git » jacl.git » commit 9b72a51

diff --git a/boot.lisp b/boot.lisp
index 1a0619d..6e6a5d8 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -26,101 +26,175 @@
        (jacl:%lambda ,params ,@body))
      ',name))
 
-(defun export (symbol &optional (package *package*))
+(defun %export (symbol &optional (package *package*))
   (\. package (|exportSymbol| (\. symbol |name|))))
 
-(export 'export)
-
-(export 'set)
-(defun set (symbol value)
-  (%js "(~{}.value = ~{})" symbol value))
-
-(export 'let)
+(%export 'let)
 (defmacro let (bindings &rest body)
   `(jacl:%let ,bindings ,@body))
 
-(export 'if)
+(%export 'if)
 (defmacro if (test true-form &optional else-form)
   `(jacl:%if ,test ,true-form ,else-form))
 
-(export 'progn)
+(%export 'progn)
 (defmacro progn (&rest forms)
   `(jacl:%progn ,@forms))
 
-(export 'when)
+(%export 'when)
 (defmacro when (test &rest forms)
   `(if ,test (progn ,@forms)))
 
-(export 'defvar)
+(%export 'defvar)
 (defmacro defvar (symbol &optional (value nil value?))
   `(progn
     (jacl:%js "~{}.isSpecial = true" ',symbol)
     (when (jacl:%js "(((~{}.value === UNDEFINED) && ~{}) ? true : null)" ',symbol ,value?)
-      (set ',symbol ,value))
+      (jacl:%js "(~{}.value = ~{})" ',symbol ',value))
     ',symbol))
 
-(export 'eq)
+(%export 'eq)
 (defun eq (x y)
   (jacl:%js "~{} === ~{} ? true : null" x y))
 
-(export 'null)
+(%export 'null)
 (defun null (x) (eq x nil))
 
-(export 'not)
+(%export 'not)
 (defun not (x) (eq x nil))
 
-(export 'car)
+(%export 'cons)
+(defun cons (car cdr)
+  (jacl:%new (jacl:%js "Cons") car cdr))
+
+(%export 'car)
 (defun car (x)
   (when (not (null x))
     (jacl:\. x |car|)))
 
-(export 'cdr)
+(%export 'cdr)
 (defun cdr (x)
   (when (not (null x))
     (jacl:\. x |cdr|)))
 
-(export 'caar)
+(%export 'caar)
 (defun caar (x)
   (car (car x)))
 
-(export 'cadar)
+(%export 'cadar)
 (defun cadar (x)
   (car (cdr (car x))))
 
-(export 'cond)
+(%export 'cond)
 (defmacro cond (&rest clauses)
   (when clauses
     `(if ,(caar clauses)
          ,(cadar clauses)
        (cond ,@(cdr clauses)))))
 
-(export 'numberp)
+(%export 'numberp)
 (defun numberp (x)
   (jacl:%js "typeof ~{} === 'number' ? true : null" x))
 
-(export 'stringp)
+(%export 'integerp)
+(defun integerp (x)
+  (jacl:%js "(typeof ~{} === 'number') && (Math.floor(~{}) === ~{}) ? true : null" x x x))
+
+(%export 'stringp)
 (defun stringp (x)
   (jacl:%js "~{} instanceof LispString ? true : null" x))
 
-(export 'symbolp)
+(%export 'symbolp)
 (defun symbolp (x)
   (jacl:%js "~{} instanceof LispSymbol ? true : null" x))
 
-(export 'tagbody)
+(%export 'consp)
+(defun consp (x)
+  (jacl:%js "~{} instanceof Cons ? true : null" x))
+
+(%export 'tagbody)
 (defmacro tagbody (&rest body)
   `(jacl:%tagbody ,@body))
 
-(export 'go)
+(%export 'go)
 (defmacro go (tag)
   `(jacl:%go ,tag))
 
+(%export '*gensym-counter*)
+(defvar *gensym-counter* 0)
+
+(defmacro %type-error (expected-type)
+  `(jacl:%throw
+    (jacl:%new (jacl:%js "TypeError")
+               (jacl:%js "'Not a ' + ~{}.toString()" ,expected-type))))
+
+(%export 'set)
+(defun set (symbol value)
+  (when (not (symbolp symbol))
+    (%type-error "symbol"))
+  (jacl:%js "(~{}.value = ~{})" symbol value))
+
+(%export '1+)
+(defun 1+ (x)
+  (when (not (numberp x))
+    (%type-error "number"))
+  (jacl:%js "~{}+1" x))
+
+(%export 'gensym)
+(defun gensym (&optional (x nil x?))
+  (cond ((stringp x)
+         (jacl:%new (jacl:%js "LispSymbol")
+                    (jacl:%js "~{}+~{}.toString()" x *gensym-counter*)))
+        ((numberp x)
+         (jacl:%new (jacl:%js "LispSymbol")
+                    (jacl:%js "'G'+~{}.toString()" x)))
+        ((not x)
+         (let ((sym (jacl:%new (jacl:%js "LispSymbol")
+                               (jacl:%js "'G'+~{}.toString()" *gensym-counter*))))
+           (set '*gensym-counter* (1+ *gensym-counter*))
+           sym))
+        (t (%type-error "string or integer"))))
+
+(%export 'or)
+(defmacro or (&rest forms)
+  (when forms
+    (let ((x (gensym)))
+      `(let ((,x ,(car forms)))
+         (if ,x ,x (or ,@(cdr forms)))))))
+
+(%export 'and)
+(defmacro and (&rest forms)
+  (if forms
+      (let ((x (gensym)))
+        `(let ((,x ,(car forms)))
+           (when ,x (and ,@(cdr forms)))))
+      t))
+
+(%export 'listp)
+(defun listp (x)
+  (or (null x) (consp x)))
+
 (defun designated-string (x)
   (cond ((stringp x) x)
         ((symbolp x)
          (jacl:\. (jacl:%js "LispString") (|fromString| (jacl:\. x |name|))))
-        (t (jacl:%throw
-            (jacl:%new (jacl:%js "TypeError")
-                       (jacl:\. "Not a string designator" (|toString|)))))))
+        (t (%type-error "string or symbol"))))
+
+(defun designated-symbols (x)
+  (cond ((symbolp x) (list x))
+        ((listp x) x)
+        (t (%type-error "symbol or list of symbols"))))
+
+;; TODO
+(%export 'export)
+(defun export (symbols &optional (package *package*))
+  (let ((syms (designated-symbols symbols)))
+    (tagbody
+     start
+     (when syms
+       (%export (car syms) package)
+       (jacl:%setq syms (cdr syms))
+       (go start)))))
 
 ;; Use COMMON-LISP from COMMON-LISP-USER and switch to
 ;; COMMON-LISP-USER