git » jacl.git » commit bc88098

diff --git a/boot.lisp b/boot.lisp
index 5d18240..aa0876f 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -29,14 +29,14 @@
 (%js "(~{}.fvalue = ~{})"
      '%internal-name
      (%lambda %internal-name nil (prefix-string name)
-       (\. (%js "Package")
-           (|get| (\. "JACL" (|toString|)))
-           (|intern|
-            (%js
-             "('INTERNAL-' + ~{}.toString() + '-' + (~{} === null ? 'NIL' : ~{}.name))"
-             prefix-string
-             name
-             name)))))
+              (\. (%js "Package")
+                  (|get| (\. "JACL" (|toString|)))
+                  (|intern|
+                   (%js
+                    "('INTERNAL-' + ~{}.toString() + '-' + (~{} === null ? 'NIL' : ~{}.name))"
+                    prefix-string
+                    name
+                    name)))))
 
 (\. *package* (|exportSymbol| (\. 'block |name|)))
 (%js "(~{}.setMacro().fvalue = ~{})"
@@ -48,9 +48,9 @@
         (vname# (%internal-name "BLOCK-VALUE" block-name))
         (labelname# (%internal-name "BLOCK-LABEL" block-name)))
        `(%let ((,vname# nil))
-              (jacl:%tagbody (%setq ,vname# (%progn ,@forms))
-                             ,labelname#)
-              ,vname#)))
+          (jacl:%tagbody (%setq ,vname# (%progn ,@forms))
+                         ,labelname#)
+          ,vname#)))
 
 (%js "(~{}.fvalue = ~{})"
      '%has-declare?
@@ -69,28 +69,28 @@
         (vname# (%internal-name "BLOCK-VALUE" nil))
         (labelname# (%internal-name "BLOCK-LABEL" nil)))
        `(jacl:%progn
-          (jacl:%js "(~{}.setMacro().fvalue = ~{})"
-            ',name
-            (jacl:%lambda nil t
-              ,params
-              ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
-              (block ,name ,@(%if (%has-declare? body)
-                                  (%js "~{}.cdr" body)
-                                  body))))
-          ',name)))
+         (jacl:%js "(~{}.setMacro().fvalue = ~{})"
+                   ',name
+                   (jacl:%lambda nil t
+                     ,params
+                     ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
+                     (block ,name ,@(%if (%has-declare? body)
+                                         (%js "~{}.cdr" body)
+                                         body))))
+         ',name)))
 
 (\. *package* (|exportSymbol| (\. 'defun |name|)))
 (defmacro defun (name params &rest body)
   `(jacl:%progn
-     (jacl:%js "(~{}.fvalue = ~{})"
-       ',name
-       (jacl:%lambda ,name nil
-         ,params
-         ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
-         (block ,name ,@(%if (%has-declare? body)
-                             (%js "~{}.cdr" body)
-                             body))))
-     ',name))
+    (jacl:%js "(~{}.fvalue = ~{})"
+              ',name
+              (jacl:%lambda ,name nil
+                ,params
+                ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
+                (block ,name ,@(%if (%has-declare? body)
+                                    (%js "~{}.cdr" body)
+                                    body))))
+    ',name))
 
 (defun %export (symbol &optional (package *package*))
   (\. package (|exportSymbol| (\. symbol |name|))))
@@ -146,10 +146,10 @@
 (%export 'defvar)
 (defmacro defvar (symbol &optional (value nil value?))
   `(progn
-    (jacl:%js "~{}.isSpecial = true" ',symbol)
-    (when (jacl:%js "(((~{}.value === UNDEFINED) && ~{}) ? true : null)" ',symbol ,value?)
-      (jacl:%js "(~{}.value = ~{})" ',symbol ,value))
-    ',symbol))
+     (jacl:%js "~{}.isSpecial = true" ',symbol)
+     (when (jacl:%js "(((~{}.value === UNDEFINED) && ~{}) ? true : null)" ',symbol ,value?)
+       (jacl:%js "(~{}.value = ~{})" ',symbol ,value))
+     ',symbol))
 
 (%export 'eq)
 (defun eq (x y)
@@ -211,7 +211,7 @@
   (when clauses
     `(if ,(caar clauses)
          ,(cadar clauses)
-       (cond ,@(cdr clauses)))))
+         (cond ,@(cdr clauses)))))
 
 (%export 'numberp)
 (defun numberp (x)
@@ -385,24 +385,24 @@
         (tail nil))
     (tagbody
      start
-     (when (not pairs) (go end))
-     (when (not head)
-       (jacl:%setq head (list (funcall fun (car pairs) (cadr pairs))))
-       (jacl:%setq tail head)
-       (go next))
-     (let ((new-tail (list (funcall fun (car pairs) (cadr pairs)))))
-       (rplacd tail new-tail)
-       (jacl:%setq tail new-tail))
+       (when (not pairs) (go end))
+       (when (not head)
+         (jacl:%setq head (list (funcall fun (car pairs) (cadr pairs))))
+         (jacl:%setq tail head)
+         (go next))
+       (let ((new-tail (list (funcall fun (car pairs) (cadr pairs)))))
+         (rplacd tail new-tail)
+         (jacl:%setq tail new-tail))
      next
-     (jacl:%setq pairs (cddr pairs))
-     (go start)
+       (jacl:%setq pairs (cddr pairs))
+       (go start)
      end)
     head))
 
 (%export 'setq)
 (defmacro setq (&rest pairs)
   `(cl:progn
-    ,@(%map-pairs (lambda (x y) `(jacl:%setq ,x ,y)) pairs)))
+     ,@(%map-pairs (lambda (x y) `(jacl:%setq ,x ,y)) pairs)))
 
 (%export 'zerop)
 (defun zerop (x)
@@ -426,15 +426,15 @@
   (let ((ret t))
     (tagbody
      start
-     (when (not more-numbers) (go end))
-     (when (not (%> number (car more-numbers)))
-       (setq ret nil)
-       (go end))
-     (setq number       (car more-numbers)
-           more-numbers (cdr more-numbers))
-     (when (not (numberp number))
-       (%type-error "number"))
-     (go start)
+       (when (not more-numbers) (go end))
+       (when (not (%> number (car more-numbers)))
+         (setq ret nil)
+         (go end))
+       (setq number       (car more-numbers)
+             more-numbers (cdr more-numbers))
+       (when (not (numberp number))
+         (%type-error "number"))
+       (go start)
      end)
     ret))
 
@@ -446,17 +446,17 @@
         (i   0))
     (tagbody
      start
-     (when (not (numberp num))
-       (%type-error "number"))
-     (when (eql i len) 
-       (go end))
-     (let ((x (%aref nums i)))
-       (when (not (%< num x)) 
-         (setq ret nil)
+       (when (not (numberp num))
+         (%type-error "number"))
+       (when (eql i len)
          (go end))
-       (setq num x
-             i   (1+ i)))
-     (go start)
+       (let ((x (%aref nums i)))
+         (when (not (%< num x))
+           (setq ret nil)
+           (go end))
+         (setq num x
+               i   (1+ i)))
+       (go start)
      end)
     ret))
 
@@ -475,49 +475,22 @@
         (result-form (caddr binding))
         (begin#      (gensym "begin"))
         (end#        (gensym "end")))
-    ;; (\. (%js "console") (|log|(funcall (%js "prstr") binding)))
-    ;; (\. (%js "console") (|log|(funcall (%js "prstr") var)))
-    ;; (\. (%js "console") (|log|(funcall (%js "prstr") list#)))
-    ;; (\. (%js "console") (|log|(funcall (%js "prstr") result-form)))
-    ;; (\. (%js "console") (|log|(funcall (%js "prstr") begin#)))
-    ;; (\. (%js "console") (|log|(funcall (%js "prstr") end#)))
     `(block nil
        (let ((,var   nil)
              (,list# ,(cadr binding)))
-         ;; (\. (%js "console") (|log|(funcall (%js "prstr") "here1")))
-         ;; (\. (%js "console") (|log|(funcall (%js "prstr") ,list#)))
-         ;; (\. (%js "console") (|log| ,list#))
          (tagbody
-          ,begin#
-          (if (null ,list#) (go ,end#))
-          (setq ,var (car ,list#))
-          ,@body
-          (setq ,list# (cdr ,list#))
-          (go ,begin#)
-          ,end#)
+            ,begin#
+            (if (null ,list#) (go ,end#))
+            (setq ,var (car ,list#))
+            ,@body
+            (setq ,list# (cdr ,list#))
+            (go ,begin#)
+            ,end#)
          (setq ,var nil)
          ,result-form))))
 
 ;; designators
 
-(%export 'string=)
-(defun string= (string1 string2 &key start1 end1 start2 end2)
-  (when (or (not (stringp string1))
-            (not (stringp string2)))
-    (%type-error "string"))
-  (dolist (x (list start1 end1 start2 end2))
-    (when (and x (not (numberp x)))
-      (%type-error "number")))
-  ;; TODO DO would be good here
-  (let ((start1 (or start1 0))
-        (end1   (or end1 (1- (\. string1 |length|))))
-        (start2 (or start2 0))
-        (end2   (or end2 (1- (\. string2 |length|)))))
-    (%js "for (let i = ~{}, j = ~{}; i < ~{} && j < ~{}; i++, j++) {
-      if (~{}[i] !== ~{}[j]) return null;
-    }" start1 start2 end1 end2 string1 string2)
-    t))
-
 (defun %designated-string (x)
   (cond ((stringp x) x)
         ((symbolp x)
@@ -554,17 +527,6 @@
       (apply (symbol-function (car form)) env form (cdr form))
       form))
 
-;;
-;;(%export 'functionp)
-;;(defun functionp (x)
-;;  (jacl:%js "~{} instanceof Function ? true : null" x))
-;;
-;;(%export 'funcall)
-;;(defun funcall (f &rest args)
-;;  (when (not (functionp f))
-;;    (%type-error "function"))
-;;  (jacl:%js "~{}.call(null, List.toArray(~{}))" f args))
-;;
 ;;(%export 'export)
 ;;(defun export (symbols &optional (package *package*))
 ;;  (let ((syms (designated-symbols symbols)))
@@ -580,3 +542,7 @@
 (%let ((cl-user-pkg (\. (%js "Package") (|get| (\. '#:common-lisp-user |name|)))))
   (\. cl-user-pkg (|usePackage| cl:*package*))
   (%setq cl:*package* cl-user-pkg))
+
+;; Local Variables:
+;; eval: (put '%let 'lisp-indent-function 1)
+;; End: