vice-versa.")
(defvar *indent-level*)
-(defvar *print-accumulator*)
-(defmethod parenscript-print (form)
+(defvar *psw-stream*)
+
+(defun parenscript-print (form immediate?)
+ (declare (special immediate?))
(let ((*indent-level* 0)
- (*print-accumulator* ()))
+ (*psw-stream* (if immediate?
+ *psw-stream*
+ (make-string-output-stream)))
+ (%psw-accumulator ()))
+ (declare (special %psw-accumulator))
(if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block
(loop for (statement . remaining) on (cdr form) do
- (ps-print statement) (psw ";") (when remaining (psw #\Newline)))
+ (ps-print statement) (psw #\;) (when remaining (psw #\Newline)))
(ps-print form))
- (nreverse *print-accumulator*)))
+ (unless immediate?
+ (reverse (cons (get-output-stream-string *psw-stream*) %psw-accumulator)))))
(defun psw (obj)
- (push (if (characterp obj) (string obj) obj) *print-accumulator*))
+ (declare (special %psw-accumulator immediate?))
+ (typecase obj
+ (string (write-string obj *psw-stream*))
+ (character (write-char obj *psw-stream*))
+ (otherwise
+ (if immediate?
+ (write-string (eval obj) *psw-stream*)
+ (setf %psw-accumulator
+ (cons obj
+ (cons (get-output-stream-string *psw-stream*)
+ %psw-accumulator)))))))
(defgeneric ps-print% (special-form-name special-form-args))
(defmethod ps-print ((form null))) ; don't print top-level nils (ex: result of defining macros, etc.)
(defmethod ps-print ((s symbol))
- (assert (keywordp s))
+ (assert (keywordp s) nil "~S is not a symbol" s)
(ps-print (string-downcase s)))
(defmethod ps-print ((compiled-form cons))
for code = (char-code char)
for special = (lisp-special-char-to-js char)
do (cond (special (psw #\\) (psw special))
- ((or (<= code #x1f) (>= code #x80)) (psw (format nil "\\u~4,'0x" code)))
+ ((or (<= code #x1f) (>= code #x80)) (format *psw-stream* "\\u~4,'0x" code))
(t (psw char))))
(psw *js-string-delimiter*)))
(defmethod ps-print ((number number))
- (psw (format nil (if (integerp number) "~S" "~F") number)))
+ (format *psw-stream* (if (integerp number) "~S" "~F") number))
;;; expression and operator precedence rules
(js:? (op-precedence 'js:?))
(js:unary-operator (op-precedence (second expr)))
(operator (op-precedence (second expr)))
- (otherwise 0))
- 0))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *op-precedence-hash* (make-hash-table :test 'eq))
-
- (let ((precedence 1))
- (dolist (ops '((js:new js:slot-value js:aref)
- (postfix++ postfix--)
- (delete void typeof ++ -- unary+ unary- ~ !)
- (* / %)
- (+ -)
- (<< >> >>>)
- (< > <= >= js:instanceof js:in)
- (== != === !== eql)
- (&)
- (^)
- (\|)
- (\&\& and)
- (\|\| or)
- (js:?)
- (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=)
- (comma)))
- (dolist (op ops)
- (setf (gethash op *op-precedence-hash*) precedence))
- (incf precedence)))
-
- (defun op-precedence (op)
- (gethash op *op-precedence-hash*)))
+ (otherwise -1))
+ -1))
(defprinter js:literal (str)
(psw str))
(psw #\[) (print-comma-delimited-list initial-contents) (psw #\]))
(defprinter js:aref (array indices)
- (if (>= (expression-precedence array) #.(op-precedence 'js:aref))
+ (if (>= (expression-precedence array) (op-precedence 'js:aref))
(parenthesize-print array)
(ps-print array))
(loop for idx in indices do
(psw #\[) (ps-print idx) (psw #\])))
+(defvar *lexical-bindings* nil)
+
+(defun rename-js-variable (name)
+ (or (cdr (assoc name *lexical-bindings*))
+ name))
+
+(defprinter js:let (variables &body body)
+ (let ((*lexical-bindings*
+ (append (mapcar (lambda (var)
+ (cons var (if (assoc var *lexical-bindings*)
+ (ps-gensym var)
+ var)))
+ variables))))
+ (loop for (exp . remaining) on body do
+ (ps-print exp) (when remaining (psw ";") (newline-and-indent)))))
+
(defprinter js:variable (var)
- (psw (js-translate-symbol var)))
+ (psw (symbol-to-js-string (rename-js-variable var))))
;;; arithmetic operators
(defun parenthesize-print (ps-form)
(if (>= (expression-precedence arg) precedence)
(parenthesize-print arg)
(ps-print arg))
- (when remaining (psw (format nil " ~(~A~) " op)))))
+ (when remaining (format *psw-stream* " ~(~A~) " op))))
(defprinter js:unary-operator (op arg &key prefix space)
- (when prefix (psw (format nil "~(~a~)~:[~; ~]" op space)))
+ (when prefix (format *psw-stream* "~(~a~)~:[~; ~]" op space))
(if (> (expression-precedence arg)
(op-precedence (case op
(+ 'unary+)
(t op))))
(parenthesize-print arg)
(ps-print arg))
- (unless prefix (psw (format nil "~(~a~)" op))))
+ (unless prefix (format *psw-stream* "~(~a~)" op)))
-(defprinter js:funcall (fun-designator &rest args)
- (funcall (if (member (car fun-designator) '(js:variable js:aref js:slot-value js:funcall))
+(defprinter js::funcall (fun-designator &rest args)
+ (funcall (if (member (car fun-designator) '(js:variable js:aref js:slot-value js::funcall))
#'ps-print
#'parenthesize-print)
fun-designator)
(print-fun-def name args body))
(defun print-fun-def (name args body-block)
- (psw (format nil "function ~:[~;~A~](" name (js-translate-symbol name)))
+ (format *psw-stream* "function ~:[~;~A~](" name (symbol-to-js-string name))
(loop for (arg . remaining) on args do
- (psw (js-translate-symbol arg)) (when remaining (psw ", ")))
+ (psw (symbol-to-js-string arg)) (when remaining (psw ", ")))
(psw ") ")
(ps-print body-block))
(defprinter js:object (&rest slot-defs)
(psw "{ ")
(loop for ((slot-name . slot-value) . remaining) on slot-defs do
- (if (and (listp slot-name) (eq 'quote (car slot-name)) (symbolp (second slot-name)))
- (psw (js-translate-symbol (second slot-name)))
- (ps-print slot-name))
- (psw " : ")
- (ps-print slot-value)
- (when remaining (psw ", ")))
+ (ps-print slot-name) (psw " : ") (ps-print slot-value)
+ (when remaining (psw ", ")))
(psw " }"))
(defprinter js:slot-value (obj slot)
- (if (or (> (expression-precedence obj) #.(op-precedence 'js:slot-value))
+ (if (or (> (expression-precedence obj) (op-precedence 'js:slot-value))
(numberp obj)
(and (listp obj) (member (car obj) '(js:lambda js:object))))
(parenthesize-print obj)
(ps-print obj))
- (if (symbolp slot)
- (progn (psw #\.) (psw (js-translate-symbol slot)))
+ (if (and (symbolp slot) (not (keywordp slot)))
+ (progn (psw #\.) (psw (symbol-to-js-string slot)))
(progn (psw #\[) (ps-print slot) (psw #\]))))
(defprinter js:if (test consequent &rest clauses)
(return)))))
(defprinter js:? (test then else)
- (ps-print test)
+ (if (>= (expression-precedence test) (op-precedence 'js:?))
+ (parenthesize-print test)
+ (ps-print test))
(psw " ? ")
(if (>= (expression-precedence then) (op-precedence 'js:?))
(parenthesize-print then)
(defprinter js:var (var-name &rest var-value)
(psw "var ")
- (psw (js-translate-symbol var-name))
+ (ps-print var-name)
(when var-value
(psw " = ")
(ps-print (car var-value))))
(psw "break")
(when label
(psw " ")
- (psw (js-translate-symbol label))))
+ (psw (symbol-to-js-string label))))
(defprinter js:continue (&optional label)
(psw "continue")
(when label
(psw " ")
- (psw (js-translate-symbol label))))
+ (psw (symbol-to-js-string label))))
;;; iteration
(defprinter js:for (label vars tests steps body-block)
- (when label (psw (js-translate-symbol label)) (psw ": ") (newline-and-indent))
+ (when label (psw (symbol-to-js-string label)) (psw ": ") (newline-and-indent))
(psw "for (")
(loop for ((var-name . var-init) . remaining) on vars
for decl = "var " then "" do
- (psw decl) (psw (js-translate-symbol var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", ")))
+ (psw decl) (psw (symbol-to-js-string var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", ")))
(psw "; ")
(loop for (test . remaining) on tests do
(ps-print test) (when remaining (psw ", ")))
(ps-print body-block))
(defprinter js:for-in (var object body-block)
- (psw "for (") (ps-print var) (psw " in ")
+ (psw "for (var ") (ps-print var) (psw " in ")
(if (> (expression-precedence object) (op-precedence 'in))
(parenthesize-print object)
(ps-print object))
(psw "try ")
(ps-print body-block)
(when catch
- (psw " catch (") (psw (js-translate-symbol (first catch))) (psw ") ")
+ (psw " catch (") (psw (symbol-to-js-string (first catch))) (psw ") ")
(ps-print (second catch)))
(when finally
(psw " finally ")
;;; regex
(defprinter js:regex (regex)
- (flet ((first-slash-p (string)
- (and (> (length string) 0) (char= (char string 0) #\/))))
- (let ((slash (unless (first-slash-p regex) "/")))
- (psw (format nil (concatenate 'string slash "~A" slash) regex)))))
+ (let ((slash (unless (and (> (length regex) 0) (char= (char regex 0) #\/)) "/")))
+ (psw (concatenate 'string slash regex slash))))
;;; conditional compilation
(defprinter js:cc-if (test &rest body)
HCoop / clinton / parenscript.git / blobdiff