X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=6c173b942ec5d981444997881d57c05b22797c71;hb=d8cc32ffc4cb6502bd1efe75a49cebf80645b68a;hp=c8049bdac56123d5f52f00c0c737f02b07bd89df;hpb=946fde45498b65e0883ea74403a4b7d54bf31e1d;p=jscl.git

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index c8049bd..6c173b9 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -24,8 +24,6 @@
 
 #+ecmalisp
 (progn
-
-  'defmacro
   (eval-when-compile
     (%compile-defmacro 'defmacro
                        '(lambda (name args &rest body)
@@ -40,8 +38,23 @@
                                                    ,@body)))
                             ',name))))
 
+  (setq nil 'nil)
+  (setq t 't)
+
+  (defmacro when (condition &body body)
+    `(if ,condition (progn ,@body) nil))
+
+  (defmacro unless (condition &body body)
+    `(if ,condition nil (progn ,@body)))
+
   (defmacro defvar (name value)
     `(progn
+       (unless (boundp ',name)
+	 (setq ,name ,value))
+       ',name))
+
+  (defmacro defparameter (name value)
+    `(progn
        (setq ,name ,value)
        ',name))
 
@@ -59,9 +72,6 @@
 
   (defvar *package* (new))
 
-  (defvar nil 'nil)
-  (defvar t 't)
-
   (defun null (x)
     (eq x nil))
 
@@ -133,12 +143,6 @@
   (defmacro push (x place)
     `(setq ,place (cons ,x ,place)))
 
-  (defmacro when (condition &body body)
-    `(if ,condition (progn ,@body) nil))
-
-  (defmacro unless (condition &body body)
-    `(if ,condition nil (progn ,@body)))
-
   (defmacro dolist (iter &body body)
     (let ((var (first iter))
           (g!list (gensym)))
@@ -416,7 +420,20 @@
     (car alist))
 
   (defun string= (s1 s2)
-    (equal s1 s2)))
+    (equal s1 s2))
+
+  (defun fdefinition (x)
+    (cond
+      ((functionp x)
+       x)
+      ((symbolp x)
+       (symbol-function x))
+      (t
+       (error "Invalid function"))))
+
+  (defun disassemble (function)
+    (write-line (lambda-code (fdefinition function)))
+    nil))
 
 
 ;;; The compiler offers some primitives and special forms which are
@@ -798,6 +815,7 @@
   (reverse (remove-if #'null-or-empty-p *toplevel-compilations*)))
 
 (defun %compile-defmacro (name lambda)
+  (toplevel-compilation (ls-compile `',name))
   (push-to-lexenv (make-binding name 'macro lambda t) *environment* 'function))
 
 (defvar *compilations* nil)
@@ -955,18 +973,13 @@
     ((integerp sexp) (integer-to-string sexp))
     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
     ((symbolp sexp)
-     #+common-lisp
      (or (cdr (assoc sexp *literal-symbols*))
 	 (let ((v (genlit))
-	       (s (concat "{name: \"" (escape-string (symbol-name sexp)) "\"}")))
+	       (s #+common-lisp (concat "{name: \"" (escape-string (symbol-name sexp)) "\"}")
+		  #+ecmalisp (ls-compile `(intern ,(symbol-name sexp)))))
 	   (push (cons sexp v) *literal-symbols*)
 	   (toplevel-compilation (concat "var " v " = " s))
-	   v))
-     #+ecmalisp
-     (let ((v (genlit))
-           (s (ls-compile `(intern ,(symbol-name sexp)))))
-       (toplevel-compilation (concat "var " v " = " s))
-       v))
+	   v)))
     ((consp sexp)
      (let ((c (concat "{car: " (literal (car sexp) t) ", "
 		      "cdr: " (literal (cdr sexp) t) "}")))
@@ -1206,9 +1219,10 @@
 ;;; Primitives
 
 (defmacro define-builtin (name args &body body)
-  `(define-compilation ,name ,args
-     (let ,(mapcar (lambda (arg) `(,arg (ls-compile ,arg env))) args)
-       ,@body)))
+  `(progn
+     (define-compilation ,name ,args
+       (let ,(mapcar (lambda (arg) `(,arg (ls-compile ,arg env))) args)
+         ,@body))))
 
 ;;; DECLS is a list of (JSVARNAME TYPE LISPFORM) declarations.
 (defmacro type-check (decls &body body)
@@ -1296,10 +1310,13 @@
   (concat "(" x ").name"))
 
 (define-builtin set (symbol value)
-  (concat "(" symbol ").value =" value))
+  (concat "(" symbol ").value = " value))
 
 (define-builtin fset (symbol value)
-  (concat "(" symbol ").function =" value))
+  (concat "(" symbol ").function = " value))
+
+(define-builtin boundp (x)
+  (js!bool (concat "(" x ".value !== undefined)")))
 
 (define-builtin symbol-value (x)
   (js!selfcall
@@ -1318,6 +1335,9 @@
 (define-builtin symbol-plist (x)
   (concat "((" x ").plist || " (ls-compile nil) ")"))
 
+(define-builtin lambda-code (x)
+  (concat "(" x ").toString()"))
+
 
 (define-builtin eq    (x y) (js!bool (concat "(" x " === " y ")")))
 (define-builtin equal (x y) (js!bool (concat "(" x  " == " y ")")))
@@ -1414,8 +1434,8 @@
 (defun macro (x)
   (and (symbolp x)
        (let ((b (lookup-in-lexenv x *environment* 'function)))
-         (eq (binding-type b) 'macro)
-         b)))
+         (and (eq (binding-type b) 'macro)
+              b))))
 
 (defun ls-macroexpand-1 (form)
   (let ((macro-binding (macro (car form))))
@@ -1502,6 +1522,7 @@
                      `(oset *package* ,(symbol-name (car s))
                             (js-vref ,(cdr s))))
                    *literal-symbols*)
+         (setq *literal-symbols* ',*literal-symbols*)
          (setq *environment* ',*environment*)
          (setq *variable-counter* ,*variable-counter*)
          (setq *gensym-counter* ,*gensym-counter*)
@@ -1509,7 +1530,8 @@
 
   (eval-when-compile
     (toplevel-compilation
-     (ls-compile `(setq *literal-counter* ,*literal-counter*)))))
+     (ls-compile
+      `(setq *literal-counter* ,*literal-counter*)))))
 
 
 ;;; Finally, we provide a couple of functions to easily bootstrap