Mike Gerwitz

Activist for User Freedom

aboutsummaryrefslogtreecommitdiffstats
blob: 8928edef5f9e19a4e91ace9834050e60b63428a3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
;;; ECMAScript Target Compiler Macros for Rebirth Lisp
;;;
;;;  Copyright (C) 2017, 2018 Mike Gerwitz
;;;
;;;  This file is part of Ulambda Scheme.
;;;
;;;  Ulambda Scheme is free software: you can redistribute it and/or modify
;;;  it under the terms of the GNU Affero General Public License as
;;;  published by the Free Software Foundation, either version 3 of the
;;;  License, or (at your option) any later version.
;;;
;;;  This program is distributed in the hope that it will be useful,
;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;  GNU General Public License for more details.
;;;
;;;  You should have received a copy of the GNU Affero General Public License
;;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;; THIS IS BOOTSTRAP CODE INTENDED FOR USE ONLY IN REBIRTH.
;;;
;;;
;;;                           === STEP 2 ===
;;;
;;; Did you read the other steps first?  If not, you're out of order; go to
;;; Step 0 first and then come back here; see `rebirth.scm'.
;;;
;;; Back?  Good!
;;;
;;; Now that we have macro support, we can start to refactor parts of the
;;; compiler into macros---rather than maintaining features as part of the
;;; compiler itself, we maintain them as a library used alongside the
;;; program.  This also has another important benefit: additional compiler
;;; features resulting from these definitions do not require another Rebirth
;;; compilation pass (that is, Re⁽ⁿ⁺¹⁾birth) before they are available to
;;; use.
;;;
;;; To make sure that these macros are not thwarted by the existing `fnmap'
;;; definitions, `fnmap' has been refactored to remove the respective
;;; definitions using `cond-expand'; see `fnmap-premacro'.
;;;
;;; These are by no means meant to be solid implementations; strong
;;; deficiencies exist, and don't expect this to work properly in every
;;; case.  They will be replaced with proper R7RS implementations in the
;;; future.
;;;
;;; These macros have references to `_env', representing the current
;;; environment.  It is at this point that we also add primitive environment
;;; support---this is essential as we move forward into purely macro-based
;;; compilation passes, since we need to be able to have discrete
;;; environments to run each of those passes in.  More on that later.
;;;
;;; Scheme creates a new environment for every level of scope.  Each
;;; environment inherits the one above it, which produces the familiar
;;; lexical scoping.  As it turns out, this structure is represented
;;; perfectly by ECMAScript's prototype model---a reference to a key on a
;;; prototype chain is transparently proxied up the chain until it is
;;; found.  Therefore, environments are chained using a simple
;;; `Object.create'.  For now, anyway---that's the easy solution for now, but
;;; in the future (Ulambda) we're likely to have a heap instead, once we have
;;; static analysis.
;;;
;;; Initially, everything here was a near-exact copy of the `fnmap-premacro'
;;; forms, re-arranged as needed for compilation (see limitations of
;;; `cdfn-macro'), so all changes are clearly visible in the repository
;;; history.

