Fix version numbers.

Set the reporting port to the error port by default

Makefile

@@ -1,52 +0,0 @@
-# test-analyzer:
-# 	raco make -v --disable-inline test-analyzer.rkt
-# 	racket test-analyzer.rkt
-all: planet-link launcher setup
-
-
-bump-version:
-	racket bump-version.rkt
-
-launcher: 
-	racket make-launcher.rkt
-
-test-all: 
-	racket tests/test-all.rkt
-
-test-browser-evaluate: 
-	racket tests/test-browser-evaluate.rkt
-
-test-compiler: 
-	racket tests/test-compiler.rkt
-
-
-test-parse-bytecode-on-collects: 
-	racket tests/test-parse-bytecode-on-collects.rkt
-
-
-test-earley: 
-	racket tests/test-earley.rkt
-
-
-test-conform: 
-	racket tests/test-conform.rkt
-
-test-more: bump-version 
-	racket tests/run-more-tests.rkt
-
-doc:
-	scribble  ++xref-in setup/xref load-collections-xref --redirect-main http://docs.racket-lang.org/ --dest generated-docs  --dest-name index.html scribblings/manual.scrbl
-
-
-cs019-doc:
-	scribble  ++xref-in setup/xref load-collections-xref --redirect-main http://docs.racket-lang.org/ --dest generated-docs  scribblings/cs019.scrbl
-
-
-
-setup:
-
-	raco setup --no-docs -P dyoo whalesong.plt 1 11
-
-
-planet-link:
-	raco planet link dyoo whalesong.plt 1 11 .

README.md

@@ -0,0 +1,46 @@
+Whalesong
+=========
+
+Important
+---------
+
+Whalesong needs Racket 6.2.
+As is Whalesong doesn't work on version 6.3 or greater.
+See https://github.com/soegaard/whalesong/issues/48
+
+Installation
+------------
+
+raco pkg install -j 1 --force --deps search-auto --scope installation whalesong
+
+Important: Use -j 1 to build Whalesong (this turns off parallel builds)
+           This also means, that you can't install Whalesong from the DrRacket package manager.
+
+This fork of Whalesong differs from dyoo/whalesong in the following ways:
+
+  * Builds on latest release of Racket
+    (fixes the x undefined problem)
+  * Adds for
+    (require whalesong/lang/for)
+  * Adds match
+    (require whalesong/lang/match)
+  * Adds on-release
+    (as a complement to on-key)
+    Contributed by Darren Cruse
+  * Adds parameters
+    (require whalesong/lang/parameters)
+  * Extended whalesong/image and whalesong/images
+    (more functions, bug fixes, now matches WeScheme)
+    Contributed by Emmanuel Schanzer
+  * Adds play-sound
+    (assumes a browser with html5 audio support)
+    Contributed by Emmanuel Schanzer and Darren Cruse
+  * Bug fixes by Vishesh Yadav
+  * The flag --as-standalone-xhtml is now --as-standalone-html
+    and produces standalone html rather than xhtml.
+
+Note: The implementation of parameters works fine,
+      as long as you don't mix parameterize with non-local-exits
+      and reentries (i.e. call/cc and friends)
+      
+/soegaard

examples/alert.rkt

@@ -1,3 +0,0 @@
-#lang planet dyoo/whalesong
-(require (planet dyoo/whalesong/js))
-(alert "hello world")

examples/cs019/hello.rkt

@@ -1,2 +0,0 @@
-#lang planet dyoo/whalesong/cs019
-"hello world"

examples/hello.rkt

@@ -1,4 +0,0 @@
-#lang planet dyoo/whalesong
-
-(display "hello world")
-(newline)

examples/snip.rkt

@@ -1,599 +0,0 @@
-#reader(lib"read.ss""wxme")WXME0108 ## 
-#|
-   This file uses the GRacket editor format.
-   Open this file in DrRacket version 5.1.2 or later to read it.
-
-   Most likely, it was created by saving a program in DrRacket,
-   and it probably contains a program with non-text elements
-   (such as images or comment boxes).
-
-            http://racket-lang.org/
-|#
- 28 7 #"wxtext\0"
-3 1 6 #"wxtab\0"
-1 1 8 #"wximage\0"
-2 0 8 #"wxmedia\0"
-4 1 34 #"(lib \"syntax-browser.ss\" \"mrlib\")\0"
-1 0 16 #"drscheme:number\0"
-3 0 44 #"(lib \"number-snip.ss\" \"drscheme\" \"private\")\0"
-1 0 36 #"(lib \"comment-snip.ss\" \"framework\")\0"
-1 0 43 #"(lib \"collapsed-snipclass.ss\" \"framework\")\0"
-0 0 19 #"drscheme:sexp-snip\0"
-0 0 36 #"(lib \"cache-image-snip.ss\" \"mrlib\")\0"
-1 0 68
-(
- #"((lib \"image-core.ss\" \"mrlib\") (lib \"image-core-wxme.rkt\" \"mr"
- #"lib\"))\0"
-) 1 0 33 #"(lib \"bullet-snip.ss\" \"browser\")\0"
-0 0 29 #"drscheme:bindings-snipclass%\0"
-1 0 25 #"(lib \"matrix.ss\" \"htdp\")\0"
-1 0 22 #"drscheme:lambda-snip%\0"
-1 0 57
-#"(lib \"hrule-snip.rkt\" \"macro-debugger\" \"syntax-browser\")\0"
-1 0 45 #"(lib \"image-snipr.ss\" \"slideshow\" \"private\")\0"
-1 0 26 #"drscheme:pict-value-snip%\0"
-0 0 38 #"(lib \"pict-snipclass.ss\" \"slideshow\")\0"
-2 0 55 #"(lib \"vertical-separator-snip.ss\" \"stepper\" \"private\")\0"
-1 0 18 #"drscheme:xml-snip\0"
-1 0 31 #"(lib \"xml-snipclass.ss\" \"xml\")\0"
-1 0 21 #"drscheme:scheme-snip\0"
-2 0 34 #"(lib \"scheme-snipclass.ss\" \"xml\")\0"
-1 0 10 #"text-box%\0"
-1 0 32 #"(lib \"text-snipclass.ss\" \"xml\")\0"
-1 0 15 #"test-case-box%\0"
-2 0 1 6 #"wxloc\0"
-          0 0 57 0 1 #"\0"
-0 75 1 #"\0"
-0 12 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 0 9
-#"Standard\0"
-0 75 10 #"Monospace\0"
-0 13 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 2 24
-#"framework:default-color\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 15
-#"text:ports out\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1
--1 2 15 #"text:ports err\0"
-0 -1 1 #"\0"
-1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1
--1 2 1 #"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 17
-#"text:ports value\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1
--1 2 27 #"Matching Parenthesis Style\0"
-0 -1 1 #"\0"
-1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1
--1 2 1 #"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 37
-#"framework:syntax-color:scheme:symbol\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 38
-#"framework:syntax-color:scheme:keyword\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 194 116 31 0 0 0 -1 -1 2
-38 #"framework:syntax-color:scheme:comment\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 194 116 31 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 37
-#"framework:syntax-color:scheme:string\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 39
-#"framework:syntax-color:scheme:constant\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 42
-#"framework:syntax-color:scheme:parenthesis\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36
-#"framework:syntax-color:scheme:error\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 36
-#"framework:syntax-color:scheme:other\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2
-38 #"drracket:check-syntax:lexically-bound\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 28
-#"drracket:check-syntax:set!d\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 31
-#"drracket:check-syntax:imported\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 47
-#"drracket:check-syntax:my-obligation-style-pref\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 50
-#"drracket:check-syntax:their-obligation-style-pref\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 48
-#"drracket:check-syntax:unk-obligation-style-pref\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2
-49 #"drracket:check-syntax:both-obligation-style-pref\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2
-26 #"plt:htdp:test-coverage-on\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 2 27
-#"plt:htdp:test-coverage-off\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 4 1
-#"\0"
-0 70 1 #"\0"
-1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
--1 -1 4 4 #"XML\0"
-0 70 1 #"\0"
-1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
--1 -1 2 1 #"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 139 34 0 0 0 -1 -1 2 37
-#"plt:module-language:test-coverage-on\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 139 34 0 0 0 -1 -1 2 1
-#"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 48 96 0 0 0 -1 -1 2 38
-#"plt:module-language:test-coverage-off\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 48 96 0 0 0 -1 -1 4 1
-#"\0"
-0 71 1 #"\0"
-1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
--1 -1 4 1 #"\0"
-0 -1 1 #"\0"
-1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1
--1 4 1 #"\0"
-0 71 1 #"\0"
-1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1
--1 4 1 #"\0"
-0 71 1 #"\0"
-1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 100 0 0 0 0 -1
--1 0 1 #"\0"
-0 75 10 #"Monospace\0"
-0.0 13 90 -1 90 -1 3 -1 0 1 0 1 0 0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
-255 255 1 -1 4 1 #"\0"
-0 -1 1 #"\0"
-1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 255 255 0 -1 -1 0
-1 #"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 200 0 0 0 0 0 -1 -1 0 1
-#"\0"
-0 -1 1 #"\0"
-0 10 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
--1 -1 2 1 #"\0"
-0 -1 1 #"\0"
-0 10 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
--1 -1           0 35 0 26 3 12 #"#lang planet"
-0 0 26 3 15 #" dyoo/whalesong"
-0 0 4 29 1 #"\n"
-0 0 22 3 1 #"("
-0 0 14 3 7 #"require"
-0 0 17 3 1 #" "
-0 0 22 3 1 #"("
-0 0 14 3 6 #"planet"
-0 0 17 3 1 #" "
-0 0 14 3 20 #"dyoo/whalesong/image"
-0 0 22 3 2 #"))"
-0 0 4 29 1 #"\n"
-0 0 24 29 1 #"\n"
-0 0 22 3 1 #"("
-0 0 15 3 6 #"define"
-0 0 24 3 1 #" "
-0 0 14 3 6 #"a-snip"
-0 0 24 3 1 #" "
-0 2          35 4 1 #"\0"
-2 -1.0 -1.0 0.0 0.0 0          12 500
-(
- #"\211PNG\r\n\32\n\0\0\0\rIHDR\0\0\0X\0\0\0U\b"
- #"\6\0\0\0\315\v#\352\0\0\0\6bKGD\0\377\0\377\0\377\240\275\247"
- #"\223\0\0\25\355IDATx\234\355"
- #"\234Y\254\34\305\271\200\277\252\236\231\263"
- #"y7\266\317\361n\360\2\266\3\16\306\vf7\216\223\\ \21I\20\302\271\220"
- #"D\212\24\244D\21\nW\271I$\256P\224\227(/\311KP\36\22\31\t\2"
- #"\17(\4\"\24\226k.\4\204\314*\300\6cb\233\v\266\217}\354\30\373\370"
- #",\263tW\325}\250\251\236\232\236\356Y\354c@W\374R\251{z\252{\252"
- #"\276\371\373\257\277\376Z\4`\370LH"
- #"\16\350\5\246\0\223\200n\244\314c\214"
- #" \b\24RV\20\242H\30\236\306\230Q\240\4h\314g\244\364Y\"\370\224\0"
- #"O\236<\203\201\201\305,^\274\224y"
- #"\363\26\323\337\337O>?\235R\251\207#Gr\274\367^\300\256]\206R\311\0"
- #"\32!\24P\301\230q`\24)?F\210#\b\361\21B\374/Qt\4\30\377"
- #"\314\1\377D\1\367\317[\304\232\265\353"
- #"\270l\375:\226-[\312\254i\323\350)\4H\t\306h\300T\217\2320\324\34"
- #"8\240y\350!\315\363\317k@\1\272Z\\\355\235G\3008\360/\204\330\207\20"
- #"\273\201\177b\314\360g\2\3669\a\334=e\n\3536ld\363\225W\261f\356"
- #"\\f\227K\344N\17C>\217\276\350"
- #"B\30\230\213\bCL\225\206\326\272\232"
- #"\24Bh\224R\334\177\277b\373v\205"
- #"\205\234\226\34p\2002B\34C\312\335\300kh\375A\374\354OC\316\31\340I"
- #"\347\235\307\346u\353\270i\351RV\236"
- #"\32\246g\317\273\210\375\373\221'O\22"
- #"\0\1 \346\314\201{\357\305|\365\253\230\361q\2141(\245\352\222"
- #"\326\nc\"~\363\233\210G\37\215\260\32\353\222\362\216>lU-\305"
-) 500
-(
- #"(\260\27)_\4\366\242\265\342\223\226"
- #"\t\a\234\v\2\256\17\2\266\255X\301\3120\244g\377~raH\36\310c\233"
- #"2\a\30\300L\232\204\371\323\237\320["
- #"\267\242\307\307QJ\21E\21a\30\306G\255#FFB\356\2743\344\335wC"
- #",\324\260\232\34d\22745\350\316\214"
- #"\24\221\362=\204\370\37\264\336\377\211\232"
- #"\216\211\3,\4\253\244\344\373\300\225Z\323g\f]X\277\240\e(`\341\n@"
- #"V\217N\314\300\0\321\263\317\22.YB8>N\30\206T*\225\272\243\224!"
- #";vD\334uW\5\255\35d?\371\327\2346\373\347\32\30A\210\327\201\3470"
- #"\346\324\204T\273\225\4\300\275g\373\220"
- #"B\20\360\357R\3623\245Xk\fS\201\31\300t\254\323\325\203\5\3544\327\1"
- #"vI\216\216\22\f\16\222\273\3556d\20 \204\250K\0J\t\346\3177\354\334"
- #"i8z\324\375rR7\4\351b\252)\a,\0\226\"\345\bp\354l\253\336"
- #"R\316\32\360\202|\236\377\22\202mQ"
- #"\304\0\26\354L\240\17k\22\222\332\232%b\357^\344e\227\21\254\\I %"
- #"R\312:\300\0]] \4\354\330\341"
- #"\337i\22\347\315~\315\201\356\303\230\345"
- #"\4A7p\220\232\315\236x9+\300\353s9~\245\24W(\305L,\330I"
- #"\325\207:\333\343\252\233Uu\207G\0"
- #"\346\360a\304\355\267\23\344\363\4A\200"
- #"\224\262>\257\201\376~\303\323O\303\360"
- #"p\22\254\361\236\226f\365\222\337I\214"
- #"\231\17\364c!\227\332\253t\207rf"
- #"\200\205\340+A\300\275J\261\22\230\205"
- #"5\ay\352!f\235\223\270\356\276\23"
- #"\207\16\301\365\327\303\242EH)c\310\316\3152\6&O6\34?\16\257\276\n"
- #"\265F\314\207\353\334\265,\310&q>\23k6\216\0#mT\2763"
- #"\351\34\260\224|+\b\370\231R,\1fc\315A\253\27\323IS\2156"
-) 500
-(
- #"\6\272\273\341\206\el^!bSa\277\266P\246L1\374\345/\20E\256\323"
- #"\221\246\301\311\224U\"S\255\301B\244"
- #"\34\302\230\341\246\325\357Td\353,\236"
- #"\b\301\267\202\200\377\210\"\26b\341v{_\247U+\r\256;O{\241\3153"
- #"\317`\306\306\354\2711H)\351\352\352"
- #"\242\273\273\233\256\256.\244,\260jU"
- #"\201\265ks\330F\313\245\254&4\231dF\232\211\3267\20\4\363;B\322J"
- #":\2\374oRrw\30\262\0\v\267\340}\3474\322\177\345I|NBO\263"
- #"\323|\360\1\274\365V|\335A.\24\ntuu\221\317\27\350\353\313s\323M"
- #"i\236u\328\341\375\232\179\r\366L\224\372j\265v\23#m\3^/%"
- #"\377\251T\254\271\371\304\367\311\327=\v"
- #"t\332\365\272<J!^z\311^\367\274\210 \bb\310B\24\270\376\372<3"
- #"g&\265\327O\355h\262\17\331\3353\v\330\212\20S\332E\323T\332\2\2740"
- #"\227\343\347\306\260\b8\257Z\245s*;w\246^\316\345r\24\n\5\202 \317"
- #"\222%y\266nm\246\305I\r\365%"
- #"\313\\\270\373\347b\314\265\b\221T\243\316\245%\340\236 \340ncXi\f3"
- #"\2517\v\347Lv\357\206\361\361\206\313"
- #"B\b\362\371<\371\274\205|\353\255yr\271,;\354\203N{w \333&\a"
- #"\300\5\300ZD\362\226\16\2459`!\330&\4\327V\375\334IM\2626\363<"
- #"\233Ij\236\217>\262)E\244\224\344r9\214\311\261~}\216\215\e;\201\333"
- #"\314P\371Z\35\0y\214\271\4!\26\265Q\213li\n\370\vB\360\355(b"
- #"\0060\255\305\203\322\376\350\266zpi"
- #"\27\213E\370\360\303\364\374B\20\4\1"
- #"A\220\243\247'\340\333\337N\263\275I3Q\347mg\224B\244\334"
- #"\327\207\326\e\260\235\3753\223L\300\5!\370\276\326\314\303v\177\203"
-) 500
-(
- #"\254\214g mE\227j\1\207\6\261"
- #"\200\3\224\222l\331\"Y\261\"\315\216"
- #"\266c\"|\361\363\372\317\231\3\254n\247\304\231OM\225/K\311F`2g"
- #"\363\377\245K[fMf\277\\N\213\205\b\230>=`\333\266,\367,M{"
- #"\333\321d\227\334[q!\266\307\327\271"
- #"\244\326bj\20p\213\326L\6\246R\363W\323:\20YQ\200\254NG\333i"
- #"`\300\36\215\211\23\20\37]7:\212$_\373\232d\336\274\206\30]\n0'"
- #"\315\376\3424wn2\260\272.\360\324"
- #"\256\244\2\336\n\254\250\206\35\375\236Z"
- #"\332\377\237,~\332\365\216\323\244I\210"
- #"%K\354y\"l\351\316]\254\2$\375\375\222[n\311\202\332\252qKJ\22"
- #"\2563\27\v\261Njg\322\0x\262"
- #"\20\334\240\24\223\260\261\334\316\372\322\331"
- #"\322N|+\226\345\313a\341\302\372\274"
- #"\211a\b\a\331j\261\340\e\337\220\314"
- #"\234\331\nr\273\222\346U\364a\314\212"
- #"\16\236a\245\201\337\345\300Rj#\21I\311\n\233\264j\270|3\223&uf"
- #"\346\252\2530\371|\235i\250\313kL\235fk-Y\270Pp\323M\376\257\245"
- #"\275[\315 \247EM\222\232<\37k4\333\227:\300\201\224l\26\202n,`"
- #"\337s\310*f\263&#)\315\356\255C\261uk\235y\240z\336\360\274\0302"
- #"h\r\337\374\246\240\257/\313\307\315\372"
- #"\334\254\264\376Q\2\275\b\2610#\177"
- #"\272\324\1^\"%\27iM\36\253\275"
- #"\235\233\364\t\220\205\va\323\246\246Y"
- #"\322\354r\24\t\226-\23l\336\234z\307Y\24\250\336T\0303\217\306HL\266"
- #"\324\1^\217\r\234\27314h\35ame\32Z\231\204\206t\343\215\230i\323"
- #"jy\306\3060\17?\2149q\242vo\325l$\207\224\214\201\233o"
- #"\206\\\333\301\222\264Q\21'i\346E\2\323\20bz\273?P\3\234\3"
-) 500
-(
- #"\326x\332\353\227\261\35\210\355\346q)"
- #"U\247\202\0\261m[\3557\225\202;"
- #"\357\204\333n\203\273\356\302\37oO\263"
- #"\315Q\4_\370\2\254Y\223\374e\262"
- #"~1\221'\2536\276\231\350\302\0163\265'1\340~!X\24259j\203\225"
- #"\311\3077sv\262\212/\0\223\30%"
- #"\26B\200\20\215\317\331\260\1\326\257\257"
- #"]\373\363\237\341\201\al\276\a\37\204"
- #"\307\37\267\371\274\21\16\37\264\326\206B"
- #"\1n\2741Y\212$\264\266\372\222\244"
- #"kq\2001\347\321\256\177\25\347Z\212"
- #"u\247\375~P\326hD\326\365\3642\212\354<B\324\353\327\17~\0yk\337"
- #"\304\3600\342W\277\212\3575\306\300\275"
- #"\367\3328\205\177\215z\320\225\212a\303"
- #"\6\303\300@\253\341\242,\343\227V\313"
- #"\270\300\325\343d\254\e\320Z\244\253\350"
- #"r)\353\302%\311\"5\353\261e\25\307\1lj\277\2356._\216\271\371\346"
- #"Z\236\207\36\302\274\377~}\3767\337"
- #"\204\307\36k\350\341\371Ik\230>\335"
- #"p\355\265\311\32\264+\255\f\236\300\232"
- #"\211\366\3345\t \205`\00153\236\366b4\353\261\371\307\264\342dy\243u"
- #"&\342G?BL\236l?\27\213\210\373\356kx\6\0\277\375-\224\313 D"
- #"<Q\260\36\260&\212\f\327]g(\24Z5\315\355^O\326(\300jqk"
- #"\221\0\223\204`\246R\251\0Z\375\237"
- #"\231\337\245\371\255i\367\32\3\313\226!"
- #"\356\270\243\326\0>\372(\274\375v\303"
- #"=\2\340\345\227\21O>\211\366\0'!G\221\341\374\363\r_\374b;\357^"
- #"\262&Y5J\226\244\3\300S\215a\n\3557`\255z\363\235\212\270\373n\230"
- #":\325\376V\245\2\277\373]\363g\377"
- #"\376\367\3500\254\3\354\203\326\332 \245"
- #"a\353\3264\357\240\231\321J\346K-m5\3654+a"
- #",\26\260\326\24\252\217t\223?\233\275\\\355\372\303-\253"
-) 500
-(
- #"c\ff\315\32\314\355\267\327\236\363\364"
- #"\323\230W_mn\273\237{\16\365\362\313\250 \310\204\\.k\326\2541,Y"
- #"\322\256\211h\347{'\316\16\267v\270-`!\2204\2\316\322hR\276k\370"
- #"/\215ii\307\21\2\356\271\az{"
- #"\3555c\340\276\373\20\325{\263\356\323"
- #"\225\n\352\301\aQ)f\242\366\331\320"
- #"\323\243\371\322\227\222\23S\232ih+"
- #"\225\361\363H\332\6\334\27\4\30\352'"
- #"}\352D\30635\5\231\367\31\203\370"
- #"\362\227\341\353_\257]{\353-\304\263"
- #"\317\266|\246\6\324\343\217\243>\372\b"
- #"\225\230\264\355C\256T\f\e7\32f\315j\69\353\35\245E^I;]f"
- #"\t\220S\252N{\335,\333\263\226\254"
- #"\231\316\306@o/\346\227\277\204\300\v"
- #")m\337\16\245\346\223\360\f\325\231\300"
- #"\203\203\250g\236A\5Au&|\243\231\210\"\303\264i\326\243h\17p\253\306"
- #"0i&\332\264\3019h\0\0346\271\251#m\316\202\374\275\357!\326\255\253="
- #"\353\304\tx\344\221\226\217\363\25@="
- #"\362\bQ\261\230j\207-dM\245\242\271\342\n;\237\255V\313f\r\\\362\330"
- #"\354\17h\23\260\277vGa\341\226\231"
- #"\300Y\263\306\324\247y\363\340\27\277\210"
- #"\277\26\0\177\373\e\34>\334\3741\324"
- #"\346\261+ z\3555\324\356\335()"
- #"\23\353:j\220\243\310\232\210+\257\364W&ub*\332\371#\262E\2\204\306"
- #"\304\366\327\301-\323\\\213\317J\356\271"
- #"\a\346\316\255}\326\32\356\277\277\345m\21P\241\266:#*\225PO<a\201"
- #"\247\230\t\247\305ah\270\352*Co"
- #"\357\331\300Mj\277\246m\300%\352\227"
- #"\225\224\253\327\312m=\242C\271\372j"
- #"\370\356w\353\257\275\366\32\274\364R\323"
- #"\333\3542\304Z\31\343\2450O=\205\32\32BiM\24"
- #"Eu\240k=;\315\2349\232\r\e:\321\342f\220\225"
-) 500
-(
- #"W\202\346\"\1F\202\0\177\355N\5"
- #"\vw\234\t\326\342\356n\370\365\257\355Z\0_\266o\207J%\3636]-S"
- #"\235\366V\217\352\320!\324\213/\22U"
- #"}\342\306e`:\206|\3155\232\236"
- #"\236\264\305\214i\266\31\32\301\372\311\255"
- #"pj.\22\340t\265\360I\300\245j"
- #"\2320-\276\343\16\330\270\261\376\332\261"
- #"c\360\327\277f\336\342\354\256\178\271\246(z\352)T\251\224\351MhmW"
- #"\216\316\236\255Y\2736\253\241\313j\340"
- #"\322\362*\332m\245$\300\2601\214SS|\337L\214U+\346W8\t<\355"
- #"sC\261g\315\202\237\377\334\236\273\270"
- #"\1`\36}\24\216\34\311\254\252+\213"
- #"\203\353C\216\275\2117\337D\355\337\217"
- #"\22\242\1\262\377Y)\303\25W\30\272"
- #"\272\222\320\374e\ai6W\247\234;\303\332\6\340\21c8Em\t_\245z"
- #"{\21k&\306\250\375W\255b\23~"
- #"\236\272\236\336\217\177\f\213\27\333s\27"
- #"x\17C\304\366\355\251\367$\341\372\32"
- #"\334\0\271TB=\367\234]\r\227\200\352\2470\324\f\fh.\271\244\35-N"
- #"3!~jo\321\214m\344\214\341\30\265\206\304\1v\220G\253G\377\205H\276"
- #"H\376yC\272\340\2\314\17\177X\313W\325^^x\1\363\312+\r\325s6"
- #"\3275\264>\344\6\355u\351\205\27P\247N\241\22P\e\3356\315\246M\332\v"
- #"e\266j\364\222`\235\201jo\301L\34[?(D\235\e\344\354\260\323b\267"
- #"CCX\375\331d\f\302]K\215_\334}7L\237^\37\203\0\314\37\376`"
- #"]4\357Y\356O\316\202\233l\350b"
- #"\320\207\16\241\337z\253\251O\354\0\17"
- #"\f\30V\257n\267As6\327\a\354\324\256\3\300\37R\363}]\205\212^\32"
- #"\253\246qj\326\307\25-\253\323(\0\261z5\334"
- #"qGc\b\364\335w\21O<Qg\22|\323T\246"
-) 500
-(
- #"\21p&\\\227\376\361\17T\24\241\32l\257\362\2\3626]~\271&\237\317Z"
- #"\6\226f\177\265\367\213\356\235\356\0\360"
- #"a)9A\255\241s\25r\356\332h\25\260\323h\a:\244\361%\303?\376\364"
- #"\247\230\276\276\372\241\35\300\374\361\217\230"
- #"\261\261\330\341qo\213\323\\wL\203"
- #"\233\265*9\332\265\vu\370p\323\0\2201\246j\213\r\253V\2455fI\250"
- #"*q\36b\375\256\366\24251\340\323"
- #"Z\363\241\224\261\375\363+\355\240\216T"
- #"\217\3765\367\271L-\n\27\267\311\227"
- #"]\6\267\334R\367\203F\b\364\321\243"
- #"\250\207\36\"\244\246\261\16\256K\345D"
- #"J\323\334\6-\36\eC\275\361F\34"
- #"\306L\203\353\17-\255_o\310\347\333"
- #"\361y}\r\256\0\355\257\245\213\3\232"
- #"\306\30\366\n\301%\325\317\25\262\27C9\255K[\343\23\337#\4\342'?A"
- #"tu\305\0212\2555\246\273\e\375\360\303\350#Gb\235HnH\340\373\271\255"
- #"\216\r\240_~\31u\305\25\261\211\310"
- #"\262\305\306\330\221\347\213.2\274\375v"
- #"\26\\\177\245\276o\36Nw\16\30\340"
- #"}c8\201\235\244\351\0\247\5\334\r"
- #"\215k{\32\346\225o\334\210\330\262\5"
- #"q\362$.\242\246\0013<\214\331\276\275\341\5Ln\257\221\266IAS\260."
- #"}\370!\352\203\17\320\213\0265hn"
- #"\332\260\322\272u\206={\254\331\310\326"
- #"\\\337p\236\302\276Sg\0\370TU\213g\30C\205\332\242\356\244g`\260\263"
- #"\177\222p]~)%\342\316;\355\310\304\350\250\35\2767\6\272\2720;v\240"
- #"w\355\252\353\325'59\rtS\323\340\237+\205~\375u\364\242E\231\376p"
- #"-^\254\351\3577\254X\241\331\275;\253D~\0w\f8\3366\334\6\300\0"
- #"o\0\27c\207\364\222\246\301\301u?\357\366\200\250\203"
- #"\v\210M\233\220\e7Z\355\365\304\204!<\360\200\255"
-) 500
-(
- #"$\365\16\220\177L\3\227\4\236\266\345"
- #"F\374B\357\332\205\332\274\31](d\216<\373Z|\351\245\206={\2549i"
- #",\215\337\f\177L'\346!\25\360A!\330'\4+\265\216\315\204\3\234f\376"
- #"s$VE\344r\210\357|\a\21Ev\2048\376\245\34\354\331\203y\341\205\206"
- #"6;Y\235\210t\330Y@\ev\3549q\2\375\376\373\230\213/\306$F\237"
- #"\223\220\303\320F\332\26/V\354\337\237\324\\\277a\263;[5\16\246u\bX"
- #"i\315+A\300\22jf\300\327\336\344"
- #"\213\324E\302\366^}5\342\342\213\355"
- #"\324'\177nDw7\346\261\307\354\346"
- #"Gd7)\311\246\245\31\314\264}\247\342\3637\337D\257Z\25\367\354|;\234"
- #"\264\311B(V\257\326\348\2400&\371d\247\275'\261\366\2673I\35\26\335"
- #"\247\24\373\244d\245\326\2619o\346z"
- #"\27\34\334\356n\304\255\267\"\312e\253"
- #"\301\16\260\224p\342\4\346\311'\e\\"
- #"\372\3443\223\260\322^\332\264\353\376w"
- #"\6\320\373\366\241\217\37GO\235\332\0"
- #"\326\377l=\r\315\334\271\212\331\263\25CCip\213X\355\355<x\233\nX"
- #"\3/\32\303\2\354N\n\255\0GTgd^w\35\342\202\v\20\325\355\bb"
- #"\300]]\360\374\363\230\243G\e\302)"
- #"\255\334\373V\300\323\376\30\3\250R\t"
- #"\275g\17f\323&tu_\266\344\320"
- #"\276\337\31\221R\261l\231\178\242\326"
- #"\3459Q\5\334\271d\16\354\0374\2067\204\340rcj\35\a\32\315D\256z"
- #"\f{{\311\337x#\262X\4\245jp\205\260\301\364\277\377\275\341\31YA\301"
- #"V\16S\22\256\237|\233n\336y\a\275vmK\270.\315\237\257\350\356V\224"
- #"J~D\344\0240H\247\266\267%`\200\235B\260\320\30\6R\0'"
- #"\e\236\334\225W\22\315\236Mn|\274n\257\35\221\317c\336y\a\366"
-) 500
-(
- #"\354\211\237\341\216~\27;\t\331\375F\226\371H\206`\322B4zp\02034"
- #"\204\2313\247)\\7\324\324\335\255\230"
- #"7O\261\177\277\203;\212\335\231\2523"
- #"\317\301\227\246\263\210G\265\346\205\\."
- #"\36:\362\343\1~\214\240\334\327G\371\232k(\216\215Q,\26)\225J\204a"
- #"h\367=\213\"\302\35;\b\225\252\213"
- #"\210\245\216\257Q\337\241H\372\301i\336"
- #"D\232\231\210\377\260(B\357\335\eO\24L\323Z\a7\212\"\242H1o\236"
- #"\263\273\343X\323pv[\177\265\234\246"
- #"\375O\245xU\312\272\20\246\e^r\237\303\r\e(\317\234Iyl\214R\251"
- #"\24\247\212R\204\207\16\21\276\362J\3\320$\314,\310ip\323LD\362Z\f"
- #"y\357^t\261\330\0004\rr\245\22"
- #"\322\327W\246\267\267\204\365\32\216P?"
- #"\236\323\271\264\236\\e\f;\261\v\302W$*\221\3to/z\303\6\202b"
- #"\21\5\361\342@Y\235\320-w\356D\216\216\3061\fh\36\240O6|Y\346"
- #"#\353\330\220\377\370q\324\340 \252\277"
- #"\37\355\305%|\315UJ\21\206!\245R\211(*2y\3620\343\343\23\263\v"
- #"U[\353q\"cx\26\353\27\317\247\36r\260f\rz\3324T\251T\aW"
- #"J\211\254T\220\325\355a\222\35\26h"
- #"\16\270\35\350iP\el\266\326\250\3"
- #"\a\320s\346\304\200\223\232\353\340\26\213"
- #"E\206\207\207\211\242A\316\324kHJ"
- #"\333\v\236F\201\377\6\276\202\335\263G"
- #"\3\272\273\233\374\245\227\242\313eDu"
- #"\363\2428\25\n\210}\373\220\207\16\305"
- #"q\214d\360\250\325\230B\26\364$\334\264^a\235\3718p\0\275fM\34\210"
- #"\367\223\17\367\324\251S\f\r\rq\362d\366V\n\235JG\333\357|\f<#"
- #"%[\264f\26\240/\274\20=e\n\271R\251\272"
- #"\275@u\2373)\221B _\177\35\241u\313e\b"
-) 500
-(
- #"\220\256\315\355hr\263\360x\234N\234"
- #"@\35;\206\2321\303\216xxp\313"
- #"\345r\35\334\303\207\17\243\275a\254\263"
- #"\225\216\3677:\2565O\t\301\346\\"
- #"\216\376\213.B\25\213\344\204 \227\313"
- #"\305[\f\310 @\214\214 \337{\257%\330\344\347v4:\315g\316\362\243\25"
- #"X\323p\360 j\3324T\24\21E\21\225J\205J\245B\251Tbxx\230"
- #"\243G\2172888\241p\341\f7\220\372\330\30\236\221\222+\207\207Y0u"
- #"*Q.GNkr\371<\271|\36\31\4\310}\373\20\247O\327\201\365\355p"
- #"\226\230\224c\226\6\247\331\341,mV"
- #"\a\17\242\226/'\254\202-\227\313\24K%FN\237\346\310\341\303\f\35?>"
- #"\341p\241\276\315\351X\272\273\273Y\273"
- #"v-+\346\317'\37E\4\245\22\271\321Qr\243\243\4\a\16 N\236\314\236"
- #"\335N#\350\244\366\372\327:1\23\251"
- #"]\354|\236p\313\26*\205\2\245\361"
- #"q\306\306\307\31\376\370c\216\f\16r"
- #"rx\370\314!\264\220\263\2\f6\336"
- #"\260\274P\340\222J\205\311\306\20\320z"
- #"\243C\377\307}i\0057\313.\247v\223i\f\227W\226.\245\270`\1##"
- #"#\234\32\32\342\350\320\20\243M\346\304M\204\2345`'3\2005X7\316\355"
- #"\302\232\265\17_Z!H\24\244\35\310"
- #"iv\330\a\233\234\320X\4N\367\366"
- #"\362\257 \340\330\310\310\304\314\342o!"
- #"\23\6\30,\310\363\201\213\260\353 \375"
- #"\rY\342\215\361i\324\3464\260\376y"
- #"\26\3304{\254\251\357\35\272\250\3028\266ov\234s\261\211m\266L(`'"
- #"\275\300\5B\260\330\230x\303\346\206a%\322\375b\22\347\255:#\311ASg"
- #"\22|\260\247\261Q\205\223\347\242\262"
- #"-\344\234\0v\322\v,\22\202\371\325\r\226\234\351H"
- #"&\177\354/)\315\32\270d\360\307\245\nvx\3624\326"
-) 188
-(
- #"w\37\256\346\3714\344\234\2v\222\307"
- #"n\3576\200\335}\314\355G\2216\2432M\262\\3gg}s0\216\5z"
- #"\n\333\373\374\24456)\237\b`_"
- #"z\260\r\342\f\254\235\356\301\216\353\371"
- #"\235\20\2238\317r\301\\\3035\16\214\n\301(0Z]o\362Y\221O\34\260"
- #"/\201\20\364\30C/\325]\256\204\240`L\274!H@\343p~\b\224\205\240"
- #"dL<\335\252\302\247\257\251Y\362\251"
- #"\2\316\22Au\352\225\277\205\214\20\250"
- #"\2545w\237a\371L\2\376\377$\23"
- #"\265\261\337\347\222!\237\3>\307\3629\340s,\237\3>\307\362"
- #"\177z\314\306\205O<{Y\0\0\0\0IEND\256B`\202"
-) 0 0 22 3 1 #")"
-0 0 4 29 1 #"\n"
-0 0 22 3 1 #"("
-0 0 14 3 11 #"image-width"
-0 0 17 3 1 #" "
-0 0 14 3 6 #"a-snip"
-0 0 22 3 1 #")"
-0 0 4 29 1 #"\n"
-0 0 22 3 1 #"("
-0 0 14 3 12 #"image-height"
-0 0 17 3 1 #" "
-0 0 14 3 6 #"a-snip"
-0 0 22 3 1 #")"
-0 0 4 29 1 #"\n"
-0 0 14 3 6 #"a-snip"
-0 0 4 29 1 #"\n"
-0           0

