#+ecmalisp
(progn
-
- 'defmacro
(eval-when-compile
(%compile-defmacro 'defmacro
'(lambda (name args &rest body)
,@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))
(defvar *package* (new))
- (defvar nil 'nil)
- (defvar t 't)
-
(defun null (x)
(eq x nil))
(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)))
(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
(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)
((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) "}")))
;;; 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)
(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
(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 ")")))
(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))))
`(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*)
(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