rebirth: Replace most built-in forms with macros
This is a significant step toward abandoning the Rebirth compiler (which is
a slight, mostly unaltered version of the Birth compiler, at this point);
anything written for these macros from this point on can be re-used moving
forward, regardless of what compiler we have underneath it. I'll continue
writing more Scheme-like abstractions moving forward to begin to normalize
the syntax as I get closer to a point where it's worth starting to create
proper R⁷RS implementations.
Things are moving along slowly, but they're moving. I don't have a whole
lot of free time between kids and other obligations.
* build-aux/bootstrap/birth.scm (fnmap): Doc corrections.
* build-aux/bootstrap/rebirth.scm: Add more documentation.
Add numerous macros to replace built-in forms; I'm not listing them
here.
(%list-item): Whitespace fix.
(fnmap): Split into `fnmap-premacro'.
(fnmap-premacro): New procedure.
master
parent
ae7fcdbc1a
commit
49142b6630
GPG Key ID:
8C917B7F5DC51BA2
|
|
@ -367,12 +367,12 @@
|
||||||
;; String values are simple function aliases. Function values take over
|
;; String values are simple function aliases. Function values take over
|
||||||
;; the compilation of that function and allow for defining special forms
|
;; the compilation of that function and allow for defining special forms
|
||||||
;; (in place of macro support). The first argument FN is the name of the
|
;; (in place of macro support). The first argument FN is the name of the
|
||||||
;; function/procedure/form, and ARS is the list of arguments.
|
;; function/procedure/form, and ARGS is the list of arguments.
|
||||||
;;
|
;;
|
||||||
;; These are by no means meant to be solid implementations; notable
|
;; These are by no means meant to be solid implementations; notable
|
||||||
;; deficiencies are documented, but don't expect this to work properly in
|
;; deficiencies are documented, but don't expect this to work properly in
|
||||||
;; every case. They will be replaced with proper R7RS implementations in
|
;; every case. They will be replaced with proper R7RS implementations in
|
||||||
;; the future (Rebirth).
|
;; the future (post-Rebirth).
|
||||||
(define (fnmap fn args t)
|
(define (fnmap fn args t)
|
||||||
(case fn
|
(case fn
|
||||||
(("es:console")
|
(("es:console")
|
||||||
|
|
|
||||||
|
|
@ -46,11 +46,163 @@
|
||||||
;;; vary as much as we want from the initial implementation. See the commit
|
;;; vary as much as we want from the initial implementation. See the commit
|
||||||
;;; history for this file for more information as to how it evolved (the
|
;;; history for this file for more information as to how it evolved (the
|
||||||
;;; first commit is the direct copy before actual code changes).
|
;;; first commit is the direct copy before actual code changes).
|
||||||
|
;;;
|
||||||
|
;;; This file follows a narrative (from Birth to Reⁿbirth), but it's more of
|
||||||
|
;;; a choose-your-adventure-book-style narrative: order of certain
|
||||||
|
;;; definitions unfortunately matters in this simple implementation. For
|
||||||
|
;;; example, primitive macros (e.g. `if') must be defined before they are
|
||||||
|
;;; used, so those appear at the top of this file, despite their definitions
|
||||||
|
;;; not being supported until future passes.
|
||||||
|
;;;
|
||||||
|
;;; So, to begin, go to `==STEP 0=='.
|
||||||
|
|
||||||
|
|
||||||
|
;; ==Step 2== (don't start here; see Step 0 below)
|
||||||
|
;;
|
||||||
|
;; Did you read the other steps first? If not, you're out of order; skip
|
||||||
|
;; down to Step 0 first and then come back here.
|
||||||
|
;;
|
||||||
|
;; 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.
|
||||||
|
;;
|
||||||
|
;; 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))))
|
||||||
|
|
||||||
|
(define-macro (define-es-macro decl . body)
|
||||||
|
(quasiquote
|
||||||
|
(define-macro (unquote decl)
|
||||||
|
(list
|
||||||
|
(quote string->es)
|
||||||
|
(string-append (unquote@ body))))))
|
||||||
|
|
||||||
|
;; 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)
|
||||||
|
"function(" (join ", " (map sexp->es fnargs)) "){\n"
|
||||||
|
(body->es body #t)
|
||||||
|
"}")
|
||||||
|
|
||||||
|
(define-es-macro (let* bindings . body)
|
||||||
|
"(function(){\n"
|
||||||
|
(join "" (map (lambda (binding)
|
||||||
|
(string-append
|
||||||
|
" let " (sexp->es (car binding))
|
||||||
|
" = " (sexp->es (cadr binding)) ";\n"))
|
||||||
|
bindings))
|
||||||
|
(body->es body #t) "\n"
|
||||||
|
" })()")
|
||||||
|
|
||||||
|
(define-es-macro (let bindings . body)
|
||||||
|
(let* ((fparams (join ", " (map sexp->es
|
||||||
|
(map car bindings))))
|
||||||
|
(fargs (join ", " (map sexp->es
|
||||||
|
(map cadr bindings)))))
|
||||||
|
(string-append "(function(" fparams "){\n"
|
||||||
|
(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)))
|
||||||
|
"}})()")
|
||||||
|
|
||||||
|
(define-es-macro (set! varid val)
|
||||||
|
(sexp->es varid) " = " (sexp->es val))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;; ==STEP 0== (start here)
|
||||||
|
;;
|
||||||
;; The first step in the Rebirth process is to liberate ourselves from
|
;; The first step in the Rebirth process is to liberate ourselves from
|
||||||
;; libprebirth.
|
;; libprebirth.
|
||||||
|
;;
|
||||||
;; Here we define the libprebirth primitives. When we first compile
|
;; Here we define the libprebirth primitives. When we first compile
|
||||||
;; Rebirth with Birth, `string->es' is not yet available, because it is
|
;; Rebirth with Birth, `string->es' is not yet available, because it is
|
||||||
;; only implemented in Rebirth. Further, Birth includes libprebirth in
|
;; only implemented in Rebirth. Further, Birth includes libprebirth in
|
||||||
|
|
@ -228,6 +380,8 @@
|
||||||
(string->es "fsdata[$$path]")))))
|
(string->es "fsdata[$$path]")))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ==STEP 1== (see Step 0 above)
|
||||||
|
;;
|
||||||
;; Without macro support, anything that involves producing code with
|
;; Without macro support, anything that involves producing code with
|
||||||
;; variable structure at compile-time must be hard-coded in the
|
;; variable structure at compile-time must be hard-coded in the
|
||||||
;; compiler. Perhaps the greatest power in Lisp is the ability to extend
|
;; compiler. Perhaps the greatest power in Lisp is the ability to extend
|
||||||
|
|
@ -430,7 +584,7 @@
|
||||||
(("string")
|
(("string")
|
||||||
(list "string" item))
|
(list "string" item))
|
||||||
(("symbol")
|
(("symbol")
|
||||||
(list "symbol" (string->es "Symbol.keyFor($$item)")))
|
(list "symbol" (string->es "Symbol.keyFor($$item)")))
|
||||||
(else
|
(else
|
||||||
(list "symbol" (string->es "''+$$item")))))
|
(list "symbol" (string->es "''+$$item")))))
|
||||||
|
|
||||||
|
|
@ -449,6 +603,8 @@
|
||||||
(lexeme (cadr item-parts)))
|
(lexeme (cadr item-parts)))
|
||||||
(car (make-token type lexeme "" 0))))))))
|
(car (make-token type lexeme "" 0))))))))
|
||||||
|
|
||||||
|
;; (go to Step 2 above)
|
||||||
|
|
||||||
|
|
||||||
;; pair selection
|
;; pair selection
|
||||||
(define (cadr xs)
|
(define (cadr xs)
|
||||||
|
|
@ -944,166 +1100,178 @@
|
||||||
(string-append idfn "(" argstr ")"))))
|
(string-append idfn "(" argstr ")"))))
|
||||||
|
|
||||||
|
|
||||||
;; Function/procedure aliases and special forms
|
;; Primitive special forms.
|
||||||
;;
|
;;
|
||||||
;; And here we have what is probably the most grotesque part of this file.
|
;; These are forms that cannot be re-written as macros because of
|
||||||
;;
|
;; chicken-and-egg issues. Since the Rebirth compiler is temporary, we're
|
||||||
;; This map allows for a steady transition---items can be removed as they
|
;; not going to worry about getting rid of the rest of these.
|
||||||
;; are written in Prebirth Lisp. This should give us a sane (but still
|
|
||||||
;; simple) environment with which we can start to self-host.
|
|
||||||
;;
|
;;
|
||||||
;; String values are simple function aliases. Function values take over
|
;; String values are simple function aliases. Function values take over
|
||||||
;; the compilation of that function and allow for defining special forms
|
;; the compilation of that function and allow for defining special forms
|
||||||
;; (in place of macro support). The first argument FN is the name of the
|
;; (in place of macro support). The first argument FN is the name of the
|
||||||
;; function/procedure/form, and ARS is the list of arguments.
|
;; function/procedure/form, and ARGS is the list of arguments.
|
||||||
;;
|
|
||||||
;; These are by no means meant to be solid implementations; notable
|
|
||||||
;; deficiencies are documented, but don't expect this to work properly in
|
|
||||||
;; every case. They will be replaced with proper R7RS implementations in
|
|
||||||
;; the future (Rebirth).
|
|
||||||
(define (fnmap fn args t)
|
(define (fnmap fn args t)
|
||||||
(case fn
|
(case fn
|
||||||
(("es:console")
|
|
||||||
(string-append "console.log(" (map sexp->es args) ")"))
|
|
||||||
(("es:error")
|
|
||||||
(string-append "console.error(" (map sexp->es args) ")"))
|
|
||||||
|
|
||||||
;; very primitive cond-expand
|
|
||||||
(("cond-expand") (expand-cond-expand args))
|
|
||||||
|
|
||||||
;; output raw code into the compiled ECMAScript (what could go wrong?)
|
;; output raw code into the compiled ECMAScript (what could go wrong?)
|
||||||
(("string->es")
|
(("string->es")
|
||||||
(token-value (car args)))
|
(token-value (car args)))
|
||||||
|
|
||||||
;; yes, there are more important things to do until we get to the
|
;; very primitive cond-expand
|
||||||
;; point where it's worth implementing proper tail calls
|
(("cond-expand") (expand-cond-expand args))
|
||||||
(("es:while")
|
|
||||||
(let ((pred (car args))
|
|
||||||
(body (cdr args)))
|
|
||||||
(string-append
|
|
||||||
"(function(__whilebrk){"
|
|
||||||
"while (" (sexp->es pred) "){\n"
|
|
||||||
(body->es body #f) " if (__whilebrk) break;\n"
|
|
||||||
"}\n"
|
|
||||||
"})(false)")))
|
|
||||||
(("es:break") "__whilebrk=true")
|
|
||||||
|
|
||||||
;; note that the unquote forms are only valid within a quasiquote; see
|
;; Note that the unquote forms are only valid within a quasiquote; see
|
||||||
;; that procedure for the handling of those forms
|
;; that procedure for the handling of those forms. Since we do not
|
||||||
(("quote") (quote-sexp (car args)))
|
;; support the special prefix form, we also offer "`quote" as a
|
||||||
(("quasiquote") (quasiquote-sexp (car args)))
|
;; shorthand for quasiquote.
|
||||||
|
(("quote") (quote-sexp (car args)))
|
||||||
|
(("quasiquote" "`quote") (quasiquote-sexp (car args)))
|
||||||
|
|
||||||
(("define") (cdfn t))
|
(("define") (cdfn t))
|
||||||
(("define-macro") (cdfn-macro t)) ; not defined until string->es cond
|
(("define-macro") (cdfn-macro t)) ; not defined until string->es cond
|
||||||
|
|
||||||
(("lambda")
|
;; If we have macro support (`cdfn-macro'), then assume that they exist
|
||||||
(let ((fnargs (car args))
|
;; and try to use them; otherwise, continue to use built-in forms, which
|
||||||
(body (cdr args)))
|
;; have been moved into `fnmap-premacro').
|
||||||
(string-append
|
(else
|
||||||
"function(" (join ", " (map sexp->es fnargs)) "){\n"
|
(cond-expand
|
||||||
(body->es body #t)
|
(cdfn-macro (apply-proc-or-macro fn args))
|
||||||
"}")))
|
(else (fnmap-premacro fn args t))))))
|
||||||
|
|
||||||
;; simple if statement with optional else, wrapped in a self-executing
|
|
||||||
;; function to simplify code generation (e.g. returning an if)
|
|
||||||
(("if")
|
|
||||||
(let ((pred (car args))
|
|
||||||
(t (cadr args))
|
|
||||||
(f (and (pair? (cddr args))
|
|
||||||
(caddr args))))
|
|
||||||
(string-append
|
|
||||||
"(function(){"
|
|
||||||
"if (_truep(" (sexp->es pred) ")){return " (sexp->es t) ";}"
|
|
||||||
(or (and (pair? f)
|
|
||||||
(string-append "else{return " (sexp->es f) ";}"))
|
|
||||||
"")
|
|
||||||
"})()")))
|
|
||||||
|
|
||||||
;; and short-circuits, so we need to implement it as a special form
|
;; Special forms to be removed on future Rebirth pass in favor of macros
|
||||||
;; rather than an alias
|
;;
|
||||||
(("and")
|
;; See Step 2 above for the replacement macro definitions.
|
||||||
(string-append
|
(cond-expand
|
||||||
"(function(__and){\n"
|
(cdfn-macro) ; our cond-expand does not support `else'
|
||||||
(join "" (map (lambda (expr)
|
(else
|
||||||
(string-append
|
(define (fnmap-premacro fn args t)
|
||||||
"__and = " (sexp->es expr) "; "
|
(case fn
|
||||||
"if (!_truep(__and)) return false;\n"))
|
(("es:console")
|
||||||
args))
|
(string-append "console.log(" (map sexp->es args) ")"))
|
||||||
"return __and;})()"))
|
(("es:error")
|
||||||
|
(string-append "console.error(" (map sexp->es args) ")"))
|
||||||
|
|
||||||
;; or short-circuits, so we need to implement it as a special form
|
;; yes, there are more important things to do until we get to the
|
||||||
;; rather than an alias
|
;; point where it's worth implementing proper tail calls
|
||||||
(("or")
|
(("es:while")
|
||||||
(string-append
|
(let ((pred (car args))
|
||||||
"(function(__or){\n"
|
(body (cdr args)))
|
||||||
(join "" (map (lambda (expr)
|
(string-append
|
||||||
(string-append
|
"(function(__whilebrk){"
|
||||||
"__or = " (sexp->es expr) "; "
|
"while (" (sexp->es pred) "){\n"
|
||||||
"if (_truep(__or)) return __or;\n"))
|
(body->es body #f) " if (__whilebrk) break;\n"
|
||||||
args))
|
"}\n"
|
||||||
"return false;})()"))
|
"})(false)")))
|
||||||
|
(("es:break") "__whilebrk=true")
|
||||||
|
|
||||||
;; (let ((binding val) ...) ...body), compiled as a self-executing
|
(("lambda")
|
||||||
;; function which allows us to easily represent the return value of
|
(let ((fnargs (car args))
|
||||||
;; the entire expression while maintaining local scope
|
(body (cdr args)))
|
||||||
(("let*")
|
(string-append
|
||||||
(let ((bindings (car args))
|
"function(" (join ", " (map sexp->es fnargs)) "){\n"
|
||||||
(body (cdr args)))
|
(body->es body #t)
|
||||||
(string-append
|
"}")))
|
||||||
"(function(){\n"
|
|
||||||
(join "" (map (lambda (binding)
|
;; simple if statement with optional else, wrapped in a self-executing
|
||||||
|
;; function to simplify code generation (e.g. returning an if)
|
||||||
|
(("if")
|
||||||
|
(let ((pred (car args))
|
||||||
|
(t (cadr args))
|
||||||
|
(f (and (pair? (cddr args))
|
||||||
|
(caddr args))))
|
||||||
|
(string-append
|
||||||
|
"(function(){"
|
||||||
|
"if (_truep(" (sexp->es pred) ")){return " (sexp->es t) ";}"
|
||||||
|
(or (and (pair? f)
|
||||||
|
(string-append "else{return " (sexp->es f) ";}"))
|
||||||
|
"")
|
||||||
|
"})()")))
|
||||||
|
|
||||||
|
;; and short-circuits, so we need to implement it as a special form
|
||||||
|
;; rather than an alias
|
||||||
|
(("and")
|
||||||
|
(string-append
|
||||||
|
"(function(__and){\n"
|
||||||
|
(join "" (map (lambda (expr)
|
||||||
|
(string-append
|
||||||
|
"__and = " (sexp->es expr) "; "
|
||||||
|
"if (!_truep(__and)) return false;\n"))
|
||||||
|
args))
|
||||||
|
"return __and;})()"))
|
||||||
|
|
||||||
|
;; or short-circuits, so we need to implement it as a special form
|
||||||
|
;; rather than an alias
|
||||||
|
(("or")
|
||||||
|
(string-append
|
||||||
|
"(function(__or){\n"
|
||||||
|
(join "" (map (lambda (expr)
|
||||||
|
(string-append
|
||||||
|
"__or = " (sexp->es expr) "; "
|
||||||
|
"if (_truep(__or)) return __or;\n"))
|
||||||
|
args))
|
||||||
|
"return false;})()"))
|
||||||
|
|
||||||
|
;; (let ((binding val) ...) ...body), compiled as a self-executing
|
||||||
|
;; function which allows us to easily represent the return value of
|
||||||
|
;; the entire expression while maintaining local scope.
|
||||||
|
(("let*")
|
||||||
|
(let ((bindings (car args))
|
||||||
|
(body (cdr args)))
|
||||||
|
(string-append
|
||||||
|
"(function(){\n"
|
||||||
|
(join "" (map (lambda (binding)
|
||||||
|
(string-append
|
||||||
|
" let " (sexp->es (car binding))
|
||||||
|
" = " (sexp->es (cadr binding)) ";\n"))
|
||||||
|
bindings))
|
||||||
|
(body->es body #t) "\n"
|
||||||
|
" })()")))
|
||||||
|
|
||||||
|
;; similar to the above, but variables cannot reference one-another
|
||||||
|
(("let")
|
||||||
|
(let* ((bindings (car args))
|
||||||
|
(body (cdr args))
|
||||||
|
(fparams (join ", " (map sexp->es
|
||||||
|
(map car bindings))))
|
||||||
|
(fargs (join ", " (map sexp->es
|
||||||
|
(map cadr bindings)))))
|
||||||
|
(string-append "(function(" fparams "){\n"
|
||||||
|
(body->es body #t) "\n"
|
||||||
|
"})(" fargs ")")))
|
||||||
|
|
||||||
|
;; and here I thought Prebirth Lisp would be simple...but having
|
||||||
|
;; `case' support really keeps things much more tidy, so here we are
|
||||||
|
;; (note that it doesn't support the arrow form, nor does it support
|
||||||
|
;; expressions as data)
|
||||||
|
(("case")
|
||||||
|
(let ((key (car args))
|
||||||
|
(clauses (cdr args)))
|
||||||
|
(string-append
|
||||||
|
"(function(){const _key=" (sexp->es key) ";\n"
|
||||||
|
"switch (_key){\n"
|
||||||
|
(join ""
|
||||||
|
(map (lambda (data exprs)
|
||||||
(string-append
|
(string-append
|
||||||
" let " (sexp->es (car binding))
|
(if (and (token? data)
|
||||||
" = " (sexp->es (cadr binding)) ";\n"))
|
(string=? "else" (token-lexeme data)))
|
||||||
bindings))
|
"default:\n"
|
||||||
(body->es body #t) "\n"
|
(join ""
|
||||||
" })()")))
|
(map (lambda (datum)
|
||||||
|
(string-append
|
||||||
|
"case " (sexp->es datum) ":\n"))
|
||||||
|
data)))
|
||||||
|
(body->es exprs #t) "\n"))
|
||||||
|
(map car clauses)
|
||||||
|
(map cdr clauses)))
|
||||||
|
"}})()")))
|
||||||
|
|
||||||
;; similar to the above, but variables cannot reference one-another
|
(("set!")
|
||||||
(("let")
|
(let ((varid (car args))
|
||||||
(let* ((bindings (car args))
|
(val (cadr args)))
|
||||||
(body (cdr args))
|
(string-append (sexp->es varid) " = " (sexp->es val))))
|
||||||
(fparams (join ", " (map sexp->es
|
|
||||||
(map car bindings))))
|
|
||||||
(fargs (join ", " (map sexp->es
|
|
||||||
(map cadr bindings)))))
|
|
||||||
(string-append "(function(" fparams "){\n"
|
|
||||||
(body->es body #t) "\n"
|
|
||||||
"})(" fargs ")")))
|
|
||||||
|
|
||||||
;; and here I thought Prebirth Lisp would be simple...but having
|
;; procedure or macro
|
||||||
;; `case' support really keeps things much more tidy, so here we are
|
(else (apply-proc-or-macro fn args))))))
|
||||||
;; (note that it doesn't support the arrow form, nor does it support
|
|
||||||
;; expressions as data)
|
|
||||||
(("case")
|
|
||||||
(let ((key (car args))
|
|
||||||
(clauses (cdr args)))
|
|
||||||
(string-append
|
|
||||||
"(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)))
|
|
||||||
"}})()")))
|
|
||||||
|
|
||||||
(("set!")
|
|
||||||
(let ((varid (car args))
|
|
||||||
(val (cadr args)))
|
|
||||||
(string-append (sexp->es varid) " = " (sexp->es val))))
|
|
||||||
|
|
||||||
;; procedure or macro
|
|
||||||
(else (apply-proc-or-macro fn args))))
|
|
||||||
|
|
||||||
|
|
||||||
;; Convert s-expressions or scalar into ECMAScript
|
;; Convert s-expressions or scalar into ECMAScript
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue