src/js-translation.lisp

   1 (in-package :parenscript.javascript)
   2
   3 (defgeneric js-to-strings (expression start-pos)
   4   (:documentation "Transform an enscript-javascript expression to a string"))
   5
   6 (defgeneric js-to-statement-strings (code-fragment start-pos)
   7   (:documentation "Transform an enscript-javascript code fragment to a string"))
   8
   9 ;;; indenter
  10
  11 (defun special-append-to-last (form elt)
  12   (flet ((special-append (form elt)
  13            (let ((len (length form)))
  14              (if (and (> len 0)
  15                       (string= (char form (1- len)) elt))
  16                  form
  17                  (concatenate 'string form elt)))))
  18     (cond ((stringp form)
  19            (special-append form elt))
  20           ((consp form)
  21            (let ((last (last form)))
  22              (if (stringp (car last))
  23                  (rplaca last (special-append (car last) elt))
  24                  (append-to-last (car last) elt))
  25            form))
  26           (t (error "unsupported form ~S" form)))))
  27
  28 (defun dwim-join (value-string-lists max-length
  29                   &key (start "")
  30                        end
  31                        (join-before "")
  32                        join-after
  33                        (white-space (make-string (length start) :initial-element #\Space))
  34                        (separator " ")
  35                   (append-to-last #'append-to-last)
  36                   (collect t))
  37     #+nil
  38     (format t "value-string-lists: ~S~%" value-string-lists)
  39
  40     ;;; collect single value-string-lists until line full
  41
  42     (do* ((string-lists value-string-lists (cdr string-lists))
  43           (string-list (car string-lists) (car string-lists))
  44           (cur-elt start)
  45           (is-first t nil)
  46           (cur-empty t)
  47           (res nil))
  48          ((null string-lists)
  49           (unless cur-empty
  50             (push cur-elt res))
  51           (if (null res)
  52               (list (concatenate 'string start end))
  53               (progn
  54                 (when end
  55                   (setf (first res)
  56                         (funcall append-to-last (first res) end)))
  57                 (nreverse res))))
  58       #+nil
  59       (format t "string-list: ~S~%" string-list)
  60
  61       (when join-after
  62         (unless (null (cdr string-lists))
  63           (funcall append-to-last string-list join-after)))
  64
  65       (if (and collect (= (length string-list) 1))
  66           (progn
  67             #+nil
  68             (format t "cur-elt: ~S line-length ~D, max-length ~D, string: ~S~%"
  69                     cur-elt
  70                     (+ (length (first string-list))
  71                        (length cur-elt))
  72                     max-length
  73                     (first string-list))
  74             (if (or cur-empty
  75                     (< (+ (length (first string-list))
  76                           (length cur-elt)) max-length))
  77                 (setf cur-elt
  78                       (concatenate 'string cur-elt
  79                                    (if (or is-first (and cur-empty (string= join-before "")))
  80                                         "" (concatenate 'string separator join-before))
  81                                    (first string-list))
  82                       cur-empty nil)
  83                 (progn
  84                   (push cur-elt res)
  85                   (setf cur-elt (concatenate 'string white-space
  86                                              join-before (first string-list))
  87                         cur-empty nil))))
  88
  89           (progn
  90             (unless cur-empty
  91               (push cur-elt res)
  92               (setf cur-elt white-space
  93                     cur-empty t))
  94             (setf res (nconc (nreverse
  95                               (cons (concatenate 'string
  96                                                  cur-elt
  97                                                  (if (null res)
  98                                                      "" join-before)
  99                                                  (first string-list))
 100                                     (mapcar #'(lambda (x) (concatenate 'string white-space x))
 101                                             (cdr string-list))))
 102                              res))
 103             (setf cur-elt white-space cur-empty t)))))
 104
 105 (defmethod js-to-strings ((expression expression) start-pos)
 106   (declare (ignore start-pos))
 107   (list (princ-to-string (value expression))))
 108
 109 (defmethod js-to-statement-strings ((expression expression) start-pos)
 110   (js-to-strings expression start-pos))
 111
 112 (defmethod js-to-statement-strings ((statement statement) start-pos)
 113   (declare (ignore start-pos))
 114   (list (princ-to-string (value statement))))
 115
 116 (defmethod js-to-strings ((expression script-quote) start-pos)
 117   (declare (ignore start-pos))
 118   (list
 119    (if (eql nil (value expression))
 120        "null"
 121        (case (value expression)
 122          (t (error "Cannot translate quoted value ~S to javascript" (value expression)))))))
 123
 124 ;;; array literals
 125
 126 (defmethod js-to-strings ((array array-literal) start-pos)
 127   (let ((value-string-lists
 128          (mapcar #'(lambda (x) (js-to-strings x (+ start-pos 2)))
 129                  (array-values array)))
 130         (max-length (- 80 start-pos 2)))
 131     (dwim-join value-string-lists max-length
 132                :start "[ " :end " ]"
 133                :join-after ",")))
 134
 135 (defmethod js-to-strings ((aref js-aref) start-pos)
 136   (dwim-join (cons (js-to-strings (aref-array aref) start-pos)
 137                    (mapcar #'(lambda (x) (dwim-join (list (js-to-strings x (+ start-pos 2)))
 138                                                     (- 80 start-pos 2)
 139                                                     :start "[" :end "]"))
 140                            (aref-index aref)))
 141              (- 80 start-pos 2) :separator ""
 142              :white-space "  "))
 143
 144 ;;; object literals (maps and hash-tables)
 145
 146 (defmethod js-to-strings ((obj object-literal) start-pos)
 147   (dwim-join
 148    (loop
 149     for (key . value) in (object-values obj)
 150     append (list
 151             (dwim-join (list (list (format nil "~A:" (js-translate-symbol key)))
 152                              (js-to-strings value (+ start-pos 2)))
 153                        (- 80 start-pos 2)
 154                        :start "" :end "" :join-after "")))
 155    (- 80 start-pos 2)
 156    :start "{ " :end " }"
 157    :join-after ","))
 158
 159 ;;; string literals
 160
 161 (defvar *js-quote-char* #\'
 162   "Specifies which character JS sholud use for delimiting strings.
 163
 164 This variable is usefull when have to embed some javascript code
 165 in an html attribute delimited by #\\\" as opposed to #\\', or
 166 vice-versa.")
 167
 168 (defparameter *js-lisp-escaped-chars*
 169   '((#\' . #\')
 170     (#\\ . #\\)
 171     (#\b . #\Backspace)
 172     (#\f . #.(code-char 12))
 173     (#\n . #\Newline)
 174     (#\r . #\Return)
 175     (#\t . #\Tab)))
 176
 177 (defun lisp-special-char-to-js (lisp-char)
 178     (car (rassoc lisp-char *js-lisp-escaped-chars*)))
 179
 180 (defmethod js-to-strings ((string string-literal) start-pos)
 181   (declare (ignore start-pos)
 182            (inline lisp-special-char-to-js))
 183   (list (with-output-to-string (escaped)
 184           (write-char *js-quote-char*  escaped)
 185           (loop
 186            for char across (value string)
 187            for code = (char-code char)
 188            for special = (lisp-special-char-to-js char)
 189            do
 190            (cond
 191              (special
 192               (write-char #\\ escaped)
 193               (write-char special escaped))
 194              ((or (<= code #x1f) (>= code #x80))
 195               (format escaped "\\u~4,'0x" code))
 196              (t (write-char char escaped)))
 197            finally (write-char *js-quote-char* escaped)))))
 198
 199 ;;; variables
 200 (defgeneric js-translate-symbol-contextually (symbol package env)
 201   (:documentation "Translates a symbol to a string in the given environment & package
 202 and for the given symbol."))
 203
 204 (defparameter *obfuscate-standard-identifiers* nil)
 205
 206 (defparameter *obfuscation-table* (make-hash-table))
 207
 208 (defun obfuscated-symbol (symbol)
 209   (or (gethash symbol *obfuscation-table*)
 210       (setf (gethash symbol *obfuscation-table*) (string (gensym)))))
 211
 212 (defmethod js-translate-symbol-contextually ((symbol symbol)
 213                                              (package ps::script-package)
 214                                              (env ps::compilation-environment))
 215   (cond
 216     ((member (ps::script-package-lisp-package package)
 217              (mapcar #'find-package '(:keyword :parenscript.global)))
 218      (symbol-to-js symbol))
 219     (*obfuscate-standard-identifiers*
 220      (obfuscated-symbol symbol))
 221     (t
 222      (case *package-prefix-style*
 223        (:prefix
 224         (format nil "~A~A"
 225                 (or (ps::script-package-prefix package) (concatenate 'string (ps::script-package-name package) "_"))
 226                 (symbol-to-js symbol)))
 227        (t
 228         (symbol-to-js (value symbol)))))))
 229
 230 (defgeneric js-translate-symbol (var)
 231   (:documentation "Given a JS-VARIABLE returns an output
 232 JavaScript version of it as a string."))
 233
 234 (defmethod js-translate-symbol ((var js-variable))
 235   (js-translate-symbol (value var)))
 236
 237 (defmethod js-translate-symbol ((var-name symbol))
 238   (js-translate-symbol-contextually var-name (ps::symbol-script-package var-name) ps::*compilation-environment*))
 239
 240 (defmethod js-to-strings ((v js-variable) start-form)
 241   (declare (ignore start-form))
 242   (list (js-translate-symbol v)))
 243
 244 ;;; arithmetic operators
 245 (defun script-convert-op-name (op)
 246   (case op
 247     (and '\&\&)
 248     (or '\|\|)
 249     (not '!)
 250     (eql '\=\=)
 251     (=   '\=\=)
 252     (t op)))
 253
 254 (defun op-form-p (form)
 255   (and (listp form)
 256        (not (script-special-form-p form))
 257        (not (null (op-precedence (first form))))))
 258
 259 (defun klammer (string-list)
 260   (prepend-to-first string-list "(")
 261   (append-to-last string-list ")")
 262   string-list)
 263
 264 (defmethod expression-precedence ((expression expression))
 265   0)
 266
 267 (defmethod expression-precedence ((form op-form))
 268   (op-precedence (operator form)))
 269
 270 (defmethod js-to-strings ((form op-form) start-pos)
 271   (let* ((precedence (expression-precedence form))
 272          (value-string-lists
 273           (mapcar #'(lambda (x)
 274                       (let ((string-list (js-to-strings x (+ start-pos 2))))
 275                         (if (>= (expression-precedence x) precedence)
 276                             (klammer string-list)
 277                             string-list)))
 278                   (op-args form)))
 279          (max-length (- 80 start-pos 2))
 280          (op-string (format nil "~A " (operator form))))
 281     (dwim-join value-string-lists max-length :join-before op-string)
 282     ))
 283
 284 (defmethod js-to-strings ((one-op one-op) start-pos)
 285   (let* ((value (value one-op))
 286          (value-strings (js-to-strings value start-pos)))
 287     (when (typep value 'op-form)
 288       (setf value-strings (klammer value-strings)))
 289     (if (one-op-pre-p one-op)
 290       (prepend-to-first value-strings
 291                         (one-op one-op))
 292       (append-to-last value-strings
 293                       (one-op one-op)))))
 294
 295 ;;; function calls
 296
 297 (defmethod js-to-strings ((form function-call) start-pos)
 298   (let* ((value-string-lists
 299           (mapcar #'(lambda (x) (js-to-strings x (+ start-pos 2)))
 300                   (f-args form)))
 301          (max-length (- 80 start-pos 2))
 302          (args (dwim-join value-string-lists max-length
 303                           :start "(" :end ")" :join-after ",")))
 304     (etypecase (f-function form)
 305       (js-lambda
 306        (dwim-join (list (append (dwim-join (list (js-to-strings (f-function form) (+ start-pos 2)))
 307                                            max-length
 308                                            :start "(" :end ")" :separator "")
 309                                 args))
 310                   max-length
 311                   :separator ""))
 312       ((or js-variable js-aref js-slot-value)
 313        (dwim-join (list (js-to-strings (f-function form) (+ start-pos 2))
 314                         args)
 315                   max-length
 316                   :separator ""))
 317       (function-call
 318        ;; TODO it adds superfluous newlines after each ()
 319        ;; and it's nearly the same as the js-lambda case above
 320        (dwim-join (list (append (dwim-join (list (js-to-strings (f-function form) (+ start-pos 2)))
 321                                            max-length :separator "")
 322                                 args))
 323                   max-length :separator "")))))
 324
 325 (defmethod js-to-strings ((form method-call) start-pos)
 326   (let ((object (js-to-strings (m-object form) (+ start-pos 2))))
 327     ;; TODO: this may not be the best way to add ()'s around lambdas
 328     ;; probably there is or should be a more general solution working
 329     ;; in other situations involving lambda's
 330     (when (member (m-object form) (list 'js-lambda 'number-literal 'js-object 'op-form)
 331                   :test #'typep)
 332       (push "(" object)
 333       (nconc object (list ")")))
 334     (let* ((fname (dwim-join (list object
 335                                    (list (js-translate-symbol (m-method form))))
 336                              (- 80 start-pos 2)
 337                              :end "("
 338                              :separator ""))
 339            (butlast (butlast fname))
 340            (last (car (last fname)))
 341            (method-and-args (dwim-join (mapcar #'(lambda (x) (js-to-strings x (+ start-pos 2)))
 342                                                (m-args form))
 343                                        (- 80 start-pos 2)
 344                                        :start last
 345                                        :end ")"
 346                                        :join-after ","))
 347            (ensure-no-newline-before-dot (concatenate 'string
 348                                                       (car (last butlast))
 349                                                       (first method-and-args))))
 350       (nconc (butlast butlast)
 351              (list ensure-no-newline-before-dot)
 352              (rest method-and-args)))))
 353
 354 ;;; optimization that gets rid of nested blocks, which have no meaningful effect
 355 ;;; in javascript
 356 (defgeneric expanded-subblocks (block)
 357   (:method (block)
 358     (list block))
 359   (:method ((block js-block))
 360     (mapcan #'expanded-subblocks (block-statements block))))
 361
 362 (defun consolidate-subblocks (block)
 363   (setf (block-statements block) (expanded-subblocks block))
 364   block)
 365
 366
 367 (defmethod js-to-statement-strings ((body js-block) start-pos)
 368   (consolidate-subblocks body)
 369   (dwim-join (mapcar #'(lambda (x) (js-to-statement-strings x (+ start-pos 2)))
 370                      (block-statements body))
 371              (- 80 start-pos 2)
 372              :join-after ";"
 373              :append-to-last #'special-append-to-last
 374              :start (block-indent body) :collect nil
 375              :end ";"))
 376
 377 (defmethod js-to-strings ((body js-block) start-pos)
 378   (dwim-join (mapcar #'(lambda (x) (js-to-strings x (+ start-pos 2)))
 379                      (block-statements body))
 380              (- 80 start-pos 2)
 381              :append-to-last #'special-append-to-last
 382              :join-after ","
 383              :start (block-indent body)))
 384
 385
 386 (defmethod js-to-statement-strings ((body js-sub-block) start-pos)
 387   (declare (ignore start-pos))
 388   (nconc (list "{") (call-next-method) (list "}")))
 389
 390 ;;; function definition
 391 (defmethod js-to-strings ((lambda js-lambda) start-pos)
 392   (let ((fun-header (dwim-join (mapcar #'(lambda (x)
 393                                            (list (js-translate-symbol x)))
 394                                        (lambda-args lambda))
 395                                (- 80 start-pos 2)
 396                                :start (function-start-string lambda)
 397                                :end ") {" :join-after ","))
 398         (fun-body (js-to-statement-strings (lambda-body lambda) (+ start-pos 2))))
 399     (nconc fun-header fun-body (list "}"))))
 400
 401 (defgeneric function-start-string (function)
 402   (:documentation "Returns the string that starts the function - this varies according to whether
 403 this is a lambda or a defun"))
 404
 405 (defmethod function-start-string ((lambda js-lambda))
 406   "function (")
 407
 408 (defmethod js-to-statement-strings ((lambda js-lambda) start-pos)
 409   (js-to-strings lambda start-pos))
 410
 411 (defmethod function-start-string ((defun js-defun))
 412   (format nil "function ~A(" (js-translate-symbol (defun-name defun))))
 413
 414 ;;; object creation
 415 (defmethod js-to-strings ((object js-object) start-pos)
 416   (let ((value-string-lists
 417          (mapcar #'(lambda (slot)
 418                      (let* ((slot-name (first slot))
 419                             (slot-string-name
 420                             (if (typep slot-name 'script-quote)
 421                                 (if (symbolp (value slot-name))
 422                                     (format nil "~A" (js-translate-symbol (value slot-name)))
 423                                     (format nil "~A" (first (js-to-strings slot-name 0))))
 424                                 (car (js-to-strings slot-name 0)))))
 425                        (dwim-join (list (js-to-strings (second slot) (+ start-pos 4)))
 426                                   (- 80 start-pos 2)
 427                                   :start (concatenate 'string slot-string-name  " : ")
 428                                   :white-space "    ")))
 429                  (o-slots object)))
 430         (max-length (- 80 start-pos 2)))
 431     (dwim-join value-string-lists max-length
 432                :start "{ "
 433                :end " }"
 434                :join-after ", "
 435                :white-space "  "
 436                :collect nil)))
 437
 438 (defmethod js-to-strings ((sv js-slot-value) start-pos)
 439   (append-to-last (if (typep (sv-object sv) 'js-variable)
 440                       (js-to-strings (sv-object sv) start-pos)
 441                       (list (format nil "~A" (js-to-strings (sv-object sv) start-pos))))
 442                   (if (typep (sv-slot sv) 'script-quote)
 443                       (if (symbolp (value (sv-slot sv)))
 444                           (format nil ".~A" (js-translate-symbol (value (sv-slot sv))))
 445                           (format nil ".~A" (first (js-to-strings (sv-slot sv) 0))))
 446                       (format nil "[~A]" (first (js-to-strings (sv-slot sv) 0))))))
 447
 448 ;;; cond
 449 (defmethod js-to-statement-strings ((cond js-cond) start-pos)
 450   (loop :for body :on (cond-bodies cond)
 451         :for first = (eq body (cond-bodies cond))
 452         :for last = (not (cdr body))
 453         :for test :in (cond-tests cond)
 454         :append (if (and last (not first) (string= (value test) "true"))
 455                     '("else {")
 456                     (dwim-join (list (js-to-strings test 0)) (- 80 start-pos 2)
 457                                :start (if first "if (" "else if (") :end ") {"))
 458         :append (js-to-statement-strings (car body) (+ start-pos 2))
 459         :collect "}"))
 460
 461 (defmethod js-to-statement-strings ((if js-if) start-pos)
 462   (let ((if-strings (dwim-join (list (js-to-strings (if-test if) 0))
 463                                (- 80 start-pos 2)
 464                                :start "if ("
 465                                :end ") {"))
 466         (then-strings (js-to-statement-strings (if-then if) (+ start-pos 2)))
 467         (else-strings (when (if-else if)
 468                         (js-to-statement-strings (if-else if)
 469                                                  (+ start-pos 2)))))
 470     (nconc if-strings then-strings (if else-strings
 471                                        (nconc (list "} else {") else-strings (list "}"))
 472                                        (list "}")))))
 473
 474 (defmethod js-to-strings ((if js-if) start-pos)
 475   (assert (typep (if-then if) 'expression))
 476   (when (if-else if)
 477     (assert (typep (if-else if) 'expression)))
 478   (dwim-join (list (append-to-last (js-to-strings (if-test if) start-pos) " ?")
 479                    (let* ((new-then (make-instance 'js-block
 480                                                    :statements (block-statements (if-then if))
 481                                                    :indent ""))
 482                           (res (js-to-strings new-then start-pos)))
 483                      (if (>= (expression-precedence (if-then if))
 484                              (expression-precedence if))
 485                              (klammer res)
 486                              res))
 487                    (list ":")
 488                    (if (if-else if)
 489                        (let* ((new-else (make-instance 'js-block
 490                                                        :statements (block-statements (if-else if))
 491                                                        :indent ""))
 492                               (res (js-to-strings new-else start-pos)))
 493                          (if (>= (expression-precedence (if-else if))
 494                                  (expression-precedence if))
 495                              (klammer res)
 496                              res))
 497                        (list "undefined")))
 498              (- 80 start-pos 2)
 499              :white-space "  "))
 500
 501 ;;; setf
 502 (defmethod js-to-strings ((setf js-setf) start-pos)
 503   (dwim-join (cons (js-to-strings (setf-lhs setf) start-pos)
 504                    (mapcar #'(lambda (x) (js-to-strings x start-pos)) (setf-rhsides setf)))
 505              (- 80 start-pos 2)
 506              :join-after " ="))
 507
 508 ;;; defvar
 509 (defmethod js-to-statement-strings ((defvar js-defvar) start-pos)
 510   (dwim-join (nconc (mapcar #'(lambda (x) (list (js-translate-symbol x))) (var-names defvar))
 511                     (when (var-value defvar)
 512                       (list (js-to-strings (var-value defvar) start-pos))))
 513              (- 80 start-pos 2)
 514              :join-after " ="
 515              :start "var " :end ";"))
 516
 517 ;;; iteration
 518 (defmethod js-to-statement-strings ((for js-for) start-pos)
 519   (let* ((init (dwim-join (mapcar #'(lambda (x)
 520                                       (dwim-join (list (list (js-translate-symbol (first (var-names x))))
 521                                                        (js-to-strings (var-value x)
 522                                                                       (+ start-pos 2)))
 523                                                  (- 80 start-pos 2)
 524                                                  :join-after " ="))
 525                                   (for-vars for))
 526                           (- 80 start-pos 2)
 527                           :start "var " :join-after ","))
 528          (check (js-to-strings (for-check for) (+ start-pos 2)))
 529          (steps (dwim-join (mapcar #'(lambda (x var)
 530                                        (dwim-join
 531                                         (list (list (js-translate-symbol (first (var-names var))))
 532                                               (js-to-strings x (- start-pos 2)))
 533                                         (- 80 start-pos 2)
 534                                         :join-after " ="))
 535                                    (for-steps for)
 536                                    (for-vars for))
 537                            (- 80 start-pos 2)
 538                            :join-after ","))
 539          (header (dwim-join (list init check steps)
 540                             (- 80 start-pos 2)
 541                             :start "for (" :end ") {"
 542                             :join-after ";"))
 543          (body (js-to-statement-strings (for-body for) (+ start-pos 2))))
 544     (nconc header body (list "}"))))
 545
 546
 547 (defmethod js-to-statement-strings ((fe for-each) start-pos)
 548   (let ((header (dwim-join (list (list (js-translate-symbol (fe-name fe)))
 549                                  (list "in")
 550                                  (js-to-strings (fe-value fe) (+ start-pos 2)))
 551                            (- 80 start-pos 2)
 552                            :start "for (var "
 553                            :end ") {"))
 554         (body (js-to-statement-strings (fe-body fe) (+ start-pos 2))))
 555     (nconc header body (list "}"))))
 556
 557 (defmethod js-to-statement-strings ((while js-while) start-pos)
 558   (let ((header (dwim-join (list (js-to-strings (while-check while) (+ start-pos 2)))
 559                            (- 80 start-pos 2)
 560                            :start "while ("
 561                            :end ") {"))
 562         (body (js-to-statement-strings (while-body while) (+ start-pos 2))))
 563     (nconc header body (list "}"))))
 564
 565 ;;; with
 566 (defmethod js-to-statement-strings ((with js-with) start-pos)
 567   (nconc (dwim-join (list (js-to-strings (with-obj with) (+ start-pos 2)))
 568                     (- 80 start-pos 2)
 569                     :start "with (" :end ") {")
 570          (js-to-statement-strings (with-body with) (+ start-pos 2))
 571          (list "}")))
 572
 573 ;;; switch
 574 (defmethod js-to-statement-strings ((case js-switch) start-pos)
 575   (let ((body    (mapcan #'(lambda (clause)
 576                      (let ((val (car clause))
 577                            (body (second clause)))
 578                        (dwim-join (list (if (eql val 'default)
 579                                             (list "")
 580                                             (js-to-strings val (+ start-pos 2)))
 581                                         (js-to-statement-strings body (+ start-pos 2)))
 582                                   (- 80 start-pos 2)
 583                                   :start (if (eql val 'default) "  default" "  case ")
 584                                   :white-space "   "
 585                                   :join-after ":"))) (case-clauses case))))
 586     (nconc (dwim-join (list (js-to-strings (case-value case) (+ start-pos 2)))
 587                     (- 80 start-pos 2)
 588                     :start "switch (" :end ") {")
 589            body
 590            (list "}"))))
 591
 592 ;;; try-catch
 593 (defmethod js-to-statement-strings ((try js-try) start-pos)
 594   (let* ((catch (try-catch try))
 595          (finally (try-finally try))
 596          (catch-list (when catch
 597                        (nconc
 598                         (dwim-join (list (list (js-translate-symbol (first catch))))
 599                                    (- 80 start-pos 2)
 600                                    :start "} catch ("
 601                                    :end ") {")
 602                         (js-to-statement-strings (second catch) (+ start-pos 2)))))
 603          (finally-list (when finally
 604                          (nconc (list "} finally {")
 605                                 (js-to-statement-strings finally (+ start-pos 2))))))
 606     (nconc (list "try {")
 607            (js-to-statement-strings (try-body try) (+ start-pos 2))
 608            catch-list
 609            finally-list
 610            (list "}"))))
 611
 612 ;;; regex
 613 (defun first-slash-p (string)
 614   (and (> (length string) 0)
 615        (eq (char string 0) '#\/)))
 616
 617 (defmethod js-to-strings ((regex regex) start-pos)
 618    (declare (ignore start-pos))
 619    (let ((slash (if (first-slash-p (value regex)) nil "/")))
 620      (list (format nil (concatenate 'string slash "~A" slash) (value regex)))))
 621
 622 ;;; conditional compilation
 623 (defmethod js-to-statement-strings ((cc cc-if) start-pos)
 624   (nconc (list (format nil "/*@if ~A" (cc-if-test cc)))
 625          (mapcan #'(lambda (x) (js-to-strings x start-pos)) (cc-if-body cc))
 626          (list "@end @*/")))
 627
 628
 629 ;;; TODO instanceof
 630 (defmethod js-to-strings ((instanceof js-instanceof) start-pos)
 631   (dwim-join
 632    (list (js-to-strings (value instanceof) (+ start-pos 2))
 633          (list "instanceof")
 634          (js-to-strings (slot-value instanceof 'type) (+ start-pos 2)))
 635    (- 80 start-pos 2)
 636    :start "("
 637    :end ")"
 638    :white-space
 639    "  "))
 640
 641 ;;; single operations
 642 (defmacro define-translate-js-single-op (name &optional (superclass 'expression))
 643     (let ((script-name (intern (concatenate 'string "JS-" (symbol-name name)) #.*package*)))
 644       `(defmethod ,(if (eql superclass 'expression)
 645                        'js-to-strings
 646                        'js-to-statement-strings)
 647         ((,name ,script-name) start-pos)
 648         (dwim-join (list (js-to-strings (value ,name) (+ start-pos 2)))
 649          (- 80 start-pos 2)
 650          :start ,(concatenate 'string (string-downcase (symbol-name name)) " ")
 651          :white-space "  "))))
 652
 653 (define-translate-js-single-op return statement)
 654 (define-translate-js-single-op throw statement)
 655 (define-translate-js-single-op delete)
 656 (define-translate-js-single-op void)
 657 (define-translate-js-single-op typeof)
 658 (define-translate-js-single-op new)