in the middle of trying to compile racket/base and see how far I can get

compiler.rkt

@@ -12,12 +12,25 @@
 
 (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
@@ -2016,8 +2029,7 @@
 (define (compile-primitive-kernel-value exp cenv target linkage)
   (let ([id (PrimitiveKernelValue-id exp)])
     (cond
-      [(KernelPrimitiveName? id)
-       
+      [(KernelPrimitiveName? id)   
        (let ([singular-context-check (emit-singular-context linkage)])
          ;; Compiles constant values.
          (end-with-linkage linkage
@@ -2027,9 +2039,10 @@
                              `(,(make-AssignImmediateStatement target exp)
                             singular-context-check)))))]
       [else
-       (error 'unimplemented-kernel-primitive 
-              "Primitive Kernel Value ~s has not been implemented"
-              id)])))
+       ((current-warn-unimplemented-kernel-primitive) id)
+       (make-instruction-sequence
+        `(,(make-PerformStatement (make-RaiseUnimplementedPrimitiveError! id))))])))
+
 
 
 

il-structs.rkt

@@ -388,6 +388,11 @@
   #:transparent)
 
 
+;; Raise a runtime error if we hit a use of an unimplemented kernel primitive.
+(define-struct: RaiseUnimplementedPrimitiveError! ([name : Symbol])
+  #:transparent)
+
+
 
 
 ;; Changes over the control located at the given argument from the structure in env[1]
@@ -426,6 +431,7 @@
                                RaiseContextExpectedValuesError!
                                RaiseArityMismatchError!
 			       RaiseOperatorApplicationError!
+                               RaiseUnimplementedPrimitiveError!
                                
                                RestoreEnvironment!
                                RestoreControl!

js-assembler/assemble-perform-statement.rkt

@@ -124,6 +124,12 @@
     [(RaiseOperatorApplicationError!? op)
      (format "RUNTIME.raiseOperatorApplicationError(MACHINE, ~a);"
              (assemble-oparg (RaiseOperatorApplicationError!-operator op)))]
+
+
+    [(RaiseUnimplementedPrimitiveError!? op)
+     (format "RUNTIME.raiseUnimplementedPrimitiveError(MACHINE, ~s);"
+             (symbol->string (RaiseUnimplementedPrimitiveError!-name op)))]
+    
     
     [(InstallModuleEntry!? op)
      (format "MACHINE.modules[~s]=new RUNTIME.ModuleRecord(~s, ~a);"

js-assembler/mini-runtime.js

@@ -303,6 +303,27 @@
 			MACHINE.argcount + " values"));
     };
 
+    var raiseArityMismatchError = function(MACHINE, expected, received) {
+	raise(MACHINE, 
+	      new Error("expected " + expected +
+			" values, received " + 
+			received + " values"));
+    };
+
+    var raiseOperatorApplicationError = function(MACHINE, operator) {
+	raise(MACHINE, 
+	      new Error("not a procedure: " + expected +
+                        operator));
+    };
+
+    var raiseUnimplementedPrimitiveError = function(MACHINE, name) {
+	raise(MACHINE, 
+	      new Error("unimplemented kernel procedure: " + name))
+    };
+
+
+
+
 
     // captureControl implements the continuation-capturing part of
     // call/cc.  It grabs the control frames up to (but not including) the
@@ -1199,6 +1220,9 @@
     exports['testArity'] = testArity;
     exports['raise'] = raise;
     exports['raiseContextExpectedValuesError'] = raiseContextExpectedValuesError;
+    exports['raiseArityMismatchError'] = raiseArityMismatchError;
+    exports['raiseOperatorApplicationError'] = raiseOperatorApplicationError;
+    exports['raiseUnimplementedPrimitiveError'] = raiseUnimplementedPrimitiveError;
 
 
     exports['captureControl'] = captureControl;

kernel-primitives.rkt

@@ -30,6 +30,7 @@
 				    'cadr
 				    'caddr
                                     'list
+                                    'list*
                                     'list->vector
                                     'vector->list
                                     'vector
@@ -64,6 +65,16 @@
                                     'map
                                     'for-each
                                     'current-print
+
+
+                                    ;; These are necessary to get racket/base compiled
+                                    ;; and running
+                                    'raise-type-error
+                                    'hash-map
+                                    'abort-current-continuation
+                                    'raise
+                                    'list?
+                                    'keyword<?
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
 

package.rkt

@@ -10,6 +10,7 @@
          "get-dependencies.rkt"
          "js-assembler/assemble.rkt"
          "js-assembler/get-runtime.rkt"
+         "lexical-structs.rkt"
          "quote-cdata.rkt"
          racket/runtime-path
          racket/port
@@ -61,7 +62,14 @@
      [(eq? ast #f)
       sources]
      [else
-      sources]))
+      (let* ([dependent-module-names (get-dependencies ast)]
+             [paths
+              (map ModuleName-real-path
+                   (filter (lambda (mp) (and (path? (ModuleName-real-path mp))
+                                             (should-follow?
+                                              (path? (ModuleName-real-path mp)))))
+                           dependent-module-names))])
+        (append paths sources))]))
     
   (let loop ([sources sources])
     (cond
@@ -71,6 +79,7 @@
      [(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)

simulator/simulator.rkt

@@ -451,6 +451,10 @@
 	   (error 'step "expected procedure, given ~a"
 		  (evaluate-oparg m (RaiseOperatorApplicationError!-operator op)))]
           
+	  [(RaiseUnimplementedPrimitiveError!? op)
+	   (error 'step "Unimplemented kernel procedure ~a"
+		  (RaiseUnimplementedPrimitiveError!-name op))]
+
           
           [(InstallModuleEntry!? op)
            (printf "installing module ~s\n"