(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)
(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))
(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"))
((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>"))))
(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)))
(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)
(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)
(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 ")")))
(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)
(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)