Commit | Line | Data |
---|---|---|
496ef8be | 1 | (in-package "PARENSCRIPT") |
9da682ca | 2 | |
cb8f8e58 VS |
3 | (defvar *ps-print-pretty* t) |
4 | (defvar *indent-num-spaces* 4) | |
5 | (defvar *js-string-delimiter* #\' | |
6 | "Specifies which character should be used for delimiting strings. | |
7 | ||
8 | This variable is used when you want to embed the resulting JavaScript | |
9 | in an html attribute delimited by #\\\" as opposed to #\\', or | |
10 | vice-versa.") | |
11 | ||
12 | (defvar *indent-level*) | |
13 | (defvar *print-accumulator*) | |
14 | ||
15 | (defmethod parenscript-print (form) | |
16 | (let ((*indent-level* 0) | |
17 | (*print-accumulator* ())) | |
0ce67a33 | 18 | (if (and (listp form) (eq 'js:block (car form))) ; ignore top-level block |
fdfa77fc | 19 | (loop for (statement . remaining) on (cdr form) do |
0ce67a33 VS |
20 | (ps-print statement) (psw ";") (when remaining (psw #\Newline))) |
21 | (ps-print form)) | |
22 | (nreverse *print-accumulator*))) | |
cb8f8e58 VS |
23 | |
24 | (defun psw (obj) | |
25 | (push (if (characterp obj) (string obj) obj) *print-accumulator*)) | |
4ff112cb | 26 | |
839600e9 | 27 | (defgeneric ps-print% (special-form-name special-form-args)) |
9da682ca | 28 | |
4a987e2b VS |
29 | (defmacro defprinter (special-form content-args &body body) |
30 | "Given a special-form name and a destructuring lambda-list for its | |
31 | arguments, defines a printer for that form using the given body." | |
32 | (let ((sf (gensym)) | |
33 | (sf-args (gensym))) | |
839600e9 | 34 | `(defmethod ps-print% ((,sf (eql ',special-form)) ,sf-args) |
89aa7077 | 35 | (declare (ignorable ,sf)) |
4a987e2b VS |
36 | (destructuring-bind ,content-args |
37 | ,sf-args | |
38 | ,@body)))) | |
39 | ||
839600e9 | 40 | (defgeneric ps-print (compiled-form)) |
4a987e2b | 41 | |
cb8f8e58 | 42 | (defmethod ps-print ((form null))) ; don't print top-level nils (ex: result of defining macros, etc.) |
53a1beac | 43 | |
f2bb932e VS |
44 | (defmethod ps-print ((s symbol)) |
45 | (assert (keywordp s)) | |
48ea6dd2 | 46 | (ps-print (string-downcase s))) |
f2bb932e | 47 | |
839600e9 | 48 | (defmethod ps-print ((compiled-form cons)) |
839600e9 | 49 | (ps-print% (car compiled-form) (cdr compiled-form))) |
4a987e2b | 50 | |
116f7450 | 51 | (defun newline-and-indent () |
cb8f8e58 | 52 | (if *ps-print-pretty* |
496ef8be VS |
53 | (progn (psw #\Newline) |
54 | (loop repeat (* *indent-level* *indent-num-spaces*) do (psw #\Space))) | |
cb8f8e58 | 55 | (psw #\Space))) |
4a987e2b VS |
56 | |
57 | (defparameter *js-lisp-escaped-chars* | |
58 | '((#\' . #\') | |
59 | (#\\ . #\\) | |
60 | (#\b . #\Backspace) | |
61 | (#\f . #.(code-char 12)) | |
62 | (#\n . #\Newline) | |
63 | (#\r . #\Return) | |
64 | (#\t . #\Tab))) | |
65 | ||
839600e9 | 66 | (defmethod ps-print ((string string)) |
4a987e2b VS |
67 | (flet ((lisp-special-char-to-js (lisp-char) |
68 | (car (rassoc lisp-char *js-lisp-escaped-chars*)))) | |
c639fe7f | 69 | (psw *js-string-delimiter*) |
839600e9 VS |
70 | (loop for char across string |
71 | for code = (char-code char) | |
72 | for special = (lisp-special-char-to-js char) | |
c639fe7f | 73 | do (cond (special (psw #\\) (psw special)) |
cb8f8e58 | 74 | ((or (<= code #x1f) (>= code #x80)) (psw (format nil "\\u~4,'0x" code))) |
c639fe7f VS |
75 | (t (psw char)))) |
76 | (psw *js-string-delimiter*))) | |
839600e9 VS |
77 | |
78 | (defmethod ps-print ((number number)) | |
cb8f8e58 | 79 | (psw (format nil (if (integerp number) "~S" "~F") number))) |
4a987e2b VS |
80 | |
81 | ;;; expression and operator precedence rules | |
82 | ||
83 | (defun expression-precedence (expr) | |
84 | (if (consp expr) | |
85 | (case (car expr) | |
0ce67a33 VS |
86 | ((js:slot-value js:aref) (op-precedence (car expr))) |
87 | (js:= (op-precedence 'js:=)) | |
e8fdcce7 | 88 | (js:? (op-precedence 'js:?)) |
0ce67a33 | 89 | (js:unary-operator (op-precedence (second expr))) |
4a987e2b VS |
90 | (operator (op-precedence (second expr))) |
91 | (otherwise 0)) | |
92 | 0)) | |
93 | ||
94 | (eval-when (:compile-toplevel :load-toplevel :execute) | |
f3847d1c | 95 | (defparameter *op-precedence-hash* (make-hash-table :test 'eq)) |
4a987e2b | 96 | |
4a987e2b | 97 | (let ((precedence 1)) |
0ce67a33 | 98 | (dolist (ops '((js:new js:slot-value js:aref) |
6a46e1ef TC |
99 | (postfix++ postfix--) |
100 | (delete void typeof ++ -- unary+ unary- ~ !) | |
4a987e2b VS |
101 | (* / %) |
102 | (+ -) | |
6a46e1ef | 103 | (<< >> >>>) |
0ce67a33 | 104 | (< > <= >= js:instanceof js:in) |
6a46e1ef | 105 | (== != === !== eql) |
4a987e2b VS |
106 | (&) |
107 | (^) | |
108 | (\|) | |
109 | (\&\& and) | |
110 | (\|\| or) | |
e8fdcce7 | 111 | (js:?) |
0ce67a33 | 112 | (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|=) |
4a987e2b VS |
113 | (comma))) |
114 | (dolist (op ops) | |
f3847d1c | 115 | (setf (gethash op *op-precedence-hash*) precedence)) |
4a987e2b VS |
116 | (incf precedence))) |
117 | ||
118 | (defun op-precedence (op) | |
f3847d1c | 119 | (gethash op *op-precedence-hash*))) |
9da682ca | 120 | |
0ce67a33 | 121 | (defprinter js:literal (str) |
4ff112cb | 122 | (psw str)) |
46f794a4 | 123 | |
4ff112cb VS |
124 | (defun print-comma-delimited-list (ps-forms) |
125 | (loop for (form . remaining) on ps-forms do | |
126 | (ps-print form) (when remaining (psw ", ")))) | |
cc4f1551 | 127 | |
0ce67a33 | 128 | (defprinter js:array (&rest initial-contents) |
4ff112cb | 129 | (psw #\[) (print-comma-delimited-list initial-contents) (psw #\])) |
839600e9 | 130 | |
0ce67a33 VS |
131 | (defprinter js:aref (array indices) |
132 | (if (>= (expression-precedence array) #.(op-precedence 'js:aref)) | |
d43d746e TC |
133 | (parenthesize-print array) |
134 | (ps-print array)) | |
839600e9 | 135 | (loop for idx in indices do |
4ff112cb | 136 | (psw #\[) (ps-print idx) (psw #\]))) |
839600e9 | 137 | |
0ce67a33 | 138 | (defprinter js:variable (var) |
4ff112cb | 139 | (psw (js-translate-symbol var))) |
cc4f1551 RD |
140 | |
141 | ;;; arithmetic operators | |
839600e9 | 142 | (defun parenthesize-print (ps-form) |
4ff112cb | 143 | (psw #\() (ps-print ps-form) (psw #\))) |
cc4f1551 | 144 | |
0ce67a33 | 145 | (defprinter js:operator (op &rest args) |
4ff112cb VS |
146 | (loop for (arg . remaining) on args |
147 | with precedence = (op-precedence op) do | |
148 | (if (>= (expression-precedence arg) precedence) | |
149 | (parenthesize-print arg) | |
150 | (ps-print arg)) | |
cb8f8e58 | 151 | (when remaining (psw (format nil " ~(~A~) " op))))) |
4a987e2b | 152 | |
0ce67a33 | 153 | (defprinter js:unary-operator (op arg &key prefix space) |
cb8f8e58 | 154 | (when prefix (psw (format nil "~(~a~)~:[~; ~]" op space))) |
6a46e1ef TC |
155 | (if (> (expression-precedence arg) |
156 | (op-precedence (case op | |
157 | (+ 'unary+) | |
158 | (- 'unary-) | |
159 | (t op)))) | |
839600e9 VS |
160 | (parenthesize-print arg) |
161 | (ps-print arg)) | |
cb8f8e58 | 162 | (unless prefix (psw (format nil "~(~a~)" op)))) |
4a987e2b | 163 | |
0ce67a33 VS |
164 | (defprinter js:funcall (fun-designator &rest args) |
165 | (funcall (if (member (car fun-designator) '(js:variable js:aref js:slot-value js:funcall)) | |
79630c82 VS |
166 | #'ps-print |
167 | #'parenthesize-print) | |
168 | fun-designator) | |
4ff112cb | 169 | (psw #\() (print-comma-delimited-list args) (psw #\))) |
cc4f1551 | 170 | |
fdfa77fc VS |
171 | (defprinter js:|,| (&rest expressions) |
172 | (psw #\() | |
173 | (loop for (exp . remaining) on expressions do | |
174 | (ps-print exp) (when remaining (psw ", "))) | |
175 | (psw #\))) | |
176 | ||
177 | (defprinter js:block (&rest statements) | |
178 | (psw #\{) | |
179 | (incf *indent-level*) | |
180 | (dolist (statement statements) | |
181 | (newline-and-indent) (ps-print statement) (psw #\;)) | |
182 | (decf *indent-level*) | |
183 | (newline-and-indent) | |
184 | (psw #\})) | |
4a987e2b | 185 | |
0ce67a33 | 186 | (defprinter js:lambda (args body) |
839600e9 | 187 | (print-fun-def nil args body)) |
4a987e2b | 188 | |
0ce67a33 | 189 | (defprinter js:defun (name args body) |
839600e9 VS |
190 | (print-fun-def name args body)) |
191 | ||
116f7450 | 192 | (defun print-fun-def (name args body-block) |
cb8f8e58 | 193 | (psw (format nil "function ~:[~;~A~](" name (js-translate-symbol name))) |
4ff112cb VS |
194 | (loop for (arg . remaining) on args do |
195 | (psw (js-translate-symbol arg)) (when remaining (psw ", "))) | |
196 | (psw ") ") | |
116f7450 | 197 | (ps-print body-block)) |
cc4f1551 | 198 | |
0ce67a33 | 199 | (defprinter js:object (&rest slot-defs) |
4ff112cb | 200 | (psw "{ ") |
79630c82 | 201 | (loop for ((slot-name . slot-value) . remaining) on slot-defs do |
fb469285 | 202 | (if (and (listp slot-name) (eq 'quote (car slot-name)) (symbolp (second slot-name))) |
4ff112cb VS |
203 | (psw (js-translate-symbol (second slot-name))) |
204 | (ps-print slot-name)) | |
205 | (psw " : ") | |
206 | (ps-print slot-value) | |
207 | (when remaining (psw ", "))) | |
208 | (psw " }")) | |
cc4f1551 | 209 | |
0ce67a33 VS |
210 | (defprinter js:slot-value (obj slot) |
211 | (if (or (> (expression-precedence obj) #.(op-precedence 'js:slot-value)) | |
79630c82 | 212 | (numberp obj) |
0ce67a33 | 213 | (and (listp obj) (member (car obj) '(js:lambda js:object)))) |
839600e9 VS |
214 | (parenthesize-print obj) |
215 | (ps-print obj)) | |
fb469285 VS |
216 | (if (symbolp slot) |
217 | (progn (psw #\.) (psw (js-translate-symbol slot))) | |
4ff112cb | 218 | (progn (psw #\[) (ps-print slot) (psw #\])))) |
cc4f1551 | 219 | |
fdfa77fc | 220 | (defprinter js:if (test consequent &rest clauses) |
4ff112cb | 221 | (psw "if (") (ps-print test) (psw ") ") |
fdfa77fc VS |
222 | (ps-print consequent) |
223 | (loop while clauses do | |
224 | (ecase (car clauses) | |
225 | (:else-if (psw " else if (") (ps-print (cadr clauses)) (psw ") ") | |
226 | (ps-print (caddr clauses)) | |
227 | (setf clauses (cdddr clauses))) | |
228 | (:else (psw " else ") | |
229 | (ps-print (cadr clauses)) | |
230 | (return))))) | |
4a987e2b | 231 | |
e8fdcce7 | 232 | (defprinter js:? (test then else) |
839600e9 | 233 | (ps-print test) |
4ff112cb | 234 | (psw " ? ") |
e8fdcce7 | 235 | (if (>= (expression-precedence then) (op-precedence 'js:?)) |
839600e9 VS |
236 | (parenthesize-print then) |
237 | (ps-print then)) | |
4ff112cb | 238 | (psw " : ") |
e8fdcce7 | 239 | (if (>= (expression-precedence else) (op-precedence 'js:?)) |
5705b542 VS |
240 | (parenthesize-print else) |
241 | (ps-print else))) | |
cc4f1551 | 242 | |
0ce67a33 | 243 | (defprinter js:= (lhs rhs) |
4ff112cb | 244 | (ps-print lhs) (psw " = ") (ps-print rhs)) |
cc4f1551 | 245 | |
0ce67a33 | 246 | (defprinter js:var (var-name &rest var-value) |
4ff112cb VS |
247 | (psw "var ") |
248 | (psw (js-translate-symbol var-name)) | |
839600e9 | 249 | (when var-value |
4ff112cb | 250 | (psw " = ") |
839600e9 | 251 | (ps-print (car var-value)))) |
cc4f1551 | 252 | |
0ce67a33 | 253 | (defprinter js:break (&optional label) |
c452748e TC |
254 | (psw "break") |
255 | (when label | |
256 | (psw " ") | |
257 | (psw (js-translate-symbol label)))) | |
258 | ||
0ce67a33 | 259 | (defprinter js:continue (&optional label) |
c452748e TC |
260 | (psw "continue") |
261 | (when label | |
262 | (psw " ") | |
263 | (psw (js-translate-symbol label)))) | |
264 | ||
cc4f1551 | 265 | ;;; iteration |
0ce67a33 | 266 | (defprinter js:for (label vars tests steps body-block) |
6a2ce72d | 267 | (when label (psw (js-translate-symbol label)) (psw ": ") (newline-and-indent)) |
4ff112cb VS |
268 | (psw "for (") |
269 | (loop for ((var-name . var-init) . remaining) on vars | |
270 | for decl = "var " then "" do | |
271 | (psw decl) (psw (js-translate-symbol var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", "))) | |
272 | (psw "; ") | |
6a2ce72d TC |
273 | (loop for (test . remaining) on tests do |
274 | (ps-print test) (when remaining (psw ", "))) | |
4ff112cb | 275 | (psw "; ") |
6a2ce72d TC |
276 | (loop for (step . remaining) on steps do |
277 | (ps-print step) (when remaining (psw ", "))) | |
4ff112cb | 278 | (psw ") ") |
116f7450 | 279 | (ps-print body-block)) |
cc4f1551 | 280 | |
0ce67a33 | 281 | (defprinter js:for-in (var object body-block) |
6a46e1ef TC |
282 | (psw "for (") (ps-print var) (psw " in ") |
283 | (if (> (expression-precedence object) (op-precedence 'in)) | |
284 | (parenthesize-print object) | |
285 | (ps-print object)) | |
286 | (psw ") ") | |
116f7450 | 287 | (ps-print body-block)) |
cc4f1551 | 288 | |
0ce67a33 | 289 | (defprinter js:while (test body-block) |
4ff112cb | 290 | (psw "while (") (ps-print test) (psw ") ") |
116f7450 | 291 | (ps-print body-block)) |
4a987e2b | 292 | |
0ce67a33 | 293 | (defprinter js:with (expression body-block) |
4ff112cb | 294 | (psw "with (") (ps-print expression) (psw ") ") |
116f7450 | 295 | (ps-print body-block)) |
4a987e2b | 296 | |
0ce67a33 | 297 | (defprinter js:switch (test clauses) |
116f7450 VS |
298 | (flet ((print-body-statements (body-statements) |
299 | (incf *indent-level*) | |
300 | (loop for statement in body-statements do | |
301 | (progn (newline-and-indent) | |
302 | (ps-print statement) | |
4ff112cb | 303 | (psw #\;))) |
116f7450 | 304 | (decf *indent-level*))) |
4ff112cb | 305 | (psw "switch (") (ps-print test) (psw ") {") |
e0032a96 | 306 | (loop for (val . statements) in clauses |
116f7450 | 307 | do (progn (newline-and-indent) |
675edae3 | 308 | (if (eq val 'default) |
4ff112cb | 309 | (progn (psw "default: ") |
e0032a96 | 310 | (print-body-statements statements)) |
4ff112cb | 311 | (progn (psw "case ") |
116f7450 | 312 | (ps-print val) |
4ff112cb | 313 | (psw #\:) |
e0032a96 VS |
314 | (print-body-statements statements))))) |
315 | (newline-and-indent) | |
4ff112cb | 316 | (psw #\}))) |
116f7450 | 317 | |
0ce67a33 | 318 | (defprinter js:try (body-block &key catch finally) |
4ff112cb | 319 | (psw "try ") |
116f7450 | 320 | (ps-print body-block) |
839600e9 | 321 | (when catch |
4ff112cb | 322 | (psw " catch (") (psw (js-translate-symbol (first catch))) (psw ") ") |
839600e9 VS |
323 | (ps-print (second catch))) |
324 | (when finally | |
4ff112cb | 325 | (psw " finally ") |
116f7450 | 326 | (ps-print finally))) |
cc4f1551 RD |
327 | |
328 | ;;; regex | |
0ce67a33 | 329 | (defprinter js:regex (regex) |
4a987e2b | 330 | (flet ((first-slash-p (string) |
839600e9 | 331 | (and (> (length string) 0) (char= (char string 0) #\/)))) |
4a987e2b | 332 | (let ((slash (unless (first-slash-p regex) "/"))) |
cb8f8e58 | 333 | (psw (format nil (concatenate 'string slash "~A" slash) regex))))) |
cc4f1551 | 334 | |
cc4f1551 | 335 | ;;; conditional compilation |
0ce67a33 | 336 | (defprinter js:cc-if (test &rest body) |
4ff112cb | 337 | (psw "/*@if ") |
839600e9 | 338 | (ps-print test) |
116f7450 | 339 | (incf *indent-level*) |
0ce67a33 | 340 | (dolist (form body) |
4ff112cb | 341 | (newline-and-indent) (ps-print form) (psw #\;)) |
116f7450 VS |
342 | (decf *indent-level*) |
343 | (newline-and-indent) | |
4ff112cb | 344 | (psw "@end @*/")) |
cc4f1551 | 345 | |
0ce67a33 | 346 | (defprinter js:instanceof (value type) |
6a46e1ef | 347 | (psw #\() |
0ce67a33 | 348 | (if (> (expression-precedence value) (op-precedence 'js:instanceof)) |
6a46e1ef TC |
349 | (parenthesize-print value) |
350 | (ps-print value)) | |
351 | (psw " instanceof ") | |
0ce67a33 | 352 | (if (> (expression-precedence type) (op-precedence 'js:instanceof)) |
6a46e1ef TC |
353 | (parenthesize-print type) |
354 | (ps-print type)) | |
355 | (psw #\))) | |
356 | ||
0ce67a33 | 357 | (defprinter js:escape (literal-js) |
ceb1f277 | 358 | ;; literal-js should be a form that evaluates to a string containing valid JavaScript |
0ce67a33 | 359 | (psw literal-js)) |
cb8f8e58 | 360 | |
6a46e1ef | 361 | ;;; named statements |
0ce67a33 VS |
362 | (defprinter js:throw (x) |
363 | (psw "throw ") (ps-print x)) | |
364 | ||
365 | (defprinter js:return (x) | |
366 | (psw "return ") (ps-print x)) |