src/js-source-model.lisp

   1 (in-package :parenscript)
   2
   3 (defgeneric script-equal (compiled-ast-node1 compiled-ast-node2)
   4   (:documentation "Determines if the AST nodes are equal."))
   5
   6 ;;; AST node equality
   7 (defmethod script-equal ((obj1 list) (obj2 list))
   8   (and (= (length obj1) (length obj2))
   9        (every #'script-equal obj1 obj2)))
  10
  11 (defmethod script-equal ((obj1 t) (obj2 t))
  12   (equal obj1 obj2))
  13
  14 (defmacro defscriptclass (name superclasses slots &rest class-options)
  15   (let ((slot-names (mapcar #'(lambda (slot) (if (atom slot) slot (first slot))) slots)))
  16     `(progn
  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)))
  23                ',slot-names)))))
  24
  25 (in-package :parenscript.javascript)
  26
  27 (defgeneric expression-precedence (expression)
  28   (:documentation "Returns the precedence of an enscript-javascript expression"))
  29
  30 ;;;; define Javascript language types
  31 (defclass statement ()
  32   ((value :initarg :value :accessor value :initform nil))
  33   (:documentation "A Javascript entity without a value."))
  34
  35 (defclass expression (statement)
  36   ()
  37   (:documentation "A Javascript entity with a value."))
  38
  39 ;;; array literals
  40 (defscriptclass array-literal (expression)
  41   ((values :initarg :values :accessor array-values)))
  42
  43 (defscriptclass js-aref (expression)
  44   ((array :initarg :array
  45           :accessor aref-array)
  46    (index :initarg :index
  47           :accessor aref-index)))
  48
  49 ;;; object literals (maps and hash-tables)
  50 (defscriptclass object-literal (expression)
  51   ((values :initarg :values :accessor object-values)))
  52
  53 ;;; string literals
  54 (defscriptclass string-literal (expression)
  55   (value))
  56
  57
  58 ;;; number literals
  59 (defscriptclass number-literal (expression)
  60   (value))
  61
  62 ;;; variables
  63 (defscriptclass js-variable (expression)
  64   (value))
  65
  66 ;;; operators
  67 (defscriptclass op-form (expression)
  68   ((operator :initarg :operator :accessor operator)
  69    (args :initarg :args :accessor op-args)))
  70
  71 (eval-when (:compile-toplevel :load-toplevel :execute)
  72   (defparameter *op-precedence-hash* (make-hash-table :test #'equal))
  73
  74   ;;; generate the operator precedences from *OP-PRECEDENCES*
  75   (let ((precedence 1))
  76     (dolist (ops '((aref)
  77                    (slot-value)
  78                    (! not ~)
  79                    (* / %)
  80                    (+ -)
  81                    (<< >>)
  82                    (>>>)
  83                    (< > <= >=)
  84                    (in if)
  85                    (eql == != =)
  86                    (=== !==)
  87                    (&)
  88                    (^)
  89                    (\|)
  90                    (\&\& and)
  91                    (\|\| or)
  92                    (setf *= /= %= += -= <<= >>= >>>= \&= ^= \|=)
  93                    (comma)))
  94       (dolist (op ops)
  95         (let ((op-name (symbol-name op)))
  96           (setf (gethash op-name *op-precedence-hash*) precedence)))
  97       (incf precedence)))
  98
  99   (defun op-precedence (op)
 100     (gethash (if (symbolp op)
 101                  (symbol-name op)
 102                  op)
 103              *op-precedence-hash*)))
 104
 105 (defscriptclass one-op (expression)
 106   ((pre-p :initarg :pre-p
 107           :initform nil
 108           :accessor one-op-pre-p)
 109    (op :initarg :op
 110        :accessor one-op)))
 111
 112 ;;; function calls
 113 (defscriptclass function-call (expression)
 114   ((function :initarg :function :accessor f-function)
 115    (args :initarg :args :accessor f-args)))
 116
 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)))
 121
 122 ;;; body forms
 123 (defscriptclass js-block (expression)
 124   ((statements :initarg :statements :accessor block-statements)
 125    (indent :initarg :indent :initform "" :accessor block-indent)))
 126
 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))))))
 136
 137 (defscriptclass js-sub-block (js-block)
 138   (statements indent))
 139
 140 ;;; function definition
 141 (defscriptclass js-lambda (expression)
 142   ((args :initarg :args :accessor lambda-args)
 143    (body :initarg :body :accessor lambda-body)))
 144
 145 (defscriptclass js-defun (js-lambda)
 146   ((name :initarg :name :accessor defun-name)))
 147
 148 ;;; object creation
 149 (defscriptclass js-object (expression)
 150   ((slots :initarg :slots
 151           :accessor o-slots)))
 152
 153 (defscriptclass js-slot-value (expression)
 154   ((object :initarg :object
 155            :accessor sv-object)
 156    (slot :initarg :slot
 157          :accessor sv-slot)))
 158
 159 ;;; cond
 160 (defscriptclass js-cond (expression)
 161   ((tests :initarg :tests
 162           :accessor cond-tests)
 163    (bodies :initarg :bodies
 164            :accessor cond-bodies)))
 165
 166 (defscriptclass js-if (expression)
 167   ((test :initarg :test
 168          :accessor if-test)
 169    (then :initarg :then
 170          :accessor if-then)
 171    (else :initarg :else
 172          :accessor if-else)))
 173
 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)))
 182
 183 ;;; switch
 184 (defscriptclass js-switch (statement)
 185   ((value :initarg :value :accessor case-value)
 186    (clauses :initarg :clauses :accessor case-clauses)))
 187
 188 ;;; assignment
 189
 190 (defscriptclass js-setf (expression)
 191   ((lhs :initarg :lhs :accessor setf-lhs)
 192    (rhsides :initarg :rhsides :accessor setf-rhsides)))
 193
 194 ;;; defvar
 195 (defscriptclass js-defvar (statement)
 196   ((names :initarg :names :accessor var-names)
 197    (value :initarg :value :accessor var-value)))
 198
 199 ;;; iteration
 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)))
 205
 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)))
 210
 211 (defscriptclass js-while (statement)
 212   ((check :initarg :check :accessor while-check)
 213    (body :initarg :body :accessor while-body)))
 214
 215 ;;; with
 216 (defscriptclass js-with (statement)
 217   ((obj :initarg :obj :accessor with-obj)
 218    (body :initarg :body :accessor with-body)))
 219
 220 ;;; try-catch
 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)))
 225
 226 ;;; regular expressions
 227 (defscriptclass regex (expression)
 228   (value))
 229
 230 ;;; conditional compilation
 231 (defscriptclass cc-if ()
 232   ((test :initarg :test :accessor cc-if-test)
 233    (body :initarg :body :accessor cc-if-body)))
 234
 235 ;; TODO this may not be the best integrated implementation of
 236 ;; instanceof into the rest of the code
 237 (defscriptclass js-instanceof (expression)
 238   ((value)
 239    (type :initarg :type)))
 240
 241 (defmacro define-js-single-op (name &optional (superclass 'expression))
 242   (let ((js-name (intern (concatenate 'string "JS-" (symbol-name name)) #.*package*)))
 243   `(progn
 244     (defscriptclass ,js-name (,superclass)
 245       (value)))))
 246
 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)