diff --git a/NOTES b/NOTES
index b78af7f..6b0d027 100644
--- a/NOTES
+++ b/NOTES
@@ -683,4 +683,64 @@ circularity between helpers and types.
The parameters I'm using to control bounce are too high for Firefox,
-leading it to raise the dialog about an out of control jva process. Not good.
\ No newline at end of file
+leading it to raise the dialog about an out of control jva process. Not good.
+
+----------------------------------------------------------------------
+
+Working out the type mappings between values in Racket and values in JavaScript
+
+
+
+ Racket JavaScript Switched over?
+
+
+ number jsnums.SchemeNumber yes
+ immutable strings JavaScript string
+ mutable strings types.Str
+
+ vector
+
+
+ regular-expressions
+ path
+ bytes
+ box
+ placeholder
+ character
+ symbol
+ keyword
+
+ pair yes
+ empty yes
+
+ eq-hashtable
+ equal-hashtable
+
+ struct-type
+ struct
+
+ path
+
+ continuation-mark-set
+
+ primitive-procedure
+ closure
+ case-lambda
+
+
+ undefined undefined
+ void plt.runtime.VOID
+
+----------------------------------------------------------------------
+
+I should add the functions:
+
+ get-viewport-width
+ get-viewport-height
+
+Other notes from Shriram: too slow, inconsistent positioning from jsworld.
+
+
+----------------------------------------------------------------------
+
+Added base as the default planet language.
\ No newline at end of file
diff --git a/README b/README
index e24389e..eec16ac 100644
--- a/README
+++ b/README
@@ -3,6 +3,7 @@ Whalesong: a compiler from Racket to JavaScript.
Danny Yoo (dyoo@cs.wpi.edu)
+
======================================================================
@@ -16,9 +17,25 @@ amount of time.
Example usage
-[FIXME]
+Create a simple, standalong executable of your program. At the
+moment, the program must be written in the base language of whalesong.
+(This restriction currently prevents arbitrary racket/base programs
+from compiling, and we'll be working to remove this restriction.)
+
+ $ cat hello.rkt
+ #lang planet dyoo/whalesong
+ (display "hello world")
+ (newline)
+
+ $ ./whalesong.rkt build hello.rkt
+
+ $ ls -l hello.xhtml
+ -rw-rw-r-- 1 dyoo nogroup 692213 Jun 7 18:00 hello.xhtml
+
+
+[FIXME: add more examples]
======================================================================
diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt
index 867e639..d57af6e 100644
--- a/compiler/compiler.rkt
+++ b/compiler/compiler.rkt
@@ -321,7 +321,7 @@
;; that has not yet been invoked.
;; fixme: This also needs to generate code for the requires and provides.
(match mod
- [(struct Module (name path prefix requires code))
+ [(struct Module (name path prefix requires provides code))
(let*: ([after-module-body (make-label 'afterModuleBody)]
[module-entry (make-label 'module-entry)]
[names : (Listof (U False Symbol GlobalBucket ModuleVariable))
@@ -2156,6 +2156,7 @@
(Module-path exp)
(Module-prefix exp)
(Module-requires exp)
+ (Module-provides exp)
(adjust-expression-depth (Module-code exp) n (add1 skip)))]
[(Constant? exp)
diff --git a/compiler/expression-structs.rkt b/compiler/expression-structs.rkt
index 7407ade..66f2c13 100644
--- a/compiler/expression-structs.rkt
+++ b/compiler/expression-structs.rkt
@@ -37,10 +37,18 @@
[path : ModuleLocator]
[prefix : Prefix]
[requires : (Listof ModuleLocator)]
+ [provides : (Listof ModuleProvide)]
[code : Expression])
#:transparent)
+(define-struct: ModuleProvide ([internal-name : Symbol]
+ [external-name : Symbol]
+ [source : ModuleLocator])
+ #:transparent)
+
+
+
(define-struct: Top ([prefix : Prefix]
[code : Expression]) #:transparent)
diff --git a/compiler/il-structs.rkt b/compiler/il-structs.rkt
index e038cbb..515da30 100644
--- a/compiler/il-structs.rkt
+++ b/compiler/il-structs.rkt
@@ -334,10 +334,10 @@
#:transparent)
;; Check the closure procedure value in 'proc and make sure it can accept the
-;; # of arguments (stored as a number in the val register.).
-(define-struct: CheckClosureArity! ([arity : OpArg])
+;; # of arguments (stored as a number in the argcount register.).
+(define-struct: CheckClosureArity! ([num-args : OpArg])
#:transparent)
-(define-struct: CheckPrimitiveArity! ([arity : OpArg])
+(define-struct: CheckPrimitiveArity! ([num-args : OpArg])
#:transparent)
diff --git a/examples/alert.rkt b/examples/alert.rkt
new file mode 100644
index 0000000..367abd0
--- /dev/null
+++ b/examples/alert.rkt
@@ -0,0 +1,3 @@
+#lang planet dyoo/whalesong
+(require (planet dyoo/whalesong/js))
+(alert "hello world")
diff --git a/examples/dom-play.rkt b/examples/dom-play.rkt
new file mode 100644
index 0000000..6e5c6b7
--- /dev/null
+++ b/examples/dom-play.rkt
@@ -0,0 +1,37 @@
+#lang planet dyoo/whalesong
+
+(require (planet dyoo/whalesong/js))
+
+
+;; insert-break: -> void
+(define (insert-break)
+ (call ($ "
") "appendTo" body)
+ (void))
+
+
+(define (write-message msg)
+ (void (call (call (call ($ "") "text" msg)
+ "css" "white-space" "pre")
+ "appendTo"
+ body)))
+
+
+
+;; Set the background green.
+(void (call body "css" "background-color" "lightgreen"))
+(void (call ($ "Hello World
") "appendTo" body))
+(write-message "Hello, this is a test!")
+(insert-break)
+(let loop ([i 0])
+ (cond
+ [(= i 10)
+ (void)]
+ [else
+ (write-message "iteration ") (write-message i)
+ (insert-break)
+ (loop (add1 i))]))
+
+(write-message "viewport-width: ") (write-message (viewport-width))
+(insert-break)
+(write-message "viewport-height: ") (write-message (viewport-height))
+(insert-break)
\ No newline at end of file
diff --git a/examples/hello.rkt b/examples/hello.rkt
new file mode 100644
index 0000000..3f39caa
--- /dev/null
+++ b/examples/hello.rkt
@@ -0,0 +1,4 @@
+#lang planet dyoo/whalesong
+
+(display "hello world")
+(newline)
\ No newline at end of file
diff --git a/examples/simple-world-program.rkt b/examples/simple-world-program.rkt
new file mode 100644
index 0000000..3405f84
--- /dev/null
+++ b/examples/simple-world-program.rkt
@@ -0,0 +1,9 @@
+#lang planet dyoo/whalesong
+(require (planet dyoo/whalesong/world))
+
+(display "hello again")
+(newline)
+
+(is-color? "red")
+(is-color? "blue")
+(is-color? 42)
\ No newline at end of file
diff --git a/examples/window-size.rkt b/examples/window-size.rkt
new file mode 100644
index 0000000..8475a84
--- /dev/null
+++ b/examples/window-size.rkt
@@ -0,0 +1,7 @@
+#lang planet dyoo/whalesong
+
+(when (in-javascript-context?)
+ (viewport-width))
+
+(when (in-javascript-context?)
+ (viewport-height))
diff --git a/js-assembler/assemble-helpers.rkt b/js-assembler/assemble-helpers.rkt
index 444078a..76911cd 100644
--- a/js-assembler/assemble-helpers.rkt
+++ b/js-assembler/assemble-helpers.rkt
@@ -101,13 +101,13 @@
(cond [(symbol? val)
(format "~s" (symbol->string val))]
[(pair? val)
- (format "[~a, ~a]"
+ (format "RUNTIME.makePair(~a, ~a)"
(loop (car val))
(loop (cdr val)))]
[(boolean? val)
(if val "true" "false")]
[(void? val)
- "null"]
+ "RUNTIME.VOID"]
[(empty? val)
(format "RUNTIME.NULL")]
[(number? val)
@@ -122,7 +122,7 @@
[(empty? vals)
"RUNTIME.NULL"]
[else
- (format "[~a, ~a]" (first vals) (loop (rest vals)))])))
+ (format "RUNTIME.makePair(~a, ~a)" (first vals) (loop (rest vals)))])))
diff --git a/js-assembler/assemble-open-coded.rkt b/js-assembler/assemble-open-coded.rkt
index f7aeae1..d6b6123 100644
--- a/js-assembler/assemble-open-coded.rkt
+++ b/js-assembler/assemble-open-coded.rkt
@@ -68,26 +68,21 @@
[(>=)
(assemble-boolean-chain "jsnums.greaterThanOrEqual" checked-operands)]
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
[(cons)
- (format "[~a, ~a]" (first checked-operands) (second checked-operands))]
+ (format "RUNTIME.makePair(~a, ~a)"
+ (first checked-operands)
+ (second checked-operands))]
[(car)
- (format "(~a)[0]" (first checked-operands))]
+ (format "(~a).first" (first checked-operands))]
[(cdr)
- (format "(~a)[1]" (first checked-operands))]
+ (format "(~a).rest" (first checked-operands))]
[(list)
(let loop ([checked-operands checked-operands])
- (cond
- [(empty? checked-operands)
- "RUNTIME.NULL"]
- [else
- (format "[~a,~a]" (first checked-operands) (loop (rest checked-operands)))]))]
+ (assemble-listof-assembled-values checked-operands))]
[(null?)
(format "(~a === RUNTIME.NULL)" (first checked-operands))]
@@ -151,17 +146,15 @@
(let: ([test-string : String
(case domain
[(number)
- (format "(jsnums.isSchemeNumber(~a))"
+ (format "jsnums.isSchemeNumber(~a)"
operand-string)]
[(string)
(format "(typeof(~a) === 'string')"
operand-string)]
[(list)
- (format "(~a === [] || (typeof(~a) === 'object' && (~a).length === 2))"
- operand-string operand-string operand-string)]
+ (format "RUNTIME.isList(~a)" operand-string)]
[(pair)
- (format "(typeof(~a) === 'object' && (~a).length === 2)"
- operand-string operand-string)]
+ (format "RUNTIME.isPair(~a)" operand-string)]
[(box)
(format "(typeof(~a) === 'object' && (~a).length === 1)"
operand-string operand-string)])])
diff --git a/js-assembler/assemble-perform-statement.rkt b/js-assembler/assemble-perform-statement.rkt
index 5c76afd..01531c8 100644
--- a/js-assembler/assemble-perform-statement.rkt
+++ b/js-assembler/assemble-perform-statement.rkt
@@ -27,13 +27,14 @@
RUNTIME.raiseOperatorIsNotClosure(MACHINE, MACHINE.proc);
}
if (! RUNTIME.isArityMatching(MACHINE.proc.arity, ~a)) {
- RUNTIME.raiseArityMismatchError(MACHINE.proc,
+ RUNTIME.raiseArityMismatchError(MACHINE,
+ MACHINE.proc,
MACHINE.proc.arity,
~a);
}
EOF
- (assemble-oparg (CheckClosureArity!-arity op))
- (assemble-oparg (CheckClosureArity!-arity op)))]
+ (assemble-oparg (CheckClosureArity!-num-args op))
+ (assemble-oparg (CheckClosureArity!-num-args op)))]
[(CheckPrimitiveArity!? op)
@@ -42,13 +43,14 @@ EOF
RUNTIME.raiseOperatorIsNotPrimitiveProcedure(MACHINE, MACHINE.proc);
}
if (! RUNTIME.isArityMatching(MACHINE.proc.arity, ~a)) {
- RUNTIME.raiseArityMismatchError(MACHINE.proc,
+ RUNTIME.raiseArityMismatchError(MACHINE,
+ MACHINE.proc,
MACHINE.proc.arity,
~a);
}
EOF
- (assemble-oparg (CheckPrimitiveArity!-arity op))
- (assemble-oparg (CheckPrimitiveArity!-arity op)))]
+ (assemble-oparg (CheckPrimitiveArity!-num-args op))
+ (assemble-oparg (CheckPrimitiveArity!-num-args op)))]
[(ExtendEnvironment/Prefix!? op)
diff --git a/js-assembler/assemble.rkt b/js-assembler/assemble.rkt
index fdfde55..ffe7512 100644
--- a/js-assembler/assemble.rkt
+++ b/js-assembler/assemble.rkt
@@ -186,7 +186,7 @@ EOF
"")
(cond
[(DebugPrint? stmt)
- (format "MACHINE.params.currentOutputPort.write(MACHINE, ~a);" (assemble-oparg (DebugPrint-value stmt)))]
+ (format "MACHINE.params.currentOutputPort.writeDomNode(MACHINE, $('').text(~a));" (assemble-oparg (DebugPrint-value stmt)))]
[(AssignImmediateStatement? stmt)
(let: ([t : String (assemble-target (AssignImmediateStatement-target stmt))]
[v : OpArg (AssignImmediateStatement-value stmt)])
diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt
index 07393a5..dd4d853 100644
--- a/js-assembler/package.rkt
+++ b/js-assembler/package.rkt
@@ -2,8 +2,14 @@
(require "assemble.rkt"
"quote-cdata.rkt"
- "../make.rkt"
- "../make-structs.rkt"
+ "../make/make.rkt"
+ "../make/make-structs.rkt"
+ "../parameters.rkt"
+ "../compiler/expression-structs.rkt"
+ "../parser/path-rewriter.rkt"
+ "../parser/parse-bytecode.rkt"
+ racket/match
+ (prefix-in query: "../lang/js/query.rkt")
(planet dyoo/closure-compile:1:1)
(prefix-in runtime: "get-runtime.rkt")
(prefix-in racket: racket/base))
@@ -21,52 +27,172 @@
write-runtime)
+
+;; notify: string (listof any)* -> void
+;; Print out log message during the build process.
+(define (notify msg . args)
+ (displayln (apply format msg args)))
+
+
+
+
+
+(define-struct js-impl (name ;; symbol
+ real-path ;; path
+ src ;; string
+ )
+ #:transparent)
+
+
;; Packager: produce single .js files to be included to execute a
;; program.
(define (package-anonymous source-code
- #:should-follow? should-follow?
+ #:should-follow-children? should-follow?
#:output-port op)
(fprintf op "(function() {\n")
(package source-code
- #:should-follow? should-follow?
+ #:should-follow-children? should-follow?
#:output-port op)
(fprintf op " return invoke; })\n"))
+;; source-is-javascript-module?: Source -> boolean
+;; Returns true if the source looks like a Javascript-implemented module.
+(define (source-is-javascript-module? src)
+ (cond
+ [(StatementsSource? src)
+ #f]
+ [(MainModuleSource? src)
+ (source-is-javascript-module? (MainModuleSource-source src))]
+ [(ModuleSource? src)
+ (query:has-javascript-implementation? `(file ,(path->string (ModuleSource-path src))))]
+ [(SexpSource? src)
+ #f]
+ [(UninterpretedSource? src)
+ #f]))
+
+
+;; get-javascript-implementation: source -> UninterpretedSource
+(define (get-javascript-implementation src)
+
+ (define (get-provided-name-code bytecode)
+ (match bytecode
+ [(struct Top [_ (struct Module (name path prefix requires provides code))])
+ (apply string-append
+ (map (lambda (p)
+ (format "modrec.namespace[~s] = exports[~s];\n"
+ (symbol->string (ModuleProvide-internal-name p))
+ (symbol->string (ModuleProvide-external-name p))))
+ provides))]
+ [else
+ ""]))
+ (cond
+ [(StatementsSource? src)
+ (error 'get-javascript-implementation src)]
+ [(MainModuleSource? src)
+ (get-javascript-implementation (MainModuleSource-source src))]
+ [(ModuleSource? src)
+ (let ([name (rewrite-path (ModuleSource-path src))]
+ [text (query:query `(file ,(path->string (ModuleSource-path src))))]
+ [bytecode (parse-bytecode (ModuleSource-path src))])
+ (make-UninterpretedSource
+ (format "
+MACHINE.modules[~s] =
+ new plt.runtime.ModuleRecord(~s,
+ function(MACHINE) {
+ if(--MACHINE.callsBeforeTrampoline<0) { throw arguments.callee; }
+ var modrec = MACHINE.modules[~s];
+ var exports = {};
+ modrec.isInvoked = true;
+ (function(MACHINE, RUNTIME, EXPORTS){~a})(MACHINE, plt.runtime, exports);
+ // FIXME: we need to inject the namespace with the values defined in exports.
+ ~a
+ return MACHINE.control.pop().label(MACHINE);
+ });
+"
+ (symbol->string name)
+ (symbol->string name)
+ (symbol->string name)
+ text
+ (get-provided-name-code bytecode))))]
+ [(SexpSource? src)
+ (error 'get-javascript-implementation)]
+ [(UninterpretedSource? src)
+ (error 'get-javascript-implementation)]))
+
+
+
+
+
+
+
;; package: Source (path -> boolean) output-port -> void
-;; Compile package for the given source program. should-follow?
-;; indicates whether we should continue following module paths.
+;; Compile package for the given source program.
+;;
+;; should-follow-children? indicates whether we should continue
+;; following module paths of a source's dependencies.
;;
;; The generated output defines a function called 'invoke' with
;; four arguments (MACHINE, SUCCESS, FAIL, PARAMS). When called, it will
;; execute the code to either run standalone expressions or
;; load in modules.
(define (package source-code
- #:should-follow? should-follow?
+ #:should-follow-children? should-follow?
#:output-port op)
+
+
+ ;; wrap-source: source -> source
+ ;; Translate all JavaScript-implemented sources into uninterpreted sources;
+ ;; we'll leave its interpretation to on-visit-src.
+ (define (wrap-source src)
+ (cond
+ [(source-is-javascript-module? src)
+ (get-javascript-implementation src)]
+ [else
+ src]))
+
+
+ (define (on-visit-src src ast stmts)
+ (cond
+ [(UninterpretedSource? src)
+ (fprintf op (UninterpretedSource-datum src))]
+ [else
+ (assemble/write-invoke stmts op)
+ (fprintf op "(MACHINE, function() { ")]))
+
+
+ (define (after-visit-src src ast stmts)
+ (cond
+ [(UninterpretedSource? src)
+ (void)]
+ [else
+ (fprintf op " }, FAIL, PARAMS);")]))
+
+
+ (define (on-last-src)
+ (fprintf op "SUCCESS();"))
+
+
(define packaging-configuration
(make-Configuration
-
+ wrap-source
+
should-follow?
;; on
- (lambda (src ast stmts)
- (assemble/write-invoke stmts op)
- (fprintf op "(MACHINE, function() { "))
+ on-visit-src
;; after
- (lambda (src ast stmts)
- (fprintf op " }, FAIL, PARAMS);"))
-
+ after-visit-src
+
;; last
- (lambda ()
- (fprintf op "SUCCESS();"))))
+ on-last-src))
(fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
@@ -90,10 +216,15 @@
;; write-runtime: output-port -> void
(define (write-runtime op)
+
+ (define (wrap-source src) src)
(let ([packaging-configuration
(make-Configuration
- ;; should-follow?
- (lambda (src p) #t)
+
+ wrap-source
+
+ ;; should-follow-children?
+ (lambda (src) #t)
;; on
(lambda (src ast stmts)
(assemble/write-invoke stmts op)
@@ -114,12 +245,19 @@
(make (list only-bootstrapped-code) packaging-configuration)
(fprintf op "})(plt.runtime.currentMachine,\nfunction(){ plt.runtime.setReadyTrue(); },\nfunction(){},\n{});\n")))
-
+
+
+(define (compress x)
+ (if (current-compress-javascript?)
+ (closure-compile x)
+ x))
+
+
(define *the-runtime*
(let ([buffer (open-output-string)])
(write-runtime buffer)
- (closure-compile
+ (compress
(get-output-string buffer))))
@@ -150,9 +288,9 @@ EOF
(define (get-code source-code)
(let ([buffer (open-output-string)])
(package source-code
- #:should-follow? (lambda (src p) #t)
+ #:should-follow-children? (lambda (src) #t)
#:output-port buffer)
- (closure-compile
+ (compress
(get-output-string buffer))))
@@ -161,14 +299,14 @@ EOF
(define (get-standalone-code source-code)
(let ([buffer (open-output-string)])
(write-standalone-code source-code buffer)
- (closure-compile
+ (compress
(get-output-string buffer))))
;; write-standalone-code: source output-port -> void
(define (write-standalone-code source-code op)
(package-anonymous source-code
- #:should-follow? (lambda (src p) #t)
+ #:should-follow-children? (lambda (src) #t)
#:output-port op)
(fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n"))
@@ -193,6 +331,8 @@ var invokeMainModule = function() {
if (console && console.log) {
console.log(e.stack || e);
}
+ MACHINE.params.currentErrorDisplayer(
+ MACHINE, $(plt.helpers.toDomNode(e.stack || e)).css('color', 'red'));
})},
function() {
// On module loading failure
diff --git a/js-assembler/runtime-src/helpers.js b/js-assembler/runtime-src/helpers.js
index 130b493..520659e 100644
--- a/js-assembler/runtime-src/helpers.js
+++ b/js-assembler/runtime-src/helpers.js
@@ -549,8 +549,8 @@ if (! this['plt']) { this['plt'] = {}; }
var makeLowLevelEqHash = function() {
- return new _Hashtable(function(x) { return getEqHashCode(x); },
- function(x, y) { return x === y; });
+ return new Hashtable(function(x) { return getEqHashCode(x); },
+ function(x, y) { return x === y; });
};
@@ -570,14 +570,15 @@ if (! this['plt']) { this['plt'] = {}; }
if (! cache) {
cache = makeLowLevelEqHash();
}
-
+ if (x === null) {
+ return "null";
+ }
if (typeof(x) === 'object') {
if (cache.containsKey(x)) {
return "...";
}
}
-
- if (x == undefined || x == null) {
+ if (x == undefined) {
return "#";
}
if (typeof(x) == 'string') {
@@ -606,12 +607,14 @@ if (! this['plt']) { this['plt'] = {}; }
if (! cache) {
cache = makeLowLevelEqHash();
}
+ if (x === null) {
+ return "null";
+ }
if (typeof(x) === 'object') {
if (cache.containsKey(x)) {
return "...";
}
}
-
if (x == undefined || x == null) {
return "#";
}
@@ -635,24 +638,74 @@ if (! this['plt']) { this['plt'] = {}; }
};
- // toDomNode: scheme-value -> dom-node
- var toDomNode = function(x, cache) {
- if (! cache) {
- cache = makeLowLevelEqHash();
+
+
+ var ToDomNodeParameters = function(params) {
+ if (! params) { params = {}; }
+ this.cache = makeLowLevelEqHash();
+ for (var k in params) {
+ if (params.hasOwnProperty(k)) {
+ this[k] = params[k];
+ }
}
+ this.objectCounter = 0;
+ };
+
+ // getMode: -> (U "print" "display" "write")
+ ToDomNodeParameters.prototype.getMode = function() {
+ if (this.mode) {
+ return this.mode;
+ }
+ return 'print';
+ };
+
+ ToDomNodeParameters.prototype.containsKey = function(x) {
+ return this.cache.containsKey(x);
+ };
+
+ ToDomNodeParameters.prototype.get = function(x) {
+ return this.cache.get(x);
+ };
+
+ ToDomNodeParameters.prototype.remove = function(x) {
+ return this.cache.remove(x);
+ };
+
+ ToDomNodeParameters.prototype.put = function(x) {
+ this.objectCounter++;
+ return this.cache.put(x, this.objectCounter);
+ };
+
+
+ // toDomNode: scheme-value -> dom-node
+ var toDomNode = function(x, params) {
+ if (params === 'write') {
+ params = new ToDomNodeParameters({'mode' : 'write'});
+ } else if (params === 'print') {
+ params = new ToDomNodeParameters({'mode' : 'print'});
+ } else if (params === 'display') {
+ params = new ToDomNodeParameters({'mode' : 'display'});
+ } else {
+ params = params || new ToDomNodeParameters({'mode' : 'display'});
+ }
if (jsnums.isSchemeNumber(x)) {
- return numberToDomNode(x);
+ return numberToDomNode(x, params);
+ }
+
+ if (x === null) {
+ var node = document.createElement("span");
+ node.appendChild(document.createTextNode("null"));
+ return node;
}
if (typeof(x) == 'object') {
- if (cache.containsKey(x)) {
+ if (params.containsKey(x)) {
var node = document.createElement("span");
- node.appendChild(document.createTextNode("..."));
+ node.appendChild(document.createTextNode("#" + params.get(x)));
return node;
}
}
-
if (x == undefined || x == null) {
var node = document.createElement("span");
node.appendChild(document.createTextNode("#"));
@@ -661,11 +714,17 @@ if (! this['plt']) { this['plt'] = {}; }
if (typeof(x) == 'string') {
var wrapper = document.createElement("span");
- wrapper.style["white-space"] = "pre";
- var node = document.createTextNode(toWrittenString(x));
+ wrapper.style["white-space"] = "pre";
+ var node;
+ if (params.getMode() === 'write' || params.getMode() === 'print') {
+ node = document.createTextNode(toWrittenString(x));
+ } else {
+ node = document.createTextNode(toDisplayedString(x));
+ }
wrapper.appendChild(node);
return wrapper;
}
+
if (typeof(x) != 'object' && typeof(x) != 'function') {
var node = document.createElement("span");
node.appendChild(document.createTextNode(x.toString()));
@@ -676,22 +735,23 @@ if (! this['plt']) { this['plt'] = {}; }
if (x.nodeType) {
returnVal = x;
} else if (typeof(x.toDomNode) !== 'undefined') {
- returnVal = x.toDomNode(cache);
- } else if (typeof(x.toWrittenString) !== 'undefined') {
-
+ returnVal = x.toDomNode(params);
+ } else if (params.getMode() === 'write' &&
+ typeof(x.toWrittenString) !== 'undefined') {
var node = document.createElement("span");
- node.appendChild(document.createTextNode(x.toWrittenString(cache)));
+ node.appendChild(document.createTextNode(x.toWrittenString(params)));
returnVal = node;
- } else if (typeof(x.toDisplayedString) !== 'undefined') {
+ } else if (params.getMode() === 'display' &&
+ typeof(x.toDisplayedString) !== 'undefined') {
var node = document.createElement("span");
- node.appendChild(document.createTextNode(x.toDisplayedString(cache)));
+ node.appendChild(document.createTextNode(x.toDisplayedString(params)));
returnVal = node;
} else {
var node = document.createElement("span");
node.appendChild(document.createTextNode(x.toString()));
returnVal = node;
}
- cache.remove(x);
+ params.remove(x);
return returnVal;
};
@@ -699,7 +759,7 @@ if (! this['plt']) { this['plt'] = {}; }
// numberToDomNode: jsnum -> dom
// Given a jsnum, produces a dom-node representation.
- var numberToDomNode = function(n) {
+ var numberToDomNode = function(n, params) {
var node;
if (jsnums.isExact(n)) {
if (jsnums.isInteger(n)) {
@@ -726,16 +786,49 @@ if (! this['plt']) { this['plt'] = {}; }
// rationalToDomNode: rational -> dom-node
var rationalToDomNode = function(n) {
- var node = document.createElement("span");
+ var repeatingDecimalNode = document.createElement("span");
var chunks = jsnums.toRepeatingDecimal(jsnums.numerator(n),
- jsnums.denominator(n));
- node.appendChild(document.createTextNode(chunks[0] + '.'))
- node.appendChild(document.createTextNode(chunks[1]));
- var overlineSpan = document.createElement("span");
- overlineSpan.style.textDecoration = 'overline';
- overlineSpan.appendChild(document.createTextNode(chunks[2]));
- node.appendChild(overlineSpan);
- return node;
+ jsnums.denominator(n),
+ {limit: 25});
+ repeatingDecimalNode.appendChild(document.createTextNode(chunks[0] + '.'))
+ repeatingDecimalNode.appendChild(document.createTextNode(chunks[1]));
+ if (chunks[2] === '...') {
+ repeatingDecimalNode.appendChild(
+ document.createTextNode(chunks[2]));
+ } else if (chunks[2] !== '0') {
+ var overlineSpan = document.createElement("span");
+ overlineSpan.style.textDecoration = 'overline';
+ overlineSpan.appendChild(document.createTextNode(chunks[2]));
+ repeatingDecimalNode.appendChild(overlineSpan);
+ }
+
+
+ var fractionalNode = document.createElement("span");
+ var numeratorNode = document.createElement("sup");
+ numeratorNode.appendChild(document.createTextNode(String(jsnums.numerator(n))));
+ var denominatorNode = document.createElement("sub");
+ denominatorNode.appendChild(document.createTextNode(String(jsnums.denominator(n))));
+ fractionalNode.appendChild(numeratorNode);
+ fractionalNode.appendChild(document.createTextNode("/"));
+ fractionalNode.appendChild(denominatorNode);
+
+
+ var numberNode = document.createElement("span");
+ numberNode.appendChild(repeatingDecimalNode);
+ numberNode.appendChild(fractionalNode);
+ fractionalNode.style['display'] = 'none';
+
+ var showingRepeating = true;
+
+ numberNode.onclick = function(e) {
+ showingRepeating = !showingRepeating;
+ repeatingDecimalNode.style['display'] =
+ (showingRepeating ? 'inline' : 'none')
+ fractionalNode.style['display'] =
+ (!showingRepeating ? 'inline' : 'none')
+ };
+ numberNode.style['cursor'] = 'pointer';
+ return numberNode;
}
@@ -743,6 +836,62 @@ if (! this['plt']) { this['plt'] = {}; }
+ var escapeString = function(s) {
+ return '"' + replaceUnprintableStringChars(s) + '"';
+ };
+
+ var replaceUnprintableStringChars = function(s) {
+ var ret = [];
+ for (var i = 0; i < s.length; i++) {
+ var val = s.charCodeAt(i);
+ switch(val) {
+ case 7: ret.push('\\a'); break;
+ case 8: ret.push('\\b'); break;
+ case 9: ret.push('\\t'); break;
+ case 10: ret.push('\\n'); break;
+ case 11: ret.push('\\v'); break;
+ case 12: ret.push('\\f'); break;
+ case 13: ret.push('\\r'); break;
+ case 34: ret.push('\\"'); break;
+ case 92: ret.push('\\\\'); break;
+ default: if (val >= 32 && val <= 126) {
+ ret.push( s.charAt(i) );
+ }
+ else {
+ var numStr = val.toString(16).toUpperCase();
+ while (numStr.length < 4) {
+ numStr = '0' + numStr;
+ }
+ ret.push('\\u' + numStr);
+ }
+ break;
+ }
+ }
+ return ret.join('');
+ };
+
+
+
+
+
+
+ // clone: object -> object
+ // Copies an object. The new object should respond like the old
+ // object, including to things like instanceof
+ var clone = function(obj) {
+ var C = function() {}
+ C.prototype = obj;
+ var c = new C();
+ for (property in obj) {
+ if (obj.hasOwnProperty(property)) {
+ c[property] = obj[property];
+ }
+ }
+ return c;
+ };
+
+
+
@@ -783,15 +932,16 @@ if (! this['plt']) { this['plt'] = {}; }
helpers.makeLowLevelEqHash = makeLowLevelEqHash;
helpers.heir = heir;
-
-
-
-
+ helpers.escapeString = escapeString;
helpers.toWrittenString = toWrittenString;
helpers.toDisplayedString = toDisplayedString;
- helpers.toDomNode = toDomNode;
+ helpers.toDomNode = toDomNode;
+ helpers.ToDomNodeParameters = ToDomNodeParameters;
+
+ helpers.clone = clone;
+
scope.link.announceReady('helpers');
})(this['plt']);
diff --git a/js-assembler/runtime-src/primitives.js b/js-assembler/runtime-src/primitives.js
index 208b799..207c522 100644
--- a/js-assembler/runtime-src/primitives.js
+++ b/js-assembler/runtime-src/primitives.js
@@ -195,7 +195,7 @@ That way, we can do a simple grep.
var length = function(lst) {
checkList(lst, 'length', 1, [lst]);
var ret = 0;
- for (; !lst.isEmpty(); lst = lst.rest()) {
+ for (; !lst.isEmpty(); lst = lst.rest) {
ret = ret+1;
}
return ret;
@@ -224,8 +224,8 @@ That way, we can do a simple grep.
var fArgs = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
- fArgs.push(args[i].first());
- argsRest.push(args[i].rest());
+ fArgs.push(args[i].first);
+ argsRest.push(args[i].rest);
}
fArgs.push(acc);
return CALL(f, fArgs,
@@ -246,20 +246,20 @@ That way, we can do a simple grep.
}
var compYes = new PrimProc('compYes', 1, false, false,
- function(x) { return CALL(comp, [x, lst.first()], id); });
+ function(x) { return CALL(comp, [x, lst.first], id); });
var compNo = new PrimProc('compNo', 1, false, false,
- function(x) { return CALL(comp, [x, lst.first()],
+ function(x) { return CALL(comp, [x, lst.first],
function(res) { return !res; });
});
return CALL(PRIMITIVES['filter'],
- [compYes, lst.rest()],
+ [compYes, lst.rest],
quicksortHelp(function(sorted1) {
return CALL(PRIMITIVES['filter'],
- [compNo, lst.rest()],
+ [compNo, lst.rest],
quicksortHelp(function(sorted2) {
return k( append([sorted1,
- types.list([lst.first()]),
+ types.list([lst.first]),
sorted2]) );
}));
}));
@@ -487,7 +487,7 @@ That way, we can do a simple grep.
var isAssocList = function(x) {
- return isPair(x) && isPair(x.rest()) && isEmpty(x.rest().rest());
+ return isPair(x) && isPair(x.rest) && isEmpty(x.rest.rest);
};
@@ -725,8 +725,8 @@ That way, we can do a simple grep.
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
- argsFirst.push(args[i].first());
- argsRest.push(args[i].rest());
+ argsFirst.push(args[i].first);
+ argsRest.push(args[i].rest);
}
return CALL(f, argsFirst,
@@ -1109,11 +1109,11 @@ That way, we can do a simple grep.
return CALL(new PrimProc('', 1, false, false,
function(args) {
- return callWithValues(fList.first(), args);
+ return callWithValues(fList.first, args);
}),
[x],
function(result) {
- return composeHelp(result, fList.rest());
+ return composeHelp(result, fList.rest);
});
}
return new PrimProc('', 0, true, false,
@@ -2032,9 +2032,9 @@ That way, we can do a simple grep.
var nextResult = parse(child);
if (isString(nextResult) &&
!result.isEmpty() &&
- isString(result.first())) {
- result = types.cons(result.first() + nextResult,
- result.rest());
+ isString(result.first)) {
+ result = types.cons(result.first + nextResult,
+ result.rest);
} else {
result = types.cons(nextResult, result);
}
@@ -2219,7 +2219,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, isPair, 'car', 'pair', 1);
- return lst.first();
+ return lst.first;
});
PRIMITIVES['cdr'] =
@@ -2228,7 +2228,7 @@ That way, we can do a simple grep.
false, false,
function (lst) {
check(lst, isPair, 'cdr', 'pair', 1);
- return lst.rest();
+ return lst.rest;
});
PRIMITIVES['caar'] =
@@ -2236,9 +2236,9 @@ That way, we can do a simple grep.
1,
false, false,
function(lst) {
- check(lst, function(x) { return (isPair(x) && isPair(x.first())); },
+ check(lst, function(x) { return (isPair(x) && isPair(x.first)); },
'caar', 'caarable value', 1);
- return lst.first().first();
+ return lst.first.first;
});
PRIMITIVES['cadr'] =
@@ -2246,9 +2246,9 @@ That way, we can do a simple grep.
1,
false, false,
function(lst) {
- check(lst, function(x) { return isPair(x) && isPair(x.rest()); },
+ check(lst, function(x) { return isPair(x) && isPair(x.rest); },
'cadr', 'cadrable value', 1);
- return lst.rest().first();
+ return lst.rest.first;
});
PRIMITIVES['cdar'] =
@@ -2256,9 +2256,9 @@ That way, we can do a simple grep.
1,
false, false,
function(lst) {
- check(lst, function(x) { return isPair(x) && isPair(x.first()); },
+ check(lst, function(x) { return isPair(x) && isPair(x.first); },
'cdar', 'cdarable value', 1);
- return lst.first().rest();
+ return lst.first.rest;
});
PRIMITIVES['cddr'] =
@@ -2266,9 +2266,9 @@ That way, we can do a simple grep.
1,
false, false,
function(lst) {
- check(lst, function(x) { return isPair(x) && isPair(x.rest()); },
+ check(lst, function(x) { return isPair(x) && isPair(x.rest); },
'cddr', 'cddrable value', 1);
- return lst.rest().rest();
+ return lst.rest.rest;
});
PRIMITIVES['caaar'] =
@@ -2277,10 +2277,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.first()) &&
- isPair(x.first().first()) ); },
+ isPair(x.first) &&
+ isPair(x.first.first) ); },
'caaar', 'caaarable value', 1);
- return lst.first().first().first();
+ return lst.first.first.first;
});
PRIMITIVES['caadr'] =
@@ -2289,10 +2289,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.rest()) &&
- isPair(x.rest().first()) ); },
+ isPair(x.rest) &&
+ isPair(x.rest.first) ); },
'caadr', 'caadrable value', 1);
- return lst.rest().first().first();
+ return lst.rest.first.first;
});
PRIMITIVES['cadar'] =
@@ -2301,10 +2301,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.first()) &&
- isPair(x.first().rest()) ); },
+ isPair(x.first) &&
+ isPair(x.first.rest) ); },
'cadar', 'cadarable value', 1);
- return lst.first().rest().first();
+ return lst.first.rest.first;
});
PRIMITIVES['cdaar'] =
@@ -2313,10 +2313,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.first()) &&
- isPair(x.first().first()) ); },
+ isPair(x.first) &&
+ isPair(x.first.first) ); },
'cdaar', 'cdaarable value', 1);
- return lst.first().first().rest();
+ return lst.first.first.rest;
});
PRIMITIVES['cdadr'] =
@@ -2325,10 +2325,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.rest()) &&
- isPair(x.rest().first()) ); },
+ isPair(x.rest) &&
+ isPair(x.rest.first) ); },
'cdadr', 'cdadrable value', 1);
- return lst.rest().first().rest();
+ return lst.rest.first.rest;
});
PRIMITIVES['cddar'] =
@@ -2337,10 +2337,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.first()) &&
- isPair(x.first().rest()) ); },
+ isPair(x.first) &&
+ isPair(x.first.rest) ); },
'cddar', 'cddarable value', 1);
- return lst.first().rest().rest();
+ return lst.first.rest.rest;
});
PRIMITIVES['caddr'] =
@@ -2349,10 +2349,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.rest()) &&
- isPair(x.rest().rest()) ); },
+ isPair(x.rest) &&
+ isPair(x.rest.rest) ); },
'caddr', 'caddrable value', 1);
- return lst.rest().rest().first();
+ return lst.rest.rest.first;
});
PRIMITIVES['cdddr'] =
@@ -2361,10 +2361,10 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.rest()) &&
- isPair(x.rest().rest()) ); },
+ isPair(x.rest) &&
+ isPair(x.rest.rest) ); },
'cdddr', 'cdddrable value', 1);
- return lst.rest().rest().rest();
+ return lst.rest.rest.rest;
});
PRIMITIVES['cadddr'] =
@@ -2373,11 +2373,11 @@ That way, we can do a simple grep.
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
- isPair(x.rest()) &&
- isPair(x.rest().rest()) &&
- isPair(x.rest().rest().rest()) ); },
+ isPair(x.rest) &&
+ isPair(x.rest.rest) &&
+ isPair(x.rest.rest.rest) ); },
'cadddr', 'cadddrable value', 1);
- return lst.rest().rest().rest().first();
+ return lst.rest.rest.rest.first;
});
@@ -2388,7 +2388,7 @@ That way, we can do a simple grep.
function(lst) {
check(lst, function(x) { return isList(x) && !isEmpty(x); },
'rest', 'non-empty list', 1);
- return lst.rest();
+ return lst.rest;
});
PRIMITIVES['first'] =
@@ -2398,7 +2398,7 @@ That way, we can do a simple grep.
function(lst) {
check(lst, function(x) { return isList(x) && !isEmpty(x); },
'first', 'non-empty list', 1);
- return lst.first();
+ return lst.first;
});
PRIMITIVES['second'] =
@@ -2407,7 +2407,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 2, 'second', 1);
- return lst.rest().first();
+ return lst.rest.first;
});
PRIMITIVES['third'] =
@@ -2416,7 +2416,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 3, 'third', 1);
- return lst.rest().rest().first();
+ return lst.rest.rest.first;
});
PRIMITIVES['fourth'] =
@@ -2425,7 +2425,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 4, 'fourth', 1);
- return lst.rest().rest().rest().first();
+ return lst.rest.rest.rest.first;
});
PRIMITIVES['fifth'] =
@@ -2434,7 +2434,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 5, 'fifth', 1);
- return lst.rest().rest().rest().rest().first();
+ return lst.rest.rest.rest.rest.first;
});
PRIMITIVES['sixth'] =
@@ -2443,7 +2443,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 6, 'sixth', 1);
- return lst.rest().rest().rest().rest().rest().first();
+ return lst.rest.rest.rest.rest.rest.first;
});
PRIMITIVES['seventh'] =
@@ -2453,7 +2453,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 7, 'seventh', 1);
- return lst.rest().rest().rest().rest().rest().rest().first();
+ return lst.rest.rest.rest.rest.rest.rest.first;
});
PRIMITIVES['eighth'] =
@@ -2462,7 +2462,7 @@ That way, we can do a simple grep.
false, false,
function(lst) {
checkListOfLength(lst, 8, 'eighth', 1);
- return lst.rest().rest().rest().rest().rest().rest().rest().first();
+ return lst.rest.rest.rest.rest.rest.rest.rest.first;
});
@@ -2536,7 +2536,7 @@ That way, we can do a simple grep.
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
- lst = lst.rest();
+ lst = lst.rest;
}
@@ -2548,7 +2548,7 @@ That way, we can do a simple grep.
msg,
[]) );
}
- return lst.first();
+ return lst.first;
});
PRIMITIVES['list-tail'] =
@@ -2578,7 +2578,7 @@ That way, we can do a simple grep.
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
- lst = lst.rest();
+ lst = lst.rest;
}
return lst;
});
@@ -2622,8 +2622,8 @@ That way, we can do a simple grep.
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
- argsFirst.push(args[i].first());
- argsRest.push(args[i].rest());
+ argsFirst.push(args[i].first);
+ argsRest.push(args[i].rest);
}
var result = CALL(f, argsFirst,
function(result) {
@@ -2658,8 +2658,8 @@ That way, we can do a simple grep.
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
- argsFirst.push(args[i].first());
- argsRest.push(args[i].rest());
+ argsFirst.push(args[i].first);
+ argsRest.push(args[i].rest);
}
return CALL(f, argsFirst,
@@ -2699,8 +2699,8 @@ That way, we can do a simple grep.
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
- argsFirst.push(args[i].first());
- argsRest.push(args[i].rest());
+ argsFirst.push(args[i].first);
+ argsRest.push(args[i].rest);
}
return CALL(f, argsFirst,
@@ -2734,10 +2734,10 @@ That way, we can do a simple grep.
}
while ( !lst.isEmpty() ) {
- if ( isEq(item, lst.first()) ) {
+ if ( isEq(item, lst.first) ) {
return lst;
}
- lst = lst.rest();
+ lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('memq: not a proper list: ' +
helpers.toDisplayedString(origList));
@@ -2764,10 +2764,10 @@ That way, we can do a simple grep.
[]) );
}
while ( !lst.isEmpty() ) {
- if ( isEqv(item, lst.first()) ) {
+ if ( isEqv(item, lst.first) ) {
return lst;
}
- lst = lst.rest();
+ lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('memv: not a proper list: ' +
helpers.toDisplayedString(origList));
@@ -2795,10 +2795,10 @@ That way, we can do a simple grep.
[]) );
}
while ( !lst.isEmpty() ) {
- if ( isEqual(item, lst.first()) ) {
+ if ( isEqual(item, lst.first) ) {
return lst;
}
- lst = lst.rest();
+ lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('member: not a proper list: ' +
@@ -2825,12 +2825,12 @@ That way, we can do a simple grep.
return false;
}
- return CALL(f, [lst.first()],
+ return CALL(f, [lst.first],
function(result) {
if (result) {
return lst;
}
- return memfHelp(lst.rest());
+ return memfHelp(lst.rest);
});
}
return memfHelp(initList);
@@ -2852,18 +2852,18 @@ That way, we can do a simple grep.
[]) );
}
while ( !lst.isEmpty() ) {
- if (! isPair(lst.first())) {
+ if (! isPair(lst.first)) {
var msg = ('assq: non-pair found in list: ' +
- helpers.toDisplayedString(lst.first()) +' in ' +
+ helpers.toDisplayedString(lst.first) +' in ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
- if ( isEq(item, lst.first().first()) ) {
- return lst.first();
+ if ( isEq(item, lst.first.first) ) {
+ return lst.first;
}
- lst = lst.rest();
+ lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assq: not a proper list: ' +
@@ -2892,18 +2892,18 @@ That way, we can do a simple grep.
[]) );
}
while ( !lst.isEmpty() ) {
- if (! isPair(lst.first())) {
+ if (! isPair(lst.first)) {
var msg = ('assv: non-pair found in list: ' +
- helpers.toDisplayedString(lst.first()) +' in ' +
+ helpers.toDisplayedString(lst.first) +' in ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
- if ( isEqv(item, lst.first().first()) ) {
- return lst.first();
+ if ( isEqv(item, lst.first.first) ) {
+ return lst.first;
}
- lst = lst.rest();
+ lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assv: not a proper list: ' +
helpers.toDisplayedString(origList));
@@ -2931,18 +2931,18 @@ That way, we can do a simple grep.
[]) );
}
while ( !lst.isEmpty() ) {
- if (! isPair(lst.first())) {
+ if (! isPair(lst.first)) {
var msg = ('assoc: non-pair found in list: ' +
- helpers.toDisplayedString(lst.first()) +' in ' +
+ helpers.toDisplayedString(lst.first) +' in ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
- if ( isEqual(item, lst.first().first()) ) {
- return lst.first();
+ if ( isEqual(item, lst.first.first) ) {
+ return lst.first;
}
- lst = lst.rest();
+ lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assoc: not a proper list: ' +
@@ -2965,11 +2965,11 @@ That way, we can do a simple grep.
var originalLst = lst;
var result = types.EMPTY;
while ( !lst.isEmpty() ) {
- if ( isEqual(item, lst.first()) ) {
- return append([result.reverse(), lst.rest()]);
+ if ( isEqual(item, lst.first) ) {
+ return append([result.reverse(), lst.rest]);
} else {
- result = types.cons(lst.first(), result);
- lst = lst.rest();
+ result = types.cons(lst.first, result);
+ lst = lst.rest;
}
}
return originalLst;
@@ -2989,14 +2989,14 @@ That way, we can do a simple grep.
return acc.reverse();
}
- return CALL(f, [lst.first()],
+ return CALL(f, [lst.first],
function(result) {
if (result) {
- return filterHelp(f, lst.rest(),
- types.cons(lst.first(), acc));
+ return filterHelp(f, lst.rest,
+ types.cons(lst.first, acc));
}
else {
- return filterHelp(f, lst.rest(), acc);
+ return filterHelp(f, lst.rest, acc);
}
});
}
@@ -3055,22 +3055,22 @@ That way, we can do a simple grep.
return curMaxElt;
}
- return CALL(f, [lst.first()],
+ return CALL(f, [lst.first],
function(result) {
check(result, isReal, 'argmax',
'procedure that returns real numbers', 1, args);
if (jsnums.greaterThan(result, curMaxVal)) {
- return argmaxHelp(lst.rest(), result, lst.first());
+ return argmaxHelp(lst.rest, result, lst.first);
}
else {
- return argmaxHelp(lst.rest(), curMaxVal, curMaxElt);
+ return argmaxHelp(lst.rest, curMaxVal, curMaxElt);
}
});
}
- return CALL(f, [initList.first()],
+ return CALL(f, [initList.first],
function(result) {
check(result, isReal, 'argmax', 'procedure that returns real numbers', 1, args);
- return argmaxHelp(initList.rest(), result, initList.first());
+ return argmaxHelp(initList.rest, result, initList.first);
});
});
@@ -3089,22 +3089,22 @@ That way, we can do a simple grep.
return curMaxElt;
}
- return CALL(f, [lst.first()],
+ return CALL(f, [lst.first],
function(result) {
check(result, isReal, 'argmin',
'procedure that returns real numbers', 1, args);
if (jsnums.lessThan(result, curMaxVal)) {
- return argminHelp(lst.rest(), result, lst.first());
+ return argminHelp(lst.rest, result, lst.first);
}
else {
- return argminHelp(lst.rest(), curMaxVal, curMaxElt);
+ return argminHelp(lst.rest, curMaxVal, curMaxElt);
}
});
}
- return CALL(f, [initList.first()],
+ return CALL(f, [initList.first],
function(result) {
check(result, isReal, 'argmin', 'procedure that returns real numbers', 1, args);
- return argminHelp(initList.rest(), result, initList.first());
+ return argminHelp(initList.rest, result, initList.first);
});
});
@@ -3614,8 +3614,8 @@ That way, we can do a simple grep.
var ret = [];
while( !lst.isEmpty() ) {
- ret.push(lst.first().val);
- lst = lst.rest();
+ ret.push(lst.first.val);
+ lst = lst.rest;
}
return types.string(ret);
});
@@ -3728,8 +3728,8 @@ That way, we can do a simple grep.
'implode', 'list of 1-letter strings', 1);
var ret = [];
while ( !lst.isEmpty() ) {
- ret.push( lst.first().toString() );
- lst = lst.rest();
+ ret.push( lst.first.toString() );
+ lst = lst.rest;
}
return types.string(ret);
});
@@ -4139,8 +4139,8 @@ That way, we can do a simple grep.
var ret = [];
while ( !lst.isEmpty() ) {
- ret.push(lst.first());
- lst = lst.rest();
+ ret.push(lst.first);
+ lst = lst.rest;
}
return types.bytes(ret, true);
});
diff --git a/js-assembler/runtime-src/runtime.js b/js-assembler/runtime-src/runtime.js
index 282b085..e1cf282 100644
--- a/js-assembler/runtime-src/runtime.js
+++ b/js-assembler/runtime-src/runtime.js
@@ -8,16 +8,10 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var runtime = {};
scope['runtime'] = runtime;
+ var helpers = plt.helpers;
+ var types = plt.types;
- // Type helpers
- //
- // Defines inheritance between prototypes.
- var heir = function(parentPrototype) {
- var f = function() {}
- f.prototype = parentPrototype;
- return new f();
- };
// Consumes a class and creates a predicate that recognizes subclasses.
var makeClassPredicate = function(aClass) {
@@ -25,27 +19,35 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
};
- var isNumber = jsnums.isSchemeNumber;
- var isNatural = function(x) { return (jsnums.isInteger(x) &&
- jsnums.greaterThanOrEqual(x, 0)); }
- var isPair = function(x) { return (typeof(x) == 'object' &&
- x.length === 2 &&
- x.type !== 'vector') };
- var isList = function(x) {
- while (x !== NULL) {
- if (typeof(x) == 'object' && x.length === 2) {
- x = x[1];
- } else {
- return false;
- }
- }
- return true;
- };
- var isVector = function(x) { return (typeof(x) == 'object' &&
- x.type === 'vector') };
+
+ //////////////////////////////////////////////////////////////////////
+ //////////////////////////////////////////////////////////////////////
+ // We try to isolate the effect of external modules: all the identifiers we
+ // pull from external modules should be listed here, and should otherwise not
+ // show up outside this section!
+ var isNumber = types.isNumber;
+ var isNatural = types.isNatural;
+ var isPair = types.isPair;
+ var isList = types.isList;
+ var isVector = types.isVector;
+ var NULL = types.EMPTY;
+ var VOID = types.VOID;
+
+ var makeVector = types.vector;
+ var makeList = types.list;
+ var makePair = types.pair;
+
+ var heir = helpers.heir;
+ var toDomNode = helpers.toDomNode;
+ var toWrittenString = helpers.toWrittenString;
+ var toDisplayedString = helpers.toDisplayedString;
+ //////////////////////////////////////////////////////////////////////]
+
+
+
// This value will be dynamically determined.
@@ -67,13 +69,25 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
// currentDisplayer: DomNode -> Void
// currentDisplayer is responsible for displaying to the browser.
- 'currentDisplayer': function(v) {
- $(document.body).append(v);
+ 'currentDisplayer': function(MACHINE, domNode) {
+ $(domNode).appendTo(document.body);
},
+ // currentErrorDisplayer: DomNode -> Void
+ // currentErrorDisplayer is responsible for displaying errors to the browser.
+ 'currentErrorDisplayer': function(MACHINE, domNode) {
+ $(domNode).appendTo(document.body);
+ },
+
+
'currentOutputPort': new StandardOutputPort(),
+ 'currentErrorPort': new StandardErrorPort(),
'currentSuccessHandler': function(MACHINE) {},
- 'currentErrorHandler': function(MACHINE, exn) {},
+ 'currentErrorHandler': function(MACHINE, exn) {
+ MACHINE.params.currentErrorDisplayer(
+ MACHINE,
+ exn);
+ },
'currentNamespace': {},
@@ -99,9 +113,9 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var elt = MACHINE.env.pop();
var outputPort =
MACHINE.params.currentOutputPort;
- if (elt !== undefined) {
- outputPort.write(MACHINE, elt);
- outputPort.write(MACHINE, "\n");
+ if (elt !== VOID) {
+ outputPort.writeDomNode(MACHINE, toDomNode(elt, 'print'));
+ outputPort.writeDomNode(MACHINE, toDomNode("\n", 'display'));
}
var frame = MACHINE.control.pop();
return frame.label(MACHINE);
@@ -166,6 +180,9 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
};
+
+
+
// A generic frame just holds marks.
var Frame = function() {
// The set of continuation marks.
@@ -218,31 +235,30 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
-
-
-
+ // Output Ports
var OutputPort = function() {};
var isOutputPort = makeClassPredicate(OutputPort);
- var StandardOutputPort = function() {};
- StandardOutputPort.prototype = heir(OutputPort.prototype);
- StandardOutputPort.prototype.write = function(MACHINE, v) {
- var domNode;
- // TODO: v must be coerced into a DOMNode in a more systematic way.
- // This function may need to be a Closure.
- if(typeof(v) === 'string' ||
- typeof(v) === 'number' ||
- typeof(v) === 'boolean' ||
- typeof(v) === 'null' ||
- typeof(v) === 'undefined') {
- domNode = $('').text(String(v)).css('white-space', 'pre');
- } else {
- domNode = $('').text(String(v)).css('white-space', 'pre');
- }
- MACHINE.params['currentDisplayer'](domNode);
+ var StandardOutputPort = function() {
+ OutputPort.call(this);
};
+ StandardOutputPort.prototype = heir(OutputPort.prototype);
+ StandardOutputPort.prototype.writeDomNode = function(MACHINE, domNode) {
+ MACHINE.params['currentDisplayer'](MACHINE, domNode);
+ };
+
+ var StandardErrorPort = function() {
+ OutputPort.call(this);
+ };
+ StandardErrorPort.prototype = heir(OutputPort.prototype);
+ StandardErrorPort.prototype.writeDomNode = function(MACHINE, domNode) {
+ MACHINE.params['currentErrorDisplayer'](MACHINE, domNode);
+ };
+
+
+
@@ -250,8 +266,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
this.buf = [];
};
OutputStringPort.prototype = heir(OutputPort.prototype);
- OutputStringPort.prototype.write = function(MACHINE, v) {
- this.buf.push(String(v));
+ OutputStringPort.prototype.writeDomNode = function(MACHINE, v) {
+ this.buf.push($(v).text());
};
OutputStringPort.prototype.getOutputString = function() {
return this.buf.join('');
@@ -310,7 +326,6 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
new ContinuationPromptTag("default-continuation-prompt-tag");
- var NULL = [];
var raise = function(MACHINE, e) {
@@ -348,7 +363,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
if (observed < minimum || observed > maximum) {
raise(MACHINE, new Error(callerName + ": expected at least " + minimum
+ " arguments "
- + " but received " + observer));
+ + " but received " + observed));
}
};
@@ -366,7 +381,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
raise(MACHINE,
new Error(callerName + ": expected " + expectedTypeName
+ " as argument " + (argumentOffset + 1)
- + " but received " + actualValue));
+ + " but received " + helpers.toWrittenString(actualValue)));
};
var raiseContextExpectedValuesError = function(MACHINE, expected) {
@@ -378,23 +393,23 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var raiseArityMismatchError = function(MACHINE, proc, expected, received) {
raise(MACHINE,
- new Error("expected " + expected + " values, received " + received + " values"));
+ new Error(proc.displayName + ": " + "expected " + expected
+ + " value(s), received " + received + " value(s)"));
};
var raiseOperatorApplicationError = function(MACHINE, operator) {
raise(MACHINE,
- new Error("not a procedure: " + expected +
- operator));
+ new Error("not a procedure: " + helpers.toWrittenString(operator)));
};
var raiseOperatorIsNotClosure = function(MACHINE, operator) {
raise(MACHINE,
- new Error("not a closure: " + operator));
+ new Error("not a closure: " + helpers.toWrittenString(operator)));
};
var raiseOperatorIsNotPrimitiveProcedure = function(MACHINE, operator) {
raise(MACHINE,
- new Error("not a primitive procedure: " + operator));
+ new Error("not a primitive procedure: " + helpers.toWrittenString(operator)));
};
@@ -448,8 +463,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var lst = MACHINE.env[MACHINE.env.length - 1 - depth];
var vals = [];
while(lst !== NULL) {
- vals.push(lst[0]);
- lst = lst[1];
+ vals.push(lst.first);
+ lst = lst.rest;
}
vals.reverse();
MACHINE.env.splice.apply(MACHINE.env,
@@ -462,7 +477,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var lst = NULL;
var i;
for (i = 0; i < length; i++) {
- lst = [MACHINE.env[MACHINE.env.length - depth - length + i], lst];
+ lst = makePair(MACHINE.env[MACHINE.env.length - depth - length + i],
+ lst);
}
MACHINE.env.splice(MACHINE.env.length - depth - length,
length,
@@ -488,12 +504,12 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
return n >= arity.value;
} else {
while (arity !== NULL) {
- if (typeof(arity[0]) === 'number') {
- if (arity[0] === n) { return true; }
+ if (typeof(arity.first) === 'number') {
+ if (arity.first === n) { return true; }
} else if (arity instanceof ArityAtLeast) {
- if (n >= arity[0].value) { return true; }
+ if (n >= arity.first.value) { return true; }
}
- arity = arity[1];
+ arity = arity.rest;
}
return false;
}
@@ -508,129 +524,119 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
// are coded here; several of them (including call/cc) are injected by
// the bootstrapping code.
var Primitives = {};
- Primitives['display'] = function(MACHINE) {
- var firstArg = MACHINE.env[MACHINE.env.length-1];
- var outputPort = MACHINE.params.currentOutputPort;
- if (MACHINE.argcount === 2) {
- testArgument(MACHINE,
- 'isOutputPort',
- isOutputPort,
- MACHINE.env.length-2,
- 1,
- 'display');
- outputPort = MACHINE.env[MACHINE.env.length-2];
- }
- outputPort.write(MACHINE, firstArg);
+
+ var installPrimitiveProcedure = function(name, arity, f) {
+ Primitives[name] = f;
+ Primitives[name].arity = arity;
+ Primitives[name].displayName = name;
};
- Primitives['display'].arity = [1, [2, NULL]];
- Primitives['display'].displayName = 'display';
-
- Primitives['newline'] = function(MACHINE) {
- var outputPort = MACHINE.params.currentOutputPort;
- if (MACHINE.argcount === 1) {
- testArgument(MACHINE,
- 'isOutputPort',
- isOutputPort,
- MACHINE.env.length-1,
- 1,
- 'newline');
- outputPort = MACHINE.env[MACHINE.env.length-1];
- }
- outputPort.write(MACHINE, "\n");
+ var makePrimitiveProcedure = function(name, arity, f) {
+ f.arity = arity;
+ f.displayName = name;
+ return f;
};
- Primitives['newline'].arity = [0, [1, NULL]];
- Primitives['newline'].displayName = 'newline';
-
- Primitives['displayln'] = function(MACHINE){
- var firstArg = MACHINE.env[MACHINE.env.length-1];
- var outputPort = MACHINE.params.currentOutputPort;
- if (MACHINE.argcount === 2) {
- testArgument(MACHINE,
- 'isOutputPort',
- isOutputPort,
- MACHINE.env.length-2,
- 1,
- 'displayln');
- outputPort = MACHINE.env[MACHINE.env.length-2];
- }
- outputPort.write(MACHINE, firstArg);
- outputPort.write(MACHINE, "\n");
+ var installPrimitiveConstant = function(name, v) {
+ Primitives[name] = v;
};
- Primitives['displayln'].arity = [1, [2, NULL]];
- Primitives['displayln'].displayName = 'displayln';
+ installPrimitiveConstant('pi', jsnums.pi);
+ installPrimitiveConstant('e', jsnums.e);
- Primitives['current-print'] = function(MACHINE) {
- return MACHINE.params['current-print'];
- };
- Primitives['current-print'].arity = [0, [1, NULL]];
- Primitives['current-print'].displayName = "current-print";
-
-
-// // This should be attached to the module corresponding for print-values
-// Primitives['print-values'] = new Closure(
-// function(MACHINE) {
-// var outputPort = MACHINE.params.currentOutputPort;
-// var prependNewline = false;
-// if (MACHINE.argcount > 0) {
-// if (MACHINE.val !== undefined) {
-// if (prependNewline) {
-// outputPort.write(MACHINE, "\n");
-// }
-// outputPort.write(MACHINE, MACHINE.val);
-// prependNewline = true;
-// }
-
-// for(var i = 0; i < MACHINE.argcount - 1; i++) {
-// if (MACHINE.env[MACHINE.env.length - 1 - i] !== undefined) {
-// if (prependNewline) {
-// outputPort.write(MACHINE, "\n");
-// }
-// outputPort.write(MACHINE,
-// MACHINE.env[MACHINE.env.length - 1 - i]);
-// prependNewline = true;
-// }
-// }
-// outputPort.write(MACHINE, "\n");
-// }
-// MACHINE.env.length = MACHINE.env.length - MACHINE.argcount;
-// var frame = MACHINE.control.pop();
-// return frame.label(MACHINE);
-// },
-// new ArityAtLeast(0),
-// [],
-// "print-values"
-// );
-
-
-
- Primitives['pi'] = jsnums.pi;
-
- Primitives['e'] = jsnums.e;
-
- Primitives['='] = function(MACHINE) {
- var firstArg = MACHINE.env[MACHINE.env.length-1];
- testArgument(MACHINE, 'number', isNumber, firstArg, 0, '=');
- for (var i = 0; i < MACHINE.argcount - 1; i++) {
- testArgument(MACHINE,
- 'number',
- isNumber,
- MACHINE.env[MACHINE.env.length - 1 - i],
- i,
- '=');
- if (! (jsnums.equals(MACHINE.env[MACHINE.env.length - 1 - i],
- MACHINE.env[MACHINE.env.length - 1 - i - 1]))) {
- return false;
+ installPrimitiveProcedure(
+ 'display', makeList(1, 2),
+ function(MACHINE) {
+ var firstArg = MACHINE.env[MACHINE.env.length-1];
+ var outputPort = MACHINE.params.currentOutputPort;
+ if (MACHINE.argcount === 2) {
+ testArgument(MACHINE,
+ 'isOutputPort',
+ isOutputPort,
+ MACHINE.env.length-2,
+ 1,
+ 'display');
+ outputPort = MACHINE.env[MACHINE.env.length-2];
}
- }
- return true;
- };
- Primitives['='].arity = new ArityAtLeast(2);
- Primitives['='].displayName = '=';
+ outputPort.writeDomNode(MACHINE, toDomNode(firstArg, 'display'));
+ return VOID;
+ });
+ installPrimitiveProcedure(
+ 'newline', makeList(0, 1),
+ function(MACHINE) {
+ var outputPort = MACHINE.params.currentOutputPort;
+ if (MACHINE.argcount === 1) {
+ testArgument(MACHINE,
+ 'isOutputPort',
+ isOutputPort,
+ MACHINE.env.length-1,
+ 1,
+ 'newline');
+ outputPort = MACHINE.env[MACHINE.env.length-1];
+ }
+ outputPort.writeDomNode(MACHINE, toDomNode("\n", 'display'));
+ return VOID;
+ });
+
+ installPrimitiveProcedure(
+ 'displayln',
+ makeList(1, 2),
+ function(MACHINE){
+ var firstArg = MACHINE.env[MACHINE.env.length-1];
+ var outputPort = MACHINE.params.currentOutputPort;
+ if (MACHINE.argcount === 2) {
+ testArgument(MACHINE,
+ 'isOutputPort',
+ isOutputPort,
+ MACHINE.env.length-2,
+ 1,
+ 'displayln');
+ outputPort = MACHINE.env[MACHINE.env.length-2];
+ }
+ outputPort.writeDomNode(MACHINE, toDomNode(firstArg, 'display'));
+ outputPort.writeDomNode(MACHINE, toDomNode("\n", 'display'));
+ return VOID;
+ });
+
+
+ installPrimitiveProcedure(
+ 'current-print',
+ makeList(0, 1),
+ function(MACHINE) {
+ if (MACHINE.argcount === 1) {
+ MACHINE.params['current-print'] = MACHINE.env[MACHINE.env.length - 1];
+ return VOID;
+ } else {
+ return MACHINE.params['current-print'];
+ }
+ });
+
+
+ installPrimitiveProcedure(
+ '=',
+ new ArityAtLeast(2),
+ function(MACHINE) {
+ var firstArg = MACHINE.env[MACHINE.env.length-1];
+ testArgument(MACHINE, 'number', isNumber, firstArg, 0, '=');
+ for (var i = 0; i < MACHINE.argcount - 1; i++) {
+ testArgument(MACHINE,
+ 'number',
+ isNumber,
+ MACHINE.env[MACHINE.env.length - 1 - i],
+ i,
+ '=');
+ if (! (jsnums.equals(MACHINE.env[MACHINE.env.length - 1 - i],
+ MACHINE.env[MACHINE.env.length - 1 - i - 1]))) {
+ return false;
+ }
+ }
+ return true;
+ });
+
+
+ // TODO: use installPrimitiveProcedure for the rest...
Primitives['<'] = function(MACHINE) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -845,7 +851,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
Primitives['cons'] = function(MACHINE) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
- return [firstArg, secondArg];
+ return makePair(firstArg, secondArg);
};
Primitives['cons'].arity = 2;
Primitives['cons'].displayName = 'cons';
@@ -854,8 +860,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
Primitives['list'] = function(MACHINE) {
var result = NULL;
for (var i = 0; i < MACHINE.argcount; i++) {
- result = [MACHINE.env[MACHINE.env.length - (MACHINE.argcount - i)],
- result];
+ result = makePair(MACHINE.env[MACHINE.env.length - (MACHINE.argcount - i)],
+ result);
}
return result;
};
@@ -870,7 +876,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
0,
'car');
var firstArg = MACHINE.env[MACHINE.env.length-1];
- return firstArg[0];
+ return firstArg.first;
};
Primitives['car'].arity = 1;
Primitives['car'].displayName = 'car';
@@ -883,7 +889,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
0,
'cdr');
var firstArg = MACHINE.env[MACHINE.env.length-1];
- return firstArg[1];
+ return firstArg.rest;
};
Primitives['cdr'].arity = 1;
Primitives['cdr'].displayName = 'cdr';
@@ -904,7 +910,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
'set-car!');
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
- firstArg[0] = secondArg;
+ firstArg.first = secondArg;
+ return VOID;
};
Primitives['set-car!'].arity = 2;
Primitives['set-car!'].displayName = 'set-car!';
@@ -918,7 +925,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
'set-cdr!');
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
- firstArg[1] = secondArg;
+ firstArg.rest = secondArg;
+ return VOID;
};
Primitives['set-cdr!'].arity = 2;
Primitives['set-cdr!'].displayName = 'set-cdr!';
@@ -945,8 +953,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
for (i = 0; i < MACHINE.argcount; i++) {
result.push(MACHINE.env[MACHINE.env.length-1-i]);
}
- result.type = 'vector';
- return result;
+ var newVector = makeVector.apply(null, result);
+ return newVector;
};
Primitives['vector'].arity = new ArityAtLeast(0);
Primitives['vector'].displayName = 'vector';
@@ -958,11 +966,11 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
MACHINE.env[MACHINE.env.length - 1],
0,
'vector->list');
- var firstArg = MACHINE.env[MACHINE.env.length-1];
+ var elts = MACHINE.env[MACHINE.env.length-1].elts;
var i;
var result = NULL;
- for (i = 0; i < firstArg.length; i++) {
- result = [firstArg[firstArg.length - 1 - i], result];
+ for (i = 0; i < elts.length; i++) {
+ result = makePair(elts[elts.length - 1 - i], result);
}
return result;
};
@@ -973,11 +981,10 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var firstArg = MACHINE.env[MACHINE.env.length-1];
var result = [];
while (firstArg !== NULL) {
- result.push(firstArg[0]);
- firstArg = firstArg[1];
+ result.push(firstArg.first);
+ firstArg = firstArg.rest;
}
- result.type='vector';
- return result;
+ return makeVector.apply(null, result);
};
Primitives['list->vector'].arity = 1;
Primitives['list->vector'].displayName = 'list->vector';
@@ -989,9 +996,9 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
MACHINE.env[MACHINE.env.length - 1],
0,
'vector-ref');
- var firstArg = MACHINE.env[MACHINE.env.length-1];
- var secondArg = MACHINE.env[MACHINE.env.length-2];
- return firstArg[secondArg];
+ var elts = MACHINE.env[MACHINE.env.length-1].elts;
+ var index = MACHINE.env[MACHINE.env.length-2];
+ return elts[index];
};
Primitives['vector-ref'].arity = 2;
Primitives['vector-ref'].displayName = 'vector-ref';
@@ -1003,11 +1010,17 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
MACHINE.env[MACHINE.env.length - 1],
0,
'vector-set!');
- var firstArg = MACHINE.env[MACHINE.env.length-1];
- var secondArg = jsnums.toFixnum(MACHINE.env[MACHINE.env.length-2]);
- var thirdArg = MACHINE.env[MACHINE.env.length-3];
- firstArg[secondArg] = thirdArg;
- return null;
+ testArgument(MACHINE,
+ 'natural',
+ isNatural,
+ MACHINE.env[MACHINE.env.length - 2],
+ 1,
+ 'vector-set!');
+ var elts = MACHINE.env[MACHINE.env.length-1].elts;
+ var index = jsnums.toFixnum(MACHINE.env[MACHINE.env.length-2]);
+ var val = MACHINE.env[MACHINE.env.length-3];
+ elts[index] = val;
+ return VOID;
};
Primitives['vector-set!'].arity = 3;
Primitives['vector-set!'].displayName = 'vector-set!';
@@ -1020,7 +1033,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
MACHINE.env[MACHINE.env.length - 1],
0,
'vector-length');
- var firstArg = MACHINE.env[jsnums.toFixnum(MACHINE.env.length-1)];
+ var firstArg = MACHINE.env[MACHINE.env.length-1].elts;
return firstArg.length;
};
Primitives['vector-length'].arity = 1;
@@ -1043,10 +1056,9 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
for(var i = 0; i < length; i++) {
arr[i] = value;
}
- arr.type='vector';
- return arr;
+ return makeVector.apply(null, arr);
};
- Primitives['make-vector'].arity = [1, [2, NULL]];
+ Primitives['make-vector'].arity = makeList(1, 2);
Primitives['make-vector'].displayName = 'make-vector';
@@ -1104,13 +1116,13 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var firstArg = MACHINE.env[MACHINE.env.length-1];
var secondArg = MACHINE.env[MACHINE.env.length-2];
firstArg[0] = secondArg;
- return;
+ return VOID;
};
Primitives['set-box!'].arity = 2;
Primitives['set-box!'].displayName = 'set-box!';
Primitives['void'] = function(MACHINE) {
- return;
+ return VOID;
};
Primitives['void'].arity = new ArityAtLeast(0);
Primitives['void'].displayName = 'void';
@@ -1132,27 +1144,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
Primitives['equal?'].displayName = 'equal?';
-
- var isEqual = function(firstArg, secondArg) {
- var lset = [firstArg], rset = [secondArg];
- while (lset.length !== 0 && rset.length !== 0) {
- var lhs = lset.pop();
- var rhs = rset.pop();
- if (lhs === rhs) {
- continue;
- } else if (typeof(lhs) === 'object' &&
- typeof(rhs) === 'object' &&
- typeof(lhs.length) === 'number' &&
- typeof(rhs.length) === 'number' &&
- lhs.length === rhs.length) {
- lset.push.apply(lset, lhs);
- rset.push.apply(rset, rhs);
- } else {
- return false;
- }
- }
- return true;
- };
+ var isEqual = types.isEqual;
Primitives['member'] = function(MACHINE) {
@@ -1168,10 +1160,10 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
if (lst === NULL) {
return false;
}
- if (isEqual(x, (lst[0]))) {
+ if (isEqual(x, (lst.first))) {
return lst;
}
- lst = lst[1];
+ lst = lst.rest;
}
};
Primitives['member'].arity = 2;
@@ -1185,8 +1177,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
while(lst !== NULL) {
testArgument(MACHINE,
'pair', isPair, lst, 0, 'reverse');
- rev = [lst[0], rev];
- lst = lst[1];
+ rev = makePair(lst.first, rev);
+ lst = lst.rest;
}
return rev;
};
@@ -1198,6 +1190,30 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
+ // Extensions. A small experiment.
+ installPrimitiveProcedure(
+ 'viewport-width',
+ 0,
+ function(MACHINE) {
+ return $(window).width();
+ });
+
+ installPrimitiveProcedure(
+ 'viewport-height',
+ 0,
+ function(MACHINE) {
+ return $(window).height();
+ });
+
+
+ installPrimitiveProcedure(
+ 'in-javascript-context?',
+ 0,
+ function(MACHINE) {
+ return true;
+ });
+
+
// recomputeGas: state number -> number
@@ -1379,6 +1395,10 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
exports['currentMachine'] = new Machine();
exports['invokeMains'] = invokeMains;
+
+ // installing new primitives
+ exports['installPrimitiveProcedure'] = installPrimitiveProcedure;
+ exports['makePrimitiveProcedure'] = makePrimitiveProcedure;
exports['Primitives'] = Primitives;
exports['ready'] = ready;
@@ -1398,6 +1418,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
exports['DEFAULT_CONTINUATION_PROMPT_TAG'] =
DEFAULT_CONTINUATION_PROMPT_TAG;
exports['NULL'] = NULL;
+ exports['VOID'] = VOID;
exports['testArgument'] = testArgument;
exports['testArity'] = testArity;
@@ -1423,6 +1444,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
exports['unspliceRestFromStack'] = unspliceRestFromStack;
+ // Type predicates
exports['isNumber'] = isNumber;
exports['isNatural'] = isNatural;
exports['isPair'] = isPair;
@@ -1432,6 +1454,17 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
exports['isOutputStringPort'] = isOutputStringPort;
exports['isEqual'] = isEqual;
+ exports['toDomNode'] = toDomNode;
+ exports['toWrittenString'] = toWrittenString;
+ exports['toDisplayedString'] = toDisplayedString;
+
+
+ // Type constructors
+ exports['makeList'] = makeList;
+ exports['makePair'] = makePair;
+ exports['makeVector'] = makeVector;
+
+
exports['ArityAtLeast'] = ArityAtLeast;
exports['isArityMatching'] = isArityMatching;
@@ -1441,5 +1474,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
exports['HaltError'] = HaltError;
+
+
scope.link.announceReady('runtime');
})(this['plt']);
\ No newline at end of file
diff --git a/js-assembler/runtime-src/types.js b/js-assembler/runtime-src/types.js
index ff70603..9bd9db8 100644
--- a/js-assembler/runtime-src/types.js
+++ b/js-assembler/runtime-src/types.js
@@ -47,8 +47,6 @@ if (! this['plt']) { this['plt'] = {}; }
-
-
// Union/find for circular equality testing.
var UnionFind = function() {
@@ -85,7 +83,7 @@ if (! this['plt']) { this['plt'] = {}; }
//////////////////////////////////////////////////////////////////////
- StructType = function(name, type, numberOfArgs, numberOfFields, firstField,
+ var StructType = function(name, type, numberOfArgs, numberOfFields, firstField,
applyGuard, constructor, predicate, accessor, mutator) {
this.name = name;
this.type = type;
@@ -698,17 +696,24 @@ if (! this['plt']) { this['plt'] = {}; }
return b;
};
- Cons = function(f, r) {
- this.f = f;
- this.r = r;
+
+
+
+ //////////////////////////////////////////////////////////////////////
+
+ // Cons Pairs
+
+ var Cons = function(f, r) {
+ this.first = f;
+ this.rest = r;
};
Cons.prototype.reverse = function() {
var lst = this;
var ret = Empty.EMPTY;
while (!lst.isEmpty()){
- ret = Cons.makeInstance(lst.first(), ret);
- lst = lst.rest();
+ ret = Cons.makeInstance(lst.first, ret);
+ lst = lst.rest;
}
return ret;
};
@@ -717,28 +722,21 @@ if (! this['plt']) { this['plt'] = {}; }
return new Cons(f, r);
};
-
// FIXME: can we reduce the recursion on this?
Cons.prototype.isEqual = function(other, aUnionFind) {
if (! (other instanceof Cons)) {
return Logic.FALSE;
}
- return (isEqual(this.first(), other.first(), aUnionFind) &&
- isEqual(this.rest(), other.rest(), aUnionFind));
- };
-
- Cons.prototype.first = function() {
- return this.f;
- };
-
- Cons.prototype.rest = function() {
- return this.r;
+ return (isEqual(this.first, other.first, aUnionFind) &&
+ isEqual(this.rest, other.rest, aUnionFind));
};
+
Cons.prototype.isEmpty = function() {
return false;
};
+
// Cons.append: (listof X) -> (listof X)
Cons.prototype.append = function(b){
if (b === Empty.EMPTY)
@@ -746,8 +744,8 @@ if (! this['plt']) { this['plt'] = {}; }
var ret = b;
var lst = this.reverse();
while ( !lst.isEmpty() ) {
- ret = Cons.makeInstance(lst.first(), ret);
- lst = lst.rest();
+ ret = Cons.makeInstance(lst.first, ret);
+ lst = lst.rest;
}
return ret;
@@ -759,8 +757,8 @@ if (! this['plt']) { this['plt'] = {}; }
var texts = [];
var p = this;
while ( p instanceof Cons ) {
- texts.push(toWrittenString(p.first(), cache));
- p = p.rest();
+ texts.push(toWrittenString(p.first, cache));
+ p = p.rest;
if (typeof(p) === 'object' && cache.containsKey(p)) {
break;
}
@@ -779,8 +777,8 @@ if (! this['plt']) { this['plt'] = {}; }
var texts = [];
var p = this;
while ( p instanceof Cons ) {
- texts.push(toDisplayedString(p.first(), cache));
- p = p.rest();
+ texts.push(toDisplayedString(p.first, cache));
+ p = p.rest;
if (typeof(p) === 'object' && cache.containsKey(p)) {
break;
}
@@ -789,17 +787,6 @@ if (! this['plt']) { this['plt'] = {}; }
texts.push('.');
texts.push(toDisplayedString(p, cache));
}
- // while (true) {
- // if ((!(p instanceof Cons)) && (!(p instanceof Empty))) {
- // texts.push(".");
- // texts.push(toDisplayedString(p, cache));
- // break;
- // }
- // if (p.isEmpty())
- // break;
- // texts.push(toDisplayedString(p.first(), cache));
- // p = p.rest();
- // }
return "(" + texts.join(" ") + ")";
};
@@ -811,8 +798,8 @@ if (! this['plt']) { this['plt'] = {}; }
node.appendChild(document.createTextNode("("));
var p = this;
while ( p instanceof Cons ) {
- appendChild(node, toDomNode(p.first(), cache));
- p = p.rest();
+ appendChild(node, toDomNode(p.first, cache));
+ p = p.rest;
if ( p !== Empty.EMPTY ) {
appendChild(node, document.createTextNode(" "));
}
@@ -825,27 +812,27 @@ if (! this['plt']) { this['plt'] = {}; }
appendChild(node, document.createTextNode(" "));
appendChild(node, toDomNode(p, cache));
}
- // while (true) {
- // if ((!(p instanceof Cons)) && (!(p instanceof Empty))) {
- // appendChild(node, document.createTextNode(" "));
- // appendChild(node, document.createTextNode("."));
- // appendChild(node, document.createTextNode(" "));
- // appendChild(node, toDomNode(p, cache));
- // break;
- // }
- // if (p.isEmpty())
- // break;
- // appendChild(node, toDomNode(p.first(), cache));
- // p = p.rest();
- // if (! p.isEmpty()) {
- // appendChild(node, document.createTextNode(" "));
- // }
- // }
+
node.appendChild(document.createTextNode(")"));
return node;
};
+ // isList: Any -> Boolean
+ // Returns true if x is a list (a chain of pairs terminated by EMPTY).
+ var isList = function(x) {
+ while (x !== Empty.EMPTY) {
+ if (x instanceof Cons){
+ x = x.rest;
+ } else {
+ return false;
+ }
+ }
+ return true;
+ };
+
+
+
//////////////////////////////////////////////////////////////////////
@@ -1955,22 +1942,22 @@ String.prototype.toDisplayedString = function(cache) {
- var makeList = function(args) {
+ var makeList = function() {
var result = Empty.EMPTY;
- for(var i = args.length-1; i >= 0; i--) {
- result = Cons.makeInstance(args[i], result);
+ for(var i = arguments.length-1; i >= 0; i--) {
+ result = Cons.makeInstance(arguments[i], result);
}
return result;
};
- var makeVector = function(args) {
- return Vector.makeInstance(args.length, args);
+ var makeVector = function() {
+ return Vector.makeInstance(arguments.length, arguments);
};
- var makeVectorImmutable = function(args) {
- var v = Vector.makeInstance(args.length, args);
+ var makeVectorImmutable = function() {
+ var v = Vector.makeInstance(arguments.length, arguments);
v.mutable = false;
return v;
};
@@ -1996,27 +1983,27 @@ String.prototype.toDisplayedString = function(cache) {
' given ' + s.toString(),
false);
}
- }
+ };
var makeHashEq = function(lst) {
var newHash = new EqHashTable();
while ( !lst.isEmpty() ) {
- newHash.hash.put(lst.first().first(), lst.first().rest());
- lst = lst.rest();
+ newHash.hash.put(lst.first.first, lst.first.rest);
+ lst = lst.rest;
}
return newHash;
- }
+ };
var makeHashEqual = function(lst) {
var newHash = new EqualHashTable();
while ( !lst.isEmpty() ) {
- newHash.hash.put(lst.first().first(), lst.first().rest());
- lst = lst.rest();
+ newHash.hash.put(lst.first.first, lst.first.rest);
+ lst = lst.rest;
}
return newHash;
- }
+ };
var Color = makeStructureType('color', false, 3, 0, false, false);
@@ -2042,10 +2029,10 @@ String.prototype.toDisplayedString = function(cache) {
}
if (types.isPair(x)) {
- var consPair = types.cons(x.first(), x.rest());
+ var consPair = types.cons(x.first, x.rest);
objectHash.put(x, consPair);
- consPair.f = readerGraph(x.first(), objectHash, n+1);
- consPair.r = readerGraph(x.rest(), objectHash, n+1);
+ consPair.f = readerGraph(x.first, objectHash, n+1);
+ consPair.r = readerGraph(x.rest, objectHash, n+1);
return consPair;
}
@@ -2071,7 +2058,7 @@ String.prototype.toDisplayedString = function(cache) {
}
if (types.isStruct(x)) {
- var aStruct = clone(x);
+ var aStruct = helpers.clone(x);
objectHash.put(x, aStruct);
for(var i = 0 ;i < x._fields.length; i++) {
x._fields[i] = readerGraph(x._fields[i], objectHash, n+1);
@@ -2088,22 +2075,6 @@ String.prototype.toDisplayedString = function(cache) {
- // clone: object -> object
- // Copies an object. The new object should respond like the old
- // object, including to things like instanceof
- var clone = function(obj) {
- var C = function() {}
- C.prototype = obj;
- var c = new C();
- for (property in obj) {
- if (obj.hasOwnProperty(property)) {
- c[property] = obj[property];
- }
- }
- return c;
- };
-
-
//////////////////////////////////////////////////////////////////////
@@ -2170,6 +2141,7 @@ String.prototype.toDisplayedString = function(cache) {
types.isChar = function(x) { return x instanceof Char; };
types.isString = isString;
types.isPair = function(x) { return x instanceof Cons; };
+ types.isList = isList;
types.isEmpty = function(x) { return x === Empty.EMPTY; };
types.isVector = function(x) { return x instanceof Vector; };
types.isBox = function(x) { return x instanceof Box; };
diff --git a/js.rkt b/js.rkt
new file mode 100644
index 0000000..121fc34
--- /dev/null
+++ b/js.rkt
@@ -0,0 +1,3 @@
+#lang s-exp "lang/base.rkt"
+(require "js/main.rkt")
+(provide (all-from-out "js/main.rkt"))
\ No newline at end of file
diff --git a/js/js-impl.js b/js/js-impl.js
new file mode 100644
index 0000000..a79a95f
--- /dev/null
+++ b/js/js-impl.js
@@ -0,0 +1,36 @@
+EXPORTS['alert'] =
+ RUNTIME.makePrimitiveProcedure(
+ 'is-color?',
+ 1,
+ function(MACHINE) {
+ var elt = MACHINE.env[MACHINE.env.length - 1];
+ alert(String(elt));
+ return RUNTIME.VOID;
+ });
+
+
+EXPORTS['body'] = $(document.body);
+
+EXPORTS['$'] =
+ RUNTIME.makePrimitiveProcedure(
+ '$',
+ 1,
+ function(MACHINE) {
+ var obj = MACHINE.env[MACHINE.env.length - 1];
+ return $(obj);
+ });
+
+EXPORTS['call'] =
+ RUNTIME.makePrimitiveProcedure(
+ 'call',
+ new RUNTIME.ArityAtLeast(2),
+ function(MACHINE) {
+ var obj = MACHINE.env[MACHINE.env.length - 1];
+ var methodName = MACHINE.env[MACHINE.env.length - 2];
+ var args = [];
+ for (var i = 0; i < MACHINE.argcount - 2; i++) {
+ args.push(MACHINE.env[MACHINE.env.length -1 - 2 - i]);
+ }
+ var result = obj[methodName].apply(obj, args);
+ return result;
+ });
diff --git a/js/main.rkt b/js/main.rkt
new file mode 100644
index 0000000..35d16af
--- /dev/null
+++ b/js/main.rkt
@@ -0,0 +1,9 @@
+#lang s-exp "../lang/js/js.rkt"
+
+(declare-implementation
+ #:racket "racket-impl.rkt"
+ #:javascript ("js-impl.js")
+ #:provided-values (alert
+ body
+ call
+ $))
\ No newline at end of file
diff --git a/js/racket-impl.rkt b/js/racket-impl.rkt
new file mode 100644
index 0000000..a9c55af
--- /dev/null
+++ b/js/racket-impl.rkt
@@ -0,0 +1,15 @@
+#lang s-exp "../lang/base.rkt"
+
+(provide alert body call $)
+
+(define (alert x)
+ (display x)
+ (newline))
+
+(define body 'blah)
+
+(define (call object method . args)
+ 'not-done-yet)
+
+(define ($ name)
+ 'not-done-yet)
\ No newline at end of file
diff --git a/lang/base/reader.rkt b/lang/base/reader.rkt
new file mode 100644
index 0000000..5ba9db5
--- /dev/null
+++ b/lang/base/reader.rkt
@@ -0,0 +1,9 @@
+#lang s-exp syntax/module-reader
+
+;; http://docs.racket-lang.org/planet/hash-lang-planet.html
+
+#:language (lambda (ip)
+ `(file ,(path->string base-lang-path)))
+
+(require racket/runtime-path)
+(define-runtime-path base-lang-path "../base.rkt")
diff --git a/lang/js-impl/js-impl.rkt b/lang/js-impl/js-impl.rkt
deleted file mode 100644
index 06c69e7..0000000
--- a/lang/js-impl/js-impl.rkt
+++ /dev/null
@@ -1,57 +0,0 @@
-#lang racket/base
-
-;; Special language level where implementation is done in Javascript.
-
-(require (for-syntax racket/base)
- (for-syntax racket/file)
- (for-syntax syntax/modresolve)
- (for-syntax "record.rkt"))
-
-
-(define-for-syntax (read-implementation a-module-path)
- (let ([a-path (parameterize ([current-directory (or (current-load-relative-directory)
- (current-directory))])
- (resolve-module-path a-module-path #f))])
- (file->string a-path)))
-
-
-(define-syntax (require-js stx)
- (syntax-case stx ()
- [(_ path ...)
- (andmap (compose string? syntax-e) (syntax->list #'(path ...)))
- (with-syntax
- ([(impl ...) (map (compose read-implementation syntax-e)
- (syntax->list #'(path ...)))])
- (syntax/loc stx
- (begin
- (begin-for-syntax
- (let* ([this-module (variable-reference->resolved-module-path (#%variable-reference))]
- [key (resolved-module-path-name this-module)])
- (record-implementations! key (list (#%datum . impl) ...))))
- (void))))]))
-
-
-(define-syntax (-provide stx)
- (syntax-case stx ()
- [(_ name ...)
- (andmap (compose symbol? syntax-e) (syntax->list #'(name ...)))
- (syntax/loc stx
- (begin
- (begin-for-syntax
- (let* ([this-module (variable-reference->resolved-module-path (#%variable-reference))]
- [key (resolved-module-path-name this-module)])
- (record-exports! key (list (#%datum . name) ...))))
- (provide name ...)
- (begin (define name (lambda args
- (error (quote name)
- "Must be evaluated within Javascript"))) ...)))]))
-
-
-
-
-
-(provide require-js
- require
- planet
- (rename-out (-provide provide)
- (#%plain-module-begin #%module-begin)))
diff --git a/lang/js-impl/query.rkt b/lang/js-impl/query.rkt
deleted file mode 100644
index 396956e..0000000
--- a/lang/js-impl/query.rkt
+++ /dev/null
@@ -1,39 +0,0 @@
-#lang racket/base
-
-(require racket/contract
- racket/runtime-path
- racket/list
- syntax/modresolve)
-
-
-(define-struct js-module (impls exports))
-
-(provide/contract [query
- (module-path? . -> . (or/c js-module? false/c))]
- [struct js-module ([impls (listof string?)]
- [exports (listof symbol?)])])
-
-
-
-
-(define-runtime-path record.rkt "record.rkt")
-(define ns (make-base-empty-namespace))
-
-
-
-;; query: module-path -> (listof string)
-;; Given a module, see if it's implemented via Javascript.
-(define (query a-module-path)
- (let ([resolved-path (resolve-module-path a-module-path #f)])
- (parameterize ([current-namespace ns])
- (dynamic-require a-module-path (void)) ;; get the compile-time code running.
- (let ([result
- ((dynamic-require-for-syntax record.rkt 'lookup-implementations) resolved-path)])
- (cond
- [(empty? result)
- #f]
- [else
- (make-js-module result
- ((dynamic-require-for-syntax record.rkt 'lookup-exports) resolved-path))])))))
-
-
diff --git a/lang/js-impl/record.rkt b/lang/js-impl/record.rkt
deleted file mode 100644
index 0acf266..0000000
--- a/lang/js-impl/record.rkt
+++ /dev/null
@@ -1,61 +0,0 @@
-#lang racket/base
-
-(provide record-implementations!
- record-exports!
- lookup-implementations
- lookup-exports)
-
-(define-struct record (path impls))
-(define-struct export (path exports))
-
-(define records '())
-(define exports '())
-
-;; record!: path (listof string) -> void
-(define (record-implementations! a-path impls)
- (set! records (cons (make-record a-path impls)
- records)))
-
-
-;; record-exports!: path (listof symbol) -> void
-(define (record-exports! a-path export-names)
- (set! exports (cons (make-export a-path export-names)
- exports)))
-
-
-(define (my-foldl f acc lst)
- (cond
- [(null? lst)
- acc]
- [else
- (my-foldl f (f (car lst) acc) (cdr lst))]))
-
-
-(define (my-filter f lst)
- (cond
- [(null? lst)
- '()]
- [(f (car lst))
- (cons (car lst) (my-filter f (cdr lst)))]
- [else
- (my-filter f (cdr lst))]))
-
-
-;; lookup-implementations: path -> (listof string)
-(define (lookup-implementations a-path)
- (my-foldl (lambda (a-record perms)
- (append (record-impls a-record) perms))
- '()
- (my-filter (lambda (a-record)
- (equal? a-path (record-path a-record)))
- records)))
-
-
-;; lookup-exports: path -> (listof symbol)
-(define (lookup-exports a-path)
- (my-foldl (lambda (an-export exports)
- (append (export-exports an-export) exports))
- '()
- (my-filter (lambda (an-export)
- (equal? a-path (export-path an-export)))
- exports)))
\ No newline at end of file
diff --git a/lang/js-conditional/js-conditional.rkt b/lang/js/js.rkt
similarity index 74%
rename from lang/js-conditional/js-conditional.rkt
rename to lang/js/js.rkt
index 150ddce..19905ee 100644
--- a/lang/js-conditional/js-conditional.rkt
+++ b/lang/js/js.rkt
@@ -17,10 +17,11 @@
(file->string a-path)))
-(define-syntax (declare-conditional-implementation stx)
+(define-syntax (declare-implementation stx)
(syntax-parse stx
[(_ #:racket racket-module-name
- #:javascript (javascript-module-name ...))
+ #:javascript (javascript-module-name ...)
+ #:provided-values (provided-name ...))
(with-syntax
([resolved-racket-module-name
(my-resolve-path (syntax-e #'racket-module-name))]
@@ -28,7 +29,8 @@
(string-join
(map (compose read-implementation syntax-e)
(syntax->list #'(javascript-module-name ...)))
- "\n")])
+ "\n")]
+ [(internal-name ...) (generate-temporaries #'(provided-name ...))])
(syntax/loc stx
(begin
@@ -42,11 +44,14 @@
[key (resolved-module-path-name this-module)])
(record-redirection! (#%datum . resolved-racket-module-name)
key)
- (record-javascript-implementation! key (#%datum . impl))))
+ (record-javascript-implementation! key (#%datum . impl))
+ ;;(record-exported-name! key 'internal-name 'provided-name) ...
+ ))
(require racket-module-name)
- (provide (all-from-out racket-module-name)))))]))
+ (define internal-name provided-name) ...
+ (provide (rename-out [internal-name provided-name] ...)))))]))
-(provide declare-conditional-implementation
+(provide declare-implementation
(rename-out [#%plain-module-begin #%module-begin]))
\ No newline at end of file
diff --git a/lang/js-conditional/query.rkt b/lang/js/query.rkt
similarity index 78%
rename from lang/js-conditional/query.rkt
rename to lang/js/query.rkt
index ea8731a..f00eaa1 100644
--- a/lang/js-conditional/query.rkt
+++ b/lang/js/query.rkt
@@ -9,7 +9,8 @@
[has-javascript-implementation? (module-path? . -> . boolean?)]
[redirected? (path? . -> . boolean?)]
- [follow-redirection (path? . -> . path?)])
+ [follow-redirection (path? . -> . path?)]
+ [collect-redirections-to (path? . -> . (listof path?))])
(define-runtime-path record.rkt "record.rkt")
(define ns (make-base-empty-namespace))
@@ -49,3 +50,12 @@
((dynamic-require-for-syntax record.rkt 'follow-redirection)
resolved-path))))
+
+
+;; collect-redirections-to: module-path -> (listof path)
+(define (collect-redirections-to a-module-path)
+ (let ([resolved-path (resolve-module-path a-module-path #f)])
+ (parameterize ([current-namespace ns])
+ (dynamic-require a-module-path (void)) ;; get the compile-time code running.
+ ((dynamic-require-for-syntax record.rkt 'collect-redirections-to)
+ resolved-path))))
diff --git a/lang/js-conditional/record.rkt b/lang/js/record.rkt
similarity index 70%
rename from lang/js-conditional/record.rkt
rename to lang/js/record.rkt
index 54452ed..7f3b235 100644
--- a/lang/js-conditional/record.rkt
+++ b/lang/js/record.rkt
@@ -5,7 +5,11 @@
lookup-javascript-implementation
record-redirection!
- follow-redirection)
+ follow-redirection
+
+ record-exported-name!
+
+ collect-redirections-to)
(define-struct record (path impl))
@@ -59,4 +63,21 @@
[(equal? (redirection-from (car redirections)) a-path)
(redirection-to (car redirections))]
[else
- (loop (cdr redirections))])))
\ No newline at end of file
+ (loop (cdr redirections))])))
+
+
+(define (record-exported-name! a-path internal-name external-name)
+ (printf "I need to remember to export ~s as ~s\n" internal-name external-name)
+ (void))
+
+
+;; collect-redirections-to: path -> (listof path)
+(define (collect-redirections-to a-path)
+ (let loop ([redirections redirections])
+ (cond
+ [(null? redirections)
+ '()]
+ [(equal? (redirection-to (car redirections)) a-path)
+ (redirection-from (car redirections))]
+ [else
+ (loop (cdr redirections))])))
diff --git a/lang/kernel.rkt b/lang/kernel.rkt
index 91f5f11..47654b9 100644
--- a/lang/kernel.rkt
+++ b/lang/kernel.rkt
@@ -148,7 +148,7 @@
display
newline
- #;displayln
+;; displayln
;; current-print
;; current-continuation-marks
@@ -175,7 +175,7 @@
;; compose
;; current-inexact-milliseconds
;; current-seconds
-;; void
+ void
;; random
;; sleep
;; (identity -identity)
@@ -394,6 +394,36 @@
;; make-reader-graph
;; make-placeholder
;; placeholder-set!
-
-
)
+
+
+
+
+
+(provide
+ ;; FIXME:
+ ;; Extensions: these may need to be hidden in a JavaScript-implemented module
+ in-javascript-context?
+ viewport-width
+ viewport-height)
+
+
+
+;; in-javascript-context: -> boolean
+;; Produces true if we're in a JavaScript context.
+(define (in-javascript-context?)
+ #f)
+
+
+;; viewport-width: -> natural
+;; The viewport width in pixels.
+(define (viewport-width)
+ (error 'viewport-width "Not available outside JavaScript context."))
+
+
+;; viewport-height: -> natural
+;; The viewport height in pixels.
+(define (viewport-height)
+ (error 'viewport-width "Not available outside JavaScript context."))
+
+
diff --git a/lang/reader.rkt b/lang/reader.rkt
new file mode 100644
index 0000000..cab4e7e
--- /dev/null
+++ b/lang/reader.rkt
@@ -0,0 +1,9 @@
+#lang s-exp syntax/module-reader
+
+;; http://docs.racket-lang.org/planet/hash-lang-planet.html
+
+#:language (lambda (ip)
+ `(file ,(path->string base-lang-path)))
+
+(require racket/runtime-path)
+(define-runtime-path base-lang-path "base.rkt")
diff --git a/get-dependencies.rkt b/make/get-dependencies.rkt
similarity index 91%
rename from get-dependencies.rkt
rename to make/get-dependencies.rkt
index 7483948..e2e29e2 100644
--- a/get-dependencies.rkt
+++ b/make/get-dependencies.rkt
@@ -1,7 +1,7 @@
#lang typed/racket/base
-(require "compiler/expression-structs.rkt"
- "compiler/lexical-structs.rkt"
- "sets.rkt")
+(require "../compiler/expression-structs.rkt"
+ "../compiler/lexical-structs.rkt"
+ "../sets.rkt")
;; Collect the complete list of dependencies for a module.
diff --git a/make-structs.rkt b/make/make-structs.rkt
similarity index 75%
rename from make-structs.rkt
rename to make/make-structs.rkt
index 1939c2c..41e8d1a 100644
--- a/make-structs.rkt
+++ b/make/make-structs.rkt
@@ -1,8 +1,8 @@
#lang typed/racket/base
-(require "compiler/il-structs.rkt"
- "compiler/bootstrapped-primitives.rkt"
- "compiler/expression-structs.rkt"
+(require "../compiler/il-structs.rkt"
+ "../compiler/bootstrapped-primitives.rkt"
+ "../compiler/expression-structs.rkt"
"get-dependencies.rkt")
@@ -13,7 +13,9 @@
(define-type Source (U StatementsSource
MainModuleSource
ModuleSource
- SexpSource))
+ SexpSource
+ UninterpretedSource
+ ))
(define-struct: StatementsSource ([stmts : (Listof Statement)])
#:transparent)
@@ -23,10 +25,14 @@
#:transparent)
(define-struct: SexpSource ([sexp : Any])
#:transparent)
+(define-struct: UninterpretedSource ([datum : String])
+ #:transparent)
+
(define-struct: Configuration
- ([should-follow? : (Source Path -> Boolean)]
+ ([wrap-source : (Source -> Source)]
+ [should-follow-children? : (Source -> Boolean)]
[on-module-statements : (Source
(U Expression #f)
(Listof Statement)
@@ -40,7 +46,8 @@
(define debug-configuration
(make-Configuration
- (lambda (src p) #t)
+ (lambda (src) src)
+ (lambda (src) #t)
(lambda (src ast stmt)
(when (and ast (expression-module-path ast))
(printf "debug build configuration: visiting ~s\n"
diff --git a/make.rkt b/make/make.rkt
similarity index 83%
rename from make.rkt
rename to make/make.rkt
index 4eb7133..fbde27f 100644
--- a/make.rkt
+++ b/make/make.rkt
@@ -1,22 +1,22 @@
#lang typed/racket/base
-(require "compiler/compiler.rkt"
- "compiler/il-structs.rkt"
- "compiler/lexical-structs.rkt"
- "compiler/compiler-structs.rkt"
- "compiler/expression-structs.rkt"
+(require "../compiler/compiler.rkt"
+ "../compiler/il-structs.rkt"
+ "../compiler/lexical-structs.rkt"
+ "../compiler/compiler-structs.rkt"
+ "../compiler/expression-structs.rkt"
+ "../parameters.rkt"
+ "../sets.rkt"
"get-dependencies.rkt"
- "parameters.rkt"
- "sets.rkt"
"make-structs.rkt"
racket/list
racket/match)
-(require/typed "parser/parse-bytecode.rkt"
+(require/typed "../parser/parse-bytecode.rkt"
[parse-bytecode (Any -> Expression)])
-(require/typed "get-module-bytecode.rkt"
+(require/typed "../get-module-bytecode.rkt"
[get-module-bytecode ((U String Path Input-Port) -> Bytes)])
@@ -41,6 +41,9 @@
[(StatementsSource? a-source)
(values #f (StatementsSource-stmts a-source))]
+ [(UninterpretedSource? a-source)
+ (values #f '())]
+
[(MainModuleSource? a-source)
(let-values ([(ast stmts)
(get-ast-and-statements (MainModuleSource-source a-source))])
@@ -82,6 +85,7 @@
(and path (? ModuleLocator?))
prefix
requires
+ provides
code))))
path]
[else
@@ -96,7 +100,8 @@
((inst new-seteq Symbol))])
(match config
- [(struct Configuration (should-follow?
+ [(struct Configuration (wrap-source
+ should-follow-children?
on-module-statements
after-module-statements
after-last))
@@ -112,20 +117,19 @@
(cond
[(eq? ast #f)
empty]
+ [(not (should-follow-children? this-source))
+ empty]
[else
(let* ([dependent-module-names (get-dependencies ast)]
[paths
(foldl (lambda: ([mp : ModuleLocator]
[acc : (Listof Source)])
(let ([rp [ModuleLocator-real-path mp]])
-
(cond [((current-kernel-module-locator?)
mp)
acc]
- [(and (path? rp)
- (should-follow? this-source rp)
- (cons (make-ModuleSource rp)
- acc))]
+ [(path? rp)
+ (cons (make-ModuleSource rp) acc)]
[else
acc])))
'()
@@ -146,9 +150,8 @@
[(ast stmts)
(get-ast-and-statements this-source)])
(on-module-statements this-source ast stmts)
- (loop (append (collect-new-dependencies this-source ast)
+ (loop (append (map wrap-source (collect-new-dependencies this-source ast))
(rest sources)))
(after-module-statements this-source ast stmts))])))
- (follow-dependencies sources)])))
-
+ (follow-dependencies (map wrap-source sources))])))
diff --git a/parameters.rkt b/parameters.rkt
index bc141d4..98fbb86 100644
--- a/parameters.rkt
+++ b/parameters.rkt
@@ -11,7 +11,8 @@
current-root-path
current-warn-unimplemented-kernel-primitive
current-seen-unimplemented-kernel-primitives
- current-kernel-module-locator?)
+ current-kernel-module-locator?
+ current-compress-javascript?)
@@ -47,6 +48,9 @@
+(: current-compress-javascript? (Parameterof Boolean))
+(define current-compress-javascript? (make-parameter #f))
+
diff --git a/parser/parse-bytecode-5.1.1.rkt b/parser/parse-bytecode-5.1.1.rkt
index b5d5061..0c30050 100644
--- a/parser/parse-bytecode-5.1.1.rkt
+++ b/parser/parse-bytecode-5.1.1.rkt
@@ -163,12 +163,14 @@
(struct ModuleLocator ('self 'self))
module-prefix
module-requires
+ module-provides
module-code))))
(make-Top top-prefix
(make-Module name
(make-ModuleLocator name name) (current-module-path)
module-prefix
module-requires
+ module-provides
module-code))]
[else
exp]))
@@ -369,6 +371,7 @@
(make-ModuleLocator self-path self-path)
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
+ (parse-mod-provides self-modidx provides)
(parse-mod-body body))]
[else
(let ([rewritten-path (rewrite-path self-path)])
@@ -379,6 +382,7 @@
(normalize-path self-path))
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
+ (parse-mod-provides self-modidx provides)
(parse-mod-body body))]
[else
(error 'parse-mod "Internal error: unable to resolve module path ~s" self-path)]))]))]))
@@ -407,6 +411,34 @@
+(define (parse-mod-provides enclosing-module-path-index provides)
+ (let* ([resolver
+ (current-module-path-index-resolver)]
+ [enclosing-path
+ (resolver enclosing-module-path-index (current-module-path))]
+ [subresolver
+ (lambda (p)
+ (cond
+ [(symbol? enclosing-path)
+ (wrap-module-name (resolver p (current-module-path)))]
+ [(path? enclosing-path)
+ (wrap-module-name (resolver p enclosing-path))]))])
+ (let loop ([provides provides])
+ (cond
+ [(empty? provides)
+ empty]
+ [(= (first (first provides)) 0)
+ (let ([provided-values (second (first provides))])
+ (for/list ([v provided-values])
+ (match v
+ [(struct provided (name src src-name nom-mod
+ src-phase protected? insp))
+ (make-ModuleProvide src-name name (subresolver src))])))]
+ [else
+ (loop (rest provides))]))))
+
+
+
diff --git a/simulator/simulator.rkt b/simulator/simulator.rkt
index 2283769..c3997ae 100644
--- a/simulator/simulator.rkt
+++ b/simulator/simulator.rkt
@@ -312,10 +312,10 @@
(cond
[(closure? clos)
(if (arity-match? (closure-arity clos)
- (ensure-natural (evaluate-oparg m (CheckClosureArity!-arity op))))
+ (ensure-natural (evaluate-oparg m (CheckClosureArity!-num-args op))))
'ok
(error 'check-closure-arity "arity mismatch: passed ~s args to ~s"
- (ensure-natural (evaluate-oparg m (CheckClosureArity!-arity op)))
+ (ensure-natural (evaluate-oparg m (CheckClosureArity!-num-args op)))
(closure-display-name clos)))]
[else
(error 'check-closure-arity "not a closure: ~s" clos)]))]
@@ -325,10 +325,10 @@
(cond
[(primitive-proc? clos)
(if (arity-match? (primitive-proc-arity clos)
- (ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-arity op))))
+ (ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-num-args op))))
'ok
(error 'check-primitive-arity "arity mismatch: passed ~s args to ~s"
- (ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-arity op)))
+ (ensure-natural (evaluate-oparg m (CheckPrimitiveArity!-num-args op)))
(primitive-proc-display-name clos)))]
[else
(error 'check-primitive-arity "not a primitive: ~s" clos)]))]
diff --git a/tests/browser-evaluate.rkt b/tests/browser-evaluate.rkt
index 8b898d5..fbcc48a 100644
--- a/tests/browser-evaluate.rkt
+++ b/tests/browser-evaluate.rkt
@@ -85,6 +85,7 @@
[program (second javascript-compiler+program)])
(with-handlers ([exn:fail? (lambda (exn)
+ (displayln exn)
(let ([sentinel
(format
#<vector (reverse nts))))))
+ def-loop)
+ grammar
+ '()))))
+ (ind
+ (lambda (nt nts)
+ ((letrec ((loop
+ (lambda (i)
+ (if (>= i '0) (if (equal? (vector-ref nts i) nt) i (loop (- i '1))) '#f))))
+ loop)
+ (- (vector-length nts) '1))))
+ (nb-configurations
+ (lambda (grammar)
+ ((letrec ((def-loop
+ (lambda (defs nb-confs)
+ (if (pair? defs)
+ (let ((def (car defs)))
+ ((letrec ((rule-loop
+ (lambda (rules nb-confs)
+ (if (pair? rules)
+ (let ((rule (car rules)))
+ ((letrec ((loop
+ (lambda (l nb-confs)
+ (if (pair? l)
+ (loop (cdr l) (+ nb-confs '1))
+ (rule-loop (cdr rules) (+ nb-confs '1))))))
+ loop)
+ rule
+ nb-confs))
+ (def-loop (cdr defs) nb-confs)))))
+ rule-loop)
+ (cdr def)
+ nb-confs))
+ nb-confs))))
+ def-loop)
+ grammar
+ '0))))
+ (let ((nts (non-terminals grammar)))
+ (let ((nb-nts (vector-length nts)))
+ (let ((nb-confs (+ (nb-configurations grammar) nb-nts)))
+ (let ((starters (make-vector nb-nts '())))
+ (let ((enders (make-vector nb-nts '())))
+ (let ((predictors (make-vector nb-nts '())))
+ (let ((steps (make-vector nb-confs '#f)))
+ (let ((names (make-vector nb-confs '#f)))
+ (letrec ((setup-tables
+ (lambda (grammar nts starters enders predictors steps names)
+ (letrec ((add-conf
+ (lambda (conf nt nts class)
+ (let ((i (ind nt nts)))
+ (vector-set! class i (cons conf (vector-ref class i)))))))
+ (let ((nb-nts (vector-length nts)))
+ ((letrec ((nt-loop
+ (lambda (i)
+ (if (>= i '0)
+ (begin
+ (vector-set! steps i (- i nb-nts))
+ (vector-set! names i (list (vector-ref nts i) '0))
+ (vector-set! enders i (list i))
+ (nt-loop (- i '1)))
+ '#f))))
+ nt-loop)
+ (- nb-nts '1))
+ ((letrec ((def-loop
+ (lambda (defs conf)
+ (if (pair? defs)
+ (let ((def (car defs)))
+ (let ((head (car def)))
+ ((letrec ((rule-loop
+ (lambda (rules conf rule-num)
+ (if (pair? rules)
+ (let ((rule (car rules)))
+ (vector-set!
+ names
+ conf
+ (list head rule-num))
+ (add-conf conf head nts starters)
+ ((letrec ((loop
+ (lambda (l conf)
+ (if (pair? l)
+ (let ((nt (car l)))
+ (vector-set!
+ steps
+ conf
+ (ind nt nts))
+ (add-conf
+ conf
+ nt
+ nts
+ predictors)
+ (loop
+ (cdr l)
+ (+ conf '1)))
+ (begin
+ (vector-set!
+ steps
+ conf
+ (-
+ (ind head nts)
+ nb-nts))
+ (add-conf
+ conf
+ head
+ nts
+ enders)
+ (rule-loop
+ (cdr rules)
+ (+ conf '1)
+ (+ rule-num '1)))))))
+ loop)
+ rule
+ conf))
+ (def-loop (cdr defs) conf)))))
+ rule-loop)
+ (cdr def)
+ conf
+ '1)))
+ '#f))))
+ def-loop)
+ grammar
+ (vector-length nts)))))))
+ (setup-tables grammar nts starters enders predictors steps names)
+ (let ((parser-descr (vector lexer nts starters enders predictors steps names)))
+ (lambda (input)
+ (letrec ((ind
+ (lambda (nt nts)
+ ((letrec ((loop
+ (lambda (i)
+ (if (>= i '0)
+ (if (equal? (vector-ref nts i) nt) i (loop (- i '1)))
+ '#f))))
+ loop)
+ (- (vector-length nts) '1))))
+ (comp-tok
+ (lambda (tok nts)
+ ((letrec ((loop
+ (lambda (l1 l2)
+ (if (pair? l1)
+ (let ((i (ind (car l1) nts)))
+ (if i (loop (cdr l1) (cons i l2)) (loop (cdr l1) l2)))
+ (cons (car tok) (reverse l2))))))
+ loop)
+ (cdr tok)
+ '())))
+ (input->tokens
+ (lambda (input lexer nts)
+ (list->vector (map (lambda (tok) (comp-tok tok nts)) (lexer input)))))
+ (make-states
+ (lambda (nb-toks nb-confs)
+ (let ((states (make-vector (+ nb-toks '1) '#f)))
+ ((letrec ((loop
+ (lambda (i)
+ (if (>= i '0)
+ (let ((v (make-vector (+ nb-confs '1) '#f)))
+ (vector-set! v '0 '-1)
+ (vector-set! states i v)
+ (loop (- i '1)))
+ states))))
+ loop)
+ nb-toks))))
+ (conf-set-get (lambda (state conf) (vector-ref state (+ conf '1))))
+ (conf-set-get*
+ (lambda (state state-num conf)
+ (let ((conf-set (conf-set-get state conf)))
+ (if conf-set
+ conf-set
+ (let ((conf-set (make-vector (+ state-num '6) '#f)))
+ (vector-set! conf-set '1 '-3)
+ (vector-set! conf-set '2 '-1)
+ (vector-set! conf-set '3 '-1)
+ (vector-set! conf-set '4 '-1)
+ (vector-set! state (+ conf '1) conf-set)
+ conf-set)))))
+ (conf-set-merge-new!
+ (lambda (conf-set)
+ (vector-set!
+ conf-set
+ (+ (vector-ref conf-set '1) '5)
+ (vector-ref conf-set '4))
+ (vector-set! conf-set '1 (vector-ref conf-set '3))
+ (vector-set! conf-set '3 '-1)
+ (vector-set! conf-set '4 '-1)))
+ (conf-set-head (lambda (conf-set) (vector-ref conf-set '2)))
+ (conf-set-next (lambda (conf-set i) (vector-ref conf-set (+ i '5))))
+ (conf-set-member?
+ (lambda (state conf i)
+ (let ((conf-set (vector-ref state (+ conf '1))))
+ (if conf-set (conf-set-next conf-set i) '#f))))
+ (conf-set-adjoin
+ (lambda (state conf-set conf i)
+ (let ((tail (vector-ref conf-set '3)))
+ (vector-set! conf-set (+ i '5) '-1)
+ (vector-set! conf-set (+ tail '5) i)
+ (vector-set! conf-set '3 i)
+ (if (< tail '0)
+ (begin
+ (vector-set! conf-set '0 (vector-ref state '0))
+ (vector-set! state '0 conf))
+ '#f))))
+ (conf-set-adjoin*
+ (lambda (states state-num l i)
+ (let ((state (vector-ref states state-num)))
+ ((letrec ((loop
+ (lambda (l1)
+ (if (pair? l1)
+ (let ((conf (car l1)))
+ (let ((conf-set (conf-set-get* state state-num conf)))
+ (if (not (conf-set-next conf-set i))
+ (begin
+ (conf-set-adjoin state conf-set conf i)
+ (loop (cdr l1)))
+ (loop (cdr l1)))))
+ '#f))))
+ loop)
+ l))))
+ (conf-set-adjoin**
+ (lambda (states states* state-num conf i)
+ (let ((state (vector-ref states state-num)))
+ (if (conf-set-member? state conf i)
+ (let ((state* (vector-ref states* state-num)))
+ (let ((conf-set* (conf-set-get* state* state-num conf)))
+ (if (not (conf-set-next conf-set* i))
+ (conf-set-adjoin state* conf-set* conf i)
+ '#f)
+ '#t))
+ '#f))))
+ (conf-set-union
+ (lambda (state conf-set conf other-set)
+ ((letrec ((loop
+ (lambda (i)
+ (if (>= i '0)
+ (if (not (conf-set-next conf-set i))
+ (begin
+ (conf-set-adjoin state conf-set conf i)
+ (loop (conf-set-next other-set i)))
+ (loop (conf-set-next other-set i)))
+ '#f))))
+ loop)
+ (conf-set-head other-set))))
+ (forw
+ (lambda (states state-num starters enders predictors steps nts)
+ (letrec ((predict
+ (lambda (state state-num conf-set conf nt starters enders)
+ ((letrec ((loop1
+ (lambda (l)
+ (if (pair? l)
+ (let ((starter (car l)))
+ (let ((starter-set
+ (conf-set-get*
+ state
+ state-num
+ starter)))
+ (if (not
+ (conf-set-next
+ starter-set
+ state-num))
+ (begin
+ (conf-set-adjoin
+ state
+ starter-set
+ starter
+ state-num)
+ (loop1 (cdr l)))
+ (loop1 (cdr l)))))
+ '#f))))
+ loop1)
+ (vector-ref starters nt))
+ ((letrec ((loop2
+ (lambda (l)
+ (if (pair? l)
+ (let ((ender (car l)))
+ (if (conf-set-member? state ender state-num)
+ (let ((next (+ conf '1)))
+ (let ((next-set
+ (conf-set-get*
+ state
+ state-num
+ next)))
+ (conf-set-union
+ state
+ next-set
+ next
+ conf-set)
+ (loop2 (cdr l))))
+ (loop2 (cdr l))))
+ '#f))))
+ loop2)
+ (vector-ref enders nt))))
+ (reduce
+ (lambda (states state state-num conf-set head preds)
+ ((letrec ((loop1
+ (lambda (l)
+ (if (pair? l)
+ (let ((pred (car l)))
+ ((letrec ((loop2
+ (lambda (i)
+ (if (>= i '0)
+ (let ((pred-set
+ (conf-set-get
+ (vector-ref states i)
+ pred)))
+ (if pred-set
+ (let ((next (+ pred '1)))
+ (let ((next-set
+ (conf-set-get*
+ state
+ state-num
+ next)))
+ (conf-set-union
+ state
+ next-set
+ next
+ pred-set)))
+ '#f)
+ (loop2
+ (conf-set-next
+ conf-set
+ i)))
+ (loop1 (cdr l))))))
+ loop2)
+ head))
+ '#f))))
+ loop1)
+ preds))))
+ (let ((state (vector-ref states state-num))
+ (nb-nts (vector-length nts)))
+ ((letrec ((loop
+ (lambda ()
+ (let ((conf (vector-ref state '0)))
+ (if (>= conf '0)
+ (let ((step (vector-ref steps conf)))
+ (let ((conf-set (vector-ref state (+ conf '1))))
+ (let ((head (vector-ref conf-set '4)))
+ (vector-set!
+ state
+ '0
+ (vector-ref conf-set '0))
+ (conf-set-merge-new! conf-set)
+ (if (>= step '0)
+ (predict
+ state
+ state-num
+ conf-set
+ conf
+ step
+ starters
+ enders)
+ (let ((preds
+ (vector-ref
+ predictors
+ (+ step nb-nts))))
+ (reduce
+ states
+ state
+ state-num
+ conf-set
+ head
+ preds)))
+ (loop))))
+ '#f)))))
+ loop))))))
+ (forward
+ (lambda (starters enders predictors steps nts toks)
+ (let ((nb-toks (vector-length toks)))
+ (let ((nb-confs (vector-length steps)))
+ (let ((states (make-states nb-toks nb-confs)))
+ (let ((goal-starters (vector-ref starters '0)))
+ (conf-set-adjoin* states '0 goal-starters '0)
+ (forw states '0 starters enders predictors steps nts)
+ ((letrec ((loop
+ (lambda (i)
+ (if (< i nb-toks)
+ (let ((tok-nts (cdr (vector-ref toks i))))
+ (conf-set-adjoin* states (+ i '1) tok-nts i)
+ (forw
+ states
+ (+ i '1)
+ starters
+ enders
+ predictors
+ steps
+ nts)
+ (loop (+ i '1)))
+ '#f))))
+ loop)
+ '0)
+ states))))))
+ (produce
+ (lambda (conf i j enders steps toks states states* nb-nts)
+ (let ((prev (- conf '1)))
+ (if (if (>= conf nb-nts) (>= (vector-ref steps prev) '0) '#f)
+ ((letrec ((loop1
+ (lambda (l)
+ (if (pair? l)
+ (let ((ender (car l)))
+ (let ((ender-set
+ (conf-set-get (vector-ref states j) ender)))
+ (if ender-set
+ ((letrec ((loop2
+ (lambda (k)
+ (if (>= k '0)
+ (begin
+ (if (>= k i)
+ (if (conf-set-adjoin**
+ states
+ states*
+ k
+ prev
+ i)
+ (conf-set-adjoin**
+ states
+ states*
+ j
+ ender
+ k)
+ '#f)
+ '#f)
+ (loop2
+ (conf-set-next ender-set k)))
+ (loop1 (cdr l))))))
+ loop2)
+ (conf-set-head ender-set))
+ (loop1 (cdr l)))))
+ '#f))))
+ loop1)
+ (vector-ref enders (vector-ref steps prev)))
+ '#f))))
+ (back
+ (lambda (states states* state-num enders steps nb-nts toks)
+ (let ((state* (vector-ref states* state-num)))
+ ((letrec ((loop1
+ (lambda ()
+ (let ((conf (vector-ref state* '0)))
+ (if (>= conf '0)
+ (let ((conf-set (vector-ref state* (+ conf '1))))
+ (let ((head (vector-ref conf-set '4)))
+ (vector-set! state* '0 (vector-ref conf-set '0))
+ (conf-set-merge-new! conf-set)
+ ((letrec ((loop2
+ (lambda (i)
+ (if (>= i '0)
+ (begin
+ (produce
+ conf
+ i
+ state-num
+ enders
+ steps
+ toks
+ states
+ states*
+ nb-nts)
+ (loop2
+ (conf-set-next conf-set i)))
+ (loop1)))))
+ loop2)
+ head)))
+ '#f)))))
+ loop1)))))
+ (backward
+ (lambda (states enders steps nts toks)
+ (let ((nb-toks (vector-length toks)))
+ (let ((nb-confs (vector-length steps)))
+ (let ((nb-nts (vector-length nts)))
+ (let ((states* (make-states nb-toks nb-confs)))
+ (let ((goal-enders (vector-ref enders '0)))
+ ((letrec ((loop1
+ (lambda (l)
+ (if (pair? l)
+ (let ((conf (car l)))
+ (conf-set-adjoin**
+ states
+ states*
+ nb-toks
+ conf
+ '0)
+ (loop1 (cdr l)))
+ '#f))))
+ loop1)
+ goal-enders)
+ ((letrec ((loop2
+ (lambda (i)
+ (if (>= i '0)
+ (begin
+ (back
+ states
+ states*
+ i
+ enders
+ steps
+ nb-nts
+ toks)
+ (loop2 (- i '1)))
+ '#f))))
+ loop2)
+ nb-toks)
+ states*)))))))
+ (parsed?
+ (lambda (nt i j nts enders states)
+ (let ((nt* (ind nt nts)))
+ (if nt*
+ (let ((nb-nts (vector-length nts)))
+ ((letrec ((loop
+ (lambda (l)
+ (if (pair? l)
+ (let ((conf (car l)))
+ (if (conf-set-member?
+ (vector-ref states j)
+ conf
+ i)
+ '#t
+ (loop (cdr l))))
+ '#f))))
+ loop)
+ (vector-ref enders nt*)))
+ '#f))))
+ (deriv-trees
+ (lambda (conf i j enders steps names toks states nb-nts)
+ (let ((name (vector-ref names conf)))
+ (if name
+ (if (< conf nb-nts)
+ (list (list name (car (vector-ref toks i))))
+ (list (list name)))
+ (let ((prev (- conf '1)))
+ ((letrec ((loop1
+ (lambda (l1 l2)
+ (if (pair? l1)
+ (let ((ender (car l1)))
+ (let ((ender-set
+ (conf-set-get
+ (vector-ref states j)
+ ender)))
+ (if ender-set
+ ((letrec ((loop2
+ (lambda (k l2)
+ (if (>= k '0)
+ (if (if (>= k i)
+ (conf-set-member?
+ (vector-ref states k)
+ prev
+ i)
+ '#f)
+ (let ((prev-trees
+ (deriv-trees
+ prev
+ i
+ k
+ enders
+ steps
+ names
+ toks
+ states
+ nb-nts))
+ (ender-trees
+ (deriv-trees
+ ender
+ k
+ j
+ enders
+ steps
+ names
+ toks
+ states
+ nb-nts)))
+ ((letrec ((loop3
+ (lambda (l3 l2)
+ (if (pair? l3)
+ (let ((ender-tree
+ (list
+ (car
+ l3))))
+ ((letrec ((loop4
+ (lambda (l4
+ l2)
+ (if (pair?
+ l4)
+ (loop4
+ (cdr
+ l4)
+ (cons
+ (append
+ (car
+ l4)
+ ender-tree)
+ l2))
+ (loop3
+ (cdr
+ l3)
+ l2)))))
+ loop4)
+ prev-trees
+ l2))
+ (loop2
+ (conf-set-next
+ ender-set
+ k)
+ l2)))))
+ loop3)
+ ender-trees
+ l2))
+ (loop2
+ (conf-set-next ender-set k)
+ l2))
+ (loop1 (cdr l1) l2)))))
+ loop2)
+ (conf-set-head ender-set)
+ l2)
+ (loop1 (cdr l1) l2))))
+ l2))))
+ loop1)
+ (vector-ref enders (vector-ref steps prev))
+ '()))))))
+ (deriv-trees*
+ (lambda (nt i j nts enders steps names toks states)
+ (let ((nt* (ind nt nts)))
+ (if nt*
+ (let ((nb-nts (vector-length nts)))
+ ((letrec ((loop
+ (lambda (l trees)
+ (if (pair? l)
+ (let ((conf (car l)))
+ (if (conf-set-member?
+ (vector-ref states j)
+ conf
+ i)
+ (loop
+ (cdr l)
+ (append
+ (deriv-trees
+ conf
+ i
+ j
+ enders
+ steps
+ names
+ toks
+ states
+ nb-nts)
+ trees))
+ (loop (cdr l) trees)))
+ trees))))
+ loop)
+ (vector-ref enders nt*)
+ '()))
+ '#f))))
+ (nb-deriv-trees
+ (lambda (conf i j enders steps toks states nb-nts)
+ (let ((prev (- conf '1)))
+ (if (let ((or-part (< conf nb-nts)))
+ (if or-part or-part (< (vector-ref steps prev) '0)))
+ '1
+ ((letrec ((loop1
+ (lambda (l n)
+ (if (pair? l)
+ (let ((ender (car l)))
+ (let ((ender-set
+ (conf-set-get (vector-ref states j) ender)))
+ (if ender-set
+ ((letrec ((loop2
+ (lambda (k n)
+ (if (>= k '0)
+ (if (if (>= k i)
+ (conf-set-member?
+ (vector-ref states k)
+ prev
+ i)
+ '#f)
+ (let ((nb-prev-trees
+ (nb-deriv-trees
+ prev
+ i
+ k
+ enders
+ steps
+ toks
+ states
+ nb-nts))
+ (nb-ender-trees
+ (nb-deriv-trees
+ ender
+ k
+ j
+ enders
+ steps
+ toks
+ states
+ nb-nts)))
+ (loop2
+ (conf-set-next ender-set k)
+ (+
+ n
+ (*
+ nb-prev-trees
+ nb-ender-trees))))
+ (loop2
+ (conf-set-next ender-set k)
+ n))
+ (loop1 (cdr l) n)))))
+ loop2)
+ (conf-set-head ender-set)
+ n)
+ (loop1 (cdr l) n))))
+ n))))
+ loop1)
+ (vector-ref enders (vector-ref steps prev))
+ '0)))))
+ (nb-deriv-trees*
+ (lambda (nt i j nts enders steps toks states)
+ (let ((nt* (ind nt nts)))
+ (if nt*
+ (let ((nb-nts (vector-length nts)))
+ ((letrec ((loop
+ (lambda (l nb-trees)
+ (if (pair? l)
+ (let ((conf (car l)))
+ (if (conf-set-member?
+ (vector-ref states j)
+ conf
+ i)
+ (loop
+ (cdr l)
+ (+
+ (nb-deriv-trees
+ conf
+ i
+ j
+ enders
+ steps
+ toks
+ states
+ nb-nts)
+ nb-trees))
+ (loop (cdr l) nb-trees)))
+ nb-trees))))
+ loop)
+ (vector-ref enders nt*)
+ '0))
+ '#f)))))
+ (let ((lexer (vector-ref parser-descr '0)))
+ (let ((nts (vector-ref parser-descr '1)))
+ (let ((starters (vector-ref parser-descr '2)))
+ (let ((enders (vector-ref parser-descr '3)))
+ (let ((predictors (vector-ref parser-descr '4)))
+ (let ((steps (vector-ref parser-descr '5)))
+ (let ((names (vector-ref parser-descr '6)))
+ (let ((toks (input->tokens input lexer nts)))
+ (vector
+ nts
+ starters
+ enders
+ predictors
+ steps
+ names
+ toks
+ (backward
+ (forward starters enders predictors steps nts toks)
+ enders
+ steps
+ nts
+ toks)
+ parsed?
+ deriv-trees*
+ nb-deriv-trees*))))))))))))))))))))))))
+ (define parse->parsed?
+ (lambda (parse nt i j)
+ (let ((nts (vector-ref parse '0)))
+ (let ((enders (vector-ref parse '2)))
+ (let ((states (vector-ref parse '7)))
+ (let ((parsed? (vector-ref parse '8))) (parsed? nt i j nts enders states)))))))
+ (define parse->trees
+ (lambda (parse nt i j)
+ (let ((nts (vector-ref parse '0)))
+ (let ((enders (vector-ref parse '2)))
+ (let ((steps (vector-ref parse '4)))
+ (let ((names (vector-ref parse '5)))
+ (let ((toks (vector-ref parse '6)))
+ (let ((states (vector-ref parse '7)))
+ (let ((deriv-trees* (vector-ref parse '9)))
+ (deriv-trees* nt i j nts enders steps names toks states))))))))))
+ (define parse->nb-trees
+ (lambda (parse nt i j)
+ (let ((nts (vector-ref parse '0)))
+ (let ((enders (vector-ref parse '2)))
+ (let ((steps (vector-ref parse '4)))
+ (let ((toks (vector-ref parse '6)))
+ (let ((states (vector-ref parse '7)))
+ (let ((nb-deriv-trees* (vector-ref parse '10)))
+ (nb-deriv-trees* nt i j nts enders steps toks states)))))))))
+ (define test
+ (lambda (k)
+ (let ((p (make-parser '((s (a) (s s)))
+ (lambda (l)
+ (map (lambda (x) (list x x)) l)))))
+ (let ((x (p (vector->list (make-vector k 'a)))))
+ (display (length (parse->trees x 's '0 k)))
+ (newline)))))
+ (test '12))
diff --git a/tests/test-assemble.rkt b/tests/test-assemble.rkt
index 5efb59a..42a6354 100644
--- a/tests/test-assemble.rkt
+++ b/tests/test-assemble.rkt
@@ -45,11 +45,12 @@
"(function() { "
runtime
+ "var RUNTIME = plt.runtime;"
"var MACHINE = new plt.runtime.Machine();\n"
"return function(success, fail, params){"
snippet
- (format "success(String(~a)); };" inspector)
+ (format "success(plt.runtime.toDisplayedString(~a)); };" inspector)
"});")])
(displayln snippet)
(display code op))))))
@@ -63,6 +64,7 @@
[inspector (cdr a-statement+inspector)])
(display runtime op)
+ "var RUNTIME = plt.runtime;"
(display "var MACHINE = new plt.runtime.Machine();\n" op)
(display "(function() { " op)
(display "var myInvoke = " op)
@@ -70,7 +72,7 @@
(display ";" op)
(fprintf op
- "return function(succ, fail, params) { myInvoke(MACHINE, function(v) { succ(String(~a));}, fail, params); }"
+ "return function(succ, fail, params) { myInvoke(MACHINE, function(v) { succ(plt.runtime.toDisplayedString(~a));}, fail, params); }"
inspector)
(display "})" op))))))
(define (E-many stmts (inspector "MACHINE.val"))
@@ -91,13 +93,13 @@
"Danny")
;; Assigning a cons
(test (E-single (make-AssignImmediateStatement 'val (make-Const (cons 1 2))))
- "1,2")
+ "(1 . 2)")
;; Assigning a void
(test (E-single (make-AssignImmediateStatement 'val (make-Const (void))))
- "null")
+ "#")
;; Assigning to proc means val should still be uninitialized.
(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny")))
- "undefined")
+ "#")
;; But we should see the assignment if we inspect MACHINE.proc.
(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny"))
"MACHINE.proc")
@@ -133,7 +135,7 @@
(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f)
(make-Const 12345)))
"MACHINE.env[0]")
- "undefined")
+ "#")
(test (E-many (list (make-PushEnvironment 2 #f)
(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f)
(make-Const 12345)))
@@ -143,7 +145,7 @@
;; Toplevel Environment loading
(test (E-single (make-PerformStatement (make-ExtendEnvironment/Prefix! '(pi)))
- "String(MACHINE.env[0]).slice(0, 5)")
+ "plt.runtime.toWrittenString(MACHINE.env[0]).slice(0, 5)")
"3.141")
@@ -210,7 +212,7 @@
(make-Const 0))
(make-GotoStatement (make-Label 'closureStart))
'theEnd)
- "String(MACHINE.env.length) + ',' + MACHINE.env[1] + ',' + MACHINE.env[0]")
+ "plt.runtime.toWrittenString(MACHINE.env.length) + ',' + MACHINE.env[1] + ',' + MACHINE.env[0]")
"2,hello,world")
diff --git a/tests/test-browser-evaluate.rkt b/tests/test-browser-evaluate.rkt
index 204ff36..a4a5809 100644
--- a/tests/test-browser-evaluate.rkt
+++ b/tests/test-browser-evaluate.rkt
@@ -1,12 +1,12 @@
#lang racket
(require "browser-evaluate.rkt"
"../js-assembler/package.rkt"
- "../make-structs.rkt")
+ "../make/make-structs.rkt")
(printf "test-browser-evaluate.rkt\n")
-(define should-follow? (lambda (src p) #t))
+(define should-follow? (lambda (src) #t))
(define evaluate (make-evaluate
(lambda (program op)
@@ -20,7 +20,7 @@
(fprintf op "var innerInvoke = ")
(package-anonymous (make-SexpSource program)
- #:should-follow? should-follow?
+ #:should-follow-children? should-follow?
#:output-port op)
(fprintf op "();\n")
@@ -63,7 +63,7 @@ EOF
(let ([r (evaluate s)])
(raise-syntax-error #f (format "Expected exception, but got ~s" r)
#'stx)))])
- (unless (string=? exp (error-happened-str an-error-happened))
+ (unless (regexp-match (regexp-quote exp) (error-happened-str an-error-happened))
(printf " error!\n")
(raise-syntax-error #f (format "Expected ~s, got ~s" exp (error-happened-str an-error-happened))
#'stx))
@@ -99,20 +99,21 @@ EOF
"7")
(test/exn (evaluate '(+ "hello" 3))
- "Error: +: expected number as argument 1 but received hello")
+ "Error: +: expected number as argument 1 but received \"hello\"")
(test '(display (/ 100 4))
"25")
+;; fixme: symbols need to be represented separately from strings.
(test/exn (evaluate '(/ 3 'four))
- "Error: /: expected number as argument 2 but received four")
+ "Error: /: expected number as argument 2 but received \"four\"")
(test '(display (- 1))
"-1")
(test/exn '(- 'one)
- "Error: -: expected number as argument 1 but received one")
+ "Error: -: expected number as argument 1 but received \"one\"")
(test '(display (- 5 4))
"1")
@@ -121,7 +122,7 @@ EOF
"51")
(test/exn '(* "three" 17)
- "Error: *: expected number as argument 1 but received three")
+ "Error: *: expected number as argument 1 but received \"three\"")
(test '(display '#t)
"true")
@@ -154,13 +155,13 @@ EOF
(test/exn '(displayln (add1 "0"))
- "Error: add1: expected number as argument 1 but received 0")
+ "Error: add1: expected number as argument 1 but received \"0\"")
(test '(displayln (sub1 1))
"0\n")
(test/exn '(displayln (sub1 "0"))
- "Error: sub1: expected number as argument 1 but received 0")
+ "Error: sub1: expected number as argument 1 but received \"0\"")
(test '(displayln (< 1 2))
"true\n")
@@ -381,7 +382,7 @@ EOF
(test/exn '(let ([x 0])
(set! x "foo")
(add1 x))
- "Error: add1: expected number as argument 1 but received foo")
+ "Error: add1: expected number as argument 1 but received \"foo\"")
@@ -479,6 +480,31 @@ EOF
"false\n")
+;;(test '(displayln 2/3)
+;; "2/3\n")
+
+
+;;(test '(displayln -2/3)
+;; "-2/3\n")
+
+
+(test '(displayln -0.0)
+ "-0.0\n")
+
+(test '(displayln +nan.0)
+ "+nan.0\n")
+
+(test '(displayln +inf.0)
+ "+inf.0\n")
+
+(test '(displayln -inf.0)
+ "-inf.0\n")
+
+
+
+
+
+
;; Knuth's Man-or-boy-test.
diff --git a/tests/test-compiler.rkt b/tests/test-compiler.rkt
index 1bf1baf..2818d55 100644
--- a/tests/test-compiler.rkt
+++ b/tests/test-compiler.rkt
@@ -1368,7 +1368,6 @@
20116)
-
(test '(let () (define (f x y z)
(values y x z))
(call-with-values (lambda () (f 3 1 4))
@@ -1376,6 +1375,7 @@
'((1 3 4))
#:with-bootstrapping? #t)
+
(test '(let () (define (f x y z)
(begin0 (values y x z)
(display "")))
diff --git a/tests/test-conform-browser.rkt b/tests/test-conform-browser.rkt
index 076384f..47c2816 100644
--- a/tests/test-conform-browser.rkt
+++ b/tests/test-conform-browser.rkt
@@ -1,7 +1,7 @@
#lang racket
(require "browser-evaluate.rkt"
"../js-assembler/package.rkt"
- "../make-structs.rkt"
+ "../make/make-structs.rkt"
racket/port
racket/runtime-path)
@@ -21,7 +21,7 @@
(fprintf op "var innerInvoke = ")
(package-anonymous (make-SexpSource program)
- #:should-follow? (lambda (src p) #t)
+ #:should-follow-children? (lambda (src) #t)
#:output-port op)
(fprintf op "();\n")
diff --git a/tests/test-earley-browser.rkt b/tests/test-earley-browser.rkt
index 8b7f6e8..37d406e 100644
--- a/tests/test-earley-browser.rkt
+++ b/tests/test-earley-browser.rkt
@@ -1,7 +1,7 @@
#lang racket
(require "browser-evaluate.rkt"
"../js-assembler/package.rkt"
- "../make-structs.rkt"
+ "../make/make-structs.rkt"
racket/port
racket/runtime-path
racket/runtime-path
@@ -23,7 +23,7 @@
(fprintf op "var innerInvoke = ")
(package-anonymous (make-SexpSource program)
- #:should-follow? (lambda (src path) #t)
+ #:should-follow-children? (lambda (src) #t)
#:output-port op)
(fprintf op "();\n")
diff --git a/tests/test-get-dependencies.rkt b/tests/test-get-dependencies.rkt
index 5e1e8c9..325c885 100644
--- a/tests/test-get-dependencies.rkt
+++ b/tests/test-get-dependencies.rkt
@@ -1,5 +1,5 @@
#lang racket
-(require "../get-dependencies.rkt"
+(require "../make/get-dependencies.rkt"
"../get-module-bytecode.rkt"
"../parser/parse-bytecode.rkt"
"../compiler/lexical-structs.rkt"
@@ -11,7 +11,7 @@
(define-runtime-path get-dependencies-path
- (build-path ".." "get-dependencies.rkt"))
+ (build-path ".." "make" "get-dependencies.rkt"))
(define-runtime-path get-module-bytecode-path
(build-path ".." "get-module-bytecode.rkt"))
diff --git a/tests/test-package.rkt b/tests/test-package.rkt
index e5ff135..d95a8e6 100644
--- a/tests/test-package.rkt
+++ b/tests/test-package.rkt
@@ -1,17 +1,17 @@
#lang racket/base
(require "../js-assembler/package.rkt"
- "../make-structs.rkt")
+ "../make/make-structs.rkt")
(printf "test-package.rkt\n")
-(define (follow? src p)
+(define (follow? src)
#t)
(define (test s-exp)
(package (make-SexpSource s-exp)
- #:should-follow? follow?
+ #:should-follow-children? follow?
#:output-port (open-output-string) #;(current-output-port)))
diff --git a/whalesong.rkt b/whalesong.rkt
index b405ca2..b026a5a 100755
--- a/whalesong.rkt
+++ b/whalesong.rkt
@@ -3,7 +3,7 @@
(require racket/list
racket/string
- "make-structs.rkt"
+ "make/make-structs.rkt"
"js-assembler/package.rkt")
diff --git a/world.rkt b/world.rkt
new file mode 100644
index 0000000..a0b0b51
--- /dev/null
+++ b/world.rkt
@@ -0,0 +1,3 @@
+#lang s-exp "lang/base.rkt"
+(require "world/main.rkt")
+(provide (all-from-out "world/main.rkt"))
\ No newline at end of file
diff --git a/world/colordb.js b/world/colordb.js
new file mode 100644
index 0000000..6f2bcf2
--- /dev/null
+++ b/world/colordb.js
@@ -0,0 +1,205 @@
+// Color database
+var ColorDb = function() {
+ this.colors = {};
+};
+
+var types = plt.types;
+
+
+ColorDb.prototype.put = function(name, color) {
+ this.colors[name] = color;
+};
+
+ColorDb.prototype.get = function(name) {
+ return this.colors[name.toString().toUpperCase()];
+};
+
+
+// FIXME: update toString to handle the primitive field values.
+
+var colorDb = new ColorDb();
+colorDb.put("ORANGE", types.color(255, 165, 0));
+colorDb.put("RED", types.color(255, 0, 0));
+colorDb.put("ORANGERED", types.color(255, 69, 0));
+colorDb.put("TOMATO", types.color(255, 99, 71));
+colorDb.put("DARKRED", types.color(139, 0, 0));
+colorDb.put("RED", types.color(255, 0, 0));
+colorDb.put("FIREBRICK", types.color(178, 34, 34));
+colorDb.put("CRIMSON", types.color(220, 20, 60));
+colorDb.put("DEEPPINK", types.color(255, 20, 147));
+colorDb.put("MAROON", types.color(176, 48, 96));
+colorDb.put("INDIAN RED", types.color(205, 92, 92));
+colorDb.put("INDIANRED", types.color(205, 92, 92));
+colorDb.put("MEDIUM VIOLET RED", types.color(199, 21, 133));
+colorDb.put("MEDIUMVIOLETRED", types.color(199, 21, 133));
+colorDb.put("VIOLET RED", types.color(208, 32, 144));
+colorDb.put("VIOLETRED", types.color(208, 32, 144));
+colorDb.put("LIGHTCORAL", types.color(240, 128, 128));
+colorDb.put("HOTPINK", types.color(255, 105, 180));
+colorDb.put("PALEVIOLETRED", types.color(219, 112, 147));
+colorDb.put("LIGHTPINK", types.color(255, 182, 193));
+colorDb.put("ROSYBROWN", types.color(188, 143, 143));
+colorDb.put("PINK", types.color(255, 192, 203));
+colorDb.put("ORCHID", types.color(218, 112, 214));
+colorDb.put("LAVENDERBLUSH", types.color(255, 240, 245));
+colorDb.put("SNOW", types.color(255, 250, 250));
+colorDb.put("CHOCOLATE", types.color(210, 105, 30));
+colorDb.put("SADDLEBROWN", types.color(139, 69, 19));
+colorDb.put("BROWN", types.color(132, 60, 36));
+colorDb.put("DARKORANGE", types.color(255, 140, 0));
+colorDb.put("CORAL", types.color(255, 127, 80));
+colorDb.put("SIENNA", types.color(160, 82, 45));
+colorDb.put("ORANGE", types.color(255, 165, 0));
+colorDb.put("SALMON", types.color(250, 128, 114));
+colorDb.put("PERU", types.color(205, 133, 63));
+colorDb.put("DARKGOLDENROD", types.color(184, 134, 11));
+colorDb.put("GOLDENROD", types.color(218, 165, 32));
+colorDb.put("SANDYBROWN", types.color(244, 164, 96));
+colorDb.put("LIGHTSALMON", types.color(255, 160, 122));
+colorDb.put("DARKSALMON", types.color(233, 150, 122));
+colorDb.put("GOLD", types.color(255, 215, 0));
+colorDb.put("YELLOW", types.color(255, 255, 0));
+colorDb.put("OLIVE", types.color(128, 128, 0));
+colorDb.put("BURLYWOOD", types.color(222, 184, 135));
+colorDb.put("TAN", types.color(210, 180, 140));
+colorDb.put("NAVAJOWHITE", types.color(255, 222, 173));
+colorDb.put("PEACHPUFF", types.color(255, 218, 185));
+colorDb.put("KHAKI", types.color(240, 230, 140));
+colorDb.put("DARKKHAKI", types.color(189, 183, 107));
+colorDb.put("MOCCASIN", types.color(255, 228, 181));
+colorDb.put("WHEAT", types.color(245, 222, 179));
+colorDb.put("BISQUE", types.color(255, 228, 196));
+colorDb.put("PALEGOLDENROD", types.color(238, 232, 170));
+colorDb.put("BLANCHEDALMOND", types.color(255, 235, 205));
+colorDb.put("MEDIUM GOLDENROD", types.color(234, 234, 173));
+colorDb.put("MEDIUMGOLDENROD", types.color(234, 234, 173));
+colorDb.put("PAPAYAWHIP", types.color(255, 239, 213));
+colorDb.put("MISTYROSE", types.color(255, 228, 225));
+colorDb.put("LEMONCHIFFON", types.color(255, 250, 205));
+colorDb.put("ANTIQUEWHITE", types.color(250, 235, 215));
+colorDb.put("CORNSILK", types.color(255, 248, 220));
+colorDb.put("LIGHTGOLDENRODYELLOW", types.color(250, 250, 210));
+colorDb.put("OLDLACE", types.color(253, 245, 230));
+colorDb.put("LINEN", types.color(250, 240, 230));
+colorDb.put("LIGHTYELLOW", types.color(255, 255, 224));
+colorDb.put("SEASHELL", types.color(255, 245, 238));
+colorDb.put("BEIGE", types.color(245, 245, 220));
+colorDb.put("FLORALWHITE", types.color(255, 250, 240));
+colorDb.put("IVORY", types.color(255, 255, 240));
+colorDb.put("GREEN", types.color(0, 255, 0));
+colorDb.put("LAWNGREEN", types.color(124, 252, 0));
+colorDb.put("CHARTREUSE", types.color(127, 255, 0));
+colorDb.put("GREEN YELLOW", types.color(173, 255, 47));
+colorDb.put("GREENYELLOW", types.color(173, 255, 47));
+colorDb.put("YELLOW GREEN", types.color(154, 205, 50));
+colorDb.put("YELLOWGREEN", types.color(154, 205, 50));
+colorDb.put("MEDIUM FOREST GREEN", types.color(107, 142, 35));
+colorDb.put("OLIVEDRAB", types.color(107, 142, 35));
+colorDb.put("MEDIUMFORESTGREEN", types.color(107, 142, 35));
+colorDb.put("DARK OLIVE GREEN", types.color(85, 107, 47));
+colorDb.put("DARKOLIVEGREEN", types.color(85, 107, 47));
+colorDb.put("DARKSEAGREEN", types.color(143, 188, 139));
+colorDb.put("LIME", types.color(0, 255, 0));
+colorDb.put("DARK GREEN", types.color(0, 100, 0));
+colorDb.put("DARKGREEN", types.color(0, 100, 0));
+colorDb.put("LIME GREEN", types.color(50, 205, 50));
+colorDb.put("LIMEGREEN", types.color(50, 205, 50));
+colorDb.put("FOREST GREEN", types.color(34, 139, 34));
+colorDb.put("FORESTGREEN", types.color(34, 139, 34));
+colorDb.put("SPRING GREEN", types.color(0, 255, 127));
+colorDb.put("SPRINGGREEN", types.color(0, 255, 127));
+colorDb.put("MEDIUM SPRING GREEN", types.color(0, 250, 154));
+colorDb.put("MEDIUMSPRINGGREEN", types.color(0, 250, 154));
+colorDb.put("SEA GREEN", types.color(46, 139, 87));
+colorDb.put("SEAGREEN", types.color(46, 139, 87));
+colorDb.put("MEDIUM SEA GREEN", types.color(60, 179, 113));
+colorDb.put("MEDIUMSEAGREEN", types.color(60, 179, 113));
+colorDb.put("AQUAMARINE", types.color(112, 216, 144));
+colorDb.put("LIGHTGREEN", types.color(144, 238, 144));
+colorDb.put("PALE GREEN", types.color(152, 251, 152));
+colorDb.put("PALEGREEN", types.color(152, 251, 152));
+colorDb.put("MEDIUM AQUAMARINE", types.color(102, 205, 170));
+colorDb.put("MEDIUMAQUAMARINE", types.color(102, 205, 170));
+colorDb.put("TURQUOISE", types.color(64, 224, 208));
+colorDb.put("LIGHTSEAGREEN", types.color(32, 178, 170));
+colorDb.put("MEDIUM TURQUOISE", types.color(72, 209, 204));
+colorDb.put("MEDIUMTURQUOISE", types.color(72, 209, 204));
+colorDb.put("HONEYDEW", types.color(240, 255, 240));
+colorDb.put("MINTCREAM", types.color(245, 255, 250));
+colorDb.put("ROYALBLUE", types.color(65, 105, 225));
+colorDb.put("DODGERBLUE", types.color(30, 144, 255));
+colorDb.put("DEEPSKYBLUE", types.color(0, 191, 255));
+colorDb.put("CORNFLOWERBLUE", types.color(100, 149, 237));
+colorDb.put("STEEL BLUE", types.color(70, 130, 180));
+colorDb.put("STEELBLUE", types.color(70, 130, 180));
+colorDb.put("LIGHTSKYBLUE", types.color(135, 206, 250));
+colorDb.put("DARK TURQUOISE", types.color(0, 206, 209));
+colorDb.put("DARKTURQUOISE", types.color(0, 206, 209));
+colorDb.put("CYAN", types.color(0, 255, 255));
+colorDb.put("AQUA", types.color(0, 255, 255));
+colorDb.put("DARKCYAN", types.color(0, 139, 139));
+colorDb.put("TEAL", types.color(0, 128, 128));
+colorDb.put("SKY BLUE", types.color(135, 206, 235));
+colorDb.put("SKYBLUE", types.color(135, 206, 235));
+colorDb.put("CADET BLUE", types.color(96, 160, 160));
+colorDb.put("CADETBLUE", types.color(95, 158, 160));
+colorDb.put("DARK SLATE GRAY", types.color(47, 79, 79));
+colorDb.put("DARKSLATEGRAY", types.color(47, 79, 79));
+colorDb.put("LIGHTSLATEGRAY", types.color(119, 136, 153));
+colorDb.put("SLATEGRAY", types.color(112, 128, 144));
+colorDb.put("LIGHT STEEL BLUE", types.color(176, 196, 222));
+colorDb.put("LIGHTSTEELBLUE", types.color(176, 196, 222));
+colorDb.put("LIGHT BLUE", types.color(173, 216, 230));
+colorDb.put("LIGHTBLUE", types.color(173, 216, 230));
+colorDb.put("POWDERBLUE", types.color(176, 224, 230));
+colorDb.put("PALETURQUOISE", types.color(175, 238, 238));
+colorDb.put("LIGHTCYAN", types.color(224, 255, 255));
+colorDb.put("ALICEBLUE", types.color(240, 248, 255));
+colorDb.put("AZURE", types.color(240, 255, 255));
+colorDb.put("MEDIUM BLUE", types.color(0, 0, 205));
+colorDb.put("MEDIUMBLUE", types.color(0, 0, 205));
+colorDb.put("DARKBLUE", types.color(0, 0, 139));
+colorDb.put("MIDNIGHT BLUE", types.color(25, 25, 112));
+colorDb.put("MIDNIGHTBLUE", types.color(25, 25, 112));
+colorDb.put("NAVY", types.color(36, 36, 140));
+colorDb.put("BLUE", types.color(0, 0, 255));
+colorDb.put("INDIGO", types.color(75, 0, 130));
+colorDb.put("BLUE VIOLET", types.color(138, 43, 226));
+colorDb.put("BLUEVIOLET", types.color(138, 43, 226));
+colorDb.put("MEDIUM SLATE BLUE", types.color(123, 104, 238));
+colorDb.put("MEDIUMSLATEBLUE", types.color(123, 104, 238));
+colorDb.put("SLATE BLUE", types.color(106, 90, 205));
+colorDb.put("SLATEBLUE", types.color(106, 90, 205));
+colorDb.put("PURPLE", types.color(160, 32, 240));
+colorDb.put("DARK SLATE BLUE", types.color(72, 61, 139));
+colorDb.put("DARKSLATEBLUE", types.color(72, 61, 139));
+colorDb.put("DARKVIOLET", types.color(148, 0, 211));
+colorDb.put("DARK ORCHID", types.color(153, 50, 204));
+colorDb.put("DARKORCHID", types.color(153, 50, 204));
+colorDb.put("MEDIUMPURPLE", types.color(147, 112, 219));
+colorDb.put("CORNFLOWER BLUE", types.color(68, 64, 108));
+colorDb.put("MEDIUM ORCHID", types.color(186, 85, 211));
+colorDb.put("MEDIUMORCHID", types.color(186, 85, 211));
+colorDb.put("MAGENTA", types.color(255, 0, 255));
+colorDb.put("FUCHSIA", types.color(255, 0, 255));
+colorDb.put("DARKMAGENTA", types.color(139, 0, 139));
+colorDb.put("VIOLET", types.color(238, 130, 238));
+colorDb.put("PLUM", types.color(221, 160, 221));
+colorDb.put("LAVENDER", types.color(230, 230, 250));
+colorDb.put("THISTLE", types.color(216, 191, 216));
+colorDb.put("GHOSTWHITE", types.color(248, 248, 255));
+colorDb.put("WHITE", types.color(255, 255, 255));
+colorDb.put("WHITESMOKE", types.color(245, 245, 245));
+colorDb.put("GAINSBORO", types.color(220, 220, 220));
+colorDb.put("LIGHT GRAY", types.color(211, 211, 211));
+colorDb.put("LIGHTGRAY", types.color(211, 211, 211));
+colorDb.put("SILVER", types.color(192, 192, 192));
+colorDb.put("GRAY", types.color(190, 190, 190));
+colorDb.put("DARK GRAY", types.color(169, 169, 169));
+colorDb.put("DARKGRAY", types.color(169, 169, 169));
+colorDb.put("DIM GRAY", types.color(105, 105, 105));
+colorDb.put("DIMGRAY", types.color(105, 105, 105));
+colorDb.put("BLACK", types.color(0, 0, 0));
+
+
+EXPORTS['_colorDb'] = colorDb;
diff --git a/world/js-impl.js b/world/js-impl.js
new file mode 100644
index 0000000..b0a2078
--- /dev/null
+++ b/world/js-impl.js
@@ -0,0 +1,11 @@
+
+
+EXPORTS['is-color?'] =
+ plt.runtime.makePrimitiveProcedure(
+ 'is-color?',
+ 1,
+ function(MACHINE) {
+ var elt = MACHINE.env[MACHINE.env.length - 1];
+ return (//(plt.runtime.isString(elt) || plt.runtime.isSymbol(elt)) &&
+ typeof(colorDb.get(elt)) != 'undefined');
+ });
diff --git a/world/kernel.js b/world/kernel.js
new file mode 100644
index 0000000..a8f2642
--- /dev/null
+++ b/world/kernel.js
@@ -0,0 +1,1739 @@
+var world = {};
+world.Kernel = {};
+
+EXPORTS['_kernel'] = world.Kernel;
+
+var types = plt.types;
+
+
+
+
+var worldListeners = [];
+var stopped;
+var timerInterval = false;
+
+
+// Inheritance from pg 168: Javascript, the Definitive Guide.
+var heir = function(p) {
+ var f = function() {}
+ f.prototype = p;
+ return new f();
+}
+
+
+// clone: object -> object
+// Copies an object. The new object should respond like the old
+// object, including to things like instanceof
+var clone = function(obj) {
+ var C = function() {}
+ C.prototype = obj;
+ var c = new C();
+ for (property in obj) {
+ if (obj.hasOwnProperty(property)) {
+ c[property] = obj[property];
+ }
+ }
+ return c;
+};
+
+
+
+
+var announceListeners = [];
+world.Kernel.addAnnounceListener = function(listener) {
+ announceListeners.push(listener);
+};
+world.Kernel.removeAnnounceListener = function(listener) {
+ var idx = announceListeners.indexOf(listener);
+ if (idx != -1) {
+ announceListeners.splice(idx, 1);
+ }
+};
+world.Kernel.announce = function(eventName, vals) {
+ for (var i = 0; i < announceListeners.length; i++) {
+ try {
+ announceListeners[i](eventName, vals);
+ } catch (e) {}
+ }
+};
+
+
+
+
+
+
+
+
+
+
+// changeWorld: world -> void
+// Changes the current world to newWorld.
+var changeWorld = function(newWorld) {
+ world = newWorld;
+ notifyWorldListeners();
+}
+
+
+// updateWorld: (world -> world) -> void
+// Public function: update the world, given the old state of the
+// world.
+world.Kernel.updateWorld = function(updater) {
+ var newWorld = updater(world);
+ changeWorld(newWorld);
+}
+
+
+world.Kernel.shutdownWorld = function() {
+ stopped = true;
+};
+
+
+// notifyWorldListeners: -> void
+// Tells all of the world listeners that the world has changed.
+var notifyWorldListeners = function() {
+ var i;
+ for (i = 0; i < worldListeners.length; i++) {
+ worldListeners[i](world);
+ }
+}
+
+// addWorldListener: (world -> void) -> void
+// Adds a new world listener: whenever the world is changed, the aListener
+// will be called with that new world.
+var addWorldListener = function(aListener) {
+ worldListeners.push(aListener);
+}
+
+
+// getKeyCodeName: keyEvent -> String
+// Given an event, try to get the name of the key.
+var getKeyCodeName = function(e) {
+ var code = e.charCode || e.keyCode;
+ var keyname;
+ if (code == 37) {
+ keyname = "left";
+ } else if (code == 38) {
+ keyname = "up";
+ } else if (code == 39) {
+ keyname = "right";
+ } else if (code == 40) {
+ keyname = "down";
+ } else {
+ keyname = String.fromCharCode(code);
+ }
+ return keyname;
+}
+
+
+// resetWorld: -> void
+// Resets all of the world global values.
+var resetWorld = function() {
+ if (timerInterval) {
+ clearInterval(timerInterval);
+ timerInterval = false;
+ }
+ stopped = false;
+ worldListeners = [];
+}
+
+
+var getBigBangWindow = function(width, height) {
+ if (window.document.getElementById("canvas") != undefined) {
+ return window;
+ }
+
+ var newWindow = window.open(
+ "big-bang.html",
+ "big-bang");
+ //"toolbar=false,location=false,directories=false,status=false,menubar=false,width="+width+",height="+height);
+ if (newWindow == null) {
+ throw new Error("Error: Not allowed to create a new window."); }
+
+ return newWindow;
+}
+
+
+
+// scheduleTimerTick: -> void
+// Repeatedly schedules an evaluation of the onTick until the program has stopped.
+var scheduleTimerTick = function(window, config) {
+ timerInterval = window.setInterval(
+ function() {
+ if (stopped) {
+ window.clearTimeout(timerInterval);
+ timerInterval = false;
+ }
+ else {
+ world.Kernel.stimuli.onTick();
+ }
+ },
+ config.lookup('tickDelay'));
+}
+
+
+
+
+// Base class for all images.
+var BaseImage = function(pinholeX, pinholeY) {
+ this.pinholeX = pinholeX;
+ this.pinholeY = pinholeY;
+}
+world.Kernel.BaseImage = BaseImage;
+
+
+var isImage = function(thing) {
+ return (thing !== null &&
+ thing !== undefined &&
+ thing instanceof BaseImage);
+}
+
+
+
+BaseImage.prototype.updatePinhole = function(x, y) {
+ var aCopy = clone(this);
+ aCopy.pinholeX = x;
+ aCopy.pinholeY = y;
+ return aCopy;
+};
+
+
+
+// render: context fixnum fixnum: -> void
+// Render the image, where the upper-left corner of the image is drawn at
+// (x, y).
+// NOTE: the rendering should be oblivous to the pinhole.
+BaseImage.prototype.render = function(ctx, x, y) {
+ throw new Error('BaseImage.render unimplemented!');
+ // plt.Kernel.throwMobyError(
+ // false,
+ // "make-moby-error-type:generic-runtime-error",
+ // "Unimplemented method render");
+};
+
+
+// makeCanvas: number number -> canvas
+// Constructs a canvas object of a particular width and height.
+world.Kernel.makeCanvas = function(width, height) {
+ var canvas = document.createElement("canvas");
+ canvas.width = width;
+ canvas.height = height;
+
+ canvas.style.width = canvas.width + "px";
+ canvas.style.height = canvas.height + "px";
+
+ // KLUDGE: IE compatibility uses /js/excanvas.js, and dynamic
+ // elements must be marked this way.
+ if (window && typeof window.G_vmlCanvasManager != 'undefined') {
+ canvas = window.G_vmlCanvasManager.initElement(canvas);
+ }
+ return canvas;
+};
+
+
+
+var withIeHack = function(canvas, f) {
+ // canvas.style.display = 'none';
+ // document.body.appendChild(canvas);
+ // try {
+ var result = f(canvas);
+ // } catch(e) {
+ // document.body.removeChild(canvas);
+ // canvas.style.display = '';
+ // throw e;
+ // }
+ // document.body.removeChild(canvas);
+ // canvas.style.display = '';
+ return result;
+};
+
+
+BaseImage.prototype.toDomNode = function(cache) {
+ var that = this;
+ var width = that.getWidth();
+ var height = that.getHeight();
+ var canvas = world.Kernel.makeCanvas(width, height);
+
+ // KLUDGE: on IE, the canvas rendering functions depend on a
+ // context where the canvas is attached to the DOM tree.
+
+ // We initialize an afterAttach hook; the client's responsible
+ // for calling this after the dom node is attached to the
+ // document.
+ canvas.afterAttach = function() {
+ var ctx = canvas.getContext("2d");
+ that.render(ctx, 0, 0);
+ };
+
+ return canvas;
+};
+
+
+
+
+BaseImage.prototype.toWrittenString = function(cache) { return ""; }
+BaseImage.prototype.toDisplayedString = function(cache) { return ""; }
+
+BaseImage.prototype.isEqual = function(other, aUnionFind) {
+ return (this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY);
+};
+
+
+
+
+// isScene: any -> boolean
+// Produces true when x is a scene.
+var isScene = function(x) {
+ return ((x != undefined) && (x != null) && (x instanceof SceneImage));
+};
+
+// SceneImage: primitive-number primitive-number (listof image) -> Scene
+var SceneImage = function(width, height, children, withBorder) {
+ BaseImage.call(this, 0, 0);
+ this.width = width;
+ this.height = height;
+ this.children = children; // arrayof [image, number, number]
+ this.withBorder = withBorder;
+}
+SceneImage.prototype = heir(BaseImage.prototype);
+
+
+// add: image primitive-number primitive-number -> Scene
+SceneImage.prototype.add = function(anImage, x, y) {
+ return new SceneImage(this.width,
+ this.height,
+ this.children.concat([[anImage,
+ x - anImage.pinholeX,
+ y - anImage.pinholeY]]),
+ this.withBorder);
+};
+
+// render: 2d-context primitive-number primitive-number -> void
+SceneImage.prototype.render = function(ctx, x, y) {
+ var i;
+ var childImage, childX, childY;
+ // Clear the scene.
+ ctx.clearRect(x, y, this.width, this.height);
+ // Then ask every object to render itself.
+ for(i = 0; i < this.children.length; i++) {
+ childImage = this.children[i][0];
+ childX = this.children[i][1];
+ childY = this.children[i][2];
+ ctx.save();
+ childImage.render(ctx, childX + x, childY + y);
+ ctx.restore();
+
+
+ }
+ // Finally, draw the black border if withBorder is true
+ if (this.withBorder) {
+ ctx.strokeStyle = 'black';
+ ctx.strokeRect(x, y, this.width, this.height);
+ }
+};
+
+SceneImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+SceneImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+SceneImage.prototype.isEqual = function(other, aUnionFind) {
+ if (!(other instanceof SceneImage)) {
+ return false;
+ }
+
+ if (this.pinholeX != other.pinholeX ||
+ this.pinholeY != other.pinholeY ||
+ this.width != other.width ||
+ this.height != other.height ||
+ this.children.length != other.children.length) {
+ return false;
+ }
+
+ for (var i = 0; i < this.children.length; i++) {
+ var rec1 = this.children[i];
+ var rec2 = other.children[i];
+ if (rec1[1] !== rec2[1] ||
+ rec1[2] !== rec2[2] ||
+ !types.isEqual(rec1[0],
+ rec2[0],
+ aUnionFind)) {
+ return false;
+ }
+ }
+ return true;
+};
+
+
+//////////////////////////////////////////////////////////////////////
+
+
+var FileImage = function(src, rawImage) {
+ BaseImage.call(this, 0, 0);
+ var self = this;
+ this.src = src;
+ this.isLoaded = false;
+ if (rawImage && rawImage.complete) {
+ this.img = rawImage;
+ this.isLoaded = true;
+ this.pinholeX = self.img.width / 2;
+ this.pinholeY = self.img.height / 2;
+ } else {
+ // fixme: we may want to do something blocking here for
+ // onload, since we don't know at this time what the file size
+ // should be, nor will drawImage do the right thing until the
+ // file is loaded.
+ this.img = new Image();
+ this.img.onload = function() {
+ self.isLoaded = true;
+ self.pinholeX = self.img.width / 2;
+ self.pinholeY = self.img.height / 2;
+ };
+ this.img.onerror = function(e) {
+ self.img.onerror = "";
+ self.img.src = "http://www.wescheme.org/images/broken.png";
+ }
+ this.img.src = src;
+ }
+}
+FileImage.prototype = heir(BaseImage.prototype);
+// world.Kernel.FileImage = FileImage;
+
+
+var imageCache = {};
+FileImage.makeInstance = function(path, rawImage) {
+ if (! (path in imageCache)) {
+ imageCache[path] = new FileImage(path, rawImage);
+ }
+ return imageCache[path];
+};
+
+FileImage.installInstance = function(path, rawImage) {
+ imageCache[path] = new FileImage(path, rawImage);
+};
+
+FileImage.installBrokenImage = function(path) {
+ imageCache[path] = new TextImage("Unable to load " + path, 10,
+ colorDb.get("red"));
+};
+
+
+
+FileImage.prototype.render = function(ctx, x, y) {
+ ctx.drawImage(this.img, x, y);
+};
+
+
+FileImage.prototype.getWidth = function() {
+ return this.img.width;
+};
+
+
+FileImage.prototype.getHeight = function() {
+ return this.img.height;
+};
+
+// Override toDomNode: we don't need a full-fledged canvas here.
+FileImage.prototype.toDomNode = function(cache) {
+ return this.img.cloneNode(true);
+};
+
+FileImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof FileImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.src == other.src);
+ // types.isEqual(this.img, other.img, aUnionFind));
+};
+
+
+//////////////////////////////////////////////////////////////////////
+
+
+// OverlayImage: image image -> image
+// Creates an image that overlays img1 on top of the
+// other image. shiftX and shiftY are deltas off the first
+// image's pinhole.
+var OverlayImage = function(img1, img2, shiftX, shiftY) {
+ var deltaX = img1.pinholeX - img2.pinholeX + shiftX;
+ var deltaY = img1.pinholeY - img2.pinholeY + shiftY;
+ var left = Math.min(0, deltaX);
+ var top = Math.min(0, deltaY);
+ var right = Math.max(deltaX + img2.getWidth(),
+ img1.getWidth());
+ var bottom = Math.max(deltaY + img2.getHeight(),
+ img1.getHeight());
+
+ BaseImage.call(this,
+ Math.floor((right-left) / 2),
+ Math.floor((bottom-top) / 2));
+ this.img1 = img1;
+ this.img2 = img2;
+ this.width = right - left;
+ this.height = bottom - top;
+
+ this.img1Dx = -left;
+ this.img1Dy = -top;
+ this.img2Dx = deltaX - left;
+ this.img2Dy = deltaY - top;
+};
+
+OverlayImage.prototype = heir(BaseImage.prototype);
+
+
+OverlayImage.prototype.render = function(ctx, x, y) {
+ this.img2.render(ctx, x + this.img2Dx, y + this.img2Dy);
+ this.img1.render(ctx, x + this.img1Dx, y + this.img1Dy);
+};
+
+
+OverlayImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+OverlayImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+OverlayImage.prototype.isEqual = function(other, aUnionFind) {
+ return ( other instanceof OverlayImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.width == other.width &&
+ this.height == other.height &&
+ this.img1Dx == other.img1Dx &&
+ this.img1Dy == other.img1Dy &&
+ this.img2Dx == other.img2Dx &&
+ this.img2Dy == other.img2Dy &&
+ types.isEqual(this.img1, other.img1, aUnionFind) &&
+ types.isEqual(this.img2, other.img2, aUnionFind) );
+};
+
+
+//////////////////////////////////////////////////////////////////////
+
+
+// rotate: angle image -> image
+// Rotates image by angle degrees in a counter-clockwise direction.
+// based on http://stackoverflow.com/questions/3276467/adjusting-div-width-and-height-after-rotated
+var RotateImage = function(angle, img) {
+ var sin = Math.sin(angle * Math.PI / 180),
+ cos = Math.cos(angle * Math.PI / 180);
+
+ // (w,0) rotation
+ var x1 = Math.floor(cos * img.getWidth()),
+ y1 = Math.floor(sin * img.getWidth());
+
+ // (0,h) rotation
+ var x2 = Math.floor(-sin * img.getHeight()),
+ y2 = Math.floor( cos * img.getHeight());
+
+ // (w,h) rotation
+ var x3 = Math.floor(cos * img.getWidth() - sin * img.getHeight()),
+ y3 = Math.floor(sin * img.getWidth() + cos * img.getHeight());
+
+ var minX = Math.min(0, x1, x2, x3),
+ maxX = Math.max(0, x1, x2, x3),
+ minY = Math.min(0, y1, y2, y3),
+ maxY = Math.max(0, y1, y2, y3);
+
+ var rotatedWidth = maxX - minX,
+ rotatedHeight = maxY - minY;
+
+ // resize the image
+ BaseImage.call(this,
+ Math.floor(rotatedWidth / 2),
+ Math.floor(rotatedHeight / 2));
+
+ this.img = img;
+ this.width = rotatedWidth;
+ this.height = rotatedHeight;
+ this.angle = angle;
+ this.translateX = -minX;
+ this.translateY = -minY;
+};
+
+RotateImage.prototype = heir(BaseImage.prototype);
+
+
+// translate drawing point, so that this.img appears in the UL corner. Then rotate and render this.img.
+RotateImage.prototype.render = function(ctx, x, y) {
+ ctx.translate(this.translateX, this.translateY);
+ ctx.rotate(this.angle * Math.PI / 180);
+ this.img.render(ctx, x, y);
+ ctx.restore();
+};
+
+
+RotateImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+RotateImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+RotateImage.prototype.isEqual = function(other, aUnionFind) {
+ return ( other instanceof RotateImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.width == other.width &&
+ this.height == other.height &&
+ this.angle == other.angle &&
+ this.translateX == other.translateX &&
+ this.translateY == other.translateY &&
+ types.isEqual(this.img, other.img, aUnionFind) );
+};
+
+//////////////////////////////////////////////////////////////////////
+
+
+// ScaleImage: factor factor image -> image
+// Scale an image
+var ScaleImage = function(xFactor, yFactor, img) {
+
+ // resize the image
+ BaseImage.call(this,
+ Math.floor((img.getWidth() * xFactor) / 2),
+ Math.floor((img.getHeight() * yFactor) / 2));
+
+ this.img = img;
+ this.width = img.getWidth() * xFactor;
+ this.height = img.getHeight() * yFactor;
+ this.xFactor = xFactor;
+ this.yFactor = yFactor;
+};
+
+ScaleImage.prototype = heir(BaseImage.prototype);
+
+
+// scale the context, and pass it to the image's render function
+ScaleImage.prototype.render = function(ctx, x, y) {
+ ctx.save();
+ ctx.scale(this.xFactor, this.yFactor);
+ this.img.render(ctx, x, y);
+ ctx.restore();
+};
+
+
+ScaleImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+ScaleImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+ScaleImage.prototype.isEqual = function(other, aUnionFind) {
+ return ( other instanceof ScaleImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.width == other.width &&
+ this.height == other.height &&
+ this.xFactor == other.xFactor &&
+ this.yFactor == other.yFactor &&
+ types.isEqual(this.img, other.img, aUnionFind) );
+};
+
+//////////////////////////////////////////////////////////////////////
+
+
+
+var colorString = function(aColor) {
+ return ("rgb(" +
+ types.colorRed(aColor) + "," +
+ types.colorGreen(aColor) + ", " +
+ types.colorBlue(aColor) + ")");
+};
+
+
+
+var RectangleImage = function(width, height, style, color) {
+ BaseImage.call(this, width/2, height/2);
+ this.width = width;
+ this.height = height;
+ this.style = style;
+ this.color = color;
+};
+RectangleImage.prototype = heir(BaseImage.prototype);
+
+
+RectangleImage.prototype.render = function(ctx, x, y) {
+ if (this.style.toString().toLowerCase() == "outline") {
+ ctx.save();
+ ctx.beginPath();
+ ctx.strokeStyle = colorString(this.color);
+ ctx.strokeRect(x, y, this.width, this.height);
+ ctx.closePath();
+ ctx.restore();
+ } else {
+ ctx.save();
+ ctx.beginPath();
+
+ ctx.fillStyle = colorString(this.color);
+ ctx.fillRect(x, y, this.width, this.height);
+
+ ctx.closePath();
+ ctx.restore();
+ }
+};
+
+RectangleImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+
+RectangleImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+RectangleImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof RectangleImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.width == other.width &&
+ this.height == other.height &&
+ this.style == other.style &&
+ types.isEqual(this.color, other.color, aUnionFind));
+};
+
+
+//////////////////////////////////////////////////////////////////////
+
+var TextImage = function(msg, size, color) {
+ BaseImage.call(this, 0, 0);
+ this.msg = msg;
+ this.size = size;
+ this.color = color;
+ this.font = this.size + "px Optimer";
+
+
+ var canvas = world.Kernel.makeCanvas(0, 0);
+ var ctx = canvas.getContext("2d");
+ ctx.font = this.font;
+ var metrics = ctx.measureText(msg);
+
+ this.width = metrics.width;
+ // KLUDGE: I don't know how to get at the height.
+ this.height = ctx.measureText("m").width + 20;
+
+}
+
+TextImage.prototype = heir(BaseImage.prototype);
+
+TextImage.prototype.render = function(ctx, x, y) {
+ ctx.save();
+ ctx.font = this.font;
+ ctx.textAlign = 'left';
+ ctx.textBaseline = 'top';
+ ctx.fillStyle = colorString(this.color);
+ ctx.fillText(this.msg, x, y);
+ ctx.restore();
+};
+
+TextImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+
+TextImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+TextImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof TextImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.msg == other.msg &&
+ this.size == other.size &&
+ types.isEqual(this.color, other.color, aUnionFind) &&
+ this.font == other.font);
+};
+
+
+//////////////////////////////////////////////////////////////////////
+
+var CircleImage = function(radius, style, color) {
+ BaseImage.call(this, radius, radius);
+ this.radius = radius;
+ this.style = style;
+ this.color = color;
+}
+CircleImage.prototype = heir(BaseImage.prototype);
+
+CircleImage.prototype.render = function(ctx, x, y) {
+ ctx.save();
+ ctx.beginPath();
+ ctx.arc(x + this.radius,
+ y + this.radius,
+ this.radius, 0, 2*Math.PI, false);
+ ctx.closePath();
+ if (this.style.toString().toLowerCase() == "outline") {
+ ctx.strokeStyle = colorString(this.color);
+ ctx.stroke();
+ } else {
+ ctx.fillStyle = colorString(this.color);
+ ctx.fill();
+ }
+
+ ctx.restore();
+};
+
+CircleImage.prototype.getWidth = function() {
+ return this.radius * 2;
+};
+
+CircleImage.prototype.getHeight = function() {
+ return this.radius * 2;
+};
+
+CircleImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof CircleImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.radius == other.radius &&
+ this.style == other.style &&
+ types.isEqual(this.color, other.color, aUnionFind));
+};
+
+
+
+//////////////////////////////////////////////////////////////////////
+
+
+// StarImage: fixnum fixnum fixnum color -> image
+var StarImage = function(points, outer, inner, style, color) {
+ BaseImage.call(this,
+ Math.max(outer, inner),
+ Math.max(outer, inner));
+ this.points = points;
+ this.outer = outer;
+ this.inner = inner;
+ this.style = style;
+ this.color = color;
+
+ this.radius = Math.max(this.inner, this.outer);
+};
+
+StarImage.prototype = heir(BaseImage.prototype);
+
+var oneDegreeAsRadian = Math.PI / 180;
+
+// render: context fixnum fixnum -> void
+// Draws a star on the given context.
+// Most of this code here adapted from the Canvas tutorial at:
+// http://developer.apple.com/safari/articles/makinggraphicswithcanvas.html
+StarImage.prototype.render = function(ctx, x, y) {
+ ctx.save();
+ ctx.beginPath();
+ for( var pt = 0; pt < (this.points * 2) + 1; pt++ ) {
+ var rads = ( ( 360 / (2 * this.points) ) * pt ) * oneDegreeAsRadian - 0.5;
+ var radius = ( pt % 2 == 1 ) ? this.outer : this.inner;
+ ctx.lineTo(x + this.radius + ( Math.sin( rads ) * radius ),
+ y + this.radius + ( Math.cos( rads ) * radius ) );
+ }
+ ctx.closePath();
+ if (this.style.toString().toLowerCase() == "outline") {
+ ctx.strokeStyle = colorString(this.color);
+ ctx.stroke();
+ } else {
+ ctx.fillStyle = colorString(this.color);
+ ctx.fill();
+ }
+
+ ctx.restore();
+};
+
+// getWidth: -> fixnum
+StarImage.prototype.getWidth = function() {
+ return this.radius * 2;
+};
+
+
+// getHeight: -> fixnum
+StarImage.prototype.getHeight = function() {
+ return this.radius * 2;
+};
+
+StarImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof StarImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.points == other.points &&
+ this.outer == other.outer &&
+ this.inner == other.inner &&
+ this.style == other.style &&
+ types.isEqual(this.color, other.color, aUnionFind));
+};
+
+
+
+
+//////////////////////////////////////////////////////////////////////
+//Triangle
+///////
+var TriangleImage = function(side, style, color) {
+ this.width = side;
+ this.height = Math.ceil(side * Math.sqrt(3) / 2);
+
+ BaseImage.call(this, Math.floor(this.width/2), Math.floor(this.height/2));
+ this.side = side;
+ this.style = style;
+ this.color = color;
+}
+TriangleImage.prototype = heir(BaseImage.prototype);
+
+
+TriangleImage.prototype.render = function(ctx, x, y) {
+ var width = this.getWidth();
+ var height = this.getHeight();
+ ctx.save();
+ ctx.beginPath();
+ ctx.moveTo(x + this.side/2, y);
+ ctx.lineTo(x + width, y + height);
+ ctx.lineTo(x, y + height);
+ ctx.closePath();
+
+ if (this.style.toString().toLowerCase() == "outline") {
+ ctx.strokeStyle = colorString(this.color);
+ ctx.stroke();
+ }
+ else {
+ ctx.fillStyle = colorString(this.color);
+ ctx.fill();
+ }
+ ctx.restore();
+};
+
+
+
+TriangleImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+TriangleImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+TriangleImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof TriangleImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.side == other.side &&
+ this.style == other.style &&
+ types.isEqual(this.color, other.color, aUnionFind));
+};
+
+
+
+//////////////////////////////////////////////////////////////////////
+//Ellipse
+var EllipseImage = function(width, height, style, color) {
+ BaseImage.call(this, Math.floor(width/2), Math.floor(height/2));
+ this.width = width;
+ this.height = height;
+ this.style = style;
+ this.color = color;
+};
+
+EllipseImage.prototype = heir(BaseImage.prototype);
+
+
+EllipseImage.prototype.render = function(ctx, aX, aY) {
+ ctx.save();
+ ctx.beginPath();
+
+ // Most of this code is taken from:
+ // http://webreflection.blogspot.com/2009/01/ellipse-and-circle-for-canvas-2d.html
+ var hB = (this.width / 2) * .5522848,
+ vB = (this.height / 2) * .5522848,
+ eX = aX + this.width,
+ eY = aY + this.height,
+ mX = aX + this.width / 2,
+ mY = aY + this.height / 2;
+ ctx.moveTo(aX, mY);
+ ctx.bezierCurveTo(aX, mY - vB, mX - hB, aY, mX, aY);
+ ctx.bezierCurveTo(mX + hB, aY, eX, mY - vB, eX, mY);
+ ctx.bezierCurveTo(eX, mY + vB, mX + hB, eY, mX, eY);
+ ctx.bezierCurveTo(mX - hB, eY, aX, mY + vB, aX, mY);
+ ctx.closePath();
+ if (this.style.toString().toLowerCase() == "outline") {
+ ctx.strokeStyle = colorString(this.color);
+ ctx.stroke();
+ }
+ else {
+ ctx.fillStyle = colorString(this.color);
+ ctx.fill();
+ }
+
+
+ ctx.restore();
+};
+
+EllipseImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+EllipseImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+EllipseImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof EllipseImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.width == other.width &&
+ this.height == other.height &&
+ this.style == other.style &&
+ types.isEqual(this.color, other.color, aUnionFind));
+};
+
+
+//////////////////////////////////////////////////////////////////////
+//Line
+var LineImage = function(x, y, color) {
+ if (x >= 0) {
+ if (y >= 0) {
+ BaseImage.call(this, 0, 0);
+ } else {
+ BaseImage.call(this, 0, -y);
+ }
+ } else {
+ if (y >= 0) {
+ BaseImage.call(this, -x, 0);
+ } else {
+ BaseImage.call(this, -x, -y);
+ }
+ }
+
+
+ this.x = x;
+ this.y = y;
+ this.color = color;
+ this.width = Math.abs(x) + 1;
+ this.height = Math.abs(y) + 1;
+}
+
+LineImage.prototype = heir(BaseImage.prototype);
+
+
+LineImage.prototype.render = function(ctx, xstart, ystart) {
+ ctx.save();
+
+ if (this.x >= 0) {
+ if (this.y >= 0) {
+ ctx.moveTo(xstart, ystart);
+ ctx.lineTo((xstart + this.x),
+ (ystart + this.y));
+ } else {
+ ctx.moveTo(xstart, ystart + (-this.y));
+ ctx.lineTo(xstart + this.x, ystart);
+ }
+ } else {
+ if (this.y >= 0) {
+ ctx.moveTo(xstart + (-this.x), ystart);
+ ctx.lineTo(xstart,
+ (ystart + this.y));
+ } else {
+ ctx.moveTo(xstart + (-this.x), ystart + (-this.y));
+ ctx.lineTo(xstart, ystart);
+ }
+ }
+ ctx.strokeStyle = colorString(this.color);
+ ctx.stroke();
+ ctx.restore();
+};
+
+
+LineImage.prototype.getWidth = function() {
+ return this.width;
+};
+
+
+LineImage.prototype.getHeight = function() {
+ return this.height;
+};
+
+LineImage.prototype.isEqual = function(other, aUnionFind) {
+ return (other instanceof LineImage &&
+ this.pinholeX == other.pinholeX &&
+ this.pinholeY == other.pinholeY &&
+ this.x == other.x &&
+ this.y == other.y &&
+ types.isEqual(this.color, other.color, aUnionFind));
+};
+
+
+
+
+
+//////////////////////////////////////////////////////////////////////
+// Effects
+
+/**
+ * applyEffect: compound-effect -> (arrayof (world -> world))
+
+ applyEffect applies all of the effects
+
+ @param aCompEffect a compound effect is either a scheme list of
+ compound effects or a single primitive effect */
+world.Kernel.applyEffect = function(aCompEffect) {
+ if ( types.isEmpty(aCompEffect) ) {
+ // Do Nothing
+ } else if ( types.isPair(aCompEffect) ) {
+ var results = world.Kernel.applyEffect(aCompEffect.first());
+ return results.concat(world.Kernel.applyEffect(aCompEffect.rest()));
+ } else {
+ var newResult = aCompEffect.run();
+ if (newResult) {
+ return newResult;
+ }
+ }
+ return [];
+}
+
+//////////////////////////////////////////////////////////////////////////
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+///////////////////////////////////////////////////////////////
+// Exports
+
+world.Kernel.isImage = isImage;
+world.Kernel.isScene = isScene;
+world.Kernel.isColor = function(thing) {
+ return (types.isColor(thing) ||
+ ((types.isString(thing) || types.isSymbol(thing)) &&
+ typeof(colorDb.get(thing)) != 'undefined'));
+};
+world.Kernel.colorDb = colorDb;
+
+world.Kernel.sceneImage = function(width, height, children, withBorder) {
+ return new SceneImage(width, height, children, withBorder);
+};
+world.Kernel.circleImage = function(radius, style, color) {
+ return new CircleImage(radius, style, color);
+};
+world.Kernel.starImage = function(points, outer, inner, style, color) {
+ return new StarImage(points, outer, inner, style, color);
+};
+world.Kernel.rectangleImage = function(width, height, style, color) {
+ return new RectangleImage(width, height, style, color);
+};
+world.Kernel.triangleImage = function(side, style, color) {
+ return new TriangleImage(side, style, color);
+};
+world.Kernel.ellipseImage = function(width, height, style, color) {
+ return new EllipseImage(width, height, style, color);
+};
+world.Kernel.lineImage = function(x, y, color) {
+ return new LineImage(x, y, color);
+};
+world.Kernel.overlayImage = function(img1, img2, shiftX, shiftY) {
+ return new OverlayImage(img1, img2, shiftX, shiftY);
+};
+world.Kernel.rotateImage = function(angle, img) {
+ return new RotateImage(angle, img);
+};
+world.Kernel.scaleImage = function(xFactor, yFactor, img) {
+ return new ScaleImage(xFactor, yFactor, img);
+};
+world.Kernel.textImage = function(msg, size, color) {
+ return new TextImage(msg, size, color);
+};
+world.Kernel.fileImage = function(path, rawImage) {
+ return FileImage.makeInstance(path, rawImage);
+};
+
+
+world.Kernel.isSceneImage = function(x) { return x instanceof SceneImage; };
+world.Kernel.isCircleImage = function(x) { return x instanceof CircleImage; };
+world.Kernel.isStarImage = function(x) { return x instanceof StarImage; };
+world.Kernel.isRectangleImage = function(x) { return x instanceof RectangleImage; };
+world.Kernel.isTriangleImage = function(x) { return x instanceof TriangleImage; };
+world.Kernel.isEllipseImage = function(x) { return x instanceof EllipseImage; };
+world.Kernel.isLineImage = function(x) { return x instanceof LineImage; };
+world.Kernel.isOverlayImage = function(x) { return x instanceof OverlayImage; };
+world.Kernel.isRotateImage = function(x) { return x instanceof RotateImage; };
+world.Kernel.isTextImage = function(x) { return x instanceof TextImage; };
+world.Kernel.isFileImage = function(x) { return x instanceof FileImage; };
+
+
+
+
+
+
+
+//////////////////////////////////////////////////////////////////////
+//////////////////////////////////////////////////////////////////////
+//////////////////////////////////////////////////////////////////////
+
+
+// Feeds stimuli inputs into the world. The functions here
+// are responsible for converting to Scheme values.
+//
+// NOTE and WARNING: make sure to really do the coersions, even for
+// strings. Bad things happen otherwise, as in the sms stuff, where
+// we're getting string-like values that aren't actually strings.
+
+
+
+world.stimuli = {};
+world.Kernel.stimuli = world.stimuli;
+
+
+(function() {
+ var handlers = [];
+
+ var doNothing = function() {};
+
+
+ var StimuliHandler = function(config, caller, restarter) {
+ this.config = config;
+ this.caller = caller;
+ this.restarter = restarter;
+ handlers.push(this);
+ };
+
+ // StimuliHandler.prototype.failHandler = function(e) {
+ // this.onShutdown();
+ // this.restarter(e);
+ // };
+
+ // doStimuli: CPS( (world -> effect) (world -> world) -> void )
+ //
+ // Processes a stimuli by compute the effect and applying it, and
+ // computing a new world to replace the old.
+ StimuliHandler.prototype.doStimuli = function(computeEffectF, computeWorldF, restArgs, k) {
+ var effectUpdaters = [];
+ var that = this;
+ try {
+ that.change(function(w, k2) {
+ var args = [w].concat(restArgs);
+ var doStimuliHelper = function() {
+ if (computeWorldF) {
+ that.caller(computeWorldF, args, k2);
+ } else {
+ k2(w);
+ }
+ };
+ doStimuliHelper();
+ }, k);
+ // if (computeEffectF) {
+ // that.caller(computeEffectF, [args],
+ // function(effect) {
+ // effectUpdaters = applyEffect(effect);
+ // doStimuliHelper();
+ // },
+ // this.failHandler);
+ // }
+ // else { doStimuliHelper(); }
+ // },
+ // function() {
+ // helpers.forEachK(effectUpdaters,
+ // function(effect, k2) { that.change(effect, k2); },
+ // function(e) { throw e; },
+ // k);
+ // });
+ } catch (e) {
+ // if (console && console.log && e.stack) {
+ // console.log(e.stack);
+ // }
+ this.onShutdown();
+ }
+ }
+
+
+ // Orientation change
+ // args: [azimuth, pitch, roll]
+ StimuliHandler.prototype.onTilt = function(args, k) {
+ var onTilt = this.lookup("onTilt");
+ var onTiltEffect = this.lookup("onTiltEffect");
+ this.doStimuli(onTiltEffect, onTilt, helpers.map(flt, args), k);
+ };
+
+
+ // Accelerations
+ // args: [x, y, z]
+ StimuliHandler.prototype.onAcceleration = function(args, k) {
+ var onAcceleration = this.lookup('onAcceleration');
+ var onAccelerationEffect = this.lookup('onAccelerationEffect');
+ this.doStimuli(onAccelerationEffect, onAcceleration, helpers.map(flt, args), k);
+ };
+
+
+ // Shakes
+ // args: []
+ StimuliHandler.prototype.onShake = function(args, k) {
+ var onShake = this.lookup('onShake');
+ var onShakeEffect = this.lookup('onShakeEffect');
+ this.doStimuli(onShakeEffect, onShake, [], k);
+ };
+
+
+ // Sms receiving
+ // args: [sender, message]
+ StimuliHandler.prototype.onSmsReceive = function(args, k) {
+ var onSmsReceive = this.lookup('onSmsReceive');
+ var onSmsReceiveEffect = this.lookup('onSmsReceiveEffect');
+ // IMPORTANT: must coerse to string by using x+"". Do not use
+ // toString(): it's not safe.
+ this.doStimuli(onSmsReceiveEffect, onSmsReceive, [args[0]+"", args[1]+""], k);
+ };
+
+
+ // Locations
+ // args: [lat, lng]
+ StimuliHandler.prototype.onLocation = function(args, k) {
+ var onLocationChange = this.lookup('onLocationChange');
+ var onLocationChangeEffect = this.lookup('onLocationChangeEffect');
+ this.doStimuli(onLocationChangeEffect, onLocationChange, helpers.map(flt, args), k);
+ };
+
+
+
+ // Keystrokes
+ // args: [e]
+ StimuliHandler.prototype.onKey = function(args, k) {
+ // getKeyCodeName: keyEvent -> String
+ // Given an event, try to get the name of the key.
+ var getKeyCodeName = function(e) {
+ var code = e.charCode || e.keyCode;
+ var keyname;
+ switch(code) {
+ case 16: keyname = "shift"; break;
+ case 17: keyname = "control"; break;
+ case 19: keyname = "pause"; break;
+ case 27: keyname = "escape"; break;
+ case 33: keyname = "prior"; break;
+ case 34: keyname = "next"; break;
+ case 35: keyname = "end"; break;
+ case 36: keyname = "home"; break;
+ case 37: keyname = "left"; break;
+ case 38: keyname = "up"; break;
+ case 39: keyname = "right"; break;
+ case 40: keyname = "down"; break;
+ case 42: keyname = "print"; break;
+ case 45: keyname = "insert"; break;
+ case 46: keyname = String.fromCharCode(127); break;
+ case 106: keyname = "*"; break;
+ case 107: keyname = "+"; break;
+ case 109: keyname = "-"; break;
+ case 110: keyname = "."; break;
+ case 111: keyname = "/"; break;
+ case 144: keyname = "numlock"; break;
+ case 145: keyname = "scroll"; break;
+ case 186: keyname = ";"; break;
+ case 187: keyname = "="; break;
+ case 188: keyname = ","; break;
+ case 189: keyname = "-"; break;
+ case 190: keyname = "."; break;
+ case 191: keyname = "/"; break;
+ case 192: keyname = "`"; break;
+ case 219: keyname = "["; break;
+ case 220: keyname = "\\"; break;
+ case 221: keyname = "]"; break;
+ case 222: keyname = "'"; break;
+ default: if (code >= 96 && code <= 105) {
+ keyname = (code - 96).toString();
+ }
+ else if (code >= 112 && code <= 123) {
+ keyname = "f" + (code - 111);
+ }
+ else {
+ keyname = String.fromCharCode(code).toLowerCase();
+ }
+ break;
+ }
+ return keyname;
+ }
+ var keyname = getKeyCodeName(args[0]);
+ var onKey = this.lookup('onKey');
+ var onKeyEffect = this.lookup('onKeyEffect');
+ this.doStimuli(onKeyEffect, onKey, [keyname], k);
+ };
+
+
+
+ // // Time ticks
+ // // args: []
+ // StimuliHandler.prototype.onTick = function(args, k) {
+ // var onTick = this.lookup('onTick');
+ // var onTickEffect = this.lookup('onTickEffect');
+ // this.doStimuli(onTickEffect, onTick, [], k);
+ // };
+
+
+
+ // Announcements
+ // args: [eventName, vals]
+ StimuliHandler.prototype.onAnnounce = function(args, k) {
+ var vals = args[1];
+ var valsList = types.EMPTY;
+ for (var i = 0; i < vals.length; i++) {
+ valsList = types.cons(vals[vals.length - i - 1], valsList);
+ }
+
+ var onAnnounce = this.lookup('onAnnounce');
+ var onAnnounceEffect = this.lookup('onAnnounceEffect');
+ this.doStimuli(onAnnounce, onAnnounceEffect, [args[0], valsList], k);
+ };
+
+
+
+ // The shutdown stimuli: special case that forces a world computation to quit.
+ // Also removes this instance from the list of handlers
+ StimuliHandler.prototype.onShutdown = function() {
+ var index = handlers.indexOf(this);
+ if (index != -1) {
+ handlers.splice(index, 1);
+ }
+
+ var shutdownWorld = this.lookup('shutdownWorld');
+ if (shutdownWorld) {
+ shutdownWorld();
+ }
+ };
+
+
+ //////////////////////////////////////////////////////////////////////
+ // Helpers
+ var flt = types.float;
+
+ StimuliHandler.prototype.lookup = function(s) {
+ return this.config.lookup(s);
+ };
+
+ StimuliHandler.prototype.change = function(f, k) {
+ if (this.lookup('changeWorld')) {
+ this.lookup('changeWorld')(f, k);
+ }
+ else { k(); }
+ };
+
+ // applyEffect: compound-effect: (arrayof (world -> world))
+ var applyEffect = function(e) {
+ return world.Kernel.applyEffect(e);
+ };
+
+ var makeStimulusHandler = function(funName) {
+ return function() {
+ var args = arguments;
+ for (var i = 0; i < handlers.length; i++) {
+ (handlers[i])[funName](args, doNothing);
+ }
+ // helpers.forEachK(handlers,
+ // function(h, k) { h[funName](args, k); },
+ // function(e) { throw e; },
+ // doNothing);
+ }
+ };
+
+ //////////////////////////////////////////////////////////////////////
+ // Exports
+
+ world.stimuli.StimuliHandler = StimuliHandler;
+
+ world.stimuli.onTilt = makeStimulusHandler('onTilt');
+ world.stimuli.onAcceleration = makeStimulusHandler('onAcceleration');
+ world.stimuli.onShake = makeStimulusHandler('onShake');
+ world.stimuli.onSmsReceive = makeStimulusHandler('onSmsReceive');
+ world.stimuli.onLocation = makeStimulusHandler('onLocation');
+ world.stimuli.onKey = makeStimulusHandler('onKey');
+ // world.stimuli.onTick = makeStimulusHandler('onTick');
+ world.stimuli.onAnnounce = makeStimulusHandler('onAnnounce');
+
+ world.stimuli.massShutdown = function() {
+ for (var i = 0; i < handlers.length; i++) {
+ var shutdownWorld = handlers[i].lookup('shutdownWorld');
+ if (shutdownWorld) {
+ shutdownWorld();
+ }
+ }
+ handlers = [];
+ };
+
+
+})();
+
+//////////////////////////////////////////////////////////////////////
+//////////////////////////////////////////////////////////////////////
+//////////////////////////////////////////////////////////////////////
+
+
+
+
+
+
+
+(function() {
+
+// var make_dash_effect_colon_none =
+// (plt.Kernel.invokeModule("moby/runtime/effect-struct")
+// .EXPORTS['make-effect:none']);
+
+ world.config = {};
+ world.Kernel.config = world.config;
+
+
+ // augment: hash hash -> hash
+ // Functionally extend a hashtable with another one.
+ var augment = function(o, a) {
+ var oo = {};
+ for (var e in o) {
+ if (o.hasOwnProperty(e)) {
+ oo[e] = o[e];
+ }
+ }
+ for (var e in a) {
+ if (a.hasOwnProperty(e)) {
+ oo[e] = a[e];
+ }
+ }
+ return oo;
+ }
+
+
+
+ var WorldConfig = function() {
+ // The following handler values are initially false until they're updated
+ // by configuration.
+
+ // A handler is a function:
+ // handler: world X Y ... -> Z
+
+
+ this.vals = {
+ // changeWorld: (world -> world) -> void
+ // When called, this will update the world based on the
+ // updater passed to it.
+ changeWorld: false,
+
+ // shutdownWorld: -> void
+ // When called, this will shut down the world computation.
+ shutdownWorld: false,
+
+ // initialEffect: effect
+ // The initial effect to invoke when the world computation
+ // begins.
+ initialEffect: false,
+
+
+ // onRedraw: world -> scene
+ onRedraw: false,
+
+ // onDraw: world -> (sexpof dom)
+ onDraw: false,
+
+ // onDrawCss: world -> (sexpof css-style)
+ onDrawCss: false,
+
+
+ // tickDelay: number
+ tickDelay: false,
+ // onTick: world -> world
+ onTick: false,
+ // onTickEffect: world -> effect
+ onTickEffect: false,
+
+ // onKey: world key -> world
+ onKey: false,
+ // onKeyEffect: world key -> effect
+ onKeyEffect : false,
+
+ // onTilt: world number number number -> world
+ onTilt: false,
+ // onTiltEffect: world number number number -> effect
+ onTiltEffect: false,
+
+ // onAcceleration: world number number number -> world
+ onAcceleration: false,
+ // onAccelerationEffect: world number number number -> effect
+ onAccelerationEffect: false,
+
+ // onShake: world -> world
+ onShake: false,
+ // onShakeEffect: world -> effect
+ onShakeEffect: false,
+
+ // onSmsReceive: world -> world
+ onSmsReceive: false,
+ // onSmsReceiveEffect: world -> effect
+ onSmsReceiveEffect: false,
+
+ // onLocationChange: world number number -> world
+ onLocationChange : false,
+ // onLocationChangeEffect: world number number -> effect
+ onLocationChangeEffect: false,
+
+
+ // onAnnounce: world string X ... -> world
+ onAnnounce: false,
+ // onAnnounce: world string X ... -> effect
+ onAnnounceEffect: false,
+
+ // stopWhen: world -> boolean
+ stopWhen: false,
+ // stopWhenEffect: world -> effect
+ stopWhenEffect: false,
+
+
+
+ //////////////////////////////////////////////////////////////////////
+ // For universe game playing
+
+ // connectToGame: string
+ // Registers with some universe, given an identifier
+ // which is a URL to a Universe server.
+ connectToGame: false,
+ onGameStart: false,
+ onOpponentTurn: false,
+ onMyTurn: false,
+ afterMyTurn: false,
+ onGameFinish: false
+ };
+ }
+
+
+ // WorldConfig.lookup: string -> handler
+ // Looks up a value in the configuration.
+ WorldConfig.prototype.lookup = function(key) {
+// plt.Kernel.check(key, plt.Kernel.isString, "WorldConfig.lookup", "string", 1);
+ if (key in this.vals) {
+ return this.vals[key];
+ } else {
+ throw Error("Can't find " + key + " in the configuration");
+ }
+ }
+
+
+
+ // WorldConfig.updateAll: (hashof string handler) -> WorldConfig
+ WorldConfig.prototype.updateAll = function(aHash) {
+ var result = new WorldConfig();
+ result.vals = augment(this.vals, aHash);
+ return result;
+ }
+
+
+ world.config.WorldConfig = WorldConfig;
+
+ // The following global variable CONFIG is mutated by either
+ // big-bang from the regular world or the one in jsworld.
+ world.config.CONFIG = new WorldConfig();
+
+
+ // A handler is a function that consumes a config and produces a
+ // config.
+
+
+ //////////////////////////////////////////////////////////////////////
+
+ var getNoneEffect = function() {
+ throw new Error("getNoneEffect: We should not be calling effects!");
+ // return make_dash_effect_colon_none();
+ }
+
+
+
+ //////////////////////////////////////////////////////////////////////
+
+ world.config.Kernel = world.config.Kernel || {};
+ world.config.Kernel.getNoneEffect = getNoneEffect;
+
+
+/*
+ // makeSimplePropertyUpdater: (string (X -> boolean) string string) -> (X -> handler)
+ var makeSimplePropertyUpdater = function(propertyName,
+ propertyPredicate,
+ propertyTypeName,
+ updaterName) {
+ return function(val) {
+ plt.Kernel.check(val, propertyPredicate, updaterName, propertyTypeName, 1);
+ return addStringMethods(
+ function(config) {
+ return config.updateAll({propertyName: val });
+ }, updaterName);
+ }
+ };
+
+ // connects to the game
+ world.config.Kernel.connect_dash_to_dash_game =
+ makeSimplePropertyUpdater('connectToGame',
+ plt.Kernel.isString,
+ "string",
+ "connect-to-game");
+
+
+ // Registers a handler for game-start events.
+ world.config.Kernel.on_dash_game_dash_start =
+ makeSimplePropertyUpdater('onGameStart',
+ plt.Kernel.isFunction,
+ "function",
+ "on-game-start");
+
+
+ // Registers a handler for opponent-turn events.
+ world.config.Kernel.on_dash_opponent_dash_turn =
+ makeSimplePropertyUpdater('onOpponentTurn',
+ plt.Kernel.isFunction,
+ "function",
+ "on-opponent-turn");
+
+
+ // Registers a handler for my turn.
+ world.config.Kernel.on_dash_my_dash_turn =
+ makeSimplePropertyUpdater('onMyTurn',
+ plt.Kernel.isFunction,
+ "function",
+ "on-my-turn");
+
+ // Register a handler after I make a move.
+ world.config.Kernel.after_dash_my_dash_turn =
+ makeSimplePropertyUpdater('afterMyTurn',
+ plt.Kernel.isFunction,
+ "function",
+ "after-my-turn");
+
+ world.config.Kernel.on_dash_game_dash_finish =
+ makeSimplePropertyUpdater('onGameFinish',
+ plt.Kernel.isFunction,
+ "function",
+ "on-game-finish");
+*/
+
+
+
+})();
diff --git a/world/main.rkt b/world/main.rkt
new file mode 100644
index 0000000..dc9df3a
--- /dev/null
+++ b/world/main.rkt
@@ -0,0 +1,8 @@
+#lang s-exp "../lang/js/js.rkt"
+
+(declare-implementation
+ #:racket "racket-impl.rkt"
+ #:javascript ("colordb.js"
+ "kernel.js"
+ "js-impl.js")
+ #:provided-values (is-color?))
\ No newline at end of file
diff --git a/world/racket-impl.rkt b/world/racket-impl.rkt
new file mode 100644
index 0000000..db5e07c
--- /dev/null
+++ b/world/racket-impl.rkt
@@ -0,0 +1,6 @@
+#lang s-exp "../lang/base.rkt"
+
+(provide is-color?)
+
+(define (is-color? x)
+ true)
\ No newline at end of file