1 (in-package :parenscript
)
3 (defparameter *js-lisp-escaped-chars
*
7 (#\f .
#.
(code-char 12))
12 (defparameter *char-escape-table
*
13 (let ((hash (make-hash-table)))
14 (dolist (escape-pair *js-lisp-escaped-chars
* hash
)
15 (setf (gethash (cdr escape-pair
) hash
) (car escape-pair
)))))
17 (declaim (inline lisp-special-char-to-js-2
))
18 (defun lisp-special-char-to-js-2 (lisp-char)
19 "Gets the escaped version "
20 (gethash lisp-char
*char-escape-table
*))
22 (defgeneric js-translate
(ast-node expression-or-statement stream
)
23 (:documentation
"Translates the given AST node to Javascript.
24 expression-or-statement is either the keyword :statement or :expression"))
26 (defmacro defjstrans
(script-class type-spec
(node-var stream-var
) &body body
)
27 "Generates a translate-to-js definition for the special-form class SCRIPT-CLASS
28 where type-spec is either :expression or :statement. STREAM is the output stream
29 where we should place the Javascript."
30 (when (not (or (eql :expression type-spec
) (eql :statement type-spec
)))
31 (error "Invalid type-spec fo DEFJSTRANS form."))
32 `(defmethod js-translate ((,node-var
,script-class
) (spec (eql ,type-spec
)) ,stream-var
)
35 (defjstrans expression
:expression
(expr stream
)
36 (princ (value expr
) stream
))
38 (defjstrans expression
:statement
(expr stream
)
39 (princ (value expr
) stream
))
41 (defjstrans statement
:statement
(statement stream
)
42 (princ (value statement
) stream
))
44 (defmacro dolist
+ ((car-var list
&key result-form lastp-var
) &body body
)
45 "Iterates over a list, giving other information in bindings designated
46 by the keyword arguments."
47 (let ((sublist-var (gensym)))
50 #'(lambda (,sublist-var
)
51 (let ((,car-var
(car ,sublist-var
))
53 (list `(,lastp-var
(not (cdr ,sublist-var
))))))
59 (defjstrans array-literal
:expression
(array stream
)
60 (write-char #\
[ stream
)
61 (dolist+ (array-item (array-values array
) :lastp-var last?
)
62 (js-translate array-item
:expression stream
)
63 (when (not last?
) (princ ",")))
64 (write-char #\
] stream
))
66 (defjstrans script-aref
:expression
(aref stream
)
67 (js-translate (aref-array aref
) :expression stream
)
69 (js-translate (aref-index aref
) :expression stream
)
72 (defjstrans object-literal
:expression
(obj stream
)
74 (dolist+ (obj-pair (object-values obj
) :lastp-var last?
)
75 (js-translate (car obj-pair
) :expression stream
)
77 (js-translate (cdr obj-pair
) :expression stream
)
78 (when (not last?
) (princ ",")))
81 (defjstrans string-literal
:expression
(string stream
)
82 (declare (inline lisp-special-char-to-js-2
))
83 (write-char *js-quote-char
* stream
)
85 for char across
(value string
)
86 for code
= (char-code char
)
87 for special
= (lisp-special-char-to-js-2 char
)
91 (write-char #\\ stream
)
92 (write-char special stream
))
93 ((or (<= code
#x1f
) (>= code
#x80
))
94 (format stream
"\\u~4,'0x" code
))
95 (t (write-char char stream
)))
96 finally
(write-char *js-quote-char
* stream
)))
98 (defjstrans script-variable
:expression
(var stream
)
99 (princ (symbol-to-js (value var
)) stream
))
101 (defjstrans op-form
:expression
(op-form stream
)
102 (let ((precedence (expression-precedence op-form
)))
103 (flet ((output-op-arg (op-arg)
104 (let ((parens?
(>= (expression-precedence op-arg
) precedence
)))
105 (when parens?
(write-char #\
())
106 (js-translate op-arg
:expression stream
)
107 (when parens?
(write-char #\
))))))
108 (output-op-arg (first (op-args op-form
)))
109 (format stream
"~A " (operator op-form
))
110 (output-op-arg (second (op-args op-form
))))))
112 (defjstrans one-op
:expression
(one-op stream
)
113 (let ((pre?
(one-op-pre-p one-op
)))
115 (princ (one-op one-op
) stream
))
116 (js-translate (value one-op
) :expression stream
)
118 (princ (one-op one-op
) stream
))))