suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

continuing to work on package

Browse Source
This commit is contained in:
Danny Yoo 2011-05-23 12:30:36 -04:00
parent 8a7971e19c
commit a695eafa15
11 changed files with 160 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
NOTES
View File

@ -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.

15
bootstrapped-primitives.rkt
View File

@ -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

12
get-module-bytecode.rkt
View File

@ -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

9
js-assembler/assemble.rkt
View File

@ -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

153
package.rkt
View File

@ -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 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)
(define (package-anonymous source-code should-follow? 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)
;; 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.
;; Compile package for the given source program. should-follow?
;; indicates whether we should continue following module paths.
(define (package source-code should-follow? op)
(let ([source-code-op (open-output-bytes)])
(fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
(follow-dependencies (cons bootstrap (list source-code))
should-follow?
op)
(fprintf op #<<EOF
\n</script>
<body onload='invokeMainModule()'>
</body>
</html>
EOF
))
(fprintf op "});\n")))
;; 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
;; ))

2
tests/module-test/m1.rkt Normal file
View File

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

3
tests/module-test/m2.rkt Normal file
View File

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

3
tests/test-browser-evaluate.rkt
View File

@ -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

2
tests/test-conform-browser.rkt
View File

@ -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

2
tests/test-earley-browser.rkt
View File

@ -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

7
tests/test-package.rkt
View File

@ -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)