src/js-ugly-translation.lisp

   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))))