git » jacl.git » commit 7f664f8

diff --git a/boot.lisp b/boot.lisp
index bfab936..5d18240 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -306,18 +306,17 @@
 
 (%export 'gensym)
 (defun gensym (&optional (x nil x?))
-  (cond ((and x? (stringp x))
-         (jacl:%new (jacl:%js "LispSymbol")
-                    (jacl:%js "~{}+~{}.toString()" x *gensym-counter*)))
-        ((and x? (numberp x))
-         (jacl:%new (jacl:%js "LispSymbol")
-                    (jacl:%js "'G'+~{}.toString()" x)))
-        (x? (%type-error "string or integer"))
-        (t
-         (let ((sym (jacl:%new (jacl:%js "LispSymbol")
-                               (jacl:%js "'G'+~{}.toString()" *gensym-counter*))))
-           (set '*gensym-counter* (1+ *gensym-counter*))
-           sym))))
+  (if x?
+      (if (stringp x)
+          (%progn
+           (%setq *gensym-counter* (1+ *gensym-counter*))
+           (%js "(new LispSymbol(~{}.toString()+~{}))" x *gensym-counter*))
+          (if (numberp x)
+              (%js "(new LispSymbol('G'+~{}))" x)
+              (%type-error "string or integer")))
+      (%progn
+       (%setq *gensym-counter* (1+ *gensym-counter*))
+       (%js "(new LispSymbol('G'+~{}))" *gensym-counter*))))
 
 (%export 'or)
 (defmacro or (&rest forms)
@@ -357,13 +356,29 @@
 (defun functionp (x)
   (jacl:%js "~{} instanceof Function ? true : null" x))
 
+(%export 'symbol-function)
+(defun symbol-function (symbol)
+  (if (not (symbolp symbol))
+      (%type-error "symbol")
+      (\. symbol (|func|))))
+
+(%export 'function)
+(defmacro function (x)
+  (cond ((symbolp x) `(symbol-function ',x))
+        ((%js "isLambdaForm(~{})?true:null" x) x)
+        (t (%type-error "function"))))
+
+(defun %unspread (args)
+  (when args
+    (if (and (listp (car args))
+             (null (cdr args)))
+        (car args)
+        (cons (car args) (%unspread (cdr args))))))
+
 (%export 'funcall)
-(defun funcall (f &rest args)
-  (declare (jacl:rest-array))
-  (let ((func (cond ((symbolp f) (\. f (|func|)))
-                    ((functionp f) f)
-                    (t (%type-error "function or symbol")))))
-    (\. func (|apply| nil args))))
+(defun funcall (function &rest args)
+  (declare (jacl:rest-array args))
+  (\. function (|apply| function args)))
 
 (defun %map-pairs (fun pairs)
   (let ((head nil)
@@ -460,9 +475,18 @@
         (result-form (caddr binding))
         (begin#      (gensym "begin"))
         (end#        (gensym "end")))
+    ;; (\. (%js "console") (|log|(funcall (%js "prstr") binding)))
+    ;; (\. (%js "console") (|log|(funcall (%js "prstr") var)))
+    ;; (\. (%js "console") (|log|(funcall (%js "prstr") list#)))
+    ;; (\. (%js "console") (|log|(funcall (%js "prstr") result-form)))
+    ;; (\. (%js "console") (|log|(funcall (%js "prstr") begin#)))
+    ;; (\. (%js "console") (|log|(funcall (%js "prstr") end#)))
     `(block nil
        (let ((,var   nil)
              (,list# ,(cadr binding)))
+         ;; (\. (%js "console") (|log|(funcall (%js "prstr") "here1")))
+         ;; (\. (%js "console") (|log|(funcall (%js "prstr") ,list#)))
+         ;; (\. (%js "console") (|log| ,list#))
          (tagbody
           ,begin#
           (if (null ,list#) (go ,end#))
@@ -524,18 +548,12 @@
 
 (cl:setq cl:*package* (\. (%js "Package") (|get| (\. '#:common-lisp |name|))))
 
-;;
-;;(%export 'let*)
-;;(defmacro let* (bindings &rest body)
-;;  (if bindings
-;;      `(let (,(car bindings))
-;;         (let* ,(cdr bindings)
-;;           ,@body))
-;;      `(progn ,@body)))
-;;
-;;(%export 'function)
-;;(defmacro function (x)
-;;  `(jacl:%js "~{}.func()" x))
+(%export 'macroexpand-1)
+(defun macroexpand-1 (form &optional env)
+  (if (%js "isMacroForm(~{})?true:null" form)
+      (apply (symbol-function (car form)) env form (cdr form))
+      form))
+
 ;;
 ;;(%export 'functionp)
 ;;(defun functionp (x)
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index 9459036..170dbfc 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -53,13 +53,27 @@
     (let ((sym '|Alan|))
       (assert= (\. sym |name|) @"Alan"))))
 
+(in-module "Lambda List")
+
+(deftest "Keyword arguments"
+  (assert= (funcall (lambda (&key x) x) :x 123) 123)
+  (assert= (funcall (lambda (a b &key c) (+ a b c)) 1 2 :c 3) 6)
+  (assert= (funcall (lambda (x y &key a b c)
+                      (dolist (x (list a b c) c)
+                        x))
+                    nil nil)
+           nil))
+
+;; (in-module "Macro Lambda List")
+;; TODO
+
 (in-module "Internal")
 
-(deftest "Designators"
-  (with-label "string"
-    (dolist (obj '("a designator" |a designator|))
-      (assert= t (string= (cl::%designated-string obj)
-                          "a designator")))))
+;; (deftest "Designators"
+;;   (with-label "string"
+;;     (dolist (obj '("a designator" |a designator|))
+;;       (assert= t (string= (cl::%designated-string obj)
+;;                           "a designator")))))
 
 (in-module "Numerics")
 
@@ -99,6 +113,12 @@
   (assert-throws (- 'foo))
   (assert-throws (- 1 'bar)))
 
+(in-module "Special Forms")
+
+(deftest "Function accessors"
+  (assert= (function +) (function +) "FUNCTION")
+  (assert= (function +) (symbol-function '+) "SYMBOL-FUNCTION"))
+
 (start-tests)
 
 ;; ;; (in-module "Control operators")
@@ -218,3 +238,19 @@
 ;; (defun snoob (&rest rest &aux (x "snoob"))
 ;;   (log x))
 ;; (snoob)
+
+;; Local Variables:
+;; eval: (put 'with-label 'lisp-indent-function 1)
+;; eval: (put 'with-read 'lisp-indent-function 1)
+;; eval: (put 'deftest 'lisp-indent-function 'defun)
+;; End:
+
+(let ((x 1))
+  (let ((x 99)
+        (y (list x)))
+    y))
+
+(let* ((x 1))
+  (let* ((x 99)
+         (y (list x)))
+    y))
diff --git a/jacl.html b/jacl.html
index 308d40e..0d4273c 100644
--- a/jacl.html
+++ b/jacl.html
@@ -17,6 +17,7 @@
     <script type="application/lisp" src="boot.lisp"></script>
     <script type="application/lisp" src="jacl-tests.lisp"></script>
     <script src="qunit-2.9.2.js"></script>
+    <script src="https://cdn.rawgit.com/beautify-web/js-beautify/v1.12.0/js/lib/beautify.js"></script>
     <script type="text/javascript">
       QUnit.config.autostart = false;
       QUnit.config.testTimeout = 100;
diff --git a/jacl.js b/jacl.js
index afe4d32..7d99d83 100644
--- a/jacl.js
+++ b/jacl.js
@@ -2396,6 +2396,7 @@ const fetchLoad = async (src) => {
     const node = optimize(analyze(emptyEnv().withContext('return'), null, obj)),
           sb = new StringBuffer();
     emitNode(sb.append.bind(sb), node);
+    // console.log(js_beautify(sb.toString()));
     await (new Function(sb.toString())());
   }
 };
diff --git a/todo.org b/todo.org
index 46e1e0f..3de303c 100644
--- a/todo.org
+++ b/todo.org
@@ -15,14 +15,27 @@
 *** Function parameters
 * TODO EVAL-WHEN
 ** Maintain situations in a variable in JACL package
-* TODO BLOCK/RETURN/RETURN-FROM
+* DONE BLOCK/RETURN/RETURN-FROM
 ** SBCL has a concept of "named lambdas"
 ** Related to RETURN-FROM? Related to tail calls?
 ** Current function name as part of dynamic environment
 * TODO FLET
+** Use multiple values to return new env from macros like FLET?
+** TODO FUNCTION
+** TODO MAPCAR
+** TODO MACROLET
 * TODO File compilation
 * TODO Multiple value returns
+See mv.lisp. Make it possible for macros to return multiple values; then they can return a new environment.
+** DEFCONSTANT
+** DO
+** MAKE-ARRAY
+** MIN
+** convert array to list
+** MAPCAR
+** LENGTH
 * SETF/accessors
 * TODO Direct linking
 * TODO Tree shaking
 * TODO JACL:DELIVER
+* TODO Host REPL