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* ())) | |
496ef8be VS |
18 | (if (and (listp form) (eql 'js-block (car form))) ; ignore top-level block |
19 | (loop for (statement . remaining) on (third form) do | |
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)) | |
46 | (ps-print (js-translate-symbol s))) | |
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) | |
6a46e1ef | 86 | ((js-slot-value js-aref) (op-precedence (car expr))) |
4a987e2b | 87 | (js-assign (op-precedence '=)) |
e8fdcce7 | 88 | (js:? (op-precedence 'js:?)) |
1222b323 | 89 | (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)) |
6a46e1ef TC |
98 | (dolist (ops '((new js-slot-value js-aref) |
99 | (postfix++ postfix--) | |
100 | (delete void typeof ++ -- unary+ unary- ~ !) | |
4a987e2b VS |
101 | (* / %) |
102 | (+ -) | |
6a46e1ef TC |
103 | (<< >> >>>) |
104 | (< > <= >= js-instance-of in) | |
105 | (== != === !== eql) | |
4a987e2b VS |
106 | (&) |
107 | (^) | |
108 | (\|) | |
109 | (\&\& and) | |
110 | (\|\| or) | |
e8fdcce7 | 111 | (js:?) |
6a46e1ef | 112 | (= *= /= %= += -= <<= >>= >>>= \&\= ^= \|= js-assign) |
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 | |
4a987e2b | 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 | |
4a987e2b | 128 | (defprinter array-literal (&rest initial-contents) |
4ff112cb | 129 | (psw #\[) (print-comma-delimited-list initial-contents) (psw #\])) |
839600e9 VS |
130 | |
131 | (defprinter js-aref (array indices) | |
2ee6879d | 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 | |
4a987e2b | 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 | |
4a987e2b | 145 | (defprinter operator (op 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 | |
6a46e1ef | 153 | (defprinter 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 | |
4a987e2b | 164 | (defprinter js-funcall (fun-designator args) |
79630c82 VS |
165 | (funcall (if (member (car fun-designator) '(js-variable js-aref js-slot-value js-funcall)) |
166 | #'ps-print | |
167 | #'parenthesize-print) | |
168 | fun-designator) | |
4ff112cb | 169 | (psw #\() (print-comma-delimited-list args) (psw #\))) |
cc4f1551 | 170 | |
e0032a96 VS |
171 | (defprinter js-block (block-type statements) |
172 | (case block-type | |
173 | (:statement | |
174 | (psw #\{) | |
175 | (incf *indent-level*) | |
176 | (dolist (statement statements) | |
177 | (newline-and-indent) (ps-print statement) (psw #\;)) | |
178 | (decf *indent-level*) | |
179 | (newline-and-indent) | |
180 | (psw #\})) | |
181 | (:expression | |
182 | (psw #\() | |
183 | (loop for (statement . remaining) on statements do | |
184 | (ps-print statement) (when remaining (psw ", "))) | |
185 | (psw #\))))) | |
4a987e2b VS |
186 | |
187 | (defprinter js-lambda (args body) | |
839600e9 | 188 | (print-fun-def nil args body)) |
4a987e2b VS |
189 | |
190 | (defprinter js-defun (name args body) | |
839600e9 VS |
191 | (print-fun-def name args body)) |
192 | ||
116f7450 | 193 | (defun print-fun-def (name args body-block) |
cb8f8e58 | 194 | (psw (format nil "function ~:[~;~A~](" name (js-translate-symbol name))) |
4ff112cb VS |
195 | (loop for (arg . remaining) on args do |
196 | (psw (js-translate-symbol arg)) (when remaining (psw ", "))) | |
197 | (psw ") ") | |
116f7450 | 198 | (ps-print body-block)) |
cc4f1551 | 199 | |
4a987e2b | 200 | (defprinter js-object (slot-defs) |
4ff112cb | 201 | (psw "{ ") |
79630c82 | 202 | (loop for ((slot-name . slot-value) . remaining) on slot-defs do |
fb469285 | 203 | (if (and (listp slot-name) (eq 'quote (car slot-name)) (symbolp (second slot-name))) |
4ff112cb VS |
204 | (psw (js-translate-symbol (second slot-name))) |
205 | (ps-print slot-name)) | |
206 | (psw " : ") | |
207 | (ps-print slot-value) | |
208 | (when remaining (psw ", "))) | |
209 | (psw " }")) | |
cc4f1551 | 210 | |
4a987e2b | 211 | (defprinter js-slot-value (obj slot) |
79630c82 VS |
212 | (if (or (> (expression-precedence obj) #.(op-precedence 'js-slot-value)) |
213 | (numberp obj) | |
214 | (and (listp obj) (member (car obj) '(js-lambda js-object)))) | |
839600e9 VS |
215 | (parenthesize-print obj) |
216 | (ps-print obj)) | |
fb469285 VS |
217 | (if (symbolp slot) |
218 | (progn (psw #\.) (psw (js-translate-symbol slot))) | |
4ff112cb | 219 | (progn (psw #\[) (ps-print slot) (psw #\])))) |
cc4f1551 | 220 | |
0949f072 | 221 | (defprinter js-cond-statement (clauses) |
839600e9 | 222 | (loop for (test body-block) in clauses |
4ff112cb VS |
223 | for start = "if (" then " else if (" do |
224 | (if (equalp test "true") | |
225 | (psw " else ") | |
226 | (progn (psw start) | |
227 | (ps-print test) | |
228 | (psw ") "))) | |
229 | (ps-print body-block))) | |
4a987e2b | 230 | |
e8fdcce7 | 231 | (defprinter js:if (test then-block else-block) |
4ff112cb | 232 | (psw "if (") (ps-print test) (psw ") ") |
116f7450 VS |
233 | (ps-print then-block) |
234 | (when else-block | |
4ff112cb | 235 | (psw " else ") |
116f7450 | 236 | (ps-print else-block))) |
4a987e2b | 237 | |
e8fdcce7 | 238 | (defprinter js:? (test then else) |
839600e9 | 239 | (ps-print test) |
4ff112cb | 240 | (psw " ? ") |
e8fdcce7 | 241 | (if (>= (expression-precedence then) (op-precedence 'js:?)) |
839600e9 VS |
242 | (parenthesize-print then) |
243 | (ps-print then)) | |
4ff112cb | 244 | (psw " : ") |
e8fdcce7 | 245 | (if (>= (expression-precedence else) (op-precedence 'js:?)) |
5705b542 VS |
246 | (parenthesize-print else) |
247 | (ps-print else))) | |
cc4f1551 | 248 | |
4a987e2b | 249 | (defprinter js-assign (lhs rhs) |
4ff112cb | 250 | (ps-print lhs) (psw " = ") (ps-print rhs)) |
cc4f1551 | 251 | |
58c4ef4f | 252 | (defprinter js-var (var-name &rest var-value) |
4ff112cb VS |
253 | (psw "var ") |
254 | (psw (js-translate-symbol var-name)) | |
839600e9 | 255 | (when var-value |
4ff112cb | 256 | (psw " = ") |
839600e9 | 257 | (ps-print (car var-value)))) |
cc4f1551 | 258 | |
c452748e TC |
259 | (defprinter js-break (&optional label) |
260 | (psw "break") | |
261 | (when label | |
262 | (psw " ") | |
263 | (psw (js-translate-symbol label)))) | |
264 | ||
265 | (defprinter js-continue (&optional label) | |
266 | (psw "continue") | |
267 | (when label | |
268 | (psw " ") | |
269 | (psw (js-translate-symbol label)))) | |
270 | ||
cc4f1551 | 271 | ;;; iteration |
6a2ce72d TC |
272 | (defprinter js-for (label vars tests steps body-block) |
273 | (when label (psw (js-translate-symbol label)) (psw ": ") (newline-and-indent)) | |
4ff112cb VS |
274 | (psw "for (") |
275 | (loop for ((var-name . var-init) . remaining) on vars | |
276 | for decl = "var " then "" do | |
277 | (psw decl) (psw (js-translate-symbol var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", "))) | |
278 | (psw "; ") | |
6a2ce72d TC |
279 | (loop for (test . remaining) on tests do |
280 | (ps-print test) (when remaining (psw ", "))) | |
4ff112cb | 281 | (psw "; ") |
6a2ce72d TC |
282 | (loop for (step . remaining) on steps do |
283 | (ps-print step) (when remaining (psw ", "))) | |
4ff112cb | 284 | (psw ") ") |
116f7450 | 285 | (ps-print body-block)) |
cc4f1551 | 286 | |
6a2ce72d | 287 | (defprinter js-for-in (var object body-block) |
6a46e1ef TC |
288 | (psw "for (") (ps-print var) (psw " in ") |
289 | (if (> (expression-precedence object) (op-precedence 'in)) | |
290 | (parenthesize-print object) | |
291 | (ps-print object)) | |
292 | (psw ") ") | |
116f7450 | 293 | (ps-print body-block)) |
cc4f1551 | 294 | |
4a987e2b | 295 | (defprinter js-while (test body-block) |
4ff112cb | 296 | (psw "while (") (ps-print test) (psw ") ") |
116f7450 | 297 | (ps-print body-block)) |
4a987e2b VS |
298 | |
299 | (defprinter js-with (expression body-block) | |
4ff112cb | 300 | (psw "with (") (ps-print expression) (psw ") ") |
116f7450 | 301 | (ps-print body-block)) |
4a987e2b VS |
302 | |
303 | (defprinter js-switch (test clauses) | |
116f7450 VS |
304 | (flet ((print-body-statements (body-statements) |
305 | (incf *indent-level*) | |
306 | (loop for statement in body-statements do | |
307 | (progn (newline-and-indent) | |
308 | (ps-print statement) | |
4ff112cb | 309 | (psw #\;))) |
116f7450 | 310 | (decf *indent-level*))) |
4ff112cb | 311 | (psw "switch (") (ps-print test) (psw ") {") |
e0032a96 | 312 | (loop for (val . statements) in clauses |
116f7450 | 313 | do (progn (newline-and-indent) |
675edae3 | 314 | (if (eq val 'default) |
4ff112cb | 315 | (progn (psw "default: ") |
e0032a96 | 316 | (print-body-statements statements)) |
4ff112cb | 317 | (progn (psw "case ") |
116f7450 | 318 | (ps-print val) |
4ff112cb | 319 | (psw #\:) |
e0032a96 VS |
320 | (print-body-statements statements))))) |
321 | (newline-and-indent) | |
4ff112cb | 322 | (psw #\}))) |
116f7450 VS |
323 | |
324 | (defprinter js-try (body-block &key catch finally) | |
4ff112cb | 325 | (psw "try ") |
116f7450 | 326 | (ps-print body-block) |
839600e9 | 327 | (when catch |
4ff112cb | 328 | (psw " catch (") (psw (js-translate-symbol (first catch))) (psw ") ") |
839600e9 VS |
329 | (ps-print (second catch))) |
330 | (when finally | |
4ff112cb | 331 | (psw " finally ") |
116f7450 | 332 | (ps-print finally))) |
cc4f1551 RD |
333 | |
334 | ;;; regex | |
4a987e2b VS |
335 | (defprinter js-regex (regex) |
336 | (flet ((first-slash-p (string) | |
839600e9 | 337 | (and (> (length string) 0) (char= (char string 0) #\/)))) |
4a987e2b | 338 | (let ((slash (unless (first-slash-p regex) "/"))) |
cb8f8e58 | 339 | (psw (format nil (concatenate 'string slash "~A" slash) regex))))) |
cc4f1551 | 340 | |
cc4f1551 | 341 | ;;; conditional compilation |
4a987e2b | 342 | (defprinter cc-if (test body-forms) |
4ff112cb | 343 | (psw "/*@if ") |
839600e9 | 344 | (ps-print test) |
116f7450 | 345 | (incf *indent-level*) |
839600e9 | 346 | (dolist (form body-forms) |
4ff112cb | 347 | (newline-and-indent) (ps-print form) (psw #\;)) |
116f7450 VS |
348 | (decf *indent-level*) |
349 | (newline-and-indent) | |
4ff112cb | 350 | (psw "@end @*/")) |
cc4f1551 | 351 | |
4a987e2b | 352 | (defprinter js-instanceof (value type) |
6a46e1ef TC |
353 | (psw #\() |
354 | (if (> (expression-precedence value) (op-precedence 'js-instance-of)) | |
355 | (parenthesize-print value) | |
356 | (ps-print value)) | |
357 | (psw " instanceof ") | |
358 | (if (> (expression-precedence type) (op-precedence 'js-instance-of)) | |
359 | (parenthesize-print type) | |
360 | (ps-print type)) | |
361 | (psw #\))) | |
362 | ||
cb8f8e58 VS |
363 | (defprinter js-escape (lisp-form) |
364 | (psw `(ps1* ,lisp-form))) | |
365 | ||
6a46e1ef TC |
366 | ;;; named statements |
367 | (macrolet ((def-stmt-printer (&rest stmts) | |
368 | `(progn ,@(mapcar (lambda (stmt) | |
369 | `(defprinter ,(intern (format nil "JS-~a" stmt)) (expr) | |
cb8f8e58 | 370 | (psw (format nil "~(~a~) " ',stmt)) |
6a46e1ef TC |
371 | (ps-print expr))) |
372 | stmts)))) | |
373 | (def-stmt-printer throw return)) |