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) |
dd4442b8 | 139 | (psw (symbol-to-js-string 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) |
dd4442b8 | 193 | (psw (format nil "function ~:[~;~A~](" name (symbol-to-js-string name))) |
4ff112cb | 194 | (loop for (arg . remaining) on args do |
dd4442b8 | 195 | (psw (symbol-to-js-string arg)) (when remaining (psw ", "))) |
4ff112cb | 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))) |
dd4442b8 | 203 | (psw (symbol-to-js-string (second slot-name))) |
4ff112cb VS |
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 | 216 | (if (symbolp slot) |
dd4442b8 | 217 | (progn (psw #\.) (psw (symbol-to-js-string 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) |
20ba6d7a VS |
233 | (if (>= (expression-precedence test) (op-precedence 'js:?)) |
234 | (parenthesize-print test) | |
235 | (ps-print test)) | |
4ff112cb | 236 | (psw " ? ") |
e8fdcce7 | 237 | (if (>= (expression-precedence then) (op-precedence 'js:?)) |
839600e9 VS |
238 | (parenthesize-print then) |
239 | (ps-print then)) | |
4ff112cb | 240 | (psw " : ") |
e8fdcce7 | 241 | (if (>= (expression-precedence else) (op-precedence 'js:?)) |
5705b542 VS |
242 | (parenthesize-print else) |
243 | (ps-print else))) | |
cc4f1551 | 244 | |
0ce67a33 | 245 | (defprinter js:= (lhs rhs) |
4ff112cb | 246 | (ps-print lhs) (psw " = ") (ps-print rhs)) |
cc4f1551 | 247 | |
0ce67a33 | 248 | (defprinter js:var (var-name &rest var-value) |
4ff112cb | 249 | (psw "var ") |
dd4442b8 | 250 | (psw (symbol-to-js-string var-name)) |
839600e9 | 251 | (when var-value |
4ff112cb | 252 | (psw " = ") |
839600e9 | 253 | (ps-print (car var-value)))) |
cc4f1551 | 254 | |
0ce67a33 | 255 | (defprinter js:break (&optional label) |
c452748e TC |
256 | (psw "break") |
257 | (when label | |
258 | (psw " ") | |
dd4442b8 | 259 | (psw (symbol-to-js-string label)))) |
c452748e | 260 | |
0ce67a33 | 261 | (defprinter js:continue (&optional label) |
c452748e TC |
262 | (psw "continue") |
263 | (when label | |
264 | (psw " ") | |
dd4442b8 | 265 | (psw (symbol-to-js-string label)))) |
c452748e | 266 | |
cc4f1551 | 267 | ;;; iteration |
0ce67a33 | 268 | (defprinter js:for (label vars tests steps body-block) |
dd4442b8 | 269 | (when label (psw (symbol-to-js-string label)) (psw ": ") (newline-and-indent)) |
4ff112cb VS |
270 | (psw "for (") |
271 | (loop for ((var-name . var-init) . remaining) on vars | |
272 | for decl = "var " then "" do | |
dd4442b8 | 273 | (psw decl) (psw (symbol-to-js-string var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", "))) |
4ff112cb | 274 | (psw "; ") |
6a2ce72d TC |
275 | (loop for (test . remaining) on tests do |
276 | (ps-print test) (when remaining (psw ", "))) | |
4ff112cb | 277 | (psw "; ") |
6a2ce72d TC |
278 | (loop for (step . remaining) on steps do |
279 | (ps-print step) (when remaining (psw ", "))) | |
4ff112cb | 280 | (psw ") ") |
116f7450 | 281 | (ps-print body-block)) |
cc4f1551 | 282 | |
0ce67a33 | 283 | (defprinter js:for-in (var object body-block) |
5ffb1eba | 284 | (psw "for (var ") (ps-print var) (psw " in ") |
6a46e1ef TC |
285 | (if (> (expression-precedence object) (op-precedence 'in)) |
286 | (parenthesize-print object) | |
287 | (ps-print object)) | |
288 | (psw ") ") | |
116f7450 | 289 | (ps-print body-block)) |
cc4f1551 | 290 | |
0ce67a33 | 291 | (defprinter js:while (test body-block) |
4ff112cb | 292 | (psw "while (") (ps-print test) (psw ") ") |
116f7450 | 293 | (ps-print body-block)) |
4a987e2b | 294 | |
0ce67a33 | 295 | (defprinter js:with (expression body-block) |
4ff112cb | 296 | (psw "with (") (ps-print expression) (psw ") ") |
116f7450 | 297 | (ps-print body-block)) |
4a987e2b | 298 | |
0ce67a33 | 299 | (defprinter js:switch (test clauses) |
116f7450 VS |
300 | (flet ((print-body-statements (body-statements) |
301 | (incf *indent-level*) | |
302 | (loop for statement in body-statements do | |
303 | (progn (newline-and-indent) | |
304 | (ps-print statement) | |
4ff112cb | 305 | (psw #\;))) |
116f7450 | 306 | (decf *indent-level*))) |
4ff112cb | 307 | (psw "switch (") (ps-print test) (psw ") {") |
e0032a96 | 308 | (loop for (val . statements) in clauses |
116f7450 | 309 | do (progn (newline-and-indent) |
675edae3 | 310 | (if (eq val 'default) |
4ff112cb | 311 | (progn (psw "default: ") |
e0032a96 | 312 | (print-body-statements statements)) |
4ff112cb | 313 | (progn (psw "case ") |
116f7450 | 314 | (ps-print val) |
4ff112cb | 315 | (psw #\:) |
e0032a96 VS |
316 | (print-body-statements statements))))) |
317 | (newline-and-indent) | |
4ff112cb | 318 | (psw #\}))) |
116f7450 | 319 | |
0ce67a33 | 320 | (defprinter js:try (body-block &key catch finally) |
4ff112cb | 321 | (psw "try ") |
116f7450 | 322 | (ps-print body-block) |
839600e9 | 323 | (when catch |
dd4442b8 | 324 | (psw " catch (") (psw (symbol-to-js-string (first catch))) (psw ") ") |
839600e9 VS |
325 | (ps-print (second catch))) |
326 | (when finally | |
4ff112cb | 327 | (psw " finally ") |
116f7450 | 328 | (ps-print finally))) |
cc4f1551 RD |
329 | |
330 | ;;; regex | |
0ce67a33 | 331 | (defprinter js:regex (regex) |
4a987e2b | 332 | (flet ((first-slash-p (string) |
839600e9 | 333 | (and (> (length string) 0) (char= (char string 0) #\/)))) |
4a987e2b | 334 | (let ((slash (unless (first-slash-p regex) "/"))) |
cb8f8e58 | 335 | (psw (format nil (concatenate 'string slash "~A" slash) regex))))) |
cc4f1551 | 336 | |
cc4f1551 | 337 | ;;; conditional compilation |
0ce67a33 | 338 | (defprinter js:cc-if (test &rest body) |
4ff112cb | 339 | (psw "/*@if ") |
839600e9 | 340 | (ps-print test) |
116f7450 | 341 | (incf *indent-level*) |
0ce67a33 | 342 | (dolist (form body) |
4ff112cb | 343 | (newline-and-indent) (ps-print form) (psw #\;)) |
116f7450 VS |
344 | (decf *indent-level*) |
345 | (newline-and-indent) | |
4ff112cb | 346 | (psw "@end @*/")) |
cc4f1551 | 347 | |
0ce67a33 | 348 | (defprinter js:instanceof (value type) |
6a46e1ef | 349 | (psw #\() |
0ce67a33 | 350 | (if (> (expression-precedence value) (op-precedence 'js:instanceof)) |
6a46e1ef TC |
351 | (parenthesize-print value) |
352 | (ps-print value)) | |
353 | (psw " instanceof ") | |
0ce67a33 | 354 | (if (> (expression-precedence type) (op-precedence 'js:instanceof)) |
6a46e1ef TC |
355 | (parenthesize-print type) |
356 | (ps-print type)) | |
357 | (psw #\))) | |
358 | ||
0ce67a33 | 359 | (defprinter js:escape (literal-js) |
ceb1f277 | 360 | ;; literal-js should be a form that evaluates to a string containing valid JavaScript |
0ce67a33 | 361 | (psw literal-js)) |
cb8f8e58 | 362 | |
6a46e1ef | 363 | ;;; named statements |
0ce67a33 VS |
364 | (defprinter js:throw (x) |
365 | (psw "throw ") (ps-print x)) | |
366 | ||
367 | (defprinter js:return (x) | |
368 | (psw "return ") (ps-print x)) |