author | Alan Dipert
<alan@dipert.org> 2020-01-12 06:29:59 UTC |
committer | Alan Dipert
<alan@dipert.org> 2020-01-12 06:29:59 UTC |
parent | 73be90649cbc567e044995dcf1bb65ec8897a071 |
boot.lisp | +37 | -12 |
jacl.js | +57 | -13 |
diff --git a/boot.lisp b/boot.lisp index eabc5d6..c5c877f 100644 --- a/boot.lisp +++ b/boot.lisp @@ -1,11 +1,14 @@ -;; in JACL package +;; in JACL package; use JACL from COMMON-LISP and switch to COMMON-LISP +(%let ((cl-pkg (\. (%js "Package") (|get| (\. '#:common-lisp |name|))))) + (\. cl-pkg (|usePackage| cl:*package*)) + (%setq cl:*package* cl-pkg)) -(\. cl:*package* (|exportSymbol| (\. '%defmacro |name|))) +(\. *package* (|exportSymbol| (\. 'defmacro |name|))) (%js "(~{}.setMacro().fvalue = ~{})" - '%defmacro + 'defmacro (%lambda (env form name params &rest body) ;; TODO Use %PROGN instead of %LET - `(jacl:%let () + `(jacl:%progn (jacl:%js "(~{}.setMacro().fvalue = ~{})" ',name ;; TODO Macro lambda list parsing. Also, consider @@ -15,25 +18,47 @@ ,@body)) ',name))) -;; Use JACL from COMMON-LISP and switch to COMMON-LISP -(%let ((cl-pkg (\. (%js "Package") (|get| (\. '#:common-lisp |name|))))) - (\. cl-pkg (|usePackage| cl:*package*)) - (%setq cl:*package* cl-pkg)) - -(%defmacro defun (name params &rest body) - `(jacl:%let () +(\. *package* (|exportSymbol| (\. "DEFUN" (|toString|)))) +(defmacro defun (name params &rest body) + `(jacl:%progn (jacl:%js "(~{}.fvalue = ~{})" ',name (jacl:%lambda ,params ,@body)) ',name)) -(\. cl:*package* (|exportSymbol| (\. "SET" (|toString|)))) +(defun %export (symbol) + (\. *package* (|exportSymbol| (\. symbol |name|)))) + +(%export 'set) (defun set (symbol value) (%js "(~{}.value = ~{})" symbol value)) +(%export 'defvar) +(defmacro defvar (symbol &optional (value nil value?)) + `(jacl:%progn + (jacl:%js "~{}.isSpecial = true" ',symbol) + (jacl:%if (jacl:%js "(((~{}.value === UNDEFINED) && ~{}) ? true : null)" ',symbol ,value?) + (cl:set ',symbol ,value) + nil) + ',symbol)) + +(%export 'let) +(defmacro let (bindings &rest body) + `(jacl:%let ,bindings ,@body)) + ;; Use COMMON-LISP from COMMON-LISP-USER and switch to ;; COMMON-LISP-USER (%let ((cl-user-pkg (\. (%js "Package") (|get| (\. '#:common-lisp-user |name|))))) (\. cl-user-pkg (|usePackage| cl:*package*)) (%setq cl:*package* cl-user-pkg)) +;; Testing things + +(defvar *x*) + +(defun observe-*x* () + *x*) + +(let ((*x* 123)) + (observe-*x*)) + diff --git a/jacl.js b/jacl.js index b01b4fc..4caa9bc 100644 --- a/jacl.js +++ b/jacl.js @@ -224,6 +224,8 @@ class LispSymbol { } } +// TODO consider using a hash table instead of Map in the runtime, and +// then using LispStrings everywhere we currently use JS Strings class LispString extends Array { static fromString(str) { return new LispString(...str.split('')); @@ -777,7 +779,8 @@ const SPECIAL_FORMS = [ '%SETQ', '%TAGBODY', '%GO', - '%JS' + '%JS', + '%IF' ]; for (const s of SPECIAL_FORMS) { @@ -1165,12 +1168,23 @@ const analyzeSpecials = new Map([ parent: parent, form: form }); - node.bindings = Cons.toArray(bindings).map(([name, expr]) => { - return [name, analyze(env.withContext('expr'), node, expr)]; - }); + node.locals = []; + node.specials = []; + for (const [name, expr] of Cons.toArray(bindings)) { + const val = analyze(env.withContext('expr'), node, expr) + if (name.isSpecial) { + node.specials.push([name, val]); + } else { + node.locals.push([name, val]); + } + } return merge( node, - analyzeBlock(env.withLocals(node.bindings.map(x => x[0])), node, body) + analyzeBlock( + env.withLocals(node.locals.map(([name]) => name)), + node, + body + ) ); }], [JACLPKG.intern('%PROGN'), (env, parent, form) => { @@ -1417,6 +1431,10 @@ const constantCode = val => { return `LispString.fromString('${escapeSingle(val.toString())}')`; } else if (val === null) { return 'null'; + } else if (val === true) { + return 'true'; + } else if (val === false) { + return 'false'; } else if (val instanceof Cons) { const { car, cdr } = val; return `new Cons(${constantCode(car)}, ${constantCode(cdr)})`; @@ -1459,6 +1477,23 @@ const formatTag = x => typeof x === 'number' ? x.toString() : `'${escapeSingle(x)}'`; +// Used by 'let' and 'lambda' nodes +// TODO expr and stmt variations? +const emitSpecialBlock = (print, blockNode) => { + print('try{'); + for (const [name, val] of blockNode.specials) { + print(`Package.get('${escapeSingle(name.packageName)}', true).intern('${escapeSingle(name.name)}').pushBinding(`); + emitNode(print, val); + print(');'); + } + emitBlock(print, blockNode.statements, blockNode.ret); + print('}finally{'); + for (const [name, val] of blockNode.specials) { + print(`Package.get('${escapeSingle(name.packageName)}', true).intern('${escapeSingle(name.name)}').popBinding();`); + } + print('}'); +} + const emitNode = (print, node) => { const { op, env: { context }, parent, form } = node; switch (op) { @@ -1546,21 +1581,30 @@ const emitNode = (print, node) => { if (context !== 'expr') print(';\n'); break; case 'let': + { if (context === 'expr') print('(function()'); print('{'); - if (node.bindings.length) print('var '); - for (let i = 0; i < node.bindings.length; i++) { - const [name, val] = node.bindings[i]; - print(mungeSym(name, 'local')) + + if (node.locals.length) print('var '); + for (let i = 0; i < node.locals.length; i++) { + const [ name, val ] = node.locals[i]; + print(mungeSym(name, 'local')); print('='); emitNode(print, val); - if (i < node.bindings.length-1) print(','); + if (i < node.locals.length-1) print(','); } - if (node.bindings.length) print(';'); - emitBlock(print, node.statements, node.ret); + if (node.locals.length) print(';'); + + if (node.specials.length) { + emitSpecialBlock(print, node); + } else { + emitBlock(print, node.statements, node.ret); + } + print('}'); if (context === 'expr') print(')()'); break; + } case 'lambda': { print('(function('); // Emit required argument names @@ -1881,7 +1925,7 @@ const startRepl = async () => { const sb = new StringBuffer(); emitNode(sb.append.bind(sb), node); const code = sb.toString(); - //console.log(code); + console.log('code="',code,'"'); const result = eval(code); console.log(result); }