X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=21ef044cae05670416a96ad79a03c766ac24ed82;hb=1feb6093af9417a611ecd57c25f3f69cc9dff73b;hp=bbc6340f6a15f6606276dd83b3c1808a405b9ddd;hpb=c9e8ef61e01075a7db5de4f8f493161be8799940;p=jscl.git

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index bbc6340..21ef044 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -533,6 +533,14 @@
         (return-from every nil)))
     t)
 
+  (defun position (elt sequence)
+    (let ((pos 0))
+      (do-sequence (x seq)
+        (when (eq elt x)
+          (return))
+        (incf pos))
+      pos))
+
   (defun assoc (x alist)
     (while alist
       (if (eql x (caar alist))
@@ -958,7 +966,9 @@
                        "()"
                        (prin1-to-string (vector-to-list form)))))
       ((packagep form)
-       (concat "#<PACKAGE " (package-name form) ">"))))
+       (concat "#<PACKAGE " (package-name form) ">"))
+      (t
+       (concat "#<javascript object>"))))
 
   (defun write-line (x)
     (write-string x)
@@ -1122,31 +1132,31 @@
 (defun !parse-integer (string junk-allow)
   (block nil
     (let ((value 0)
-	  (index 0)
-	  (size (length string))
-	  (sign 1))
+          (index 0)
+          (size (length string))
+          (sign 1))
       (when (zerop size) (return (values nil 0)))
       ;; Optional sign
       (case (char string 0)
-	(#\+ (incf index))
-	(#\- (setq sign -1)
-	     (incf index)))
+        (#\+ (incf index))
+        (#\- (setq sign -1)
+             (incf index)))
       ;; First digit
       (unless (and (< index size)
-		   (setq value (digit-char-p (char string index))))
-	(return (values nil index)))
+                   (setq value (digit-char-p (char string index))))
+        (return (values nil index)))
       (incf index)
       ;; Other digits
       (while (< index size)
-	(let ((digit (digit-char-p (char string index))))
-	  (unless digit (return))
-	  (setq value (+ (* value 10) digit))
-	  (incf index)))
+        (let ((digit (digit-char-p (char string index))))
+          (unless digit (return))
+          (setq value (+ (* value 10) digit))
+          (incf index)))
       (if (or junk-allow
-	      (= index size)
-	      (char= (char string index) #\space))
-	  (values (* sign value) index)
-	  (values nil index)))))
+              (= index size)
+              (char= (char string index) #\space))
+          (values (* sign value) index)
+          (values nil index)))))
 
 #+ecmalisp
 (defun parse-integer (string)
@@ -2712,6 +2722,15 @@
       (t
        (error (concat "How should I compile " (prin1-to-string sexp) "?"))))))
 
+
+(defvar *compile-print-toplevels* nil)
+
+(defun truncate-string (string &optional (width 60))
+    (let ((size (length string))
+          (n (or (position #\newline string)
+                 (min width (length string)))))
+      (subseq string 0 n)))
+
 (defun ls-compile-toplevel (sexp &optional multiple-value-p)
   (let ((*toplevel-compilations* nil))
     (cond
@@ -2721,6 +2740,12 @@
                            (cdr sexp))))
          (join (remove-if #'null-or-empty-p subs))))
       (t
+       (when *compile-print-toplevels*
+         (let ((form-string (prin1-to-string sexp)))
+           (write-string "Compiling ")
+           (write-string (truncate-string form-string))
+           (write-line "...")))
+       
        (let ((code (ls-compile sexp multiple-value-p)))
          (code (join-trailing (get-toplevel-compilations)
                               (code ";" *newline*))
@@ -2804,8 +2829,9 @@
         (read-sequence seq in)
         seq)))
 
-  (defun ls-compile-file (filename output)
-    (let ((*compiling-file* t))
+  (defun ls-compile-file (filename output &key print)
+    (let ((*compiling-file* t)
+          (*compile-print-toplevels* print))
       (with-open-file (out output :direction :output :if-exists :supersede)
         (write-string (read-whole-file "prelude.js") out)
         (let* ((source (read-whole-file filename))
@@ -2824,4 +2850,4 @@
           *gensym-counter* 0
           *literal-counter* 0
           *block-counter* 0)
-    (ls-compile-file "ecmalisp.lisp" "ecmalisp.js")))
+    (ls-compile-file "ecmalisp.lisp" "ecmalisp.js" :print t)))