From 49142b66305e2ef67755c21bea80b13ec06ff025 Mon Sep 17 00:00:00 2001 From: Mike Gerwitz Date: Fri, 15 Dec 2017 00:40:10 -0500 Subject: [PATCH] rebirth: Replace most built-in forms with macros MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- build-aux/bootstrap/birth.scm | 4 +- build-aux/bootstrap/rebirth.scm | 446 ++++++++++++++++++++++---------- 2 files changed, 309 insertions(+), 141 deletions(-) diff --git a/build-aux/bootstrap/birth.scm b/build-aux/bootstrap/birth.scm index b34aa84..c2ae3fa 100644 --- a/build-aux/bootstrap/birth.scm +++ b/build-aux/bootstrap/birth.scm @@ -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") diff --git a/build-aux/bootstrap/rebirth.scm b/build-aux/bootstrap/rebirth.scm index 7439c3d..5243348 100644 --- a/build-aux/bootstrap/rebirth.scm +++ b/build-aux/bootstrap/rebirth.scm @@ -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