adding gensym and a few of the paramz bindings. Prepping traced-app for good stack traces.

compiler/kernel-primitives.rkt

@@ -71,6 +71,8 @@
                                     'current-inspector
                                     'make-struct-field-accessor
                                     'make-struct-field-mutator
+                                    
+                                    'gensym
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
 

examples/maze.rkt

@@ -0,0 +1,21 @@
+#lang planet dyoo/whalesong
+
+;; Maze generation via Recursive Backtracking technique.
+;; http://weblog.jamisbuck.org/2010/12/27/maze-generation-recursive-backtracking
+
+(define-struct cell (carved visited) #:mutable #:transparent)
+
+(define (make-grid width height f)
+  (build-vector 
+   width
+   (lambda (i)
+     (build-vector 
+      height
+      (lambda (j)
+        (f i j))))))
+
+(define grid (make-grid 20 20 
+                        (lambda (i j)
+                          (make-cell 0 #f))))
+
+grid

js-assembler/assemble-helpers.rkt

@@ -136,9 +136,15 @@
               [(path? val)
                (format "RUNTIME.makePath(~s)"
                        (path->string val))]
+              #;[(vector? val)
+               (format "RUNTIME.makeVector(~s)"
+                       (string-join (for/list ([elt (vector->list val)])
+                                        (loop elt))
+                                    ","))]
               [else
                (error 'assemble-const "Unsupported datum ~s" val)])))
 
+
 (: assemble-listof-assembled-values ((Listof String) -> String))
 (define (assemble-listof-assembled-values vals)
   (let loop ([vals vals])

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

@@ -143,6 +143,11 @@
         baselib.strings.isString,
         'string');
 
+    var checkSymbolOrString = makeCheckArgumentType(
+        function(x) { return (baselib.symbols.isSymbol(x) || 
+                              baselib.strings.isString(x)); },
+        'symbol or string');
+
     var checkMutableString = makeCheckArgumentType(
         baselib.strings.isMutableString,
         'mutable string');
@@ -241,10 +246,11 @@
     exports.makeCheckListofArgumentType = makeCheckListofArgumentType;
 
     exports.checkOutputPort = checkOutputPort;
+    exports.checkSymbol = checkSymbol;
     exports.checkString = checkString;
+    exports.checkSymbolOrString = checkSymbolOrString;
     exports.checkMutableString = checkMutableString;
     exports.checkChar = checkChar;
-    exports.checkSymbol = checkSymbol;
     exports.checkProcedure = checkProcedure;
     exports.checkNumber = checkNumber;
     exports.checkReal = checkReal;

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

@@ -55,6 +55,7 @@
 
     var checkOutputPort = baselib.check.checkOutputPort;
     var checkString = baselib.check.checkString;
+    var checkSymbolOrString = baselib.check.checkSymbolOrString;
     var checkMutableString = baselib.check.checkMutableString;
     var checkSymbol = baselib.check.checkSymbol;
     var checkByte = baselib.check.checkByte;
@@ -114,6 +115,30 @@
     installPrimitiveConstant('false', false);
 
 
+    // The parameter keys here must be uninterned symbols, so we explicitly
+    // call the symbol constructor here.
+    installPrimitiveConstant('exception-handler-key',
+                             new baselib.symbols.Symbol("exnh"));
+    installPrimitiveConstant('parameterization-key',
+                             new baselib.symbols.Symbol("paramz"));
+    installPrimitiveConstant('break-enabled-key',
+                             new baselib.symbols.Symbol("break-on?"));
+
+
+    var gensymCounter = 0;
+    installPrimitiveProcedure(
+        'gensym',
+        makeList(0, 1),
+        function(MACHINE) {
+            var baseName = "g";
+            if (MACHINE.argcount === 1) {
+                baseName = checkSymbolOrString(MACHINE, 'gensym', 0).toString();
+            }
+            gensymCounter++;
+            return new baselib.symbols.Symbol(baseName + gensymCounter);
+        });
+
+
     installPrimitiveProcedure(
         'display',
         makeList(1, 2),

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

@@ -99,6 +99,7 @@
 
     var isVector = function (x) { return x instanceof Vector; };
 
+    // makeVector: x ... -> vector
     var makeVector = function () {
         return Vector.makeInstance(arguments.length, arguments);
     };

lang/base.rkt

@@ -1,9 +1,21 @@
 #lang s-exp "kernel.rkt"
 
-(provide (except-out (all-from-out "kernel.rkt"))
+(provide (except-out (all-from-out "kernel.rkt")
-         (all-from-out "private/list.rkt"))
 
-(require "private/list.rkt")
+                     ;; Don't publically export the bindings from #%paramz.
+                     exception-handler-key
+                     parameterization-key
+                     break-enabled-key
+                     
+                     ;; Use the traced app
+                     #;#%app)
+         
+         (all-from-out "private/list.rkt")
+         
+         #;(rename-out [traced-app #%app]))
+
+(require "private/list.rkt"
+         "private/traced-app.rkt")
 
 
 ;; Kludge: This forces modbeg to be compiled and packaged.

lang/kernel.rkt

@@ -3,8 +3,18 @@
                                      sgn conjugate))
          (prefix-in racket: racket/base)
 	 racket/local
-	 (for-syntax racket/base))
+	 (for-syntax racket/base)
 
+         
+         (only-in '#%paramz
+                  exception-handler-key
+                  parameterization-key
+                  break-enabled-key))
+
+
+(provide exception-handler-key
+         parameterization-key
+         break-enabled-key)
 
 
 ;; constants
@@ -146,7 +156,9 @@
          values
 
          apply
-         call-with-values)
+         call-with-values
+
+         gensym)
 
 
 (define (-identity x) x)
@@ -255,7 +267,7 @@ raise-mismatch-error
   magnitude
   conjugate
   ;;  inexact->exact
-;;  exact->inexact
+  ;;  exact->inexact
   number->string
   string->number
   procedure?

lang/private/traced-app.rkt

@@ -0,0 +1,23 @@
+#lang s-exp "../kernel.rkt"
+
+(require (for-syntax racket/base))
+
+(provide traced-app traced-app-key)
+
+(define traced-app-key (gensym 'traced-app-key))
+
+
+(define-syntax (traced-app stx)
+  (syntax-case stx ()
+    [(_ operator operands ...)
+     (with-syntax ([key #'traced-app-key]
+                   [pos  (vector (format "~s" (syntax-source stx))
+                                 (syntax-position stx)
+                                 (syntax-line stx)
+                                 (syntax-column stx)
+                                 (syntax-span stx))])
+       (syntax/loc stx
+         (with-continuation-mark key 'pos
+           (#%app operator operands ...))))]
+    [else
+     stx]))

make/make.rkt

@@ -146,13 +146,15 @@
                        (foldl (lambda: ([mp : ModuleLocator]
                                         [acc : (Listof Source)])
                                        (let ([rp [ModuleLocator-real-path mp]])
-                                         (cond [((current-kernel-module-locator?)
+                                         (cond
-                                                 mp)
+                                          ;; Ignore modules that are implemented by Whalesong.
-                                                acc]
+                                          [((current-kernel-module-locator?)
-                                               [(path? rp)
+                                            mp)
-                                                (cons (make-ModuleSource rp) acc)]
+                                           acc]
-                                               [else
+                                          [(path? rp)
-                                                acc])))
+                                           (cons (make-ModuleSource rp) acc)]
+                                          [else
+                                           acc])))
                               '()
                               dependent-module-names)])
                  paths)])]))

parameters.rkt

@@ -41,14 +41,26 @@
 
 
 (: current-kernel-module-locator? (Parameterof (ModuleLocator -> Boolean)))
-;; Produces true if the given module locator should be treated as a root one.
+;; Produces true if the given module locator should be treated as a primitive root one
+;; that is implemented by us.
 (define current-kernel-module-locator?
   (make-parameter
    (lambda: ([locator : ModuleLocator])
-            (or (and (eq? (ModuleLocator-name locator) '#%kernel)
+            (or (kernel-locator? locator)
-                     (eq? (ModuleLocator-real-path locator) '#%kernel))
+                (paramz-locator? locator)))))
-                (eq? (ModuleLocator-name locator)
+
-                     'whalesong/lang/kernel.rkt)))))
+(: 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)))
+
+
+(: paramz-locator? (ModuleLocator -> Boolean))
+(define (paramz-locator? locator)
+  (or (and (eq? (ModuleLocator-name locator) '#%paramz)
+           (eq? (ModuleLocator-real-path locator) '#%paramz))))