src/compilation-interface.lisp

   1 ;;;; -*- encoding:utf-8 -*-
   2
   3 ;;; Copyright 2005 Manuel Odendahl
   4 ;;; Copyright 2005-2006 Edward Marco Baringer
   5 ;;; Copyright 2006 Luca Capello
   6 ;;; Copyright 2007-2009 Red Daly
   7 ;;; Copyright 2008 Travis Cross
   8 ;;; Copyright 2007-2011 Vladimir Sedach
   9 ;;; Copyright 2009-2010 Daniel Gackle
  10
  11 ;;; SPDX-License-Identifier: BSD-3-Clause
  12
  13 ;;; Redistribution and use in source and binary forms, with or
  14 ;;; without modification, are permitted provided that the following
  15 ;;; conditions are met:
  16
  17 ;;; 1. Redistributions of source code must retain the above copyright
  18 ;;; notice, this list of conditions and the following disclaimer.
  19
  20 ;;; 2. Redistributions in binary form must reproduce the above
  21 ;;; copyright notice, this list of conditions and the following
  22 ;;; disclaimer in the documentation and/or other materials provided
  23 ;;; with the distribution.
  24
  25 ;;; 3. Neither the name of the copyright holder nor the names of its
  26 ;;; contributors may be used to endorse or promote products derived
  27 ;;; from this software without specific prior written permission.
  28
  29 ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  30 ;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  31 ;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  32 ;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  33 ;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
  34 ;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  35 ;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  36 ;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  37 ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
  38 ;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  39 ;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  40 ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  41 ;;; POSSIBILITY OF SUCH DAMAGE.
  42
  43 (in-package #:parenscript)
  44
  45 (defparameter *js-target-version* "1.3")
  46
  47 (defvar *parenscript-stream* nil)
  48
  49 (defmacro ps (&body body)
  50   "Given Parenscript forms (an implicit progn), compiles those forms
  51 to a JavaScript string at macro-expansion time. Expands into a form
  52 which evaluates to a string."
  53   (let ((printed-forms (parenscript-print
  54                         (compile-statement `(progn ,@body))
  55                         nil)))
  56     (if (and (not (cdr printed-forms))
  57              (stringp (car printed-forms)))
  58         (car printed-forms)
  59         (let ((s (gensym)))
  60           `(with-output-to-string (,s)
  61              ,@(mapcar (lambda (x) `(write-string ,x ,s))
  62                        printed-forms))))))
  63
  64 (defmacro ps-to-stream (stream &body body)
  65   "Given Parenscript forms (an implicit progn), compiles those forms
  66 to a JavaScript string at macro-expansion time. Expands into a form
  67 which writes the resulting code to stream."
  68   (let ((printed-forms (parenscript-print
  69                         (compile-statement `(progn ,@body))
  70                         nil)))
  71     `(let ((*parenscript-stream* ,stream))
  72        ,@(mapcar (lambda (x) `(write-string ,x *parenscript-stream*))
  73                  printed-forms))))
  74
  75 (defun ps* (&rest body)
  76   "Compiles body to a JavaScript string. If *parenscript-stream* is
  77 bound, writes the output to *parenscript-stream*, otherwise returns a
  78 string."
  79   (let ((*psw-stream* (or *parenscript-stream* (make-string-output-stream))))
  80     (parenscript-print (compile-statement `(progn ,@body)) t)
  81     (unless *parenscript-stream*
  82       (get-output-stream-string *psw-stream*))))
  83
  84 (defmacro with-blank-compilation-environment (&body body)
  85   `(let ((*ps-gensym-counter* 0)
  86          (*special-variables* nil))
  87      ,@body))
  88
  89 (defmacro ps-doc (&body body)
  90   "Expands Parenscript forms in a clean environment."
  91   (with-blank-compilation-environment
  92     (macroexpand-1 `(ps ,@body))))
  93
  94 (defun ps-doc* (&rest body)
  95   (with-blank-compilation-environment
  96     (apply #'ps* body)))
  97
  98 (defvar *js-inline-string-delimiter* #\"
  99   "Controls the string delimiter char used when compiling Parenscript in ps-inline.")
 100
 101 (defun ps-inline* (form &optional
 102                    (*js-string-delimiter* *js-inline-string-delimiter*))
 103   (concatenate 'string "javascript:" (ps* form)))
 104
 105 (defmacro+ps ps-inline (form &optional
 106                              (string-delimiter *js-inline-string-delimiter*))
 107   `(concatenate 'string "javascript:"
 108                 ,@(let ((*js-string-delimiter* string-delimiter))
 109                     (parenscript-print (compile-statement form) nil))))
 110
 111 (defvar *ps-read-function* #'read)
 112
 113 (defun ps-compile-stream (stream)
 114   "Reads (using the value of *ps-read-function*, #'read by default, as
 115 the read function) Parenscript forms from stream and compiles them as
 116 if by ps*. If *parenscript-stream* is bound, writes the output to
 117 *parenscript-stream*, otherwise and returns a string."
 118   (let ((output-stream (or *parenscript-stream* (make-string-output-stream))))
 119     (let ((*compilation-level* :toplevel)
 120           (*readtable* *readtable*)
 121           (*package* *package*)
 122           (*parenscript-stream* output-stream)
 123           (eof '#:eof))
 124       (loop for form = (funcall *ps-read-function* stream nil eof)
 125             until (eq form eof) do (ps* form) (fresh-line *parenscript-stream*)))
 126     (unless *parenscript-stream*
 127       (get-output-stream-string output-stream))))
 128
 129 (defun ps-compile-file (source-file &key (element-type 'character) (external-format :default))
 130   "Opens file as input stream and calls ps-compile-stream on it."
 131   (with-open-file (stream source-file
 132                           :direction :input
 133                           :element-type element-type
 134                           :external-format external-format)
 135     (ps-compile-stream stream)))