"
32 | :description "Javascript With Advanced Continuation Support"
33 | :serial t
34 | :class program-system
35 | :build-operation program-op
36 | :build-pathname "jwacs"
37 | :entry-point "jwacs:main"
38 | :components ((:module "external"
39 | :components
40 | ((:file "yacc")))
41 | ;;TODO Should these three non-Lisp files go into a separate module?
42 | (:js-file "jw-runtime")
43 | (:js-file "jw-debug-runtime")
44 | (:html-file "default-template")
45 | (:html-file "default-iframe")
46 | (:file "package")
47 | (:file "general-utilities")
48 | (:file "conditions")
49 | (:file "lexer-macros")
50 | (:file "lex-javascript")
51 | (:file "js-source-model")
52 | (:file "parse-javascript-yacc")
53 | (:file "parse-javascript")
54 | (:file "pretty-print")
55 | (:file "source-transformations")
56 | (:file "shift-decls-transformation")
57 | (:file "ugly-print")
58 | (:file "static-analysis")
59 | (:file "type-analysis")
60 | (:file "explicitize-transformation")
61 | (:file "shadow-values-transformation")
62 | (:file "cps-transformation")
63 | (:file "loop-transformation")
64 | (:file "trampoline-transformation")
65 | (:file "runtime-transformation")
66 | (:file "compiler")
67 | (:file "main"))
68 | :depends-on ("cl-ppcre")
69 | :in-order-to ((test-op (test-op "jwacs-tests"))))
70 |
--------------------------------------------------------------------------------
/examples/textarea-highlights.js:
--------------------------------------------------------------------------------
1 | var activeBoxes = [];
2 |
3 | function getHeight(dummyDiv, text)
4 | {
5 | while(dummyDiv.lastChild)
6 | dummyDiv.removeChild(dummyDiv.lastChild);
7 |
8 | var paras = text.split(/\r?\n/);
9 | for(var i = 0; i < paras.length; i++)
10 | {
11 | if(i > 0)
12 | dummyDiv.appendChild(document.createElement("BR"));
13 | dummyDiv.appendChild(document.createTextNode(paras[i]));
14 | }
15 |
16 | return dummyDiv.offsetHeight;
17 | }
18 |
19 | function findBoundingYs(dummyDiv, text, s, e)
20 | {
21 | var lineHeight = getHeight(dummyDiv, 'a');
22 | var precedingHeight = s == 0 ? lineHeight : getHeight(dummyDiv, text.substr(0, s));
23 | var includingHeight = getHeight(dummyDiv, text.substr(0, e));
24 |
25 | return [lineHeight + includingHeight - precedingHeight, precedingHeight - lineHeight];
26 | }
27 |
28 | function positionBoxes()
29 | {
30 | for(var i = 0; i < activeBoxes.length; i++)
31 | {
32 | var box = activeBoxes[i];
33 | var elm = box._targetElm;
34 |
35 | var top = box._heightAndTop[1];
36 | var bot = top + box._heightAndTop[0];
37 |
38 | top = Math.max(top, elm.scrollTop);
39 | bot = Math.min(bot, elm.scrollTop + elm.clientHeight);
40 |
41 | if(top < bot)
42 | {
43 | box.style.top = (top + elm.offsetTop - elm.scrollTop) + 'px';
44 | box.style.height = (bot - top) + 'px';
45 | box.style.width = (elm.clientWidth + tabWidth + 3) + 'px';
46 | box.style.left = (Position.positionedOffset(elm)[0] - tabWidth) + 'px';
47 | Element.show(box);
48 | }
49 | else
50 | Element.hide(box);
51 | }
52 | }
53 |
54 | //======= Public API ===============================================================================
55 |
56 | var tabWidth = 0;
57 | function addHighlight(elm, dummyDiv, s, e, background)
58 | {
59 | var box = document.createElement("DIV");
60 | var origScroll = elm.scrollTop;
61 | var heightAndTop = findBoundingYs(dummyDiv, elm.value, s, e);
62 |
63 | Element.hide(box);
64 | Element.setOpacity(box, 0.5);
65 | box.style.position = 'absolute';
66 | box.style.background = background || 'green';
67 |
68 | box._heightAndTop = heightAndTop;
69 | box._targetElm = elm;
70 |
71 | document.body.appendChild(box);
72 | activeBoxes.push(box);
73 | elm.scrollTop = origScroll;
74 |
75 | return box;
76 | }
77 |
78 | function removeHighlight(targetBox)
79 | {
80 | for(var i = 0; i < activeBoxes.length; i++)
81 | {
82 | var box = activeBoxes[i];
83 | if(box == targetBox)
84 | {
85 | activeBoxes[i] = null;
86 | activeBoxes.splice(i, 1);
87 | box.parentNode.removeChild(box);
88 | return box;
89 | }
90 | }
91 | }
92 |
93 | function clearHighlights()
94 | {
95 | for(var i = 0; i < activeBoxes.length; i++)
96 | {
97 | var box = activeBoxes[i];
98 | box.parentNode.removeChild(box);
99 | activeBoxes[i] = null;
100 | }
101 | activeBoxes = [];
102 | }
103 |
104 | function initHighlights(period)
105 | {
106 | setInterval(positionBoxes, period || 150);
107 | }
108 |
--------------------------------------------------------------------------------
/parse-javascript-yacc.lisp:
--------------------------------------------------------------------------------
1 | ;;;; parse-javascript-yacc.lisp
2 | ;;;
3 | ;;; Use the cl-yacc package to parse javascript source text.
4 | ;;;
5 | ;;; Copyright (c) 2005 Greg Smolyn
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs)
9 |
10 | (defun expand-hashtable-to-values (hashtable)
11 | "Returns a list of all the values stored in a hashtable."
12 | (let ((valuelist '()))
13 | (maphash #'(lambda (k v)
14 | (declare (ignore k))
15 | (setf valuelist (cons v valuelist)))
16 | hashtable)
17 | valuelist))
18 |
19 | ; need to collect productions
20 |
21 | (defmacro defparser (parser-name starting-production &body productions)
22 | "This macro emulates the Lispworks parsergenerator's defparser macro, but instead creates output
23 | for CL-YACC"
24 | (let* ((starting-point (first starting-production))
25 | (starting-symbol (first starting-point))
26 | (header `(yacc:define-parser ,parser-name
27 | (:muffle-conflicts ,jwacs-system::*muffle-conflicts*)
28 | ; (:print-derives-epsilon t)
29 | ; (:print-first-terminals t)
30 | ; (:print-states t)
31 | ; (:print-goto-graph t)
32 | ; (:print-lookaheads )
33 | (:start-symbol ,starting-symbol)
34 | (:terminals ,(expand-hashtable-to-values *tokens-to-symbols* ))
35 | (:precedence nil)
36 | ,starting-point)))
37 | (append header (generate-productions productions))))
38 |
39 | ; here we turn
40 | ; ((primary-expression object-literal) $1)
41 | ; into
42 | ; (primary-expression
43 | ; (object-literal #'(lambda (&rest expr) (nth 0 expr))))
44 | ;
45 | ; and
46 | ;
47 | ; ((literal :number) (make-numeric-literal :value $1))
48 | ; into
49 | ; (literal
50 | ; (:number #'(lambda (&rest expr) (make-numeric-literal :value (nth 0 expr)))))
51 |
52 |
53 |
54 | (defun generate-productions (productions)
55 | "Used by defparser macro. Take the lispworks list of productions and convert them into
56 | CL-YACC versions"
57 | (let* ((production-map (make-hash-table)))
58 | (dolist (production productions)
59 | (let* ((rule (nth 0 production))
60 | (action (maptree 'replace-special-variables (nth 1 production)))
61 | (rule-name (first rule))
62 | (rule-terminals (rest rule)))
63 | (setf (gethash rule-name production-map)
64 | (cons (append rule-terminals `(#'(lambda (&rest expr) ,action)))
65 | (gethash rule-name production-map)))))
66 | (let* ((output '()))
67 | (maphash #'(lambda (k v)
68 | (setf output (cons (append (list k) (reverse v)) output)))
69 | production-map)
70 | (reverse output))))
71 |
72 | (defun replace-special-variables (leaf)
73 | "Replace $$n with (token-value (nth n-1 expr)) and $n with (nth n-1 expr)"
74 | (if (symbolp leaf)
75 | (let ((symname (symbol-name leaf)))
76 | (cond
77 | ((string= symname "$S")
78 | `(element-start expr))
79 | ((string= symname "$E")
80 | `(element-end expr))
81 | ((prefix-p symname "$$")
82 | `(token-value (nth ,(1- (parse-integer (subseq symname 2))) expr)))
83 | ((prefix-p symname "$")
84 | `(nth ,(1- (parse-integer (subseq symname 1))) expr))
85 | (t
86 | leaf)))
87 | leaf))
88 |
--------------------------------------------------------------------------------
/lib/builder.js:
--------------------------------------------------------------------------------
1 | // Copyright (c) 2005 Thomas Fuchs (http://script.aculo.us, http://mir.aculo.us)
2 | //
3 | // See scriptaculous.js for full license.
4 |
5 | var Builder = {
6 | NODEMAP: {
7 | AREA: 'map',
8 | CAPTION: 'table',
9 | COL: 'table',
10 | COLGROUP: 'table',
11 | LEGEND: 'fieldset',
12 | OPTGROUP: 'select',
13 | OPTION: 'select',
14 | PARAM: 'object',
15 | TBODY: 'table',
16 | TD: 'table',
17 | TFOOT: 'table',
18 | TH: 'table',
19 | THEAD: 'table',
20 | TR: 'table'
21 | },
22 | // note: For Firefox < 1.5, OPTION and OPTGROUP tags are currently broken,
23 | // due to a Firefox bug
24 | node: function(elementName) {
25 | elementName = elementName.toUpperCase();
26 |
27 | // try innerHTML approach
28 | var parentTag = this.NODEMAP[elementName] || 'div';
29 | var parentElement = document.createElement(parentTag);
30 | try { // prevent IE "feature": http://dev.rubyonrails.org/ticket/2707
31 | parentElement.innerHTML = "<" + elementName + ">";
32 | } catch(e) {}
33 | var element = parentElement.firstChild || null;
34 |
35 | // see if browser added wrapping tags
36 | if(element && (element.tagName != elementName))
37 | element = element.getElementsByTagName(elementName)[0];
38 |
39 | // fallback to createElement approach
40 | if(!element) element = document.createElement(elementName);
41 |
42 | // abort if nothing could be created
43 | if(!element) return;
44 |
45 | // attributes (or text)
46 | if(arguments[1])
47 | if(this._isStringOrNumber(arguments[1]) ||
48 | (arguments[1] instanceof Array)) {
49 | this._children(element, arguments[1]);
50 | } else {
51 | var attrs = this._attributes(arguments[1]);
52 | if(attrs.length) {
53 | try { // prevent IE "feature": http://dev.rubyonrails.org/ticket/2707
54 | parentElement.innerHTML = "<" +elementName + " " +
55 | attrs + ">";
56 | } catch(e) {}
57 | element = parentElement.firstChild || null;
58 | // workaround firefox 1.0.X bug
59 | if(!element) {
60 | element = document.createElement(elementName);
61 | for(attr in arguments[1])
62 | element[attr == 'class' ? 'className' : attr] = arguments[1][attr];
63 | }
64 | if(element.tagName != elementName)
65 | element = parentElement.getElementsByTagName(elementName)[0];
66 | }
67 | }
68 |
69 | // text, or array of children
70 | if(arguments[2])
71 | this._children(element, arguments[2]);
72 |
73 | return element;
74 | },
75 | _text: function(text) {
76 | return document.createTextNode(text);
77 | },
78 | _attributes: function(attributes) {
79 | var attrs = [];
80 | for(attribute in attributes)
81 | attrs.push((attribute=='className' ? 'class' : attribute) +
82 | '="' + attributes[attribute].toString().escapeHTML() + '"');
83 | return attrs.join(" ");
84 | },
85 | _children: function(element, children) {
86 | if(typeof children=='object') { // array can hold nodes and text
87 | children.flatten().each( function(e) {
88 | if(typeof e=='object')
89 | element.appendChild(e)
90 | else
91 | if(Builder._isStringOrNumber(e))
92 | element.appendChild(Builder._text(e));
93 | });
94 | } else
95 | if(Builder._isStringOrNumber(children))
96 | element.appendChild(Builder._text(children));
97 | },
98 | _isStringOrNumber: function(param) {
99 | return(typeof param=='string' || typeof param=='number');
100 | }
101 | }
--------------------------------------------------------------------------------
/tests/test-shift-decls-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-shift-function-decls.lisp
2 | ;;;
3 | ;;; Tests for the shift-decls transformation
4 | ;;;
5 | ;;; Copyright (c) 2005 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs-tests)
9 |
10 | (defnote shift-decls "Tests for the shift-decls transformation")
11 |
12 | (deftest shift-decls/1 :notes shift-decls
13 | (transform 'shift-decls (test-parse "
14 | var global1, global2 = 20;
15 | WScript.echo(global2);
16 | function foo()
17 | {
18 | bar();
19 | var a = 10;
20 | function inner(h)
21 | {
22 | return h * 10;
23 | }
24 | var b = 20;
25 | }
26 | var global3 = /h/g;
27 | function bar() { return -88; }"))
28 | #.(test-parse "
29 | var global1;
30 | var global2;
31 | var global3;
32 | function foo()
33 | {
34 | function inner(h)
35 | {
36 | return h * 10;
37 | }
38 | bar();
39 | var a = 10;
40 | var b = 20;
41 | }
42 | function bar() { return -88; }
43 | global2 = 20;
44 | WScript.echo(global2);
45 | global3 = /h/g;"))
46 |
47 |
48 | (deftest shift-decls/2 :notes shift-decls
49 | (transform 'shift-decls (test-parse "
50 | function foo()
51 | {
52 | var a = 1;
53 | if(x)
54 | {
55 | var b;
56 | var fex = function functionExpression() // Doesn't move; only function decls move
57 | {
58 | return inner(2);
59 | function inner(arg) { return arg; } // Moves up within functionExpression's body only
60 | };
61 | var c = 100;
62 | }
63 | }"))
64 | #.(test-parse "
65 | function foo()
66 | {
67 | var a = 1;
68 | if(x)
69 | {
70 | var b;
71 | var fex = function functionExpression()
72 | {
73 | function inner(arg) { return arg; }
74 | return inner(2);
75 | };
76 | var c = 100;
77 | }
78 | }"))
79 |
80 | (deftest shift-decls/3 :notes shift-decls
81 | (transform 'shift-decls (test-parse "
82 | var obj = { field: 44, method: function() { return this.field * 2; }};
83 | function fn()
84 | {
85 | obj.method(obj.field);
86 | }"))
87 | #.(test-parse "
88 | var obj;
89 | function fn()
90 | {
91 | obj.method(obj.field);
92 | }
93 | obj = { field: 44, method: function() { return this.field * 2; }};"))
94 |
95 | (deftest shift-decls/nested-var-decls/1 :notes shift-decls
96 | (transform 'shift-decls (test-parse "
97 | foo();
98 | var x = 10;
99 | try
100 | {
101 | var y = 20;
102 | }
103 | catch(e)
104 | {
105 | bar(e);
106 | }"))
107 | #.(test-parse "
108 | var x;
109 | var y;
110 | foo();
111 | x = 10;
112 | try
113 | {
114 | y = 20;
115 | }
116 | catch(e)
117 | {
118 | bar(e);
119 | }"))
120 |
121 | (deftest shift-decls/nested-var-decls/2 :notes shift-decls
122 | (transform 'shift-decls (test-parse "
123 | foo();
124 | var x = 10;
125 | try
126 | {
127 | var y = 20;
128 | }
129 | catch(e)
130 | {
131 | var z;
132 | bar(e);
133 | }"))
134 | #.(test-parse "
135 | var x;
136 | var y;
137 | var z;
138 | foo();
139 | x = 10;
140 | try
141 | {
142 | y = 20;
143 | }
144 | catch(e)
145 | {
146 | bar(e);
147 | }"))
148 |
149 | (deftest shift-decls/position-preservation/1 :notes shift-decls
150 | (transform 'shift-decls (parse "foo(); var x = bar();"))
151 | (#s(var-decl-statement :var-decls (#s(var-decl :name "x")))
152 | #s(fn-call :fn #s(identifier :name "foo" :start 0 :end 3)
153 | :args nil
154 | :start 0 :end 3)
155 | #s(binary-operator :left-arg #s(identifier :name "x")
156 | :op-symbol :assign
157 | :right-arg #s(fn-call :fn #s(identifier :name "bar" :start 15 :end 18)
158 | :args nil
159 | :start 15 :end 18)
160 | :start 11 :end 18)))
--------------------------------------------------------------------------------
/shadow-values-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; shadow-values-transformation.lisp
2 | ;;;
3 | ;;; Defines the shadow-values transformation, which replaces references to
4 | ;;; `this` and `arguments` (which don't behave as expected when you're at
5 | ;;; the bottom of three levels of continuation) with references to "shadow
6 | ;;; values", which are variable that have been set to point to the /correct/
7 | ;;; versions of `this` and arguments at the beginning of a function.
8 | ;;;
9 | ;;; Copyright (c) 2006 James Wright
10 | ;;; See LICENSE for full licensing details.
11 | ;;;
12 | (in-package :jw)
13 |
14 | (defparameter *shadowed-this-name* nil
15 | "Name of the variable that currently shadows `this`")
16 |
17 | (defparameter *shadowed-arguments-name* nil
18 | "Name of the variable that currently shadows `arguments`")
19 |
20 | (defparameter *arguments-name* "arguments"
21 | "Name of the `arguments` identifier")
22 |
23 | (defmethod transform ((xform (eql 'shadow-values)) (elm identifier))
24 | (if (and *shadowed-arguments-name*
25 | (equal (identifier-name elm) *arguments-name*))
26 | (make-identifier :name *shadowed-arguments-name*
27 | :start (source-element-start elm)
28 | :end (source-element-end elm))
29 | (call-next-method)))
30 |
31 | (defmethod transform ((xform (eql 'shadow-values)) (elm special-value))
32 | (if (and *shadowed-this-name*
33 | (eq :this (special-value-symbol elm)))
34 | (make-identifier :name *shadowed-this-name*
35 | :start (source-element-start elm)
36 | :end (source-element-end elm))
37 | (call-next-method)))
38 |
39 | (defun tx-shadow-values-body (body)
40 | "Transforms the body of a function expression or declaration and returns
41 | the new body"
42 | (let* ((declares-arguments-p (find *arguments-name*
43 | (collect-in-scope body 'var-decl)
44 | :key 'var-decl-name :test 'equal))
45 | (references-arguments-p (find *arguments-name*
46 | (collect-in-scope body 'identifier)
47 | :key 'identifier-name :test 'equal))
48 | (references-this-p (find :this
49 | (collect-in-scope body 'special-value)
50 | :key 'special-value-symbol :test 'eq))
51 | (*shadowed-arguments-name* (if (and references-arguments-p (not declares-arguments-p))
52 | (genvar "arguments")
53 | nil))
54 | (*shadowed-this-name* (if references-this-p
55 | (genvar "this")
56 | nil)))
57 | (cond
58 |
59 | ((and references-arguments-p (not declares-arguments-p)
60 | references-this-p)
61 | (append
62 | (list (make-var-init *shadowed-arguments-name* (make-special-value :symbol :arguments))
63 | (make-var-init *shadowed-this-name* (make-special-value :symbol :this)))
64 | (transform 'shadow-values body)))
65 |
66 | ((and references-arguments-p (not declares-arguments-p))
67 | (cons (make-var-init *shadowed-arguments-name* (make-special-value :symbol :arguments))
68 | (transform 'shadow-values body)))
69 |
70 | (references-this-p
71 | (cons (make-var-init *shadowed-this-name* (make-special-value :symbol :this))
72 | (transform 'shadow-values body)))
73 |
74 | (t
75 | (transform 'shadow-values body)))))
76 |
77 |
78 | (defmethod transform ((xform (eql 'shadow-values)) (elm function-decl))
79 | (make-function-decl :name (function-decl-name elm)
80 | :parameters (function-decl-parameters elm)
81 | :body (tx-shadow-values-body (function-decl-body elm))
82 | :start (source-element-start elm)
83 | :end (source-element-end elm)))
84 |
85 | (defmethod transform ((xform (eql 'shadow-values)) (elm function-expression))
86 | (make-function-expression :name (function-expression-name elm)
87 | :parameters (function-expression-parameters elm)
88 | :body (tx-shadow-values-body (function-expression-body elm))
89 | :start (source-element-start elm)
90 | :end (source-element-end elm)))
--------------------------------------------------------------------------------
/doc/examples.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | jwacs examples
5 |
6 |
50 |
51 |
52 |
53 | jwacs examples
54 | The examples/ directory contains some small (tiny) example
55 | applications written in jwacs. This file provides descriptions of
56 | them.
57 |
58 | You can build all of the example programs by running the
59 | build-examples script (under Linux) or the
60 | build-examples.cmd batch file (under Windows). You can also execute
61 | the following from the REPL:
62 |
63 |
64 | (asdf:oos 'asdf:load-op :jwacs-tests)
65 | (jw-tests::compile-examples)
66 |
67 | Some of the example programs (okay, one) require the server to provide
68 | certain services for Ajax requests, so they (okay, it) won't run very well on
69 | a local file system. So that you can still see these (this) application in
70 | action, we provide running versions of all the example apps on the
71 | jwacs site.
72 |
73 |
74 | - TrivialHttpRequest
75 | - This trivial little app demonstrates the use of
76 |
JwacsLib.fetchData; it fetches a text file from the server and
77 | displays it on the page. Note that it is making an asynchronous
78 | XMLHttpRequest request, but to the programmer it appears that
79 | fetchData blocks until complete and then returns the result.
80 |
81 | - Counter
82 | - This application shows a simple counter, and links to make it go up and
83 | down. It demonstrates the use of the history (ie, back-button) management
84 | capabilities that the jwacs library provides.
85 |
86 | - Calendar Mark 2
87 | - This slightly more substantial example of a jwacs application implements
88 | a simple web-calendar as a client-side application. Login using username
89 | guest and password guest.
90 |
91 |
The client expects the server to provide a basic REST-style service that
92 | exposes the following endpoints:
93 |
94 | - GET /event-query with parameter id: Returns a single event
95 |
- GET /event-query with parameters s and e:
96 | Returns all events that occur between the start date s
97 | and the end date e inclusive.
98 |
- POST /event-add with parameters date, desc,
99 | and notes: Creates a new event on the specified date with the
100 | specified description and notes. Returns the created event if successful.
101 |
- POST /event-del with parameter id: Deletes the
102 | specified event.
103 |
- POST /event-update with required parameter id and
104 | optional parameters date, desc, and notes:
105 | Updates the specified fields of the specified event.
106 |
107 |
108 |
109 | Unit tests
110 |
111 | The jwacs-tests system contains a bunch of unit tests that verify
112 | that the transformations produce the code that we expect them to. To run
113 | these unit tests, execute the following from the REPL:
114 |
115 | (asdf:oos 'asdf:test-op :jwacs)
116 |
117 | Language tests
118 | The tests/ directory also contains "language tests" to verify that
119 | transformed code behaves as expected. To run these tests, execute
120 |
121 |
122 | (asdf:oos 'asdf:load-op :jwacs-tests)
123 | (jw-tests::compile-lang-tests)
124 |
125 | from the REPL and then open tests/lang-tests.html in a browser. All
126 | the tests should pass.
127 |
--------------------------------------------------------------------------------
/tests/package.lisp:
--------------------------------------------------------------------------------
1 | ;;;; package.lisp
2 | ;;; Defines the package used by the unit tests
3 | ;;;
4 | ;;; Copyright (c) 2005-2006 James Wright
5 | ;;; See LICENSE for full licensing details.
6 | ;;;
7 |
8 | (defpackage :jwacs-tests
9 | (:use :cl :rtest :cl-ppcre :jwacs)
10 | (:nicknames :jw-tests)
11 | (:import-from jwacs
12 | ;; lexer-specific symbols for testing
13 | javascript-lexer
14 | make-lexer-function
15 | regexp-re
16 | token
17 | token-terminal token-value token-start token-end
18 | next-token
19 | coerce-token
20 | make-load-form
21 | set-cursor
22 | position-to-line/column
23 | encountered-line-terminator
24 |
25 | ;; source-model structure types
26 | source-element
27 | special-value
28 | identifier
29 | numeric-literal
30 | string-literal
31 | array-literal
32 | object-literal
33 | re-literal
34 | new-expr
35 | fn-call
36 | property-access
37 | unary-operator
38 | binary-operator
39 | conditional
40 | comma-expr
41 | var-decl-statement
42 | var-decl
43 | statement-block
44 | if-statement
45 | do-statement
46 | while
47 | for
48 | for-in
49 | continue-statement
50 | break-statement
51 | return-statement
52 | with
53 | switch
54 | case-clause
55 | default-clause
56 | throw-statement
57 | try
58 | catch-clause
59 | finally-clause
60 | function-decl
61 | function-expression
62 | continuation-function
63 | thunk-function
64 | continuation-call
65 | suspend-statement
66 | resume-statement
67 | import-decl
68 | add-handler
69 | remove-handler
70 |
71 | ;; constructors for source-model structures
72 | make-source-element
73 | make-special-value
74 | make-identifier
75 | make-numeric-literal
76 | make-string-literal
77 | make-array-literal
78 | make-object-literal
79 | make-re-literal
80 | make-new-expr
81 | make-fn-call
82 | make-property-access
83 | make-unary-operator
84 | make-binary-operator
85 | make-conditional
86 | make-comma-expr
87 | make-var-decl-statement
88 | make-var-decl
89 | make-statement-block
90 | make-if-statement
91 | make-do-statement
92 | make-while
93 | make-for
94 | make-for-in
95 | make-continue-statement
96 | make-break-statement
97 | make-return-statement
98 | make-with
99 | make-switch
100 | make-case-clause
101 | make-default-clause
102 | make-throw-statement
103 | make-try
104 | make-catch-clause
105 | make-finally-clause
106 | make-function-decl
107 | make-function-expression
108 | make-suspend-statement
109 | make-resume-statement
110 | make-import-decl
111 | make-add-handler
112 | make-remove-handler
113 |
114 | ;; frequently-used accessors
115 | source-element-start
116 | source-element-end
117 |
118 | ;; structure management
119 | get-constructor
120 | structure-slots
121 | make-keyword
122 |
123 | ;; pretty-printer-specific symbols
124 | pretty-print
125 | with-indent
126 | *indent*
127 | *escape-script-end-tags*
128 |
129 | ;; ugly-printer symbols
130 | genvar
131 | *genvar-counter*
132 | ugly-print
133 |
134 | ;; source-transformation-specific symbols
135 | *cont-name*
136 | *cont-id*
137 | transform
138 | cps
139 | explicitize
140 | shift-decls
141 | uniquify
142 | loop-canonicalize
143 | in-local-scope
144 | trampoline
145 | runtime
146 | shadow-values
147 |
148 | ;; cps transformation symbols
149 | find-free-variables
150 |
151 | ;; type-analysis symbols
152 | type-analyze
153 | compute-types
154 | value-node
155 | location-node
156 | explicitly-terminated-p
157 | ))
158 |
--------------------------------------------------------------------------------
/shift-decls-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; shift-function-decls-transformation.lisp
2 | ;;;
3 | ;;; Define the shift-function-decls transformation.
4 | ;;;
5 | ;;; Copyright (c) 2005 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs)
9 |
10 | ;;;; ======= shift-decls transformation ============================================================
11 | ;;;
12 | ;;; This transformation moves function declarations to the beginning
13 | ;;; of each scope in the provided AST. Function decls are never moved
14 | ;;; to a different scope, and they will always appear in the same order
15 | ;;; as originally, so this transfomation is semantically neutral.
16 | ;;;
17 | ;;; This transformation also converts variable declarations at the toplevel scope
18 | ;;; into simple assignments, and adds empty variable declarations to the top of the
19 | ;;; scope.
20 | ;;;
21 | ;;; These shifts are to ensure that visibility is maintained even after cps conversion.
22 | ;;; We want to make sure that function declarations and global variable declarations
23 | ;;; never get absorbed into the declaration of a continuation function, since they will
24 | ;;; then be invisible to code that occurs outside the continuation function.
25 | ;;;
26 | ;;; NOTE: The Javascript definition of "scope" is slightly different
27 | ;;; than you might expect. In particular, only function-decls and
28 | ;;; function-expressions create new scopes; statement blocks do not.
29 | ;;;
30 | ;;; Note also that function-expressions will /not/ be moved, since
31 | ;;; they are values (and also their identifiers do not affect their
32 | ;;; enclosing scope; see Pg 71 of ECMA-262)
33 |
34 | (defun shift-function-decls (elm-list)
35 | "Moves all function-decls in elm-list to the front"
36 | (let ((fn-decls (collect-in-scope elm-list 'function-decl))
37 | (other-statements (remove-if #'function-decl-p elm-list)))
38 | (append fn-decls other-statements)))
39 |
40 | (defun shift-var-decls (elm-list)
41 | "Adds empty variable declarations at the top of elm-list for variable declarations
42 | that have new-exprs or fn-calls as initializers. The original variable decls are
43 | converted to simple assignments."
44 | (let ((stripped-var-decl-stmts (mapcar (lambda (decl)
45 | (make-var-init (var-decl-name decl) nil))
46 | (collect-in-scope elm-list 'var-decl)))
47 | (stripped-elm-list (transform 'strip-var-decls-in-scope elm-list)))
48 | (append stripped-var-decl-stmts
49 | stripped-elm-list)))
50 |
51 | (defmethod transform ((xform (eql 'shift-decls)) (elm-list list))
52 | (let ((shifted-elms (if *in-local-scope*
53 | (shift-function-decls elm-list)
54 | (shift-var-decls (shift-function-decls elm-list)))))
55 | (mapcar (lambda (elm)
56 | (transform 'shift-decls elm))
57 | shifted-elms)))
58 |
59 | (defmethod transform ((xform (eql 'shift-decls)) (elm source-element))
60 | (apply
61 | (get-constructor elm)
62 | (loop for slot in (structure-slots elm)
63 | unless (function-decl-p (slot-value elm slot)) collect (make-keyword slot)
64 | unless (function-decl-p (slot-value elm slot)) collect (transform xform (slot-value elm slot)))))
65 |
66 |
67 | (defmethod transform ((xform (eql 'shift-decls)) (elm object-literal))
68 | (make-object-literal
69 | :properties
70 | (loop for (prop-name . prop-value) in (object-literal-properties elm)
71 | collect (cons
72 | (transform 'shift-decls prop-name)
73 | (transform 'shift-decls prop-value)))))
74 |
75 | (defmethod transform ((xform (eql 'shift-decls)) (elm var-decl-statement))
76 | (make-var-decl-statement :var-decls (mapcar (lambda (decl)
77 | (transform 'shift-decls decl))
78 | (var-decl-statement-var-decls elm))
79 | :start (source-element-start elm)
80 | :end (source-element-end elm)))
81 |
82 | (defmethod transform ((xform (eql 'shift-decls)) (elm function-decl))
83 | (in-local-scope
84 | (call-next-method)))
85 |
86 | (defmethod transform ((xform (eql 'shift-decls)) (elm function-expression))
87 | (in-local-scope
88 | (call-next-method)))
89 |
90 | ;;;; ======= strip-var-decls-in-scope transformation ===============================================
91 |
92 | ;;; Shifting function decls is relatively easy, because they can't be nested inside of other
93 | ;;; statements. We can get a list of var-decls to shift relatively easily using COLLECT-IN-SCOPE,
94 | ;;; but we need a tranformation to do the actual stripping.
95 |
96 | ;; Strip all the var decls that we encounter (ie, convert them into assignments)
97 | (defmethod transform ((xform (eql 'strip-var-decls-in-scope)) (elm var-decl-statement))
98 | (loop for decl in (var-decl-statement-var-decls elm)
99 | for name = (var-decl-name decl)
100 | for initializer = (var-decl-initializer decl)
101 | unless (null initializer)
102 | collect (make-binary-operator :op-symbol :assign
103 | :left-arg (make-identifier :name name)
104 | :right-arg initializer
105 | :start (source-element-start decl)
106 | :end (source-element-end decl))))
107 |
108 | ;; Don't recurse into functions (that's the "in-scope" part)
109 | (defmethod transform ((xform (eql 'strip-var-decls-in-scope)) (elm function-decl))
110 | elm)
111 |
112 | (defmethod transform ((xform (eql 'strip-var-decls-in-scope)) (elm function-expression))
113 | elm)
114 |
115 |
--------------------------------------------------------------------------------
/tests/test-shadow-values-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-shadow-values-transformation.lisp
2 | ;;;
3 | ;;; Tests for the shadow-values transformation
4 | ;;;
5 | ;;; Copyright (c) 2006 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jw-tests)
9 |
10 | (defnote shadow-values "Tests for the shadow-values transformation")
11 |
12 | (deftest shadow-values/fn-decl/arguments-referenced/1 :notes shadow-values
13 | (with-fresh-genvar
14 | (test-transform 'shadow-values (parse "
15 | function foo(a, b)
16 | {
17 | if(arguments.length < 2)
18 | throw 'too few args';
19 | else
20 | return arguments[0] + ',' + arguments[1];
21 | }")))
22 | #.(test-parse "
23 | function foo(a, b)
24 | {
25 | var arguments$0 = arguments;
26 | if(arguments$0.length < 2)
27 | throw 'too few args';
28 | else
29 | return arguments$0[0] + ',' + arguments$0[1];
30 | }"))
31 |
32 | (deftest shadow-values/fn-decl/this-referenced/1 :notes shadow-values
33 | (with-fresh-genvar
34 | (test-transform 'shadow-values (parse "
35 | function foo(a, b)
36 | {
37 | this.foo = 'foo';
38 | if(!this.bar)
39 | this.bar = 'bar';
40 | }")))
41 | #.(test-parse "
42 | function foo(a, b)
43 | {
44 | var this$0 = this;
45 | this$0.foo = 'foo';
46 | if(!this$0.bar)
47 | this$0.bar = 'bar';
48 | }"))
49 |
50 | (deftest shadow-values/fn-decl/both-referenced/1 :notes shadow-values
51 | (with-fresh-genvar
52 | (test-transform 'shadow-values (parse "
53 | function foo(a, b)
54 | {
55 | this.foo = arguments.length;
56 | if(!this.bar)
57 | this.bar = arguments[0];
58 | }")))
59 | #.(test-parse "
60 | function foo(a, b)
61 | {
62 | var arguments$0 = arguments;
63 | var this$1 = this;
64 | this$1.foo = arguments$0.length;
65 | if(!this$1.bar)
66 | this$1.bar = arguments$0[0];
67 | }"))
68 |
69 | (deftest shadow-values/fn-decl/neither-referenced/1 :notes shadow-values
70 | (with-fresh-genvar
71 | (test-transform 'shadow-values (parse "
72 | function foo(a, b)
73 | {
74 | return 24;
75 | }")))
76 | #.(test-parse "
77 | function foo(a, b)
78 | {
79 | return 24;
80 | }"))
81 |
82 | (deftest shadow-values/fn-expression/arguments-referenced/1 :notes shadow-values
83 | (with-fresh-genvar
84 | (test-transform 'shadow-values (parse "
85 | var foo = function(a, b)
86 | {
87 | if(arguments.length < 2)
88 | throw 'too few args';
89 | else
90 | return arguments[0] + ',' + arguments[1];
91 | };")))
92 | #.(test-parse "
93 | var foo = function(a, b)
94 | {
95 | var arguments$0 = arguments;
96 | if(arguments$0.length < 2)
97 | throw 'too few args';
98 | else
99 | return arguments$0[0] + ',' + arguments$0[1];
100 | };"))
101 |
102 | (deftest shadow-values/fn-expression/this-referenced/1 :notes shadow-values
103 | (with-fresh-genvar
104 | (test-transform 'shadow-values (parse "
105 | var foo = function(a, b)
106 | {
107 | this.foo = 'foo';
108 | if(!this.bar)
109 | this.bar = 'bar';
110 | };")))
111 | #.(test-parse "
112 | var foo = function(a, b)
113 | {
114 | var this$0 = this;
115 | this$0.foo = 'foo';
116 | if(!this$0.bar)
117 | this$0.bar = 'bar';
118 | };"))
119 |
120 | (deftest shadow-values/fn-expression/both-referenced/1 :notes shadow-values
121 | (with-fresh-genvar
122 | (test-transform 'shadow-values (parse "
123 | var foo = function(a, b)
124 | {
125 | this.foo = arguments.length;
126 | if(!this.bar)
127 | this.bar = arguments[0];
128 | };")))
129 | #.(test-parse "
130 | var foo = function(a, b)
131 | {
132 | var arguments$0 = arguments;
133 | var this$1 = this;
134 | this$1.foo = arguments$0.length;
135 | if(!this$1.bar)
136 | this$1.bar = arguments$0[0];
137 | };"))
138 |
139 | (deftest shadow-values/fn-expression/neither-referenced/1 :notes shadow-values
140 | (with-fresh-genvar
141 | (test-transform 'shadow-values (parse "
142 | var foo = function(a, b)
143 | {
144 | return 24;
145 | };")))
146 | #.(test-parse "
147 | var foo = function(a, b)
148 | {
149 | return 24;
150 | };"))
151 |
152 | (deftest shadow-values/position-preservation/1 :notes shadow-values
153 | (with-fresh-genvar
154 | (transform 'shadow-values (parse "function foo() { this.x = 10; return arguments; }")))
155 | (#s(function-decl :name "foo" :parameters nil
156 | :body (#s(var-decl-statement :var-decls
157 | (#s(var-decl :name "arguments$0" :initializer #s(special-value :symbol :arguments))))
158 | #s(var-decl-statement :var-decls
159 | (#s(var-decl :name "this$1" :initializer #s(special-value :symbol :this))))
160 | #s(binary-operator :op-symbol :assign
161 | :left-arg #s(property-access :target #s(identifier :name "this$1" :start 17 :end 21)
162 | :field #s(string-literal :start 22 :end 23 :value "x")
163 | :start 17 :end 23)
164 | :right-arg #s(numeric-literal :start 26 :end 28 :value 10)
165 | :start 17 :end 28)
166 | #s(return-statement :arg #s(identifier :start 37 :end 46 :name "arguments$0")
167 | :start 30 :end 47 ))
168 | :start 0 :end 47)))
--------------------------------------------------------------------------------
/tests/test-static-analysis.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-static-analysis.lisp
2 | ;;;
3 | ;;; Unit tests for the static analysis utility functions
4 | ;;;
5 | ;;; Copyright (c) 2006 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs-tests)
9 |
10 | (defnote static-analysis "Tests for the simple static-analysis utility functions")
11 |
12 | (deftest static-analysis/explicitly-terminated-p/1 :notes static-analysis
13 | (explicitly-terminated-p
14 | (test-parse "
15 | x = 10;
16 | y = 20;
17 | return 15;")
18 | '(:return :throw :break :continue :resume :suspend))
19 | :return)
20 |
21 | (deftest static-analysis/explicitly-terminated-p/2 :notes static-analysis
22 | (explicitly-terminated-p
23 | (test-parse "
24 | x = 10;
25 | y = 20;
26 | if(x > 10)
27 | resume k <- 55;
28 | else
29 | suspend;")
30 | '(:return :throw :break :continue :resume :suspend))
31 | :suspend)
32 |
33 | (deftest static-analysis/explicitly-terminated-p/3 :notes static-analysis
34 | (explicitly-terminated-p
35 | (test-parse "
36 | if(x)
37 | return;
38 | else
39 | x = 10;")
40 | '(:return :throw :break :continue :resume :suspend))
41 | nil)
42 |
43 | (deftest static-analysis/explicitly-terminated-p/4 :notes static-analysis
44 | (explicitly-terminated-p
45 | (test-parse "
46 | while(true)
47 | {
48 | if(x)
49 | break; // Not an 'escaping' break, because it terminates the while but not the whole list
50 | else
51 | continue; // Not an escaping continue, similarly
52 | }
53 | x = 10;")
54 | '(:return :throw :break :continue :resume :suspend))
55 | nil)
56 |
57 | (deftest static-analysis/explicitly-terminated-p/5 :notes static-analysis
58 | (explicitly-terminated-p
59 | (test-parse "
60 | foo:
61 | while(true)
62 | {
63 | if(x)
64 | break foo; // Not an 'escaping' break, because it terminates the while but not the whole list
65 | else
66 | continue foo; // Not an escaping continue, similarly
67 | }
68 | x = 10;")
69 | '(:return :throw :break :continue :resume :suspend))
70 | nil)
71 |
72 | (deftest static-analysis/explicitly-terminated-p/6 :notes static-analysis
73 | (explicitly-terminated-p
74 | (test-parse "
75 | foo:
76 | while(true)
77 | {
78 | if(x)
79 | break foo; // Not an 'escaping' break, because it terminates the while but not the whole list
80 | else
81 | continue bar; // is an escaping continue
82 | }
83 | x = 10;")
84 | '(:return :throw :break :continue :resume :suspend))
85 | nil)
86 |
87 | (deftest static-analysis/explicitly-terminated-p/7 :notes static-analysis
88 | (explicitly-terminated-p
89 | (test-parse "
90 | while(true)
91 | {
92 | if(x)
93 | break foo; // escaping break
94 | else
95 | continue bar; // escaping continue
96 | }
97 | x = 10;")
98 | '(:return :throw :break :continue :resume :suspend))
99 | :continue)
100 |
101 | (deftest static-analysis/explicitly-terminated-p/8 :notes static-analysis
102 | (explicitly-terminated-p
103 | (test-parse "
104 | x = 50;
105 | // Although a human can tell that the loop's body is guaranteed to execute
106 | // at least once, EXPLICITLY-TERMINATED-P can't, because we're not doing
107 | // dataflow analysis.
108 | while(x < 100)
109 | {
110 | if(x)
111 | return 10;
112 | else
113 | return 20;
114 | }")
115 | '(:return :throw :break :continue :resume :suspend))
116 | nil)
117 |
118 | (deftest static-analysis/explicitly-terminated-p/9 :notes static-analysis
119 | (explicitly-terminated-p
120 | (test-parse "
121 | x = 20;
122 | foo:
123 | while(true)
124 | {
125 | break;
126 | }")
127 | '(:return :throw :break :continue :resume :suspend))
128 | nil)
129 |
130 | (deftest static-analysis/explicitly-terminated-p/nested-throw/1 :notes static-analysis
131 | (explicitly-terminated-p
132 | (test-parse "
133 | foo();
134 | bar();
135 | try
136 | {
137 | if(baz())
138 | return 10;
139 | else
140 | throw new Error;
141 | }
142 | catch(e)
143 | {
144 | errno = e;
145 | }")
146 | '(:return :throw :break :continue :resume :suspend))
147 | nil)
148 |
149 | (deftest static-analysis/explicitly-terminated-p/nested-throw/2 :notes static-analysis
150 | (explicitly-terminated-p
151 | (test-parse "
152 | foo();
153 | bar();
154 | try
155 | {
156 | if(baz())
157 | return 10;
158 | else
159 | throw new Error;
160 | }
161 | catch(e)
162 | {
163 | errno = e;
164 | throw null;
165 | }")
166 | '(:return :throw :break :continue :resume :suspend))
167 | :throw)
168 |
169 | (deftest static-analysis/explicitly-terminated-p/nested-throw/3 :notes static-analysis
170 | (explicitly-terminated-p
171 | (test-parse "
172 | foo();
173 | bar();
174 | try
175 | {
176 | try
177 | {
178 | if(baz())
179 | return 10;
180 | else
181 | throw new Error;
182 | }
183 | catch(e)
184 | {
185 | errno = e;
186 | throw null;
187 | }
188 | }
189 | catch(e)
190 | {
191 | x = errno;
192 | }
193 | baz(x);")
194 | '(:return :throw :break :continue :resume :suspend))
195 | nil)
196 |
197 | (deftest static-analysis/explicitly-terminated-p/nested-throw/4 :notes static-analysis
198 | (explicitly-terminated-p
199 | (test-parse "
200 | foo();
201 | bar();
202 | try
203 | {
204 | try
205 | {
206 | if(baz())
207 | return 10;
208 | else
209 | throw new Error;
210 | }
211 | catch(e)
212 | {
213 | errno = e;
214 | throw null;
215 | }
216 | }
217 | catch(e)
218 | {
219 | x = errno;
220 | }
221 | break;")
222 | '(:return :throw :break :continue :resume :suspend))
223 | :break)
224 |
--------------------------------------------------------------------------------
/tests/test-utils.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-utils.lisp
2 | ;;;
3 | ;;; Some helper functions for testing in general (i.e., that are
4 | ;;; not specific to testing a certain file).
5 | ;;;
6 | ;;; Copyright (c) 2005 James Wright
7 | ;;; See LICENSE for full licensing details.
8 | ;;;
9 | (in-package :jw-tests)
10 |
11 | (defun flag-expected-failure (test-name)
12 | "Add a test to the list of expected failures"
13 | (pushnew test-name rtest::*expected-failures*))
14 |
15 | (defmacro expect-error (form &optional (condition-type 'error))
16 | "If evaluating FORM results in an error being raised, returns non-NIL.
17 | If the CONDITION-TYPE argument is provided, non-NIL is raised only if
18 | an error of that specific type is raised."
19 | (let ((gret (gensym))
20 | (gerr (gensym)))
21 | `(multiple-value-bind (,gret ,gerr)
22 | (ignore-errors ,form)
23 | (declare (ignore ,gret))
24 | (or (typep ,gerr ',condition-type)
25 | ,gerr))))
26 |
27 | ;;; The REMOVE-POSITIONS transformation strips source positions from a source
28 | ;;; tree. TEST-PARSE and TEST-TRANSFORM both use it so that we can check
29 | ;;; generated Javascript code in unit tests without having to ensure that we
30 | ;;; provide the correct source positions (which is in many cases impossible,
31 | ;;; since transformation often moves source elements to different parts of the
32 | ;;; code while preserving their original position information).
33 | (defmethod transform ((xform (eql 'remove-positions)) (elm source-element))
34 | (apply
35 | (get-constructor elm)
36 | (loop for slot in (structure-slots elm)
37 | collect (make-keyword slot)
38 | collect (if (or (eq slot 'jw::start) (eq slot 'jw::end))
39 | nil
40 | (transform xform (slot-value elm slot))))))
41 |
42 | (defmethod transform ((xform (eql 'remove-positions)) (elm object-literal))
43 | (make-object-literal
44 | :properties
45 | (loop for (prop-name . prop-value) in (jw::object-literal-properties elm)
46 | collect (cons
47 | (transform xform prop-name)
48 | (transform xform prop-value)))))
49 |
50 | (defun test-parse (str)
51 | "Parse STR into a source model representation that does not include source positions"
52 | (let ((elm (parse str)))
53 | (transform 'remove-positions elm)))
54 |
55 | ;;; The REMOVE-ADMINISTRATIVES transformation translates administrative
56 | ;;; source-elements (such as CONTINUATION-FUNCTIONs) to their non-administrative
57 | ;;; equivalents (eg FUNCTION-EXPRESSION). This transformation is used by the
58 | ;;; TEST-TRANSFORM function to ensure that the results of a transformation are
59 | ;;; the same as what would be parsed from their pretty-printed representation
60 | ;;; (so that we can write unit tests by providing JWACS code instead of ASTs).
61 | (defmethod transform ((xform (eql 'remove-administratives)) (elm thunk-function))
62 | (make-function-expression :name (jw::function-expression-name elm)
63 | :parameters (jw::function-expression-parameters elm)
64 | :body (transform xform (jw::function-expression-body elm))))
65 |
66 | (defmethod transform ((xform (eql 'remove-administratives)) (elm continuation-function))
67 | (make-function-expression :name (jw::function-expression-name elm)
68 | :parameters (jw::function-expression-parameters elm)
69 | :body (transform xform (jw::function-expression-body elm))))
70 |
71 | (defmethod transform ((xform (eql 'remove-administratives)) (elm continuation-call))
72 | (make-fn-call :fn (transform xform (jw::fn-call-fn elm))
73 | :args (transform xform (jw::fn-call-args elm))))
74 |
75 | (defmethod transform ((xform (eql 'remove-administratives)) (elm special-value))
76 | (if (eq :arguments (jw::special-value-symbol elm))
77 | (make-identifier :name jw::*arguments-name*)
78 | (call-next-method)))
79 |
80 | (defmethod transform ((xform (eql 'remove-administratives)) (elm add-handler))
81 | (make-fn-call :fn (make-identifier :name "$addHandler")
82 | :args (list (transform xform (jw::add-handler-handler elm))
83 | (transform xform (jw::make-function-expression
84 | :body (jw::add-handler-thunk-body elm))))))
85 |
86 | (defmethod transform ((xform (eql 'remove-administratives)) (elm remove-handler))
87 | (make-fn-call :fn (make-identifier :name "$removeHandler")
88 | :args (list (transform xform (jw::remove-handler-handler elm))
89 | (transform xform (jw::make-function-expression
90 | :body (jw::remove-handler-thunk-body elm))))))
91 |
92 | (defun test-transform (xform elm)
93 | "Return the results of applying XFORM to ELM with any administrative source-elements
94 | converted to their non-administrative equivalents and with source positions removed."
95 | (transform 'remove-administratives
96 | (transform 'remove-positions
97 | (transform xform elm))))
98 |
99 | ;;; compilation helpers
100 |
101 | (defun compile-lang-tests (&key debug-mode)
102 | "Compile the language tests"
103 | (let* ((jw::*debug-mode* debug-mode)
104 | (module (asdf:find-component (asdf:find-system :jwacs-tests) "tests"))
105 | (component (asdf:find-component module "lang-tests")))
106 | (jw::build-app (asdf:component-pathname component))))
107 |
108 | (defun compile-examples (&key (compress-mode t) (combine-mode t))
109 | "Compiles all the examples"
110 | (let ((lib-pathname (asdf:system-relative-pathname :jwacs "lib/"))
111 | (examples-pathname (asdf:system-relative-pathname :jwacs "examples/")))
112 | (flet ((build-ex (name)
113 | (jw:build-app (uiop:subpathname examples-pathname name)
114 | :prefix-lookup `(("/lib/" . ,lib-pathname))
115 | :compress-mode compress-mode
116 | :combine-mode combine-mode)))
117 | (list
118 | (build-ex "CalendarMark2.jw")
119 | (build-ex "Counter.jw")
120 | (build-ex "TrivialHttpRequest.jw")))))
121 |
122 | ;;TODO Automated benchmarks?
123 | ;;TODO Randomized testing? (a la Quickcheck)
124 | ;;TODO Coverage checks?
125 |
--------------------------------------------------------------------------------
/examples/WebIdeClient.jw:
--------------------------------------------------------------------------------
1 | //// WebIdeClient.jw
2 | ///
3 | /// A simple web-based client for writing jwacs applications.
4 | import "../lib/prototype.js";
5 | import "../lib/jwacs-lib.js";
6 | import "effects.js";
7 | import "textarea-highlights.js";
8 |
9 | JwacsLib.initHistory();
10 | initHighlights();
11 |
12 | function main()
13 | {
14 | }
15 |
16 | function doLoad()
17 | {
18 | try
19 | {
20 | var sourceNameElm = document.getElementById("sourceName");
21 | var textElm = document.getElementById("sourceText");
22 |
23 | //TODO prompt if changed
24 |
25 | var newSource = JwacsLib.fetchData("GET", "/jwacs/demos/web-ide/source/" + sourceNameElm.value);
26 | textElm.value = newSource;
27 | JwacsLib.newPage();
28 | }
29 | catch(e)
30 | {
31 | alert("error: " + e);
32 | }
33 | }
34 |
35 | function updateButtons()
36 | {
37 | var sourceNameElm = document.getElementById("sourceName");
38 | if(sourceNameElm.value.match(/\.jw$/i))
39 | document.getElementById('runButton').disabled = false;
40 | else
41 | document.getElementById('runButton').disabled = true;
42 | }
43 |
44 | function doCompile()
45 | {
46 | var sourceNameElm = document.getElementById("sourceName");
47 | var textElm = document.getElementById("sourceText");
48 | var errElm = document.getElementById('errorText');
49 |
50 | try
51 | {
52 | var http = JwacsLib.sendRequest("POST", "/jwacs/demos/web-ide/compile/" + sourceNameElm.value,
53 | textElm.value);
54 |
55 | // Handle errors
56 | if(http.status == 409)
57 | {
58 | Element.show(errElm);
59 | var match = http.responseText.match(/^(\d+):(.*)$/);
60 | if(match)
61 | {
62 | errElm.innerHTML = match[2];
63 | var ta = document.getElementById('sourceText');
64 | var dummy = document.getElementById('dummyDiv');
65 | var box = addHighlight(ta, dummy, new Number(match[1]) + 1, new Number(match[1]) + 2, 'red');
66 | }
67 | else
68 | errElm.innerHTML = http.responseText;
69 | return;
70 | }
71 |
72 | if(http.status != 200)
73 | {
74 | alert("Error (" + http + "): " + http.responseText);
75 | return;
76 | }
77 |
78 | // Otherwise, there were no errors and we can reset the error box and return
79 | // the name of the application's entry URI.
80 | Element.hide(errElm);
81 | return http.responseText;
82 | }
83 | catch(e)
84 | {
85 | if(e.http && e.http.status == 409)
86 | errElm.innerHTML = e.http.responseText;
87 | else
88 | alert(e);
89 | }
90 | }
91 |
92 | var appWindow = null;
93 | function doRun()
94 | {
95 | // Clean up now-invalid highlights and close the obsolete window before we compile
96 | if(appWindow)
97 | appWindow.close();
98 | appWindow = null;
99 | clearHighlights();
100 |
101 | document.getElementById('exceptions').innerHTML = "";
102 |
103 | var appText = doCompile();
104 | if(!appText)
105 | return;
106 |
107 | // Insert code to set the $exHook at the very beginning of the script before loading it
108 | // into the appWindow
109 | appText = appText.replace(/" +
110 | " '(1 2 3)"
32 | (append list-arg (list atom-arg)))
33 |
34 | (defun maptree (fn tree)
35 | "MAPTREE maps a function over a tree of cons cells.
36 | If TREE is NIL, returns NIL.
37 | If TREE is a cons cell, recursively calls MAPTREE on the CAR and CDR and returns a new cons cell
38 | whose CAR and CDR are the results.
39 | Otherwise, returns the result of applying FN to TREE."
40 | (cond
41 | ((consp tree)
42 | (cons (maptree fn (car tree))
43 | (maptree fn (cdr tree))))
44 | ((null tree)
45 | tree)
46 | (t
47 | (funcall fn tree))))
48 |
49 | (defun prefix-p (string prefix)
50 | "return: whether prefix is a prefix of the string."
51 | (and (<= (length prefix) (length string))
52 | (string= string prefix :end1 (length prefix))))
53 |
54 | ;;;; ======= File handling =========================================================================
55 | (defun pathnames-equal (path1 path2)
56 | "Return non-NIL if PATH1 and PATH2 are equivalent. This function avoids some of the
57 | complexity that pathnames can entail by comparing the namestrings of the two paths
58 | rather than the paths themselves. That way we don't have to worry about spurious
59 | distinctions between :UNSPECIFIED and NIL, :NEWEST and NIL and some actual version number, etc."
60 | (equal (namestring (pathname path1))
61 | (namestring (pathname path2))))
62 |
63 | (defun read-entire-file (path)
64 | "Reads the entire contents of the file located at PATH and returns it as a string"
65 | (with-open-file (in path :direction :input)
66 | (with-output-to-string (out)
67 | (loop for line = (read-line in nil :eof)
68 | until (eq line :eof)
69 | do (format out "~A~%" line)))))
70 |
71 | (defun read-asdf-component-text (component-path)
72 | "Returns the contents of a file that is a component of a currently-loaded asdf system.
73 | COMPONENT-PATH is a path describing the location of the component to read. It should
74 | have at least 2 elements.
75 | The first element is a symbol naming a system.
76 | The last element is a string naming a component.
77 | There may be intermediate strings naming intermediate modules. Eg:
78 |
79 | (:JWACS-TESTS \"tests\" \"test-cps-transformation\")
80 |
81 | names the test-cps-transformation component, which is part of the tests module, which
82 | is part of the :JWACS-TESTS system."
83 | (let ((component (asdf:find-system (car component-path))))
84 | (dolist (name (cdr component-path))
85 | (setf component (asdf:find-component component name)))
86 | (read-entire-file (asdf:component-pathname component))))
87 |
88 | ;;;; ======= Backchannel communication =============================================================
89 | (define-condition backchannel-message ()
90 | ((channel-name :initarg :channel-name :accessor channel-name)
91 | (message-value :initarg :message-value :accessor message-value))
92 | (:documentation
93 | "A condition that indicates that a function further down the call chain has a message
94 | to pass back. BACKCHANNEL-MESSAGE should never be directly instantiated or used;
95 | use BIND-WITH-BACKCHANNELS and BACKCHANNEL-SIGNAL instead."))
96 |
97 | (defun backchannel-signal (channel value)
98 | "Signals VALUE on backchannel CHANNEL. Returns T if the message was received."
99 | (assert (keywordp channel))
100 | (restart-case (signal 'backchannel-message :channel-name channel :message-value value)
101 | (backchannel-message-received () t)))
102 |
103 | (defmacro bind-with-backchannels ((&rest bindings) form &body body)
104 | (let* ((first-keyword (position-if #'keywordp bindings))
105 | (mv-bindings (subseq bindings 0 first-keyword))
106 | (gmv-bindings (mapcar #'(lambda (name)
107 | (cons name (gensym)))
108 | mv-bindings)))
109 | (if first-keyword
110 | (let* ((channel-spec (subseq bindings first-keyword))
111 | (channel-names (loop with spec = channel-spec
112 | while spec
113 | collect (pop spec)
114 | do (pop spec)))
115 | (channel-bindings (loop with spec = channel-spec
116 | while spec
117 | do (pop spec)
118 | collect (pop spec)))
119 | (gvalue (gensym)))
120 | (flet ((make-clause (channel-name)
121 | `(,channel-name
122 | (push (message-value ,gvalue)
123 | ,(getf channel-spec channel-name))
124 | (invoke-restart 'backchannel-message-received))))
125 | `(let (,@mv-bindings
126 | ,@channel-bindings)
127 | (handler-bind ((backchannel-message #'(lambda (,gvalue)
128 | (case (channel-name ,gvalue)
129 | ,@(mapcar #'make-clause channel-names)))))
130 | (multiple-value-bind (,@(mapcar #'cdr gmv-bindings))
131 | ,form
132 | ,@(loop for (name . gname) in gmv-bindings
133 | collect `(setf ,name ,gname))
134 | ,@(loop for name in channel-bindings
135 | collect `(setf ,name (reverse ,name)))))
136 | ,@body)))
137 | `(multiple-value-bind ,mv-bindings ,form ,@body))))
138 |
--------------------------------------------------------------------------------
/tests/test-trampoline-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-trampoline-transformation.lisp
2 | ;;;
3 | ;;; Tests for the trampoline transformation
4 | ;;;
5 | ;;; Copyright (c) 2006 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs-tests)
9 |
10 | (defnote trampoline "tests for the trampoline transformation")
11 |
12 | (deftest trampoline/inlined-result/1 :notes trampoline
13 | (transform 'trampoline
14 | (test-parse "return 50;"))
15 | #.(test-parse "return {done: true, result: 50};"))
16 |
17 | (deftest trampoline/inlined-result/2 :notes trampoline
18 | (transform 'trampoline
19 | (test-parse "return x[50];"))
20 | #.(test-parse "return {done: true, result: x[50]};"))
21 |
22 | (deftest trampoline/inlined-thunk/1 :notes trampoline
23 | (test-transform 'trampoline
24 | (parse "return fn(4);"))
25 | #.(test-parse "return {done: false,
26 | thunk: function($e) {
27 | return fn(4);
28 | }};"))
29 |
30 | ;; Verify that the correct administrative source-element gets created
31 | (deftest trampoline/inlined-thunk/2 :notes trampoline
32 | (transform 'trampoline
33 | (test-parse "return fn(4);"))
34 | (#s(return-statement
35 | :arg
36 | #S(object-literal :properties
37 | ((#s(string-literal :value "done") . #S(special-value :symbol :false))
38 | (#s(string-literal :value "thunk") . #S(thunk-function
39 | :parameters ("$e")
40 | :body
41 | (#s(return-statement
42 | :arg
43 | #S(fn-call :fn #S(identifier :name "fn")
44 | :args (#S(numeric-literal :value 4))))))))))))
45 |
46 |
47 | (deftest trampoline/inlined-thunk/3 :notes trampoline
48 | (let ((jw::*debug-mode* t))
49 | (test-transform 'trampoline
50 | (parse "return fn(4);")))
51 | #.(test-parse "return {startPos: 0, endPos: 13,
52 | done: false,
53 | thunk: function($e, $localEvalArg) {
54 | if($localEvalArg) return $id(eval($localEvalArg));
55 | return fn(4);
56 | }};"))
57 |
58 | (deftest trampoline/new-expr/1 :notes trampoline
59 | (test-transform 'trampoline (parse "
60 | return new Object;"))
61 | #.(test-parse "
62 | return {done: false,
63 | thunk: function($e) {
64 | return new Object;
65 | }
66 | };"))
67 |
68 | (deftest trampoline/new-expr/2 :notes trampoline
69 | (test-transform 'trampoline (parse "
70 | return new Foo($k, 10);"))
71 | #.(test-parse "
72 | return {done: false,
73 | thunk: function($e) {
74 | return new Foo($k, 10);
75 | }
76 | };"))
77 |
78 | (deftest trampoline/function-expression-recursion/1 :notes trampoline
79 | (test-transform 'trampoline (parse "
80 | return factorial(function(JW0) { return $k(n * JW0); }, n-1);"))
81 | #.(test-parse "
82 | return {done: false,
83 | thunk: function($e) {
84 | return factorial(function(JW0) {
85 | return {done: false, thunk: function($e) { return $k(n * JW0); }};
86 | }, n - 1);
87 | }};"))
88 |
89 | (deftest trampoline/suspend/1 :notes trampoline
90 | (in-local-scope
91 | (test-transform 'trampoline (parse "
92 | if(flag)
93 | suspend;
94 | else
95 | return 50;")))
96 | #.(test-parse "
97 | if(flag)
98 | return {done: true};
99 | else
100 | return {done: true, result: 50};"))
101 |
102 | ;; Note that we return the result of the continuation directly without
103 | ;; wrapping it in a thunk or a result object (a "trampoline box"?)
104 | ;; since it should already be trampoline boxed by the continuation iteself.
105 | (deftest trampoline/resume/1 :notes trampoline
106 | (in-local-scope
107 | (test-transform 'trampoline (parse "
108 | resume foo[bar];")))
109 | #.(test-parse "
110 | return {replaceHandlers: foo[bar].$exHandlers, done: false, thunk: function($e) {
111 | return foo[bar](); }};"))
112 |
113 | (deftest trampoline/resume/2 :notes trampoline
114 | (in-local-scope
115 | (test-transform 'trampoline (parse "
116 | resume foo[bar] <- baz;")))
117 | #.(test-parse "
118 | return {replaceHandlers: foo[bar].$exHandlers, done: false, thunk: function($e) {
119 | return foo[bar](baz); }};"))
120 |
121 | ;; Note that the toplevel version of trampoline's tranformation of resume statements
122 | ;; isn't any different from the in-local-scope version anymore. I'm keeping these
123 | ;; tests around in case I change my mind about where to resolve toplevel issues.
124 | (deftest trampoline/resume/toplevel/1 :notes trampoline
125 | (test-transform 'trampoline (parse "
126 | resume foo;"))
127 | #.(test-parse "
128 | return {replaceHandlers: foo.$exHandlers, done: false, thunk: function($e) {
129 | return foo(); }};"))
130 |
131 | (deftest trampoline/resume/toplevel/2 :notes trampoline
132 | (test-transform 'trampoline (parse "
133 | resume foo <- bar;"))
134 | #.(test-parse "
135 | return {replaceHandlers: foo.$exHandlers, done: false, thunk: function($e) {
136 | return foo(bar); }};"))
137 |
138 | (deftest trampoline/throw/1 :notes trampoline
139 | (transform 'trampoline (test-parse "
140 | throw 100;"))
141 | #.(test-parse "
142 | throw 100;"))
143 |
144 | (deftest trampoline/throw/2 :notes trampoline
145 | (let ((jw::*debug-mode* t))
146 | (test-transform 'trampoline (parse "throw 100;")))
147 | #.(test-parse "return {startPos: 0, endPos: 10,
148 | done: false,
149 | thunk: function($e, $localEvalArg) {
150 | if($localEvalArg) return $id(eval($localEvalArg));
151 | throw 100;
152 | }};"))
153 |
154 | (deftest trampoline/throw/3 :notes trampoline
155 | (test-transform 'trampoline (parse "
156 | throw 100 -> k;"))
157 | #.(test-parse "
158 | return {replaceHandlers: k.$exHandlers, done: false, thunk: function($e) {
159 | throw 100;
160 | }};"))
161 |
162 | ;;TODO position-preservation unit tests
--------------------------------------------------------------------------------
/tests/test-lexer.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-lexer.lisp
2 | ;;;
3 | ;;; Unit tests for the Javascript lexer.
4 | ;;;
5 | ;;; Copyright (c) 2005 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs-tests)
9 |
10 | ;;;; Helper functions
11 | (defun non-null (x)
12 | "Return T if X is non-null. This is a convenience function that
13 | frees us from the necessity of having to know exactly which non-null
14 | value a test should expect."
15 | (not (null x)))
16 |
17 | ;;;; Test categories
18 | (defnote lexer "tests for the lexer")
19 | (defnote regexp "tests for individual regular expressions")
20 |
21 | ;;;; Tests
22 | (deftest regexp-re/1 :notes (lexer regexp)
23 | (non-null (scan regexp-re "/hello/"))
24 | t)
25 |
26 | (deftest regexp-re/2 :notes (lexer regexp)
27 | (non-null (scan regexp-re "/.\\n/"))
28 | t)
29 |
30 | (deftest regexp-re/3 :notes (lexer regexp)
31 | (non-null (scan regexp-re "/(this)/g"))
32 | t)
33 |
34 | (deftest regexp-re/4 :notes (lexer regexp)
35 | (non-null (scan regexp-re "/(this)/gi"))
36 | t)
37 |
38 | (deftest regexp-re/5 :notes (lexer regexp)
39 | (scan regexp-re "\"hi\"")
40 | nil)
41 |
42 | (deftest regexp-re/6 :notes (lexer regexp)
43 | (scan regexp-re "/\"hi\"")
44 | nil)
45 |
46 | (defun read-all-tokens (js-string)
47 | "Return a list of cons cells representing the tokens
48 | of JS-STRING. The CAR of each cell is the type of
49 | token, and the CDR is the source text."
50 | (loop with l = (make-lexer-function (make-instance 'javascript-lexer :text js-string))
51 | for x = (multiple-value-list (funcall l))
52 | until (null (first x))
53 | collect (list (first x) (token-value (second x)))))
54 |
55 | (deftest lexer/1 :notes lexer
56 | (read-all-tokens
57 | "/* test string */
58 | function (f)
59 | {
60 | // Ignore this stuff
61 | var m = 010;
62 | doStuff('stuff', \"nonsense\", 0xff, 45.0, f(m));
63 | }")
64 | ((:function "function")
65 | (:left-paren "(")
66 | (:identifier "f")
67 | (:right-paren ")")
68 | (:left-curly "{")
69 | (:var "var")
70 | (:identifier "m")
71 | (:equals "=")
72 | (:number 8)
73 | (:semicolon ";")
74 | (:identifier "doStuff")
75 | (:left-paren "(")
76 | (:string-literal "stuff")
77 | (:comma ",")
78 | (:string-literal "nonsense")
79 | (:comma ",")
80 | (:number 255)
81 | (:comma ",")
82 | (:number 45.0)
83 | (:comma ",")
84 | (:identifier "f")
85 | (:left-paren "(")
86 | (:identifier "m")
87 | (:right-paren ")")
88 | (:right-paren ")")
89 | (:semicolon ";")
90 | (:right-curly "}")))
91 |
92 | (deftest lexer/2 :notes lexer
93 | (read-all-tokens
94 | "var re1 = /hello/g;
95 | var re2 = /hello\\/goodbye/ig;")
96 | ((:var "var")
97 | (:identifier "re1")
98 | (:equals "=")
99 | (:re-literal ("hello" . "g"))
100 | (:semicolon ";")
101 | (:var "var")
102 | (:identifier "re2")
103 | (:equals "=")
104 | (:re-literal ("hello/goodbye" . "ig"))
105 | (:semicolon ";")))
106 |
107 | (deftest lexer/3 :notes lexer
108 | (read-all-tokens
109 | "x >= 10, y<=20, <=>=<>")
110 | ((:identifier "x")
111 | (:greater-than-equals ">=")
112 | (:number 10)
113 | (:comma ",")
114 | (:identifier "y")
115 | (:less-than-equals "<=")
116 | (:number 20)
117 | (:comma ",")
118 | (:less-than-equals "<=")
119 | (:greater-than-equals ">=")
120 | (:less-than "<")
121 | (:greater-than ">")))
122 |
123 | (deftest lexer/4 :notes lexer
124 | (read-all-tokens
125 | "foo _foo $foo foo1 foo$ foo_")
126 | ((:identifier "foo")
127 | (:identifier "_foo")
128 | (:identifier "$foo")
129 | (:identifier "foo1")
130 | (:identifier "foo$")
131 | (:identifier "foo_")))
132 |
133 | (deftest lexer/restricted-tokens/1 :notes lexer
134 | (read-all-tokens "break foo")
135 | ((:break "break") (:no-line-terminator "") (:identifier "foo")))
136 |
137 | (deftest lexer/restricted-tokens/2 :notes lexer
138 | (read-all-tokens "break
139 | foo")
140 | ((:break "break") (:line-terminator "") (:identifier "foo")))
141 |
142 | (deftest lexer/restricted-tokens/3 :notes lexer
143 | (read-all-tokens "continue;")
144 | ((:continue "continue") (:no-line-terminator "") (:semicolon ";")))
145 |
146 | (deftest lexer/restricted-tokens/4 :notes lexer
147 | (read-all-tokens "continue
148 | ;")
149 | ((:continue "continue") (:line-terminator "") (:semicolon ";")))
150 |
151 | (deftest lexer/restricted-tokens/5 :notes lexer
152 | (read-all-tokens "b ++ c")
153 | ((:identifier "b") (:no-line-terminator "") (:plus2 "++") (:identifier "c")))
154 |
155 | (deftest lexer/restricted-tokens/6 :notes lexer
156 | (read-all-tokens "b
157 | ++ c")
158 | ((:identifier "b") (:line-terminator "") (:plus2 "++") (:identifier "c")))
159 |
160 | (deftest lexer/set-cursor/1 :notes lexer
161 | (let ((lexer (make-instance 'javascript-lexer :text "x/5 + x/10;"))
162 | (tok nil))
163 | (next-token lexer) ; ==> X
164 | (setf tok (next-token lexer)) ; ==> /5 + x/
165 | (set-cursor lexer (token-start tok))
166 | (next-token lexer))
167 | #s(token :terminal :re-literal :value ("5 + x" . "")
168 | :start 1 :end 8))
169 |
170 | (deftest lexer/coerce-token/1 :notes lexer
171 | (let ((lexer (make-instance 'javascript-lexer :text "x/5 + x/10;"))
172 | (tok nil))
173 | (next-token lexer) ; ==> X
174 | (setf tok (next-token lexer)) ; ==> /5 + x/
175 | (set-cursor lexer (token-start tok))
176 | (coerce-token lexer :slash)
177 | (next-token lexer) ; ==> /
178 | (next-token lexer))
179 | #s(token :terminal :number :value 5 :start 2 :end 3))
180 |
181 | (deftest lexer/position/1 :notes lexer
182 | (let ((lexer (make-instance 'javascript-lexer :text "Line 1
183 | Line number 2
184 |
185 | Line 4")))
186 | (loop for token = (next-token lexer)
187 | until (null (token-terminal token))
188 | collect (position-to-line/column (jw::text lexer) (token-start token))))
189 | ((1 . 1) (1 . 6)
190 | (2 . 1) (2 . 6) (2 . 13)
191 | (4 . 1) (4 . 6)))
192 |
193 | (deftest lexer/position/2 :notes lexer
194 | (let ((lexer (make-instance 'javascript-lexer :text "Line 1
195 | Line number 2
196 |
197 | Line 4")))
198 | (loop for token = (next-token lexer)
199 | until (null (token-terminal token))
200 | collect (position-to-line/column (jw::text lexer) (token-end token))))
201 | ((1 . 5) (1 . 7)
202 | (2 . 5) (2 . 12) (2 . 14)
203 | (4 . 5) (4 . 7)))
204 |
205 | (deftest lexer/encountered-line-terminator/1 :notes lexer
206 | (let ((lexer (make-instance 'javascript-lexer :text "})
207 | return 10;")))
208 | (loop for token = (next-token lexer)
209 | until (null (token-terminal token))
210 | collect (not (null (encountered-line-terminator lexer)))))
211 | (nil nil t nil nil nil))
--------------------------------------------------------------------------------
/tests/test-loop-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;
2 | ;;; Copyright (c) 2005 Greg Smolyn
3 | ;;; See LICENSE for full licensing details.
4 | ;;;
5 | (in-package :jwacs-tests)
6 |
7 | ;; canonicalization tests
8 |
9 | (defnote loop-canonicalize "tests for canonicalize source transformation")
10 |
11 | ;; ====================================
12 | ;; WHILE LOOPS
13 |
14 |
15 | (deftest canonicalize/while/basic :notes loop-canonicalize
16 | (transform 'loop-canonicalize
17 | (test-parse "x=0; while(x<4) { foo(); x++; }"))
18 | #.(test-parse "x=0; while(true) { if(!(x<4)) break; foo(); x++; continue; }"))
19 |
20 | (deftest canonicalize/while/var-decl-in-body :notes loop-canonicalize
21 | (transform 'loop-canonicalize
22 | (test-parse "x=0; while(x<4) { var y=0; foo(); x++; }"))
23 | #.(test-parse "x=0; var y; while(true) { if(!(x<4)) break; y=0; foo(); x++; continue; }"))
24 |
25 | (deftest canonicalize/while/nested-while :notes loop-canonicalize
26 | (transform 'loop-canonicalize
27 | (test-parse "while(x<4) { var y=0; foo(); while(y<5) { var z=0; bar(); } }"))
28 | #.(test-parse "var y,z; while(true) { if(!(x<4)) break; y=0; foo(); while(true) { if(!(y<5)) break; z=0; bar(); continue; } continue; }"))
29 |
30 | (deftest canonicalize/while/labelled :notes loop-canonicalize
31 | (transform 'loop-canonicalize
32 | (test-parse "x=0; labelled: while(x<4) { foo(); x++; }"))
33 | #.(test-parse "x=0; labelled: while(true) { if(!(x<4)) break; foo(); x++; continue; }"))
34 |
35 | (deftest canonicalize/while/infinite :notes loop-canonicalize
36 | (transform 'loop-canonicalize
37 | (test-parse "
38 | while(true);"))
39 | #.(test-parse "
40 | while(true)
41 | {
42 | if(!true)
43 | break;
44 | continue;
45 | }"))
46 |
47 |
48 | ;; ====================================
49 | ;; FOR LOOPS
50 |
51 |
52 | (deftest canonicalize/for/basic :notes loop-canonicalize
53 | (transform 'loop-canonicalize
54 | (test-parse "for(var x=0; x<10; x++) { foo(); }"))
55 | #.(test-parse "var x=0; while(true) { if(!(x<10)) break; foo(); x++; continue; }"))
56 |
57 | (deftest canonicalize/for/labelled :notes loop-canonicalize
58 | (transform 'loop-canonicalize
59 | (test-parse "yar: for(var x=0; x<10; x++) { foo(); }"))
60 | #.(test-parse "var x=0; yar: while(true) { if(!(x<10)) break; foo(); x++; continue; }"))
61 |
62 |
63 | (deftest canonicalize/for/var-decl-in-body :notes loop-canonicalize
64 | (transform 'loop-canonicalize
65 | (test-parse "for(var x=0; x<10; x++) { var y=0; foo();}"))
66 | #.(test-parse "var y; var x=0; while(true) { if(!(x<10)) break; y=0; foo(); x++; continue; }"))
67 |
68 | (deftest canonicalize/for/single-statement :notes loop-canonicalize
69 | (with-fresh-genvar
70 | (transform 'loop-canonicalize
71 | (test-parse "
72 | for(var x = 0; x < 10; x++)
73 | output(x);")))
74 | #.(test-parse "
75 | var x = 0;
76 | while(true)
77 | {
78 | if(!(x < 10))
79 | break;
80 | output(x);
81 | x++;
82 | continue;
83 | }"))
84 |
85 | (deftest canonicalize/for/infinite :notes loop-canonicalize
86 | (with-fresh-genvar
87 | (transform 'loop-canonicalize
88 | (test-parse "
89 | for(;;);")))
90 | #.(test-parse "
91 | while(true)
92 | {
93 | if(!true)
94 | break;
95 | continue;
96 | }"))
97 |
98 |
99 | ;; ====================================
100 | ;; DO-WHILE LOOPS
101 |
102 | (deftest canonicalize/do-while/var-decl-in-body :notes loop-canonicalize
103 | (with-fresh-genvar
104 | (transform 'loop-canonicalize
105 | (test-parse "do { var x = rval; foo(); } while(test);")))
106 | #.(test-parse "
107 | var x, JW0 = true;
108 | while(true)
109 | {
110 | if(!JW0)
111 | {
112 | if(!test)
113 | break;
114 | }
115 | else
116 | JW0 = false;
117 | x = rval;
118 | foo();
119 | continue;
120 | }"))
121 |
122 | (deftest canonicalize/do-while/labelled :notes loop-canonicalize
123 | (with-fresh-genvar
124 | (transform 'loop-canonicalize
125 | (test-parse "yar: do { var x = rval; foo(); } while(test);")))
126 | #.(test-parse "
127 | var x, JW0 = true;
128 | yar:
129 | while(true)
130 | {
131 | if(!JW0)
132 | {
133 | if(!test)
134 | break;
135 | }
136 | else
137 | JW0 = false;
138 | x = rval;
139 | foo();
140 | continue;
141 | }"))
142 |
143 |
144 | ;; ====================================
145 | ;; FOR-IN LOOPS
146 |
147 | (deftest canonicalize/for-in/basic :notes loop-canonicalize
148 | (with-fresh-genvar
149 | (transform 'loop-canonicalize
150 | (test-parse "for(var_x in some_collection) { foo(); }")))
151 | #.(test-parse "
152 | var JW0 = [], JW1 = 0, JW3 = 0;
153 | for(var JW2 in some_collection)
154 | {
155 | JW0[JW1++] = JW2;
156 | }
157 | while(true)
158 | {
159 | if(!(JW3 < JW0.length))
160 | break;
161 | var_x = JW0[JW3++];
162 | foo();
163 | continue;
164 | }"))
165 |
166 | (deftest canonicalize/for-in/labelled :notes loop-canonicalize
167 | (with-fresh-genvar
168 | (transform 'loop-canonicalize
169 | (test-parse "yar: for(var_x in some_collection) { foo(); }")))
170 | #.(test-parse "
171 | var JW0 = [], JW1 = 0, JW3 = 0;
172 | for(var JW2 in some_collection)
173 | {
174 | JW0[JW1++] = JW2;
175 | }
176 | yar:
177 | while(true)
178 | {
179 | if(!(JW3 < JW0.length))
180 | break;
181 | var_x = JW0[JW3++];
182 | foo();
183 | continue;
184 | }"))
185 |
186 | (deftest canonicalize/while/position-preservation/1 :notes loop-canonicalize
187 | (let* ((xformed (transform 'loop-canonicalize
188 | (parse "x=0; while(x<4) { foo(); x++; }")))
189 | (foo-call (second (jw::statement-block-statements (jw::while-body (second xformed))))))
190 | (values (source-element-start foo-call)
191 | (source-element-end foo-call)))
192 | 18 21)
193 |
194 |
195 | (deftest canonicalize/for-with-var-decls-in-body/1 :notes loop-canonicalize
196 | (with-fresh-genvar
197 | (transform 'loop-canonicalize (test-parse "
198 | while(true)
199 | {
200 | for(var i = 0;;);
201 | }")))
202 | #.(test-parse "
203 | var i;
204 | while(true)
205 | {
206 | if(!true)
207 | break;
208 | i = 0;
209 | while(true)
210 | {
211 | if(!true)
212 | break;
213 | continue;
214 | }
215 | continue;
216 | }"))
217 |
218 |
219 | ;; TODO at some point we will want to look very carefully at how the positions are calculated
220 | ;; for the condition test and the generated break and continue statements.
--------------------------------------------------------------------------------
/main.lisp:
--------------------------------------------------------------------------------
1 | ;;;; main.lisp
2 | ;;;
3 | ;;; Defines the MAIN function which is the entry-point for the delivered binary.
4 | ;;;
5 | ;;; Copyright (c) 2006 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs)
9 |
10 | (defun main ()
11 | "This is the main entry-point for the jwacs binary."
12 | (show-banner)
13 | (handler-case
14 | (multiple-value-bind (template output prefix-lookup bundle-mode compress-mode runtime target)
15 | (decode-arguments)
16 | (let ((build-args (list target)))
17 | (unless target
18 | (format *error-output* "~&jwacs: No target specified~%")
19 | (show-usage)
20 | (return-from main 255))
21 | (format t "~&Main source file: ~A" target)
22 | (when template
23 | (format t "~&~%Template URI path: ~A" template)
24 | (format t "~&Template file: ~A" (truename (resolve-import-uripath target template prefix-lookup)))
25 | (setf build-args (append build-args (list :template-uripath template))))
26 | (when runtime
27 | (format t "~&~%Runtime URI path: ~A" runtime)
28 | (format t "~&Runtime file: ~A" (truename (resolve-import-uripath target runtime prefix-lookup)))
29 | (setf build-args (append build-args (list :runtime-uripath runtime))))
30 | (when output
31 | (format t "~&~%Output URI path: ~A" output)
32 | (format t "~&Output file: ~A" (resolve-import-uripath target output prefix-lookup))
33 | (setf build-args (append build-args (list :output-uripath output))))
34 | (unless (eq :default bundle-mode)
35 | (format t "~&Bundle mode: ~A" (if bundle-mode "on" "off"))
36 | (setf build-args (append build-args (list :combine-mode bundle-mode))))
37 | (unless (eq :default compress-mode)
38 | (format t "~&Compress mode: ~A" (if compress-mode "on" "off"))
39 | (setf build-args (append build-args (list :compress-mode compress-mode))))
40 |
41 | (apply 'build-app build-args)
42 | (format t "~&~%Done.~%~%")
43 | 0))
44 | (condition (c)
45 | (let ((*print-escape* nil))
46 | (format *error-output* "~&jwacs: ")
47 | (print-object c *error-output*)
48 | (terpri *error-output*)
49 | 254))))
50 |
51 | (defun decode-arguments ()
52 | "Decode the command-line arguments and return the resulting option values"
53 | (let (template output prefix-lookup (bundle-mode :default) (compress-mode :default) runtime target)
54 | (do* ((arg-cell (uiop:command-line-arguments) (cddr arg-cell))
55 | (arg-name (car arg-cell) (car arg-cell))
56 | (arg-value (cadr arg-cell) (cadr arg-cell)))
57 | ((null arg-cell))
58 | (cond
59 | ((string= "-t" arg-name)
60 | (setf template arg-value))
61 | ((string= "-o" arg-name)
62 | (setf output arg-value))
63 | ((string= "-r" arg-name)
64 | (setf runtime arg-value))
65 | ((string= "-p" arg-name)
66 | (setf prefix-lookup (parse-prefix-lookup arg-value)))
67 | ((string= "-b" arg-name)
68 | (setf bundle-mode (boolean-arg arg-name arg-value)))
69 | ((string= "-c" arg-name)
70 | (setf compress-mode (boolean-arg arg-name arg-value)))
71 | ((null arg-value)
72 | (setf target (truename arg-name)))
73 | (t
74 | (show-usage)
75 | (error "Unrecognized option '~A'" arg-name))))
76 | (values template output prefix-lookup bundle-mode compress-mode runtime target)))
77 |
78 | (defun boolean-arg (name val)
79 | "Converts an argument to a boolean option to a boolean value"
80 | (let ((true-args '("t" "true" "on" "yes"))
81 | (false-args '("nil" "false" "off" "no")))
82 | (cond
83 | ((find val true-args :test 'string-equal)
84 | t)
85 | ((find val false-args :test 'string-equal)
86 | nil)
87 | (t
88 | (error "The argument to the ~A option must be one of: ~A" name (append true-args false-args))))))
89 |
90 | (defun parse-prefix-lookup (raw-str)
91 | "Takes the argument to the prefix lookup command line option and parses it into a
92 | prefix-lookup table."
93 | (flet ((parse-cell (cell-str)
94 | (let* ((components (split "=+" cell-str))
95 | (uri (first components))
96 | (path (second components)))
97 |
98 | ;; Validate input
99 | (assert (= 2 (length components)) nil
100 | "Ill-formed lookup entry ~S" cell-str)
101 | (assert (char= #\/ (aref uri 0)) (uri)
102 | "'~A' is not an absolute URI path" uri)
103 |
104 | ;; We'll silently add trailing slashes if required
105 | (when (char/= #\/ (aref uri (1- (length uri))))
106 | (setf uri (format nil "~A/" uri)))
107 | (when (and (char/= #\\ (aref path (1- (length path))))
108 | (char/= #\/ (aref path (1- (length path)))))
109 | (setf path (format nil "~A/" path)))
110 |
111 | (cons uri (parse-namestring path)))))
112 | (mapcar #'parse-cell (split ";" raw-str))))
113 |
114 | (defparameter *version*
115 | #.(asdf:component-version (asdf:find-system :jwacs)))
116 |
117 | (defun show-banner ()
118 | (format t "~%~%~
119 | ===============================================================================~%~
120 | jwacs - Javascript With Advanced Continuation Support~%~
121 | version: ~A~%~
122 | -------------------------------------------------------------------------------"
123 | *version*)
124 | (write-line "" *standard-output*))
125 |
126 | (defun show-usage ()
127 | (let ((foo (namestring #P"/static-web/foo/"))
128 | (bar (namestring #P"/contrib/bar/")))
129 | (format t "~&Usage: ~A [options] ~%~
130 | ~%Options:~
131 | ~% -t URI-path of the template file to use. Default: the name of~
132 | ~% the main source file, with new extension \".template\".~
133 | ~% -r URI-path of the runtime script to use. Default: \"jw-rt.js\".~
134 | ~% -o URI-path of the output file to create. Default: the name~
135 | ~% of the main source file with new extension \".html\".~
136 | ~% -p =[;= ...]~
137 | ~% Specifies the mapping between absolute URI paths and the~
138 | ~% filesystem.~
139 | ~% eg: -i /foo/=~A;/foo/bar/=~A~
140 | ~% maps all absolute URI paths under /foo/ to ~A,~
141 | ~% except for those under /foo/bar/ which are searched for~
142 | ~% in ~A.~
143 | ~% -c on|off Turn compress mode on or off. When on, unnecessary whitespace~
144 | ~% will be omitted in output Javascript. When off, indentation~
145 | ~% and comments will be preserved. Defaults to on.~
146 | ~% -b on|off Turn bundle mode on or off. When on, all output Javascript~
147 | ~% files will be combined into a single file. When off, each~
148 | ~% jwacs file will be compiled into a seperate Javascript file,~
149 | ~% and each imported Javascript file will be linked to separately.~
150 | ~% Defaults to on.
151 | ~%~%"
152 | "jwacs" foo bar foo bar)))
153 |
--------------------------------------------------------------------------------
/ugly-print.lisp:
--------------------------------------------------------------------------------
1 | ;;;; ugly-print.lisp
2 | ;;;
3 | ;;; Provides functions for printing ASTs in a pareseable, but hopefully un-human readable form
4 | ;;; The key functionality provided is a source transformation to ensure ALL identifiers are made
5 | ;;; unique
6 | ;;;
7 | ;;; Note that pretty-print was modified to output without formatting if *pretty-mode*
8 | ;;; and *opt-space* are correctly set.
9 | ;;; Essentially all we do in this is the uniquifying transformation.
10 | ;;;
11 | ;;; Unit tests in tests/ugly-print.lisp.
12 | ;;;
13 | ;;; Copyright (c) 2005 Greg Smolyn and James Wright
14 | ;;; See LICENSE for full licensing details.
15 | ;;;
16 | (in-package :jwacs)
17 |
18 | ; Our main entry point to the ugly printer
19 | ; Please note that we're cheating somewhat-- the source
20 | (defun ugly-print (elm stream)
21 | "Outputs the AST to a stream with variables and function names converted to
22 | unique identifiers (ie. JW0) and with all formatting removed."
23 | (let* ((*pretty-mode* nil)
24 | (*opt-space* "")
25 | (new-elm (uglify-vars elm)))
26 | (pretty-print new-elm stream)))
27 |
28 | ;;; ==================================================
29 | ;;;
30 | ;;; Simple environment ADT (ribcage)
31 | ;;;
32 | ;;; the environment is a list of association lists
33 | ;;; alists contain pairs of (oldname . newname), in this case they will be strings
34 | ;;;
35 | ;;; Everytime we enter a new lexical environment, we add a new alist to the front.
36 | ;;; When looking for a binding, we start at the front (innermost) and look through until we get to the back (global)
37 |
38 | (defparameter *environment* '()
39 | "list of assoc lists representing the current lexical environment")
40 |
41 | (defmacro with-added-environment (&body body)
42 | "Executes BODY with a new environment added to the environment stack"
43 | `(let ((*environment* (cons '() *environment*)))
44 | ,@body))
45 |
46 | (defun find-binding (var-name)
47 | "Looks through the set of environments and finds the most recently bound variable, returns its bound value"
48 | (labels ((f-b-h (environment)
49 | (if (null environment)
50 | nil
51 | (let ((var-pair (assoc var-name (car environment) :test #'equal)))
52 | (if (null var-pair)
53 | (f-b-h (cdr environment))
54 | (cdr var-pair))))))
55 | (f-b-h *environment*)))
56 |
57 | (defun add-binding (var-name var-newname)
58 | "Add a binding to the environment. In our case, name and new name"
59 | (push (cons var-name var-newname) (car *environment*)))
60 |
61 | (defun ensure-unique-binding (var-name)
62 | "Adds a unique name for VAR-NAME to the environment, and returns the unique name.
63 | The unique name will be uglified or otherwise 'uniquified' for non-toplevel
64 | identifiers; toplevel identifiers will be left as-is."
65 | (cond
66 | (*in-local-scope*
67 | (let ((ugly-name (genvar var-name)))
68 | (add-binding var-name ugly-name)
69 | ugly-name))
70 | (t
71 | ;;TODO Warnings may have to be done differently once compiler errors are
72 | ;; being properly reported.
73 | (when (find-binding var-name)
74 | (warn "Duplicate top-level identifier '~A'" var-name))
75 | (add-binding var-name var-name)
76 | var-name)))
77 |
78 | (defparameter *genvar-counter* 0)
79 |
80 | (defun genvar (&optional orig-name)
81 | "Generates a unique string that will be our ugly name for variables.
82 | When *PRETTY-MODE* is non-NIL and ORIG-NAME is provided, the name will
83 | be unique but not all that ugly."
84 | (let ((old *genvar-counter*))
85 | (incf *genvar-counter*)
86 | (if (and *pretty-mode* orig-name)
87 | (format nil "~A$~D" orig-name old)
88 | (format nil "JW~D" old))))
89 |
90 |
91 | ;;; ==================================================
92 | ;;;
93 | ;;; uniquify source transformation
94 | ;;;
95 | ;;; Converts all variable declarations and function names into indiscernable unique names such as JW0.
96 | ;;;
97 | ;;; Subsequently ensures that all identifiers are unique (all scoping will have been sorted out by this point)
98 |
99 | (defun uglify-vars (program)
100 | "Entry point for our source transformation. Turn all var and function declarations and their related
101 | references s into ugly ones"
102 | (with-added-environment
103 | (transform-in-scope program)))
104 |
105 | (defun transform-in-scope (elm)
106 | "Transforms source elements for the current scope. Given an element, collects all
107 | var-decls and fun-decls and adds them to the current environment. THEN goes through
108 | and transforms identifiers + names in said environment. This calls into the main
109 | uniquify transform methods, and subsequently will recurse through the tree"
110 | (dolist (var-decl (collect-in-scope elm 'var-decl))
111 | (ensure-unique-binding (var-decl-name var-decl)))
112 | (dolist (fun-decl (collect-in-scope elm 'function-decl))
113 | (ensure-unique-binding (function-decl-name fun-decl)))
114 | (transform 'uniquify elm))
115 |
116 | ;;; Guarantee that we will always have an environment available
117 | (defmethod transform :around ((xform (eql 'uniquify)) elm)
118 | (if (null *environment*)
119 | (with-added-environment
120 | (transform-in-scope elm))
121 | (call-next-method)))
122 |
123 | (defmethod transform ((xform (eql 'uniquify)) (elm identifier))
124 | (let ((new-name (find-binding (identifier-name elm))))
125 | ;; If the identifier is defined in this script, use its unique name.
126 | ;; Otherwise, return it unmodified (to account for system globals like document or XmlHttpRequest)
127 | (if new-name
128 | (make-identifier :name new-name
129 | :start (source-element-start elm)
130 | :end (source-element-end elm))
131 | elm)))
132 |
133 | (defmethod transform ((xform (eql 'uniquify)) (elm function-decl))
134 | (with-added-environment
135 |
136 | ;; Make sure that the function name has a binding in the current environment
137 | ;; (It will if this source-element was part of a list, but it won't if this
138 | ;; is a singleton source element)
139 | (unless (find-binding (function-decl-name elm))
140 | (ensure-unique-binding (function-decl-name elm)))
141 |
142 | (in-local-scope
143 | (let ((new-params (mapcar #'ensure-unique-binding (function-decl-parameters elm))))
144 | (make-function-decl :name (find-binding (function-decl-name elm))
145 | :parameters new-params
146 | :body (transform-in-scope (function-decl-body elm))
147 | :start (source-element-start elm)
148 | :end (source-element-end elm))))))
149 |
150 | (defmethod transform ((xform (eql 'uniquify)) (elm function-expression))
151 | (with-added-environment
152 | (in-local-scope
153 | (let* ((new-name (ensure-unique-binding (function-expression-name elm)))
154 | (new-params (mapcar #'ensure-unique-binding (function-expression-parameters elm))))
155 | (make-function-expression :name new-name
156 | :parameters new-params
157 | :body (transform-in-scope (function-expression-body elm))
158 | :start (source-element-start elm)
159 | :end (source-element-end elm))))))
160 |
161 | (defmethod transform ((xform (eql 'uniquify)) (elm var-decl))
162 | (unless (find-binding (var-decl-name elm))
163 | (ensure-unique-binding (var-decl-name elm)))
164 | (make-var-decl :name (find-binding (var-decl-name elm))
165 | :initializer (transform xform (var-decl-initializer elm))
166 | :start (source-element-start elm)
167 | :end (source-element-end elm)))
--------------------------------------------------------------------------------
/tests/test-ugly-print.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-ugly-print.lisp
2 | ;;;
3 | ;;; Tests for the ugly printer
4 | ;;;
5 | ;;; Copyright (c) 2005 Greg Smolyn
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs-tests)
9 |
10 | ;;;; Helper functions
11 | (defun ugly-string (elm)
12 | "Uglyprint LM to a string value instead of a stream"
13 | (with-output-to-string (s)
14 | (ugly-print elm s)))
15 |
16 | (defmacro with-fresh-genvar (&body body)
17 | "Make sure that GENVAR variable names will start from 0 and that
18 | continuation arguments will have a known value"
19 | `(let* ((*genvar-counter* 0))
20 | ,@body))
21 |
22 | ;;;; Test categories
23 | (defnote ugly-print "tests for the ugly printer")
24 | (defnote uniquify "tests for the uniquify transformation")
25 |
26 | ;;;; Ugly-printer tests
27 | (deftest ugly-print/var-decl/1 :notes ugly-print
28 | (with-fresh-genvar
29 | (in-local-scope
30 | (ugly-string (test-parse "var x = 3;"))))
31 | "var JW0=3;")
32 |
33 | (deftest ugly-print/function-decl/1 :notes ugly-print
34 | (with-fresh-genvar
35 | (in-local-scope
36 | (ugly-string (test-parse "function FOO(){}"))))
37 | "function JW0(){}")
38 |
39 | (deftest ugly-print/function-decl/2 :notes ugly-print
40 | (with-fresh-genvar
41 | (in-local-scope
42 | (ugly-string (test-parse "function FOO(x){}"))))
43 | "function JW0(JW1){}")
44 |
45 | (deftest ugly-print/function-decl/3 :notes ugly-print
46 | (with-fresh-genvar
47 | (ugly-string (test-parse "function FOO(x){ var y = x; }")))
48 | "function FOO(JW0){var JW1=JW0;}")
49 |
50 | (deftest ugly-print/function-decl/4 :notes ugly-print
51 | (with-fresh-genvar
52 | (in-local-scope
53 | (ugly-string (test-parse "function FOO(){ FOO(); }"))))
54 | "function JW0(){JW0();}")
55 |
56 | (deftest ugly-print/function-decl/5 :notes ugly-print
57 | (with-fresh-genvar
58 | (in-local-scope
59 | (let ((jw::*pretty-mode* nil))
60 | (jw::uglify-vars (test-parse "
61 | function recursiveCount(i, n)
62 | {
63 | if(i > n)
64 | return i - 1;
65 | else
66 | {
67 | WScript.echo(i + '/' + n);
68 | return recursiveCount(i + 1, n);
69 | }
70 | }")))))
71 | #.(test-parse "
72 | function JW0(JW1, JW2)
73 | {
74 | if(JW1 > JW2)
75 | return JW1 - 1;
76 | else
77 | {
78 | WScript.echo(JW1 + '/' + JW2);
79 | return JW0(JW1 + 1, JW2);
80 | }
81 | }"))
82 |
83 | ;; ensure vardecls in blocks shadow function vars
84 | ;;
85 | ;; function foo(x) <-- this x could be JW0
86 | ;; {
87 | ;; var x = 3; <-- this x should be JW1 not 0
88 | ;; bar(x); <-- this x should be JW1
89 | ;; }
90 | ;;
91 | (deftest ugly-print/function-decl-arg-shadow/1 :notes ugly-print
92 | (with-fresh-genvar
93 | (ugly-string (test-parse "function FOO(x){ var x = 3; }")))
94 | "function FOO(JW0){var JW1=3;}")
95 |
96 |
97 | (deftest ugly-print/function-decl-arg-shadow/2 :notes ugly-print
98 | (with-fresh-genvar
99 | (in-local-scope
100 | (ugly-string (test-parse "function FOO(x){ var x = 3; FOO(x);}"))))
101 | "function JW0(JW1){var JW2=3;JW0(JW2);}")
102 |
103 | (deftest ugly-print/function-in-function/1 :notes ugly-print
104 | (with-fresh-genvar
105 | (ugly-string (test-parse "function FOO(x) {
106 | function BAR(z) {
107 | return z + y;
108 | }
109 | var y = 3;
110 | BAR(3);
111 | }")))
112 | "function FOO(JW0){function JW2(JW3){return JW3+JW1;}var JW1=3;JW2(3);}")
113 |
114 | (deftest ugly-print/function-in-function/2 :notes ugly-print
115 | (with-fresh-genvar
116 | (ugly-string (test-parse "function FOO(x) {
117 | var y = 3;
118 | function BAR(z) {
119 | return z + y;
120 | }
121 | BAR(3);
122 | }")))
123 | "function FOO(JW0){var JW1=3;function JW2(JW3){return JW3+JW1;}JW2(3);}")
124 |
125 | (deftest ugly-print/function-in-function-in-function/1 :notes ugly-print
126 | (with-fresh-genvar
127 | (ugly-string (test-parse "function FOO(x) {
128 | function BAR(z) {
129 | function BAZ(xz) {
130 | return 3 + y;
131 | }
132 | return z + y + BAZ(3);
133 | }
134 | var y = 3;
135 | BAR(3);
136 | }")))
137 | "function FOO(JW0){function JW2(JW3){function JW4(JW5){return 3+JW1;}return JW3+JW1+JW4(3);}var JW1=3;JW2(3);}")
138 |
139 | (deftest ugly-print/blocks/1 :notes ugly-print
140 | (with-fresh-genvar
141 | (in-local-scope
142 | (ugly-string (test-parse "{ var y = 3;
143 | {
144 | var x = 1;
145 | }
146 | x + y;
147 | }"))))
148 | "{var JW0=3;{var JW1=1;}JW1+JW0;}")
149 |
150 | (deftest ugly-print/free-variables/1 :notes ugly-print
151 | (with-fresh-genvar
152 | (in-local-scope
153 | (ugly-string (test-parse "var x = 10;
154 | var y = x + z;"))))
155 | "var JW0=10;var JW1=JW0+z;")
156 |
157 | (deftest ugly-print/free-variables/2 :notes ugly-print
158 | (with-fresh-genvar
159 | (ugly-string (test-parse "var x = foo;
160 | function bar(m)
161 | {
162 | var y=m*2;
163 | if(y > x)
164 | return bar(m--);
165 | else
166 | return m;
167 | }")))
168 | "var x=foo;function bar(JW0){var JW1=JW0*2;if(JW1>x)return bar(JW0--);else return JW0;}")
169 |
170 | (deftest ugly-print/pretty-variable/1 :notes ugly-print
171 | (with-fresh-genvar
172 | (let ((jw::*pretty-mode* t))
173 | (jw::uglify-vars (test-parse "
174 | function fn(arg1, arg2)
175 | {
176 | function bar() { return 7; }
177 | var foo = 10;
178 | WScript.echo(foo + arg2);
179 | }"))))
180 | #.(test-parse "
181 | function fn(arg1$0, arg2$1)
182 | {
183 | function bar$3() { return 7; }
184 | var foo$2 = 10;
185 | WScript.echo(foo$2 + arg2$1);
186 | }"))
187 |
188 | (deftest ugly-print/for-loop-does-not-create-new-scope/1 :notes ugly-print
189 | (with-fresh-genvar
190 | (ugly-string (test-parse "
191 | var top = 10;
192 | for(var top = 0; top < 100; top++)
193 | {
194 | echo(top);
195 | }")))
196 | "var top=10;for(var top=0;top<100;top++)echo(top);")
197 |
198 | (deftest ugly-print/for-loop-does-not-create-new-scope/2 :notes ugly-print
199 | (with-fresh-genvar
200 | (ugly-string (test-parse "
201 | var top = 10;
202 | for(var top in topVars)
203 | {
204 | echo(top);
205 | }")))
206 | "var top=10;for(var top in topVars)echo(top);")
207 |
208 | (deftest ugly-print/case-sensitivity/1 :notes ugly-print
209 | (with-fresh-genvar
210 | (ugly-string (test-parse "
211 | function Counter() {}
212 | function foo()
213 | {
214 | var counter = new Counter;
215 | }")))
216 | "function Counter(){}function foo(){var JW0=new Counter;}")
217 |
218 | (deftest ugly-print/case-sensitivity/2 :notes ugly-print
219 | (with-fresh-genvar
220 | (ugly-string (test-parse "
221 | function Counter() {}
222 | var counter = new Counter;")))
223 | "function Counter(){}var counter=new Counter;") ; Toplevel identifiers (including the `counter` var) should not be changed
224 |
225 | ;;;; Uniquify tests
226 |
227 | (deftest uniquify/position-preservation/1 :notes uniquify
228 | (with-fresh-genvar
229 | (transform 'uniquify (parse "function foo(x) { var x = 10; x = 5;}")))
230 | (#s(function-decl :name "foo" :parameters ("x$0")
231 | :body (#s(var-decl-statement :var-decls (#s(var-decl :name "x$1"
232 | :initializer #s(numeric-literal :value 10 :start 26 :end 28)
233 | :start 22 :end 28))
234 | :start 18 :end 29)
235 | #s(binary-operator :op-symbol :assign
236 | :left-arg #s(identifier :name "x$1"
237 | :start 30 :end 31)
238 | :right-arg #s(numeric-literal :value 5 :start 34 :end 35)
239 | :start 30 :end 35))
240 | :start 0 :end 35)))
--------------------------------------------------------------------------------
/reference/tramp-perf.js:
--------------------------------------------------------------------------------
1 | //// tramp-perf.js
2 | ///
3 | /// This file contains the factorial function manually transformed into various
4 | /// call-styles. I used it to gauge the depth of various Javascript implementations'
5 | /// call stacks empirically, and to do some timings on various different trampoline
6 | /// implementations.
7 |
8 | ////--------------------------------------------------------------------------------
9 | //// Utility functions
10 |
11 | // function say(str)
12 | // {
13 | // WScript.echo(str);
14 | // }
15 |
16 | function now()
17 | {
18 | return (new Date).getTime();
19 | }
20 |
21 | function id(x)
22 | {
23 | return x;
24 | }
25 |
26 | function trampolineId(x)
27 | {
28 | var ret = new Object;
29 | ret.done = true;
30 | ret.result = x;
31 | return ret;
32 | }
33 |
34 | function trampoline(origThunk)
35 | {
36 | var ret = new Object;
37 | ret.done = false;
38 | ret.thunk = origThunk;
39 | while(!ret.done)
40 | {
41 | ret = ret.thunk();
42 | }
43 | return ret.result;
44 | }
45 |
46 | function count(n, max)
47 | {
48 | var ret = new Object;
49 | if(n == max)
50 | {
51 | ret.done = true;
52 | ret.result = n;
53 | }
54 | else
55 | {
56 | say(n);
57 | ret.done = false;
58 | ret.thunk = function() { return count(n+1, max); };
59 | }
60 |
61 | return ret;
62 | }
63 |
64 | ////--------------------------------------------------------------------------------
65 | //// Factorial implementations
66 |
67 | /// The naive factorial function
68 | function factorial(n)
69 | {
70 | if(n==0)
71 | return 1;
72 | else
73 | return n * factorial(n-1);
74 | }
75 |
76 | /// Accumulator-passing version of factorial
77 | function accFactorial(n, acc)
78 | {
79 | if(n == 0)
80 | return acc;
81 | else
82 | return accFactorial(n-1, n*acc);
83 | }
84 |
85 | /// The naive factorial transformed into CPS form
86 | function cpsFactorial(n, k)
87 | {
88 | if(n==0)
89 | return k(1);
90 | else
91 | {
92 | return cpsFactorial(n-1, function(intermediate) {
93 | return k(n * intermediate);
94 | });
95 | }
96 | }
97 |
98 | /// The accumulator-passing version of factorial transformed into CPS form
99 | function cpsAccFactorial(n, acc, k)
100 | {
101 | if(n==0)
102 | return k(acc);
103 | else
104 | return cpsAccFactorial(n-1, n*acc, k);
105 | }
106 |
107 |
108 | /// The CPS form modified to use "first-order" trampolined function calls
109 | /// (ie, original function calls modified to be trampolined calls, continuation
110 | /// calls not modified)
111 | function trampolineFactorial1(n, k)
112 | {
113 | var ret = new Object;
114 | if(n == 0)
115 | {
116 | ret.done = true;
117 | ret.result = k(1);
118 | }
119 | else
120 | {
121 | var k2 = function(intermediate) {
122 | return k(n * intermediate);
123 | };
124 |
125 | ret.done = false;
126 | ret.thunk = function() {
127 | return trampolineFactorial1(n-1, k2);
128 | }
129 | }
130 |
131 | return ret;
132 | }
133 |
134 | /// CPS form modified to use "second-order" trampolined function calls
135 | /// (ie, original function calls and continuation calls both modified
136 | /// to be trampolined calls)
137 | function trampolineFactorial2(n, k)
138 | {
139 | var ret = new Object;
140 | if(n == 0)
141 | {
142 | ret.done = false;
143 | ret.thunk = function() {
144 | return k(1);
145 | }
146 | }
147 | else
148 | {
149 | var k2 = function(intermediate) {
150 | var ret = new Object;
151 | ret.done = false;
152 | ret.thunk = function() {
153 | return k(n * intermediate);
154 | };
155 |
156 | return ret;
157 | };
158 |
159 | ret.done = false;
160 | ret.thunk = function() {
161 | return trampolineFactorial2(n-1, k2);
162 | }
163 | }
164 |
165 | return ret;
166 | }
167 |
168 | /// A version of trampolineFactorial2 that reuses a single result
169 | /// object instead of consing a new one each time.
170 | var globalRet = new Object;
171 | function trampolineFactorial3(n, k)
172 | {
173 | if(n == 0)
174 | {
175 | globalRet.done = false;
176 | globalRet.thunk = function() {
177 | return k(1);
178 | }
179 | }
180 | else
181 | {
182 | var k2 = function(intermediate) {
183 | globalRet.done = false;
184 | globalRet.thunk = function() {
185 | return k(n * intermediate);
186 | };
187 |
188 | return globalRet;
189 | };
190 |
191 | globalRet.done = false;
192 | globalRet.thunk = function() {
193 | return trampolineFactorial3(n-1, k2);
194 | }
195 | }
196 |
197 | return globalRet;
198 | }
199 |
200 | /// The accumulator-passing version of factorial transformed into
201 | /// second-order trampolined style.
202 | function trampolineAccFactorial2(n, acc, k)
203 | {
204 | var ret = new Object;
205 | if(n==0)
206 | {
207 | ret.done = false;
208 | ret.thunk = function() {
209 | return k(acc);
210 | };
211 | }
212 | else
213 | {
214 | ret.done = false;
215 | ret.thunk = function() {
216 | return trampolineAccFactorial2(n-1, n*acc, k);
217 | };
218 | }
219 | return ret;
220 | }
221 |
222 |
223 |
224 |
225 | ////--------------------------------------------------------------------------------
226 | //// Demonstration calls
227 |
228 | function runDemos()
229 | {
230 |
231 | // Under WScript, naive factorial blows the stack at i = 469
232 | // Under Firefox, naive factorial blows the stack at i = 1000
233 | for(var i = 0; i < 469; i++)
234 | {
235 | var nbang = factorial(i);
236 | if(i % 100 == 0)
237 | say("factorial("+ i +") = "+nbang);
238 | }
239 |
240 | // Under WScript, accFactorial blows the stack at i = 469
241 | // Under Firefox, accFactorial blows the stack at i = 1000
242 | // (ie, tail-recursion does not buy any additional stack efficiency)
243 | for(var i = 0; i < 469; i++)
244 | {
245 | var nbang = accFactorial(i, 1);
246 | if(i % 100 == 0)
247 | say("accFactorial(" + i + ") = " + nbang);
248 | }
249 |
250 | // Under WScript, cpsFactorial blows the stack at i = 234
251 | // Under Firefox, cpsFactorial blows the stack at i = 996
252 | // (ie, CPS transformation costs an extra stack frame per recursion under
253 | // WScript but not (mysteriously) under Firefox)
254 | for(var i = 0; i < 234; i++)
255 | {
256 | var nbang = cpsFactorial(i, id);
257 | if(i % 100 == 0)
258 | say("cpsFactorial(" + i + ") = "+nbang);
259 | }
260 |
261 | trampoline(function() { return trampolineAccFactorial2(5, 1, trampolineId); });
262 |
263 | // Under WScript, trampolineFactorial1 blows the stack at i = 466
264 | // Under Firefox, trampolineFactorial1 blows the stack at i = 1000
265 | // (ie, the maximum depth of continuation calls is still stack-limited)
266 | for(var i = 0; i < 466; i++)
267 | {
268 | var nbang = trampoline(function() { return trampolineFactorial1(i, id); });
269 | if(i % 100 == 0)
270 | say("trampolineFactorial1(" + i + ") = " + nbang);
271 | }
272 |
273 | // Under WScript, trampolineFactorial2 is limited only by your patience and
274 | // the size of the heap.
275 | // Under Firefox, trampolineFactorial2 causes Firefox to crash at i = 25000
276 | for(var i = 0; i < 2001; i+= 200)
277 | {
278 | var nbang = trampoline(function() { return trampolineFactorial2(i, trampolineId); });
279 | if(i % 100 == 0)
280 | say("trampolineFactorial2(" + i + ") = " + nbang);
281 | }
282 |
283 | var s, e, nbang;
284 | var sz = 18000;
285 | // Under WScript:
286 | // trampoline2(20000) = Infinity in 12922 msec
287 | // trampoline3(20000) = Infinity in 4953 msec
288 | // trampolineAccFactorial2(500000) = Infinity in 6813 msec
289 | // trampolineAccFactorial2(5000000) = Infinity in 66985 msec
290 | // Under Firefox:
291 | // trampoline2(20000) = Infinity in 1063 msec
292 | // trampoline3(18000) = Infinity in 985 msec (crashes at 19000 and above)
293 | // trampolineAccFactorial2(500000) = Infinity in 14203 msec
294 | // 1. reusing the result object cuts the time required by more than half under
295 | // WScript, but it makes no difference under Firefox (except to make it a little
296 | // less stable)
297 | // 2. The stability issue in Firefox seems to be caused by the increasing heap usage
298 | // of the non-accumulator version (used to save the chain of continuations that
299 | // replaces the usual call stack). We can gather that from the fact that the
300 | // trampolined accumulator-passing factorial (which reuses the same continuation
301 | // on each recursion) appears to be effectively unbounded in terms of its argument
302 | // size (although at 500,000 it does cause "slow script" prompts to appear a couple of times).
303 | var s = now();
304 | var nbang = trampoline(function() { return trampolineFactorial2(sz, trampolineId); });
305 | var e = now();
306 | say("trampoline2("+sz+") = " + nbang + " in " + (e-s) + " msec");
307 |
308 | s = now();
309 | nbang = trampoline(function() { return trampolineFactorial3(sz, trampolineId); });
310 | e = now();
311 | say("trampoline3("+sz+") = " + nbang + " in " + (e-s) + " msec");
312 |
313 | s = now();
314 | nbang = trampoline(function() { return trampolineAccFactorial2(500000, 1, trampolineId); });
315 | e = now();
316 | say("trampolineAccFactorial2(500000) = " + nbang + " in " + (e-s));
317 | }
318 |
--------------------------------------------------------------------------------
/source-transformations.lisp:
--------------------------------------------------------------------------------
1 | ;;;; source-transformations.lisp
2 | ;;;
3 | ;;; Define the base functionality for source transformations.
4 | ;;; The TRANSFORM generic function is defined, as well as some
5 | ;;; transformation-related utility functions. The main source
6 | ;;; transformations will implement methods on TRANSFORM in their
7 | ;;; own source files.
8 | ;;;
9 | ;;; Copyright (c) 2005 James Wright
10 | ;;; See LICENSE for full licensing details.
11 | ;;;
12 | (in-package :jwacs)
13 |
14 | ;;;; Utilities
15 | (defun structure-slots (object)
16 | "Returns a list of the slot-names of the provided structure object"
17 | #+openmcl
18 | (let* ((sd (gethash (class-name (class-of object)) ccl::%defstructs%))
19 | (slots (if sd (ccl::sd-slots sd))))
20 | (mapcar #'car (if (symbolp (caar slots)) slots (cdr slots))))
21 | #+cmu
22 | (mapcar #'pcl:slot-definition-name (pcl:class-slots (class-of object)))
23 | #+lispworks
24 | (structure:structure-class-slot-names (class-of object))
25 | #+sbcl
26 | (mapcar #'sb-mop:slot-definition-name (sb-mop:class-slots (class-of object)))
27 | #+allegro
28 | (mapcar #'mop:slot-definition-name (mop:class-slots (class-of object))))
29 |
30 | (defparameter *constructor-cache* (make-hash-table :test 'eq)
31 | "Map from structure-type symbol to copy-function symbol")
32 |
33 | (defun get-constructor (struct-object)
34 | "Accept a structure object and return the (likely) name of its constructor.
35 | CAVEAT: Assumes that the structure was defined in the same package as its name."
36 | (let* ((name (type-of struct-object))
37 | (make-fn (gethash name *constructor-cache*)))
38 | (if (null make-fn)
39 | (setf (gethash name *constructor-cache*) (intern (format nil "MAKE-~A" name)
40 | (symbol-package name)))
41 | make-fn)))
42 |
43 | (defmacro forbid-transformation-elements (xform elm-type-list)
44 | "Generate DEFMETHOD forms that throw an error if the transformation
45 | specified in XFORM is applied to any of the element types in
46 | ELM-TYPE-LIST"
47 | `(progn
48 | ,@(loop for elm-type in elm-type-list
49 | collect `(defmethod transform ((xform (eql ',xform)) (elm ,elm-type))
50 | (error "~A source-element encountered during ~A transformation!" ',elm-type ',xform)))))
51 |
52 |
53 | ;;;; Scope tracking
54 |
55 | ;;; Some transformations need to keep track of toplevel vs. local scopes.
56 | ;;; They should use this macro and variable.
57 |
58 | (defparameter *in-local-scope* nil
59 | "T when the lexical scope is currently inside a function decl, NIL when the
60 | lexical scope is currently the global scope")
61 |
62 | (defmacro in-local-scope (&body body)
63 | "Execute BODY with *IN-LOCAL-SCOPE* bound to T"
64 | `(let ((*in-local-scope* t))
65 | ,@body))
66 |
67 | ;;;; Collection within a single scope
68 | (defgeneric collect-in-scope (elm target-type)
69 | (:documentation
70 | "Finds and returns a list of all elements of TARGET-TYPE in the same scope as
71 | ELM. Does not recurse into function-decl or function-expression elements.
72 | So for example, searching for function-decls in this code:
73 |
74 | var x = 10;
75 | function foo(x) { function bar(y) { return 10; } return bar(x); }
76 |
77 | FOO would be returned but BAR would not, since the decl of BAR is in
78 | an innermore scope (namely, FOO's body)."))
79 |
80 | ;;;; Rules about recursing into children
81 | (defmethod collect-in-scope (elm target-type)
82 | nil)
83 |
84 | (defmethod collect-in-scope ((elm-list list) target-type)
85 | (loop for elm in elm-list
86 | append (collect-in-scope elm target-type)))
87 |
88 | (defmethod collect-in-scope ((elm source-element) target-type)
89 | (loop for slot in (structure-slots elm)
90 | append (collect-in-scope (slot-value elm slot) target-type)))
91 |
92 | ;; Don't recurse, because the body is a new, innermore scope.
93 | (defmethod collect-in-scope ((elm function-decl) target-type)
94 | nil)
95 |
96 | ;; Don't recurse, because the body is a new, innermore scope.
97 | (defmethod collect-in-scope ((elm function-expression) target-type)
98 | nil)
99 |
100 | ;; Don't recurse, because the body is a new, innermore scope.
101 | (defmethod collect-in-scope ((elm object-literal) target-type)
102 | nil)
103 |
104 | ;;;; Rule for returning matches.
105 | ;; We don't recurse into matching elements
106 | (defmethod collect-in-scope :around (elm target-type)
107 | (if (typep elm target-type)
108 | (list elm)
109 | (call-next-method)))
110 |
111 | ;;;; Default transformation behaviour
112 |
113 | ;;; The top-level TRANSFORM methods provide the default code-walking behaviour,
114 | ;;; so that individual transformations can override just the important parts.
115 | ;;;
116 | ;;; The transformation of any "obligate statement" may return a list instead of
117 | ;;; a single source-element, and the default behaviour will handle it correctly.
118 | ;;; An obligate statement is a source element that must be a statement (ie, which
119 | ;;; can never be an expression). For example, a function call is _not_ an
120 | ;;; obligate statement, since it can appear as a sub-expression, but a break
121 | ;;; statement is.
122 |
123 | (defgeneric transform (xform elm)
124 | (:documentation
125 | "Accepts a transformation name (symbol) and a source element, and returns a new
126 | source element that has been transformed in some way. Methods should /not/ perform
127 | destructive updates on the provided source-element."))
128 |
129 | ;; The default behaviour for any transformation is to do nothing
130 | (defmethod transform (xform elm)
131 | elm)
132 |
133 | (defun make-keyword (x)
134 | "Makes a keyword out of a symbol."
135 | (if (keywordp x) x (intern (symbol-name x) 'keyword)))
136 |
137 | ;; The default behaviour for any transformation on a source-element that has children
138 | ;; is to return a new source-element whose children have been transformed.
139 | (defmethod transform (xform (elm source-element))
140 | (apply
141 | (get-constructor elm)
142 | (loop for slot in (structure-slots elm)
143 | collect (make-keyword slot)
144 | collect (transform xform (slot-value elm slot)))))
145 |
146 | ;; Sometimes we're dealing with lists of source elements, and sometimes (rarely) we're
147 | ;; dealing with some other sort of list. We only flatten source element lists.
148 | ;; We decide if it is a source-element list based on the first element only.
149 | (defmethod transform (xform (elm-list list))
150 | (if (source-element-p (car elm-list))
151 | (loop for elm in elm-list
152 | for tx-elm = (transform xform elm)
153 | if (listp tx-elm)
154 | append tx-elm
155 | else
156 | collect tx-elm)
157 | (loop for elm in elm-list
158 | for tx-elm = (transform xform elm)
159 | collect tx-elm)))
160 |
161 | ;; Override the default slot-traversing behaviour for elements that have single-statement
162 | ;; children, since we might need to single-statement them.
163 | (defmethod transform (xform (elm if-statement))
164 | (with-slots (condition then-statement else-statement) elm
165 | (make-if-statement :condition (transform xform condition)
166 | :then-statement (single-statement (transform xform then-statement))
167 | :else-statement (single-statement (transform xform else-statement)))))
168 |
169 | (defmethod transform (xform (elm while))
170 | (with-slots (label body condition) elm
171 | (make-while :label label
172 | :condition (transform xform condition)
173 | :body (single-statement (transform xform body)))))
174 |
175 | (defmethod transform (xform (elm do-statement))
176 | (with-slots (label body condition) elm
177 | (make-do-statement :label label
178 | :condition (transform xform condition)
179 | :body (single-statement (transform xform body)))))
180 |
181 | (defmethod transform (xform (elm for))
182 | (with-slots (label body initializer condition step) elm
183 | (make-for :label label
184 | :initializer (transform xform initializer)
185 | :condition (transform xform condition)
186 | :step (transform xform step)
187 | :body (single-statement (transform xform body)))))
188 |
189 | (defmethod transform (xform (elm for-in))
190 | (with-slots (label body binding collection) elm
191 | (make-for-in :label label
192 | :binding (transform xform binding)
193 | :collection (transform xform collection)
194 | :body (single-statement (transform xform body)))))
195 |
196 | (defmethod transform (xform (elm with))
197 | (with-slots (label scope-object body) elm
198 | (make-with :label label
199 | :scope-object (transform xform scope-object)
200 | :body (single-statement (transform xform body)))))
201 |
202 | (defmethod transform (xform (elm try))
203 | (with-slots (label body catch-clause finally-clause) elm
204 | (make-try :label label
205 | :body (transform xform body)
206 | :catch-clause (transform xform catch-clause)
207 | :finally-clause (transform xform finally-clause))))
208 |
209 | ;; Special case for object-literals to account for the fact that object-literal-properties
210 | ;; is an alist rather than a list of structures.
211 | (defmethod transform (xform (elm object-literal))
212 | (make-object-literal
213 | :properties
214 | (loop for (prop-name . prop-value) in (object-literal-properties elm)
215 | collect (cons
216 | (transform xform prop-name)
217 | (transform xform prop-value)))
218 | :start (source-element-start elm)
219 | :end (source-element-end elm)))
220 |
--------------------------------------------------------------------------------
/lib/jwacs-lib.jw:
--------------------------------------------------------------------------------
1 | //// jwacs-lib.jw
2 | ///
3 | /// Defines some "framework"-style functionality for use by jwacs applications
4 |
5 | // Namespace
6 | var JwacsLib =
7 | {
8 | //// Handy utilities
9 |
10 | // Sleep for `msec` milliseconds, and then continue executing on the GUI thread
11 | sleep: function(msec)
12 | {
13 | var k = function_continuation;
14 | setTimeout(function() { resume k; }, msec);
15 | suspend;
16 | },
17 |
18 | // Yield the thread to the browser process. Execution will resume on the GUI thread.
19 | yieldThread: function()
20 | {
21 | JwacsLib.sleep(0);
22 | },
23 |
24 | //// History management (based loosely on Brad Neuberg's Really Simple History;
25 | //// see http://codinginparadise.org/projects/dhtml_history/README.html)
26 |
27 | pageThunks: new Object, // Lookup from hash to thunk
28 | maxHistoryEntries: 50, // Maximum number of historical thunks to keep in pageThunks
29 | // (we only prune in newPage calls, so it is
30 | // actually possible for the user to
31 | // temporarily drive the size of pageThunks
32 | // arbitrarily beyond this threshold)
33 | generatedHashes: new Object, // Lookup from hash to token of newPage-generated hashes
34 | nextToken: 0,
35 | currentHash: new Object, // Won't be equal to any other value on inital load
36 |
37 | initHistory: function(maxHistoryEntries)
38 | {
39 | if(!isNaN(maxHistoryEntries))
40 | JwacsLib.maxHistoryEntries = maxHistoryEntries;
41 |
42 | if(JwacsLib.isInternetExplorer())
43 | {
44 | document.write("");
46 | }
47 |
48 | var startTimerThunk = function()
49 | {
50 | setInterval(JwacsLib.checkLocation, 200);
51 | };
52 |
53 | if (window.addEventListener)
54 | window.addEventListener("load", startTimerThunk, false);
55 | else if (window.attachEvent)
56 | window.attachEvent("onload", startTimerThunk, false);
57 | },
58 |
59 | newPage: function(title, hint)
60 | {
61 | function propertiesToString(obj)
62 | {
63 | var nextChar = "";
64 | var result = "";
65 | for(field in obj)
66 | {
67 | if(typeof obj[field] == "function")
68 | continue; // skip all the methods added to the Object prototype by prototype
69 | result += nextChar + escape(field) + "=" + escape(obj[field]);
70 | nextChar = "&";
71 | }
72 |
73 | return result;
74 | }
75 |
76 | // Prune the pageThunk list before proceeding
77 | JwacsLib.prunePageThunks();
78 |
79 | var token = JwacsLib.nextToken++;
80 | var k = function_continuation;
81 | var hash = propertiesToString(hint) + '|' + token;
82 | JwacsLib.generatedHashes[hash] = token;
83 | JwacsLib.pageThunks[hash] = function() { document.title = title; resume k; };
84 |
85 | // Setting the hash of the window does not add a history entry in Internet Explorer,
86 | // so we call through a helper IFrame, which adds the history entry and then calls
87 | // back to this frame to change the location bar.
88 | if(JwacsLib.isInternetExplorer())
89 | {
90 | var iframe = document.getElementById('HistoryIFrame');
91 | iframe.src = "blank.html?" + escape(hash); // !!! Note that we are double-escaping here
92 | }
93 | else
94 | window.location.hash = '#' + hash;
95 |
96 | suspend;
97 | },
98 |
99 | stripChar: function(str, ch)
100 | {
101 | if(str && str.charAt(0) == ch)
102 | return str.substr(1);
103 | return str;
104 | },
105 |
106 | stripHash: function(str)
107 | {
108 | return JwacsLib.stripChar(str, '#');
109 | },
110 |
111 | stripToken: function(str)
112 | {
113 | if(!str || typeof str != "string")
114 | return str;
115 | return str.replace(/\|\d+$/, "");
116 | },
117 |
118 | getToken: function(str)
119 | {
120 | if(!str || typeof str != "string")
121 | return 0;
122 |
123 | var aMatch = str.match(/\|(\d+)$/);
124 | if(aMatch)
125 | return new Number(aMatch[1]);
126 | else
127 | return 0;
128 | },
129 |
130 | parsePageArgs: function()
131 | {
132 | var hash = JwacsLib.stripChar(window.location.hash, '#');
133 | if(hash)
134 | {
135 | hash = JwacsLib.stripToken(hash);
136 | hash = hash.split('&');
137 | }
138 | else
139 | hash = [];
140 |
141 | var query = JwacsLib.stripChar(window.location.search, '?');
142 | if(query)
143 | {
144 | query = JwacsLib.stripToken(query); // ??? Necessary?
145 | query = query.split('&');
146 | }
147 | else
148 | query = [];
149 |
150 | var result = {};
151 | var i;
152 | for(i = 0; i < query.length; i++)
153 | {
154 | var factor = query[i].split('=');
155 | result[unescape(factor[0])] = unescape(factor[1]);
156 | }
157 |
158 | for(i = 0; i < hash.length; i++)
159 | {
160 | var factor = hash[i].split('=');
161 | result[unescape(factor[0])] = unescape(factor[1]);
162 | }
163 |
164 | return result;
165 | },
166 |
167 | checkLocation: function()
168 | {
169 | var hash = JwacsLib.stripHash(document.location.hash);
170 | if(hash == JwacsLib.currentHash)
171 | return;
172 |
173 | var token = JwacsLib.getToken(JwacsLib.currentHash);
174 | if(token > JwacsLib.nextToken)
175 | JwacsLib.nextToken = token + 1;
176 |
177 | JwacsLib.currentHash = hash;
178 |
179 | if(!JwacsLib.pageThunks[hash])
180 | JwacsLib.pageThunks[hash] = function() { main(JwacsLib.parsePageArgs(hash)); };
181 |
182 | JwacsLib.pageThunks[hash]();
183 | },
184 |
185 | isInternetExplorer: function()
186 | {
187 | var userAgent = navigator.userAgent.toLowerCase();
188 | return (document.all && userAgent.indexOf('msie') != -1);
189 | },
190 |
191 | prunePageThunks: function()
192 | {
193 | // If we are generating a new page from somewhere in the back-button
194 | // history, then everything in the forward-button history is no longer
195 | // accessible. Before we add to pageThunks, we want to flush all such
196 | // thunks. For now, due to issues with distinguishing between back/forward
197 | // and user-entering of user-entered (ie, non-newPage-generated) URIs, we'll
198 | // only flush newPage-generated thunks.
199 | var currentToken = JwacsLib.getToken(JwacsLib.currentHash);
200 | var dummyObj = new Object; // For skipping prototype.js-added properties
201 | var remainingHashes = new Array;
202 | for(var h in JwacsLib.pageThunks)
203 | {
204 | if(dummyObj[h])
205 | continue;
206 |
207 | if(!isNaN(currentToken) &&
208 | JwacsLib.generatedHashes[h] &&
209 | JwacsLib.generatedHashes[h] > currentToken)
210 | {
211 | delete JwacsLib.generatedHashes[h];
212 | delete JwacsLib.pageThunks[h];
213 | }
214 | else
215 | remainingHashes[remainingHashes.length] = h;
216 | }
217 |
218 | // Even if we never use the back button, we want to keep the pageThunks map
219 | // from growing without bound, so when it gets to a certain threshold prune
220 | // out the oldest entry until we are under the threshold again.
221 | if(remainingHashes.length > JwacsLib.maxHistoryEntries)
222 | {
223 | remainingHashes.sort(function(l, r)
224 | {
225 | var lToken = JwacsLib.getToken(l);
226 | var rToken = JwacsLib.getToken(r);
227 | if(isNaN(lToken))
228 | lToken = -1;
229 | if(isNaN(rToken))
230 | rToken = -1;
231 |
232 | if(lToken < rToken)
233 | return -1;
234 | else if(rToken < lToken)
235 | return 1;
236 | else
237 | return 0;
238 | });
239 | var numberToPrune = remainingHashes.length - JwacsLib.maxHistoryEntries;
240 | for(var i = 0; i < numberToPrune; i++)
241 | {
242 | delete JwacsLib.pageThunks[remainingHashes[i]];
243 | delete JwacsLib.generatedHashes[remainingHashes[i]];
244 | }
245 | }
246 | },
247 |
248 | iframeLoaded: function(search)
249 | {
250 | var hash = JwacsLib.stripChar(search, '?');
251 |
252 | // We double-escape the iframe hash because it contains a bar,
253 | // so unescape the extra layer here to get the bar back, and the field values
254 | // will be further unescaped by checkLocation.
255 | window.location.hash = unescape(hash);
256 | },
257 |
258 | //// Faux-synchronous server-data fetching.
259 | getHttpObj: function()
260 | {
261 | var http = null;
262 | try
263 | {
264 | http = new XMLHttpRequest;
265 | if(http) return http;
266 | }
267 | catch(e)
268 | { }
269 |
270 | try
271 | {
272 | http = new ActiveXObject("Msxml2.XMLHTTP");
273 | if(http) return http;
274 | }
275 | catch(e)
276 | { }
277 |
278 | try
279 | {
280 | http = new ActiveXObject('Microsoft.XMLHTTP');
281 | if(http) return http;
282 | }
283 | catch(e)
284 | { }
285 |
286 | throw "Cannot create a suitable http request object";
287 | },
288 |
289 | emptyFunction: function() { },
290 |
291 | sendRequest: function(method, url, body)
292 | {
293 | var http = JwacsLib.getHttpObj();
294 | var k = function_continuation;
295 |
296 | http.onreadystatechange = function()
297 | {
298 | try
299 | {
300 | // Report results to the continuation on completion
301 | if(http.readyState == 4)
302 | {
303 | // Resume the continuation with the raw results
304 | http.onreadystatechange = JwacsLib.emptyFunction;
305 | resume k <- http;
306 | }
307 | }
308 | catch(e)
309 | {
310 | // Errors are thrown as exceptions into the continuation
311 | http.onreadystatechange = JwacsLib.emptyFunction;
312 | throw e -> k;
313 | }
314 | };
315 |
316 | http.open(method, url);
317 | http.send(body);
318 | suspend;
319 | },
320 |
321 | fetchData: function(method, url)
322 | {
323 | var http = JwacsLib.sendRequest(method, url, null);
324 |
325 | // Check for errors
326 | if(!(http.status == undefined ||
327 | http.status == 0 ||
328 | (http.status >= 200 && http.status < 300)))
329 | {
330 | var err = new Error("Server returned " + http.status);
331 | err.http = http;
332 | throw err;
333 | }
334 |
335 | return http.responseText;
336 | }
337 | };
338 |
339 |
--------------------------------------------------------------------------------
/tests/test-runtime-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; test-runtime-transformation.lisp
2 | ;;;
3 | ;;; Unit tests for the runtime transformation
4 | ;;;
5 | ;;; Copyright (c) 2006 James Wright
6 | ;;; See LICENSE for full licensing details.
7 | ;;;
8 | (in-package :jwacs-tests)
9 |
10 | (defnote runtime "tests for the runtime transformation")
11 |
12 | (deftest runtime/continuation/1 :notes runtime
13 | (with-fresh-genvar
14 | (let ((jw::*function-decls-in-scope* '("bar" "baz")))
15 | (test-transform 'runtime
16 | (transform 'cps (parse "
17 | function foo()
18 | {
19 | bar();
20 | return baz();
21 | }")))))
22 | #.(test-parse "
23 | function foo($k)
24 | {
25 | if(!$k || !$k.$isK)
26 | return $callFromDirect(foo, this, arguments);
27 | return bar($makeK(function () { return baz($k); }, $k.$exHandlers));
28 | }
29 | foo.$jw = true;"))
30 |
31 | (deftest runtime/function-expression/1 :notes runtime
32 | (with-fresh-genvar
33 | (transform 'runtime (test-parse "
34 | var x = function($k) { return $k(21); };")))
35 | #.(test-parse "
36 | var x = $lambda(function lambda$0($k) {
37 | if(!$k || !$k.$isK)
38 | return $callFromDirect(lambda$0, this, arguments);
39 | return $k(21); });"))
40 |
41 | (deftest runtime/trampoline-return/1 :notes runtime
42 | (with-fresh-genvar
43 | (transform 'runtime
44 | (transform 'trampoline (test-parse "
45 | function fact($k, x)
46 | {
47 | if(x == 0)
48 | return $k(1);
49 | else
50 | return fact($k, x - 1);
51 | }"))))
52 | #.(test-parse "
53 | function fact($k, x)
54 | {
55 | if(!$k || !$k.$isK)
56 | return $callFromDirect(fact, this, arguments);
57 | if(x == 0)
58 | return {done:false, thunk: function($e) { return $k(1); }};
59 | else
60 | return {done:false, thunk: function($e) { return fact($k, x - 1); }};
61 | }
62 | fact.$jw = true;"))
63 |
64 | (deftest runtime/indirected-call/1 :notes runtime
65 | (with-fresh-genvar
66 | (test-transform 'runtime
67 | (transform 'cps (parse "
68 | function bar(x) { return x; }
69 | function foo()
70 | {
71 | bar(50);
72 | return baz(100);
73 | }"))))
74 | #.(test-parse "
75 | function bar($k, x)
76 | {
77 | if(!$k || !$k.$isK)
78 | return $callFromDirect(bar, this, arguments);
79 | return $k(x);
80 | }
81 | bar.$jw = true;
82 |
83 | function foo($k)
84 | {
85 | if(!$k || !$k.$isK)
86 | return $callFromDirect(foo, this, arguments);
87 | return bar($makeK(function() {
88 | return $call0(baz, $k, null, 100);
89 | }, $k.$exHandlers), 50);
90 | }
91 | foo.$jw = true;"))
92 |
93 | (deftest runtime/indirected-call/2 :notes runtime
94 | (with-fresh-genvar
95 | (test-transform 'runtime
96 | (transform 'cps (parse "
97 | function bar(x) { return x; }
98 | function foo()
99 | {
100 | bar(50);
101 | return Foo.Bar.Baz.quux(100, 101, 102, 103, 104, 105, 106, 107, 108, 109);
102 | }"))))
103 | #.(test-parse "
104 | function bar($k, x)
105 | {
106 | if(!$k || !$k.$isK)
107 | return $callFromDirect(bar, this, arguments);
108 | return $k(x);
109 | }
110 | bar.$jw = true;
111 |
112 | function foo($k)
113 | {
114 | if(!$k || !$k.$isK)
115 | return $callFromDirect(foo, this, arguments);
116 | return bar($makeK(function() {
117 | return $call(Foo.Bar.Baz.quux, $k, Foo.Bar.Baz, [100, 101, 102, 103, 104, 105, 106, 107, 108, 109]);
118 | }, $k.$exHandlers), 50);
119 | }
120 | foo.$jw = true;"))
121 |
122 | (deftest runtime/indirected-call/3 :notes runtime
123 | (with-fresh-genvar
124 | (test-transform 'runtime
125 | (transform 'cps (parse "
126 | function foo()
127 | {
128 | return Foo.Bar.Baz(10, 20);
129 | }"))))
130 | #.(test-parse "
131 | function foo($k)
132 | {
133 | if(!$k || !$k.$isK)
134 | return $callFromDirect(foo, this, arguments);
135 | return $call0('Baz', $k, Foo.Bar, 10, 20);
136 | }
137 | foo.$jw = true;"))
138 |
139 | (deftest runtime/new-expr/1 :notes runtime
140 | (with-fresh-genvar
141 | (in-local-scope
142 | (let ((jw::*current-handler-stack-reference* jw::*in-function-handler-stack-reference*))
143 | (test-transform 'runtime
144 | (transform 'cps (parse "
145 | function bar(z) { return z; }
146 | var x = new Foo(50, 55);
147 | return bar(x);"))))))
148 | #.(test-parse "
149 | function bar($k, z)
150 | {
151 | if(!$k || !$k.$isK)
152 | return $callFromDirect(bar, this, arguments);
153 | return $k(z);
154 | }
155 | bar.$jw = true;
156 |
157 | return $new0(Foo, $makeK(function(x) { return bar($k, x); }, $k.$exHandlers), 50, 55);"))
158 |
159 | (deftest runtime/new-expr/2 :notes runtime
160 | (with-fresh-genvar
161 | (in-local-scope
162 | (let ((jw::*current-handler-stack-reference* jw::*in-function-handler-stack-reference*))
163 | (test-transform 'runtime
164 | (transform 'cps (parse "
165 | function bar(z) { return z; }
166 | var x = new Foo(1,2,3,4,5,6,7,8,9,10,11,12);
167 | return bar(x);"))))))
168 | #.(test-parse "
169 | function bar($k, z)
170 | {
171 | if(!$k || !$k.$isK)
172 | return $callFromDirect(bar, this, arguments);
173 | return $k(z);
174 | }
175 | bar.$jw = true;
176 |
177 | return $new(Foo, $makeK(function(x) { return bar($k, x); }, $k.$exHandlers), [1,2,3,4,5,6,7,8,9,10,11,12]);"))
178 |
179 | (deftest runtime/arguments/1 :notes runtime
180 | (with-fresh-genvar
181 | (test-transform 'runtime
182 | (transform 'shadow-values
183 | (transform 'cps (parse "
184 | function foo()
185 | {
186 | return arguments;
187 | }")))))
188 | #.(test-parse "
189 | function foo($k)
190 | {
191 | if(!$k || !$k.$isK)
192 | return $callFromDirect(foo, this, arguments);
193 | var arguments$0 = $makeArguments(arguments);
194 | return $k(arguments$0);
195 | }
196 | foo.$jw = true;"))
197 |
198 | (deftest runtime/arguments/2 :notes runtime
199 | (test-transform 'runtime
200 | (transform 'shadow-values
201 | (transform 'cps (parse "
202 | function foo()
203 | {
204 | var arguments = 99;
205 | return arguments;
206 | }"))))
207 | #.(test-parse "
208 | function foo($k)
209 | {
210 | if(!$k || !$k.$isK)
211 | return $callFromDirect(foo, this, arguments);
212 | var arguments = 99;
213 | return $k(arguments);
214 | }
215 | foo.$jw = true;"))
216 |
217 | (deftest runtime/arguments/3 :notes runtime
218 | (test-transform 'runtime
219 | (transform 'shadow-values
220 | (transform 'cps (parse "
221 | var x = arguments;"))))
222 | #.(test-parse "var x = arguments;"))
223 |
224 | (deftest runtime/toplevel/resume/1 :notes runtime
225 | (test-transform 'runtime (transform 'trampoline (transform 'cps (parse "
226 | resume foo;"))))
227 | #.(test-parse "
228 | $trampoline(function($e) {
229 | return {replaceHandlers: foo.$exHandlers, done: false, thunk: function($e) {
230 | return foo();
231 | }};
232 | });"))
233 |
234 | (deftest runtime/toplevel/indirect-call/1 :notes runtime
235 | (test-transform 'runtime
236 | (transform 'trampoline
237 | (transform 'cps (parse "
238 | foo(10);
239 | bar(20);"))))
240 | #.(test-parse "
241 | $trampoline(function($e) {
242 | return {done: false, thunk: function($e) {
243 | return $call0(foo, $makeK(function() {
244 | return {done: false, thunk: function($e) {
245 | return $call0(bar, $makeK(function() {
246 | return {done: true};
247 | }, $e), null, 20);
248 | }};
249 | }, $e), null, 10);
250 | }};
251 | });"))
252 |
253 | (deftest runtime/toplevel/indirect-new/1 :notes runtime
254 | (test-transform 'runtime
255 | (transform 'trampoline
256 | (transform 'cps (parse "
257 | new foo(10);
258 | new bar(20);"))))
259 | #.(test-parse "
260 | $trampoline(function($e) {
261 | return {done: false, thunk: function($e) {
262 | return $new0(foo, $makeK(function() {
263 | return {done: false, thunk: function($e) {
264 | return $new0(bar, $makeK(function() {
265 | return {done: true};
266 | }, $e), 20);
267 | }};
268 | }, $e), 10);
269 | }};
270 | });"))
271 |
272 | (deftest runtime/makeK-argument/toplevel/1 :notes runtime
273 | (test-transform 'runtime
274 | (list
275 | (jw::make-continuation-function :body (parse "return {done: true};"))))
276 | #.(test-parse "
277 | $makeK(function() { return {done: true}; }, null);"))
278 |
279 | (deftest runtime/makeK-argument/in-function/1 :notes runtime
280 | (test-transform 'runtime
281 | (transform 'trampoline
282 | (transform 'cps (parse "
283 | function foo()
284 | {
285 | foo();
286 | return 10;
287 | }"))))
288 | #.(test-parse "
289 | function foo($k)
290 | {
291 | if(!$k || !$k.$isK)
292 | return $callFromDirect(foo, this, arguments);
293 | return {done: false, thunk: function($e) {
294 | return foo($makeK(function() {
295 | return {done: false, thunk: function($e) {
296 | return $k(10);
297 | }};
298 | }, $e));
299 | }};
300 | }
301 | foo.$jw = true;"))
302 |
303 | (deftest runtime/makeK-argument/in-function/2 :notes runtime
304 | (with-fresh-genvar
305 | (test-transform 'runtime
306 | (transform 'trampoline
307 | (transform 'cps (parse "
308 | function foo()
309 | {
310 | if(x)
311 | foo();
312 | return 10;
313 | }")))))
314 | #.(test-parse "
315 | function foo($k)
316 | {
317 | if(!$k || !$k.$isK)
318 | return $callFromDirect(foo, this, arguments);
319 |
320 | var ifK$0 = $makeK(function() {
321 | return {done: false, thunk: function($e) {
322 | return $k(10);
323 | }};
324 | }, $k.$exHandlers);
325 |
326 | if(x)
327 | return {done: false, thunk: function($e) {
328 | return foo($makeK(function() {
329 | return {replaceHandlers: ifK$0.$exHandlers, done: false, thunk: function($e) {
330 | return ifK$0();
331 | }};
332 | }, $e));
333 | }};
334 | else
335 | return {replaceHandlers: ifK$0.$exHandlers, done: false, thunk: function($e) {
336 | return ifK$0();
337 | }};
338 | }
339 | foo.$jw = true;"))
340 |
--------------------------------------------------------------------------------
/lib/slider.js:
--------------------------------------------------------------------------------
1 | // Copyright (c) 2005 Marty Haught, Thomas Fuchs
2 | //
3 | // See http://script.aculo.us for more info
4 | //
5 | // Permission is hereby granted, free of charge, to any person obtaining
6 | // a copy of this software and associated documentation files (the
7 | // "Software"), to deal in the Software without restriction, including
8 | // without limitation the rights to use, copy, modify, merge, publish,
9 | // distribute, sublicense, and/or sell copies of the Software, and to
10 | // permit persons to whom the Software is furnished to do so, subject to
11 | // the following conditions:
12 | //
13 | // The above copyright notice and this permission notice shall be
14 | // included in all copies or substantial portions of the Software.
15 | //
16 | // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17 | // EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18 | // MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
19 | // NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
20 | // LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
21 | // OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
22 | // WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
23 |
24 | if(!Control) var Control = {};
25 | Control.Slider = Class.create();
26 |
27 | // options:
28 | // axis: 'vertical', or 'horizontal' (default)
29 | //
30 | // callbacks:
31 | // onChange(value)
32 | // onSlide(value)
33 | Control.Slider.prototype = {
34 | initialize: function(handle, track, options) {
35 | var slider = this;
36 |
37 | if(handle instanceof Array) {
38 | this.handles = handle.collect( function(e) { return $(e) });
39 | } else {
40 | this.handles = [$(handle)];
41 | }
42 |
43 | this.track = $(track);
44 | this.options = options || {};
45 |
46 | this.axis = this.options.axis || 'horizontal';
47 | this.increment = this.options.increment || 1;
48 | this.step = parseInt(this.options.step || '1');
49 | this.range = this.options.range || $R(0,1);
50 |
51 | this.value = 0; // assure backwards compat
52 | this.values = this.handles.map( function() { return 0 });
53 | this.spans = this.options.spans ? this.options.spans.map(function(s){ return $(s) }) : false;
54 | this.options.startSpan = $(this.options.startSpan || null);
55 | this.options.endSpan = $(this.options.endSpan || null);
56 |
57 | this.restricted = this.options.restricted || false;
58 |
59 | this.maximum = this.options.maximum || this.range.end;
60 | this.minimum = this.options.minimum || this.range.start;
61 |
62 | // Will be used to align the handle onto the track, if necessary
63 | this.alignX = parseInt(this.options.alignX || '0');
64 | this.alignY = parseInt(this.options.alignY || '0');
65 |
66 | this.trackLength = this.maximumOffset() - this.minimumOffset();
67 | this.handleLength = this.isVertical() ? this.handles[0].offsetHeight : this.handles[0].offsetWidth;
68 |
69 | this.active = false;
70 | this.dragging = false;
71 | this.disabled = false;
72 |
73 | if(this.options.disabled) this.setDisabled();
74 |
75 | // Allowed values array
76 | this.allowedValues = this.options.values ? this.options.values.sortBy(Prototype.K) : false;
77 | if(this.allowedValues) {
78 | this.minimum = this.allowedValues.min();
79 | this.maximum = this.allowedValues.max();
80 | }
81 |
82 | this.eventMouseDown = this.startDrag.bindAsEventListener(this);
83 | this.eventMouseUp = this.endDrag.bindAsEventListener(this);
84 | this.eventMouseMove = this.update.bindAsEventListener(this);
85 |
86 | // Initialize handles in reverse (make sure first handle is active)
87 | this.handles.each( function(h,i) {
88 | i = slider.handles.length-1-i;
89 | slider.setValue(parseFloat(
90 | (slider.options.sliderValue instanceof Array ?
91 | slider.options.sliderValue[i] : slider.options.sliderValue) ||
92 | slider.range.start), i);
93 | Element.makePositioned(h); // fix IE
94 | Event.observe(h, "mousedown", slider.eventMouseDown);
95 | });
96 |
97 | Event.observe(this.track, "mousedown", this.eventMouseDown);
98 | Event.observe(document, "mouseup", this.eventMouseUp);
99 | Event.observe(document, "mousemove", this.eventMouseMove);
100 |
101 | this.initialized = true;
102 | },
103 | dispose: function() {
104 | var slider = this;
105 | Event.stopObserving(this.track, "mousedown", this.eventMouseDown);
106 | Event.stopObserving(document, "mouseup", this.eventMouseUp);
107 | Event.stopObserving(document, "mousemove", this.eventMouseMove);
108 | this.handles.each( function(h) {
109 | Event.stopObserving(h, "mousedown", slider.eventMouseDown);
110 | });
111 | },
112 | setDisabled: function(){
113 | this.disabled = true;
114 | },
115 | setEnabled: function(){
116 | this.disabled = false;
117 | },
118 | getNearestValue: function(value){
119 | if(this.allowedValues){
120 | if(value >= this.allowedValues.max()) return(this.allowedValues.max());
121 | if(value <= this.allowedValues.min()) return(this.allowedValues.min());
122 |
123 | var offset = Math.abs(this.allowedValues[0] - value);
124 | var newValue = this.allowedValues[0];
125 | this.allowedValues.each( function(v) {
126 | var currentOffset = Math.abs(v - value);
127 | if(currentOffset <= offset){
128 | newValue = v;
129 | offset = currentOffset;
130 | }
131 | });
132 | return newValue;
133 | }
134 | if(value > this.range.end) return this.range.end;
135 | if(value < this.range.start) return this.range.start;
136 | return value;
137 | },
138 | setValue: function(sliderValue, handleIdx){
139 | if(!this.active) {
140 | this.activeHandle = this.handles[handleIdx];
141 | this.activeHandleIdx = handleIdx;
142 | this.updateStyles();
143 | }
144 | handleIdx = handleIdx || this.activeHandleIdx || 0;
145 | if(this.initialized && this.restricted) {
146 | if((handleIdx>0) && (sliderValuethis.values[handleIdx+1]))
149 | sliderValue = this.values[handleIdx+1];
150 | }
151 | sliderValue = this.getNearestValue(sliderValue);
152 | this.values[handleIdx] = sliderValue;
153 | this.value = this.values[0]; // assure backwards compat
154 |
155 | this.handles[handleIdx].style[this.isVertical() ? 'top' : 'left'] =
156 | this.translateToPx(sliderValue);
157 |
158 | this.drawSpans();
159 | if(!this.dragging || !this.event) this.updateFinished();
160 | },
161 | setValueBy: function(delta, handleIdx) {
162 | this.setValue(this.values[handleIdx || this.activeHandleIdx || 0] + delta,
163 | handleIdx || this.activeHandleIdx || 0);
164 | },
165 | translateToPx: function(value) {
166 | return Math.round(
167 | ((this.trackLength-this.handleLength)/(this.range.end-this.range.start)) *
168 | (value - this.range.start)) + "px";
169 | },
170 | translateToValue: function(offset) {
171 | return ((offset/(this.trackLength-this.handleLength) *
172 | (this.range.end-this.range.start)) + this.range.start);
173 | },
174 | getRange: function(range) {
175 | var v = this.values.sortBy(Prototype.K);
176 | range = range || 0;
177 | return $R(v[range],v[range+1]);
178 | },
179 | minimumOffset: function(){
180 | return(this.isVertical() ? this.alignY : this.alignX);
181 | },
182 | maximumOffset: function(){
183 | return(this.isVertical() ?
184 | this.track.offsetHeight - this.alignY : this.track.offsetWidth - this.alignX);
185 | },
186 | isVertical: function(){
187 | return (this.axis == 'vertical');
188 | },
189 | drawSpans: function() {
190 | var slider = this;
191 | if(this.spans)
192 | $R(0, this.spans.length-1).each(function(r) { slider.setSpan(slider.spans[r], slider.getRange(r)) });
193 | if(this.options.startSpan)
194 | this.setSpan(this.options.startSpan,
195 | $R(0, this.values.length>1 ? this.getRange(0).min() : this.value ));
196 | if(this.options.endSpan)
197 | this.setSpan(this.options.endSpan,
198 | $R(this.values.length>1 ? this.getRange(this.spans.length-1).max() : this.value, this.maximum));
199 | },
200 | setSpan: function(span, range) {
201 | if(this.isVertical()) {
202 | span.style.top = this.translateToPx(range.start);
203 | span.style.height = this.translateToPx(range.end - range.start + this.range.start);
204 | } else {
205 | span.style.left = this.translateToPx(range.start);
206 | span.style.width = this.translateToPx(range.end - range.start + this.range.start);
207 | }
208 | },
209 | updateStyles: function() {
210 | this.handles.each( function(h){ Element.removeClassName(h, 'selected') });
211 | Element.addClassName(this.activeHandle, 'selected');
212 | },
213 | startDrag: function(event) {
214 | if(Event.isLeftClick(event)) {
215 | if(!this.disabled){
216 | this.active = true;
217 |
218 | var handle = Event.element(event);
219 | var pointer = [Event.pointerX(event), Event.pointerY(event)];
220 | if(handle==this.track) {
221 | var offsets = Position.cumulativeOffset(this.track);
222 | this.event = event;
223 | this.setValue(this.translateToValue(
224 | (this.isVertical() ? pointer[1]-offsets[1] : pointer[0]-offsets[0])-(this.handleLength/2)
225 | ));
226 | var offsets = Position.cumulativeOffset(this.activeHandle);
227 | this.offsetX = (pointer[0] - offsets[0]);
228 | this.offsetY = (pointer[1] - offsets[1]);
229 | } else {
230 | // find the handle (prevents issues with Safari)
231 | while((this.handles.indexOf(handle) == -1) && handle.parentNode)
232 | handle = handle.parentNode;
233 |
234 | this.activeHandle = handle;
235 | this.activeHandleIdx = this.handles.indexOf(this.activeHandle);
236 | this.updateStyles();
237 |
238 | var offsets = Position.cumulativeOffset(this.activeHandle);
239 | this.offsetX = (pointer[0] - offsets[0]);
240 | this.offsetY = (pointer[1] - offsets[1]);
241 | }
242 | }
243 | Event.stop(event);
244 | }
245 | },
246 | update: function(event) {
247 | if(this.active) {
248 | if(!this.dragging) this.dragging = true;
249 | this.draw(event);
250 | // fix AppleWebKit rendering
251 | if(navigator.appVersion.indexOf('AppleWebKit')>0) window.scrollBy(0,0);
252 | Event.stop(event);
253 | }
254 | },
255 | draw: function(event) {
256 | var pointer = [Event.pointerX(event), Event.pointerY(event)];
257 | var offsets = Position.cumulativeOffset(this.track);
258 | pointer[0] -= this.offsetX + offsets[0];
259 | pointer[1] -= this.offsetY + offsets[1];
260 | this.event = event;
261 | this.setValue(this.translateToValue( this.isVertical() ? pointer[1] : pointer[0] ));
262 | if(this.initialized && this.options.onSlide)
263 | this.options.onSlide(this.values.length>1 ? this.values : this.value, this);
264 | },
265 | endDrag: function(event) {
266 | if(this.active && this.dragging) {
267 | this.finishDrag(event, true);
268 | Event.stop(event);
269 | }
270 | this.active = false;
271 | this.dragging = false;
272 | },
273 | finishDrag: function(event, success) {
274 | this.active = false;
275 | this.dragging = false;
276 | this.updateFinished();
277 | },
278 | updateFinished: function() {
279 | if(this.initialized && this.options.onChange)
280 | this.options.onChange(this.values.length>1 ? this.values : this.value, this);
281 | this.event = null;
282 | }
283 | }
--------------------------------------------------------------------------------
/static-analysis.lisp:
--------------------------------------------------------------------------------
1 | ;;;; static-analysis.lisp
2 | ;;;
3 | ;;; Defines some utilities for statically analyzing the control flow of
4 | ;;; jwacs source elements.
5 | ;;;
6 | ;;; Copyright (c) 2006 James Wright
7 | ;;; See LICENSE for full licensing details.
8 | ;;;
9 | (in-package :jwacs)
10 |
11 | ;;;; ======= Simple predicates =====================================================================
12 |
13 | (defun effective-fn-call-p (elm)
14 | "Both function calls and new expressions are 'effective' function calls, because they
15 | will both wind up as function calls after the compiler pipeline gets through with them."
16 | (or (fn-call-p elm)
17 | (new-expr-p elm)))
18 |
19 | ;;;; ======= explicitly-terminated-p generic function ==============================================
20 |
21 | (defun explicit-return-p (elm)
22 | "Convenience function for the common case where we're concerned about function
23 | termination (rather than loop or clause termination)"
24 | (explicitly-terminated-p elm '(:return :throw :resume :suspend)))
25 |
26 | (defgeneric explicitly-terminated-p (elm terminators)
27 | (:documentation
28 | "Returns non-NIL if ELM explicitly terminates via all control paths. The definition
29 | of 'termination' is configurable by the TERMINATORS argument. TERMINATORS is a list
30 | containing any or all of :RETURN :THROW :BREAK :CONTINUE :RESUME :SUSPEND. When :RETURN
31 | is in TERMINATORS, return statements are considered to terminate a control path; similarly
32 | for the other keywords."))
33 |
34 | ;;; Non-escaping label tracking
35 | ;;;
36 | ;;; We track 'non-escaping' breaks and continues that don't terminate the entire statement
37 | ;;; being considered. For example, this call:
38 | ;;;
39 | ;;; (EXPLICITLY-TERMINATED-P (PARSE "x = 10; break;"))
40 | ;;;
41 | ;;; should return non-NIL, but this one:
42 | ;;;
43 | ;;; (EXPLICITLY-TERMINATED-P (PARSE "x = 10; while(true) { break; } x = 20;"))
44 | ;;;
45 | ;;; should return NIL, because the `break` statement only terminates the `while` loop,
46 | ;;; not the entire control path being considered.
47 |
48 | (defparameter *non-escaping-break-labels* nil
49 | "Non-escaping label names that are valid targets for a `break` statement")
50 |
51 | (defparameter *non-escaping-continue-labels* nil
52 | "Non-escaping label names that are valid targets for a `continue` statement")
53 |
54 | (defmacro with-non-escaping-break-target ((elm) &body body)
55 | `(let ((*non-escaping-break-labels* (cons (source-element-label ,elm)
56 | *non-escaping-break-labels*)))
57 | ,@body))
58 |
59 | (defmacro with-non-escaping-continue-target ((elm) &body body)
60 | `(let ((*non-escaping-continue-labels* (cons (source-element-label ,elm)
61 | *non-escaping-continue-labels*)))
62 | ,@body))
63 |
64 | ;;; Unless otherwise specified, a source element does not explicitly terminate
65 | (defmethod explicitly-terminated-p (elm terminators)
66 | nil)
67 |
68 | ;;; Base cases
69 | (defmethod explicitly-terminated-p ((elm return-statement) terminators)
70 | (find :return terminators))
71 |
72 | (defmethod explicitly-terminated-p ((elm throw-statement) terminators)
73 | (find :throw terminators))
74 |
75 | (defmethod explicitly-terminated-p ((elm resume-statement) terminators)
76 | (find :resume terminators))
77 |
78 | (defmethod explicitly-terminated-p ((elm suspend-statement) terminators)
79 | (find :suspend terminators))
80 |
81 | (defmethod explicitly-terminated-p ((elm break-statement) terminators)
82 | (with-slots (target-label) elm
83 | (unless (or (and (null target-label)
84 | (> (length *non-escaping-break-labels*) 0))
85 | (member target-label *non-escaping-break-labels*
86 | :test 'equal))
87 | (find :break terminators))))
88 |
89 | (defmethod explicitly-terminated-p ((elm continue-statement) terminators)
90 | (with-slots (target-label) elm
91 | (unless (or (and (null target-label)
92 | (> (length *non-escaping-continue-labels*) 0))
93 | (member target-label *non-escaping-continue-labels*
94 | :test 'equal))
95 | (find :continue terminators))))
96 |
97 | ;;; Sequences
98 | (defmethod explicitly-terminated-p ((elm-list list) terminators)
99 | (unless (null elm-list)
100 | (or (explicitly-terminated-p (car elm-list) terminators)
101 | (explicitly-terminated-p (cdr elm-list) terminators))))
102 |
103 | ;;; Branches
104 | (defmethod explicitly-terminated-p ((elm if-statement) terminators)
105 | (and (explicitly-terminated-p (if-statement-then-statement elm) terminators)
106 | (explicitly-terminated-p (if-statement-else-statement elm) terminators)))
107 |
108 | (defmethod explicitly-terminated-p ((elm switch) terminators)
109 | (with-non-escaping-break-target (elm)
110 | (reduce (lambda (x y)
111 | (and x y))
112 | (switch-clauses elm)
113 | :key (lambda (clause)
114 | (explicitly-terminated-p clause terminators)))))
115 |
116 | (defmethod explicitly-terminated-p ((elm try) terminators)
117 | (with-slots (body catch-clause finally-clause) elm
118 | (or (explicitly-terminated-p finally-clause terminators)
119 | (if (null catch-clause)
120 | (explicitly-terminated-p body terminators)
121 | (and (explicitly-terminated-p body terminators)
122 | (explicitly-terminated-p catch-clause terminators))))))
123 |
124 | ;;; Simple recursion
125 | (defmethod explicitly-terminated-p ((elm statement-block) terminators)
126 | (explicitly-terminated-p (statement-block-statements elm) terminators))
127 |
128 | (defmethod explicitly-terminated-p ((elm case-clause) terminators)
129 | (explicitly-terminated-p (case-clause-body elm) terminators))
130 |
131 | (defmethod explicitly-terminated-p ((elm default-clause) terminators)
132 | (explicitly-terminated-p (default-clause-body elm) terminators))
133 |
134 | (defmethod explicitly-terminated-p ((elm do-statement) terminators)
135 | ;; If the body of a do loop is explicitly terminated, then so is the whole
136 | ;; statement, because the body always executes at least once.
137 | (with-non-escaping-break-target (elm)
138 | (with-non-escaping-continue-target (elm)
139 | (explicitly-terminated-p (do-statement-body elm) terminators))))
140 |
141 | (defmethod explicitly-terminated-p ((elm while) terminators)
142 | ;; The only time that a while loop's body is statically guaranteed to execute is
143 | ;; when its condition is true
144 | (when (and (special-value-p (while-condition elm))
145 | (eq (special-value-symbol (while-condition elm))
146 | :true))
147 | (with-non-escaping-break-target (elm)
148 | (with-non-escaping-continue-target (elm)
149 | (explicitly-terminated-p (while-body elm) terminators)))))
150 |
151 | (defmethod explicitly-terminated-p ((elm for) terminators)
152 | ;; The only time that a for loop's body is statically guaranteed to execute is
153 | ;; when its condition is true
154 | (when (and (special-value-p (for-condition elm))
155 | (eq (special-value-symbol (for-condition elm))
156 | :true))
157 | (with-non-escaping-break-target (elm)
158 | (with-non-escaping-continue-target (elm)
159 | (explicitly-terminated-p (for-body elm) terminators)))))
160 |
161 | (defmethod explicitly-terminated-p ((elm for-in) terminators)
162 | ;; The only time that a for-in loop's body is statically guaranteed to execute is
163 | ;; when its collection is a non-empty literal
164 | (when (or (and (object-literal-p (for-in-collection elm))
165 | (> (length (object-literal-properties (for-in-collection elm))) 0))
166 | (and (array-literal-p (for-in-collection elm))
167 | (> (length (array-literal-elements (for-in-collection elm))) 0)))
168 | (with-non-escaping-break-target (elm)
169 | (with-non-escaping-continue-target (elm)
170 | (explicitly-terminated-p (for-in-body elm) terminators)))))
171 |
172 | (defmethod explicitly-terminated-p ((elm with) terminators)
173 | (explicitly-terminated-p (with-body elm) terminators))
174 |
175 | (defmethod explicitly-terminated-p ((elm catch-clause) terminators)
176 | (explicitly-terminated-p (catch-clause-body elm) terminators))
177 |
178 | (defmethod explicitly-terminated-p ((elm finally-clause) terminators)
179 | (explicitly-terminated-p (finally-clause-body elm) terminators))
180 |
181 | ;;;; ======= introduces-fn-call-p generic function =================================================
182 |
183 | (defgeneric introduces-fn-call-p (elm)
184 | (:documentation
185 | "Returns non-NIL if there exists a control path through ELM that contains
186 | an effective function call."))
187 |
188 | ;;; Base cases
189 |
190 | (defmethod introduces-fn-call-p (elm)
191 | nil)
192 |
193 | (defmethod introduces-fn-call-p ((elm fn-call))
194 | t)
195 |
196 | (defmethod introduces-fn-call-p ((elm new-expr))
197 | t)
198 |
199 | ;;; Recursion
200 |
201 | (defmethod introduces-fn-call-p ((elm-list list))
202 | (some #'introduces-fn-call-p elm-list))
203 |
204 | (defmethod introduces-fn-call-p ((elm source-element))
205 | (some (lambda (slot)
206 | (introduces-fn-call-p (slot-value elm slot)))
207 | (structure-slots elm)))
208 |
209 | (defmethod introduces-fn-call-p ((elm object-literal))
210 | (some #'introduces-fn-call-p
211 | (mapcar #'cdr (object-literal-properties elm))))
212 |
213 | ;;; Don't recurse into functions
214 |
215 | (defmethod introduces-fn-call-p ((elm function-decl))
216 | nil)
217 |
218 | (defmethod introduces-fn-call-p ((elm function-expression))
219 | nil)
220 |
221 | ;;;; ======= FIND-FREE-VARIABLES generic function ==================================================
222 |
223 | ;; TODO this is horrible because it duplicates so much code in uniquify
224 |
225 | (defgeneric find-free-variables (elm)
226 | (:documentation
227 | "Return a list of all the free variables in ELM"))
228 |
229 | (defun find-free-variables-in-scope (elm)
230 | "This is basically TRANSFORM-IN-SCOPE. It adds bindings for each variable and function
231 | declaration that it encounters."
232 | (dolist (var-decl (collect-in-scope elm 'var-decl))
233 | (add-binding (var-decl-name var-decl) t))
234 | (dolist (fun-decl (collect-in-scope elm 'function-decl))
235 | (add-binding (function-decl-name fun-decl) t))
236 | (find-free-variables elm))
237 |
238 | (defmethod find-free-variables ((elm identifier))
239 | (with-slots (name) elm
240 | (unless (find-binding name)
241 | (list name))))
242 |
243 | (defmethod find-free-variables ((elm function-decl))
244 | (with-added-environment
245 | (dolist (param (function-decl-parameters elm))
246 | (add-binding param t))
247 | (find-free-variables-in-scope (function-decl-body elm))))
248 |
249 | (defmethod find-free-variables ((elm function-expression))
250 | (with-added-environment
251 | (when-let (name (function-expression-name elm))
252 | (add-binding name t))
253 | (dolist (param (function-expression-parameters elm))
254 | (add-binding param t))
255 | (find-free-variables-in-scope (function-expression-body elm))))
256 |
257 | (defmethod find-free-variables ((elm-list list))
258 | (remove-duplicates
259 | (mapcan #'find-free-variables elm-list)
260 | :test #'equal))
261 |
262 | (defmethod find-free-variables ((elm source-element))
263 | (remove-duplicates
264 | (loop for slot in (structure-slots elm)
265 | append (find-free-variables (slot-value elm slot)))
266 | :test #'equal))
267 |
268 | (defmethod find-free-variables ((elm object-literal))
269 | (remove-duplicates
270 | (loop for prop-cell in (object-literal-properties elm)
271 | append (find-free-variables (cdr prop-cell)))
272 | :test #'equal))
273 |
274 | (defmethod find-free-variables (elm)
275 | nil)
276 |
277 | (defmethod find-free-variables :around (elm)
278 | (if (null *environment*)
279 | (with-added-environment
280 | (if (listp elm)
281 | (find-free-variables-in-scope elm)
282 | (call-next-method)))
283 | (call-next-method)))
284 |
--------------------------------------------------------------------------------
/trampoline-transformation.lisp:
--------------------------------------------------------------------------------
1 | ;;;; trampoline-transformation.lisp
2 | ;;;
3 | ;;; Define the transformation that converts cps-form Javascript source
4 | ;;; into trampolined cps-form Javascript.
5 | ;;;
6 | ;;; Copyright (c) 2006 James Wright
7 | ;;; See LICENSE for full licensing details.
8 | ;;;
9 | (in-package :jwacs)
10 |
11 | ;;;; ======= Trampoline transformation =============================================================
12 | ;;;
13 | ;;; 1. Every return statement whose argument is a function call
14 | ;;; to a trampoline-style function is transformed into a trampolining
15 | ;;; return statement whose `done` field is `false` and whose `thunk`
16 | ;; field is a function that contains the original return statement.
17 | ;;; 2. Every return statement whose argument is /not/ a function call
18 | ;;; is transformed into a trampolining return statement whose `done`
19 | ;;; field is `true` and whose `result` field contains the original
20 | ;;;
21 | ;;; The return continuation for a function to convert to trampoline form
22 | ;;; is assumed to already be in trampoline form.
23 | ;;;
24 | ;;; It is assumed that all calls to trampoline-style functions are
25 | ;;; tail calls; the above two rules are obviously not sufficient when
26 | ;;; this condition doesn't hold.
27 |
28 | ;;;; ======= Helpers ===============================================================================
29 | (defparameter *thunk-prop* (make-string-literal :value "thunk")
30 | "property name for the thunk field of a boxed result object")
31 |
32 | (defparameter *done-prop* (make-string-literal :value "done")
33 | "property name for the done field of a boxed result object")
34 |
35 | (defparameter *result-prop* (make-string-literal :value "result")
36 | "property name for the result field of a boxed result object")
37 |
38 | (defparameter *add-handler-prop* (make-string-literal :value "addHandler")
39 | "property name for the 'add exception handler to stack' operation field of a boxed result object")
40 |
41 | (defparameter *remove-handler-prop* (make-string-literal :value "removeHandler")
42 | "property name for the 'remove exception handler from stack' operation field of a boxed result object")
43 |
44 | (defparameter *replace-handler-stack-prop* (make-string-literal :value "replaceHandlers")
45 | "property name for the 'replace exception handler stack' operation field of a boxed result object")
46 |
47 | (defparameter *start-pos-prop* (make-string-literal :value "startPos")
48 | "property name for the start-position debug property on boxed thunks")
49 |
50 | (defparameter *end-pos-prop* (make-string-literal :value "endPos")
51 | "property name for the end-position debug property on boxed thunks")
52 |
53 | (defparameter *handler-stack-k-prop* (make-string-literal :value "$exHandlers")
54 | "Name of the property on continuations that contains the handler stack to use")
55 |
56 | (defparameter *handler-stack-var-name* "$e"
57 | "standard variable name for storing the current handler stack")
58 |
59 | (defvar *debug-mode* nil
60 | "When true, we pack more information into each boxed thunk")
61 |
62 | (defparameter *debug-eval-var-name* "$localEvalArg"
63 | "Name of the parameter containing an expression to be evaluated locally for debug-mode thunks")
64 |
65 | (defparameter *debug-eval-boilerplate*
66 | (make-if-statement :condition (make-identifier :name *debug-eval-var-name*)
67 | :then-statement (make-return-statement
68 | :arg (make-continuation-call :fn (make-identifier :name "$id")
69 | :args (list (make-continuation-call :fn (make-identifier :name "eval")
70 | :args (list (make-identifier :name *debug-eval-var-name*)))))))
71 | "Boilerplate code for debug-mode local evaluation")
72 |
73 | (defun make-boxed-thunk (body-elm &optional stack-op stack-op-arg)
74 | "Returns an object literal whose `done` field is `false` and whose
75 | `thunk` field contains a thunk whose body is BODY-ELM. When STACK-OP
76 | is non-NIL, a handler stack operation property will also be added with
77 | a value of STACK-OP-ARG. When *DEBUG-MODE* is non-NIL, an `$evalArg`
78 | parameter is also provided, along with boilerplate code that evaluates
79 | the argument and then returns when it's present."
80 | (cond
81 | ((and *debug-mode* stack-op)
82 | (make-object-literal :properties (list
83 | (cons stack-op stack-op-arg)
84 | (cons *done-prop* (make-special-value :symbol :false))
85 | (cons *start-pos-prop*
86 | (aif (element-start body-elm)
87 | (make-numeric-literal :value it)
88 | undefined-id))
89 | (cons *end-pos-prop*
90 | (aif (element-end body-elm)
91 | (make-numeric-literal :value it)
92 | undefined-id))
93 | (cons *thunk-prop*
94 | (make-thunk-function :parameters (list *handler-stack-var-name*
95 | *debug-eval-var-name*)
96 | :body (combine-statements
97 | *debug-eval-boilerplate*
98 | body-elm))))))
99 | (stack-op
100 | (make-object-literal :properties (list
101 | (cons stack-op stack-op-arg)
102 | (cons *done-prop* (make-special-value :symbol :false))
103 | (cons *thunk-prop*
104 | (make-thunk-function :parameters (list *handler-stack-var-name*)
105 | :body (combine-statements body-elm))))))
106 | (*debug-mode*
107 | (make-object-literal :properties (list
108 | (cons *start-pos-prop*
109 | (aif (source-element-start body-elm)
110 | (make-numeric-literal :value it)
111 | undefined-id))
112 | (cons *end-pos-prop*
113 | (aif (source-element-end body-elm)
114 | (make-numeric-literal :value it)
115 | undefined-id))
116 | (cons *done-prop* (make-special-value :symbol :false))
117 | (cons *thunk-prop*
118 | (make-thunk-function :parameters (list *handler-stack-var-name*
119 | *debug-eval-var-name*)
120 | :body (combine-statements
121 | *debug-eval-boilerplate*
122 | body-elm))))))
123 | (t
124 | (make-object-literal :properties (list
125 | (cons *done-prop* (make-special-value :symbol :false))
126 | (cons *thunk-prop*
127 | (make-thunk-function :parameters (list *handler-stack-var-name*)
128 | :body (combine-statements body-elm))))))))
129 | (defun make-boxed-result (elm)
130 | "Returns an object literal whose `done` field is `true` and whose
131 | `result` field contains ELM. If ELM is NIL, the result field will
132 | be left undefined."
133 | (if (null elm)
134 | (make-object-literal :properties
135 | (list (cons *done-prop* (make-special-value :symbol :true))))
136 | (make-object-literal :properties
137 | (list
138 | (cons *done-prop* (make-special-value :symbol :true))
139 | (cons *result-prop* elm)))))
140 |
141 | ;;;; ======= TRANSFORM methods =====================================================================
142 |
143 | (defmethod transform ((xform (eql 'trampoline)) (elm return-statement))
144 | (with-slots (arg) elm
145 | (if (or (fn-call-p arg)
146 | (new-expr-p arg)) ; new expressions are "effective function calls", because the runtime transform will turn them into calls to `$new`.
147 | (make-return-statement :arg (make-boxed-thunk (make-return-statement :arg (transform 'trampoline arg)
148 | :start (source-element-start elm)
149 | :end (source-element-end elm))))
150 | (make-return-statement :arg (make-boxed-result (transform 'trampoline arg))
151 | :start (source-element-start elm)
152 | :end (source-element-end elm)))))
153 |
154 | ;;;; ------- handler stack operations --------------------------------------------------------------
155 |
156 | (defmethod transform ((xform (eql 'trampoline)) (elm add-handler))
157 | (make-return-statement
158 | :arg (make-boxed-thunk (transform 'trampoline (add-handler-thunk-body elm))
159 | *add-handler-prop*
160 | (add-handler-handler elm))))
161 |
162 | (defmethod transform ((xform (eql 'trampoline)) (elm remove-handler))
163 | (make-return-statement
164 | :arg (make-boxed-thunk (transform 'trampoline (remove-handler-thunk-body elm))
165 | *remove-handler-prop*
166 | (remove-handler-handler elm))))
167 |
168 | ;;;; ------- `suspend` and `resume` transformation -------------------------------------------------
169 |
170 | (defmethod transform ((xform (eql 'trampoline)) (elm suspend-statement))
171 | ;; We don't bother with a replace-handler operation here since we will be exiting
172 | ;; the $trampoline function right away.
173 | (make-return-statement :arg (make-boxed-result nil)
174 | :start (source-element-start elm)
175 | :end (source-element-end elm)))
176 |
177 | (defmethod transform ((xform (eql 'trampoline)) (elm resume-statement))
178 | (with-slots (target arg) elm
179 | (let ((new-call (make-continuation-call :fn (transform 'trampoline target)
180 | :args (when arg
181 | (list arg))
182 | :start (source-element-start elm)
183 | :end (source-element-end elm))))
184 | (make-return-statement
185 | :arg (make-boxed-thunk
186 | (make-return-statement :arg new-call
187 | :start (source-element-start elm)
188 | :end (source-element-end elm))
189 | *replace-handler-stack-prop*
190 | (make-property-access :target (transform 'trampoline target)
191 | :field *handler-stack-k-prop*))))))
192 |
193 | ;;;; ------- throwing into a continuation ----------------------------------------------------------
194 |
195 | (defmethod transform ((xform (eql 'trampoline)) (elm throw-statement))
196 | (with-slots (value target) elm
197 | (cond
198 | (target
199 | (make-return-statement
200 | :arg (make-boxed-thunk
201 | (make-throw-statement :value (transform 'trampoline value)
202 | :start (source-element-start elm)
203 | :end (source-element-end elm))
204 | *replace-handler-stack-prop*
205 | (make-property-access :target (transform 'trampoline target)
206 | :field *handler-stack-k-prop*))))
207 | (*debug-mode*
208 | ;; In debug mode, it's a lot less confusing if we generate an otherwise-superfluous
209 | ;; thunk for each throw statement.
210 | (make-return-statement
211 | :arg (make-boxed-thunk
212 | (make-throw-statement :value (transform 'trampoline value)
213 | :start (source-element-start elm)
214 | :end (source-element-end elm)))))
215 | (t
216 | (make-throw-statement :value (transform 'trampoline value)
217 | :start (source-element-start elm)
218 | :end (source-element-end elm))))))
--------------------------------------------------------------------------------