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