X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=ad61676e0a154db2df22a0e89ed3787ca56268fa;hb=69f4ead4d3a5f853780816b07e4408abcbc21cfc;hp=4a274133e68418e58f875825f528b228a9d8e9e2;hpb=2cfa0e65959624b3ed1caebb829e829ed50e5a6f;p=jscl.git

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 4a27413..ad61676 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1,4 +1,4 @@
-;;; compiler.lisp --- 
+;;; compiler.lisp ---
 
 ;; copyright (C) 2012, 2013 David Vazquez
 ;; Copyright (C) 2012 Raimon Grau
@@ -558,7 +558,7 @@
     ((floatp sexp) (float-to-string sexp))
     ((characterp sexp) (code "\"" (escape-string (string sexp)) "\""))
     (t
-     (or (cdr (assoc sexp *literal-table* :test #'equal))
+     (or (cdr (assoc sexp *literal-table* :test #'eql))
          (let ((dumped (typecase sexp
                          (symbol (dump-symbol sexp))
                          (string (dump-string sexp))
@@ -719,7 +719,7 @@
                         variables)
                 ",")
           "){" *newline*
-          (let ((body (ls-compile-block body t)))
+          (let ((body (ls-compile-block body t t)))
             (indent (let-binding-wrapper dynamic-bindings body)))
           "})(" (join cvalues ",") ")")))
 
@@ -767,7 +767,7 @@
     (js!selfcall
       (let ((specials (remove-if-not #'special-variable-p (mapcar #'first bindings)))
             (body (concat (mapconcat #'let*-initialize-value bindings)
-                          (ls-compile-block body t))))
+                          (ls-compile-block body t t))))
         (let*-binding-wrapper specials body)))))
 
 
@@ -1324,6 +1324,7 @@
 (define-builtin-comparison >= ">=")
 (define-builtin-comparison <= "<=")
 (define-builtin-comparison = "==")
+(define-builtin-comparison /= "!=")
 
 (define-builtin numberp (x)
   (js!bool (code "(typeof (" x ") == \"number\")")))
@@ -1390,6 +1391,9 @@
 (define-builtin boundp (x)
   (js!bool (code "(" x ".value !== undefined)")))
 
+(define-builtin fboundp (x)
+  (js!bool (code "(" x ".fvalue !== undefined)")))
+
 (define-builtin symbol-value (x)
   (js!selfcall
     "var symbol = " x ";" *newline*
@@ -1524,57 +1528,58 @@
 (define-builtin in (key object)
   (js!bool (code "(xstring(" key ") in (" object "))")))
 
+(define-builtin map-for-in (function object)
+  (js!selfcall
+   "var f = " function ";" *newline*
+   "var g = (typeof f === 'function' ? f : f.fvalue);" *newline*
+   "var o = " object ";" *newline*
+   "for (var key in o){" *newline*
+   (indent "g(" (if *multiple-value-p* "values" "pv") ", 1, o[key]);" *newline*)
+   "}"
+   " return " (ls-compile nil) ";" *newline*))
+
 (define-builtin functionp (x)
   (js!bool (code "(typeof " x " == 'function')")))
 
 (define-builtin write-string (x)
   (code "lisp.write(" x ")"))
 
-(define-builtin make-array (n)
-  (js!selfcall
-    "var r = [];" *newline*
-    "for (var i = 0; i < " n "; i++)" *newline*
-    (indent "r.push(" (ls-compile nil) ");" *newline*)
-    "return r;" *newline*))
 
-;;; FIXME: should take optional min-extension.
-;;; FIXME: should use fill-pointer instead of the absolute end of array
-(define-builtin vector-push-extend (new vector)
-  (js!selfcall
-    "var v = " vector ";" *newline*
-    "v.push(" new ");" *newline*
-    "return v;"))
+;;; Storage vectors. They are used to implement arrays and (in the
+;;; future) structures.
 
-(define-builtin arrayp (x)
+(define-builtin storage-vector-p (x)
   (js!bool
    (js!selfcall
      "var x = " x ";" *newline*
      "return typeof x === 'object' && 'length' in x;")))
 
-(define-builtin aref (array n)
+(define-builtin make-storage-vector (n)
   (js!selfcall
-    "var x = " "(" array ")[" n "];" *newline*
+    "var r = [];" *newline*
+    "r.length = " n ";" *newline*
+    "return r;" *newline*))
+
+(define-builtin storage-vector-size (x)
+  (code x ".length"))
+
+(define-builtin resize-storage-vector (vector new-size)
+  (code "(" vector ".length = " new-size ")"))
+
+(define-builtin storage-vector-ref (vector n)
+  (js!selfcall
+    "var x = " "(" vector ")[" n "];" *newline*
     "if (x === undefined) throw 'Out of range';" *newline*
     "return x;" *newline*))
 
-(define-builtin aset (array n value)
+(define-builtin storage-vector-set (vector n value)
   (js!selfcall
-    "var x = " array ";" *newline*
+    "var x = " vector ";" *newline*
     "var i = " n ";" *newline*
     "if (i < 0 || i >= x.length) throw 'Out of range';" *newline*
     "return x[i] = " value ";" *newline*))
 
-(define-builtin afind (value array)
-  (js!selfcall
-    "var v = " value ";" *newline*
-    "var x = " array ";" *newline*
-    "return x.indexOf(v);" *newline*))
 
-(define-builtin aresize (array new-size)
-  (js!selfcall
-    "var x = " array ";" *newline*
-    "var n = " new-size ";" *newline*
-    "return x.length = n;" *newline*))
 
 (define-builtin get-internal-real-time ()
   "(new Date()).getTime()")
@@ -1672,13 +1677,16 @@
       (t
        (code (ls-compile `#',function) arglist)))))
 
-(defun ls-compile-block (sexps &optional return-last-p)
-  (if return-last-p
-      (code (ls-compile-block (butlast sexps))
-            "return " (ls-compile (car (last sexps)) *multiple-value-p*) ";")
-      (join-trailing
-       (remove-if #'null-or-empty-p (mapcar #'ls-compile sexps))
-       (concat ";" *newline*))))
+(defun ls-compile-block (sexps &optional return-last-p decls-allowed-p)
+  (multiple-value-bind (sexps decls)
+      (parse-body sexps :declarations decls-allowed-p)
+    (declare (ignore decls))
+    (if return-last-p
+        (code (ls-compile-block (butlast sexps) nil decls-allowed-p)
+              "return " (ls-compile (car (last sexps)) *multiple-value-p*) ";")
+        (join-trailing
+         (remove-if #'null-or-empty-p (mapcar #'ls-compile sexps))
+         (concat ";" *newline*)))))
 
 (defun ls-compile (sexp &optional multiple-value-p)
   (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp)