projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Replace INTERNP by FIND-SYMBOL
[jscl.git]
/
ecmalisp.lisp
diff --git
a/ecmalisp.lisp
b/ecmalisp.lisp
index
57f793b
..
562f1f8
100644
(file)
--- a/
ecmalisp.lisp
+++ b/
ecmalisp.lisp
@@
-71,17
+71,13
@@
(defmacro while (condition &body body)
`(block nil (%while ,condition ,@body)))
(defmacro while (condition &body body)
`(block nil (%while ,condition ,@body)))
- (defun internp (name)
- (in name *package*))
-
- (defun intern (name)
- (if (internp name)
- (oget *package* name)
- (oset *package* name (make-symbol name))))
-
(defun find-symbol (name)
(oget *package* name))
(defun find-symbol (name)
(oget *package* name))
+ (defun intern (name)
+ (let ((s (find-symbol name)))
+ (if s s (oset *package* name (make-symbol name)))))
+
(defvar *gensym-counter* 0)
(defun gensym (&optional (prefix "G"))
(setq *gensym-counter* (+ *gensym-counter* 1))
(defvar *gensym-counter* 0)
(defun gensym (&optional (prefix "G"))
(setq *gensym-counter* (+ *gensym-counter* 1))
@@
-416,7
+412,20
@@
(car alist))
(defun string= (s1 s2)
(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
;;; The compiler offers some primitives and special forms which are
@@
-955,18
+964,12
@@
((integerp sexp) (integer-to-string sexp))
((stringp sexp) (concat "\"" (escape-string sexp) "\""))
((symbolp sexp)
((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)) "\"}")))
(push (cons sexp v) *literal-symbols*)
(toplevel-compilation (concat "var " v " = " s))
(or (cdr (assoc sexp *literal-symbols*))
(let ((v (genlit))
(s (concat "{name: \"" (escape-string (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) "}")))
((consp sexp)
(let ((c (concat "{car: " (literal (car sexp) t) ", "
"cdr: " (literal (cdr sexp) t) "}")))
@@
-1206,9
+1209,10
@@
;;; Primitives
(defmacro define-builtin (name args &body body)
;;; 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)
;;; DECLS is a list of (JSVARNAME TYPE LISPFORM) declarations.
(defmacro type-check (decls &body body)
@@
-1315,6
+1319,13
@@
"if (func === undefined) throw \"Function `\" + symbol.name + \"' is undefined.\";" *newline*
"return func;" *newline*))
"if (func === undefined) throw \"Function `\" + symbol.name + \"' is undefined.\";" *newline*
"return func;" *newline*))
+(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 ")")))
(define-builtin eq (x y) (js!bool (concat "(" x " === " y ")")))
(define-builtin equal (x y) (js!bool (concat "(" x " == " y ")")))
@@
-1410,8
+1421,8
@@
(defun macro (x)
(and (symbolp x)
(let ((b (lookup-in-lexenv x *environment* 'function)))
(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))))
(defun ls-macroexpand-1 (form)
(let ((macro-binding (macro (car form))))
@@
-1498,6
+1509,7
@@
`(oset *package* ,(symbol-name (car s))
(js-vref ,(cdr s))))
*literal-symbols*)
`(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*)
(setq *environment* ',*environment*)
(setq *variable-counter* ,*variable-counter*)
(setq *gensym-counter* ,*gensym-counter*)
@@
-1505,7
+1517,8
@@
(eval-when-compile
(toplevel-compilation
(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
;;; Finally, we provide a couple of functions to easily bootstrap