X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=fa5dcc5f983122a9a68b7afbd887842481027578;hb=5a05b2053cf76ea53701c11072073994dbd31de8;hp=41c06f06950eb3ed98b5ba023a21d0063fdf5465;hpb=9bc9d7edc40c65d7803043f01e4db2389d5e0211;p=jscl.git

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index 41c06f0..fa5dcc5 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -47,7 +47,7 @@
   (defmacro named-lambda (name args &rest body)
     (let ((x (gensym "FN")))
       `(let ((,x (lambda ,args ,@body)))
-         (set ,x "fname" ,name)
+         (oset ,x "fname" ,name)
          ,x)))
 
   (defmacro %defun (name args &rest body)
@@ -63,10 +63,10 @@
   (defvar *package* (new))
 
   (defvar nil (make-symbol "NIL"))
-  (set *package* "NIL" nil)
+  (oset *package* "NIL" nil)
 
   (defvar t (make-symbol "T"))
-  (set *package* "T" t)
+  (oset *package* "T" t)
 
   (defun null (x)
     (eq x nil))
@@ -82,11 +82,11 @@
 
   (defun intern (name)
     (if (internp name)
-        (get *package* name)
-        (set *package* name (make-symbol name))))
+        (oget *package* name)
+        (oset *package* name (make-symbol name))))
 
   (defun find-symbol (name)
-    (get *package* name))
+    (oget *package* name))
 
   (defvar *gensym-counter* 0)
   (defun gensym (&optional (prefix "G"))
@@ -562,7 +562,7 @@
       ((integerp form) (integer-to-string form))
       ((stringp form) (concat "\"" (escape-string form) "\""))
       ((functionp form)
-       (let ((name (get form "fname")))
+       (let ((name (oget form "fname")))
          (if name
              (concat "#<FUNCTION " name ">")
              (concat "#<FUNCTION>"))))
@@ -792,7 +792,7 @@
   (or (lookup-in-lexenv symbol env 'variable)
       (lookup-in-lexenv symbol *environment* 'variable)
       (let ((name (symbol-name symbol))
-            (binding (make-binding symbol 'variable (gvarname symbol) nil)))
+            (binding (make-binding symbol 'special-variable (gvarname symbol) nil)))
         (push-to-lexenv binding *environment* 'variable)
         (push (lambda ()
 		(let ((b (lookup-in-lexenv symbol *environment* 'variable)))
@@ -807,7 +807,7 @@
 (defun extend-local-env (args env)
   (let ((new (copy-lexenv env)))
     (dolist (symbol args new)
-      (let ((b (make-binding symbol 'variable (gvarname symbol) t)))
+      (let ((b (make-binding symbol 'lexical-variable (gvarname symbol) t)))
         (push-to-lexenv b new 'variable)))))
 
 (defvar *function-counter* 0)
@@ -968,9 +968,11 @@
           (ls-compile val env)))
 
 (define-compilation setq (var val)
-  (concat (lookup-variable-translation var env)
-          " = "
-           (ls-compile val env)))
+  (let ((b (lookup-variable var env)))
+    (ecase (binding-type b)
+      (lexical-variable (concat (binding-translation b) " = " (ls-compile val env)))
+      (special-variable (ls-compile `(set ',var ,val) env)))))
+
 
 ;;; Literals
 (defun escape-string (string)
@@ -1317,6 +1319,15 @@
 (define-builtin symbol-name (x)
   (concat "(" x ").name"))
 
+(define-builtin set (symbol value)
+  (concat "(" symbol ").value =" value))
+
+(define-builtin symbol-value (x)
+  (concat "(" x ").value"))
+
+(define-builtin symbol-function (x)
+  (concat "(" x ").function"))
+
 (define-builtin eq    (x y) (js!bool (concat "(" x " === " y ")")))
 (define-builtin equal (x y) (js!bool (concat "(" x  " == " y ")")))
 
@@ -1391,12 +1402,12 @@
 
 (define-builtin new () "{}")
 
-(define-builtin get (object key)
+(define-builtin oget (object key)
   (js!selfcall
     "var tmp = " "(" object ")[" key "];" *newline*
     "return tmp == undefined? " (ls-compile nil) ": tmp ;" *newline*))
 
-(define-builtin set (object key value)
+(define-builtin oset (object key value)
   (concat "((" object ")[" key "] = " value ")"))
 
 (define-builtin in (key object)
@@ -1438,7 +1449,13 @@
 
 (defun ls-compile (sexp &optional (env (make-lexenv)))
   (cond
-    ((symbolp sexp) (lookup-variable-translation sexp env))
+    ((symbolp sexp)
+     (let ((b (lookup-variable sexp env)))
+       (ecase (binding-type b)
+	 (lexical-variable
+	  (lookup-variable-translation sexp env))
+	 (special-variable
+	  (ls-compile `(symbol-value ',sexp) env)))))
     ((integerp sexp) (integer-to-string sexp))
     ((stringp sexp) (concat "\"" (escape-string sexp) "\""))
     ((listp sexp)