fixing parameter names; moving the unimplmented-kernel warning function out to the parameters

compiler.rkt

@@ -6,31 +6,17 @@
          "compiler-structs.rkt"
          "kernel-primitives.rkt"
          "optimize-il.rkt"
+         "parameters.rkt"
          racket/match
          racket/bool
          racket/list)
 
 (provide (rename-out [-compile compile])
          compile-general-procedure-call
-         current-warn-unimplemented-kernel-primitive
          append-instruction-sequences)
 
 
 
-
-
-(: default-warn-unimplemented-kernel-primitive (Symbol -> Void))
-(define (default-warn-unimplemented-kernel-primitive id)
-  (printf "WARNING: Primitive Kernel Value ~s has not been implemented\n"
-          id))
-
-
-(: current-warn-unimplemented-kernel-primitive (Parameterof (Symbol -> Void)))
-(define current-warn-unimplemented-kernel-primitive (make-parameter default-warn-unimplemented-kernel-primitive))
-
-
-
-
 (: -compile (Expression Target Linkage -> (Listof Statement)))
 ;; Generates the instruction-sequence stream.
 ;; Note: the toplevel generates the lambda body streams at the head, and then the

package.rkt

@@ -29,9 +29,13 @@
 
 
 
-(define (package-anonymous source-code should-follow? op)
+(define (package-anonymous source-code
+                           #:should-follow? should-follow?
+                           #:output-port op)
   (fprintf op "(function() {\n")
-  (package source-code should-follow? op)
+  (package source-code
+           #:should-follow? should-follow?
+           #:output-port op)
   (fprintf op " return invoke; })\n"))
 
 
@@ -41,7 +45,9 @@
 
 ;; Compile package for the given source program.  should-follow?
 ;; indicates whether we should continue following module paths.
-(define (package source-code should-follow? op)  
+(define (package source-code
+                 #:should-follow? should-follow?
+                 #:output-port op)  
   (let ([source-code-op (open-output-bytes)])
     (fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
     (follow-dependencies (cons bootstrap (list source-code))
@@ -79,7 +85,6 @@
      [(hash-has-key? visited (first sources))
       (loop (rest sources))]
      [else
-      (printf "visiting ~s\n" (first sources))
       (hash-set! visited (first sources) #t)
       (let-values ([(ast stmts) (get-ast-and-statements (first sources))])
         (assemble/write-invoke stmts op)

parameters.rkt

@@ -1,23 +1,44 @@
-#lang racket/base
+#lang typed/racket/base
 
 (require "expression-structs.rkt"
          racket/path)
 
 (provide current-defined-name
          current-module-path
-         current-root-path)
+         current-root-path
+         current-warn-unimplemented-kernel-primitive)
 
 
 
-;(: current-defined-name (Parameterof (U Symbol LamPositionalName)))
+(: current-module-path (Parameterof (U False Path)))
-(define current-defined-name (make-parameter 'unknown))
-
-
-;(: current-module-path (Parameterof (U False Path)))
 (define current-module-path 
   (make-parameter (build-path (current-directory) "anonymous-module.rkt")))
 
 
-;(: current-root-path (Parameterof Path))
+(: current-root-path (Parameterof Path))
 (define current-root-path
   (make-parameter (normalize-path (current-directory))))
+
+
+
+(: current-warn-unimplemented-kernel-primitive (Parameterof (Symbol -> Void)))
+(define current-warn-unimplemented-kernel-primitive
+  (make-parameter
+   (lambda: ([id : Symbol])
+            (printf "WARNING: Primitive Kernel Value ~s has not been implemented\n"
+                    id))))
+
+
+
+
+
+
+
+
+
+;;; These parameters below will probably go away soon.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(: current-defined-name (Parameterof (U Symbol LamPositionalName)))
+(define current-defined-name (make-parameter 'unknown))
+

tests/test-browser-evaluate.rkt

@@ -18,7 +18,9 @@
                     (newline op)
                     
                     (fprintf op "var innerInvoke = ")
-                    (package-anonymous program should-follow? op)
+                    (package-anonymous program
+                                       #:should-follow? should-follow?
+                                       #:output-port op)
                     (fprintf op "();\n")
                     
                     (fprintf op #<<EOF

tests/test-conform-browser.rkt

@@ -18,7 +18,9 @@
                     (newline op)
                     
                     (fprintf op "var innerInvoke = ")
-                    (package-anonymous program (lambda (p) #t) op)
+                    (package-anonymous program
+                                       #:should-follow? (lambda (p) #t)
+                                       #:output-port op)
                     (fprintf op "();\n")
                     
                     (fprintf op #<<EOF

tests/test-earley-browser.rkt

@@ -20,7 +20,9 @@
                     (newline op)
                     
                     (fprintf op "var innerInvoke = ")
-                    (package-anonymous program (lambda (p) #t) op)
+                    (package-anonymous program
+                                       #:should-follow? (lambda (p) #t)
+                                       #:output-port op)
                     (fprintf op "();\n")
                     
                     (fprintf op #<<EOF

tests/test-package.rkt

@@ -8,7 +8,9 @@
   #t)
 
 (define (test s-exp)
-  (package s-exp follow? (open-output-string) #;(current-output-port)))
+  (package s-exp
+           #:should-follow? follow?
+           #:output-port (open-output-string) #;(current-output-port)))
 
 
 (test '(define (factorial n)