228 lines
8.7 KiB
Scheme
228 lines
8.7 KiB
Scheme
;;; ECMAScript Target Compiler Macros for Rebirth Lisp
|
||
;;;
|
||
;;; Copyright (C) 2017, 2018 Mike Gerwitz
|
||
;;;
|
||
;;; This file is part of Gibble.
|
||
;;;
|
||
;;; Gibble 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))))
|
||
|
||
(define-macro (es:raw . body)
|
||
(`quote
|
||
(string->es (unquote@ body))))
|
||
|
||
;; Expand the body BODY into a new environment inherited from the current
|
||
;; environment. Environments are currently handled by the ES runtime, so
|
||
;; this is easy.
|
||
(define-macro (es:envf . body)
|
||
(`quote
|
||
(string-append
|
||
"(function(_env){"
|
||
"return "
|
||
(unquote@ body)
|
||
"})(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
|
||
"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
|
||
"(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 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))))))
|