continuing to work on package

NOTES

@@ -540,3 +540,24 @@ I'm running my bytecode parser over the entire racket collects tree,
 just to make sure the parser itself is robust.
 
 Parsing takes milliseconds, except on Typed Racket code, which is expected.
+
+
+
+----------------------------------------------------------------------
+
+May 23, 2011
+
+Let me list out, roughly, what's left for me to do do:
+
+
+    Get module invokation working.
+
+    Get enough of the racket/base helper functions working to get
+    basic programs in place.
+
+    Get the runtime of Moby in the system.
+
+    Integrate the raw JavaScript-specific extensions in.
+
+    Isolate performance issues.
+

bootstrapped-primitives.rkt

@@ -20,14 +20,6 @@
 
 
 
-;; 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
@@ -99,13 +91,6 @@
   
   (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 

get-module-bytecode.rkt

@@ -1,12 +1,20 @@
 #lang racket/base
 (require racket/contract 
          racket/path
-         syntax/modcode)
+         racket/runtime-path
+         syntax/modcode
+         "language-namespace.rkt")
 (provide/contract [get-module-bytecode ((or/c string? path? input-port?) . -> . bytes?)])
 
 
-(define base-namespace (make-base-namespace))
+(define-runtime-path kernel-language-path
+  "lang/kernel.rkt")
 
