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
|
||||
;; 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
|
||||
;; 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).
|
||||
;; the future (post-Rebirth).
|
||||
(define (fnmap fn args t)
|
||||
(case fn
|
||||
(("es:console")
|
||||
|
|
|
|||
|
|
@ -46,11 +46,163 @@
|
|||
;;; 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
|
||||
;;; 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
|
||||
;; libprebirth.
|
||||
|
||||
;;
|
||||
;; Here we define the libprebirth primitives. When we first compile
|
||||
;; Rebirth with Birth, `string->es' is not yet available, because it is
|
||||
;; only implemented in Rebirth. Further, Birth includes libprebirth in
|
||||
|
|
@ -228,6 +380,8 @@
|
|||
(string->es "fsdata[$$path]")))))
|
||||
|
||||
|
||||
;; ==STEP 1== (see Step 0 above)
|
||||
;;
|
||||
;; Without macro support, anything that involves producing code with
|
||||
;; variable structure at compile-time must be hard-coded in the
|
||||
;; compiler. Perhaps the greatest power in Lisp is the ability to extend
|
||||
|
|
@ -430,7 +584,7 @@
|
|||
(("string")
|
||||
(list "string" item))
|
||||
(("symbol")
|
||||
(list "symbol" (string->es "Symbol.keyFor($$item)")))
|
||||
(list "symbol" (string->es "Symbol.keyFor($$item)")))
|
||||
(else
|
||||
(list "symbol" (string->es "''+$$item")))))
|
||||
|
||||
|
|
@ -449,6 +603,8 @@
|
|||
(lexeme (cadr item-parts)))
|
||||
(car (make-token type lexeme "" 0))))))))
|
||||
|
||||
;; (go to Step 2 above)
|
||||
|
||||
|
||||
;; pair selection
|
||||
(define (cadr xs)
|
||||
|
|
@ -944,166 +1100,178 @@
|
|||
(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.
|
||||
;;
|
||||
;; This map allows for a steady transition---items can be removed as they
|
||||
;; are written in Prebirth Lisp. This should give us a sane (but still
|
||||
;; simple) environment with which we can start to self-host.
|
||||
;; These are forms that cannot be re-written as macros because of
|
||||
;; chicken-and-egg issues. Since the Rebirth compiler is temporary, we're
|
||||
;; not going to worry about getting rid of the rest of these.
|
||||
;;
|
||||
;; String values are simple function aliases. Function values take over
|
||||
;; 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
|
||||
;; function/procedure/form, and ARS 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).
|
||||
;; function/procedure/form, and ARGS is the list of arguments.
|
||||
(define (fnmap fn args t)
|
||||
(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?)
|
||||
(("string->es")
|
||||
(token-value (car args)))
|
||||
|
||||
;; yes, there are more important things to do until we get to the
|
||||
;; point where it's worth implementing proper tail calls
|
||||
(("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")
|
||||
;; very primitive cond-expand
|
||||
(("cond-expand") (expand-cond-expand args))
|
||||
|
||||
;; note that the unquote forms are only valid within a quasiquote; see
|
||||
;; that procedure for the handling of those forms
|
||||
(("quote") (quote-sexp (car args)))
|
||||
(("quasiquote") (quasiquote-sexp (car args)))
|
||||
;; Note that the unquote forms are only valid within a quasiquote; see
|
||||
;; that procedure for the handling of those forms. Since we do not
|
||||
;; support the special prefix form, we also offer "`quote" as a
|
||||
;; shorthand for quasiquote.
|
||||
(("quote") (quote-sexp (car args)))
|
||||
(("quasiquote" "`quote") (quasiquote-sexp (car args)))
|
||||
|
||||
(("define") (cdfn t))
|
||||
(("define-macro") (cdfn-macro t)) ; not defined until string->es cond
|
||||
|
||||
(("lambda")
|
||||
(let ((fnargs (car args))
|
||||
(body (cdr args)))
|
||||
(string-append
|
||||
"function(" (join ", " (map sexp->es fnargs)) "){\n"
|
||||
(body->es body #t)
|
||||
"}")))
|
||||
;; If we have macro support (`cdfn-macro'), then assume that they exist
|
||||
;; and try to use them; otherwise, continue to use built-in forms, which
|
||||
;; have been moved into `fnmap-premacro').
|
||||
(else
|
||||
(cond-expand
|
||||
(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
|
||||
;; 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;})()"))
|
||||
;; Special forms to be removed on future Rebirth pass in favor of macros
|
||||
;;
|
||||
;; See Step 2 above for the replacement macro definitions.
|
||||
(cond-expand
|
||||
(cdfn-macro) ; our cond-expand does not support `else'
|
||||
(else
|
||||
(define (fnmap-premacro fn args t)
|
||||
(case fn
|
||||
(("es:console")
|
||||
(string-append "console.log(" (map sexp->es args) ")"))
|
||||
(("es:error")
|
||||
(string-append "console.error(" (map sexp->es args) ")"))
|
||||
|
||||
;; 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;})()"))
|
||||
;; yes, there are more important things to do until we get to the
|
||||
;; point where it's worth implementing proper tail calls
|
||||
(("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")
|
||||
|
||||
;; (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)
|
||||
(("lambda")
|
||||
(let ((fnargs (car args))
|
||||
(body (cdr args)))
|
||||
(string-append
|
||||
"function(" (join ", " (map sexp->es fnargs)) "){\n"
|
||||
(body->es body #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
|
||||
;; 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
|
||||
" let " (sexp->es (car binding))
|
||||
" = " (sexp->es (cadr binding)) ";\n"))
|
||||
bindings))
|
||||
(body->es body #t) "\n"
|
||||
" })()")))
|
||||
(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)))
|
||||
"}})()")))
|
||||
|
||||
;; 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 ")")))
|
||||
(("set!")
|
||||
(let ((varid (car args))
|
||||
(val (cadr args)))
|
||||
(string-append (sexp->es varid) " = " (sexp->es val))))
|
||||
|
||||
;; 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
|
||||
(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))))
|
||||
;; procedure or macro
|
||||
(else (apply-proc-or-macro fn args))))))
|
||||
|
||||
|
||||
;; Convert s-expressions or scalar into ECMAScript
|
||||
|
|
|
|||
Loading…
Reference in New Issue