#+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)
((symbolp sexp)
(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)))
;;; 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 ")")))