FUNCTIONP and printer for FUNCTION

[jscl.git] / lispstrack.lisp

diff --git a/lispstrack.lisp b/lispstrack.lisp
index f31ca0f..b677491 100644 (file)
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -29,18 +29,24 @@
                         `(eval-when-compile
                            (%compile-defmacro ',name '(lambda ,args ,@body))))))
 
- (defmacro defvar (name value)
+ (defmacro %defvar (name value)
    `(progn
       (eval-when-compile
         (%compile-defvar ',name))
       (setq ,name ,value)))
 
- (defmacro defun (name args &rest body)
+  (defmacro defvar (name value)
+    `(%defvar ,name ,value))
+
+ (defmacro %defun (name args &rest body)
    `(progn
       (eval-when-compile
         (%compile-defun ',name))
       (fsetq ,name (lambda ,args ,@body))))
 
+  (defmacro defun (name args &rest body)
+    `(%defun ,name ,args ,@body))
+
  (defvar *package* (new))
 
  (defvar nil (make-symbol "NIL"))
@@ -127,6 +133,16 @@
 
 #+lispstrack
 (progn
+  (defmacro defun (name args &rest body)
+    `(progn
+       (%defun ,name ,args ,@body)
+       ',name))
+
+  (defmacro defvar (name value)
+    `(progn
+       (%defvar ,name ,value)
+       ',name))
+
   (defun append-two (list1 list2)
     (if (null list1)
         list2
@@ -389,7 +405,6 @@
                       digits)
               ""))))
 
-
 ;;;; Reader
 
 ;;; The Lisp reader, parse strings and return Lisp objects. The main
@@ -738,7 +753,7 @@
 
 (define-compilation eval-when-compile (&rest body)
   (eval (cons 'progn body))
-  nil)
+  "")
 
 (defmacro define-transformation (name args form)
   `(define-compilation ,name ,args
@@ -955,6 +970,11 @@
   (compile-bool
    (concat "(" (ls-compile key env fenv) " in " (ls-compile object env fenv) ")")))
 
+(define-compilation functionp (x)
+  (compile-bool
+   (concat "(typeof " (ls-compile x env fenv) " == 'function')")))
+
+
 (defun macrop (x)
   (and (symbolp x) (eq (binding-type (lookup-function x *fenv*)) 'macro)))
 
@@ -1011,6 +1031,18 @@
 ;;; interactive development (eval), which works calling the compiler
 ;;; and evaluating the Javascript result globally.
 
+(defun print-to-string (form)
+  (cond
+    ((symbolp form) (symbol-name form))
+    ((integerp form) (integer-to-string form))
+    ((stringp form) (concat "\"" (escape-string form) "\""))
+    ((functionp form) (concat "#<FUNCTION>"))
+    ((listp form)
+     (concat "("
+             (join (mapcar #'print-to-string form)
+                   " ")
+             ")"))))
+
 #+lispstrack
 (progn
  (defmacro with-compilation-unit (&rest body)
@@ -1043,6 +1075,7 @@
  (js-eval
   (concat "var lisp = {};"
           "lisp.read = " (lookup-function-translation 'ls-read-from-string nil) ";" *newline*
+          "lisp.print = " (lookup-function-translation 'print-to-string nil) ";" *newline*
           "lisp.eval = " (lookup-function-translation 'eval nil) ";" *newline*
           "lisp.compile = " (lookup-function-translation 'ls-compile-toplevel nil) ";" *newline*
           "lisp.evalString = function(str){" *newline*