1 (in-package :parenscript
)
3 (defgeneric script-equal
(compiled-ast-node1 compiled-ast-node2
)
4 (:documentation
"Determines if the AST nodes are equal."))
7 (defmethod script-equal ((obj1 list
) (obj2 list
))
8 (and (= (length obj1
) (length obj2
))
9 (every #'script-equal obj1 obj2
)))
11 (defmethod script-equal ((obj1 t
) (obj2 t
))
14 (defmacro defscriptclass
(name superclasses slots
&rest class-options
)
15 (let ((slot-names (mapcar #'(lambda (slot) (if (atom slot
) slot
(first slot
))) slots
)))
17 (defclass ,name
,superclasses
18 ,slots
,@class-options
)
19 (defmethod script-equal ((obj1 ,name
) (obj2 ,name
))
20 (every #'(lambda (slot)
21 (script-equal (slot-value obj1 slot
)
22 (slot-value obj2 slot
)))
25 (in-package :parenscript.javascript
)
27 (defgeneric expression-precedence
(expression)
28 (:documentation
"Returns the precedence of an enscript-javascript expression"))
30 ;;;; define Javascript language types
31 (defclass statement
()
32 ((value :initarg
:value
:accessor value
:initform nil
))
33 (:documentation
"A Javascript entity without a value."))
35 (defclass expression
(statement)
37 (:documentation
"A Javascript entity with a value."))
40 (defscriptclass array-literal
(expression)
41 ((values :initarg
:values
:accessor array-values
)))
43 (defscriptclass js-aref
(expression)
44 ((array :initarg
:array
46 (index :initarg
:index
47 :accessor aref-index
)))
49 ;;; object literals (maps and hash-tables)
50 (defscriptclass object-literal
(expression)
51 ((values :initarg
:values
:accessor object-values
)))
54 (defscriptclass string-literal
(expression)
59 (defscriptclass number-literal
(expression)
63 (defscriptclass js-variable
(expression)
67 (defscriptclass op-form
(expression)
68 ((operator :initarg
:operator
:accessor operator
)
69 (args :initarg
:args
:accessor op-args
)))
71 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
72 (defparameter *op-precedence-hash
* (make-hash-table :test
#'equal
))
74 ;;; generate the operator precedences from *OP-PRECEDENCES*
92 (setf *= /= %
= += -
= <<= >>= >>>= \
&= ^
= \|
=)
95 (let ((op-name (symbol-name op
)))
96 (setf (gethash op-name
*op-precedence-hash
*) precedence
)))
99 (defun op-precedence (op)
100 (gethash (if (symbolp op
)
103 *op-precedence-hash
*)))
105 (defscriptclass one-op
(expression)
106 ((pre-p :initarg
:pre-p
108 :accessor one-op-pre-p
)
113 (defscriptclass function-call
(expression)
114 ((function :initarg
:function
:accessor f-function
)
115 (args :initarg
:args
:accessor f-args
)))
117 (defscriptclass method-call
(expression)
118 ((method :initarg
:method
:accessor m-method
)
119 (object :initarg
:object
:accessor m-object
)
120 (args :initarg
:args
:accessor m-args
)))
123 (defscriptclass js-block
(expression)
124 ((statements :initarg
:statements
:accessor block-statements
)
125 (indent :initarg
:indent
:initform
"" :accessor block-indent
)))
127 (defmethod initialize-instance :after
((block js-block
) &rest initargs
)
128 (declare (ignore initargs
))
129 (let* ((statements (block-statements block
))
130 (last (last statements
))
131 (last-stmt (car last
)))
132 (when (typep last-stmt
'js-block
)
133 (setf (block-statements block
)
134 (nconc (butlast statements
)
135 (block-statements last-stmt
))))))
137 (defscriptclass js-sub-block
(js-block)
140 ;;; function definition
141 (defscriptclass js-lambda
(expression)
142 ((args :initarg
:args
:accessor lambda-args
)
143 (body :initarg
:body
:accessor lambda-body
)))
145 (defscriptclass js-defun
(js-lambda)
146 ((name :initarg
:name
:accessor defun-name
)))
149 (defscriptclass js-object
(expression)
150 ((slots :initarg
:slots
153 (defscriptclass js-slot-value
(expression)
154 ((object :initarg
:object
160 (defscriptclass js-cond
(expression)
161 ((tests :initarg
:tests
162 :accessor cond-tests
)
163 (bodies :initarg
:bodies
164 :accessor cond-bodies
)))
166 (defscriptclass js-if
(expression)
167 ((test :initarg
:test
174 (defmethod initialize-instance :after
((if js-if
) &rest initargs
)
175 (declare (ignore initargs
))
176 (when (and (if-then if
)
177 (typep (if-then if
) 'js-sub-block
))
178 (change-class (if-then if
) 'js-block
))
179 (when (and (if-else if
)
180 (typep (if-else if
) 'js-sub-block
))
181 (change-class (if-else if
) 'js-block
)))
184 (defscriptclass js-switch
(statement)
185 ((value :initarg
:value
:accessor case-value
)
186 (clauses :initarg
:clauses
:accessor case-clauses
)))
190 (defscriptclass js-setf
(expression)
191 ((lhs :initarg
:lhs
:accessor setf-lhs
)
192 (rhsides :initarg
:rhsides
:accessor setf-rhsides
)))
195 (defscriptclass js-defvar
(statement)
196 ((names :initarg
:names
:accessor var-names
)
197 (value :initarg
:value
:accessor var-value
)))
200 (defscriptclass js-for
(statement)
201 ((vars :initarg
:vars
:accessor for-vars
)
202 (steps :initarg
:steps
:accessor for-steps
)
203 (check :initarg
:check
:accessor for-check
)
204 (body :initarg
:body
:accessor for-body
)))
206 (defscriptclass for-each
(statement)
207 ((name :initarg
:name
:accessor fe-name
)
208 (value :initarg
:value
:accessor fe-value
)
209 (body :initarg
:body
:accessor fe-body
)))
211 (defscriptclass js-while
(statement)
212 ((check :initarg
:check
:accessor while-check
)
213 (body :initarg
:body
:accessor while-body
)))
216 (defscriptclass js-with
(statement)
217 ((obj :initarg
:obj
:accessor with-obj
)
218 (body :initarg
:body
:accessor with-body
)))
221 (defscriptclass js-try
(statement)
222 ((body :initarg
:body
:accessor try-body
)
223 (catch :initarg
:catch
:accessor try-catch
)
224 (finally :initarg
:finally
:accessor try-finally
)))
226 ;;; regular expressions
227 (defscriptclass regex
(expression)
230 ;;; conditional compilation
231 (defscriptclass cc-if
()
232 ((test :initarg
:test
:accessor cc-if-test
)
233 (body :initarg
:body
:accessor cc-if-body
)))
235 ;; TODO this may not be the best integrated implementation of
236 ;; instanceof into the rest of the code
237 (defscriptclass js-instanceof
(expression)
239 (type :initarg
:type
)))
241 (defmacro define-js-single-op
(name &optional
(superclass 'expression
))
242 (let ((js-name (intern (concatenate 'string
"JS-" (symbol-name name
)) #.
*package
*)))
244 (defscriptclass ,js-name
(,superclass
)
247 (define-js-single-op return statement
)
248 (define-js-single-op throw statement
)
249 (define-js-single-op delete
)
250 (define-js-single-op void
)
251 (define-js-single-op typeof
)
252 (define-js-single-op new
)