Commit | Line | Data |
---|---|---|
5aa10005 RD |
1 | (in-package :parenscript) |
2 | ||
3 | (defparameter *js-lisp-escaped-chars* | |
4 | '((#\' . #\') | |
5 | (#\\ . #\\) | |
6 | (#\b . #\Backspace) | |
7 | (#\f . #.(code-char 12)) | |
8 | (#\n . #\Newline) | |
9 | (#\r . #\Return) | |
10 | (#\t . #\Tab))) | |
11 | ||
12 | (defparameter *char-escape-table* | |
13 | (let ((hash (make-hash-table))) | |
14 | (dolist (escape-pair *js-lisp-escaped-chars* hash) | |
15 | (setf (gethash (cdr escape-pair) hash) (car escape-pair))))) | |
16 | ||
17 | (declaim (inline lisp-special-char-to-js-2)) | |
18 | (defun lisp-special-char-to-js-2 (lisp-char) | |
19 | "Gets the escaped version " | |
20 | (gethash lisp-char *char-escape-table*)) | |
21 | ||
22 | (defgeneric js-translate (ast-node expression-or-statement stream) | |
23 | (:documentation "Translates the given AST node to Javascript. | |
24 | expression-or-statement is either the keyword :statement or :expression")) | |
25 | ||
26 | (defmacro defjstrans (script-class type-spec (node-var stream-var) &body body) | |
27 | "Generates a translate-to-js definition for the special-form class SCRIPT-CLASS | |
28 | where type-spec is either :expression or :statement. STREAM is the output stream | |
29 | where we should place the Javascript." | |
30 | (when (not (or (eql :expression type-spec) (eql :statement type-spec))) | |
31 | (error "Invalid type-spec fo DEFJSTRANS form.")) | |
32 | `(defmethod js-translate ((,node-var ,script-class) (spec (eql ,type-spec)) ,stream-var) | |
33 | ,@body)) | |
34 | ||
35 | (defjstrans expression :expression (expr stream) | |
36 | (princ (value expr) stream)) | |
37 | ||
38 | (defjstrans expression :statement (expr stream) | |
39 | (princ (value expr) stream)) | |
40 | ||
41 | (defjstrans statement :statement (statement stream) | |
42 | (princ (value statement) stream)) | |
43 | ||
44 | (defmacro dolist+ ((car-var list &key result-form lastp-var) &body body) | |
45 | "Iterates over a list, giving other information in bindings designated | |
46 | by the keyword arguments." | |
47 | (let ((sublist-var (gensym))) | |
48 | `(progn | |
49 | (mapl | |
50 | #'(lambda (,sublist-var) | |
51 | (let ((,car-var (car ,sublist-var)) | |
52 | ,@(when lastp-var | |
53 | (list `(,lastp-var (not (cdr ,sublist-var)))))) | |
54 | ,@body)) | |
55 | ,list) | |
56 | ,result-form))) | |
57 | ||
58 | ||
59 | (defjstrans array-literal :expression (array stream) | |
60 | (write-char #\[ stream) | |
61 | (dolist+ (array-item (array-values array) :lastp-var last?) | |
62 | (js-translate array-item :expression stream) | |
63 | (when (not last?) (princ ","))) | |
64 | (write-char #\] stream)) | |
65 | ||
66 | (defjstrans script-aref :expression (aref stream) | |
67 | (js-translate (aref-array aref) :expression stream) | |
68 | (princ "[") | |
69 | (js-translate (aref-index aref) :expression stream) | |
70 | (princ "]")) | |
71 | ||
72 | (defjstrans object-literal :expression (obj stream) | |
73 | (princ "{") | |
74 | (dolist+ (obj-pair (object-values obj) :lastp-var last?) | |
75 | (js-translate (car obj-pair) :expression stream) | |
76 | (princ ":") | |
77 | (js-translate (cdr obj-pair) :expression stream) | |
78 | (when (not last?) (princ ","))) | |
79 | (princ "}")) | |
80 | ||
81 | (defjstrans string-literal :expression (string stream) | |
82 | (declare (inline lisp-special-char-to-js-2)) | |
83 | (write-char *js-quote-char* stream) | |
84 | (loop | |
85 | for char across (value string) | |
86 | for code = (char-code char) | |
87 | for special = (lisp-special-char-to-js-2 char) | |
88 | do | |
89 | (cond | |
90 | (special | |
91 | (write-char #\\ stream) | |
92 | (write-char special stream)) | |
93 | ((or (<= code #x1f) (>= code #x80)) | |
94 | (format stream "\\u~4,'0x" code)) | |
95 | (t (write-char char stream))) | |
96 | finally (write-char *js-quote-char* stream))) | |
97 | ||
98 | (defjstrans script-variable :expression (var stream) | |
99 | (princ (symbol-to-js (value var)) stream)) | |
100 | ||
101 | (defjstrans op-form :expression (op-form stream) | |
102 | (let ((precedence (expression-precedence op-form))) | |
103 | (flet ((output-op-arg (op-arg) | |
104 | (let ((parens? (>= (expression-precedence op-arg) precedence))) | |
105 | (when parens? (write-char #\()) | |
106 | (js-translate op-arg :expression stream) | |
107 | (when parens? (write-char #\)))))) | |
108 | (output-op-arg (first (op-args op-form))) | |
109 | (format stream "~A " (operator op-form)) | |
110 | (output-op-arg (second (op-args op-form)))))) | |
111 | ||
112 | (defjstrans one-op :expression (one-op stream) | |
113 | (let ((pre? (one-op-pre-p one-op))) | |
114 | (when pre? | |
115 | (princ (one-op one-op) stream)) | |
116 | (js-translate (value one-op) :expression stream) | |
117 | (when (not pre?) | |
118 | (princ (one-op one-op) stream)))) |