+(define base-namespace
+  (lookup-language-namespace
+   #;'racket/base
+   `(file ,(path->string kernel-language-path)))
+  #;(make-base-namespace))
   
 (define (get-module-bytecode x)
   (let ([compiled-code

js-assembler/assemble.rkt

@@ -25,17 +25,20 @@
 
 (: 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)
+  (fprintf op "(function(MACHINE, success, fail, params) {\n")
+  (fprintf op "var param;\n")
+  (fprintf op "var RUNTIME = plt.runtime;\n")
   (let: ([basic-blocks : (Listof BasicBlock) (fracture stmts)])
-        (fprintf op "(function(MACHINE, success, fail, params) {\n")
-        (fprintf op "var param;\n")
-        (fprintf op "var RUNTIME = plt.runtime;\n")
         (for-each
          (lambda: ([basic-block : BasicBlock])
                   (displayln (assemble-basic-block basic-block) op)
                   (newline op))
          basic-blocks)
         (write-linked-label-attributes stmts op)
+        
         (fprintf op "MACHINE.params.currentErrorHandler = fail;\n")
         (fprintf op "MACHINE.params.currentSuccessHandler = success;\n")
         (fprintf op #<<EOF

package.rkt

@@ -13,12 +13,14 @@
          "quote-cdata.rkt"
          racket/runtime-path
          racket/port
+         racket/list
 	 (prefix-in racket: racket/base))
 
 (provide package
          package-anonymous)
 
-;; Packager: produce single .js files to be included.
+;; Packager: produce single .js files to be included to execute a
+;; program.  Follows module dependencies.
 
 
 (define-runtime-path kernel-language-path
@@ -26,57 +28,114 @@
 
 
 
-;; package: s-expression output-port -> void
+(define (package-anonymous source-code should-follow? op)
-(define (package source-code op)  
-  (let ([source-code-op (open-output-bytes)])
-    (write source-code source-code-op)
-    (let ([source-code-ip (open-input-bytes (get-output-bytes source-code-op))])
-      (fprintf op "var invoke = ")
-      (assemble/write-invoke (append (get-bootstrapping-code)
-                                     (compile (parse-bytecode 
-                                               (open-input-bytes (get-module-bytecode source-code-ip)))
-                                              'val
-                                              next-linkage/drop-multiple))
-                             op)
-      (fprintf op ";\n"))))
-
-
-(define (package-anonymous source-code op)
   (fprintf op "(function() {\n")
-  (package source-code op)
+  (package source-code should-follow? op)
   (fprintf op " return invoke; })\n"))
 
 
 
 
+;; package: s-expression (path -> boolean) output-port -> void
 
-(define (package-standalone-html a-module-path op)
+;; Compile package for the given source program.  should-follow?
-  ;; FIXME: write the runtime ...
+;; indicates whether we should continue following module paths.
-  ;; Next, write the function to load in each module.
+(define (package source-code should-follow? op)  
-  (fprintf op #<<EOF
+  (let ([source-code-op (open-output-bytes)])
-<!DOCTYPE html>
+    (fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+    (follow-dependencies (cons bootstrap (list source-code))
-<head>
+                         should-follow?
-  <meta charset="utf-8"/>
+                         op)
-  <title>Example</title>
-</head>
-<script>\n
-EOF
-           )
-  (display (quote-as-cdata (get-runtime)) op)
-  (let ([buffer (open-output-string)])
-    (assemble/write-invoke (compile (parse-bytecode a-module-path)
-                                    'val
-                                    next-linkage/drop-multiple)
-                           buffer)
-    (write-string (quote-as-cdata (get-output-string buffer))
-                  op))
-  ;; FIXME: Finally, invoke the main module.
     
-  (fprintf op #<<EOF
+    (fprintf op "});\n")))
-\n</script>
+
-<body onload='invokeMainModule()'>
+
-</body>
+
-</html>
+
-EOF
+;; follow-dependencies
-           ))
+(define (follow-dependencies sources should-follow? op)
+  (define visited (make-hash))
+
+  (define (collect-new-dependencies ast sources)
+    (cond
+     [(eq? ast #f)
+      sources]
+     [else
+      sources]))
+    
+  (let loop ([sources sources])
+    (cond
+     [(empty? sources)
+      (fprintf op "SUCCESS();")
+      (void)]
+     [(hash-has-key? visited (first sources))
+      (loop (rest sources))]
+     [else
+      (hash-set! visited (first sources) #t)
+      (let-values ([(ast stmts) (get-ast-and-statements (first sources))])
+        (assemble/write-invoke stmts op)
+        (fprintf op "(MACHINE, function() { ")
+        (loop (collect-new-dependencies ast (rest sources)))
+        (fprintf op " }, FAIL, PARAMS);"))])))
+
+
+
+(define-struct Bootstrap (code))
+(define bootstrap (make-Bootstrap (get-bootstrapping-code)))
+
+
+
+
+;; get-ast-and-statements: X -> (values (U Expression #f) (Listof Statement))
+(define (get-ast-and-statements source-code)
+  (cond
+   [(Bootstrap? source-code)
+    (values #f (get-bootstrapping-code))]
+   [else
+    (let ([ast
+           (cond
+            [(path? source-code)
+             (parse-bytecode source-code)]
+            [else
+             (let ([source-code-op (open-output-bytes)])
+               (write source-code source-code-op)
+               (parse-bytecode
+                (open-input-bytes
+                 (get-module-bytecode
+                  (open-input-bytes
+                   (get-output-bytes source-code-op))))))])])
+      (values ast
+              (compile ast 'val next-linkage/drop-multiple)))]))
+
+
+
+;; (define (package-standalone-html a-module-path op)
+;;   ;; FIXME: write the runtime ...
+;;   ;; Next, write the function to load in each module.
+;;   (fprintf op #<<EOF
+;; <!DOCTYPE html>
+;; <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+;; <head>
+;;   <meta charset="utf-8"/>
+;;   <title>Example</title>
+;; </head>
+;; <script>\n
+;; EOF
+;;            )
+;;   (display (quote-as-cdata (get-runtime)) op)
+;;   (let ([buffer (open-output-string)])
+;;     (assemble/write-invoke (compile (parse-bytecode a-module-path)
+;;                                     'val
+;;                                     next-linkage/drop-multiple)
+;;                            buffer)
+;;     (write-string (quote-as-cdata (get-output-string buffer))
+;;                   op))
+;;   ;; FIXME: Finally, invoke the main module.
+  
+;;   (fprintf op #<<EOF
+;; \n</script>
+;; <body onload='invokeMainModule()'>
+;; </body>
+;; </html>
+;; EOF
+;;            ))

tests/module-test/m1.rkt

@@ -0,0 +1,2 @@
+(module m1 '#%kernel
+  (#%require "m2.rkt"))

tests/module-test/m2.rkt

@@ -0,0 +1,3 @@
+(module m2 '#%kernel
+  (display "hello world")
+  (newline))

tests/test-browser-evaluate.rkt

@@ -5,6 +5,7 @@
          
 
 
+(define should-follow? (lambda (p) #t))
 
 (define evaluate (make-evaluate 
                   (lambda (program op)
@@ -17,7 +18,7 @@
                     (newline op)
                     
                     (fprintf op "var innerInvoke = ")
-                    (package-anonymous program op)
+                    (package-anonymous program should-follow? op)
                     (fprintf op "();\n")
                     
                     (fprintf op #<<EOF

tests/test-conform-browser.rkt

@@ -18,7 +18,7 @@
                     (newline op)
                     
                     (fprintf op "var innerInvoke = ")
-                    (package-anonymous program op)
+                    (package-anonymous program (lambda (p) #t) op)
                     (fprintf op "();\n")
                     
                     (fprintf op #<<EOF

tests/test-earley-browser.rkt

@@ -20,7 +20,7 @@
                     (newline op)
                     
                     (fprintf op "var innerInvoke = ")
-                    (package-anonymous program op)
+                    (package-anonymous program (lambda (p) #t) op)
                     (fprintf op "();\n")
                     
                     (fprintf op #<<EOF

tests/test-package.rkt

@@ -2,8 +2,13 @@
 
 (require "../package.rkt")
 
+
+
+(define (follow? p)
+  #t)
+
 (define (test s-exp)
-  (package s-exp (open-output-string) #;(current-output-port)))
+  (package s-exp follow? (open-output-string) #;(current-output-port)))
 
 
 (test '(define (factorial n)