projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix spacing in !parse-integer
[jscl.git]
/
ecmalisp.lisp
diff --git
a/ecmalisp.lisp
b/ecmalisp.lisp
index
bbc6340
..
21ef044
100644
(file)
--- a/
ecmalisp.lisp
+++ b/
ecmalisp.lisp
@@
-533,6
+533,14
@@
(return-from every nil)))
t)
(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))
(defun assoc (x alist)
(while alist
(if (eql x (caar alist))
@@
-958,7
+966,9
@@
"()"
(prin1-to-string (vector-to-list form)))))
((packagep form)
"()"
(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)
(defun write-line (x)
(write-string x)
@@
-1122,31
+1132,31
@@
(defun !parse-integer (string junk-allow)
(block nil
(let ((value 0)
(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)
(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)
;; 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)
(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
(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)
#+ecmalisp
(defun parse-integer (string)
@@
-2712,6
+2722,15
@@
(t
(error (concat "How should I compile " (prin1-to-string sexp) "?"))))))
(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
(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
(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*))
(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)))
(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))
(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)
*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)))