image/main.rkt

@@ -1,7 +0,0 @@
-#lang s-exp "../lang/base.rkt"
-
-(require "private/main.rkt"
-         "private/color.rkt")
-
-(provide (all-from-out "private/main.rkt")
-         (all-from-out "private/color.rkt"))

image/private/racket-impl.rkt

@@ -1,96 +0,0 @@
-#lang s-exp "../../lang/base.rkt"
-
-(require 2htdp/image
-         (for-syntax racket/base))
-
-(provide text
-         text/font
-         overlay
-         overlay/xy
-         overlay/align
-         underlay
-         underlay/xy
-         underlay/align
-         beside
-         beside/align
-         above
-         above/align
-         empty-scene
-         place-image
-         place-image/align
-         rotate
-         scale
-         scale/xy
-         flip-horizontal
-         flip-vertical
-         frame
-         crop
-         line
-         add-line
-         scene+line
-         circle
-         square
-         rectangle
-         regular-polygon
-         ellipse
-         triangle
-         right-triangle
-         isosceles-triangle
-         star
-         radial-star
-         star-polygon
-         rhombus
-         image->color-list
-         color-list->image
-         image-width
-         image-height
-         image-baseline
-         image-color?
-         mode?
-         x-place?
-         y-place?
-         angle?
-         side-count?
-         image-color?
-
-
-         image?
-         ;; Something funky is happening on the Racket side of things with regards
-         ;; to step-count?  See:  http://bugs.racket-lang.org/query/?cmd=view&pr=12031
-         ;; step-count?
-
-         bitmap/url
-         )
-
-
-
-(define-syntax (define-stubs stx)
-  (syntax-case stx ()
-    [(_ f ...)
-     (syntax/loc stx
-       (begin
-         (define f (lambda args (error 'f))) ...))]))
-
-
-
-(define-stubs color-list->image)
-
-
-  
-
-(define (my-step-count? x)
-  (and (integer? x)
-       (>= x 1)))
-
-
-(define (png-bytes->image bytes)
-  (error 'png-bytes->image "not implemented yet"))
-
-
-(define image-url (procedure-rename bitmap/url 'image-url))
-(define open-image-url (procedure-rename bitmap/url 'open-image-url))
-
-
-(provide (rename-out [my-step-count? step-count?]
-                     [bitmap/url image-url]
-                     [bitmap/url open-image-url]))

info.rkt

@@ -1,28 +1,2 @@
 #lang setup/infotab
-
-(define name "Whalesong")
-(define blurb '("A Racket to JavaScript compiler"))
-(define release-notes '((p "Bug patch: under rare situations, the scheduler can incorrectly allow  multiple computations to run.  For now, Whalesong's will not release control to the browser during long-running computations.  Program output may be a little bit more delayed as a result.")))
-(define version "1.11")
-(define categories '(devtools))
-(define repositories '("4.x"))
-(define required-core-version "5.1.1")
-
-;; I am disabling the automatic launchers: it's causing issues with
-;; file permissions.  The program "make-launcher.rkt" will build a
-;; whalesong launcher, so I need to revise the instructions to use it
-;; instead.
-;;
-;; (define racket-launcher-libraries '("whalesong.rkt"))
-;; (define racket-launcher-names '("whalesong"))
-;;
-
-(define homepage "http://hashcollision.org/whalesong")
-(define scribblings '(("scribblings/manual.scrbl")))
-(define compile-omit-paths '("tests"
-                             "sandbox"
-                             "examples"
-                             "experiments"
-                             "simulator"
-                             "tmp"))
-(define can-be-loaded-with 'all)
+(define collection 'multi)

js-assembler/assemble-expression.rkt

@@ -1,63 +0,0 @@
-#lang typed/racket/base
-
-(require "assemble-structs.rkt"
-         "assemble-helpers.rkt"
-         "assemble-open-coded.rkt"
-         "../compiler/il-structs.rkt"
-         racket/string)
-
-(provide assemble-op-expression)
-
-
-
-(: assemble-op-expression (PrimitiveOperator Blockht -> String))
-(define (assemble-op-expression op blockht)
-  (cond
-    [(GetCompiledProcedureEntry? op)
-     "M.p.label"]
-    
-    [(MakeCompiledProcedure? op)
-     (format "new RT.Closure(~a,~a,[~a],~a)"
-             (assemble-label (make-Label (MakeCompiledProcedure-label op))
-                             blockht)
-             (assemble-arity (MakeCompiledProcedure-arity op))
-             (string-join (map
-			   assemble-env-reference/closure-capture 
-                               ;; The closure values are in reverse order
-                               ;; to make it easier to push, in bulk, into
-                               ;; the environment (which is also in reversed order)
-                               ;; during install-closure-values.
-                               (reverse (MakeCompiledProcedure-closed-vals op)))
-                          ",")
-             (assemble-display-name (MakeCompiledProcedure-display-name op)))]
-    
-    [(MakeCompiledProcedureShell? op)
-     (format "new RT.Closure(~a,~a,undefined,~a)"
-             (assemble-label (make-Label (MakeCompiledProcedureShell-label op))
-                             blockht)
-             (assemble-arity (MakeCompiledProcedureShell-arity op))
-             (assemble-display-name (MakeCompiledProcedureShell-display-name op)))]
-    
-    [(CaptureEnvironment? op)
-     (format "M.e.slice(0, M.e.length-~a)"
-             (CaptureEnvironment-skip op))]
-    
-    [(CaptureControl? op)
-     (format "M.captureControl(~a,~a)"
-             (CaptureControl-skip op)
-             (let: ([tag : (U DefaultContinuationPromptTag OpArg)
-			 (CaptureControl-tag op)])
-               (cond [(DefaultContinuationPromptTag? tag)
-                      (assemble-default-continuation-prompt-tag)]
-                     [(OpArg? tag)
-                      (assemble-oparg tag blockht)])))]
-
-    
-    [(MakeBoxedEnvironmentValue? op)
-     (format "[M.e[M.e.length-~a]]"
-             (add1 (MakeBoxedEnvironmentValue-depth op)))]
-
-    [(CallKernelPrimitiveProcedure? op)
-     (open-code-kernel-primitive-procedure op blockht)]
-    [(ApplyPrimitiveProcedure? op)
-     "M.p._i(M)"]))

js-assembler/assemble.rkt

@@ -1,640 +0,0 @@
-#lang typed/racket/base
-
-
-;; Assembles the statement stream into JavaScript.
-
-
-(require "assemble-structs.rkt"
-         "assemble-helpers.rkt"
-         "assemble-expression.rkt"
-         "assemble-perform-statement.rkt"
-         "fracture.rkt"
-         "../compiler/il-structs.rkt"
-         "../sets.rkt"
-         "../helpers.rkt"
-         racket/string
-         racket/list
-         racket/match)
-(require/typed "../logger.rkt"
-               [log-debug (String -> Void)])
-
-(provide assemble/write-invoke
-         assemble-statement)
-
-
-
-
-
-;; Parameter that controls the generation of a trace.
-(define current-emit-debug-trace? (make-parameter #f))
-
-
-
-
-
-(: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
-;; Writes out the JavaScript code that represents the anonymous invocation expression.
-;; What's emitted is a function expression that, when invoked, runs the
-;; statements.
-(define (assemble/write-invoke stmts op)
-  (display "(function(M, success, fail, params) {\n" op)
-  (display "var param;\n" op)
-  (display "var RT = plt.runtime;\n" op)
-  
-  (define-values (basic-blocks entry-points) (fracture stmts))
-
-  (define function-entry-and-exit-names
-    (list->set (get-function-entry-and-exit-names stmts)))
-
-  (: blockht : Blockht)
-  (define blockht (make-hash))
-  
-  (for ([b basic-blocks])
-    (hash-set! blockht (BasicBlock-name b) b))
-
-  (write-blocks basic-blocks
-                blockht
-                (list->set entry-points)
-                function-entry-and-exit-names
-                op)
-  
-  (write-linked-label-attributes stmts blockht op)
-  
-  (display "M.params.currentErrorHandler = fail;\n" op)
-  (display "M.params.currentSuccessHandler = success;\n" op)
-  (display  #<<EOF
-for (param in params) {
-    if (params.hasOwnProperty(param)) {
-        M.params[param] = params[param];
-    }
-}
-EOF
-           op)
-  (fprintf op "M.trampoline(~a, true); })"
-           (assemble-label (make-Label (BasicBlock-name (first basic-blocks)))
-                           blockht)))
-
-
-
-(: write-blocks ((Listof BasicBlock) Blockht (Setof Symbol) (Setof Symbol) Output-Port -> Void))
-;; Write out all the basic blocks associated to an entry point.
-(define (write-blocks blocks blockht entry-points function-entry-and-exit-names op)  
-  
-  ;; Since there may be cycles between the blocks, we cut the cycles by
-  ;; making them entry points as well.
-  (insert-cycles-as-entry-points! entry-points blockht)
-
-  (set-for-each (lambda: ([s : Symbol])
-                  (log-debug (format "Emitting code for basic block ~s" s))
-                  (assemble-basic-block (hash-ref blockht s) 
-                                        blockht
-                                        entry-points
-                                        function-entry-and-exit-names
-                                        op)
-                  (newline op))
-                entry-points))
-
-
-
-(: insert-cycles-as-entry-points! ((Setof Symbol) Blockht -> 'ok))
-(define (insert-cycles-as-entry-points! entry-points blockht)
-  (define visited ((inst new-seteq Symbol)))
-  
-  (: loop ((Listof Symbol) -> 'ok))
-  (define (loop queue)
-    (cond
-      [(empty? queue)
-       'ok]
-      [else
-       ;; Visit the next one.
-       (define next-to-visit (first queue))
-       (cond
-         [(set-contains? visited next-to-visit)
-          #;(unless (set-contains? entry-points next-to-visit)
-            (log-debug (format "Promoting ~a to an entry point" next-to-visit))
-            (set-insert! entry-points next-to-visit))
-          (loop (rest queue))]
-         [else
-          (set-insert! visited next-to-visit)
-          (set-insert! entry-points next-to-visit)
-          (loop (list-union (basic-block-out-edges (hash-ref blockht next-to-visit))
-                            (rest queue)))])]))
-
-  (loop (set->list entry-points)))
-
-
-
-
-
-(: write-linked-label-attributes ((Listof Statement) Blockht Output-Port -> 'ok))
-(define (write-linked-label-attributes stmts blockht op)
-  (cond
-    [(empty? stmts)
-     'ok]
-    [else
-     (let: ([stmt : Statement (first stmts)])
-       
-       (define (next) (write-linked-label-attributes (rest stmts) blockht op))
-       
-       (cond
-         [(symbol? stmt)
-          (next)]
-         [(LinkedLabel? stmt)
-          ;; Setting up multiple-value-return.
-          ;; Optimization: in the most common case (expecting only one), we optimize away
-          ;; the assignment, because there's a distinguished instruction, and it's implied
-          ;; that if .mvr is missing, that the block only expects one.
-          (define linked-to-block (hash-ref blockht (LinkedLabel-linked-to stmt)))
-          (cond
-           [(block-looks-like-context-expected-values? linked-to-block)
-            => (lambda (expected)
-                 (cond
-                  [(= expected 1)
-                   (void)]
-                  [else
-                   (fprintf op "~a.mvr=RT.si_context_expected(~a);\n"
-                            (munge-label-name (make-Label (LinkedLabel-label stmt)))
-                            expected)]))]
-           [else
-            (fprintf op "~a.mvr=~a;\n" 
-                     (munge-label-name (make-Label (LinkedLabel-label stmt)))
-                     (assemble-label (make-Label (LinkedLabel-linked-to stmt)) blockht))])
-          (next)]
-         [(DebugPrint? stmt)
-          (next)]
-         [(AssignImmediateStatement? stmt)
-          (next)]
-         [(AssignPrimOpStatement? stmt)
-          (next)]
-         [(PerformStatement? stmt)
-          (next)]
-         [(TestAndJumpStatement? stmt)
-          (next)]
-         [(GotoStatement? stmt)
-          (next)]
-         [(PushEnvironment? stmt)
-          (next)]
-         [(PopEnvironment? stmt)
-          (next)]
-         [(PushImmediateOntoEnvironment? stmt)
-          (next)]
-         [(PushControlFrame/Generic? stmt)
-          (next)]
-         [(PushControlFrame/Call? stmt)
-          (next)]
-         [(PushControlFrame/Prompt? stmt)
-          (next)]
-         [(PopControlFrame? stmt)
-          (next)]
-         [(Comment? stmt)
-          (next)]))]))
-
-
-
-
-
-
-(: assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok))
-(define (assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)
-  (cond
-   [(block-looks-like-context-expected-values? a-basic-block)
-    =>
-    (lambda (expected)
-      (cond
-       [(= expected 1)
-        'ok]
-       [else
-        (fprintf op "~a=RT.si_context_expected(~a);\n"
-                 (munge-label-name (make-Label (BasicBlock-name a-basic-block)))
-                 expected)
-        'ok]))]
-   [else
-    (default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)]))
-
-
-
-(: default-assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok))
-(define (default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)
-  (cond
-   [(set-contains? function-entry-and-exit-names (BasicBlock-name a-basic-block))
-    (fprintf op "var ~a=function(M){if(--M.cbt<0){throw ~a;}\n"
-             (assemble-label (make-Label (BasicBlock-name a-basic-block)) blockht)
-             (assemble-label (make-Label (BasicBlock-name a-basic-block)) blockht))]
-   [else
-    (fprintf op "var ~a=function(M){\n"
-             (assemble-label (make-Label (BasicBlock-name a-basic-block)) blockht))])
-  (assemble-block-statements (BasicBlock-name a-basic-block)
-                             (BasicBlock-stmts a-basic-block)
-                             blockht
-                             entry-points
-                             op)
-  (display "};\n" op)
-  'ok)
-
-
-
-
-(: assemble-block-statements (Symbol (Listof UnlabeledStatement) Blockht (Setof Symbol) Output-Port -> 'ok))
-(define (assemble-block-statements name stmts blockht entry-points op)
-  
-  (: default (UnlabeledStatement -> 'ok))
-  (define (default stmt)
-    (when (and (empty? (rest stmts))
-               (not (GotoStatement? stmt)))
-      (log-debug (format "Last statement of the block ~a is not a goto" name)))
-
-    (display (assemble-statement stmt blockht) op)
-    (newline op)
-    (assemble-block-statements name
-                               (rest stmts) 
-                               blockht
-                               entry-points
-                               op))
-  
-  (cond [(empty? stmts)
-         'ok]
-        [else
-         (define stmt (first stmts))
-         (cond
-           [(DebugPrint? stmt)
-            (default stmt)]
-           
-           [(AssignImmediateStatement? stmt)
-            (default stmt)]
-           
-           [(AssignPrimOpStatement? stmt)
-            (default stmt)]
-           
-           [(PerformStatement? stmt)
-            (default stmt)]
-           
-           [(TestAndJumpStatement? stmt)
-            (define test (TestAndJumpStatement-op stmt))
-            
-            (: test-code String)
-            (define test-code (cond
-                                [(TestFalse? test)
-                                 (format "if(~a===false)"
-                                         (assemble-oparg (TestFalse-operand test)
-                                                         blockht))]
-                                [(TestTrue? test)
-                                 (format "if(~a!==false)"
-                                         (assemble-oparg (TestTrue-operand test)
-                                                         blockht))]
-                                [(TestOne? test)
-                                 (format "if(~a===1)"
-                                         (assemble-oparg (TestOne-operand test)
-                                                         blockht))]
-                                [(TestZero? test)
-                                 (format "if(~a===0)"
-                                         (assemble-oparg (TestZero-operand test)
-                                                         blockht))]
-                                                                
-                                [(TestClosureArityMismatch? test)
-                                 (format "if(!RT.isArityMatching((~a).racketArity,~a))"
-                                         (assemble-oparg (TestClosureArityMismatch-closure test)
-                                                         blockht)
-                                         (assemble-oparg (TestClosureArityMismatch-n test)
-                                                         blockht))]))
-               (display test-code op)
-               (display "{" op)
-               (cond
-                [(set-contains? entry-points (TestAndJumpStatement-label stmt))
-                 (display (assemble-jump (make-Label (TestAndJumpStatement-label stmt))
-                                         blockht) op)]
-                [else
-                 (assemble-block-statements (BasicBlock-name
-                                             (hash-ref blockht (TestAndJumpStatement-label stmt)))
-                                            (BasicBlock-stmts 
-                                             (hash-ref blockht (TestAndJumpStatement-label stmt)))
-                                            blockht
-                                            entry-points
-                                            op)])
-               (display "}else{" op)
-               (assemble-block-statements name (rest stmts) blockht entry-points op)
-               (display "}" op)
-               'ok]
-           
-           [(GotoStatement? stmt)
-            (let loop ([stmt stmt])
-              (define target (GotoStatement-target stmt))
-              (cond
-               [(Label? target)
-                (define target-block (hash-ref blockht (Label-name target)))
-                (define target-name (BasicBlock-name target-block))
-                (define target-statements (BasicBlock-stmts target-block))
-                (cond
-                 ;; Optimization: if the target block consists of a single goto,
-                 ;; inline and follow the goto.
-                 [(and (not (empty? target-statements))
-                       (= 1 (length target-statements))
-                       (GotoStatement? (first target-statements)))
-                  (loop (first target-statements))]
-                 [(set-contains? entry-points (Label-name target))
-                  (display (assemble-statement stmt blockht) op)
-                  'ok]
-                 [else
-                  (log-debug (format "Assembling inlined jump into ~a" (Label-name target)) )
-                  (assemble-block-statements target-name
-                                             target-statements
-                                             blockht
-                                             entry-points
-                                             op)])]
-               [(Reg? target)
-                (display (assemble-statement stmt blockht) op)
-                'ok]
-               [(ModuleEntry? target)
-                (display (assemble-statement stmt blockht) op)
-                'ok]
-               [(CompiledProcedureEntry? target)
-                (display (assemble-statement stmt blockht) op)
-                'ok]))]
-
-           
-           [(PushControlFrame/Generic? stmt)
-            (default stmt)]
-           
-           [(PushControlFrame/Call? stmt)
-            (default stmt)]
-           
-           [(PushControlFrame/Prompt? stmt)
-            (default stmt)]
-           
-           [(PopControlFrame? stmt)
-            (default stmt)]
-           
-           [(PushEnvironment? stmt)
-            (default stmt)]
-           
-           [(PopEnvironment? stmt)
-            (default stmt)]
-           
-           [(PushImmediateOntoEnvironment? stmt)
-            (default stmt)]
-           [(Comment? stmt)
-            (default stmt)])]))
-
-
-
-
-(: basic-block-out-edges (BasicBlock -> (Listof Symbol)))
-;; Returns the neighboring blocks of this block.
-(define (basic-block-out-edges a-block)
-  
-  (: loop ((Listof UnlabeledStatement) -> (Listof Symbol)))
-  (define (loop stmts)
-    
-    (: default (-> (Listof Symbol)))
-    (define (default)
-      (loop (rest stmts)))
-    
-    (cond [(empty? stmts)
-           empty]
-          [else
-           (define stmt (first stmts))
-           (cond
-             [(DebugPrint? stmt)
-              (default)]
-             
-             [(AssignImmediateStatement? stmt)
-              (default)]
-             
-             [(AssignPrimOpStatement? stmt)
-              (default)]
-             
-             [(PerformStatement? stmt)
-              (default)]
-             
-             [(TestAndJumpStatement? stmt)
-              (cons (TestAndJumpStatement-label stmt)
-                    (loop (rest stmts)))]
-             
-             [(GotoStatement? stmt)
-              (define target (GotoStatement-target stmt))
-              (cond
-                [(Label? target)
-                 (cons (Label-name target)
-                       (loop (rest stmts)))]
-                [(Reg? target)
-                 (default)]
-                [(ModuleEntry? target)
-                 (default)]
-                [(CompiledProcedureEntry? target)
-                 (default)])]
-             
-             [(PushControlFrame/Generic? stmt)
-              (default)]
-             
-             [(PushControlFrame/Call? stmt)
-              (default)]
-             
-             [(PushControlFrame/Prompt? stmt)
-              (default)]
-             
-             [(PopControlFrame? stmt)
-              (default)]
-             
-             [(PushEnvironment? stmt)
-              (default)]
-             
-             [(PopEnvironment? stmt)
-              (default)]
-             
-             [(PushImmediateOntoEnvironment? stmt)
-              (default)]
-             [(Comment? stmt)
-              (default)])]))
-  
-  (loop (BasicBlock-stmts a-block)))
-
-
-
-
-
-
-
-
-(: assemble-statement (UnlabeledStatement Blockht -> String))
-;; Generates the code to assemble a statement.
-(define (assemble-statement stmt blockht)
-  (define assembled
-    (cond
-     [(DebugPrint? stmt)
-      (format "M.params.currentOutputPort.writeDomNode(M, $('<span/>').text(~a));"
-              (assemble-oparg (DebugPrint-value stmt)
-                              blockht))]
-     [(AssignImmediateStatement? stmt)
-      (let: ([t : (String -> String) (assemble-target (AssignImmediateStatement-target stmt))]
-             [v : OpArg (AssignImmediateStatement-value stmt)])
-        (t (assemble-oparg v blockht)))]
-     
-     [(AssignPrimOpStatement? stmt)
-      ((assemble-target (AssignPrimOpStatement-target stmt))
-       (assemble-op-expression (AssignPrimOpStatement-op stmt)
-                               blockht))]
-     
-     [(PerformStatement? stmt)
-      (assemble-op-statement (PerformStatement-op stmt) blockht)]
-     
-     [(TestAndJumpStatement? stmt)
-      (let*: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)]
-              [jump : String (assemble-jump 
-                              (make-Label (TestAndJumpStatement-label stmt))
-                              blockht)])
-        ;; to help localize type checks, we add a type annotation here.
-        (ann (cond
-               [(TestFalse? test)
-                (format "if(~a===false){~a}"
-                        (assemble-oparg (TestFalse-operand test)
-                                        blockht)
-                        jump)]
-               [(TestTrue? test)
-                (format "if(~a!==false){~a}"
-                        (assemble-oparg (TestTrue-operand test)
-                                        blockht)
-                        jump)]
-               [(TestOne? test)
-                (format "if(~a===1){~a}"
-                        (assemble-oparg (TestOne-operand test)
-                                        blockht)
-                        jump)]
-               [(TestZero? test)
-                (format "if(~a===0){~a}"
-                        (assemble-oparg (TestZero-operand test)
-                                        blockht)
-                        jump)]
-               [(TestClosureArityMismatch? test)
-                (format "if(!RT.isArityMatching((~a).racketArity,~a)){~a}"
-                        (assemble-oparg (TestClosureArityMismatch-closure test)
-                                        blockht)
-                        (assemble-oparg (TestClosureArityMismatch-n test)
-                                        blockht)
-                        jump)])
-             String))]
-     
-     [(GotoStatement? stmt)
-      (assemble-jump (GotoStatement-target stmt)
-                     blockht)]
-     
-     [(PushControlFrame/Generic? stmt)
-      "M.c.push(new RT.Frame());"]
-     
-     [(PushControlFrame/Call? stmt)
-      (format "M.c.push(new RT.CallFrame(~a,M.p));" 
-              (let: ([label : (U Symbol LinkedLabel) (PushControlFrame/Call-label stmt)])
-                (cond
-                  [(symbol? label) 
-                   (assemble-label (make-Label label)
-                                   blockht)]
-                  [(LinkedLabel? label) 
-                   (assemble-label (make-Label (LinkedLabel-label label))
-                                   blockht)])))]
-     
-     [(PushControlFrame/Prompt? stmt)
-      ;; fixme: use a different frame structure
-      (format "M.c.push(new RT.PromptFrame(~a,~a));" 
-              (let: ([label : (U Symbol LinkedLabel) (PushControlFrame/Prompt-label stmt)])
-                (cond
-                  [(symbol? label) 
-                   (assemble-label (make-Label label)
-                                   blockht)]
-                  [(LinkedLabel? label) 
-                   (assemble-label (make-Label (LinkedLabel-label label))
-                                   blockht)]))
-              
-              (let: ([tag : (U DefaultContinuationPromptTag OpArg)
-                          (PushControlFrame/Prompt-tag stmt)])
-                (cond
-                  [(DefaultContinuationPromptTag? tag)
-                   (assemble-default-continuation-prompt-tag)]
-                  [(OpArg? tag)
-                   (assemble-oparg tag blockht)])))]
-     
-     [(PopControlFrame? stmt)
-      "M.c.pop();"]
-     
-     [(PushEnvironment? stmt)
-      (cond [(= (PushEnvironment-n stmt) 0)
-             ""]
-            [(PushEnvironment-unbox? stmt)
-             (format "M.e.push(~a);" (string-join
-                                      (build-list (PushEnvironment-n stmt) 
-                                                  (lambda: ([i : Natural])
-                                                               "[undefined]"))
-                                      ", "))]
-            [else
-             (format "M.e.length+=~a;" (PushEnvironment-n stmt))])]
-     [(PopEnvironment? stmt)
-      (let: ([skip : OpArg (PopEnvironment-skip stmt)])
-        (cond
-          [(and (Const? skip) (= (ensure-natural (Const-const skip)) 0))
-           (cond [(equal? (PopEnvironment-n stmt)
-                          (make-Const 1))
-                  "M.e.pop();"]
-                 [else
-                  (format "M.e.length-=~a;"
-                          (assemble-oparg (PopEnvironment-n stmt) blockht))])]
-          [else
-           (format "M.e.splice(M.e.length-(~a+~a),~a);"
-                   (assemble-oparg (PopEnvironment-skip stmt) blockht)
-                   (assemble-oparg (PopEnvironment-n stmt) blockht)
-                   (assemble-oparg (PopEnvironment-n stmt) blockht))]))]
-     
-     [(PushImmediateOntoEnvironment? stmt)
-      (format "M.e.push(~a);"
-              (let: ([val-string : String
-                                 (cond [(PushImmediateOntoEnvironment-box? stmt)
-                                        (format "[~a]" (assemble-oparg (PushImmediateOntoEnvironment-value stmt)
-                                                                       blockht))]
-                                       [else
-                                        (assemble-oparg (PushImmediateOntoEnvironment-value stmt)
-                                                        blockht)])])
-                val-string))]
-     [(Comment? stmt)
-      ;; TODO: maybe comments should be emitted as JavaScript comments.
-      ""]))
-  (cond
-   #;[(current-emit-debug-trace?)
-    (string-append 
-     (format "if(typeof(window.console)!=='undefined'&&typeof(window.console.log)==='function'){window.console.log(~s);\n}"
-               (format "~a" stmt))
-     assembled)]
-   [else
-    assembled]))
-
-
-(define-predicate natural? Natural)
-
-(: ensure-natural (Any -> Natural))
-(define (ensure-natural n)
-  (if (natural? n)
-      n
-      (error 'ensure-natural)))
-
-
-
-(: get-function-entry-and-exit-names ((Listof Statement) -> (Listof Symbol)))
-(define (get-function-entry-and-exit-names stmts)
-  (cond
-   [(empty? stmts)
-    '()]
-   [else
-    (define first-stmt (first stmts))
-    (cond
-     [(LinkedLabel? first-stmt)
-      (cons (LinkedLabel-label first-stmt)
-            (cons (LinkedLabel-linked-to first-stmt)
-                  (get-function-entry-and-exit-names (rest stmts))))]
-     [(AssignPrimOpStatement? first-stmt)
-      (define op (AssignPrimOpStatement-op first-stmt))
-      (cond
-       [(MakeCompiledProcedure? op)
-        (cons (MakeCompiledProcedure-label op)
-              (get-function-entry-and-exit-names (rest stmts)))]
-       [(MakeCompiledProcedureShell? first-stmt)
-        (cons (MakeCompiledProcedureShell-label op)
-              (get-function-entry-and-exit-names (rest stmts)))]
-       [else
-        (get-function-entry-and-exit-names (rest stmts))])]
-     [else
-      (get-function-entry-and-exit-names (rest stmts))])]))

js-assembler/find-primitive-implemented.rkt

@@ -1,27 +0,0 @@
-#lang racket/base
-
-(require racket/runtime-path
-         racket/list
-         (for-syntax racket/base))
-
-;; Provides a list of symbols of the function implemented primitively.  Knowing
-;; this allows us to do certain procedure applications more efficiently without
-;; touching the stack so much.
-(provide primitive-ids)
-
-(define a-regexp 
-  #px"installPrimitiveProcedure\\s*\\(\\s*['\"]([^'\"]+)['\"]")
-
-(define-runtime-path baselib-primitives.js
-  (build-path "runtime-src" "baselib-primitives.js"))
-
-(define ip (open-input-file baselib-primitives.js))
-
-(define primitive-ids
-  (let loop ()
-    (let ([a-match (regexp-match a-regexp ip)])
-      (cond
-        [a-match => (lambda (a-match)
-                      (cons (string->symbol (bytes->string/utf-8 (second a-match)))
-                            (loop)))]
-        [else empty]))))

js-assembler/runtime-src/baselib-modules.js

@@ -1,83 +0,0 @@
-/*jslint sub: true, vars: true, nomen: true, plusplus: true, maxerr: 50, indent: 4 */
-/*global plt*/
-
-// Modules
-(function (baselib, plt) {
-    'use strict';
-    var exports = {};
-    baselib.modules = exports;
-
-
-    var ModuleRecord = function (name, label) {
-        this.name = name;
-        this.label = label;
-        this.isInvoked = false;
-        this.prefix = false;
-        this.namespace = {};
-
-        // JavaScript-implemented code will assign privateExports
-        // with all of the exported identifiers.
-        this.privateExports = {};
-    };
-
-    // Returns access to the names defined in the module.
-    ModuleRecord.prototype.getNamespace = function () {
-        return this.namespace;
-    };
-
-    ModuleRecord.prototype.finalizeModuleInvokation = function () {
-        var i, len = this.prefix.names.length;
-        for (i = 0; i < len; i++) {
-            this.namespace[this.prefix.names[i]] = this.prefix[i];
-        }
-    };
-    
-
-    // External invokation of a module.
-    ModuleRecord.prototype.invoke = function (MACHINE, succ, fail) {
-        this._invoke(false, MACHINE, succ, fail);
-    };
-
-    // Internal invokation of a module.
-    ModuleRecord.prototype.internalInvoke = function (MACHINE, succ, fail) {
-        this._invoke(true, MACHINE, succ, fail);
-    };
-
-    // Private: general invokation of a module
-    ModuleRecord.prototype._invoke = function (isInternal, MACHINE, succ, fail) {
-        var that = this;
-        MACHINE = MACHINE || plt.runtime.currentMachine;
-        succ = succ || function () {};
-        fail = fail || function () {};
-
-        var oldErrorHandler = MACHINE.params['currentErrorHandler'];
-        var afterGoodInvoke = function (MACHINE) { 
-            MACHINE.params['currentErrorHandler'] = oldErrorHandler;
-            if (isInternal) { succ(); }
-            else {
-                throw new plt.runtime.HaltError(succ)
-            }
-        };
-
-        if (this.isInvoked) {
-            succ();
-        } else {
-            MACHINE.params['currentErrorHandler'] = function (MACHINE, anError) {
-                MACHINE.params['currentErrorHandler'] = oldErrorHandler;
-                fail(MACHINE, anError);
-            };
-            MACHINE.c.push(new plt.baselib.frames.CallFrame(afterGoodInvoke, null));
-            if (isInternal) {
-                throw that.label;
-            } else {
-                MACHINE.trampoline(that.label);
-            }
-        }
-    };
-
-
-
-    exports.ModuleRecord = ModuleRecord;
-
-
-}(this.plt.baselib, this.plt));

js-assembler/runtime-src/jquery-protect-footer.js

@@ -1,2 +0,0 @@
-    }
-})(window);

js-assembler/runtime-src/js-numbers.js

@@ -1,90 +0,0 @@
-var __PLTNUMBERS_TOP__;typeof exports!=="undefined"?__PLTNUMBERS_TOP__=exports:(this.jsnums||(this.jsnums={}),__PLTNUMBERS_TOP__=this.jsnums);
-(function(){function f(a,b,c){a!=null&&("number"==typeof a?this.fromNumber(a,b,c):b==null&&"string"!=typeof a?this.fromString(a,256):this.fromString(a,b))}function p(){return new f(null)}function hb(a,b,c,e,j,d){for(;--d>=0;){var f=b*this[a++]+c[e]+j,j=Math.floor(f/67108864);c[e++]=f&67108863}return j}function ib(a,b,c,e,j,d){var f=b&32767;for(b>>=15;--d>=0;){var g=this[a]&32767,h=this[a++]>>15,i=b*g+h*f,g=f*g+((i&32767)<<15)+c[e]+(j&1073741823),j=(g>>>30)+(i>>>15)+b*h+(j>>>30);c[e++]=g&1073741823}return j}
-function jb(a,b,c,e,j,d){var f=b&16383;for(b>>=14;--d>=0;){var g=this[a]&16383,h=this[a++]>>14,i=b*g+h*f,g=f*g+((i&16383)<<14)+c[e]+j,j=(g>>28)+(i>>14)+b*h;c[e++]=g&268435455}return j}function xa(a,b){var c=ja[a.charCodeAt(b)];return c==null?-1:c}function N(a){var b=p();b.fromInt(a);return b}function Y(a){var b=this.s-a.s;if(b!=0)return b;var c=this.t,b=this.s<0?a.t-c:c-a.t;if(b!=0)return b;for(;--c>=0;)if((b=this[c]-a[c])!=0)return b;return 0}function ka(a){var b=1,c;if((c=a>>>16)!=0)a=c,b+=16;if((c=
-a>>8)!=0)a=c,b+=8;if((c=a>>4)!=0)a=c,b+=4;if((c=a>>2)!=0)a=c,b+=2;a>>1!=0&&(b+=1);return b}function ya(a){var b=p();this.abs().divRemTo(a,null,b);this.s<0&&b.compareTo(f.ZERO)>0&&a.subTo(b,b);return b}function P(a){this.m=a}function Q(a){this.m=a;this.mp=a.invDigit();this.mpl=this.mp&32767;this.mph=this.mp>>15;this.um=(1<<a.DB-15)-1;this.mt2=2*a.t}function Z(a){return this.compareTo(a)==0}function kb(a,b){return a&b}function ua(a,b){return a|b}function za(a,b){return a^b}function Aa(a,b){return a&
-~b}function Ba(a){var b=p();this.addTo(a,b);return b}function Ca(a){var b=p();this.subTo(a,b);return b}function Da(a){var b=p();this.multiplyTo(a,b);return b}function Ea(a){var b=p();this.divRemTo(a,b,null);return b}function Fa(a){var b=p();this.divRemTo(a,null,b);return b}function Ga(a){var b=p(),c=p();this.divRemTo(a,b,c);return[b,c]}function $(){}function Ha(a){return a}function Ia(a){return this.exp(a,new $)}function V(a){this.r2=p();this.q3=p();f.ONE.dlShiftTo(2*a.t,this.r2);this.mu=this.r2.divide(a);
-this.m=a}function Ja(a){var b=this.s<0?this.negate():this.clone(),a=a.s<0?a.negate():a.clone();if(b.compareTo(a)<0)var c=b,b=a,a=c;var c=b.getLowestSetBit(),e=a.getLowestSetBit();if(e<0)return b;c<e&&(e=c);e>0&&(b.rShiftTo(e,b),a.rShiftTo(e,a));for(;b.signum()>0;)(c=b.getLowestSetBit())>0&&b.rShiftTo(c,b),(c=a.getLowestSetBit())>0&&a.rShiftTo(c,a),b.compareTo(a)>=0?(b.subTo(a,b),b.rShiftTo(1,b)):(a.subTo(b,a),a.rShiftTo(1,a));e>0&&a.lShiftTo(e,a);return a}var h=__PLTNUMBERS_TOP__,H=function(a,b,c){c=
-c||{};return function(e,j){if(c.isXSpecialCase&&c.isXSpecialCase(e))return c.onXSpecialCase(e,j);if(c.isYSpecialCase&&c.isYSpecialCase(j))return c.onYSpecialCase(e,j);if(typeof e==="number"&&typeof j==="number")return a(e,j);typeof e==="number"&&(e=Ka(e,j));typeof j==="number"&&(j=Ka(j,e));e.level<j.level&&(e=e.liftTo(j));j.level<e.level&&(j=j.liftTo(e));return b(e,j)}},Na=function(a){var b=a.match(La);return b?(a=b[1].match(/^([^.]*)(.*)$/),b=Number(b[2]),a[2].length===0?a[1]+Ma(b):b>=a[2].length-
-1?a[1]+a[2].substring(1)+Ma(b-(a[2].length-1)):a[1]+a[2].substring(1,1+b)):a},Ma=function(a){var b=[];b.length=a;for(var c=0;c<a;c++)b[c]="0";return b.join("")},Ka=function(a,b){switch(b.level){case 0:return v(a);case 1:return new i(a,1);case 2:return new d(a);case 3:return new g(a,0);default:l("IMPOSSIBLE: cannot lift fixnum integer to "+b.toString(),a,b)}},l=function(a,b,c){h.onThrowRuntimeError(a,b,c)},R=function(a){return typeof a==="number"||a instanceof i||a instanceof d||a instanceof g||a instanceof
-f},va=function(a){return typeof a==="number"||R(a)&&a.isRational()},E=function(a){return typeof a==="number"||R(a)&&a.isReal()},W=function(a){return typeof a==="number"||R(a)&&a.isExact()},aa=function(a){return typeof a==="number"?!1:R(a)&&a.isInexact()},t=function(a){return typeof a==="number"||R(a)&&a.isInteger()},O=function(a){return typeof a==="number"||R(a)&&a.isInteger()&&a.isExact()},I=function(a){return typeof a==="number"?a:a.toFixnum()},S=function(a){return typeof a==="number"?a:a.toExact()},
-ba=function(a){return typeof a==="number"?d.makeInstance(a):a.toInexact()},m=H(function(a,b){var c=a+b;return K(c)?v(a).add(v(b)):c},function(a,b){return a.add(b)},{isXSpecialCase:function(a){return O(a)&&r(a)},onXSpecialCase:function(a,b){return b},isYSpecialCase:function(a){return O(a)&&r(a)},onYSpecialCase:function(a){return a}}),w=H(function(a,b){var c=a-b;return K(c)?v(a).subtract(v(b)):c},function(a,b){return a.subtract(b)},{isXSpecialCase:function(a){return O(a)&&r(a)},onXSpecialCase:function(a,
-b){return x(b)},isYSpecialCase:function(a){return O(a)&&r(a)},onYSpecialCase:function(a){return a}}),k=H(function(a,b){var c=a*b;return K(c)?v(a).multiply(v(b)):c},function(a,b){return a.multiply(b)},{isXSpecialCase:function(a){return O(a)&&(r(a)||T(a)||la(a))},onXSpecialCase:function(a,b){if(r(a))return 0;if(T(a))return b;if(la(a))return x(b)},isYSpecialCase:function(a){return O(a)&&(r(a)||T(a)||la(a))},onYSpecialCase:function(a,b){if(r(b))return 0;if(T(b))return a;if(la(b))return x(a)}}),o=H(function(a,
-b){r(b)&&l("/: division by zero",a,b);var c=a/b;return K(c)?v(a).divide(v(b)):Math.floor(c)!==c?i.makeInstance(a,b):c},function(a,b){return a.divide(b)},{isXSpecialCase:function(a){return q(a,0)},onXSpecialCase:function(a,b){q(b,0)&&l("/: division by zero",a,b);return 0},isYSpecialCase:function(a){return q(a,0)},onYSpecialCase:function(a,b){l("/: division by zero",a,b)}}),s=H(function(a,b){return a===b},function(a,b){return a.equals(b)}),q=function(a,b){if(a===b)return!0;if(typeof a==="number"&&typeof b===
-"number")return a===b;if(a===L||b===L)return a===b;if(a instanceof g||b instanceof g)return q(M(a),M(b))&&q(ca(a),ca(b));var c=W(a),e=W(b);return(c&&e||!c&&!e)&&s(a,b)},ma=H(function(a,b){return a>=b},function(a,b){(!E(a)||!E(b))&&l(">=: couldn't be applied to complex number",a,b);return a.greaterThanOrEqual(b)}),da=H(function(a,b){return a<=b},function(a,b){(!E(a)||!E(b))&&l("<=: couldn't be applied to complex number",a,b);return a.lessThanOrEqual(b)}),U=H(function(a,b){return a>b},function(a,b){(!E(a)||
-!E(b))&&l(">: couldn't be applied to complex number",a,b);return a.greaterThan(b)}),J=H(function(a,b){return a<b},function(a,b){(!E(a)||!E(b))&&l("<: couldn't be applied to complex number",a,b);return a.lessThan(b)}),lb=function(){var a=H(function(a,c){var e=Math.pow(a,c);return K(e)?v(a).expt(v(c)):e},function(a,c){return s(c,0)?m(c,1):a.expt(c)});return function(b,c){return s(c,0)?m(c,1):E(c)&&J(c,0)?a(o(1,b),x(c)):a(b,c)}}(),F=function(a){return q(a,0)?1:typeof a==="number"?d.makeInstance(Math.exp(a)):
-a.exp()},Pa=function(a,b){t(a)||l("modulo: the first argument "+a+" is not an integer.",a,b);t(b)||l("modulo: the second argument "+b+" is not an integer.",a,b);var c;if(typeof a==="number")return c=a%b,b<0?c<=0?c:c+b:c<0?c+b:c;c=Oa(z(a),z(b));return J(b,0)?da(c,0)?c:m(c,b):J(c,0)?m(c,b):c},ea=function(a){return typeof a==="number"?a:a.numerator()},Qa=function(a){return typeof a==="number"?1:a.denominator()},D=function(a){return typeof a==="number"?a>=0?(a=Math.sqrt(a),Math.floor(a)===a?a:d.makeInstance(a)):
-g.makeInstance(0,D(-a)):a.sqrt()},A=function(a){return typeof a==="number"?Math.abs(a):a.abs()},z=function(a){return typeof a==="number"?a:a.floor()},Ra=function(a){return typeof a==="number"?a:a.ceiling()},Sa=function(a){return typeof a==="number"?a:a.conjugate()},na=function(a){return q(a,1)?0:typeof a==="number"?d.makeInstance(Math.log(a)):a.log()},Ta=function(a){return typeof a==="number"?a>0?0:d.pi:a.angle()},Ua=function(a){return q(a,0)?0:typeof a==="number"?d.makeInstance(Math.tan(a)):a.tan()},
-wa=function(a){return q(a,0)?0:typeof a==="number"?d.makeInstance(Math.atan(a)):a.atan()},oa=function(a){return q(a,0)?1:typeof a==="number"?d.makeInstance(Math.cos(a)):a.cos()},pa=function(a){return q(a,0)?0:typeof a==="number"?d.makeInstance(Math.sin(a)):a.sin()},Va=function(a){return q(a,1)?0:typeof a==="number"?d.makeInstance(Math.acos(a)):a.acos()},Wa=function(a){return q(a,0)?0:typeof a==="number"?d.makeInstance(Math.asin(a)):a.asin()},ca=function(a){return typeof a==="number"?0:a.imaginaryPart()},
-M=function(a){return typeof a==="number"?a:a.realPart()},Xa=function(a){return typeof a==="number"?a:a.round()},X=function(a){return k(a,a)},Ya=function(a){t(a)||l("integer-sqrt: the argument "+a.toString()+" is not an integer.",a);return typeof a==="number"?a<0?g.makeInstance(0,Math.floor(Math.sqrt(-a))):Math.floor(Math.sqrt(a)):a.integerSqrt()},qa=function(a,b){t(a)||l("quotient: the first argument "+a.toString()+" is not an integer.",a);t(b)||l("quotient: the second argument "+b.toString()+" is not an integer.",
-b);return fa(a,b)},ra=function(a,b){t(a)||l("remainder: the first argument "+a.toString()+" is not an integer.",a);t(b)||l("remainder: the second argument "+b.toString()+" is not an integer.",b);return mb(a,b)},K=function(a){return a<-9E15||9E15<a},x=function(a){return typeof a==="number"?-a:a.negate()},Za=function(a,b){for(var c=1;;){if(r(b))return c;s(Pa(b,2),0)?(a=k(a,a),b=o(b,2)):(c=k(c,a),b=w(b,1))}},n=function(a,b,c){c=c||{};return function(e,j){e instanceof i?e=ea(e):e instanceof g&&(e=M(e));
-j instanceof i?j=ea(j):j instanceof g&&(j=M(j));if(typeof e==="number"&&typeof j==="number"){var f=a(e,j);if(!K(f)||c.ignoreOverflow)return f}if(e instanceof d||j instanceof d)return c.doNotCoerseToFloating?a(I(e),I(j)):d.makeInstance(a(I(e),I(j)));typeof e==="number"&&(e=v(e));typeof j==="number"&&(j=v(j));return b(e,j)}},y=function(a,b,c){c=c||{};return function(e){e instanceof i?e=ea(e):e instanceof g&&(e=M(e));if(typeof e==="number"){var j=a(e);if(!K(j)||c.ignoreOverflow)return j}if(e instanceof
-d)return a(I(e));typeof e==="number"&&(e=v(e));return b(e)}},Oa=n(function(a,b){return a%b},function(a,b){return ya.call(a,b)}),sa=n(function(a,b){for(var c;b!==0;)c=a,a=b,b=c%b;return a},function(a,b){return Ja.call(a,b)}),r=y(function(a){return a===0},function(a){return Z.call(a,f.ZERO)}),T=y(function(a){return a===1},function(a){return Z.call(a,f.ONE)}),la=y(function(a){return a===-1},function(a){return Z.call(a,f.NEGATIVE_ONE)}),nb=n(function(a,b){return a+b},function(a,b){return Ba.call(a,b)}),
-ob=n(function(a,b){return a-b},function(a,b){return Ca.call(a,b)}),u=n(function(a,b){return a*b},function(a,b){return Da.call(a,b)}),fa=n(function(a,b){return(a-a%b)/b},function(a,b){return Ea.call(a,b)}),mb=n(function(a,b){return a%b},function(a,b){return Fa.call(a,b)}),B=n(function(a,b){return a/b},function(a,b){return I(a)/I(b)},{ignoreOverflow:!0,doNotCoerseToFloating:!0}),$a=n(function(a,b){return a===b},function(a,b){return Z.call(a,b)},{doNotCoerseToFloating:!0}),ab=n(function(a,b){return a>
-b},function(a,b){return Y.call(a,b)>0},{doNotCoerseToFloating:!0}),ta=n(function(a,b){return a<b},function(a,b){return Y.call(a,b)<0},{doNotCoerseToFloating:!0}),bb=n(function(a,b){return a>=b},function(a,b){return Y.call(a,b)>=0},{doNotCoerseToFloating:!0}),pb=n(function(a,b){return a<=b},function(a,b){return Y.call(a,b)<=0},{doNotCoerseToFloating:!0}),i=function(a,b){this.n=a;this.d=b};i.prototype.toString=function(){return T(this.d)?this.n.toString()+"":this.n.toString()+"/"+this.d.toString()};
-i.prototype.level=1;i.prototype.liftTo=function(a){return a.level===2?new d(B(this.n,this.d)):a.level===3?new g(this,0):l("invalid level of Number",this,a)};i.prototype.isFinite=function(){return!0};i.prototype.equals=function(a){return a instanceof i&&$a(this.n,a.n)&&$a(this.d,a.d)};i.prototype.isInteger=function(){return T(this.d)};i.prototype.isRational=function(){return!0};i.prototype.isReal=function(){return!0};i.prototype.add=function(a){return i.makeInstance(nb(u(this.n,a.d),u(this.d,a.n)),
-u(this.d,a.d))};i.prototype.subtract=function(a){return i.makeInstance(ob(u(this.n,a.d),u(this.d,a.n)),u(this.d,a.d))};i.prototype.negate=function(){return i.makeInstance(-this.n,this.d)};i.prototype.multiply=function(a){return i.makeInstance(u(this.n,a.n),u(this.d,a.d))};i.prototype.divide=function(a){(r(this.d)||r(a.n))&&l("/: division by zero",this,a);return i.makeInstance(u(this.n,a.d),u(this.d,a.n))};i.prototype.toExact=function(){return this};i.prototype.toInexact=function(){return d.makeInstance(this.toFixnum())};
-i.prototype.isExact=function(){return!0};i.prototype.isInexact=function(){return!1};i.prototype.toFixnum=function(){return B(this.n,this.d)};i.prototype.numerator=function(){return this.n};i.prototype.denominator=function(){return this.d};i.prototype.greaterThan=function(a){return ab(u(this.n,a.d),u(this.d,a.n))};i.prototype.greaterThanOrEqual=function(a){return bb(u(this.n,a.d),u(this.d,a.n))};i.prototype.lessThan=function(a){return ta(u(this.n,a.d),u(this.d,a.n))};i.prototype.lessThanOrEqual=function(a){return pb(u(this.n,
-a.d),u(this.d,a.n))};i.prototype.integerSqrt=function(){var a=D(this);return va(a)?S(z(a)):E(a)?S(z(a)):g.makeInstance(S(z(M(a))),S(z(ca(a))))};i.prototype.sqrt=function(){if(bb(this.n,0)){var a=D(this.n),b=D(this.d);return s(z(a),a)&&s(z(b),b)?i.makeInstance(a,b):d.makeInstance(B(a,b))}else return a=D(x(this.n)),b=D(this.d),s(z(a),a)&&s(z(b),b)?g.makeInstance(0,i.makeInstance(a,b)):g.makeInstance(0,d.makeInstance(B(a,b)))};i.prototype.abs=function(){return i.makeInstance(A(this.n),this.d)};i.prototype.floor=
-function(){var a=fa(this.n,this.d);return ta(this.n,0)?w(a,1):a};i.prototype.ceiling=function(){var a=fa(this.n,this.d);return ta(this.n,0)?a:m(a,1)};i.prototype.conjugate=function(){return this};i.prototype.magnitude=i.prototype.abs;i.prototype.log=function(){return d.makeInstance(Math.log(this.n/this.d))};i.prototype.angle=function(){return r(this.n)?0:ab(this.n,0)?0:d.pi};i.prototype.tan=function(){return d.makeInstance(Math.tan(B(this.n,this.d)))};i.prototype.atan=function(){return d.makeInstance(Math.atan(B(this.n,
-this.d)))};i.prototype.cos=function(){return d.makeInstance(Math.cos(B(this.n,this.d)))};i.prototype.sin=function(){return d.makeInstance(Math.sin(B(this.n,this.d)))};i.prototype.expt=function(a){return O(a)&&ma(a,0)?Za(this,a):d.makeInstance(Math.pow(B(this.n,this.d),B(a.n,a.d)))};i.prototype.exp=function(){return d.makeInstance(Math.exp(B(this.n,this.d)))};i.prototype.acos=function(){return d.makeInstance(Math.acos(B(this.n,this.d)))};i.prototype.asin=function(){return d.makeInstance(Math.asin(B(this.n,
-this.d)))};i.prototype.imaginaryPart=function(){return 0};i.prototype.realPart=function(){return this};i.prototype.round=function(){if(s(this.d,2)){var a=B(this.n,this.d),b=Math.floor(a),a=Math.ceil(a);return r(b%2)?b:a}else return Math.round(this.n/this.d)};i.makeInstance=function(a,b){a===void 0&&l("n undefined",a,b);b===void 0&&(b=1);ta(b,0)&&(a=x(a),b=x(b));var c=sa(A(a),A(b)),a=fa(a,c),b=fa(b,c);return T(b)||r(a)?a:new i(a,b)};var d=function(a){this.n=a},ga=new d(Number.NaN),n=new d(Number.POSITIVE_INFINITY),
-cb=new d(Number.NEGATIVE_INFINITY),db=new d(Number.POSITIVE_INFINITY),eb=new d(Number.NEGATIVE_INFINITY),L=new d(0),fb=new d(0);d.pi=new d(Math.PI);d.e=new d(Math.E);d.nan=ga;d.inf=n;d.neginf=cb;d.makeInstance=function(a){if(isNaN(a))return d.nan;else if(a===Number.POSITIVE_INFINITY)return d.inf;else if(a===Number.NEGATIVE_INFINITY)return d.neginf;else if(a===0)return 1/a===-Infinity?L:fb;return new d(a)};d.prototype.isExact=function(){return!1};d.prototype.isInexact=function(){return!0};d.prototype.isFinite=
-function(){return isFinite(this.n)||this===db||this===eb};d.prototype.toExact=function(){(!isFinite(this.n)||isNaN(this.n))&&l("toExact: no exact representation for "+this,this);var a=this.n.toString().match(/^(.*)\.(.*)$/);return a?(parseInt(a[1]),parseInt(a[2]),a=Math.pow(10,a[2].length),i.makeInstance(Math.round(this.n*a),a)):this.n};d.prototype.toInexact=function(){return this};d.prototype.isInexact=function(){return!0};d.prototype.level=2;d.prototype.liftTo=function(a){return a.level===3?new g(this,
-0):l("invalid level of Number",this,a)};d.prototype.toString=function(){if(isNaN(this.n))return"+nan.0";if(this.n===Number.POSITIVE_INFINITY)return"+inf.0";if(this.n===Number.NEGATIVE_INFINITY)return"-inf.0";if(this===L)return"-0.0";var a=this.n.toString();return a.match("\\.")?a:a+".0"};d.prototype.equals=function(a){return a instanceof d&&this.n===a.n};d.prototype.isRational=function(){return this.isFinite()};d.prototype.isInteger=function(){return this.isFinite()&&this.n===Math.floor(this.n)};
-d.prototype.isReal=function(){return!0};var ha=function(a){return J(a,0)?-1:U(a,0)?1:a===L?-1:0};d.prototype.add=function(a){return this.isFinite()&&a.isFinite()?d.makeInstance(this.n+a.n):isNaN(this.n)||isNaN(a.n)?ga:this.isFinite()&&!a.isFinite()?a:!this.isFinite()&&a.isFinite()?this:ha(this)*ha(a)===1?this:ga};d.prototype.subtract=function(a){return this.isFinite()&&a.isFinite()?d.makeInstance(this.n-a.n):isNaN(this.n)||isNaN(a.n)?ga:!this.isFinite()&&!a.isFinite()?ha(this)===ha(a)?ga:this:this.isFinite()?
-k(a,-1):this};d.prototype.negate=function(){return d.makeInstance(-this.n)};d.prototype.multiply=function(a){return d.makeInstance(this.n*a.n)};d.prototype.divide=function(a){return d.makeInstance(this.n/a.n)};d.prototype.toFixnum=function(){return this.n};d.prototype.numerator=function(){var a=this.n.toString().match(/^(.*)\.(.*)$/);if(a){var b=parseInt(a[2]),a=Math.pow(10,a[2].length),b=sa(a,b);return d.makeInstance(Math.round(this.n*(a/b)))}else return this};d.prototype.denominator=function(){var a=
-this.n.toString().match(/^(.*)\.(.*)$/);if(a){var b=parseInt(a[2]),a=Math.pow(10,a[2].length),b=sa(a,b);return d.makeInstance(Math.round(a/b))}else return d.makeInstance(1)};d.prototype.floor=function(){return d.makeInstance(Math.floor(this.n))};d.prototype.ceiling=function(){return d.makeInstance(Math.ceil(this.n))};d.prototype.greaterThan=function(a){return this.n>a.n};d.prototype.greaterThanOrEqual=function(a){return this.n>=a.n};d.prototype.lessThan=function(a){return this.n<a.n};d.prototype.lessThanOrEqual=
-function(a){return this.n<=a.n};d.prototype.integerSqrt=function(){if(this===L)return this;if(t(this))return this.n>=0?d.makeInstance(Math.floor(Math.sqrt(this.n))):g.makeInstance(fb,d.makeInstance(Math.floor(Math.sqrt(-this.n))));else l("integerSqrt: can only be applied to an integer",this)};d.prototype.sqrt=function(){return this.n<0?g.makeInstance(0,d.makeInstance(Math.sqrt(-this.n))):d.makeInstance(Math.sqrt(this.n))};d.prototype.abs=function(){return d.makeInstance(Math.abs(this.n))};d.prototype.log=
-function(){return this.n<0?(new g(this,0)).log():d.makeInstance(Math.log(this.n))};d.prototype.angle=function(){return 0===this.n?0:this.n>0?0:d.pi};d.prototype.tan=function(){return d.makeInstance(Math.tan(this.n))};d.prototype.atan=function(){return d.makeInstance(Math.atan(this.n))};d.prototype.cos=function(){return d.makeInstance(Math.cos(this.n))};d.prototype.sin=function(){return d.makeInstance(Math.sin(this.n))};d.prototype.expt=function(a){return this.n===1?(a.isFinite()||isNaN(a.n),this):
-d.makeInstance(Math.pow(this.n,a.n))};d.prototype.exp=function(){return d.makeInstance(Math.exp(this.n))};d.prototype.acos=function(){return d.makeInstance(Math.acos(this.n))};d.prototype.asin=function(){return d.makeInstance(Math.asin(this.n))};d.prototype.imaginaryPart=function(){return 0};d.prototype.realPart=function(){return this};d.prototype.round=function(){return isFinite(this.n)?this===L?this:Math.abs(Math.floor(this.n)-this.n)===0.5?Math.floor(this.n)%2===0?d.makeInstance(Math.floor(this.n)):
-d.makeInstance(Math.ceil(this.n)):d.makeInstance(Math.round(this.n)):this};d.prototype.conjugate=function(){return this};d.prototype.magnitude=d.prototype.abs;var g=function(a,b){this.r=a;this.i=b};g.makeInstance=function(a,b){b===void 0&&(b=0);if(W(b)&&t(b)&&r(b))return a;if(aa(a)||aa(b))a=ba(a),b=ba(b);return new g(a,b)};g.prototype.toString=function(){var a=this.r.toString(),b=this.i.toString();return b[0]==="-"||b[0]==="+"?a+b+"i":a+"+"+b+"i"};g.prototype.isFinite=function(){return(typeof this.r===
-"number"?isFinite(this.r):this.r.isFinite())&&(typeof this.i==="number"?isFinite(this.i):this.i.isFinite())};g.prototype.isRational=function(){return va(this.r)&&q(this.i,0)};g.prototype.isInteger=function(){return t(this.r)&&q(this.i,0)};g.prototype.toExact=function(){return g.makeInstance(S(this.r),S(this.i))};g.prototype.toInexact=function(){return g.makeInstance(ba(this.r),ba(this.i))};g.prototype.isExact=function(){return W(this.r)&&W(this.i)};g.prototype.isInexact=function(){return aa(this.r)||
-aa(this.i)};g.prototype.level=3;g.prototype.liftTo=function(a){l("Don't know how to lift Complex number",this,a)};g.prototype.equals=function(a){return a instanceof g&&s(this.r,a.r)&&s(this.i,a.i)};g.prototype.greaterThan=function(a){(!this.isReal()||!a.isReal())&&l(">: expects argument of type real number",this,a);return U(this.r,a.r)};g.prototype.greaterThanOrEqual=function(a){(!this.isReal()||!a.isReal())&&l(">=: expects argument of type real number",this,a);return ma(this.r,a.r)};g.prototype.lessThan=
-function(a){(!this.isReal()||!a.isReal())&&l("<: expects argument of type real number",this,a);return J(this.r,a.r)};g.prototype.lessThanOrEqual=function(a){(!this.isReal()||!a.isReal())&&l("<=: expects argument of type real number",this,a);return da(this.r,a.r)};g.prototype.abs=function(){s(this.i,0).valueOf()||l("abs: expects argument of type real number",this);return A(this.r)};g.prototype.toFixnum=function(){s(this.i,0).valueOf()||l("toFixnum: expects argument of type real number",this);return I(this.r)};
-g.prototype.numerator=function(){this.isReal()||l("numerator: can only be applied to real number",this);return ea(this.n)};g.prototype.denominator=function(){this.isReal()||l("floor: can only be applied to real number",this);return Qa(this.n)};g.prototype.add=function(a){return g.makeInstance(m(this.r,a.r),m(this.i,a.i))};g.prototype.subtract=function(a){return g.makeInstance(w(this.r,a.r),w(this.i,a.i))};g.prototype.negate=function(){return g.makeInstance(x(this.r),x(this.i))};g.prototype.multiply=
-function(a){if(a.isReal())return g.makeInstance(k(this.r,a.r),k(this.i,a.r));var b=w(k(this.r,a.r),k(this.i,a.i)),a=m(k(this.r,a.i),k(this.i,a.r));return g.makeInstance(b,a)};g.prototype.divide=function(a){var b,c,e,j,d;return a.isReal()?g.makeInstance(o(this.r,a.r),o(this.i,a.r)):this.isInexact()||a.isInexact()?(b=this.r,c=this.i,e=a.r,j=a.i,da(A(j),A(e))?(d=o(j,e),a=o(m(b,k(c,d)),m(e,k(j,d))),b=o(w(c,k(b,d)),m(e,k(j,d)))):(d=o(e,j),a=o(m(k(b,d),c),m(k(e,d),j)),b=o(w(k(c,d),b),m(k(e,d),j))),g.makeInstance(a,
-b)):(c=Sa(a),b=k(this,c),c=M(k(a,c)),g.makeInstance(o(M(b),c),o(ca(b),c)))};g.prototype.conjugate=function(){return g.makeInstance(this.r,w(0,this.i))};g.prototype.magnitude=function(){var a=m(k(this.r,this.r),k(this.i,this.i));return D(a)};g.prototype.isReal=function(){return q(this.i,0)};g.prototype.integerSqrt=function(){if(t(this))return Ya(this.r);else l("integerSqrt: can only be applied to an integer",this)};g.prototype.sqrt=function(){if(this.isReal())return D(this.r);var a=m(this.magnitude(),
-this.r),b=D(o(a,2)),a=o(this.i,D(k(a,2)));return g.makeInstance(b,a)};g.prototype.log=function(){var a=this.magnitude(),b=this.angle();return m(na(a),k(b,G))};g.prototype.angle=function(){if(this.isReal())return Ta(this.r);if(s(0,this.r)){var a=o(d.pi,2);return U(this.i,0)?a:x(a)}else return a=wa(o(A(this.i),A(this.r))),U(this.r,0)?U(this.i,0)?a:x(a):U(this.i,0)?w(d.pi,a):w(a,d.pi)};var G=g.makeInstance(0,1),gb=g.makeInstance(0,-1);g.prototype.tan=function(){return o(this.sin(),this.cos())};g.prototype.atan=
-function(){return s(this,G)||s(this,gb)?cb:k(G,k(d.makeInstance(0.5),na(o(m(G,this),m(G,w(0,this))))))};g.prototype.cos=function(){if(this.isReal())return oa(this.r);var a=k(this,G),b=x(a),a=m(F(a),F(b));return o(a,2)};g.prototype.sin=function(){if(this.isReal())return pa(this.r);var a=k(this,G),b=x(a),c=g.makeInstance(0,2),a=w(F(a),F(b));return o(a,c)};g.prototype.expt=function(a){if(O(a)&&ma(a,0))return Za(this,a);a=k(a,this.log());return F(a)};g.prototype.exp=function(){var a=F(this.r),b=oa(this.i),
-c=pa(this.i);return k(a,m(b,k(c,G)))};g.prototype.acos=function(){if(this.isReal())return Va(this.r);var a=o(d.pi,2),b=k(this,G),c=D(w(1,X(this))),b=na(m(b,c)),b=k(b,G);return m(a,b)};g.prototype.asin=function(){if(this.isReal())return Wa(this.r);var a=w(1,X(this)),a=D(a);return k(2,wa(o(this,m(1,a))))};g.prototype.ceiling=function(){this.isReal()||l("ceiling: can only be applied to real number",this);return Ra(this.r)};g.prototype.floor=function(){this.isReal()||l("floor: can only be applied to real number",
-this);return z(this.r)};g.prototype.imaginaryPart=function(){return this.i};g.prototype.realPart=function(){return this.r};g.prototype.round=function(){this.isReal()||l("round: can only be applied to real number",this);return Xa(this.r)};var qb=/^([+-]?\d+)\/(\d+)$/,rb=/^([+-]?[\d\w/\.]*)([+-])([\d\w/\.]*)i$/,sb=/^[+-]?\d+$/,tb=/^([+-]?\d*)\.(\d*)$/,La=/^([+-]?\d*\.?\d*)[Ee](\+?\d+)$/,ia=function(a){var b=a.match(qb);if(b)return i.makeInstance(ia(b[1]),ia(b[2]));if(b=a.match(rb))return g.makeInstance(ia(b[1]||
-"0"),ia(b[2]+(b[3]||"1")));if(a==="+nan.0"||a==="-nan.0")return d.nan;if(a==="+inf.0")return d.inf;if(a==="-inf.0")return d.neginf;if(a==="-0.0")return L;return a.match(tb)||a.match(La)?d.makeInstance(Number(a)):a.match(sb)?(b=Number(a),K(b)?v(a):b):!1};typeof navigator!=="undefined"&&navigator.appName=="Microsoft Internet Explorer"?(f.prototype.am=ib,n=30):typeof navigator!=="undefined"&&navigator.appName!="Netscape"?(f.prototype.am=hb,n=26):(f.prototype.am=jb,n=28);f.prototype.DB=n;f.prototype.DM=
-(1<<n)-1;f.prototype.DV=1<<n;f.prototype.FV=Math.pow(2,52);f.prototype.F1=52-n;f.prototype.F2=2*n-52;for(var ja=[],n="0".charCodeAt(0),y=0;y<=9;++y)ja[n++]=y;n="a".charCodeAt(0);for(y=10;y<36;++y)ja[n++]=y;n="A".charCodeAt(0);for(y=10;y<36;++y)ja[n++]=y;P.prototype.convert=function(a){return a.s<0||a.compareTo(this.m)>=0?a.mod(this.m):a};P.prototype.revert=function(a){return a};P.prototype.reduce=function(a){a.divRemTo(this.m,null,a)};P.prototype.mulTo=function(a,b,c){a.multiplyTo(b,c);this.reduce(c)};
-P.prototype.sqrTo=function(a,b){a.squareTo(b);this.reduce(b)};Q.prototype.convert=function(a){var b=p();a.abs().dlShiftTo(this.m.t,b);b.divRemTo(this.m,null,b);a.s<0&&b.compareTo(f.ZERO)>0&&this.m.subTo(b,b);return b};Q.prototype.revert=function(a){var b=p();a.copyTo(b);this.reduce(b);return b};Q.prototype.reduce=function(a){for(;a.t<=this.mt2;)a[a.t++]=0;for(var b=0;b<this.m.t;++b){var c=a[b]&32767,e=c*this.mpl+((c*this.mph+(a[b]>>15)*this.mpl&this.um)<<15)&a.DM,c=b+this.m.t;for(a[c]+=this.m.am(0,
-e,a,b,0,this.m.t);a[c]>=a.DV;)a[c]-=a.DV,a[++c]++}a.clamp();a.drShiftTo(this.m.t,a);a.compareTo(this.m)>=0&&a.subTo(this.m,a)};Q.prototype.mulTo=function(a,b,c){a.multiplyTo(b,c);this.reduce(c)};Q.prototype.sqrTo=function(a,b){a.squareTo(b);this.reduce(b)};f.prototype.copyTo=function(a){for(var b=this.t-1;b>=0;--b)a[b]=this[b];a.t=this.t;a.s=this.s};f.prototype.fromInt=function(a){this.t=1;this.s=a<0?-1:0;a>0?this[0]=a:a<-1?this[0]=a+DV:this.t=0};f.prototype.fromString=function(a,b){var c;if(b==16)c=
-4;else if(b==8)c=3;else if(b==256)c=8;else if(b==2)c=1;else if(b==32)c=5;else if(b==4)c=2;else{this.fromRadix(a,b);return}this.s=this.t=0;for(var e=a.length,j=!1,d=0;--e>=0;){var g=c==8?a[e]&255:xa(a,e);g<0?a.charAt(e)=="-"&&(j=!0):(j=!1,d==0?this[this.t++]=g:d+c>this.DB?(this[this.t-1]|=(g&(1<<this.DB-d)-1)<<d,this[this.t++]=g>>this.DB-d):this[this.t-1]|=g<<d,d+=c,d>=this.DB&&(d-=this.DB))}if(c==8&&(a[0]&128)!=0)this.s=-1,d>0&&(this[this.t-1]|=(1<<this.DB-d)-1<<d);this.clamp();j&&f.ZERO.subTo(this,
-this)};f.prototype.clamp=function(){for(var a=this.s&this.DM;this.t>0&&this[this.t-1]==a;)--this.t};f.prototype.dlShiftTo=function(a,b){var c;for(c=this.t-1;c>=0;--c)b[c+a]=this[c];for(c=a-1;c>=0;--c)b[c]=0;b.t=this.t+a;b.s=this.s};f.prototype.drShiftTo=function(a,b){for(var c=a;c<this.t;++c)b[c-a]=this[c];b.t=Math.max(this.t-a,0);b.s=this.s};f.prototype.lShiftTo=function(a,b){var c=a%this.DB,e=this.DB-c,d=(1<<e)-1,f=Math.floor(a/this.DB),g=this.s<<c&this.DM,h;for(h=this.t-1;h>=0;--h)b[h+f+1]=this[h]>>
-e|g,g=(this[h]&d)<<c;for(h=f-1;h>=0;--h)b[h]=0;b[f]=g;b.t=this.t+f+1;b.s=this.s;b.clamp()};f.prototype.rShiftTo=function(a,b){b.s=this.s;var c=Math.floor(a/this.DB);if(c>=this.t)b.t=0;else{var e=a%this.DB,d=this.DB-e,f=(1<<e)-1;b[0]=this[c]>>e;for(var g=c+1;g<this.t;++g)b[g-c-1]|=(this[g]&f)<<d,b[g-c]=this[g]>>e;e>0&&(b[this.t-c-1]|=(this.s&f)<<d);b.t=this.t-c;b.clamp()}};f.prototype.subTo=function(a,b){for(var c=0,e=0,d=Math.min(a.t,this.t);c<d;)e+=this[c]-a[c],b[c++]=e&this.DM,e>>=this.DB;if(a.t<
-this.t){for(e-=a.s;c<this.t;)e+=this[c],b[c++]=e&this.DM,e>>=this.DB;e+=this.s}else{for(e+=this.s;c<a.t;)e-=a[c],b[c++]=e&this.DM,e>>=this.DB;e-=a.s}b.s=e<0?-1:0;e<-1?b[c++]=this.DV+e:e>0&&(b[c++]=e);b.t=c;b.clamp()};f.prototype.multiplyTo=function(a,b){var c=this.abs(),e=a.abs(),d=c.t;for(b.t=d+e.t;--d>=0;)b[d]=0;for(d=0;d<e.t;++d)b[d+c.t]=c.am(0,e[d],b,d,0,c.t);b.s=0;b.clamp();this.s!=a.s&&f.ZERO.subTo(b,b)};f.prototype.squareTo=function(a){for(var b=this.abs(),c=a.t=2*b.t;--c>=0;)a[c]=0;for(c=
-0;c<b.t-1;++c){var e=b.am(c,b[c],a,2*c,0,1);if((a[c+b.t]+=b.am(c+1,2*b[c],a,2*c+1,e,b.t-c-1))>=b.DV)a[c+b.t]-=b.DV,a[c+b.t+1]=1}a.t>0&&(a[a.t-1]+=b.am(c,b[c],a,2*c,0,1));a.s=0;a.clamp()};f.prototype.divRemTo=function(a,b,c){var e=a.abs();if(!(e.t<=0)){var d=this.abs();if(d.t<e.t)b!=null&&b.fromInt(0),c!=null&&this.copyTo(c);else{c==null&&(c=p());var g=p(),h=this.s,a=a.s,i=this.DB-ka(e[e.t-1]);i>0?(e.lShiftTo(i,g),d.lShiftTo(i,c)):(e.copyTo(g),d.copyTo(c));e=g.t;d=g[e-1];if(d!=0){var l=d*(1<<this.F1)+
-(e>1?g[e-2]>>this.F2:0),k=this.FV/l,l=(1<<this.F1)/l,n=1<<this.F2,m=c.t,o=m-e,q=b==null?p():b;g.dlShiftTo(o,q);c.compareTo(q)>=0&&(c[c.t++]=1,c.subTo(q,c));f.ONE.dlShiftTo(e,q);for(q.subTo(g,g);g.t<e;)g[g.t++]=0;for(;--o>=0;){var r=c[--m]==d?this.DM:Math.floor(c[m]*k+(c[m-1]+n)*l);if((c[m]+=g.am(0,r,c,o,0,e))<r){g.dlShiftTo(o,q);for(c.subTo(q,c);c[m]<--r;)c.subTo(q,c)}}b!=null&&(c.drShiftTo(e,b),h!=a&&f.ZERO.subTo(b,b));c.t=e;c.clamp();i>0&&c.rShiftTo(i,c);h<0&&f.ZERO.subTo(c,c)}}}};f.prototype.invDigit=
-function(){if(this.t<1)return 0;var a=this[0];if((a&1)==0)return 0;var b=a&3,b=b*(2-(a&15)*b)&15,b=b*(2-(a&255)*b)&255,b=b*(2-((a&65535)*b&65535))&65535,b=b*(2-a*b%this.DV)%this.DV;return b>0?this.DV-b:-b};f.prototype.isEven=function(){return(this.t>0?this[0]&1:this.s)==0};f.prototype.exp=function(a,b){if(a>4294967295||a<1)return f.ONE;var c=p(),e=p(),d=b.convert(this),g=ka(a)-1;for(d.copyTo(c);--g>=0;)if(b.sqrTo(c,e),(a&1<<g)>0)b.mulTo(e,d,c);else var h=c,c=e,e=h;return b.revert(c)};f.prototype.toString=
-function(a){if(this.s<0)return"-"+this.negate().toString(a);if(a==16)a=4;else if(a==8)a=3;else if(a==2)a=1;else if(a==32)a=5;else if(a==4)a=2;else return this.toRadix(a);var b=(1<<a)-1,c,e=!1,d=[],f=this.t,g=this.DB-f*this.DB%a;if(f-- >0){if(g<this.DB&&(c=this[f]>>g)>0)e=!0,d.push("0123456789abcdefghijklmnopqrstuvwxyz".charAt(c));for(;f>=0;)g<a?(c=(this[f]&(1<<g)-1)<<a-g,c|=this[--f]>>(g+=this.DB-a)):(c=this[f]>>(g-=a)&b,g<=0&&(g+=this.DB,--f)),c>0&&(e=!0),e&&d.push("0123456789abcdefghijklmnopqrstuvwxyz".charAt(c))}return e?
-d.join(""):"0"};f.prototype.negate=function(){var a=p();f.ZERO.subTo(this,a);return a};f.prototype.abs=function(){return this.s<0?this.negate():this};f.prototype.compareTo=Y;f.prototype.bitLength=function(){return this.t<=0?0:this.DB*(this.t-1)+ka(this[this.t-1]^this.s&this.DM)};f.prototype.mod=ya;f.prototype.modPowInt=function(a,b){var c;c=a<256||b.isEven()?new P(b):new Q(b);return this.exp(a,c)};f.ZERO=N(0);f.ONE=N(1);$.prototype.convert=Ha;$.prototype.revert=Ha;$.prototype.mulTo=function(a,b,c){a.multiplyTo(b,
-c)};$.prototype.sqrTo=function(a,b){a.squareTo(b)};V.prototype.convert=function(a){if(a.s<0||a.t>2*this.m.t)return a.mod(this.m);else if(a.compareTo(this.m)<0)return a;else{var b=p();a.copyTo(b);this.reduce(b);return b}};V.prototype.revert=function(a){return a};V.prototype.reduce=function(a){a.drShiftTo(this.m.t-1,this.r2);if(a.t>this.m.t+1)a.t=this.m.t+1,a.clamp();this.mu.multiplyUpperTo(this.r2,this.m.t+1,this.q3);for(this.m.multiplyLowerTo(this.q3,this.m.t+1,this.r2);a.compareTo(this.r2)<0;)a.dAddOffset(1,
-this.m.t+1);for(a.subTo(this.r2,a);a.compareTo(this.m)>=0;)a.subTo(this.m,a)};V.prototype.mulTo=function(a,b,c){a.multiplyTo(b,c);this.reduce(c)};V.prototype.sqrTo=function(a,b){a.squareTo(b);this.reduce(b)};var C=[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,
-409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509],ub=67108864/C[C.length-1];f.prototype.chunkSize=function(a){return Math.floor(Math.LN2*this.DB/Math.log(a))};f.prototype.toRadix=function(a){a==null&&(a=10);if(this.signum()==0||a<2||a>36)return"0";var b=this.chunkSize(a),b=Math.pow(a,b),c=N(b),e=p(),d=p(),f="";for(this.divRemTo(c,e,d);e.signum()>0;)f=(b+d.intValue()).toString(a).substr(1)+f,e.divRemTo(c,e,d);return d.intValue().toString(a)+f};f.prototype.fromRadix=function(a,
-b){this.fromInt(0);b==null&&(b=10);for(var c=this.chunkSize(b),e=Math.pow(b,c),d=!1,g=0,h=0,i=0;i<a.length;++i){var l=xa(a,i);l<0?a.charAt(i)=="-"&&this.signum()==0&&(d=!0):(h=b*h+l,++g>=c&&(this.dMultiply(e),this.dAddOffset(h,0),h=g=0))}g>0&&(this.dMultiply(Math.pow(b,g)),this.dAddOffset(h,0));d&&f.ZERO.subTo(this,this)};f.prototype.fromNumber=function(a,b,c){if("number"==typeof b)if(a<2)this.fromInt(1);else{this.fromNumber(a,c);this.testBit(a-1)||this.bitwiseTo(f.ONE.shiftLeft(a-1),ua,this);for(this.isEven()&&
-this.dAddOffset(1,0);!this.isProbablePrime(b);)this.dAddOffset(2,0),this.bitLength()>a&&this.subTo(f.ONE.shiftLeft(a-1),this)}else{var c=[],e=a&7;c.length=(a>>3)+1;b.nextBytes(c);e>0?c[0]&=(1<<e)-1:c[0]=0;this.fromString(c,256)}};f.prototype.bitwiseTo=function(a,b,c){var e,d,f=Math.min(a.t,this.t);for(e=0;e<f;++e)c[e]=b(this[e],a[e]);if(a.t<this.t){d=a.s&this.DM;for(e=f;e<this.t;++e)c[e]=b(this[e],d);c.t=this.t}else{d=this.s&this.DM;for(e=f;e<a.t;++e)c[e]=b(d,a[e]);c.t=a.t}c.s=b(this.s,a.s);c.clamp()};
-f.prototype.changeBit=function(a,b){var c=f.ONE.shiftLeft(a);this.bitwiseTo(c,b,c);return c};f.prototype.addTo=function(a,b){for(var c=0,e=0,d=Math.min(a.t,this.t);c<d;)e+=this[c]+a[c],b[c++]=e&this.DM,e>>=this.DB;if(a.t<this.t){for(e+=a.s;c<this.t;)e+=this[c],b[c++]=e&this.DM,e>>=this.DB;e+=this.s}else{for(e+=this.s;c<a.t;)e+=a[c],b[c++]=e&this.DM,e>>=this.DB;e+=a.s}b.s=e<0?-1:0;e>0?b[c++]=e:e<-1&&(b[c++]=this.DV+e);b.t=c;b.clamp()};f.prototype.dMultiply=function(a){this[this.t]=this.am(0,a-1,this,
-0,0,this.t);++this.t;this.clamp()};f.prototype.dAddOffset=function(a,b){if(a!=0){for(;this.t<=b;)this[this.t++]=0;for(this[b]+=a;this[b]>=this.DV;)this[b]-=this.DV,++b>=this.t&&(this[this.t++]=0),++this[b]}};f.prototype.multiplyLowerTo=function(a,b,c){var e=Math.min(this.t+a.t,b);c.s=0;for(c.t=e;e>0;)c[--e]=0;var d;for(d=c.t-this.t;e<d;++e)c[e+this.t]=this.am(0,a[e],c,e,0,this.t);for(d=Math.min(a.t,b);e<d;++e)this.am(0,a[e],c,e,0,b-e);c.clamp()};f.prototype.multiplyUpperTo=function(a,b,c){--b;var e=
-c.t=this.t+a.t-b;for(c.s=0;--e>=0;)c[e]=0;for(e=Math.max(b-this.t,0);e<a.t;++e)c[this.t+e-b]=this.am(b-e,a[e],c,0,0,this.t+e-b);c.clamp();c.drShiftTo(1,c)};f.prototype.modInt=function(a){if(a<=0)return 0;var b=this.DV%a,c=this.s<0?a-1:0;if(this.t>0)if(b==0)c=this[0]%a;else for(var e=this.t-1;e>=0;--e)c=(b*c+this[e])%a;return c};f.prototype.millerRabin=function(a){var b=this.subtract(f.ONE),c=b.getLowestSetBit();if(c<=0)return!1;var e=b.shiftRight(c),a=a+1>>1;if(a>C.length)a=C.length;for(var d=p(),
-g=0;g<a;++g){d.fromInt(C[g]);var h=d.modPow(e,this);if(h.compareTo(f.ONE)!=0&&h.compareTo(b)!=0){for(var i=1;i++<c&&h.compareTo(b)!=0;)if(h=h.modPowInt(2,this),h.compareTo(f.ONE)==0)return!1;if(h.compareTo(b)!=0)return!1}}return!0};f.prototype.clone=function(){var a=p();this.copyTo(a);return a};f.prototype.intValue=function(){if(this.s<0)if(this.t==1)return this[0]-this.DV;else{if(this.t==0)return-1}else if(this.t==1)return this[0];else if(this.t==0)return 0;return(this[1]&(1<<32-this.DB)-1)<<this.DB|
-this[0]};f.prototype.byteValue=function(){return this.t==0?this.s:this[0]<<24>>24};f.prototype.shortValue=function(){return this.t==0?this.s:this[0]<<16>>16};f.prototype.signum=function(){return this.s<0?-1:this.t<=0||this.t==1&&this[0]<=0?0:1};f.prototype.toByteArray=function(){var a=this.t,b=[];b[0]=this.s;var c=this.DB-a*this.DB%8,e,d=0;if(a-- >0){if(c<this.DB&&(e=this[a]>>c)!=(this.s&this.DM)>>c)b[d++]=e|this.s<<this.DB-c;for(;a>=0;)if(c<8?(e=(this[a]&(1<<c)-1)<<8-c,e|=this[--a]>>(c+=this.DB-
-8)):(e=this[a]>>(c-=8)&255,c<=0&&(c+=this.DB,--a)),(e&128)!=0&&(e|=-256),d==0&&(this.s&128)!=(e&128)&&++d,d>0||e!=this.s)b[d++]=e}return b};f.prototype.equals=Z;f.prototype.min=function(a){return this.compareTo(a)<0?this:a};f.prototype.max=function(a){return this.compareTo(a)>0?this:a};f.prototype.and=function(a){var b=p();this.bitwiseTo(a,kb,b);return b};f.prototype.or=function(a){var b=p();this.bitwiseTo(a,ua,b);return b};f.prototype.xor=function(a){var b=p();this.bitwiseTo(a,za,b);return b};f.prototype.andNot=
-function(a){var b=p();this.bitwiseTo(a,Aa,b);return b};f.prototype.not=function(){for(var a=p(),b=0;b<this.t;++b)a[b]=this.DM&~this[b];a.t=this.t;a.s=~this.s;return a};f.prototype.shiftLeft=function(a){var b=p();a<0?this.rShiftTo(-a,b):this.lShiftTo(a,b);return b};f.prototype.shiftRight=function(a){var b=p();a<0?this.lShiftTo(-a,b):this.rShiftTo(a,b);return b};f.prototype.getLowestSetBit=function(){for(var a=0;a<this.t;++a)if(this[a]!=0){var b=a*this.DB;a=this[a];if(a==0)a=-1;else{var c=0;(a&65535)==
-0&&(a>>=16,c+=16);(a&255)==0&&(a>>=8,c+=8);(a&15)==0&&(a>>=4,c+=4);(a&3)==0&&(a>>=2,c+=2);(a&1)==0&&++c;a=c}return b+a}return this.s<0?this.t*this.DB:-1};f.prototype.bitCount=function(){for(var a=0,b=this.s&this.DM,c=0;c<this.t;++c){for(var e=this[c]^b,d=0;e!=0;)e&=e-1,++d;a+=d}return a};f.prototype.testBit=function(a){var b=Math.floor(a/this.DB);return b>=this.t?this.s!=0:(this[b]&1<<a%this.DB)!=0};f.prototype.setBit=function(a){return this.changeBit(a,ua)};f.prototype.clearBit=function(a){return this.changeBit(a,
-Aa)};f.prototype.flipBit=function(a){return this.changeBit(a,za)};f.prototype.add=Ba;f.prototype.subtract=Ca;f.prototype.multiply=Da;f.prototype.divide=Ea;f.prototype.remainder=Fa;f.prototype.divideAndRemainder=Ga;f.prototype.modPow=function(a,b){var c=a.bitLength(),e,d=N(1),f;if(c<=0)return d;else e=c<18?1:c<48?3:c<144?4:c<768?5:6;f=c<8?new P(b):b.isEven()?new V(b):new Q(b);var g=[],h=3,i=e-1,l=(1<<e)-1;g[1]=f.convert(this);if(e>1){c=p();for(f.sqrTo(g[1],c);h<=l;)g[h]=p(),f.mulTo(c,g[h-2],g[h]),
-h+=2}for(var k=a.t-1,m,o=!0,n=p(),c=ka(a[k])-1;k>=0;){c>=i?m=a[k]>>c-i&l:(m=(a[k]&(1<<c+1)-1)<<i-c,k>0&&(m|=a[k-1]>>this.DB+c-i));for(h=e;(m&1)==0;)m>>=1,--h;if((c-=h)<0)c+=this.DB,--k;if(o)g[m].copyTo(d),o=!1;else{for(;h>1;)f.sqrTo(d,n),f.sqrTo(n,d),h-=2;h>0?f.sqrTo(d,n):(h=d,d=n,n=h);f.mulTo(n,g[m],d)}for(;k>=0&&(a[k]&1<<c)==0;)f.sqrTo(d,n),h=d,d=n,n=h,--c<0&&(c=this.DB-1,--k)}return f.revert(d)};f.prototype.modInverse=function(a){var b=a.isEven();if(this.isEven()&&b||a.signum()==0)return f.ZERO;
-for(var c=a.clone(),e=this.clone(),d=N(1),g=N(0),h=N(0),i=N(1);c.signum()!=0;){for(;c.isEven();){c.rShiftTo(1,c);if(b){if(!d.isEven()||!g.isEven())d.addTo(this,d),g.subTo(a,g);d.rShiftTo(1,d)}else g.isEven()||g.subTo(a,g);g.rShiftTo(1,g)}for(;e.isEven();){e.rShiftTo(1,e);if(b){if(!h.isEven()||!i.isEven())h.addTo(this,h),i.subTo(a,i);h.rShiftTo(1,h)}else i.isEven()||i.subTo(a,i);i.rShiftTo(1,i)}c.compareTo(e)>=0?(c.subTo(e,c),b&&d.subTo(h,d),g.subTo(i,g)):(e.subTo(c,e),b&&h.subTo(d,h),i.subTo(g,i))}if(e.compareTo(f.ONE)!=
-0)return f.ZERO;if(i.compareTo(a)>=0)return i.subtract(a);if(i.signum()<0)i.addTo(a,i);else return i;return i.signum()<0?i.add(a):i};f.prototype.pow=Ia;f.prototype.gcd=Ja;f.prototype.isProbablePrime=function(a){var b,c=this.abs();if(c.t==1&&c[0]<=C[C.length-1]){for(b=0;b<C.length;++b)if(c[0]==C[b])return!0;return!1}if(c.isEven())return!1;for(b=1;b<C.length;){for(var e=C[b],d=b+1;d<C.length&&e<ub;)e*=C[d++];for(e=c.modInt(e);b<d;)if(e%C[b++]==0)return!1}return c.millerRabin(a)};f.NEGATIVE_ONE=f.ONE.negate();
-var v=function(a){typeof a==="number"&&(a+="");a=Na(a);return new f(a,10)};f.prototype.level=0;f.prototype.liftTo=function(a){if(a.level===1)return new i(this,1);return a.level===2?(a=this.toFixnum(),a===Number.POSITIVE_INFINITY?db:a===Number.NEGATIVE_INFINITY?eb:new d(a)):a.level===3?new g(this,0):l("invalid level for BigInteger lift",this,a)};f.prototype.isFinite=function(){return!0};f.prototype.isInteger=function(){return!0};f.prototype.isRational=function(){return!0};f.prototype.isReal=function(){return!0};
-f.prototype.isExact=function(){return!0};f.prototype.isInexact=function(){return!1};f.prototype.toExact=function(){return this};f.prototype.toInexact=function(){return d.makeInstance(this.toFixnum())};f.prototype.toFixnum=function(){var a=0,b=this.toString(),c;if(b[0]==="-"){for(c=1;c<b.length;c++)a=a*10+Number(b[c]);return-a}else{for(c=0;c<b.length;c++)a=a*10+Number(b[c]);return a}};f.prototype.greaterThan=function(a){return this.compareTo(a)>0};f.prototype.greaterThanOrEqual=function(a){return this.compareTo(a)>=
-0};f.prototype.lessThan=function(a){return this.compareTo(a)<0};f.prototype.lessThanOrEqual=function(a){return this.compareTo(a)<=0};f.prototype.divide=function(a){var b=Ga.call(this,a);return b[1].compareTo(f.ZERO)===0?b[0]:m(b[0],i.makeInstance(b[1],a))};f.prototype.numerator=function(){return this};f.prototype.denominator=function(){return 1};(function(){var a=function(a,c){for(;!da(X(c),a)||!J(a,X(m(c,1)));)c=z(o(m(c,z(o(a,c))),2));return c};f.prototype.integerSqrt=function(){var b;return ha(this)>=
-0?a(this,this):(b=this.negate(),g.makeInstance(0,a(b,b)))}})();(function(){f.prototype.sqrt=function(){var a=this.integerSqrt(),b;if(q(X(a),this))return a;b=I(this);return isFinite(b)?b>=0?d.makeInstance(Math.sqrt(b)):g.makeInstance(0,d.makeInstance(Math.sqrt(-b))):a}})();f.prototype.floor=function(){return this};f.prototype.ceiling=function(){return this};f.prototype.expt=function(a){return Ia.call(this,a)};f.prototype.imaginaryPart=function(){return 0};f.prototype.realPart=function(){return this};
-n=function(){return function(a,b,c){var e=512;if(c&&typeof c.limit!=="undefined")e=c.limit;t(a)||l("toRepeatingDecimal: n "+a.toString()+" is not an integer.");t(b)||l("toRepeatingDecimal: d "+b.toString()+" is not an integer.");s(b,0)&&l("toRepeatingDecimal: d equals 0");J(b,0)&&l("toRepeatingDecimal: d < 0");c=J(a,0)?"-":"";a=A(a);c+=qa(a,b);a:{var a=ra(a,b),d=e,e=[],f={};for(f[a]=!0;;){if(d--<=0){b=[e.join(""),"..."];break a}var g=qa(k(a,10),b),a=ra(k(a,10),b);e.push(g.toString());if(f[a])break;
-else f[a]=!0}f=a;for(d=[];;)if(g=qa(k(a,10),b),a=ra(k(a,10),b),d.push(g.toString()),s(a,f))break;b=e.join("");for(a=d.join("");b.length>=a.length&&b.substring(b.length-a.length)===a;)b=b.substring(0,b.length-a.length);b=[b,a]}return[c].concat(b)}}();h.fromFixnum=function(a){if(isNaN(a)||!isFinite(a))return d.makeInstance(a);var b=Math.floor(a);return b===a?K(b)?v(Na(a+"")):b:d.makeInstance(a)};h.fromString=ia;h.makeBignum=v;h.makeRational=i.makeInstance;h.makeFloat=d.makeInstance;h.makeComplex=g.makeInstance;
-h.makeComplexPolar=function(a,b){return q(b,0)?a:g.makeInstance(k(a,oa(b)),k(a,pa(b)))};h.pi=d.pi;h.e=d.e;h.nan=d.nan;h.negative_inf=d.neginf;h.inf=d.inf;h.negative_one=-1;h.zero=0;h.one=1;h.i=G;h.negative_i=gb;h.negative_zero=L;h.onThrowRuntimeError=function(a){throw Error(a);};h.isSchemeNumber=R;h.isRational=va;h.isReal=E;h.isExact=W;h.isInexact=aa;h.isInteger=t;h.toFixnum=I;h.toExact=S;h.toInexact=ba;h.add=m;h.subtract=w;h.multiply=k;h.divide=o;h.equals=s;h.eqv=q;h.approxEquals=function(a,b,c){return J(A(w(a,
-b)),c)};h.greaterThanOrEqual=ma;h.lessThanOrEqual=da;h.greaterThan=U;h.lessThan=J;h.expt=lb;h.exp=F;h.modulo=Pa;h.numerator=ea;h.denominator=Qa;h.integerSqrt=Ya;h.sqrt=D;h.abs=A;h.quotient=qa;h.remainder=ra;h.floor=z;h.ceiling=Ra;h.conjugate=Sa;h.magnitude=function(a){return typeof a==="number"?Math.abs(a):a.magnitude()};h.log=na;h.angle=Ta;h.tan=Ua;h.atan=wa;h.cos=oa;h.sin=pa;h.tan=Ua;h.acos=Va;h.asin=Wa;h.cosh=function(a){return q(a,0)?d.makeInstance(1):o(m(F(a),F(x(a))),2)};h.sinh=function(a){return o(w(F(a),
-F(x(a))),2)};h.imaginaryPart=ca;h.realPart=M;h.round=Xa;h.sqr=X;h.gcd=function(a,b){t(a)||l("gcd: the argument "+a.toString()+" is not an integer.",a);for(var c=A(a),e,d,f=0;f<b.length;f++){d=A(b[f]);for(t(d)||l("gcd: the argument "+d.toString()+" is not an integer.",d);!r(d);)e=c,c=d,d=Oa(e,d)}return c};h.lcm=function(a,b){t(a)||l("lcm: the argument "+a.toString()+" is not an integer.",a);var c=A(a);if(r(c))return 0;for(var d=0;d<b.length;d++){t(b[d])||l("lcm: the argument "+b[d].toString()+" is not an integer.",
-b[d]);var f=sa(c,b[d]);if(r(f))return 0;c=o(k(c,b[d]),f)}return c};h.toRepeatingDecimal=n;h.BigInteger=f;h.Rational=i;h.FloatPoint=d;h.Complex=g;h.MIN_FIXNUM=-9E15;h.MAX_FIXNUM=9E15})();

js-assembler/runtime-src/runtime.js

@@ -1,805 +0,0 @@
-/*jslint browser: true, undef: true, unparam: true, sub: true, vars: true, white: true, plusplus: true, maxerr: 50, indent: 4 */
-
-
-// runtime.js: the main runtime library for whalesong.
-//
-
-// All of the values here are namespaced under "plt.runtime".
-/*global $*/
-(function(plt, baselib) {
-    'use strict';
-    var runtime = {};
-    plt.runtime = runtime;
-
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    // 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 = baselib.numbers.isNumber;
-    var isNatural = baselib.numbers.isNatural;
-    var isReal = baselib.numbers.isReal;
-    var isPair = baselib.lists.isPair;
-    var isCaarPair = function(x) { return isPair(x) && isPair(x.first); };
-    var isList = baselib.lists.isList;
-    var isVector = baselib.vectors.isVector;
-    var isString = baselib.strings.isString;
-    var isSymbol = baselib.symbols.isSymbol;
-    var isPath = baselib.paths.isPath;
-
-    var equals = baselib.equality.equals;
-
-    var NULL = baselib.lists.EMPTY;
-    var VOID = baselib.constants.VOID_VALUE;
-
-    var NEGATIVE_ZERO = baselib.numbers.negative_zero;
-    var INF = baselib.numbers.inf;
-    var NEGATIVE_INF = baselib.numbers.negative_inf;
-    var NAN = baselib.numbers.nan;
-
-    var makeFloat = baselib.numbers.makeFloat;
-    var makeRational = baselib.numbers.makeRational;
-    var makeBignum = baselib.numbers.makeBignum;
-    var makeComplex = baselib.numbers.makeComplex;
-
-
-    var makeSymbol = baselib.symbols.makeSymbol;
-    var makePath = baselib.paths.makePath;
-    var makeBytes = baselib.bytes.makeBytes;
-
-    var makeBox = baselib.boxes.makeBox;
-    var isBox = baselib.boxes.isBox;
-
-    var makeVector = baselib.vectors.makeVector;
-    var makeList = baselib.lists.makeList;
-    var makePair = baselib.lists.makePair;
-    var makeChar = baselib.chars.makeChar;
-
-    var makeStructureType = baselib.structs.makeStructureType;
-
-
-    var Struct = baselib.structs.Struct;
-    var StructType = baselib.structs.StructType;
-
-    var Closure = baselib.functions.Closure;
-    var finalizeClosureCall = baselib.functions.finalizeClosureCall;
-    var makePrimitiveProcedure = baselib.functions.makePrimitiveProcedure;
-    var makeClosure = baselib.functions.makeClosure;
-
-    var ContinuationPromptTag = baselib.contmarks.ContinuationPromptTag;
-
-
-    // Other helpers
-    var heir = baselib.heir;
-    var makeClassPredicate = baselib.makeClassPredicate;
-    var toDomNode = baselib.format.toDomNode;
-    var toWrittenString = baselib.format.toWrittenString;
-    var toDisplayedString = baselib.format.toDisplayedString;
-
-
-
-    // Frame structures.
-    var Frame = baselib.frames.Frame;
-    var CallFrame = baselib.frames.CallFrame;
-    var PromptFrame = baselib.frames.PromptFrame;
-
-    // Module structure
-    var ModuleRecord = baselib.modules.ModuleRecord;
-
-
-
-    // Ports
-    var isOutputPort = baselib.ports.isOutputPort;
-    var StandardOutputPort = baselib.ports.StandardOutputPort;
-    var StandardErrorPort = baselib.ports.StandardErrorPort;
-    var StandardInputPort = baselib.ports.StandardInputPort;
-    var isOutputStringPort = baselib.ports.isOutputStringPort;
-
-
-
-
-    // Exceptions and error handling.
-    var raise = baselib.exceptions.raise;
-    var raiseUnboundToplevelError = baselib.exceptions.raiseUnboundToplevelError;
-    var raiseArgumentTypeError = baselib.exceptions.raiseArgumentTypeError;
-    var raiseContextExpectedValuesError = baselib.exceptions.raiseContextExpectedValuesError;
-    var raiseArityMismatchError = baselib.exceptions.raiseArityMismatchError;
-    var raiseOperatorApplicationError = baselib.exceptions.raiseOperatorApplicationError;
-    var raiseOperatorIsNotPrimitiveProcedure = baselib.exceptions.raiseOperatorIsNotPrimitiveProcedure;
-    var raiseUnimplementedPrimitiveError = baselib.exceptions.raiseUnimplementedPrimitiveError;
-
-
-    var ArityAtLeast = baselib.arity.ArityAtLeast;
-    var makeArityAtLeast = baselib.arity.makeArityAtLeast;
-    var isArityMatching = baselib.arity.isArityMatching;
-    
-
-    var testArgument = baselib.check.testArgument;
-    var testArity = baselib.check.testArity;
-    var makeCheckArgumentType = baselib.check.makeCheckArgumentType;
-
-
-    var Primitives = baselib.primitives.Primitives;
-    var installPrimitiveProcedure = baselib.primitives.installPrimitiveProcedure;
-
-
-
-    // This value used to be dynamically determined, but something on iOS5
-    // breaks badly when I try this.
-    // We're very conservative now.
-     var STACK_LIMIT_ESTIMATE = 200;
-
-
-
-    //////////////////////////////////////////////////////////////////////
-
-
-
-    var defaultCurrentPrintImplementation = function (MACHINE) {
-        if(--MACHINE.cbt < 0) { 
-            throw defaultCurrentPrintImplementation; 
-        }
-        var oldArgcount = MACHINE.a;
-
-	var elt = MACHINE.e[MACHINE.e.length - 1];
-	var outputPort = 
-	    MACHINE.params.currentOutputPort;
-	if (elt !== VOID) {
-	    outputPort.writeDomNode(
-                MACHINE, 
-                toDomNode(elt, MACHINE.params['print-mode']));
-	    outputPort.writeDomNode(MACHINE, toDomNode("\n", 'display'));
-	}
-        MACHINE.a = oldArgcount;
-        return finalizeClosureCall(MACHINE, VOID);
-    };
-    var defaultCurrentPrint = makeClosure(
-	"default-printer",
-	1,
-	defaultCurrentPrintImplementation);
-
-
-    //////////////////////////////////////////////////////////////////////]
-    // The MACHINE
-
-    var Machine = function() {
-	this.cbt = STACK_LIMIT_ESTIMATE;  // calls before trampoline
-	this.v = undefined;         // value register
-	this.p = undefined;        // procedure register
-	this.a = undefined;           // argument count
-	this.e = [];                // environment
-	this.c = [];            // control: Arrayof (U Frame CallFrame PromptFrame)
-	this.running = false;
-	this.modules = {};     // String -> ModuleRecord
-        this.mainModules = []; // Arrayof String
-	this.params = {
-
-            // print-as-expression: boolean
-            'print-as-expression' : false,
-
-            // print-mode: (one-of "write" "print" "constructor")
-            'print-mode' : 'write',
-
-
-	    // currentDisplayer: DomNode -> Void
-	    // currentDisplayer is responsible for displaying to the browser.
-	    '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);
-	    },
-
-            'currentInspector': baselib.inspectors.DEFAULT_INSPECTOR,
-	    
-	    'currentOutputPort': new StandardOutputPort(),
-	    'currentErrorPort': new StandardErrorPort(),
-            'currentInputPort': new StandardInputPort(),
-	    'currentSuccessHandler': function(MACHINE) {},
-	    'currentErrorHandler': function(MACHINE, exn) {
-                MACHINE.params.currentErrorDisplayer(
-                    MACHINE,
-                    toDomNode(exn, MACHINE.params['print-mode']));
-            },
-	    
-	    'currentNamespace': {},
-	    
-	    // These parameters control how often
-	    // control yields back to the browser
-	    // for response.  The implementation is a
-	    // simple PID controller.
-	    //
-	    // To tune this, adjust desiredYieldsPerSecond.
-	    // Do no touch numBouncesBeforeYield or
-	    // maxNumBouncesBeforeYield, because those
-	    // are adjusted automatically by the
-	    // recomputeMaxNumBouncesBeforeYield
-	    // procedure.
-	    'desiredYieldsPerSecond': 5,
-	    'numBouncesBeforeYield': 2000,   // self-adjusting
-	    'maxNumBouncesBeforeYield': 2000, // self-adjusting
-
-	    'currentPrint': defaultCurrentPrint
-
-
-	};
-	this.primitives = Primitives;
-    };
-    
-
-    // Try to get the continuation mark key used for procedure application tracing.
-    var getTracedAppKey = function(MACHINE) {
-        if (MACHINE.modules['whalesong/lang/private/traced-app.rkt']) {
-            return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].namespace['traced-app-key'];
-        }
-        return undefined;
-    };
-
-    var getTracedCalleeKey = function(MACHINE) {
-        if (MACHINE.modules['whalesong/lang/private/traced-app.rkt']) {
-            return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].namespace['traced-callee-key'];
-        }
-        return undefined;
-    };
-
-
-
-    // captureControl implements the continuation-capturing part of
-    // call/cc.  It grabs the control frames up to (but not including) the
-    // prompt tagged by the given tag.
-    Machine.prototype.captureControl = function(skip, tag) {
-	var MACHINE = this;
-	var i;
-	for (i = MACHINE.c.length - 1 - skip; i >= 0; i--) {
-	    if (MACHINE.c[i].tag === tag) {
-		return MACHINE.c.slice(i + 1,
-					     MACHINE.c.length - skip);
-	    }
-	} 
-	raise(MACHINE, new Error("captureControl: unable to find tag " + tag));
-    };
-
-
-
-    // restoreControl clears the control stack (up to, but not including the
-    // prompt tagged by tag), and then appends the rest of the control frames.
-    // At the moment, the rest of the control frames is assumed to be in the 
-    // top of the environment.
-    Machine.prototype.restoreControl = function(tag) {
-	var MACHINE = this;
-	var i;
-	for (i = MACHINE.c.length - 1; i >= 0; i--) {
-	    if (MACHINE.c[i].tag === tag) {
-		MACHINE.c = 
-		    MACHINE.c.slice(0, i+1).concat(
-			MACHINE.e[MACHINE.e.length - 1]);
-		return;
-	    }
-	}
-	raise(MACHINE, new Error("restoreControl: unable to find tag " + tag));     
-
-    };
-
-
-    // Splices the list argument in the environment.  Adjusts MACHINE.a
-    // appropriately.
-    Machine.prototype.spliceListIntoStack = function(depth) {
-	var MACHINE = this;
-	var lst = MACHINE.e[MACHINE.e.length - 1 - depth];
-	var vals = [];
-	while(lst !== NULL) {
-	    vals.push(lst.first);
-	    lst = lst.rest;
-	}
-	vals.reverse();
-	MACHINE.e.splice.apply(MACHINE.e,
-				 [MACHINE.e.length - 1 - depth, 1].concat(vals));
-	MACHINE.a = MACHINE.a + vals.length - 1;
-    };
-
-
-    // Unsplices a list from the MACHINE stack.
-    Machine.prototype.unspliceRestFromStack = function(depth, length) {
-	var MACHINE = this;
-	var lst = NULL;
-	var i;
-	for (i = 0; i < length; i++) {
-	    lst = makePair(MACHINE.e[MACHINE.e.length - depth - length + i], 
-                           lst);
-	}
-	MACHINE.e.splice(MACHINE.e.length - depth - length,
-			   length, 
-			   lst);
-	MACHINE.a = MACHINE.a - length + 1;
-    };
-
-
-    // Save the continuation mark on the top control frame.
-    Machine.prototype.installContinuationMarkEntry = function(key, value) {
-        var frame = this.c[this.c.length - 1];
-        var marks = frame.marks;
-        var i;
-        for (i = 0; i < marks.length; i++) {
-            if (key === marks[i][0]) {
-                marks[i][1] = value;
-                return;
-            }
-        }
-        marks.push([key, value]);
-    };
-
-
-    Machine.prototype.captureContinuationMarks = function(promptTag) {
-        var kvLists = [];
-        var i;
-        var control = this.c;
-        var tracedCalleeKey = getTracedCalleeKey(this);
-        for (i = control.length-1; i >= 0; i--) {
-            if (promptTag !== null &&
-                control[i] instanceof PromptFrame && control[i].tag === promptTag) {
-                break;
-            }
-            if (control[i].marks.length !== 0) {
-                kvLists.push(control[i].marks);
-            }
-            
-            if (tracedCalleeKey !== null && 
-                control[i] instanceof CallFrame &&
-                control[i].p !== null) {
-                kvLists.push([[tracedCalleeKey, control[i].p]]);
-            }
-        }
-        return new baselib.contmarks.ContinuationMarkSet(kvLists);
-    };
-    
-
-
-
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    // The toplevel trampoline.
-    //
-    //
-    // trampoline: MACHINE (MACHINE -> void) -> void
-    //
-    // All evaluation in Racketland happens in the context of this
-    // trampoline.
-    //
-    var recomputeMaxNumBouncesBeforeYield;
-
-    var scheduleTrampoline = function(MACHINE, f) {
-        // FIXME: at the moment, the setTimeout is breaking when we get
-        // a rapid set of events from web-world.  We are running into
-        // a very ugly re-entrancy bug.  https://github.com/dyoo/whalesong/issues/70
-
-        // setTimeout(
-	//     function() { 
-        return MACHINE.trampoline(f); 
-        // },
-	// 0);
-    };
-
-    // Creates a restarting function, that reschedules f in a context
-    // with the old argcount in place. 
-    // Meant to be used only by the trampoline.
-    var makeRestartFunction = function(MACHINE) {
-        var oldArgcount = MACHINE.a;
-        return function(f) { 
-            MACHINE.a = oldArgcount;
-            return scheduleTrampoline(MACHINE, f);
-        };
-    };
-
-
-    // These are exception values that are treated specially in the context
-    // of the trampoline.
-
-    var HaltError = function(onHalt) {
-        // onHalt: MACHINE -> void
-        this.onHalt = onHalt || function(MACHINE) {};
-    };
-
-
-    var Pause = function(onPause) {
-        // onPause: MACHINE -> void
-        this.onPause = onPause || function(MACHINE) {};
-    };
-
-    var PAUSE = function(onPause) {
-        throw(new Pause(onPause));
-    };
-
-
-    Machine.prototype.trampoline = function(initialJump, noJumpingOff) {
-	var thunk = initialJump;
-	var startTime = (new Date()).valueOf();
-	this.cbt = STACK_LIMIT_ESTIMATE;
-	this.params.numBouncesBeforeYield = 
-	    this.params.maxNumBouncesBeforeYield;
-	this.running = true;
-
-	while(true) {
-            try {
-		thunk(this);
-		break;
-            } catch (e) {
-                // There are a few kinds of things that can get thrown
-                // during racket evaluation:
-                //
-                // functions: this gets thrown if the Racket code
-                // realizes that the number of bounces has grown too
-                // large.  The thrown function represents a restarter
-                // function.  The running flag remains true.
-                //
-                // Pause: causes the machine evaluation to pause, with
-                // the expectation that it will restart momentarily.
-                // The running flag on the machine will remain true.
-                //
-                // HaltError: causes evaluation to immediately halt.
-                // We schedule the onHalt function of the HaltError to
-                // call afterwards.  The running flag on the machine
-                // is set to false.
-                //
-                // Everything else: otherwise, we send the exception value
-                // to the current error handler and exit.
-                // The running flag is set to false.
-		if (typeof(e) === 'function') {
-                    thunk = e;
-                    this.cbt = STACK_LIMIT_ESTIMATE;
-
-
-                    // If we're running an a model that prohibits
-                    // jumping off the trampoline, continue.
-                    if (noJumpingOff) {
-                        continue;
-                    }
-
-		    if (this.params.numBouncesBeforeYield-- < 0) {
-			recomputeMaxNumBouncesBeforeYield(
-			    this,
-			    (new Date()).valueOf() - startTime);
-			scheduleTrampoline(this, thunk);
-			return;
-		    }
-		} else if (e instanceof Pause) {
-                    var restart = makeRestartFunction(this);
-                    e.onPause(restart);
-                    return;
-                } else if (e instanceof HaltError) {
-		    this.running = false;
-                    e.onHalt(this);
-                    return;
-                } else {
-		    // General error condition: just exit out
-		    // of the trampoline and call the current error handler.
-		    this.running = false;
-                    this.params.currentErrorHandler(this, e);
-	            return;
-		}
-            }
-	}
-	this.running = false;
-        var that = this;
-        this.params.currentSuccessHandler(this);
-	return;
-    };
-
-    // recomputeGas: state number -> number
-    recomputeMaxNumBouncesBeforeYield = function(MACHINE, observedDelay) {
-	// We'd like to see a delay of DESIRED_DELAY_BETWEEN_BOUNCES so
-	// that we get MACHINE.params.desiredYieldsPerSecond bounces per
-	// second.
-	var DESIRED_DELAY_BETWEEN_BOUNCES = 
-	    (1000 / MACHINE.params.desiredYieldsPerSecond);
-	var ALPHA = 50;
-	var delta = (ALPHA * ((DESIRED_DELAY_BETWEEN_BOUNCES -
-			       observedDelay) / 
-			      DESIRED_DELAY_BETWEEN_BOUNCES));
-	MACHINE.params.maxNumBouncesBeforeYield = 
-            Math.max(MACHINE.params.maxNumBouncesBeforeYield + delta,
-                     1);
-    };
-
-
-
-
-
-
-
-
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-
-
-
-
-
-
-
-
-
-    // There is a single, distinguished default continuation prompt tag
-    // that's used to wrap around toplevel prompts.
-    var DEFAULT_CONTINUATION_PROMPT_TAG =
-        baselib.contmarks.DEFAULT_CONTINUATION_PROMPT_TAG;
-
-
-
-
-    
-
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-
-    var VariableReference = function(prefix, pos) {
-        this.prefix = prefix;
-        this.pos = pos;
-    };
-
-
-
-
-
-
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-
-    // Implementation of the ready function.  This will fire off when
-    // setReadyTrue is called.
-    var ready, setReadyTrue, setReadyFalse;
-    (function() {
-        var runtimeIsReady = true;
-        var readyWaiters = [];
-        var notifyWaiter = function(w) {
-            w();
-        };
-
-        ready = function(f) {
-            if (runtimeIsReady) {
-                notifyWaiter(f);
-            } else {
-                readyWaiters.push(f);
-            }
-        };
-
-        setReadyTrue = function() {
-            runtimeIsReady = true;
-            while(runtimeIsReady && readyWaiters.length > 0) {
-                notifyWaiter(readyWaiters.shift());
-            }
-        };
-
-        setReadyFalse = function() {
-            runtimeIsReady = false;
-        };
-
-    }());
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-
-    // Executes all programs that have been labeled as a main module
-    var invokeMains = function(machine, succ, fail) {
-        runtime.ready(function () {
-            if (window.console && window.console.log) {
-                window.console.log("invoking main modules");
-            }
-            setReadyFalse();
-            machine = machine || runtime.currentMachine;
-            succ = succ || function() {};
-            fail = fail || function() {};
-            var mainModules = machine.mainModules.slice();
-            var loop = function() {
-                if (mainModules.length > 0) {
-                    var nextModule = mainModules.shift();
-                    nextModule.invoke(machine, loop, fail);
-                } else {
-                    setReadyTrue();
-                    succ();
-                }
-            };
-            setTimeout(loop, 0);
-        });
-    };
-
-    // Looks up a name in any of the machine's main modules.
-    var lookupInMains = function(name, machine) {
-        var i;
-        machine = machine || runtime.currentMachine;
-        for (i = 0; i < machine.mainModules.length; i++) {
-            var ns = machine.mainModules[i].getNamespace();
-            if(ns.hasOwnProperty(name)) {
-                return ns[name];
-            }
-        }
-    };
-
-
-
-    var checkClosureAndArity = function(M) {
-        if(!(M.p instanceof Closure)){
-            raiseOperatorApplicationError(M,M.p);
-        }
-        if(!isArityMatching(M.p.racketArity,M.a)) {
-            raiseArityMismatchError(M,M.p,M.a);
-        }
-    };
-
-    var checkPrimitiveArity = function(M) {
-        if(!isArityMatching(M.p.racketArity,M.a)) {
-            raiseArityMismatchError(M,M.p,M.a);
-        }
-    };
-
-
-    //////////////////////////////////////////////////////////////////////
-    // Superinstructions to try to reduce code size.
-    var si_context_expected = function(n) {
-        if (n === 1) { return si_context_expected_1; }
-        var f = function(M) { raiseContextExpectedValuesError(M, n); };
-        return f;
-    };
-    var si_context_expected_1 = function(M) { raiseContextExpectedValuesError(M, 1); }
-
-
-
-
-
-
-
-
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-    //////////////////////////////////////////////////////////////////////
-
-
-    // Exports
-    var exports = runtime;
-    exports['currentMachine'] = new Machine();
-    exports['invokeMains'] = invokeMains;
-    exports['lookupInMains'] = lookupInMains;
-
-
-    // installing new primitives
-    exports['installPrimitiveProcedure'] = installPrimitiveProcedure;
-    exports['makePrimitiveProcedure'] = makePrimitiveProcedure;
-    exports['Primitives'] = Primitives;
-    
-    exports['ready'] = ready;
-    // Private: the runtime library will set this flag to true when
-    // the library has finished loading.
-    exports['setReadyTrue'] = setReadyTrue;
-    exports['setReadyFalse'] = setReadyFalse;
-
-    exports['Machine'] = Machine;
-    exports['Frame'] = Frame;
-    exports['CallFrame'] = CallFrame;
-    exports['PromptFrame'] = PromptFrame;
-    exports['Closure'] = Closure;
-    exports['ModuleRecord'] = ModuleRecord;
-    exports['VariableReference'] = VariableReference;
-    exports['ContinuationPromptTag'] = ContinuationPromptTag;
-    exports['DEFAULT_CONTINUATION_PROMPT_TAG'] = 
-	DEFAULT_CONTINUATION_PROMPT_TAG;
-    exports['NULL'] = NULL;
-    exports['VOID'] = VOID;
-
-    exports['NEGATIVE_ZERO'] = NEGATIVE_ZERO;
-    exports['INF'] = INF;
-    exports['NEGATIVE_INF'] = NEGATIVE_INF;
-    exports['NAN'] = NAN;
-
-
-
-
-
-    exports['testArgument'] = testArgument;
-    exports['testArity'] = testArity;
-    exports['makeCheckArgumentType'] = makeCheckArgumentType;
-
-
-    exports['raise'] = raise;
-    exports['raiseUnboundToplevelError'] = raiseUnboundToplevelError;
-    exports['raiseArgumentTypeError'] = raiseArgumentTypeError;
-    exports['raiseContextExpectedValuesError'] = raiseContextExpectedValuesError;
-    exports['raiseArityMismatchError'] = raiseArityMismatchError;
-    exports['raiseOperatorApplicationError'] = raiseOperatorApplicationError;
-    exports['raiseOperatorIsNotPrimitiveProcedure'] = raiseOperatorIsNotPrimitiveProcedure;
-    exports['raiseUnimplementedPrimitiveError'] = raiseUnimplementedPrimitiveError;
-
-
-    exports['finalizeClosureCall'] = finalizeClosureCall;
-
-
-    //////////////////////////////////////////////////////////////////////
-
-
-    // Type constructors
-
-    // numbers
-    exports['makeList'] = makeList;
-    exports['makePair'] = makePair;
-    exports['makeChar'] = makeChar;
-    exports['makeVector'] = makeVector;
-    exports['makeBox'] = makeBox;
-    exports['makeFloat'] = makeFloat;
-    exports['makeRational'] = makeRational;
-    exports['makeBignum'] = makeBignum;
-    exports['makeComplex'] = makeComplex;
-    exports['makeSymbol'] = makeSymbol;
-    exports['makePath'] = makePath;
-    exports['makeBytes'] = makeBytes;
-
-
-    exports['checkPair'] = baselib.check.checkPair;
-    exports['checkNumber'] = baselib.check.checkNumber;
-    exports['checkString'] = baselib.check.checkString;
-
-
-
-    // Type predicates
-    exports['isPair'] = isPair;
-    exports['isCaarPair'] = isCaarPair;
-    exports['isList'] = isList;
-    exports['isVector'] = isVector;
-    exports['isOutputPort'] = isOutputPort;
-    exports['isOutputStringPort'] = isOutputStringPort;
-    exports['isBox'] = isBox;
-    exports['isString'] = isString;
-    exports['isSymbol'] = isSymbol;
-    exports['isPath'] = isPath;
-    exports['isNumber'] = isNumber;
-    exports['isNatural'] = isNatural;
-    exports['isReal'] = isReal;
-    exports['isProcedure'] = plt.baselib.functions.isProcedure;
-    exports['equals'] = equals;
-
-    exports['toDomNode'] = toDomNode;
-    exports['toWrittenString'] = toWrittenString;
-    exports['toDisplayedString'] = toDisplayedString;
-
-    exports['ArityAtLeast'] = ArityAtLeast;
-    exports['makeArityAtLeast'] = makeArityAtLeast;
-    exports['isArityMatching'] = isArityMatching;
-
-    exports['heir'] = heir;
-    exports['makeClassPredicate'] = makeClassPredicate;
-
-    exports['PAUSE'] = PAUSE;
-    exports['HaltError'] = HaltError;
-
-
-
-    exports['makeStructureType'] = makeStructureType;
-    exports['Struct'] = Struct;
-    exports['StructType'] = StructType;
-
-    exports['getTracedAppKey'] = getTracedAppKey;
-    exports['getTracedCalleeKey'] = getTracedCalleeKey;
-
-    exports['si_context_expected'] = si_context_expected;
-    exports['si_context_expected_1'] = si_context_expected_1;
-    exports['checkClosureAndArity'] = checkClosureAndArity;
-    exports['checkPrimitiveArity'] = checkPrimitiveArity;
-
-}(this.plt, this.plt.baselib));

js.rkt

@@ -1,3 +0,0 @@
-#lang s-exp "lang/base.rkt"
-(require "js/main.rkt")
-(provide (all-from-out "js/main.rkt"))

js/js-impl.js

@@ -1,180 +0,0 @@
-/*jslint devel: true, browser: false, unparam: true, sub: true, windows: false, vars: true, white: true, maxerr: 50, indent: 4 */
-
-/*global $,plt,EXPORTS,document,window*/
-(function() {
-    "use strict";
-
-    var VOID = plt.baselib.constants.VOID_VALUE;
-    var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure;
-    var makeCheckArgumentType = plt.baselib.check.makeCheckArgumentType;
-    var checkSymbolOrString = plt.baselib.check.checkSymbolOrString;
-    var checkString = plt.baselib.check.checkString;
-    var checkAny = makeCheckArgumentType(function(x) { return true; },
-                                         "any");
-
-    var isJsString = function(x) { return typeof(x) === 'string'; };
-    var checkJsString = makeCheckArgumentType(isJsString, 'JavaScript string');
-
-
-
-    var isJsNumber = function(x) { return typeof(x) === 'number'; };
-    var checkNumber = plt.baselib.check.checkNumber;
-    var checkJsNumber = makeCheckArgumentType(isJsNumber, 'JavaScript number');
-
-
-    EXPORTS['alert'] =
-        makePrimitiveProcedure(
-            'alert',
-            1,
-            function(MACHINE) {
-                var elt = MACHINE.e[MACHINE.e.length - 1];
-                alert(String(elt));
-                return VOID;
-            });
-
-
-    EXPORTS['body'] = $(document.body);
-
-    EXPORTS['$'] =
-        makePrimitiveProcedure(
-            '$',
-            1,
-            function(MACHINE) {
-                var obj = MACHINE.e[MACHINE.e.length - 1];
-                return $(obj);
-            });
-
-    EXPORTS['call-method'] = 
-        makePrimitiveProcedure(
-            'call-method',
-            plt.baselib.arity.makeArityAtLeast(2),
-            function(MACHINE) {
-                var obj = MACHINE.e[MACHINE.e.length - 1];
-                var methodName = MACHINE.e[MACHINE.e.length - 2];
-                var args = [], i;
-                for (i = 0; i < MACHINE.a - 2; i = i+1) {
-                    args.push(MACHINE.e[MACHINE.e.length -1 - 2 - i]);
-                }
-                var result = obj[methodName].apply(obj, args);
-                return result;
-            });
-
-
-    EXPORTS['window'] = window;
-
-
-    EXPORTS['get-attr'] =
-        makePrimitiveProcedure(
-            'get-attr',
-            plt.baselib.arity.makeArityAtLeast(2),
-            function(MACHINE) {
-                var obj = checkAny(MACHINE, 'get-attr', 0), attr, i;
-                for (i = 1; i < MACHINE.a; i = i + 1) {
-                    attr = checkSymbolOrString(MACHINE, 'get-attr', i).toString();
-                    obj = obj[attr];
-                }
-                return obj;
-            });
-
-
-    EXPORTS['set-attr!'] =
-        makePrimitiveProcedure(
-            'set-attr!',
-            3,
-            function(MACHINE) {
-                var obj = checkAny(MACHINE, 'set-attr!', 0);
-                var attr = checkSymbolOrString(MACHINE, 'set-attr!', 1).toString();
-                var val = checkAny(MACHINE, 'set-attr!', 2);
-                obj[attr] = val;
-                return VOID;
-            });
-
-    EXPORTS['js-string?'] = 
-        makePrimitiveProcedure(
-            'js-string?',
-            1,
-            function(MACHINE) {
-                return typeof(checkAny(MACHINE, 'js-string?', 0)) === 'string';
-            });
-
-    EXPORTS['string->js-string'] =
-        makePrimitiveProcedure(
-            'string->js-string',
-            1,
-            function(MACHINE) {
-                return checkString(MACHINE, 'string->js-string', 0).toString();
-            });
-
-    EXPORTS['js-string->string'] =
-        makePrimitiveProcedure(
-            'js-string->string',
-            1,
-            function(MACHINE) {
-                return checkJsString(MACHINE, 'string->js-string', 0);
-            });
-
-
-
-
-    EXPORTS['js-number?'] = 
-        makePrimitiveProcedure(
-            'js-number?',
-            1,
-            function(MACHINE) {
-                return isJsNumber(checkAny(MACHINE, 'js-string?', 0));
-            });    
-    EXPORTS['js-number->number'] = 
-        makePrimitiveProcedure(
-            'js-number->number',
-            1,
-            function(MACHINE) {
-                return plt.baselib.numbers.makeFloat(checkJsNumber(MACHINE, 'js-string?', 0));
-            });    
-
-    EXPORTS['number->js-number'] = 
-        makePrimitiveProcedure(
-            'number->js-number',
-            1,
-            function(MACHINE) {
-                return plt.baselib.numbers.toFixnum(checkNumber(MACHINE, 'js-string?', 0));
-            });    
-
-
-    EXPORTS['js-null?'] = 
-        makePrimitiveProcedure(
-            'js-null?',
-            1,
-            function(MACHINE) {
-                return checkAny(MACHINE, 'js-null?', 0) === null;
-            });    
-
-    EXPORTS['js-null'] = null;
-
-
-
-    // Javascript-specific extensions.  A small experiment.
-    EXPORTS['viewport-width'] = 
-        makePrimitiveProcedure(
-            'viewport-width',
-            0,
-            function(MACHINE) {
-                return $(window).width();
-            });
-
-    EXPORTS['viewport-height'] = 
-        makePrimitiveProcedure(
-            'viewport-height',
-            0,
-            function(MACHINE) {
-                return $(window).height();
-            });
-
-
-    EXPORTS['in-javascript-context?'] =
-        makePrimitiveProcedure(
-            'in-javascript-context?',
-            0,
-            function(MACHINE) {
-                return true;
-            });
-}());

korean/lang/reader.rkt

@@ -1,5 +0,0 @@
-#lang s-exp syntax/module-reader
-#:language (lambda ()
-             `(planet ,(this-package-version-symbol lang/korean)))
-
-(require planet/version)

lang/kernel.rkt

@@ -1,530 +0,0 @@
-#lang racket/base
-(require (prefix-in racket: (only-in racket/math pi sinh cosh sqr
-                                     sgn conjugate))
-         (prefix-in racket: racket/base)
-         racket/provide
-	 racket/local
-	 (for-syntax racket/base)
-         racket/stxparam
-         
-         (only-in '#%paramz
-                  exception-handler-key
-                  parameterization-key
-                  break-enabled-key))
-
-(require (prefix-in kernel: '#%kernel))
-
-
-(provide exception-handler-key
-         parameterization-key
-         break-enabled-key)
-
-
-(provide define-syntax-parameter
-         syntax-parameterize)
-
-;; constants
-(define pi racket:pi)
-(define e (racket:exp 1))
-
-
-(define my-current-print-mode "write")
-(define current-print-mode
-  (case-lambda
-    [() my-current-print-mode]
-    [(v) (set! my-current-print-mode v)]))
-
-(provide current-print-mode)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Primitive function stubs
-
-;; provide-stub-function
-(define-syntax (provide-stub-function stx)
-  (syntax-case stx ()
-    [(_ name-or-name-pair ...)
-     (with-syntax ([(provided-name ...)
-                    (map (lambda (name-or-pair)
-                           (syntax-case name-or-pair ()
-                             [x
-                              (identifier? #'x)
-                              #'x]
-                             [(x y)
-                              #'x]))
-                         (syntax->list #'(name-or-name-pair ...)))]
-                   [(impl-name ...) 
-                    (map (lambda (name)
-                           (syntax-case name ()
-                             [an-id
-                              (identifier? #'an-id)
-                              (datum->syntax name 
-                                             (string->symbol
-                                              (string-append "racket:"
-                                                             (symbol->string 
-                                                              (syntax-e name))))
-                                             name)]
-                             [(an-id an-impl-name)
-                              #'an-impl-name]))
-                         (syntax->list #'(name-or-name-pair ...)))])
-       (syntax/loc stx
-         (begin (begin (define (provided-name . args) 
-                         (racket:apply impl-name args))
-                       (provide provided-name))
-                ...)))]))
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Provides
-(provide pi
-         e
-         null
-         eof
-         #%plain-module-begin
-	 #%module-begin
-	 #%datum
-	 #%app
-         #%plain-app
-	 #%top-interaction
-	 #%top
-         module
-         define
-	 define-values
-         let-syntax
-	 let-values
-	 let*-values
-	 define-struct
-         struct
-         if
-	 cond
-	 else
-	 case
-	 quote
-	 unquote
-	 unquote-splicing
-	 lambda
-	 case-lambda
-	 let
-	 let*
-	 letrec
-	 letrec-values
-	 local
-	 begin
-	 begin0
-	 set!
-	 and
-	 or
-	 when
-	 unless
-	 require
-	 for-syntax
-         for-template
-	 define-for-syntax
-	 begin-for-syntax
-	 prefix-in
-	 only-in
-         rename-in
-         except-in
-	 provide
-	 planet
-	 all-defined-out
-	 all-from-out
-         prefix-out
-	 except-out
-	 rename-out
-	 struct-out
-         filtered-out
-         combine-in
-         protect-out
-         combine-out
-
-         
-         define-syntax-rule
-	 define-syntax
-	 define-syntaxes
-
-
-         let/cc
-	 with-continuation-mark
-
-         hash?
-         hash-equal?
-         hash-eq?
-         hash-eqv?
-         hash
-         hasheqv
-         hasheq
-         make-hash
-         make-hasheqv
-         make-hasheq
-         make-immutable-hash
-         make-immutable-hasheqv
-         make-immutable-hasheq
-         hash-copy
-         hash-ref
-         hash-set!
-         hash-set
-         hash-remove!
-         hash-remove
-         equal-hash-code
-         hash-count
-
-
-         ;; Kernel inlinable
-         *
-	 -
-	 +
-	 =
-	 /
-	 sub1
-	 add1
-	 <
-	 >
-	 <=
-	 >=
-         cons
-         car
-         cdr
-         list
-         list?
-         pair?
-         null?
-         not
-         eq?
-         values
-
-         ;; The version of apply in racket/base is doing some stuff that
-         ;; we are not handling yet.  So we expose the raw apply here instead.
-         (rename-out [kernel:apply apply])
-         call-with-values
-
-         gensym
-
-
-         srcloc
-         make-srcloc
-         srcloc?
-         srcloc-source
-         srcloc-line
-         srcloc-column
-         srcloc-position
-         srcloc-span
-
-
-         make-struct-type
-         make-struct-field-accessor
-         make-struct-field-mutator
-         struct-type?
-
-         exn:fail
-         struct:exn:fail
-         prop:exn:srclocs
-
-
-         current-inexact-milliseconds
-         current-seconds
-         
-         
-         ;; needed for cs019-local
-         #%stratified-body
-         )
-
-
-(define (-identity x) x)
-
-(define (-undefined? x)
-  (letrec ([y y])
-    (eq? x y)))
-
-
-
-;; Many of these should be pushed upward rather than stubbed, so that
-;; Racket's compiler can optimize these.
-(provide-stub-function
-
- current-output-port
- current-print 
-
-
-
- write
- write-byte
- display
- newline
- displayln
-
- 
- current-continuation-marks
-
-;;  continuation-mark-set?
-;;  continuation-mark-set->list
-
-;;  struct-constructor-procedure?
-;;  struct-predicate-procedure?
-;;  struct-accessor-procedure?
-;;  struct-mutator-procedure?
-
-;;  make-arity-at-least
-;;  arity-at-least?
-;;  arity-at-least-value
-
-
-;;  compose
-;;  current-inexact-milliseconds
-;;  current-seconds
-  void
-  random
-;;  sleep
-;;  (identity -identity)
-
-raise  
-error
-raise-type-error
-raise-mismatch-error
-
-make-exn
-make-exn:fail
-make-exn:fail:contract
-make-exn:fail:contract:arity
-make-exn:fail:contract:variable
-make-exn:fail:contract:divide-by-zero
-
-exn-message
-exn-continuation-marks
-
-
-;;  exn?
-;;  exn:fail?
-;;  exn:fail:contract?
-;;  exn:fail:contract:arity?
-;;  exn:fail:contract:variable?
-;;  exn:fail:contract:divide-by-zero?
-  abs
-  quotient
-  remainder
-  modulo
-  max
-  min
-  gcd
-  lcm
-  floor
-  ceiling
-  round
-  truncate
-  numerator
-  denominator
-  expt
-  exp
-  log
-  sin
-  sinh
-  cos
-  cosh
-  tan
-  asin
-  acos
-  atan
-  sqr
-  sqrt
-  integer-sqrt
-  sgn
-  make-rectangular
-  make-polar
-  real-part
-  imag-part
-  angle
-  magnitude
-  conjugate
-  inexact->exact
-  exact->inexact
-  number->string
-  string->number
-  procedure?
-  procedure-arity
-  procedure-arity-includes?
-  procedure-rename
-  ;;  (undefined? -undefined?)
-;;  immutable?
-void?
-symbol?
-string?
-char?
-boolean?
-vector?
-struct?
-;;  bytes?
-byte?
-number?
-complex?
-real?
-rational?
-integer?
-exact-integer?
-exact?
-exact-nonnegative-integer?
-inexact?
-odd?
-even?
-zero?
-positive?
-negative?
-box?
-;;  hash?
-
-  equal?
-  eqv?
-
-  caar
-  cadr
-;;  cdar
-;;  cddr
-;;  caaar
-;;  caadr
-;;  cadar
-;;  cdaar
-;;  cdadr
-;;  cddar
-;;  caddr
-;;  cdddr
-;;  cadddr
-  length
-  list*
-  list-ref
-;;  list-tail
-  append
-  reverse
-  for-each
-  map
-  andmap
-  ormap
-  memq
-  memv
-  member
-  memf
-  assq
-  assv
-  assoc
-;;  sort
-  box
-;;  box-immutable
-  unbox
-  set-box!
-;;  make-hash
-;;  make-hasheq
-;;  hash-set!
-;;  hash-ref
-;;  hash-remove!
-;;  hash-map
-;;  hash-for-each
-  make-string
-  string
-  string-length
-  string-ref
-  string=?
-  string<?
-  string>?
-  string<=?
-  string>=?
-  string-ci=?
-  string-ci<?
-  string-ci>?
-  string-ci<=?
-  string-ci>=?
-
-  string-copy
-  substring
-  string-append
-  string->list
-  list->string
-  string->symbol
-  symbol->string
-  
-  format
-  printf
-  fprintf
-;;  string->immutable-string
-  string-set!
-;;  string-fill!
-;;  make-bytes
-;;  bytes
-;;  bytes->immutable-bytes
-;;  bytes-length
-;;  bytes-ref
-;;  bytes-set!
-;;  subbytes
-;;  bytes-copy
-;;  bytes-fill!
-;;  bytes-append
-;;  bytes->list
-;;  list->bytes
-;;  bytes=?
-;;  bytes<?
-;;  bytes>?
-  make-vector
-  vector
-  vector-length
-  vector-ref
-  vector-set!
-  vector->list
-  list->vector
-  char=?
-  char<?
-  char>?
-  char<=?
-  char>=?
-  char-ci=?
-  char-ci<?
-  char-ci>?
-  char-ci<=?
-  char-ci>=?
-  char-alphabetic?
-  char-numeric?
-  char-whitespace?
-  char-upper-case?
-  char-lower-case?
-  char->integer
-  integer->char
-  char-upcase
-  char-downcase
-
-  
-  ;; these are defined in bootstrapped-primitives in Whalesong's compiler package
-  call-with-current-continuation
-  call/cc
-
-  ;;  call-with-continuation-prompt
-  ;;  abort-current-continuation
-  default-continuation-prompt-tag
-  make-continuation-prompt-tag
-  continuation-prompt-tag?
-
-  make-reader-graph
-  make-placeholder
-  placeholder-set!
-
-  eof-object?
-  read-byte
-
-
-  hash-has-key?
-  hash-keys
-  hash-values
-  )
-
-
-
-
-
-(provide set-car! set-cdr!)
-
-(define (set-car! x v)
-  (error 'set-car! "Not available outside JavaScript context."))
-
-(define (set-cdr! x v)
-  (error 'set-car! "Not available outside JavaScript context."))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

parser/where-is-collects.rkt

@@ -1,18 +0,0 @@
-#lang typed/racket/base
-(require/typed racket/path
-               (normalize-path (Path -> Path)))
-(require/typed typed/racket/base
-               (relative-path? (Any -> Boolean))
-               (find-executable-path (Path Path -> Path)))
-
-(provide collects-path)
-
-(define collects-path
-  (normalize-path
-   (let ([p (find-system-path 'collects-dir)])
-     (cond
-      [(relative-path? p)
-       (find-executable-path (find-system-path 'exec-file)
-                             (find-system-path 'collects-dir))]
-      [else
-       p]))))

tests/more-tests/booleans-cs019.rkt~

@@ -1,23 +0,0 @@
-#lang planet dyoo/whalesong/base
-(require (planet dyoo/whalesong/lang/bool))
-
-(boolean? "t")
-(boolean? #t)
-(boolean? 0)
-(boolean? #\t)
-
-(char? "t")
-(char? #t)
-(char? 0)
-(char? #\t)
-
-(char=? #\a #\b)
-(char=? #\a #\a)
-(char=? #\a #\a #\b)
-(char=? #\a #\b #\a)
-(char=? #\a #\a #\a)
-
-true
-false
-(false? true)
-(false? false)

tests/more-tests/isolating-bug.expected

@@ -1,27 +0,0 @@
-#<struct-type:swf>
-#<procedure:make-swf>
-#<procedure:swf?>
-#<procedure:swf-f>
-#<procedure:set-swf-f!>
-in the result of call-with-values
-(#<struct-type:swf> #<procedure:make-swf> #<procedure:swf?> #<procedure:swf-f> #<procedure:set-swf-f!>)
----
-#<struct-type:swf>
-#<procedure:make-swf>
-#<procedure:swf?>
-#<procedure:swf-f>
-#<procedure:set-swf-f!>
-***
-#<struct-type:swf2>
-#<procedure:make-swf2>
-#<procedure:swf2?>
-#<procedure:swf2-f>
-#<procedure:set-swf2-f!>
-in the result of call-with-values
-(#<struct-type:swf2> #<procedure:make-swf2> #<procedure:swf2?> #<procedure:swf2-f> #<procedure:set-swf2-f!>)
----
-#<struct-type:swf2>
-#<procedure:make-swf2>
-#<procedure:swf2?>
-#<procedure:swf2-f>
-#<procedure:set-swf2-f!>

tests/more-tests/quasi.rkt

@@ -1,2 +0,0 @@
-#lang planet dyoo/whalesong
-`(0 ,@(list 1 2) 4)

web-world/examples/hello2/hello2.rkt

@@ -1,5 +0,0 @@
-#lang planet dyoo/whalesong
-
-(require (planet dyoo/whalesong/web-world))
-
-(big-bang 0 (initial-view "hello world"))

web-world/main.rkt

@@ -1,9 +0,0 @@
-#lang s-exp "../lang/base.rkt"
-
-(require "impl.rkt"
-         "helpers.rkt"
-         "event.rkt")
-
-(provide (all-from-out "impl.rkt")
-         (all-from-out "helpers.rkt")
-         (all-from-out "event.rkt"))

whalesong/Makefile

@@ -0,0 +1,52 @@
+all: build
+
+build: planet-link launcher setup
+
+bump-version:
+	racket bump-version.rkt
+
+launcher: 
+	racket make-launcher.rkt
+
+test: test-more
+
+test-all: test 
+
+
+## TODO: fix the tests harness in tests/test-all.  I have to remove references
+## to deleted files.
+# test-analyzer:
+# 	raco make -v --disable-inline test-analyzer.rkt
+# 	racket test-analyzer.rkt
+# test-all: 
+# 	racket tests/test-all.rkt
+# test-browser-evaluate: 
+# 	racket tests/test-browser-evaluate.rkt
+# test-compiler: 
+# 	racket tests/test-compiler.rkt
+# test-parse-bytecode-on-collects: 
+# 	racket tests/test-parse-bytecode-on-collects.rkt
+# test-earley: 
+# 	racket tests/test-earley.rkt
+# test-conform: 
+# 	racket tests/test-conform.rkt
+
+test-more: bump-version build
+	racket tests/run-more-tests.rkt
+
+doc:
+	scribble  ++xref-in setup/xref load-collections-xref --redirect-main http://docs.racket-lang.org/ --dest generated-docs  --dest-name index.html scribblings/manual.scrbl
+
+
+cs019-doc:
+	scribble  ++xref-in setup/xref load-collections-xref --redirect-main http://docs.racket-lang.org/ --dest generated-docs  scribblings/cs019.scrbl
+
+
+
+setup:
+
+	raco setup --no-docs -P dyoo whalesong.plt 1 19
+
+
+planet-link:
+	raco planet link dyoo whalesong.plt 1 19 .

whalesong/README

@@ -1,7 +1,7 @@
 ======================================================================
 Whalesong: a compiler from Racket to JavaScript.
 
-Danny Yoo (dyoo@cs.wpi.edu)
+Danny Yoo (dyoo@hashcollision.org)
 
 
 ======================================================================
@@ -29,21 +29,30 @@ amount of time.
 Example usage
 
 
-
-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.)
+Create a simple, 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
+    #lang 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
+    $ ls -l hello.html
+    -rw-rw-r-- 1 dyoo nogroup 692213 Jun  7 18:00 hello.html
+
+To build standalone executable of your program, provide --as-standalone-html
+flag.
+
+    $ ./whalesong.rkt build --as-standalone-html hello.rkt
+
+    $ ls -l
+    -rw-rw-r-- 1 dyoo nogroup 692213 Jun  7 18:00 hello.html
+
+NOTE: Earlier versions had --as-standalone-xhtml flag, which is now removed.
 
 
 [FIXME: add more examples]

whalesong/bf/lang/reader.rkt

@@ -1,11 +1,9 @@
 #lang s-exp syntax/module-reader
-#:language (lambda ()
-             `(planet ,(this-package-version-symbol bf/language)))
+#:language (lambda () 'whalesong/bf/language)
 #:read my-read
 #:read-syntax my-read-syntax
 #:info my-get-info
-(require "../parser.rkt"
-         planet/version)
+(require "../parser.rkt")
 
 (define (my-read in)
   (syntax->datum (my-read-syntax #f in)))

whalesong/bf/language.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
 (require "semantics.rkt"
          (for-syntax racket/base))

whalesong/bf/semantics.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
 ;; This is a second semantics for the language that tries to go for speed,
 ;; at the expense of making things a little more complicated.

whalesong/compiler/analyzer.rkt

@@ -0,0 +1,346 @@
+#lang typed/racket/base
+
+(require "expression-structs.rkt"
+         "analyzer-structs.rkt"
+         "arity-structs.rkt"
+         "lexical-structs.rkt"
+         "il-structs.rkt"
+         "compiler-structs.rkt"
+         racket/list)
+
+(require/typed "compiler-helper.rkt"
+               [ensure-const-value (Any -> const-value)])
+
+
+(provide collect-all-lambdas-with-bodies
+         collect-lam-applications
+         extract-static-knowledge
+         ensure-prefix)
+
+;; Holds helper functions we use for different analyses.
+
+;; Given a lambda body, collect all the applications that exist within
+;; it.  We'll use this to determine what procedures can safely be
+;; transformed into primitives.
+(: collect-lam-applications (Lam CompileTimeEnvironment -> (Listof CompileTimeEnvironmentEntry)))
+(define (collect-lam-applications lam cenv)
+  
+  (let: loop : (Listof CompileTimeEnvironmentEntry)
+    ([exp : Expression (Lam-body lam)]
+     [cenv : CompileTimeEnvironment cenv]
+     [acc : (Listof CompileTimeEnvironmentEntry) '()])
+    
+    (cond
+      [(Top? exp)
+       (loop (Top-code exp)
+             (cons (Top-prefix exp) cenv)
+             acc)]
+      
+      [(Module? exp)
+       (loop (Module-code exp)
+             (cons (Module-prefix exp) cenv)
+             acc)]
+      
+      [(Constant? exp)
+       acc]
+      
+      [(LocalRef? exp)
+       acc]
+      
+      [(ToplevelRef? exp)
+       acc]
+      
+      [(ToplevelSet? exp)
+       (loop (ToplevelSet-value exp) cenv acc)]
+      
+      [(Branch? exp)
+       (define acc-1 (loop (Branch-predicate exp) cenv acc))
+       (define acc-2 (loop (Branch-consequent exp) cenv acc-1))
+       (define acc-3 (loop (Branch-alternative exp) cenv acc-2))
+       acc-3]
+      
+      [(Lam? exp)
+       acc]
+      
+      [(CaseLam? exp)
+       acc]
+      
+      [(EmptyClosureReference? exp)
+       acc]
+      
+      [(Seq? exp)
+       (foldl (lambda: ([e : Expression]
+                        [acc : (Listof CompileTimeEnvironmentEntry)])
+                (loop e cenv acc))
+              acc
+              (Seq-actions exp))]
+      
+      [(Splice? exp)
+       (foldl (lambda: ([e : Expression]
+                        [acc : (Listof CompileTimeEnvironmentEntry)])
+                (loop e cenv acc))
+              acc
+              (Splice-actions exp))]
+      
+      [(Begin0? exp)
+       (foldl (lambda: ([e : Expression]
+                        [acc : (Listof CompileTimeEnvironmentEntry)])
+                (loop e cenv acc))
+              acc
+              (Begin0-actions exp))]
+      
+      [(App? exp)
+       (define new-cenv
+         (append (build-list (length (App-operands exp)) (lambda: ([i : Natural]) '?))
+                 cenv))
+       (foldl (lambda: ([e : Expression]
+                        [acc : (Listof CompileTimeEnvironmentEntry)])
+                (loop e new-cenv acc))
+              (cons (extract-static-knowledge (App-operator exp) new-cenv)
+                    (loop (App-operator exp) new-cenv acc))
+              (App-operands exp))]
+      
+      [(Let1? exp)
+       (define acc-1 (loop (Let1-rhs exp) (cons '? cenv) acc))
+       (define acc-2 (loop (Let1-body exp) 
+                           (cons (extract-static-knowledge (Let1-rhs exp) (cons '? cenv)) 
+                                 cenv)
+                           acc-1))
+       acc-2]
+      
+      [(LetVoid? exp)
+       (loop (LetVoid-body exp) 
+             (append (build-list (LetVoid-count exp) (lambda: ([i : Natural]) '?))
+                     cenv)
+             acc)]
+      
+      [(InstallValue? exp)
+       (loop (InstallValue-body exp) cenv acc)]
+      
+      [(BoxEnv? exp)
+       (loop (BoxEnv-body exp) cenv acc)]
+      
+      [(LetRec? exp)
+       (let ([n (length (LetRec-procs exp))])
+         (let ([new-cenv (append (map (lambda: ([p : Lam]) 
+                                        (extract-static-knowledge 
+                                         p 
+                                         (append (build-list (length (LetRec-procs exp))
+                                                             (lambda: ([i : Natural]) '?))
+                                                 (drop cenv n))))
+                                      (LetRec-procs exp))
+                                 (drop cenv n))])
+           (loop (LetRec-body exp) new-cenv acc)))]
+      
+      [(WithContMark? exp)
+       (define acc-1 (loop (WithContMark-key exp) cenv acc))
+       (define acc-2 (loop (WithContMark-value exp) cenv acc-1))
+       (define acc-3 (loop (WithContMark-body exp) cenv acc-2))
+       acc-3]
+      
+      [(ApplyValues? exp)
+       (define acc-1 (loop (ApplyValues-proc exp) cenv acc))
+       (define acc-2 (loop (ApplyValues-args-expr exp) cenv acc-1))
+       acc-2]
+      
+      [(DefValues? exp)
+       (loop (DefValues-rhs exp) cenv acc)]
+      
+      [(PrimitiveKernelValue? exp)
+       acc]
+      
+      [(VariableReference? exp)
+       (loop (VariableReference-toplevel exp) cenv acc)]
+      
+      [(Require? exp)
+       acc])))
+
+
+
+
+
+(: extract-static-knowledge (Expression CompileTimeEnvironment ->  
+                                        CompileTimeEnvironmentEntry))
+;; Statically determines what we know about the expression, given the compile time environment.
+;; We should do more here eventually, including things like type inference or flow analysis, so that
+;; we can generate better code.
+(define (extract-static-knowledge exp cenv)
+  (cond
+    [(Lam? exp)
+     ;(log-debug "known to be a lambda")
+     (make-StaticallyKnownLam (Lam-name exp)
+                              (Lam-entry-label exp)
+                              (if (Lam-rest? exp)
+                                  (make-ArityAtLeast (Lam-num-parameters exp))
+                                  (Lam-num-parameters exp)))]
+    [(and (LocalRef? exp) 
+          (not (LocalRef-unbox? exp)))
+     (let ([entry (list-ref cenv (LocalRef-depth exp))])
+       ;(log-debug (format "known to be ~s" entry))
+       entry)]
+    
+    [(EmptyClosureReference? exp)
+     (make-StaticallyKnownLam (EmptyClosureReference-name exp)
+                              (EmptyClosureReference-entry-label exp)
+                              (if (EmptyClosureReference-rest? exp)
+                                  (make-ArityAtLeast (EmptyClosureReference-num-parameters exp))
+                                  (EmptyClosureReference-num-parameters exp)))]
+    [(ToplevelRef? exp)
+     ;(log-debug (format "toplevel reference of ~a" exp))
+     ;(when (ToplevelRef-constant? exp)
+     ;  (log-debug (format "toplevel reference ~a should be known constant" exp)))
+     (let: ([name : (U Symbol False GlobalBucket ModuleVariable)
+                  (list-ref (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp))))
+                            (ToplevelRef-pos exp))])
+       (cond
+         [(ModuleVariable? name)
+          ;(log-debug (format "toplevel reference is to ~s" name))
+          name]
+         [(GlobalBucket? name)
+          '?]
+         [else
+          ;(log-debug (format "nothing statically known about ~s" exp))
+          '?]))]
+    
+    [(Constant? exp)
+     (make-Const (ensure-const-value (Constant-v exp)))]
+    
+    [(PrimitiveKernelValue? exp)
+     exp]
+    
+    [else
+     ;(log-debug (format "nothing statically known about ~s" exp))
+     '?]))
+
+
+
+
+
+
+
+
+
+(: collect-all-lambdas-with-bodies (Expression -> (Listof lam+cenv)))
+;; Finds all the lambdas in the expression.
+(define (collect-all-lambdas-with-bodies exp)
+  (let: loop : (Listof lam+cenv)
+    ([exp : Expression exp]
+     [cenv : CompileTimeEnvironment '()])
+    
+    (cond
+      [(Top? exp)
+       (loop (Top-code exp) (cons (Top-prefix exp) cenv))]
+      [(Module? exp)
+       (loop (Module-code exp) (cons (Module-prefix exp) cenv))]
+      [(Constant? exp)
+       '()]
+      [(LocalRef? exp)
+       '()]
+      [(ToplevelRef? exp)
+       '()]
+      [(ToplevelSet? exp)
+       (loop (ToplevelSet-value exp) cenv)]
+      [(Branch? exp)
+       (append (loop (Branch-predicate exp) cenv)
+               (loop (Branch-consequent exp) cenv)
+               (loop (Branch-alternative exp) cenv))]
+      [(Lam? exp)
+       (cons (make-lam+cenv exp (extract-lambda-cenv exp cenv))
+             (loop (Lam-body exp) 
+                   (extract-lambda-cenv exp cenv)))]
+      [(CaseLam? exp)
+       (cons (make-lam+cenv exp cenv)
+             (apply append (map (lambda: ([lam : (U Lam EmptyClosureReference)])
+                                  (loop lam cenv))
+                                (CaseLam-clauses exp))))]
+      
+      [(EmptyClosureReference? exp)
+       '()]
+      
+      [(Seq? exp)
+       (apply append (map (lambda: ([e : Expression]) (loop e cenv))
+                          (Seq-actions exp)))]
+      [(Splice? exp)
+       (apply append (map (lambda: ([e : Expression]) (loop e cenv))
+                          (Splice-actions exp)))]
+      [(Begin0? exp)
+       (apply append (map (lambda: ([e : Expression]) (loop e cenv))
+                          (Begin0-actions exp)))]
+      [(App? exp)
+       (let ([new-cenv (append (build-list (length (App-operands exp)) (lambda: ([i : Natural]) '?))
+                               cenv)])
+         (append (loop (App-operator exp) new-cenv)
+                 (apply append (map (lambda: ([e : Expression]) (loop e new-cenv)) (App-operands exp)))))]
+      [(Let1? exp)
+       (append (loop (Let1-rhs exp)
+                     (cons '? cenv))
+               (loop (Let1-body exp) 
+                     (cons (extract-static-knowledge (Let1-rhs exp) (cons '? cenv)) 
+                           cenv)))]
+      [(LetVoid? exp)
+       (loop (LetVoid-body exp) 
+             (append (build-list (LetVoid-count exp) (lambda: ([i : Natural]) '?))
+                     cenv))]
+      [(InstallValue? exp)
+       (loop (InstallValue-body exp) cenv)]
+      [(BoxEnv? exp)
+       (loop (BoxEnv-body exp) cenv)]
+      [(LetRec? exp)
+       (let ([n (length (LetRec-procs exp))])
+         (let ([new-cenv (append (map (lambda: ([p : Lam]) 
+                                        (extract-static-knowledge 
+                                         p 
+                                         (append (build-list (length (LetRec-procs exp))
+                                                             (lambda: ([i : Natural]) '?))
+                                                 (drop cenv n))))
+                                      (LetRec-procs exp))
+                                 (drop cenv n))])
+           (append (apply append 
+                          (map (lambda: ([lam : Lam])
+                                 (loop lam new-cenv))
+                               (LetRec-procs exp)))
+                   (loop (LetRec-body exp) new-cenv))))]
+      [(WithContMark? exp)
+       (append (loop (WithContMark-key exp) cenv)
+               (loop (WithContMark-value exp) cenv)
+               (loop (WithContMark-body exp) cenv))]
+      [(ApplyValues? exp)
+       (append (loop (ApplyValues-proc exp) cenv)
+               (loop (ApplyValues-args-expr exp) cenv))]
+      [(DefValues? exp)
+       (append (loop (DefValues-rhs exp) cenv))]
+      [(PrimitiveKernelValue? exp)
+       '()]
+      [(VariableReference? exp)
+       (loop (VariableReference-toplevel exp) cenv)]
+      [(Require? exp)
+       '()])))
+
+
+
+(: extract-lambda-cenv (Lam CompileTimeEnvironment -> CompileTimeEnvironment))
+;; Given a Lam and the ambient environment, produces the compile time environment for the
+;; body of the lambda.
+(define (extract-lambda-cenv lam cenv)
+  (append (map (lambda: ([d : Natural])
+                 (list-ref cenv d))
+               (Lam-closure-map lam))
+          (build-list (if (Lam-rest? lam)
+                          (add1 (Lam-num-parameters lam))
+                          (Lam-num-parameters lam))
+                      (lambda: ([i : Natural]) '?))))
+
+
+
+
+
+
+
+
+
+
+(: ensure-prefix (CompileTimeEnvironmentEntry -> Prefix))
+(define (ensure-prefix x)
+  (if (Prefix? x)
+      x
+      (error 'ensure-prefix "Not a prefix: ~s" x)))

whalesong/compiler/bootstrapped-primitives.rkt

@@ -14,7 +14,7 @@
 (require/typed "../parameters.rkt"
                (current-defined-name (Parameterof (U Symbol LamPositionalName))))
 (require/typed "../parser/parse-bytecode.rkt"
-               (parse-bytecode (Any -> Expression)))
+               (parse-bytecode (Compiled-Expression -> Expression)))
 
 
 
@@ -43,16 +43,16 @@
     ;; Precondition: the environment holds the f function that we want to jump into.
     
     ;; First, move f to the proc register
-    (make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
+    (make-AssignImmediate 'proc (make-EnvLexicalReference 0 #f))
     
     ;; Next, capture the envrionment and the current continuation closure,.
     (make-PushEnvironment 2 #f)
-    (make-AssignPrimOpStatement (make-EnvLexicalReference 0 #f) 
+    (make-AssignPrimOp (make-EnvLexicalReference 0 #f) 
                                 (make-CaptureControl 0 default-continuation-prompt-tag))
-    (make-AssignPrimOpStatement (make-EnvLexicalReference 1 #f)
+    (make-AssignPrimOp (make-EnvLexicalReference 1 #f)
                                 ;; When capturing, skip over f and the two slots we just added.
                                 (make-CaptureEnvironment 3 default-continuation-prompt-tag))
-    (make-AssignPrimOpStatement (make-EnvLexicalReference 2 #f)
+    (make-AssignPrimOp (make-EnvLexicalReference 2 #f)
                                  (make-MakeCompiledProcedure call/cc-closure-entry
                                                              1 ;; the continuation consumes a single value
                                                              (list 0 1)
@@ -61,7 +61,7 @@
                           (make-Const 0))
        
     ;; Finally, do a tail call into f.
-    (make-AssignImmediateStatement 'argcount (make-Const 1))
+    (make-AssignImmediate 'argcount (make-Const 1))
     (compile-general-procedure-call '()
                                     (make-Const 1) ;; the stack at this point holds a single argument
                                     'val
@@ -70,13 +70,13 @@
     ;; The code for the continuation code follows.  It's supposed to
     ;; abandon the current continuation, initialize the control and environment, and then jump.
     call/cc-closure-entry
-    (make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
-    (make-PerformStatement (make-InstallClosureValues!))
-    (make-PerformStatement (make-RestoreControl! default-continuation-prompt-tag))
-    (make-PerformStatement (make-RestoreEnvironment!))
-    (make-AssignImmediateStatement 'proc (make-ControlStackLabel))
+    (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
+    (make-Perform (make-InstallClosureValues! 2))
+    (make-Perform (make-RestoreControl! default-continuation-prompt-tag))
+    (make-Perform (make-RestoreEnvironment!))
+    (make-AssignImmediate 'proc (make-ControlStackLabel))
     (make-PopControlFrame)
-    (make-GotoStatement (make-Reg 'proc)))))
+    (make-Goto (make-Reg 'proc)))))
 
 
 
@@ -264,11 +264,11 @@
    (let ([after-call/cc-code (make-label 'afterCallCCImplementation)])
      (append 
 
-      `(,(make-AssignPrimOpStatement (make-PrimitivesReference 'call/cc) 
+      `(,(make-AssignPrimOp (make-PrimitivesReference 'call/cc) 
                                      (make-MakeCompiledProcedure call/cc-label 1 '() 'call/cc))
-        ,(make-AssignPrimOpStatement (make-PrimitivesReference 'call-with-current-continuation) 
+        ,(make-AssignPrimOp (make-PrimitivesReference 'call-with-current-continuation) 
                                      (make-MakeCompiledProcedure call/cc-label 1 '() 'call/cc))
-        ,(make-GotoStatement (make-Label after-call/cc-code)))
+        ,(make-Goto (make-Label after-call/cc-code)))
       (make-call/cc-code)
       `(,after-call/cc-code)))
    
@@ -281,35 +281,35 @@
          [values-entry (make-label 'valuesEntry)]
          [on-zero-values (make-label 'onZeroValues)]
          [on-single-value (make-label 'onSingleValue)])
-     `(,(make-GotoStatement (make-Label after-values-body-defn))
+     `(,(make-Goto (make-Label after-values-body-defn))
        ,values-entry
-       ,(make-TestAndJumpStatement (make-TestOne (make-Reg 'argcount)) on-single-value)
-       ,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) on-zero-values)
+       ,(make-TestAndJump (make-TestOne (make-Reg 'argcount)) on-single-value)
+       ,(make-TestAndJump (make-TestZero (make-Reg 'argcount)) on-zero-values)
 
        ;; Common case: we're running multiple values.  Put the first in the val register
        ;; and go to the multiple value return.
-       ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
+       ,(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
        ,(make-PopEnvironment (make-Const 1) (make-Const 0))
-       ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
+       ,(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn))
        ,(make-PopControlFrame)
-       ,(make-GotoStatement (make-Reg 'proc))
+       ,(make-Goto (make-Reg 'proc))
 
        ;; Special case: on a single value, just use the regular return address
        ,on-single-value
-       ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
+       ,(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
        ,(make-PopEnvironment (make-Const 1) (make-Const 0))
-       ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
+       ,(make-AssignImmediate 'proc (make-ControlStackLabel))
        ,(make-PopControlFrame)
-       ,(make-GotoStatement (make-Reg 'proc))
+       ,(make-Goto (make-Reg 'proc))
 
        ;; On zero values, leave things be and just return.
        ,on-zero-values
-       ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
+       ,(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn))
        ,(make-PopControlFrame)
-       ,(make-GotoStatement (make-Reg 'proc))
+       ,(make-Goto (make-Reg 'proc))
        
        ,after-values-body-defn
-       ,(make-AssignPrimOpStatement (make-PrimitivesReference 'values)
+       ,(make-AssignPrimOp (make-PrimitivesReference 'values)
                                     (make-MakeCompiledProcedure values-entry
                                                                 (make-ArityAtLeast 0) 
                                                                 '() 
@@ -321,17 +321,17 @@
    ;; As is apply:
    (let ([after-apply-code (make-label 'afterApplyCode)]
          [apply-entry (make-label 'applyEntry)])
-     `(,(make-GotoStatement (make-Label after-apply-code))
+     `(,(make-Goto (make-Label after-apply-code))
        ,apply-entry
        
        ;; Push the procedure into proc.
-       ,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
+       ,(make-AssignImmediate 'proc (make-EnvLexicalReference 0 #f))
        ,(make-PopEnvironment (make-Const 1) (make-Const 0))
        ;; Correct the number of arguments to be passed.
-       ,(make-AssignImmediateStatement 'argcount (make-SubtractArg (make-Reg 'argcount)
+       ,(make-AssignImmediate 'argcount (make-SubtractArg (make-Reg 'argcount)
                                                                    (make-Const 1)))
        ;; Splice in the list argument.
-       ,(make-PerformStatement (make-SpliceListIntoStack! (make-SubtractArg (make-Reg 'argcount)
+       ,(make-Perform (make-SpliceListIntoStack! (make-SubtractArg (make-Reg 'argcount)
                                                                             (make-Const 1))))
        
        ;; Finally, jump into the procedure body
@@ -342,5 +342,5 @@
        
        
        ,after-apply-code
-       ,(make-AssignPrimOpStatement (make-PrimitivesReference 'apply)
+       ,(make-AssignPrimOp (make-PrimitivesReference 'apply)
                                     (make-MakeCompiledProcedure apply-entry (make-ArityAtLeast 2) '() 'apply))))))

whalesong/compiler/compiler-structs.rkt

@@ -1,4 +1,6 @@
 #lang typed/racket/base
+(require "expression-structs.rkt"
+         "analyzer-structs.rkt")
 
 
 (provide (all-defined-out))
@@ -38,3 +40,8 @@
 (define-type Linkage (U NextLinkage
                         LabelLinkage
                         ReturnLinkage))
+
+
+;; Lambda and compile-time environment
+(define-struct: lam+cenv ([lam : (U Lam CaseLam)]
+                          [cenv : CompileTimeEnvironment]))

whalesong/compiler/expression-structs.rkt

@@ -0,0 +1,186 @@
+#lang typed/racket/base
+(require "lexical-structs.rkt")
+
+
+(provide (all-defined-out))
+
+
+;; Expressions
+(define-type Expression (U
+                         Top
+                         Constant 
+                         ToplevelRef
+                         LocalRef
+                         ToplevelSet
+                         Branch 
+                         Lam 
+                         CaseLam
+                         EmptyClosureReference
+                         Seq 
+                         Splice 
+                         Begin0
+                         App
+                         Let1 
+                         LetVoid 
+                         LetRec
+                         InstallValue
+                         BoxEnv
+                         WithContMark
+                         ApplyValues
+                         DefValues
+                         PrimitiveKernelValue
+                         Module
+                         VariableReference
+                         Require))
+
+
+(define-struct: Module ([name : Symbol]
+                        [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)
+
+(define-struct: Constant ([v : Any]) #:transparent)
+
+(define-struct: ToplevelRef ([depth : Natural]
+                             [pos : Natural]
+                             [constant? : Boolean]
+                             [check-defined? : Boolean]) #:transparent)
+
+(define-struct: LocalRef ([depth : Natural]
+                          [unbox? : Boolean]) #:transparent)
+
+(define-struct: ToplevelSet ([depth : Natural]
+                             [pos : Natural]
+                             [value : Expression]) #:transparent)
+
+(define-struct: Branch ([predicate : Expression]
+                        [consequent : Expression]
+                        [alternative : Expression]) #:transparent)
+
+(define-struct: CaseLam ([name : (U Symbol LamPositionalName)]
+                         [clauses : (Listof (U Lam EmptyClosureReference))]
+                         [entry-label : Symbol]) #:transparent)
+
+(define-struct: Lam ([name : (U Symbol LamPositionalName)]
+                     [num-parameters : Natural]
+                     [rest? : Boolean]
+                     [body : Expression]
+                     [closure-map : (Listof Natural)]
+                     [entry-label : Symbol]) #:transparent)
+
+;; An EmptyClosureReference has enough information to create the lambda value,
+;; assuming that the lambda's body has already been compiled.  The entry-label needs
+;; to have been shared with an existing Lam, and the closure must be empty.
+(define-struct: EmptyClosureReference ([name : (U Symbol LamPositionalName)]
+                                       [num-parameters : Natural]
+                                       [rest? : Boolean]
+                                       [entry-label : Symbol]) #:transparent)
+
+
+
+;; We may have more information about the lambda's name.  This will show it.
+(define-struct: LamPositionalName ([name : Symbol] 
+                                   [path : String]    ;; the source of the name
+                                   [line : Natural] 
+                                   [column : Natural] 
+                                   [offset : Natural] 
+                                   [span : Natural]) #:transparent)
+
+
+
+(define-struct: Seq ([actions : (Listof Expression)]) #:transparent)
+(define-struct: Splice ([actions : (Listof Expression)]) #:transparent)
+(define-struct: Begin0 ([actions : (Listof Expression)]) #:transparent)
+(define-struct: App ([operator : Expression]
+                     [operands : (Listof Expression)]) #:transparent)
+
+(define-struct: Let1 ([rhs : Expression]
+                      [body : Expression])  #:transparent)
+
+(define-struct: LetVoid ([count : Natural]
+                         [body : Expression]
+                         [boxes? : Boolean]) #:transparent)
+
+
+;; During evaluation, the closures corresponding to procs are expected
+;; to be laid out so that stack position 0 corresponds to procs[0],
+;; stack position 1 to procs[1], and so on.
+(define-struct: LetRec ([procs : (Listof Lam)]
+                        [body : Expression]) #:transparent)
+
+(define-struct: InstallValue ([count : Natural] ;; how many values to install
+                              [depth : Natural] ;; how many slots to skip
+                              [body : Expression]
+                              [box? : Boolean])  #:transparent)
+
+
+(define-struct: BoxEnv ([depth : Natural]
+                        [body : Expression]) #:transparent)
+
+
+
+(define-struct: WithContMark ([key : Expression]
+                              [value : Expression]
+                              [body : Expression]) #:transparent)
+
+
+(define-struct: ApplyValues ([proc : Expression]
+                             [args-expr : Expression]) #:transparent)
+
+
+;; Multiple value definition
+(define-struct: DefValues ([ids : (Listof ToplevelRef)]
+                           [rhs : Expression]) #:transparent)
+
+
+
+(define-struct: PrimitiveKernelValue ([id : Symbol]) #:transparent)
+
+
+(define-struct: VariableReference ([toplevel : ToplevelRef]) #:transparent)
+
+
+(define-struct: Require ([path : ModuleLocator]) #:transparent)
+
+
+
+
+(: current-short-labels? (Parameterof Boolean))
+(define current-short-labels? (make-parameter #t))
+
+
+(define make-label-counter 0)
+
+(: reset-make-label-counter (-> Void))
+(define (reset-make-label-counter)
+  (set! make-label-counter 0))
+
+(: make-label (Symbol -> Symbol))
+#;(define make-label
+  (let ([n 0])
+    (lambda (l)
+      (set! n (add1 n))
+      (if (current-short-labels?)
+          (string->symbol (format "_~a" n))
+          (string->symbol (format "~a~a" l n))))))
+
+(define (make-label l)
+  (set! make-label-counter (+ make-label-counter 1))
+  (define n make-label-counter)
+  (if (current-short-labels?)
+      (string->symbol (format "_~a" n))
+      (string->symbol (format "~a~a" l n))))

whalesong/compiler/il-structs.rkt

@@ -35,10 +35,10 @@
                       CompiledProcedureEntry
                       CompiledProcedureClosureReference
                       ModuleEntry
-                      IsModuleInvoked
-		      IsModuleLinked
+                      ModulePredicate
                       PrimitiveKernelValue
-                      VariableReference))
+                      VariableReference
+                      ))
 
 
 ;; Targets: these are the allowable lhs's for a targetted assignment.
@@ -46,8 +46,12 @@
                        EnvLexicalReference
                        EnvPrefixReference
                        PrimitivesReference
+                       GlobalsReference
                        ControlFrameTemporary
-                       ModulePrefixTarget))
+                       ModulePrefixTarget
+                       ))
+
+(define-struct: ModuleVariableThing () #:transparent)
 
 
 ;; When we need to store a value temporarily in the top control frame, we can use this as a target.
@@ -63,6 +67,11 @@
 (define-struct: ModulePrefixTarget ([path : ModuleLocator])
   #:transparent)
 
+(define-struct: ModuleVariableReference ([name : Symbol]
+                                         [module-name : ModuleLocator])
+  #:transparent)
+
+
 
 (define-type const-value
   (Rec C
@@ -144,16 +153,17 @@
 (define-struct: PrimitivesReference ([name : Symbol])
   #:transparent)
 
+(define-struct: GlobalsReference ([name : Symbol])
+  #:transparent)
+
+
 ;; Produces the entry point of the module.
 (define-struct: ModuleEntry ([name : ModuleLocator])
   #:transparent)
 
-;; Produces true if the module has already been invoked
-(define-struct: IsModuleInvoked ([name : ModuleLocator])
-  #:transparent)
 
-;; Produces true if the module has been loaded into the machine
-(define-struct: IsModuleLinked ([name : ModuleLocator])
+(define-struct: ModulePredicate ([module-name : ModuleLocator]
+                                 [pred : (U 'invoked? 'linked?)])
   #:transparent)
 
 
@@ -162,10 +172,11 @@
 (define-type StraightLineStatement (U
                                     DebugPrint
                                     Comment
+                                    MarkEntryPoint
                                     
-                                    AssignImmediateStatement
-                                    AssignPrimOpStatement
-                                    PerformStatement
+                                    AssignImmediate
+                                    AssignPrimOp
+                                    Perform
                                     
                                     PopEnvironment
                                     PushEnvironment
@@ -176,7 +187,7 @@
                                     PushControlFrame/Prompt
                                     PopControlFrame))
 
-(define-type BranchingStatement (U GotoStatement TestAndJumpStatement))
+(define-type BranchingStatement (U Goto TestAndJump))
                                  
 
 ;; instruction sequences
@@ -201,10 +212,26 @@
   #:transparent)
 
 
-(define-struct: AssignImmediateStatement ([target : Target]
+;; Returns a pair of labels, the first being the mutiple-value-return
+;; label and the second its complementary single-value-return label.
+(: new-linked-labels (Symbol -> (Values Symbol LinkedLabel)))
+(define (new-linked-labels sym)
+  (define a-label-multiple (make-label (string->symbol (format "~aMultiple" sym))))
+  (define a-label (make-LinkedLabel (make-label sym) a-label-multiple))
+  (values a-label-multiple a-label))
+
+
+
+
+
+;; FIXME: it would be nice if I can reduce AssignImmediate and
+;; AssignPrimOp into a single Assign statement, but I run into major
+;; issues with Typed Racket taking minutes to compile.  So we're
+;; running into some kind of degenerate behavior.
+(define-struct: AssignImmediate ([target : Target]
                                  [value : OpArg])
   #:transparent)
-(define-struct: AssignPrimOpStatement ([target : Target]
+(define-struct: AssignPrimOp ([target : Target]
                               [op : PrimitiveOperator])
   #:transparent)
 
@@ -238,12 +265,12 @@
 (define-struct: PushControlFrame/Call ([label : LinkedLabel]) 
   #:transparent)
 
-(define-struct: PushControlFrame/Prompt ([tag : (U OpArg DefaultContinuationPromptTag)]
-                                         [label : LinkedLabel]
-                                         ;; TODO: add handler and arguments
-                                         )
+(define-struct: PushControlFrame/Prompt
+  ([tag : (U OpArg DefaultContinuationPromptTag)]
+   [label : LinkedLabel])
   #:transparent)
 
+
 (define-struct: DefaultContinuationPromptTag ()
   #:transparent)
 (define default-continuation-prompt-tag 
@@ -252,18 +279,18 @@
 
 
 
-(define-struct: GotoStatement ([target : (U Label 
+(define-struct: Goto ([target : (U Label 
                                             Reg
                                             ModuleEntry
                                             CompiledProcedureEntry)]) 
   #:transparent)
 
-(define-struct: PerformStatement ([op : PrimitiveCommand])
+(define-struct: Perform ([op : PrimitiveCommand])
   #:transparent)
 
 
 
-(define-struct: TestAndJumpStatement ([op : PrimitiveTest]
+(define-struct: TestAndJump ([op : PrimitiveTest]
                                       [label : Symbol])
   #:transparent)
 
@@ -272,15 +299,26 @@
   #:transparent)
 
 
+;; Marks the head of every lambda.
+(define-struct: MarkEntryPoint ([label : Symbol])
+  #:transparent)
+
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Primitive Operators
 
 ;; The operators that return values, that are used in AssignPrimopStatement.
+;; The reason this is here is really to get around what looks like a Typed Racket issue.
+;; I would prefer to move these all to OpArgs, but if I do, Typed Racket takes much longer
+;; to type my program than I'd like.
 (define-type PrimitiveOperator (U GetCompiledProcedureEntry
                                   MakeCompiledProcedure
                                   MakeCompiledProcedureShell
 
+                                  ModuleVariable
+                                  PrimitivesReference
+                                  GlobalsReference
                                   
                                   MakeBoxedEnvironmentValue
 
@@ -318,16 +356,14 @@
 
 (define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName/Inline]
 
-                                              [operands : (Listof OpArg)]
+                                              [operands : (Listof (U OpArg ModuleVariable))]
                                               [expected-operand-types : (Listof OperandDomain)]
                                               ;; For each operand, #t will add code to typecheck the operand
                                               [typechecks? : (Listof Boolean)])
   #:transparent)
 
 
-(define-struct: ApplyPrimitiveProcedure () #:transparent)
-
-
+(define-struct: ApplyPrimitiveProcedure ([name : Symbol]) #:transparent)
 
 
 (define-struct: MakeBoxedEnvironmentValue ([depth : Natural])
@@ -368,6 +404,12 @@
                                      [pos : Natural])
   #:transparent)
 
+;; Check that the global can be defined.
+;; If not, raise an error and stop evaluation.
+(define-struct: CheckGlobalBound! ([name : Symbol])
+  #:transparent)
+
+
 ;; Check the closure procedure value in 'proc and make sure it's a closure
 ;; that can accept the right arguments (stored as a number in the argcount register.).
 (define-struct: CheckClosureAndArity! ()
@@ -385,7 +427,7 @@
 
 ;; Adjusts the environment by pushing the values in the
 ;; closure (held in the proc register) into itself.
-(define-struct: InstallClosureValues! ()
+(define-struct: InstallClosureValues! ([n : Natural])
   #:transparent)
 
 
@@ -449,6 +491,12 @@
 (define-struct: InstallContinuationMarkEntry! () #:transparent)
 
 
+;; Use the dynamic module loader to link the module into the runtime.
+;; After successful linkage, jump into label.
+(define-struct: LinkModule! ([path : ModuleLocator]
+                             [label : Symbol]))
+
+
 ;; Installs a module record into the machine
 (define-struct: InstallModuleEntry! ([name : Symbol]
                                      [path : ModuleLocator]
@@ -468,13 +516,15 @@
 
 ;; Given the module locator, do any finalizing operations, like
 ;; setting up the module namespace.
-(define-struct: FinalizeModuleInvokation! ([path : ModuleLocator])
+(define-struct: FinalizeModuleInvokation! ([path : ModuleLocator]
+                                           [provides : (Listof ModuleProvide)])
   #:transparent)
 
 
 
 (define-type PrimitiveCommand (U                                
                                CheckToplevelBound!
+                               CheckGlobalBound!
                                CheckClosureAndArity!
                                CheckPrimitiveArity!
 
@@ -496,6 +546,7 @@
                                RestoreEnvironment!
                                RestoreControl!
                                
+                               LinkModule!
                                InstallModuleEntry!
                                MarkModuleInvoked!
                                AliasModuleAsMain!

whalesong/compiler/kernel-primitives.rkt

@@ -3,9 +3,67 @@
 (provide (all-defined-out))
 
 (require "arity-structs.rkt"
+         "lexical-structs.rkt"
          "../type-helpers.rkt")
+
+
+
+
+(: kernel-module-name? (ModuleLocator -> Boolean))
+;; Produces true if the module is hardcoded.
+(define (kernel-module-name? name)
+
+  
+  (: kernel-locator? (ModuleLocator -> Boolean))
+  (define (kernel-locator? locator)
+    (or (and (eq? (ModuleLocator-name locator) '#%kernel)
+             (eq? (ModuleLocator-real-path locator) '#%kernel))
+        (eq? (ModuleLocator-name locator)
+             'whalesong/lang/kernel.rkt)
+        
+        ;; HACK HACK HACK
+        ;; This is for srcloc:
+        (eq? (ModuleLocator-name locator)
+             'collects/racket/private/kernstruct.rkt)))
+
+
+  (: paramz-locator? (ModuleLocator -> Boolean))
+  (define (paramz-locator? locator)
+    (or (and (eq? (ModuleLocator-name locator) '#%paramz)
+             (eq? (ModuleLocator-real-path locator) '#%paramz))))
+
+
+  (: kernel-module-locator? (ModuleLocator -> Boolean))
+  ;; Produces true if the given module locator should be treated as a primitive root one
+  ;; that is implemented by us.
+  (define (kernel-module-locator? locator)
+    (or (kernel-locator? locator)
+        (paramz-locator? locator)))
+
+  
+  (kernel-module-locator? name))
+
+
+
+;; Given a kernel-labeled ModuleVariable, returns the kernel name for it.
+(: kernel-module-variable->primitive-name (ModuleVariable -> Symbol))
+(define (kernel-module-variable->primitive-name a-modvar)
+  ;; FIXME: remap if the module is something else like whalesong/unsafe/ops
+
+  (ModuleVariable-name a-modvar))
+
+
+
+
+
+
+
+
+
+
 (define-type OperandDomain (U 'number
                               'string
+                              'vector
                               'box
                               'list
                               'pair
@@ -18,6 +76,7 @@
                                     '-
                                     '*
                                     '/
+                                    'zero?
                                     'add1
                                     'sub1
 				    'abs
@@ -28,10 +87,39 @@
                                     '>=
                                     'cons
                                     'car
-				    'caar
                                     'cdr
+
+                                    
+                                    'caar
+                                    'cdar
                                     'cadr
+                                    'cddr
+                                    'caaar
+                                    'cdaar
+                                    'cadar
+                                    'cddar
+                                    'caadr
+                                    'cdadr
                                     'caddr
+                                    'cdddr
+                                    'caaaar
+                                    'cdaaar
+                                    'cadaar
+                                    'cddaar
+                                    'caadar
+                                    'cdadar
+                                    'caddar
+                                    'cdddar
+                                    'caaadr
+                                    'cdaadr
+                                    'cadadr
+                                    'cddadr
+                                    'caaddr
+                                    'cdaddr
+                                    'cadddr
+                                    'cddddr
+
+                                    
 				    'list
                                     'list?
                                     'list*
@@ -44,6 +132,9 @@
                                     'make-vector
                                     'equal?
                                     'member
+                                    'memq
+                                    'memv
+                                    'memf
                                     'append
                                     'reverse
                                     'length
@@ -86,8 +177,22 @@
 
 				    'error
                                     'raise-type-error
+                                    'raise-mismatch-error
                                     'struct:exn:fail
                                     'prop:exn:srclocs
+                                    'make-exn
+                                    'make-exn:fail
+                                    'make-exn:fail:contract
+                                    'make-exn:fail:contract:arity
+                                    'make-exn:fail:contract:variable
+                                    'make-exn:fail:contract:divide-by-zero
+
+                                    'exn:fail?
+                                    'exn:fail:contract?
+                                    'exn:fail:contract:arity?
+                                    
+                                    'exn-message
+                                    'exn-continuation-marks
 
                                     'hash?
                                     'hash-equal?
@@ -115,6 +220,13 @@
                                     'hash-values
                                     
                                     'string-copy
+
+                                    'unsafe-car
+                                    'unsafe-cdr
+
+                                    'continuation-prompt-available?
+                                    'abort-current-continuation
+                                    'call-with-continuation-prompt
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
 
@@ -124,6 +236,7 @@
                                            '-
                                            '*
                                            '/
+                                           'zero?
                                            'add1
                                            'sub1
                                            '<
@@ -141,6 +254,8 @@
                                            'null?
                                            'not
                                            'eq?
+                                           'vector-ref
+                                           'vector-set!
                                            ))
 
 (ensure-type-subsetof KernelPrimitiveName/Inline KernelPrimitiveName)
@@ -175,6 +290,12 @@
            [else
             (make-IncorrectArity (make-ArityAtLeast 1))])]
 
+    [(eq? prim 'zero?)
+     (cond [(= arity 1)
+            (list 'number)]
+           [else
+            (make-IncorrectArity (make-ArityAtLeast 1))])]
+
     [(eq? prim 'add1)
      (cond [(= arity 1)
             (list 'number)]
@@ -245,4 +366,10 @@
      (list 'any)]
 
     [(eq? prim 'eq?)
-     (list 'any 'any)]))
+     (list 'any 'any)]
+
+    [(eq? prim 'vector-ref)
+     (list 'vector 'number)]
+
+    [(eq? prim 'vector-set!)
+     (list 'vector 'number 'any)]))

whalesong/compiler/lexical-env.rkt

@@ -48,11 +48,11 @@
                                  (let: ([n : (U False Symbol GlobalBucket ModuleVariable) (first names)])
                                        (cond
                                          [(and (symbol? n) (eq? name n))
-                                          (make-EnvPrefixReference depth pos)]
+                                          (make-EnvPrefixReference depth pos #f)]
                                          [(and (ModuleVariable? n) (eq? name (ModuleVariable-name n)))
-                                          (make-EnvPrefixReference depth pos)]
+                                          (make-EnvPrefixReference depth pos #t)]
                                          [(and (GlobalBucket? n) (eq? name (GlobalBucket-name n)))
-                                          (make-EnvPrefixReference depth pos)]
+                                          (make-EnvPrefixReference depth pos #f)]
                                          [else
                                           (prefix-loop (rest names) (add1 pos))]))]))]
                    
@@ -122,8 +122,8 @@
 ;; Given a list of lexical addresses, computes a set of unique references.
 ;; Multiple lexical addresses to a single prefix should be treated identically.
 (define (collect-lexical-references addresses)
-  (let: ([prefix-references : (Setof EnvWholePrefixReference) (new-set)]
-         [lexical-references : (Setof EnvLexicalReference) (new-set)])
+  (let: ([prefix-references : (Setof EnvWholePrefixReference) ((inst new-set EnvWholePrefixReference))]
+         [lexical-references : (Setof EnvLexicalReference) ((inst new-set EnvLexicalReference))])
         (let: loop : (Listof (U EnvLexicalReference EnvWholePrefixReference)) 
               ([addresses : (Listof LexicalAddress) addresses])
               (cond 
@@ -218,7 +218,8 @@
                                (EnvLexicalReference-unbox? target))]
     [(EnvPrefixReference? target)
      (make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
-                              (EnvPrefixReference-pos target))]
+                              (EnvPrefixReference-pos target)
+                              (EnvPrefixReference-modvar? target))]
     [(EnvWholePrefixReference? target)
      (make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))]))
 

whalesong/compiler/lexical-structs.rkt

@@ -53,7 +53,8 @@
   #:transparent)
 
 (define-struct: EnvPrefixReference ([depth : Natural]
-                                    [pos : Natural])
+                                    [pos : Natural]
+                                    [modvar? : Boolean])
   #:transparent)
 
 (define-struct: EnvWholePrefixReference ([depth : Natural])

whalesong/compiler/optimize-il.rkt

@@ -50,8 +50,8 @@
          
          ;; If there's a label, immediately followed by a direct Goto jump,
          ;; just equate the label and the jump.
-         [(and (symbol? last-stmt) (GotoStatement? next-stmt))
-          (define goto-target (GotoStatement-target next-stmt))
+         [(and (symbol? last-stmt) (Goto? next-stmt))
+          (define goto-target (Goto-target next-stmt))
           (cond
             [(Label? goto-target)
              (log-debug (format "merging label ~a and ~a" last-stmt (Label-name goto-target)))
@@ -102,9 +102,7 @@
         oparg]
        [(ModuleEntry? oparg)
         oparg]
-       [(IsModuleInvoked? oparg)
-        oparg]
-       [(IsModuleLinked? oparg)
+       [(ModulePredicate? oparg)
         oparg]
        [(PrimitiveKernelValue? oparg)
         oparg]
@@ -142,6 +140,15 @@
         op]
        
        [(ApplyPrimitiveProcedure? op)
+        op]
+
+       [(ModuleVariable? op)
+        op]
+       
+       [(PrimitivesReference? op)
+        op]
+       
+       [(GlobalsReference? op)
         op]))
 
 
@@ -183,27 +190,30 @@
                 (loop (rest stmts)))]
          
          [(DebugPrint? a-stmt)
-          ;(cons a-stmt (loop (rest stmts)))
-          (loop (rest stmts))
+          (cons a-stmt (loop (rest stmts)))
+          #;(loop (rest stmts))
           ]
 
          [(Comment? a-stmt)
-          (loop (rest stmts))
-          ;(cons a-stmt (loop (rest stmts)))
+          ;(loop (rest stmts))
+          (cons a-stmt (loop (rest stmts)))
           ]
 
-         [(AssignImmediateStatement? a-stmt)
-          (cons (make-AssignImmediateStatement (rewrite-target (AssignImmediateStatement-target a-stmt))
-                                               (rewrite-oparg (AssignImmediateStatement-value a-stmt)))
+         [(MarkEntryPoint? a-stmt)
+          (cons a-stmt (loop (rest stmts)))]
+         
+         [(AssignImmediate? a-stmt)
+          (cons (make-AssignImmediate (rewrite-target (AssignImmediate-target a-stmt))
+                                               (rewrite-oparg (AssignImmediate-value a-stmt)))
                 (loop (rest stmts)))]
 
-         [(AssignPrimOpStatement? a-stmt)
-          (cons (make-AssignPrimOpStatement (rewrite-target (AssignPrimOpStatement-target a-stmt))
-                                            (rewrite-primop (AssignPrimOpStatement-op a-stmt)))
+         [(AssignPrimOp? a-stmt)
+          (cons (make-AssignPrimOp (rewrite-target (AssignPrimOp-target a-stmt))
+                                            (rewrite-primop (AssignPrimOp-op a-stmt)))
                 (loop (rest stmts)))]
 
-         [(PerformStatement? a-stmt)
-          (cons (make-PerformStatement (rewrite-primcmd (PerformStatement-op a-stmt)))
+         [(Perform? a-stmt)
+          (cons (make-Perform (rewrite-primcmd (Perform-op a-stmt)))
                 (loop (rest stmts)))]
          
          [(PopEnvironment? a-stmt)
@@ -242,19 +252,19 @@
          [(PopControlFrame? a-stmt)
           (cons a-stmt (loop (rest stmts)))]
 
-         [(GotoStatement? a-stmt)
-          (define target (GotoStatement-target a-stmt))
+         [(Goto? a-stmt)
+          (define target (Goto-target a-stmt))
           (cond
            [(Label? target)
-            (cons (make-GotoStatement (make-Label (ref (Label-name target))))
+            (cons (make-Goto (make-Label (ref (Label-name target))))
                   (loop (rest stmts)))]
            [else
             (cons a-stmt (loop (rest stmts)))])]
 
 
-         [(TestAndJumpStatement? a-stmt)
-          (cons (make-TestAndJumpStatement (rewrite-primtest (TestAndJumpStatement-op a-stmt))
-                                           (ref (TestAndJumpStatement-label a-stmt)))
+         [(TestAndJump? a-stmt)
+          (cons (make-TestAndJump (rewrite-primtest (TestAndJump-op a-stmt))
+                                           (ref (TestAndJump-label a-stmt)))
                 (loop (rest stmts)))])]))]))
     
 
@@ -283,13 +293,13 @@
                ;; instruction.
                [(and (PushEnvironment? first-stmt)
                      (equal? first-stmt (make-PushEnvironment 1 #f))
-                     (AssignImmediateStatement? second-stmt))
-                (let ([target (AssignImmediateStatement-target second-stmt)])
+                     (AssignImmediate? second-stmt))
+                (let ([target (AssignImmediate-target second-stmt)])
                   (cond
                    [(equal? target (make-EnvLexicalReference 0 #f))
                     (loop (cons (make-PushImmediateOntoEnvironment 
                                  (adjust-oparg-depth 
-                                  (AssignImmediateStatement-value second-stmt) -1)
+                                  (AssignImmediate-value second-stmt) -1)
                                  #f)
                                 (rest (rest statements))))]
                    [else
@@ -339,23 +349,26 @@
      #f]
     
     [(DebugPrint? stmt)
-     ;#f
-     #t]
+     #f
+     #;#t]
     
-    [(AssignImmediateStatement? stmt)
-     (equal? (AssignImmediateStatement-target stmt)
-             (AssignImmediateStatement-value stmt))]
-
-    [(AssignPrimOpStatement? stmt)
+    [(MarkEntryPoint? stmt)
      #f]
     
-    [(PerformStatement? stmt)
+    [(AssignImmediate? stmt)
+     (equal? (AssignImmediate-target stmt)
+             (AssignImmediate-value stmt))]
+
+    [(AssignPrimOp? stmt)
      #f]
     
-    [(GotoStatement? stmt)
+    [(Perform? stmt)
      #f]
     
-    [(TestAndJumpStatement? stmt)
+    [(Goto? stmt)
+     #f]
+    
+    [(TestAndJump? stmt)
      #f]
     
     [(PopEnvironment? stmt)
@@ -381,7 +394,7 @@
     [(PopControlFrame? stmt)
      #f]
     [(Comment? stmt)
-     #t]))
+     #f]))
 
 
 
@@ -399,7 +412,8 @@
                                (EnvLexicalReference-unbox? oparg))]
     [(EnvPrefixReference? oparg)
      (make-EnvPrefixReference (ensure-natural (+ n (EnvPrefixReference-depth oparg)))
-                              (EnvPrefixReference-pos oparg))]
+                              (EnvPrefixReference-pos oparg)
+                              (EnvPrefixReference-modvar? oparg))]
     [(EnvWholePrefixReference? oparg)
      (make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth oparg))))]
     [(SubtractArg? oparg)
@@ -421,9 +435,7 @@
      oparg]
     [(ModuleEntry? oparg)
      oparg]
-    [(IsModuleInvoked? oparg)
-     oparg]
-    [(IsModuleLinked? oparg)
+    [(ModulePredicate? oparg)
      oparg]
     [(VariableReference? oparg)
      (let ([t (VariableReference-toplevel oparg)])

whalesong/cs019/lists.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong/base
+#lang whalesong/base
 #|
 Why on earth are these here?
 Because first, etc. don't work on cyclic lists:

whalesong/cs019/teach.rkt

@@ -3,11 +3,29 @@
 (require (for-template "../lang/base.rkt")
          (for-template "teach-runtime.rkt")
          "teachhelp.rkt"
-         stepper/private/shared
          racket/list
          syntax/context
          syntax/kerncase
-         syntax/stx)
+         syntax/stx
+         "../version-case/version-case.rkt"
+         (for-syntax racket/base))
+
+  ;; We're treading in private implementation; we deserve this pain.
+  (version-case
+    [(and (version<= "5.2.0.900" (version))
+          (version< (version) "5.2.900"))
+     (begin
+       (require stepper/private/shared)
+       (require (for-syntax stepper/private/shared)))]
+    [(version<= "5.2.900" (version))
+     (begin
+       (require stepper/private/syntax-property)
+       (require (for-syntax stepper/private/syntax-property)))]
+    [else
+     (error 'teachhelp.rkt "Unable to cooperate with Racket ~a" (version))])
+
+
+
 
 
 (provide advanced-define/proc

whalesong/cs019/teachhelp.rkt

@@ -1,9 +1,22 @@
 (module teachhelp mzscheme
   (require "firstorder.rkt"
            "rewrite-error-message.rkt"
-           stepper/private/shared)
+           "../version-case/version-case.rkt")
+
+  ;; We're treading in private implementation; we deserve this pain.
+  (version-case
+    [(and (version<= "5.2.0.900" (version))
+          (version< (version) "5.2.900"))
+     (begin
+       (require stepper/private/shared)
+       (require-for-syntax stepper/private/shared))]
+    [(version<= "5.2.900" (version))
+     (begin
+       (require stepper/private/syntax-property)
+       (require-for-syntax stepper/private/syntax-property))]
+    [else
+     (error 'teachhelp.rkt "Unable to cooperate with Racket ~a" (version))])
 
-  (require-for-syntax stepper/private/shared)
   
   (provide make-undefined-check
            make-first-order-function)

whalesong/examples/alert.rkt

@@ -0,0 +1,3 @@
+#lang whalesong
+(require whalesong/js)
+(alert "hello world")

whalesong/examples/cs019/hello.rkt

@@ -0,0 +1,2 @@
+#lang whalesong/cs019
+"hello world"

whalesong/examples/cs019/tick-tock/tick-tock.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong/cs019
+#lang whalesong/cs019
 
 (define-resource index.html)
 

whalesong/examples/cs019/where-am-i/where-am-i.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong/cs019
+#lang whalesong/cs019
 
 (define-resource index.html)
 

whalesong/examples/dom-play.rkt

@@ -1,6 +1,6 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/js))
+(require whalesong/js)
 
 
 ;; insert-break: -> void

whalesong/examples/drag-and-drop/drag-and-drop-1.rkt

@@ -0,0 +1,59 @@
+#lang whalesong
+
+(require whalesong/web-world
+         whalesong/resource)
+
+(define-resource view.html)
+(define-resource style.css)
+
+;; A small drag-and-drop example using the web-world library.
+;;
+;; The world consists of a set of shapes.
+;;
+;; A shape has an id and a position.
+(define-struct shape (id x y))
+
+
+
+;; add-fresh-shape: world view -> world
+;; Given a world, creates a new world within the boundaries of the playground.
+(define (add-fresh-shape w v)
+  (define-values (max-width max-height) (width-and-height v "playground"))
+  (define new-world (cons (make-shape (fresh-id)
+                                      (random max-width)
+                                      (random max-height))
+                          w))
+  new-world)
+
+
+
+(define (width-and-height v element-id)
+  (define focused (view-focus v element-id))
+  (values (view-width focused)
+          (view-height focused)))
+
+
+(define (draw w v)
+  (foldl (lambda (a-shape v)
+           (cond
+            [(view-focus? v (shape-id a-shape))
+             v]
+            [else
+             (view-append-child v
+                                (xexp->dom `(span (@ (class "shape")
+                                                     (id ,(shape-id a-shape))
+                                                     (style ,(format "position: absolute; left: ~apx; top: ~apx"
+                                                                     (shape-x a-shape)
+                                                                     (shape-y a-shape))))
+                                                  "shape")))]))
+         (view-focus v "playground")
+         w))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define the-view (view-bind-many view.html
+                                 ["add" "click" add-fresh-shape]))
+
+(big-bang (list)
+          (initial-view the-view)
+          (to-draw draw))

whalesong/examples/drag-and-drop/drag-and-drop-2.rkt

@@ -0,0 +1,128 @@
+#lang whalesong
+
+(require whalesong/web-world
+         whalesong/resource)
+
+(define-resource view.html)
+(define-resource style.css)
+
+;; A small drag-and-drop example using the web-world library.
+;;
+;; The world consists of a set of shapes.  It also has a reference
+;; to the currently dragged shape, if one is being dragged.
+(define-struct world (shapes  ;; (listof shape)
+                      dragged ;; (U shape #f)
+                      ))
+
+;; A shape has an id and a position.
+(define-struct shape (id x y))
+
+
+
+;; add-fresh-shape: world view -> world
+;; Given a world, creates a new world within the boundaries of the playground.
+(define (add-fresh-shape w v)
+  (define-values (max-width max-height) (width-and-height v "playground"))
+  (define new-world (make-world (cons (make-shape (fresh-id)
+                                                  (random max-width)
+                                                  (random max-height))
+                                      (world-shapes w))
+                                (world-dragged w)))
+  new-world)
+
+
+;; Helper: produces the width and height of the element with the given id.
+(define (width-and-height v element-id)
+  (define focused (view-focus v element-id))
+  (values (view-width focused)
+          (view-height focused)))
+
+
+(define (draw w v)
+  (foldl (lambda (a-shape v)
+           (cond
+            [(view-focus? v (shape-id a-shape))
+             (define focused (view-focus v (shape-id a-shape)))
+             (update-view-css (update-view-css focused "left" (format "~apx" (shape-x a-shape)))
+                              "top"
+                              (format "~apx" (shape-y a-shape)))]
+            [else
+             (view-bind-many
+              (view-append-child v
+                                 (xexp->dom `(span (@ (class "shape")
+                                                      (id ,(shape-id a-shape))
+                                                      (style ,(format "position: absolute; left: ~apx; top: ~apx"
+                                                                      (shape-x a-shape)
+                                                                      (shape-y a-shape))))
+                                                   "shape")))
+              [(shape-id a-shape) "mousedown" mousedown])]))
+         (view-focus v "playground")
+         (if (shape? (world-dragged w))
+             (cons (world-dragged w) (world-shapes w))
+             (world-shapes w))))
+
+
+;; find-shape: (listof shape) string -> (U #f shape)
+(define (find-shape los id)
+  (cond
+   [(empty? los)
+    #f]
+   [(string=? (shape-id (first los)) id)
+    (first los)]
+   [else
+    (find-shape (rest los) id)]))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mouse handling.
+
+;; When the mouse is down, select the shape being clicked.
+;; The shape being mousedowned is the one with focus.
+(define (mousedown w v evt)
+  (define selected-shape (find-shape (world-shapes w) (view-id v)))
+  (make-world (remove selected-shape (world-shapes w))
+              selected-shape))
+
+
+
+(define (mouseup w v evt)
+  (cond [(shape? (world-dragged w))
+         (make-world (cons (world-dragged w)
+                           (world-shapes w))
+                     #f)]
+        [else
+         w]))
+
+(define (mousemove w v evt)
+  (cond
+   [(shape? (world-dragged w))
+    (define-values (left top) (normalize-mouse-event-coordinates v evt))
+    (make-world (world-shapes w)
+                (make-shape (shape-id (world-dragged w))
+                            left
+                            top))]
+   [else
+    w]))
+
+(define (normalize-mouse-event-coordinates v evt)
+  (values (- (event-ref evt "pageX")
+             (string->number (trim-px (view-css v "left"))))
+          (- (event-ref evt "pageY")
+             (string->number (trim-px (view-css v "top"))))))
+
+(define (trim-px s)
+  (substring s 0 (- (string-length s) 2)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define the-view (view-bind-many view.html
+                                 ["add" "click" add-fresh-shape]
+                                 ["playground" "mousemove" mousemove]
+                                 ["playground" "mouseup" mouseup]))
+
+(big-bang (make-world (list) #f)
+          (initial-view the-view)
+          (to-draw draw))

whalesong/examples/drag-and-drop/style.css

@@ -0,0 +1,16 @@
+
+#playground {
+    background-color: lightgray;
+    border: 1px solid black;
+    width: 500px;
+    height: 500px;
+    display: block;
+    position: relative;
+}
+
+
+.shape {
+    position: relative;
+    background-color: orange;
+    border: 1px solid black;
+}

whalesong/examples/drag-and-drop/view.html

@@ -0,0 +1,16 @@
+<!DOCTYPE html>
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css"/>
+</head>
+<body>
+<h1>Drag and drop example</h1>
+
+<div id="playground">
+This is the playground.
+</div>
+
+<input type="button" id="add" value="Add"/>
+
+</body>
+</html>

whalesong/examples/eli-number-puzzle.rkt

@@ -1,10 +1,10 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
 ;; Eli's puzzle
 ;;
 ;;    http://lists.racket-lang.org/users/archive/2011-July/046849.html
 
-(require (planet dyoo/whalesong/world))
+(require whalesong/world)
           
 (define-struct world (seq output))
 

whalesong/examples/expanding-circle.rkt

@@ -1,7 +1,7 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/world)
-         (planet dyoo/whalesong/image))
+(require whalesong/world
+         whalesong/image)
 
 
 (define handler (on-tick add1 1))

whalesong/examples/fact.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 (provide fact)
 (define (fact x)
   (cond

whalesong/examples/google-maps/maps.rkt

@@ -0,0 +1,127 @@
+#lang whalesong
+
+;; A simple binding to Google Maps.
+;;
+;; Some of this comes from:
+;;
+;;     https://developers.google.com/maps/documentation/javascript/tutorial
+;; 
+
+(require whalesong/js
+         whalesong/js/world)
+
+(provide initialize-google-maps-api!
+         make-dom-and-map
+         make-on-map-click)
+
+
+
+;; initialize-google-maps-api!: string boolean -> void
+;; Dynamically loads the Google Maps API.
+(define raw-initialize-google-maps-api!
+  (js-async-function->procedure
+   #<<EOF
+function(success, fail, key, sensor) {
+    var callbackName = 'afterGoogleMapsInitialized' + plt.runtime.makeRandomNonce();
+    window[callbackName] = function() {
+        delete(window[callbackName]);
+        // At this point, we know the API has been instantiated ok.
+        success(plt.runtime.VOID);
+    };
+
+    var script = document.createElement("script");
+    script.type = "text/javascript";
+    script.src = "http://maps.googleapis.com/maps/api/js?key="
+         + encodeURIComponent(key) + "&sensor=" + (sensor ? 'true' : 'false')
+         + "&callback=" + encodeURIComponent(callbackName);
+    document.body.appendChild(script);
+}
+EOF
+))
+
+
+;; raw-make-map-dom-and-map: js-number js-number -> (values dom-node gmap-object)
+;; Dynamically creates both a dom-node and a gmap object.
+(define raw-make-map-dom-and-map
+  (js-async-function->procedure
+   #<<EOF
+function(success, fail, lat, lng) {
+    var myOptions = {
+         center: new google.maps.LatLng(lat, lng),
+         zoom: 8,
+         mapTypeId: google.maps.MapTypeId.ROADMAP
+    };
+    var domElement = document.createElement('div');
+    domElement.style.width = "100%";
+    domElement.style.height = "200px";
+    var map = new google.maps.Map(domElement, myOptions);
+    success(domElement, map);
+}
+EOF
+))
+
+;; We can listen to certain events, like click.
+;; https://developers.google.com/maps/documentation/javascript/events
+(define (raw-make-on-map-click a-gmap)
+  ;; setup will add a listener associated to the given map.
+  (define raw-setup
+    (js-function->procedure #<<EOF
+function(map, callback) {
+    var mapsListener =
+        google.maps.event.addListener(map, 'click', function(event) {
+            callback(plt.runtime.makeFloat(event.latLng.lat()),
+                     plt.runtime.makeFloat(event.latLng.lng()));
+        });
+   return mapsListener;
+}
+EOF
+))
+  ;; shutdown will remove the listener off the map.
+  (define raw-shutdown
+    (js-function->procedure #<<EOF
+function(gmap, mapsListener) {
+    google.maps.event.removeListener(gmap, mapsListener);
+}
+EOF
+
+))
+  (define (setup callback)
+    (raw-setup a-gmap callback))
+
+  (define (shutdown setup-data)
+    (raw-shutdown a-gmap setup-data))
+  
+  (make-world-event-handler setup shutdown))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (initialize-google-maps-api! key sensor)
+  (unless (string? key)
+    (raise-type-error 'initialize-google-maps-api! "string" 0 key))
+  (unless (boolean? sensor)
+    (raise-type-error 'initialize-google-maps-api! "boolean" 1 sensor))
+  (raw-initialize-google-maps-api! key sensor))
+
+
+;; make-dom-and-map: number number -> (values dom-node gmap-object)
+;; Given a latitude and longitude, creates a dom node that presents a
+;; Google Map, along with the gmap-object that carries its map state.
+;; TODO: We may want to provide a higher-level abstraction that
+;; encapsulates the two into a structured value.
+(define (make-dom-and-map lat lng)
+  (unless (real? lat)
+    (raise-type-error 'make-dom-and-map "real" 0 lat))
+  (unless (real? lng)
+    (raise-type-error 'make-dom-and-map "real" 1 lng))
+  (raw-make-map-dom-and-map (number->js-number lat)
+                            (number->js-number lng)))
+
+
+;; make-on-map-click: gmap-object -> world-handler
+;; TODO: We may want to provide a higher-level abstraction that
+;; encapsulates the two into a structured value.
+(define make-on-map-click raw-make-on-map-click)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

whalesong/examples/google-maps/test-maps.rkt

@@ -0,0 +1,40 @@
+#lang whalesong
+(require whalesong/web-world
+         "maps.rkt")
+
+;; Note: this is dyoo's API key.  Please don't abuse this.  :)
+(initialize-google-maps-api! "AIzaSyCRKQNI_nbyyN1286cssEy3taKj5IZcHN8" #f)
+
+
+;; We dynamically create a dom node for the presentation of the map,
+;; and an auxiliary gmap value that we use to manage the internal
+;; state of the map.
+(define-values (dom gmap)
+  (make-dom-and-map 41.82706261971936 -71.39962630844116))
+
+
+;; on-map-click: world handler
+;; Creates an on-map-click associated to the gmap, ready to be used in
+;; a big bang.
+;; It'll be used as an input device for our world program.
+(define on-map-click (make-on-map-click gmap))
+
+
+
+(xexp->dom '(h1 "Google Maps demonstration"))
+
+(big-bang "???"
+          (initial-view
+           (xexp->dom
+            `(div (p (@ (id "where"))
+                     "<<fill me in>>")
+                  (hr)
+                  ,dom
+                  (hr)
+                  (p "Instructions: click the map.  The "
+                     "world program will follow the map clicks."))))
+          (to-draw (lambda (w v)
+                     (update-view-text (view-focus v "where")
+                                       (format "~a" w))))
+          (on-map-click (lambda (w v lat lng)
+                          (list lat lng))))

whalesong/examples/hello-bf.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong/bf
+#lang whalesong/bf
 
 +++++ +++++             initialize counter (cell #0) to 10
 [                       use loop to set the next four cells to 70/100/30/10

whalesong/examples/hello-css.rkt

@@ -1,6 +1,6 @@
-#lang planet dyoo/whalesong/base
-(require (planet dyoo/whalesong/web-world)
-         (planet dyoo/whalesong/resource))
+#lang whalesong/base
+(require whalesong/web-world
+         whalesong/resource)
 
 (define-resource hello-css.css)
 (define-resource hello-css-main.html)

whalesong/examples/hello-kr.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong/korean
+#lang whalesong/korean
 
 
 (정의 (안녕 이름)

whalesong/examples/hello.rkt

@@ -0,0 +1,4 @@
+#lang whalesong
+
+(display "hello world")
+(newline)

whalesong/examples/image-library-example.rkt

@@ -1,6 +1,6 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/image))
+(require whalesong/image)
 
 (printf "images.rkt\n")
 

whalesong/examples/iron-puzzle/iron-puzzle.rkt

@@ -0,0 +1,66 @@
+#lang whalesong/base
+(require whalesong/resource
+         whalesong/image)
+
+;; The Iron Image Puzzle
+;; Part of the Nifty Assignments page by Nick Parlante.
+;; http://nifty.stanford.edu/2011/parlante-image-puzzle/
+
+;; To run this program locally on your machine under Google Chrome, you'll
+;; probably need to use --allow-file-access-from-files to get around
+;; the same-origin policy.  The program should run normally if served on
+;; a web server.
+
+(define-resource iron-puzzle.png)
+
+ 
+;; First, grab the image by its url.
+(define distorted-image iron-puzzle.png)
+
+
+distorted-image              
+(image-width distorted-image)
+(image-height distorted-image)
+
+;; We will want to decompose the image into its individual pixels.  We can use
+;; image->color-list to do this.
+;; To make experimenting with the pixels an easy thing to do, let?s write
+;; a function that will let us ?map? across the pixels of an image
+;; to get another image.
+(define (image-transform an-image a-pixel-transform)
+  (local [(define colors (image->color-list an-image))
+          (define new-colors (map a-pixel-transform colors))]
+    (color-list->image new-colors
+                       (image-width an-image)
+                       (image-height an-image)
+                       0
+                       0)))
+
+
+;; With image-transform in hand, we can apply a filter,
+;; such as zeroing out the blue and green components like this:
+(define (zero-blue-green a-color)
+  (make-color (color-red a-color)
+              0
+              0))
+(define dark-image
+  (image-transform distorted-image zero-blue-green))
+
+dark-image
+
+
+;; The image is still a bit darkened.  Let?s bump up the red component
+;; by a factor of ten.
+(define (red*10 a-color)
+  (make-color (* (color-red a-color) 10)
+              (color-green a-color)
+              (color-blue a-color)))
+(define red-eye-image
+  (image-transform dark-image red*10))
+
+;; And now we should be able to look at red-eye-image and recognize
+;; the landmark.
+
+red-eye-image
+(image-width red-eye-image)
+(image-height red-eye-image)

whalesong/examples/js-get-message/js-get-message-child.rkt

@@ -0,0 +1,45 @@
+#lang whalesong
+(require whalesong/js/world
+         whalesong/js
+         whalesong/web-world)
+
+;; Test of getting world events from arbitrary JavaScript function application.
+
+;; We first define a new event handler type, by using make-js-world-event:
+(define-values (on-message send)
+  (make-js-world-event))
+
+;; It gives us two values back:
+;; 1.  An event handler that can be passed to big-bang
+;; 2.  A raw JavaScript function that can fire events
+
+
+;; Let's attach the send-event function to a toplevel function on the window.
+(void ((js-function->procedure "function(send) { $(window).bind('message', function(e) { send(e.originalEvent.data); })}")
+       send))
+;; js-function lifts JavaScript functions to regular function we can call.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; With this infrastructure, we can make a world program that responds to window postMessage.  For example,
+;; we can present a log of all the messages we receive.
+
+(define-struct world (time messages))
+
+(define (read-message w v msg)
+  (make-world (world-time w)
+              (cons (format "at time ~a: ~s"
+                            (world-time w)
+                            msg)
+                    (world-messages w))))
+
+(define (tick w v)
+  (make-world (add1 (world-time w))
+              (world-messages w)))
+
+
+;; Finally, let's use our big bang:
+(big-bang (make-world 0 '())
+          (on-tick tick 1)
+          (on-message read-message))
+

whalesong/examples/js-get-message/js-get-message-parent.html

@@ -0,0 +1,36 @@
+<!DOCTYPE html>
+<html>
+<head><title>Testing message passing across windows</title>
+
+<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.7.1/jquery.min.js" type="text/javascript"></script>
+<style type="text/css">
+#another-world {
+   width: 100%;
+   height: 50%;
+}
+</style>
+
+</head>
+<body>
+<p>This is a world program:</p>
+<iframe id="another-world" src="js-get-message-child.html"></iframe>
+
+<br/>
+<hr/
+<p>And this a regular JavaScript program:</p>
+<input id="msg" type="text"/>
+<input id="submit" type="submit">
+
+
+<script type="text/javascript">
+$(document).ready(function() {
+  var otherWorld = document.getElementById("another-world").contentWindow;
+  var send = function() {
+      otherWorld.postMessage($("#msg").val(), "*");
+      $("#msg").val("");
+  };
+  $("#submit").on("click", send);
+});
+</script>
+</body>
+</html>

whalesong/examples/list-length.rkt

@@ -0,0 +1,13 @@
+#lang whalesong
+
+(define (mylen x acc)
+  (cond
+    [(empty? x)
+     acc]
+    [else
+     (mylen (rest x) (add1 acc))]))
+"computing length"
+(define v (build-list 1000000 (lambda (i) i)))
+(printf "Built list\n")
+(mylen v 0)
+"done computing length"

whalesong/examples/logo.rkt

@@ -1,6 +1,6 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/image))
+(require whalesong/image)
 
 
 (define lst

whalesong/examples/mathjax-script.js

@@ -0,0 +1,21 @@
+<script type="text/javascript" src="http://cdn.mathjax.org/mathjax/latest/MathJax.js">
+  MathJax.Hub.Config({
+    extensions: ["tex2jax.js"],
+    jax: ["input/TeX", "output/HTML-CSS"],
+    tex2jax: {
+      inlineMath: [ ['$','$'], ["\\(","\\)"] ],
+      displayMath: [ ['$$','$$'], ["\\[","\\]"] ],
+      processEscapes: true
+    },
+    "HTML-CSS": { availableFonts: ["TeX"] }
+  });
+</script>
+<script>
+var UpdateMath = function () {
+                     MathJax.Hub.Queue(["Typeset",MathJax.Hub]); 
+                     window.setTimeout(UpdateMath, 1000*1);                                      
+                     return true;
+                 };
+window.setTimeout(UpdateMath, 1000*1);
+</script>
+

whalesong/examples/mathjax.rkt

@@ -0,0 +1,22 @@
+#lang whalesong
+(require whalesong/web-world)
+
+;;; This demonstrates how to use MathJax to write equations.
+;;; Use  --include-script mathjax-script.js  to include the MathJax.
+;;; racket whalesong.rkt build --include-script mathjax-script.js mathjax.rkt
+
+;; tick: world view -> world
+(define (tick n view)
+  (add1 n))
+ 
+;; draw: world view -> view
+(define (draw n view)
+  (->view
+   (xexp->dom `(p "This equation has no integer solutions: "
+                  ,(let ([n (number->string n)])
+                     (format "$$ x^~a + y^~a = z^~a $$" n n n))))))
+ 
+(big-bang 3 
+          (initial-view (xexp->dom '(html (head) (body))))
+          (on-tick tick 5)
+          (to-draw draw))

whalesong/examples/mouse.rkt

@@ -1,7 +1,7 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/world)
-         (planet dyoo/whalesong/image))
+(require whalesong/world
+         whalesong/image)
 
 (define width 640)
 (define height 480)

whalesong/examples/pacman.rkt

@@ -1,8 +1,7 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/world)
-         (planet dyoo/whalesong/image)
-         )
+(require whalesong/world
+         whalesong/image)
 
 
 ;; Constants:

whalesong/examples/rain-world-program.rkt

@@ -1,8 +1,8 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
-(require (planet dyoo/whalesong/world)
-         (planet dyoo/whalesong/image)
-         (planet dyoo/whalesong/js))
+(require whalesong/world
+         whalesong/image
+         whalesong/js)
 
 ;; Occupy the whole screen.
 (void (call-method body "css" "margin" 0))

whalesong/examples/raphael-demo.rkt

@@ -0,0 +1,203 @@
+#lang whalesong
+(require whalesong/resource
+         whalesong/web-world
+         whalesong/js)
+
+; This is a small demonstration of the Javascript
+; graphics library Raphael from http://raphaeljs.com/ .
+
+; The example below the bindings draws a Lissajous curve.
+
+
+;;;
+;;; Whalesong binding of Raphael
+;;;
+(load-script "http://yandex.st/raphael/1.5.2/raphael.js")
+
+(define paper #f)
+
+(define (raphael-init id width height)
+  (unless paper    
+    (set! paper
+          (js-eval 
+           (format "Raphael(~s, ~a, ~a)"
+                   id width height)))))
+
+(define (raphael-rect x1 y1 x2 y2 . more)
+  (case (length more)
+    [(0) (call-method paper "rect" x1 y1 x2 y2)]
+    [(1) (call-method paper "rect" x1 y1 x2 y2 (car more))]
+    [else (error 'raphael-rect "too many arguments")]))
+
+(define (raphael-circle x y r)
+  (call-method paper "circle" x y r))
+
+(define (raphael-ellipse x y rx ry)
+  (call-method paper "ellipse" x y rx ry))
+
+(define (raphael-image src-uri x y w h)
+  (call-method paper "image" x y w h))
+
+(define (raphael-set)
+  (call-method paper "set"))
+
+(define (raphael-push set . elems)
+  (for-each (λ (e) (call-method paper "push" e)) elems))
+
+(define (raphael-text x y str)
+  (call-method paper "text" x y str))
+
+(define (raphael-path str) ; str in SVG path string format
+  (call-method paper "path" str))
+
+(define (raphael-line x1 y1 x2 y2)
+  (raphael-path (format "M~a ~aL~a ~a" x1 y1 x2 y2)))
+
+(define (raphael-clear) 
+  (call-method paper "clear"))
+
+(define (raphael-node c)
+  (call-method c "node"))
+
+(define (raphael-hide c)
+  (call-method c "hide"))
+
+(define (raphael-show c)
+  (call-method c "show"))
+
+
+(define (raphael-remove c)
+  (call-method c "remove"))
+
+(define (raphael-rotate c deg . more)
+  (case (length more)
+    [(0) (call-method c "rotate" deg)]
+    [(1) (let ([is-absolute (car more)])
+           (call-method c "rotate" deg is-absolute))]
+    [(2) (let ([cx (car more)]
+               [cy (cadr more)])
+           ; (cx,xy) is the center
+           (call-method c "rotate" deg cx cy))]))
+
+(define (raphael-translate c dx dy)
+  (call-method c "translate" dx dy))
+
+(define (raphael-scale c xtimes ytimes . more)
+  (case (length more)
+    [(0) (call-method c "scale" xtimes ytimes)]
+    [(2) (let ([centerx (car more)]
+               [centery (cadr more)])
+           (call-method c "scale" xtimes ytimes centerx centery))]
+    [else (error 'raphael-scale "wrong number of arguments")]))
+
+(define (raphael-attr c . more)
+  (case (length more)
+    [(2) (let* ([attribute-name (car more)]
+                [attribute-value (cadr more)]
+                [attribute-value (if (number? attribute-value)
+                                     (number->string attribute-value)
+                                     attribute-value)])
+           (call-method c "attr" attribute-name attribute-value))]
+    [(1) (cond
+           [(string? (car more))
+            ; return current attribute values
+            (call-method c "attr" (car more))]
+           [(list? (car more))
+            (for-each (λ (p) (let ([name (car p)]
+                                   [val (cadr p)])
+                               (raphael-attr c name val)))
+                      (car more))]
+           [else (error 'raphael-attr "wrong argument type: string or list-of-two-element-lists expected")])]
+    [else (error 'raphael-attr "expected 2 or 3 arguments")]))
+
+;;;
+;;; Demonstration of the Raphael bindings
+;;;
+
+(define WIDTH 400)
+(define HEIGHT 400)
+
+(define XMIN -1.0)
+(define XMAX  1.0)
+(define YMIN -1.0)
+(define YMAX  1.0)
+
+(define FRAMES-PER-SECOND 30)
+
+(define SECONDS-PER-ORBIT 20)
+
+(define STAR-PATH
+  "M16,22.375L7.116,28.83l3.396-10.438l-8.883-6.458l10.979,0.002L16.002,
+   1.5l3.391,10.434h10.981l-8.886,6.457l3.396,10.439L16,22.375L16,22.375z")
+
+(define (count->time c)
+  (let ([seconds (/ (remainder c (* SECONDS-PER-ORBIT FRAMES-PER-SECOND)) FRAMES-PER-SECOND)])
+    (* 2 pi (/ seconds SECONDS-PER-ORBIT))))
+
+(define screen-x
+  (let ([dx (- XMAX XMIN)])
+    (lambda (x)
+      (let* ([x (max x XMIN)]
+             [x (min x XMAX)])
+        (/ (* (- x XMIN) WIDTH) dx)))))
+
+(define screen-y
+  (let ([dy (- YMAX YMIN)])
+    (lambda (y)
+      (let* ([y (max y YMIN)]
+             [y (min y XMAX)])
+        (/ (* (- (- y) YMIN) HEIGHT) dy)))))
+
+(define-struct world (count star))
+
+;;; See http://en.wikipedia.org/wiki/Lissajous_curve for
+;;; other values of a and b to try.
+(define a 5)
+(define b 4)
+(define c 3)
+
+(define (x t)
+  (* 0.8 (sin (* a t))))
+
+(define (y t)
+  (* 0.8 (sin (* b t))))
+
+;; tick: world view -> world
+(define (tick world view)
+  (let* ([c (world-count world)]
+         [s (world-star world)]
+         [t (count->time c)]
+         [t2 (count->time (sub1 c))])
+    (cond
+      [(zero? c)     
+       (raphael-init "raphael_area" WIDTH HEIGHT)       
+       (make-world 1 (raphael-circle (screen-x (x t)) (screen-y (y t)) 3))]
+      [else
+       (raphael-remove s)
+       (let ([color (format "rgb(~a%, ~a%, ~a%)" 
+                            (* 100 (/ (+ 1.0 (x t)) 2.0))
+                            (* 100 (/ (+ 1.0 (y t)) 2.0))
+                            50)])
+         (raphael-attr (raphael-line (screen-x (x t2)) (screen-y (y t2)) 
+                                     (screen-x (x t)) (screen-y (y t)))
+                       "stroke" color)
+         (make-world (add1 c)
+                     (let* ([s (raphael-path STAR-PATH)]
+                            [s (raphael-translate s 
+                                                  (- (screen-x (x t)) 15)
+                                                  (- (screen-y (y t)) 15))]
+                            [s (raphael-attr s "fill" color)]
+                            [s (raphael-rotate s c)]
+                            [scale (+ 3 (* 20 (/ (+ 1.0 (sin (* 5 t))) 2)))]
+                            [s (raphael-scale s scale scale)])
+                       (raphael-attr s "stroke" "black"))))])))
+
+;; draw: world view -> view
+(define (draw world view)
+  view)
+
+(big-bang 
+ (make-world 0 #f)
+ (initial-view (xexp->dom '(html (head) (body (div (@ (id "raphael_area")))))))
+ (on-tick tick (/ 1 FRAMES-PER-SECOND))
+ (to-draw draw))

whalesong/examples/read-bytes.rkt

@@ -1,4 +1,4 @@
-#lang planet dyoo/whalesong
+#lang whalesong
 
 (let loop ([b (read-byte)])
   (cond

whalesong/examples/select.rkt

@@ -0,0 +1,27 @@
+#lang whalesong
+
+(require whalesong/web-world)
+
+(define (draw w v)
+  (define v2 (view-focus v "fill-me-in"))
+  (update-view-text v2 w))
+
+(define view (xexp->dom '(div
+                          (h1 "test")
+                          (select (@ (id "my-select"))
+                                  (option (@ (value "red")) "Red")
+                                  (option (@ (value "green")) "Green")
+                                  (option (@ (value "blue")) "Blue"))
+                          (p
+                            "I see: "
+                            (span (@ (id "fill-me-in")))))))
+
+(define (when-select-changed w v)
+  (view-form-value (view-focus v "my-select")))
+   
+(define bound-view
+  (view-bind-many view ["my-select" "change" when-select-changed]))
+
+(big-bang "nothing yet"
+          (initial-view bound-view)
+          (to-draw draw))