Fix list allocation in &rest arguments

[jscl.git] / lispstrack.lisp

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 70f8f6a..f3f01df 100644 (file)
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -25,7 +25,7 @@
   (defun / (x y) (/ x y))
   (defun 1+ (x) (+ x 1))
   (defun 1- (x) (- x 1))
-  (defun cons (x y ) (cons x y))
+  (defun cons (x y) (cons x y))
   (defun car (x) (car x))
   (defun cdr (x) (cdr x))
 
@@ -47,7 +47,10 @@
     (if (null list)
         '()
         (cons (funcall func (car list))
-              (mapcar func (cdr list))))))
+              (mapcar func (cdr list)))))
+
+  (defmacro push (x place)
+    `(setq ,place (cons ,x ,place))))
 
 
 (defun !reduce (func list initial)
@@ -60,17 +63,21 @@
 ;;; Utils
 
 #+common-lisp
-(defmacro while (condition &body body)
-  `(do ()
-       ((not ,condition))
-     ,@body))
+(progn
+  (defmacro while (condition &body body)
+    `(do ()
+         ((not ,condition))
+       ,@body))
+
+  #+common-lisp
+  (defun concat-two (s1 s2)
+    (concatenate 'string s1 s2)))
 
 (defvar *newline* "
 ")
 
-;;; simplify me, please
 (defun concat (&rest strs)
-  (!reduce (lambda (s1 s2) (concatenate 'string s1 s2))
+  (!reduce (lambda (s1 s2) (concat-two s1 s2))
            strs
            ""))
 
@@ -299,10 +306,12 @@
               "){"
               *newline*
               (if rest-argument
-                  (concat "var " (lookup-variable rest-argument new-env)
-                          " = arguments.slice("
-                          (prin1-to-string (length required-arguments))
-                          ");"
+                  (concat "var " (lookup-variable rest-argument new-env) ";" *newline*
+                          "for (var i = arguments.length-1; i>="
+                          (integer-to-string (length required-arguments))
+                          "; i--)" *newline*
+                          (lookup-variable rest-argument new-env) " = "
+                          "{car: arguments[i], cdr: " (lookup-variable rest-argument new-env) "};"
                           *newline*)
                   "")
               (concat (ls-compile-block (butlast body) new-env fenv)
@@ -457,6 +466,20 @@
 (define-compilation code-char (x)
   (concat "String.fromCharCode( " (ls-compile x env fenv) ")"))
 
+(define-compilation char (string index)
+  (concat "("
+          (ls-compile string env fenv)
+          ").charCodeAt("
+          (ls-compile index env fenv)
+          ")"))
+
+(define-compilation concat-two (string1 string2)
+  (concat "("
+          (ls-compile string1 env fenv)
+          ").concat("
+          (ls-compile string2 env fenv)
+          ")"))
+
 (define-compilation funcall (func &rest args)
   (concat "("
           (ls-compile func env fenv)