(cond-expand
  (cdfn-macro
   (define-macro (%es:native-apply fn . args)
     (`quote
      (string->es
       (unquote (string-append
                 (token-value fn)
                 "(" (join "," (map sexp->es args)) ")")))))

   (define-macro (es:console . args)
     (`quote (%es:native-apply console.log (unquote@ args))))
   (define-macro (es:error . args)
     (`quote (%es:native-apply console.error (unquote@ args))))

   ;; Expand the body BODY into a new environment.  Environments are
   ;; currently handled by the ES runtime, so this is easy.
   (define-macro (es:envf env . body)
     (`quote
      (string-append
       "(function(_env){"
       "return "
       (unquote@ body)
       "})(" (unquote env) ")")))

   (define (es:inherit-env)
     "Object.create(_env)")

   (define-macro (define-es-macro decl . body)
     (quasiquote
      (define-macro (unquote decl)
        (list
         (quote string->es)
         (string-append (unquote@ body))))))

   ;; Reference to current environment object.
   (define-es-macro (%es:env) "_env")

   ;; Don't worry---basic tail call support (at least for recursion) is
   ;; nearing, and then we can get rid of this ugly thing.
   (define-es-macro (es:while pred . body)
     "(function(__whilebrk){"
     "while (" (sexp->es pred) "){\n"
     (body->es body #f) " if (__whilebrk) break;\n"
     "}\n"
     "})(false)")
   (define-es-macro (es:break)
     "__whilebrk=true")

   (define-es-macro (lambda fnargs . body)
     (es:envf (es:inherit-env)
      "function(" (join ", " (map tparam->es fnargs)) "){\n"
      (env-params fnargs)
      (body->es body #t)
      "}"))

   (define-es-macro (let* bindings . body)
     "(function(){\n"
     (join "" (map (lambda (binding)
                     (string-append
                      "let " (tparam->es (car binding))  ; TODO: BC; remove
                      " = " (env-ref (car binding))
                      " = " (sexp->es (cadr binding)) ";\n"))
                   bindings))
     (body->es body #t) "\n"
     "    })()")

   (define-es-macro (let bindings . body)
     (let* ((params  (map car bindings))
            (fparams (join ", " (map tparam->es params)))
            (args    (map cadr bindings))
            (fargs   (map sexp->es args)))
       (string-append (es:envf (es:inherit-env)
                       "(function(" fparams "){\n"
                       (env-params params)
                       (body->es body #t) "\n"
                       "})(" fargs ")"))))

   (define-es-macro (and . args)
     "(function(__and){\n"
     (join "" (map (lambda (expr)
                     (string-append
                      "__and = " (sexp->es expr) "; "
                      "if (!_truep(__and)) return false;\n"))
                   args))
     "return __and;})()")

   (define-es-macro (or . args)
     "(function(__or){\n"
     (join "" (map (lambda (expr)
                     (string-append
                      "__or = " (sexp->es expr) "; "
                      "if (_truep(__or)) return __or;\n"))
                   args))
     "return false;})()")

   (define-es-macro (if pred t . rest)
     (let ((f (and (pair? rest)
                   (car rest))))
       (string-append
        "(function(){"
        "if (_truep(" (sexp->es pred) ")){return " (sexp->es t) ";}"
        (or (and (pair? f)
                 (string-append "else{return " (sexp->es f) ";}"))
            "")
        "})()")))

   (define-es-macro (case key . clauses)
     "(function(){const _key=" (sexp->es key) ";\n"
     "switch (_key){\n"
     (join ""
           (map (lambda (data exprs)
                  (string-append
                   (if (and (token? data)
                            (string=? "else" (token-lexeme data)))
                       "default:\n"
                       (join ""
                             (map (lambda (datum)
                                    (string-append
                                     "case " (sexp->es datum) ":\n"))
                                  data)))
                   (body->es exprs #t) "\n"))
                (map car clauses)
                (map cdr clauses)))
     "}})()")


   ;; We can just re-use `let' for `begin' since it already does exactly
   ;; what we need it to
   (define-macro (begin . exprs)
     (`quote (let () (unquote@ exprs))))


   ;; This doesn't currently produce any sort of encapsulated
   ;; environment---it just produces an ECMAScript string.  This also
   ;; does not provide any of the expected syntatic keywords yet.
   (define (null-environment version)
     (if (not (eq? version 5))
         (error "null-environment version must be 5")
         (es:empty-env)))

   ;; `eval' re-uses the macro `list->ast' procedure, immediately applying
   ;; its result.
   (define-macro (eval expr env)
     (`quote (%es:native-apply
              eval
              (es:envf (unquote env)
                       (sexp->es (list->ast (unquote expr)))))))


   ;; We unfortunately have to worry about environment mutability in the
   ;; current implementation.  Since variables within environments are
   ;; implemented using ECMAScript's prototype chain, any sets affect the
   ;; object that the assignment is performed _on_, _not_ the prototype that
   ;; contains the key being set.  Therefore, we have to traverse up the
   ;; prototype chain until we find the correct value, and set it on that
   ;; object.
   ;;
   ;; There are other ways to accomplish this.  For example, we should
   ;; define setters for each variable and then not worry about
   ;; traversing.  However, since set! is rare, we wouldn't want to incur a
   ;; performance hit for every single variable.
   (define (%es:has-own-prop o id)
     (string->es "Object.hasOwnProperty.call($$o, $$id)"))
   (define (%es:proto-of o)
     (string->es "Object.getPrototypeOf($$o)"))
   (define (%es:envobj-for env id)
     (if (and (string=? (es:typeof env) "object")
              (not (es:null? env)))
         (if (%es:has-own-prop env id)
             env
             (%es:envobj-for (%es:proto-of env) id))
         (error (string-append "unknown variable: `" id "'"))))
   (define (%es:setenv env id val)
     (let ((envo (%es:envobj-for env id)))
       (string->es "$$envo[$$id] = $$val")))

   ;; set! is then a simple application of `%es:setenv'.
   (define-macro (set! varid val)
     (`quote
      (%es:setenv (%es:env)
                  (unquote (tname->id (token-lexeme varid)))
                  (unquote val))))))