...
 
Commits (136)
# Boring file regexps:
\#
~$
(^|/)_darcs($|/)
\.dfsl$
\.ppcf$
\.fasl$
\.x86f$
\.fas$
\.lib$
^docs/html($|/)
^docs/pdf($|/)
^\{arch\}$
(^|/).arch-ids($|/)
;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")
((nil
(indent-tabs-mode)
(fill-column . 69))
(lisp-mode
(eval put 'test-ps-js 'common-lisp-indent-function 1)
(eval put 'test-js-eval 'common-lisp-indent-function 1)))
Copyright (c) 2005, Manuel Odendahl <manuel@bl0rg.net>
Copyright (c) 2005, Edward Marco Baringer <mb@bese.it>
Copyright (c) 2007-2012, Vladimir Sedach <vsedach@gmail.com>
Copyright (c) 2008-2009, Travis Cross <tc@travislists.com>
All rights reserved.
Copyright (c) 2005 Manuel Odendahl <manuel@bl0rg.net>
Copyright (c) 2005-2006 Edward Marco Baringer <mb@bese.it>
Copyright (c) 2007-2013, 2018 Vladimir Sedach <vas@oneofus.la>
Copyright (c) 2008, 2009 Travis Cross <tc@travislists.com>
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
- Redistributions of source code must retain the above copyright
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
- Neither the names of Manuel Odendahl, Edward Marco Baringer,
Vladimir Sedach, nor BESE, nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
3. Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
......
Parenscript is a translator from an extended subset of Common Lisp to
JavaScript. Parenscript code can run almost identically on both the
browser (as JavaScript) and server (as Common Lisp).
Parenscript code is treated the same way as Common Lisp code, making
the full power of Lisp macros available for JavaScript. This provides
a web development environment that is unmatched in its ability to
reduce code duplication and provide advanced meta-programming
facilities to web developers.
At the same time, Parenscript is different from almost all other
"language X" to JavaScript translators in that it imposes almost no
overhead:
No run-time dependencies:
Any piece of Parenscript code is runnable as-is. There are no
JavaScript files to include.
Native types:
Parenscript works entirely with native JavaScript data types. There
are no new types introduced, and object prototypes are not
touched.
Native calling convention:
Any JavaScript code can be called without the need for
bindings. Likewise, Parenscript can be used to make efficient,
self-contained JavaScript libraries.
Readable code:
Parenscript generates concise, formatted, idiomatic JavaScript
code. Identifier names are preserved. This enables seamless
use of JavaScript debuggers.
Efficiency:
Parenscript introduces minimal overhead for advanced Common Lisp
features. The generated code is almost as fast as hand-written
JavaScript.
Parenscript is available via Quicklisp:
(ql:quickload :parenscript)
To run unit tests:
(ql:quickload :parenscript.tests)
(parenscript.tests:run-tests)
Contributing:
Please send patches and bug reports to the mailing list:
parenscript-devel@common-lisp.net
Documentation:
See docs/tutorial.html and docs/reference.html
Mailing list:
parenscript-devel@common-lisp.net
https://mailman.common-lisp.net/listinfo/parenscript-devel
Web site:
http://common-lisp.net/project/parenscript/
Source repository:
https://gitlab.common-lisp.net/parenscript/parenscript.git
License:
BSD-3-Clause, see the file COPYING
* Fix BREAKing out of LOOP
https://github.com/vsedach/Parenscript/issues/43
(ps:ps
(defun foo (t1 t5)
(loop for t2 in t1
for t4 in t5
collect (loop for t3 in t2 collect t3))))
generates
function foo(t1, t5) {
__PS_MV_REG = [];
return (function () {
var _js54 = t1.length;
var _js56 = t5.length;
var collect57 = [];
var FIRST58 = true;
for (var _js53 = 0; _js53 < _js54; _js53 += 1) {
(function () {
var t2 = t1[_js53];
var _js55 = FIRST58 ? 0 : _js55 + 1;
if (_js55 >= _js56) {
break;
};
var t4 = t5[_js55];
collect57.push((function () {
var _js60 = t2.length;
var collect61 = [];
for (var _js59 = 0; _js59 < _js60; _js59 += 1) {
var t3 = t2[_js59];
collect61.push(t3);
};
__PS_MV_REG = [];
return collect61;
})());
__PS_MV_REG = [];
return FIRST58 = null;
})();
};
__PS_MV_REG = [];
return collect57;
})();
};
Note that the entire outer-loop body is inside a js function but it still contains break statements.
Reverting e6489e0 fixes this issue.
This is reduced from a regression in real-world code.
@jasom
Collaborator Author
jasom commented on Jan 11
As ECMA script 6 supports block scoping via "let" the only way I see of implementing this would be to wrap the loop in a try and change the break to be a throw. Or we could just not support strict mode and go back to using with (which provides the scoping).
@jasom
Collaborator Author
jasom commented on Jan 11 •
Actually for this example "break" could be turned into "return" since the entire loop body is a function.
The above doesn't terminate the loop; rather the loop would have to be inside the function and then break could just be used anyways. My comment below is still true.
I don't know enough about the loop implementation to say if this works for the general case.
@vsedach
Owner
vsedach commented on Jan 11
As ECMA script 6 supports block scoping via "let" the only way I
see of implementing this would be to wrap the loop in a try and
change the break to be a throw.
Correct. I think Parenscript's LOOP is not doing a RETURN-FROM, which
would generate a throw in cases like this.
@jasom
Collaborator Author
jasom commented on Jan 17
I locally fixd the BREAK to use RETURN-FROM and it gets worse; note that var _js55 = FIRST58 ? 0 : _js55 + 1; is inside the lambda, so js55 is zero on the first iteration and NaN thereafter.
Previously only the non-gensymed variables were declared in the with block so the gensym variables took the outer scope; this obviously is not what happens when you replace the with with a lambda. The fix is likely going to involve hoisting those variable declarations out of the loop body; I'm busy with other things currently so it may take several days before I report back.
* Fix multiple COLLECT clauses in LOOP
https://github.com/vsedach/Parenscript/issues/46
phmarek commented 7 hours ago
(ps:ps
(loop for i from 0 to 3
for ch = (char "abcde" i)
for p = (char-code ch)
collect (logand (ash p -1) 1)
collect (logand (ash p -0) 1)))
results in
(function () {
var collect41 = [];
var collect41 = [];
for (var i = 0; i <= 3; i += 1) {
var ch = char('abcde', i);
var p = charCode(ch);
collect41.push(p >> 1 & 1);
collect41.push(p >> 0 & 1);
};
__PS_MV_REG = [];
return collect41;
})();
Please note the duplicated var collect41 statements.
I don't think this breaks JS, but at least it is ugly.
* Add DOM3 and DOM4 symbols to PS-DHTML-SYMBOLS
https://github.com/vsedach/Parenscript/issues/14
* Merge ZEROP, FORMAT from https://github.com/mgi/Parenscript
* Add ECMAScript 2015 support
https://github.com/pjstirling/Parenscript
This diff is collapsed.
(in-package :ps)
;;;# Introduction
;;; Introduction
;;;
;;; ParenScript is a simple language that looks a lot like Lisp, but
;;; actually is JavaScript in disguise. Actually, it is JavaScript
;;; embedded in a host Lisp. This way, JavaScript programs can be
;;; Parenscript is a language that looks a lot like Common Lisp, but
;;; is JavaScript in disguise. This way, JavaScript programs can be
;;; seamlessly integrated in a Lisp web application. The programmer
;;; doesn't have to resort to a different syntax, and JavaScript code
;;; can easily be generated without having to resort to complicated
;;; string generation or `FORMAT' expressions.
;;;
;;; An example is worth more than a thousand words. The following Lisp
;;; expression is a call to the ParenScript "compiler". The
;;; ParenScript "compiler" transforms the expression in ParenScript
;;; The following Lisp expression is a call to the Parenscript
;;; translator Parenscript transforms the expression in Parenscript
;;; into an equivalent, human-readable expression in JavaScript.
(ps
(defun foobar (a b)
(return (+ a b))))
(+ a b)))
;;; The resulting javascript is:
"
function foobar(a, b) {
return a + b;
}
"
;;; Great care has been given to the indentation and overall
;;; readability of the generated JavaScript code.
;;;# Features
;;; Features
;;;
;;; ParenScript supports all the statements and expressions defined by
;;; Parenscript supports all the statements and expressions defined by
;;; the EcmaScript 262 standard. Lisp symbols are converted to
;;; camelcase, javascript-compliant syntax. This idea is taken from
;;; Linj by Antonio Menezes Leitao. Here are a few examples of Lisp
;;; symbol to JavaScript name conversion:
(js-to-string 'foobar) => "foobar"
(js-to-string 'foo-bar) => "fooBar"
(js-to-string 'foo-b-@-r) => "fooBAtR"
(js-to-string 'foo-b@r) => "fooBatr"
(js-to-string '*array) => "Array"
(js-to-string '*math.floor) => "Math.floor"
;;; It also supports additional iteration constructs, relieving the
;;; programmer of the burden of iterating over arrays.
;;; Linj by Antonio Menezes Leitao. Case sensitivity (using the
;;; :invert readtable-case option) is supported. Here are a few
;;; examples of Lisp symbol to JavaScript name conversion:
(ps foobar) => "foobar"
(ps foo-bar) => "fooBar"
(ps foo-b@r) => "fooBatr"
(ps *array) => "Array"
(ps FooBar) => "FooBar"
;;; Parenscript supports a subset of Common Lisp iteration constructs.
;;; `for' loops can be written using the customary `DO*' syntax.
(ps
......@@ -58,16 +58,16 @@ for (var i = 0, j = arr[i]; i < 10; i = ++i, j = arr[i]) {
alert('i is ' + i + ' and j is ' + j);
};
"
;;; ParenScript uses the Lisp reader, allowing for reader macros. It
;;; Parenscript uses the Lisp reader, allowing for reader macros. It
;;; also comes with its own macro environment, allowing host Lisp
;;; macros and ParenScript macros to coexist without interfering with
;;; macros and Parenscript macros to coexist without interfering with
;;; each other. For example, the `1+' construct is implemented using
;;; a ParenScript macro:
;;; a Parenscript macro:
(defpsmacro 1+ (form)
`(+ ,form 1))
;;; ParenScript allows the creation of JavaScript objects in a Lispy
;;; Parenscript allows the creation of JavaScript objects in a Lispy
;;; way, using keyword arguments.
(ps
......@@ -79,62 +79,22 @@ for (var i = 0, j = arr[i]; i < 10; i = ++i, j = arr[i]) {
{ foo : 'foo',
bla : 'bla' }
"
;;; ParenScript features a HTML generator. Using the same syntax as
;;; Parenscript features a HTML generator. Using the same syntax as
;;; the HTMLGEN package of Franz, Inc., it can generate JavaScript
;;; string expressions. This allows for a clean integration of HTML in
;;; ParenScript code, instead of writing the tedious and error-prone
;;; Parenscript code, instead of writing the tedious and error-prone
;;; string generation code generally found in JavaScript.
(ps
(defun add-div (name href link-text)
(document.write
(ps-html ((:div :id name)
"The link is: "
((:a :href href) link-text))))))
(funcall (getprop document 'write)
(ps-html ((:div :id name)
"The link is: "
((:a :href href) link-text))))))
;; compiles to
"
function addDiv(name, href, linkText) {
document.write('<div id=\"' + name + '\">The link is: <a href=\"'
+ href + '\">'
+ linkText + '</a></div>');
}
return document.write(['<div id=\\\"', name, '\\\">The link is: <a href=\\\"', href, '\\\">', linkText, '</a></div>'].join(''));
};
"
;;; In order to have a complete web application framework available in
;;; Lisp, ParenScript also provides a sexp-based syntax for CSS
;;; stylesheets. Thus, a complete web application featuring HTML, CSS
;;; and JavaScript documents can be generated using Lisp syntax,
;;; allowing the programmer to use Lisp macros to factor out the
;;; redundancies and complexities of Web syntax. For example, to
;;; generate a CSS inline node in a HTML document using the
;;; AllegroServe HTMLGEN library:
(html-stream *standard-output*
(html
(:html
(:head
(css (* :border "1px solid black")
(div.bl0rg :font-family "serif")
(("a:active" "a:hoover") :color "black" :size "200%"))))))
;; which produces
<html><head><style type="text/css">
<!--
* {
border:1px solid black;
}
div.bl0rg {
font-family:serif;
}
a:active,a:hoover {
color:black;
size:200%;
}
-->
</style>
</head>
</html>
This diff is collapsed.
This diff is collapsed.
;;;; -*- encoding:utf-8 -*-
;; SPDX-License-Identifier: BSD-3-Clause
;; Tracing macro courtesy of William Halliburton
;; <whalliburton@gmail.com>, logs to Firebug console
......@@ -27,4 +31,4 @@
(console *trace-level* ,sname "returned" rtn)
(return rtn)))
(defun ,tname ,args
,@body))))
\ No newline at end of file
,@body))))
;; SPDX-License-Identifier: BSD-3-Clause
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; This is an extension to SLIME that is inspired by (and works
;;;; like) the SLIME 'C-c M-m' macroexpansion feature.
......
;;;; -*- encoding:utf-8 -*-
;; SPDX-License-Identifier: BSD-3-Clause
(in-package :parenscript)
(defun parenscript-function-p (symbol)
......@@ -15,4 +19,3 @@
(values it t))))
#++
(pushnew 'parenscript-arglist swank::*external-arglist-hooks*)
;;;; -*- encoding:utf-8 -*-
;;;; -*- lisp -*-
(defsystem :parenscript
:name "parenscript"
:author "Manuel Odendahl <manuel@bl0rg.net>"
:maintainer "Vladimir Sedach <vsedach@gmail.com>"
:licence "BSD"
:maintainer "Vladimir Sedach <vas@oneofus.la>"
:licence "BSD-3-Clause"
:description "Lisp to JavaScript transpiler"
:components
((:static-file "parenscript.asd")
......
;;;; -*- encoding:utf-8; -*-
;;;; -*- lisp -*-
(defsystem :parenscript.test
:license "Public Domain"
(defsystem :parenscript.tests
:license "BSD-3-Clause"
:description "Unit tests for Parenscript"
:components ((:module :t
:components ((:module :tests
:serial t
:components ((:file "test-package")
(:file "test")
(:file "output-tests")
(:file "package-system-tests")
(:file "eval-tests"))))
:depends-on (:parenscript :eos :cl-js))
:depends-on (:parenscript :fiveam :cl-js))
;;;; -*- encoding:utf-8 -*-
;; SPDX-License-Identifier: BSD-3-Clause
(in-package #:parenscript)
;;; Script of library functions you can include with your own code to
......@@ -50,10 +54,12 @@
(setf idx (1+ idx))))
result))
(defun reduce (func list &optional init) ;; the use of init here is actually a bit broken wrt null
(defun reduce (func list &optional init)
(let* ((acc))
(do* ((i (if init -1 0) (1+ i))
(acc (if init init (elt list 0)) (func acc (elt list i))))
(do* ((i (if (= (length arguments) 3) -1 0)
(1+ i))
(acc (if (= (length arguments) 3) init (elt list 0))
(func acc (elt list i))))
((>= i (1- (length list)))))
acc))
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2005 Manuel Odendahl
;;; Copyright 2005-2006 Edward Marco Baringer
;;; Copyright 2006 Luca Capello
;;; Copyright 2007-2009 Red Daly
;;; Copyright 2008 Travis Cross
;;; Copyright 2007-2011 Vladimir Sedach
;;; Copyright 2009-2010 Daniel Gackle
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(defparameter *js-target-version* 1.3)
(defparameter *js-target-version* "1.3")
(defvar *parenscript-stream* nil)
......
This diff is collapsed.
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2005 Manuel Odendahl
;;; Copyright 2005-06 Edward Marco Baringer
;;; Copyright 2007 Red Daly
;;; Copyright 2007 Attila Lendvai
;;; Copyright 2007-2012 Vladimir Sedach
;;; Copyright 2008 Travis Cross
;;; Coypright 2010, 2013 Daniel Gackle
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(in-readtable :parenscript)
(define-condition simple-style-warning (style-warning simple-warning)
())
(defun warn-deprecated (old-name &optional new-name)
(unless *suppress-deprecation*
(warn 'simple-style-warning
:format-control "~:@(~a~) is deprecated~:[.~;, use ~:@(~a~) instead~]"
:format-arguments (list old-name new-name new-name))))
(warn 'simple-style-warning
:format-control "~:@(~a~) is deprecated~:[.~;, use ~:@(~a~) instead~]"
:format-arguments (list old-name new-name new-name)))
(defmacro defun-js (old-name new-name args &body body)
`(defun ,old-name ,args
......@@ -106,7 +144,16 @@ is output to the OUTPUT-STREAM stream."
(define-statement-operator with (expression &rest body)
(warn-deprecated 'with '|LET or WITH-SLOTS|)
`(ps-js:with ,(compile-expression expression)
,(compile-statement `(progn ,@body))))
,(compile-statement `(progn ,@body))))
(define-statement-operator while (test &rest body)
(warn-deprecated 'while '|LOOP WHILE|)
`(ps-js:while ,(compile-expression test)
,(compile-loop-body () body)))
(defmacro while (test &body body)
(warn-deprecated 'while '|LOOP WHILE|)
`(loop while ,test do (progn ,@body)))
(defpsmacro label (&rest args)
(warn-deprecated 'label 'block)
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2011 Vladimir Sedach
;;; Copyright 2014-2015 Boris Smilga
;;; Copyright 2014 Max Rottenkolber
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(in-readtable :parenscript)
......@@ -31,6 +69,19 @@ Syntax of key spec:
(supplied-p-var (if (listp spec) (third spec))))
(values var init-form supplied-p-var)))
(defun parse-body (body &key allow-docstring)
"Parses a function or block body, which may or may not include a
docstring. Returns 2 or 3 values: a docstring (if allowed for), a list
of (declare ...) forms, and the remaining body."
(let (docstring declarations)
(loop while
(cond ((and (consp (car body)) (eq (caar body) 'declare))
(push (pop body) declarations))
((and allow-docstring (not docstring)
(stringp (car body)) (cdr body))
(setf docstring (pop body)))))
(values body declarations docstring)))
(defun parse-extended-function (lambda-list body)
"The lambda list is transformed as follows:
......@@ -84,20 +135,16 @@ Syntax of key spec:
,@defaults)))))
(rest-form
(when rest?
(with-ps-gensyms (i)
`(progn (var ,rest (array))
(dotimes (,i (- (getprop arguments 'length)
,(length effective-args)))
(setf (aref ,rest
,i)
(aref arguments
(+ ,i ,(length effective-args)))))))))
(docstring (and (cdr body) (stringp (car body)) (car body)))
(effective-body (append opt-forms
key-forms
(awhen rest-form (list it))
(if docstring (rest body) body))))
(values effective-args effective-body docstring))))
`(var ,rest
((@ Array prototype slice call)
arguments ,(length effective-args))))))
(multiple-value-bind (fun-body declarations docstring)
(parse-body body :allow-docstring t)
(values effective-args
(append declarations
opt-forms key-forms (awhen rest-form (list it))
fun-body)
docstring)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; common
......@@ -105,24 +152,27 @@ Syntax of key spec:
(defun collapse-function-return-blocks (body)
(append (butlast body)
(let ((last (ps-macroexpand (car (last body)))))
(if (and (listp last) (eq 'block (car last))) ; no need for a block at the end of a function body
(progn (push (or (second last) 'nilBlock) *function-block-names*)
(if (and (listp last) (eq 'block (car last)))
;; no need for a block at the end of a function body
(progn (push (or (second last) 'nilBlock)
*function-block-names*)
(cddr last))
(list last)))))
(defun compile-function-body (args body)
(with-declaration-effects (body body)
(let* ((in-function-scope? t)
(*vars-needing-to-be-declared* ())
(*used-up-names* ())
(let* ((in-function-scope? t)
(*current-block-tag* nil)
(*vars-needing-to-be-declared* ())
(*used-up-names* ())
(returning-values? nil)
(clear-multiple-values? nil)
(*enclosing-function-arguments*
(append args *enclosing-function-arguments*))
(*enclosing-lexicals*
(set-difference *enclosing-lexicals* args))
(collapsed-body
(collapse-function-return-blocks body))
(suppress-values?
(find 'values (flatten body)))
(*dynamic-return-tags*
(append (mapcar (lambda (x) (cons x nil))
*function-block-names*)
......@@ -140,10 +190,9 @@ Syntax of key spec:
(compile-statement
`(progn
,@(mapcar
(lambda (var)
`(var ,var))
(lambda (var) `(var ,var))
(remove-duplicates *vars-needing-to-be-declared*))))))
(when in-loop-scope? ;; this might be broken when it comes to let-renaming
(when in-loop-scope?
(setf *loop-scope-lexicals-captured*
(append (intersection (flatten body) *loop-scope-lexicals*)
*loop-scope-lexicals-captured*)))
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2009-2011 Vladimir Sedach
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(in-readtable :parenscript)
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2010, 2012 Vladimir Sedach
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(in-readtable :parenscript)
......@@ -7,6 +44,7 @@
;; operators
;; arithmetic
#:+
#:unary-plus
#:-
#:negate
#:*
......@@ -64,6 +102,7 @@
#:delete
#:function
#:get
#:set
#:in
#:instanceof
#:new
......@@ -81,7 +120,7 @@
#:block
#:break
#:continue
#:do-while
#:do-while ; currently unused
#:for
#:for-in
#:if
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2009-2010 Daniel Gackle
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
;; Utilities for accessing standard DOM functionality in a Lispier, PSier way.
(defpsmacro inner-html (el)
`(@ ,el :inner-h-t-m-l))
`(@ ,el 'inner-h-t-m-l))
(defpsmacro uri-encode (str)
`(if (null ,str) "" (encode-u-r-i-component ,str)))
(defpsmacro attribute (el attr)
`((@ ,el :get-attribute) ,attr))
`((@ ,el 'get-attribute) ,attr))
(defun assert-is-one-of (val options)
(unless (member val options)
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2005 Manuel Odendahl
;;; Copyright 2005 Edward Marco Baringer
;;; Copyright 2007-2011 Vladimir Sedach
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(named-readtables:in-readtable :parenscript)
(defvar *ps-html-empty-tag-aware-p* t)
(defvar *ps-html-mode* :sgml "One of :sgml or :xml")
......@@ -40,20 +79,20 @@
attr-val (pop attrs))
(if attr-test
(push `(if ,attr-test
(stringify ,(format nil " ~A=\"" attr-name) ,attr-val "\"")
(stringify ,(format nil " ~(~A~)=\"" attr-name) ,attr-val "\"")
"")
r)
(progn
(push (format nil " ~A=\"" attr-name) r)
(push (format nil " ~(~A~)=\"" attr-name) r)
(push attr-val r)
(push "\"" r)))))
(process-form% (tag attrs content)
(push (format nil "<~A" tag) r)
(push (format nil "<~(~A~)" tag) r)
(process-attrs attrs)
(if (or content (not (empty-tag-p tag)))
(progn (push ">" r)
(map nil #'process-form content)
(push (format nil "</~A>" tag) r))
(push (format nil "</~(~A~)>" tag) r))
(progn (when (eql *ps-html-mode* :xml)
(push "/" r))
(push ">" r))))
......@@ -74,12 +113,12 @@
(cond ((keywordp form) (process-form (list form)))
((atom form) (push form r))
((and (consp form) (keywordp (car form)))
(push (format nil "<~A" (car form)) r)
(push (format nil "<~(~A~)" (car form)) r)
(labels ((process-attributes (el-body)
(when el-body
(if (keywordp (car el-body))
(progn
(push (format nil " ~A=\""
(push (format nil " ~(~A~)=\""
(car el-body)) r)
(push (cadr el-body) r)
(push "\"" r)
......@@ -89,7 +128,7 @@
(if (or content (not (empty-tag-p (car form))))
(progn (push ">" r)
(when content (map nil #'process-form content))
(push (format nil "</~A>" (car form)) r))
(push (format nil "</~(~A~)>" (car form)) r))
(progn (when (eql *ps-html-mode* :xml)
(push "/" r))
(push ">" r))))))
......
This diff is collapsed.
This diff is collapsed.
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2007-2010 Vladimir Sedach
;;; Copyright 2008 Travis Cross
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(in-readtable :parenscript)
(defvar *obfuscated-packages* (make-hash-table))
(defun obfuscate-package (package-designator &optional
(symbol-map
(let ((symbol-table (make-hash-table)))
(lambda (symbol)
(or #1=(gethash symbol symbol-table)
(setf #1# (ps-gensym "G")))))))
(setf (gethash (find-package package-designator) *obfuscated-packages*) symbol-map))
(defun obfuscate-package (package-designator &optional symbol-map)
(setf (gethash (find-package package-designator)
*obfuscated-packages*)
(or symbol-map
(let ((symbol-table (make-hash-table)))
(lambda (symbol)
(or (gethash symbol symbol-table)
(setf (gethash symbol symbol-table)
(ps-gensym 'g))))))))
(defun unobfuscate-package (package-designator)
(remhash (find-package package-designator) *obfuscated-packages*))
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2005 Manuel Odendahl
;;; Copyright 2005-2006 Edward Marco Baringer
;;; Copyright 2006 Luca Capello
;;; Copyright 2010-2012 Vladimir Sedach
;;; Copyright 2012, 2014, 2015 Boris Smilga
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
(in-readtable :parenscript)
......@@ -27,39 +67,55 @@
(define-statement-operator switch (test-expr &rest clauses)
`(ps-js:switch ,(compile-expression test-expr)
,@(loop for (val . body) in clauses collect
(cons (if (eq val 'default)
'ps-js:default
(let ((in-case? t))
(compile-expression val)))
(mapcan (lambda (x)
(let* ((in-case? t)
(exp (compile-statement x)))
(if (and (listp exp) (eq 'ps-js:block (car exp)))
(cdr exp)
(list exp))))
body)))))
,@(let ((in-case? t))
(loop for (val . body) in clauses collect
(cons (if (eq val 'default)
'ps-js:default
(compile-expression val))
(flatten-blocks
(mapcar #'compile-statement body)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; objects
(define-expression-operator create (&rest arrows)
`(ps-js:object
,@(loop for (key val-expr) on arrows by #'cddr collecting
(cons (cond ((and (symbolp key) (reserved-symbol-p key))
(reserved-symbol-p key))
((or (stringp key) (numberp key) (symbolp key))
key)
((and (consp key)
(eq 'quote (first key))
(symbolp (second key))
(null (third key)))
(symbol-to-js-string (second key)))
(t
(error
"Slot key ~s is not one of symbol, string or number."
key)))
(compile-expression val-expr)))))
(let ((allow-accessors (js-target-at-least "1.8.5")))
(cons
'ps-js:object
(loop for (key val-expr) on arrows by #'cddr
for (accessor . accessor-args) =
(when (and allow-accessors
(consp key)
(symbolp (first key))
(symbolp (second key)))
(case (first key)
(get (and (null (third key))
`((ps-js:get ,(second key)))))
(set (and (symbolp (third key)) (null (fourth key))
`((ps-js:set ,(second key)) ,(third key))))))
collecting
(if accessor
(list accessor accessor-args
(let ((*function-block-names* ()))
(compile-function-body (third accessor)
(list val-expr))))
(cons (cond ((and (symbolp key) (reserved-symbol-p key))
(reserved-symbol-p key))
((or (stringp key) (numberp key) (symbolp key))
key)
((and (consp key)
(eq 'quote (first key))
(symbolp (second key))
(null (third key)))
(symbol-to-js-string (second key)))
(t
(error "Slot key ~s is not one of ~
~{~a~#[~;, or ~:;, ~]~}."
key
(list* "symbol" "string" "number"
(when allow-accessors
'("accessor spec"))))))
(compile-expression val-expr)))))))
(define-expression-operator %js-getprop (obj slot)
(let ((expanded-slot (ps-macroexpand slot))
......@@ -86,14 +142,16 @@
,@(cdr props))
obj))
(defun chain (method-calls)
(let ((chain (car method-calls)))
(dolist (next (cdr method-calls))
(setf chain (if (consp next)
`(funcall (@ ,chain ,(car next)) ,@(cdr next))
`(@ ,chain ,next))))
chain))
(defpsmacro chain (&rest method-calls)
(labels ((do-chain (method-calls)
(if (cdr method-calls)
(if (listp (car method-calls))
`((@ ,(do-chain (cdr method-calls)) ,(caar method-calls)) ,@(cdar method-calls))
`(@ ,(do-chain (cdr method-calls)) ,(car method-calls)))
(car method-calls))))
(do-chain (reverse method-calls))))
(chain method-calls))
;;; var
......@@ -127,13 +185,6 @@
,(compile-expression object)
,(compile-loop-body (list var) body)))
(define-statement-operator while (test &rest body)
`(ps-js:while ,(compile-expression test)
,(compile-loop-body () body)))
(defmacro while (test &body body)
`(loop while ,test do (progn ,@body)))
;;; misc
(define-statement-operator try (form &rest clauses)
......@@ -160,8 +211,11 @@
;; dynamic environment only, analogous to eval.
`(ps-js:escape
(with-output-to-string (*psw-stream*)
(let ((compile-expression? ,compile-expression?))
(parenscript-print (ps-compile ,lisp-form) t)))))
(let ((compile-expression? ,compile-expression?)
(*js-string-delimiter* ,*js-string-delimiter*)
(eval-results (multiple-value-list ,lisp-form)))
(when eval-results
(parenscript-print (ps-compile (car eval-results)) t))))))
(defun lisp (x) x)
......@@ -186,7 +240,7 @@
(defpsmacro stringify (&rest things)
(if (and (= (length things) 1) (stringp (car things)))
(car things)
`((@ (list ,@things) join) "")))
`(funcall (getprop (list ,@things) 'join) "")))
(defun stringify (&rest things)
"Like concatenate but prints all of its arguments."
(format nil "~{~A~}" things))
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2005 Manuel Odendahl
;;; Copyright 2005-2006 Edward Marco Baringer
;;; Copyright 2006 Luca Capello
;;; Copyright 2006 Atilla Lendvai
;;; Copyright 2007-2012 Vladimir Sedach
;;; Copyright 2007 Red Daly
;;; Copyright 2008 Travis Cross
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl)
(pushnew :parenscript *features*)
......@@ -6,7 +48,9 @@
(unless (named-readtables:find-readtable :parenscript)
(named-readtables:defreadtable :parenscript
(:merge :standard)
(:case :invert))))
(:case #.(if (eql :upcase (readtable-case *readtable*))
:invert
(readtable-case *readtable*))))))
(named-readtables:in-readtable :parenscript)
......@@ -63,7 +107,7 @@
;; literals
#:t
#.(symbol-name 'nil) ; for case-sensitive Lisps like some versions of Allegro
#:nil
;; array literals
#:array
......
;;;; -*- encoding:utf-8 -*-
;;; Copyright 2007 Red Daly
;;; SPDX-License-Identifier: BSD-3-Clause
;;; Redistribution and use in source and binary forms, with or
;;; without modification, are permitted provided that the following
;;; conditions are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials provided
;;; with the distribution.
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived
;;; from this software without specific prior written permission.
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.
(in-package #:parenscript)
;;;; This software was taken from the SBCL system, mostly verbatim.
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
;; Copying and distribution of this file, with or without
;; modification, are permitted in any medium without royalty. This
;; file is offered as-is, without any warranty.
(in-package #:ps-test)
(in-suite package-system-tests)
(test-ps-js operator-packages1
(#:new)
"new();")
(defpackage #:ps-test.my-library
(:use #:parenscript))
(setf (ps-package-prefix '#:ps-test.my-library) "my_library_")
(test-ps-js lib-function1
(defun ps-test.my-library::library-function (x y)
(+ x y))
"function my_library_libraryFunction(x, y) {
return x + y;
};")
(test-ps-js uniform-symbol-handling1
(progn (create ps-test.my-library::foo 1)
(getprop foo 'ps-test.my-library::foo))
"({ my_library_foo : 1 });
foo.my_library_foo;")
(let ((map (make-hash-table)))
(defun symbol-obfuscator (symbol)
(or #1=(gethash symbol map)
(setf #1# (make-symbol (map 'string (lambda (x)
(code-char (1+ (char-code x))))
(symbol-name symbol)))))))
(defpackage #:ps-test.obfuscate-me)
(obfuscate-package '#:ps-test.obfuscate-me #'symbol-obfuscator)
(test-ps-js obfuscation1
(defun ps-test.obfuscate-me::libfun2 (a b ps-test.obfuscate-me::foo)
(+ a (ps-test.my-library::library-function b ps-test.obfuscate-me::foo)))
"function mjcgvo3(a, b, gpp) {
return a + my_library_libraryFunction(b, gpp);
};")
(defpackage #:ps-test.obfuscate-and-prefix)
(obfuscate-package '#:ps-test.obfuscate-and-prefix #'symbol-obfuscator)
(setf (ps-package-prefix '#:ps-test.obfuscate-and-prefix) "__FOO___")
(test-ps-js obfuscate-and-prefix
(defun ps-test.obfuscate-and-prefix::xfun (a ps-test.obfuscate-and-prefix::b ps-test.my-library::d)
(* a
(ps-test.obfuscate-me::libfun2 ps-test.obfuscate-and-prefix::b a)
(ps-test.my-library::library-function ps-test.my-library::d ps-test.obfuscate-and-prefix::b)))
"function __FOO___ygvo(a, __FOO___c, my_library_d) {
return a * mjcgvo3(__FOO___c, a) * my_library_libraryFunction(my_library_d, __FOO___c);
};")
(defpackage #:ps-test.pststpkg
(:use #:parenscript))
(setf (ps-package-prefix '#:ps-test.pststpkg) "prefix_")
(test namespace1 ()
(is (string= "prefix_foo;" (normalize-js-code (ps* 'ps-test.pststpkg::foo)))))
(cl:in-package #:ps-test.pststpkg)
(ps-test::test-ps-js namespace-and-special-forms
(defun foo ()
(let ((foo (create bar 1 not-a-keyword something)))
(return-from foo (and (not foo) (+ (getprop foo 'bar) some-other-var)))))
"function prefix_foo() {
var foo1 = { prefix_bar : 1, prefix_notAKeyword : prefix_something };
return !foo1 && foo1.prefix_bar + prefix_someOtherVar;
};")
(ps-test::test-ps-js exported-interface
(defun ps-test:interface-function (baz)
(+ baz ps-test.obfuscate-me::foo))
"function interfaceFunction(prefix_baz) {
return prefix_baz + gpp;
};")
(cl:in-package #:ps-test)
(test compile-stream-in-package
(is (string=
"function __FOO___ygvo(a, __FOO___c, my_library_d) {
return a * mjcgvo3(__FOO___c, a) * my_library_libraryFunction(my_library_d, __FOO___c);
};
function interfaceFunction(prefix_baz) {
return prefix_baz + gpp;
};
"
(with-input-from-string (s "
(defun ps-test.obfuscate-and-prefix::xfun (a ps-test.obfuscate-and-prefix::b ps-test.my-library::d)
(* a
(ps-test.obfuscate-me::libfun2 ps-test.obfuscate-and-prefix::b a)
(ps-test.my-library::library-function ps-test.my-library::d ps-test.obfuscate-and-prefix::b)))
(in-package #:ps-test.pststpkg)
(defun ps-test:interface-function (baz)
(+ baz ps-test.obfuscate-me::foo))
")
(ps-compile-stream s)))))
(in-package #:cl)
(named-readtables:in-readtable :parenscript)
(defpackage #:ps-test
(:use #:cl #:parenscript #:eos)
(:export #:parenscript-tests #:run-tests #:interface-function #:test-js-eval #:test-js-eval-epsilon #:jsarray))
(defpackage #:ps-eval-tests
(:use #:cl #:eos #:parenscript #:ps-test))
This diff is collapsed.