git » jacl.git » commit 3bbf30f

Added dynamic binding for LET; DEFVAR

author Alan Dipert
2020-01-12 06:29:59 UTC
committer Alan Dipert
2020-01-12 06:29:59 UTC
parent 73be90649cbc567e044995dcf1bb65ec8897a071

Added dynamic binding for LET; DEFVAR

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);
     }