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