still fixing module imports

bootstrapped-primitives.rkt

@@ -4,11 +4,13 @@
          "il-structs.rkt"
          "compiler.rkt"
          "compiler-structs.rkt"
-         "typed-parse.rkt")
+         "typed-parse.rkt"
+         "where-is-collects.rkt")
 
 (require/typed "parameters.rkt"
                (current-defined-name (Parameterof (U Symbol LamPositionalName))))
-
+(require/typed "parse-bytecode.rkt"
+               (parse-bytecode (Path -> Expression)))
 
 
 
@@ -17,6 +19,17 @@
 
 
 
+
+;; We'll hardcode the compilation of some Racket modules here.
+(: hardcoded-modules-to-compile (Listof Path))
+(define hardcoded-modules-to-compile
+  (list
+   (build-path collects-path "racket" "private" "modbeg.rkt")
+   ))
+
+
+
+
 ;; The primitive code necessary to do call/cc
 
 (: call/cc-label Symbol)
@@ -85,7 +98,16 @@
 (define (get-bootstrapping-code)
   
   (append
+
+   ;; module code
+   (apply append (map (lambda: ([p : Path])
+                               (compile (parse-bytecode p)
+                                        'val
+                                        next-linkage/drop-multiple))
+                      hardcoded-modules-to-compile))
+
    
+   ;; Other primitives
    (make-bootstrapped-primitive-code 
     'map 
     '(letrec ([map (lambda (f l)

kernel-primitives.rkt

@@ -60,6 +60,10 @@
 				    'call-with-values
                                     'apply
                                     'printf
+                                    
+                                    'map
+                                    'for-each
+                                    'current-print
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
 

parse-bytecode.rkt

@@ -1,11 +1,32 @@
 #lang racket/base
 (require "version-case/version-case.rkt"
+         racket/file
+         (prefix-in whalesong: "version.rkt")
          (for-syntax racket/base))
 
 (version-case
   [(version>= (version) "5.1.1")
    (begin      
      (require "parse-bytecode-5.1.1.rkt")
-     (provide (all-from-out "parse-bytecode-5.1.1.rkt")))]
+     (provide (except-out (all-from-out "parse-bytecode-5.1.1.rkt")
+                          parse-bytecode)))]
   [else
-   (error 'parse-bytecode "Whalesong doesn't have a compatible parser for Racket ~a" (version))])
+   (error 'parse-bytecode "Whalesong doesn't have a compatible parser for Racket ~a" (version))])
+
+
+(provide (rename-out [my-parse-bytecode parse-bytecode]))
+
+
+(define (my-parse-bytecode x)
+  (cond
+    [(path? x)
+     (parse-bytecode x)]
+    [else
+     (parse-bytecode x)]))
+
+
+(define cache-dir (build-path (find-system-path 'pref-dir)
+                              "whalesong"
+                              whalesong:version))
+(unless (directory-exists? cache-dir)
+  (make-directory* cache-dir))

path-rewriter.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require "parameters.rkt"
+         "where-is-collects.rkt"
          racket/path
          racket/contract
          racket/list
@@ -34,7 +35,7 @@
       (string->symbol
        (string-append "collects/"
                       (path->string
-                       (find-relative-path collects a-path))))]
+                       (find-relative-path collects-path a-path))))]
      [(within-this-project-path? a-path)
       (string->symbol
        (string-append "whalesong/"
@@ -49,24 +50,14 @@
       #f])))
 
 
-(define collects
+       
-  (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]))))
-        
-
 
 (define (within-root? a-path)
   (within? (current-root-path) a-path))
 
 
 (define (within-collects? a-path)
-  (within? collects a-path))
+  (within? collects-path a-path))
 
 
 (define (within-this-project-path? a-path)

simulator/simulator.rkt

@@ -453,6 +453,9 @@
           
           
           [(InstallModuleEntry!? op)
+           (printf "installing module ~s\n"
+                   (ModuleName-name 
+                    (InstallModuleEntry!-path op)))
            (hash-set! (machine-modules m)
                       (ModuleName-name (InstallModuleEntry!-path op))
                       (make-module-record (InstallModuleEntry!-name op)

tests/test-compiler.rkt

@@ -3,7 +3,11 @@
 (require "../simulator/simulator.rkt"
          "../simulator/simulator-structs.rkt"
          "../simulator/simulator-helpers.rkt"
-         "test-helpers.rkt")
+         "../parameters.rkt"
+         "test-helpers.rkt"
+         racket/runtime-path)
+
+(define-runtime-path this-test-path ".")
 
   
 
@@ -1335,11 +1339,12 @@
       #:with-bootstrapping? #t)
 
 
-
+(parameterize ([current-module-path (build-path this-test-path "foo.rkt")])
-(test '(module foo racket/base
+  (test '(module foo racket/base
-         (printf "hello world"))
+           (printf "hello world"))
-      (make-undefined)
+        (make-undefined)
-      #:as-main-module 'foo)
+        #:as-main-module 'whalesong/tests/foo.rkt
+        #:with-bootstrapping? #t))
 
 
 
@@ -1347,7 +1352,7 @@
 
 ;; begin0 is still broken.
 
-#;(test '(letrec ([f (lambda (x)
+(test '(letrec ([f (lambda (x)
                      (if (= x 0)
                          0
                          (+ x (f (sub1 x)))))])
@@ -1357,14 +1362,14 @@
 
 
 
-#;(test '(let () (define (f x y z)
+(test '(let () (define (f x y z)
                  (values y x z))
            (call-with-values (lambda () (f 3 1 4))
                              (lambda args (list args))))
         '((1 3 4))
         #:with-bootstrapping? #t)
 
-#;(test '(let () (define (f x y z)
+(test '(let () (define (f x y z)
                  (begin0 (values y x z)
                          (display "")))
            (call-with-values (lambda () (f 3 1 4))

version.rkt

@@ -0,0 +1,4 @@
+#lang typed/racket/base
+(provide version)
+(: version String)
+(define version "1.0")

where-is-collects.rkt

@@ -0,0 +1,18 @@
+#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]))))