X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=lispstrack.lisp;h=9395aec00cd88b7c7ab5a64af1170cec045663e0;hb=0051195db753db40c7b42ad1e947d2a606af12dd;hp=4aa57bc815f6c2a930b7657c7fa0f9aa795d0f83;hpb=d0b80709a9000bc3208c806b7f57c727b3610d22;p=jscl.git

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 4aa57bc..9395aec 100644
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -6,6 +6,9 @@
        ((not ,condition))
      ,@body))
 
+(defvar *newline* "
+")
+
 ;;; simplify me, please
 (defun concat (&rest strs)
   (reduce (lambda (s1 s2) (concatenate 'string s1 s2))
@@ -24,6 +27,11 @@
              separator
              (join (cdr list) separator)))))
 
+(defun join-trailing (list separator)
+  (if (null list)
+      ""
+      (concat (car list) separator (join-trailing (cdr list) separator))))
+
 (defun integer-to-string (x)
   (if (zerop x)
       "0"
@@ -168,11 +176,11 @@
 (defvar *compilations* nil)
 
 (defun ls-compile-block (sexps env fenv)
-  (concat (join (mapcar (lambda (x)
-                          (concat (ls-compile x env fenv) ";"))
-                        sexps)
-                ";
-")))
+  (join-trailing (mapcar (lambda (x)
+                           (ls-compile x env fenv))
+                         sexps)
+                 ";
+"))
 
 (defun extend-env (args env)
   (append (mapcar #'make-var-binding args) env))
@@ -229,19 +237,19 @@
               (join (mapcar (lambda (x) (lookup-variable x new-env))
                             required-arguments)
                     ",")
-              "){
-"
+              "){"
+              *newline*
               (if rest-argument
                   (concat "var " (lookup-variable rest-argument new-env)
                           " = arguments.slice("
-                          (prin1-to-string (length required-arguments)) ");
-")
+                          (prin1-to-string (length required-arguments))
+                          ");"
+                          *newline*)
                   "")
-
               (concat (ls-compile-block (butlast body) new-env fenv)
                       "return " (ls-compile (car (last body)) new-env fenv) ";")
-              "
-})"))))
+              *newline*
+              "})"))))
 
 (define-compilation fsetq (var val)
   (concat (lookup-function var fenv)
@@ -293,6 +301,7 @@
     ((symbolp x)
      (lookup-function x fenv))))
 
+#+common-lisp
 (defmacro eval-when-compile (&body body)
   `(eval-when (:compile-toplevel :execute)
      ,@body))
@@ -342,6 +351,9 @@
       (backquote-expand-1 (cadr form))
       form))
 
+(defmacro backquote (form)
+  (backquote-expand-1 form))
+
 (define-transformation backquote (form)
   (backquote-expand-1 form))
 
@@ -362,6 +374,9 @@
 (define-compilation = (x y)
   (concat "((" (ls-compile x env fenv) ") == (" (ls-compile y env fenv) "))"))
 
+(define-compilation null (x)
+  (concat "(" (ls-compile x env fenv) "== undefined)"))
+
 (define-compilation cons (x y)
   (concat "{car: " (ls-compile x env fenv) ", cdr: " (ls-compile y env fenv) "}"))
 
@@ -371,6 +386,8 @@
 (define-compilation cdr (x)
   (concat "(" (ls-compile x env fenv) ").cdr"))
 
+
+
 (define-compilation symbol-name (x)
   (concat "(" (ls-compile x env fenv) ").name"))
 
@@ -429,8 +446,7 @@
   (setq *toplevel-compilations* nil)
   (let ((code (ls-compile sexp)))
     (prog1
-        (concat (join (mapcar (lambda (x)(concat x ";
-"))
+        (concat (join (mapcar (lambda (x) (concat x ";" *newline*))
                               *toplevel-compilations*)
                       "")
                 code)