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

working on packaging some more

Browse Source
This commit is contained in:
Danny Yoo 2011-05-23 17:23:53 -04:00
parent 8befded925
commit 246549465e
3 changed files with 83 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
js-assembler/package.rkt
View File

@ -1,20 +1,8 @@
#lang racket/base
(require "assemble.rkt"
"get-runtime.rkt"
"../compiler.rkt"
"../compiler-structs.rkt"
"../parse-bytecode.rkt"
"../language-namespace.rkt"
"../il-structs.rkt"
"../bootstrapped-primitives.rkt"
"../get-module-bytecode.rkt"
"../get-dependencies.rkt"
"../lexical-structs.rkt"
"../quote-cdata.rkt"
racket/runtime-path
racket/port
racket/list
"../make-dependencies.rkt"
"../make-structs.rkt"
(prefix-in racket: racket/base))
(provide package
@ -24,14 +12,13 @@
;; program. Follows module dependencies.
(define-runtime-path kernel-language-path
"lang/kernel.rkt")
(define (package-anonymous source-code
#:should-follow? should-follow?
#:output-port op)
#:output-port op)
(fprintf op "(function() {\n")
(package source-code
#:should-follow? should-follow?
@ -48,82 +35,36 @@
(define (package source-code
#:should-follow? should-follow?
#:output-port op)
(define packaging-configuration
(make-Configuration
should-follow?
;; on
(lambda (ast stmts)
(assemble/write-invoke stmts op)
(fprintf op "(MACHINE, function() { "))
;; after
(lambda (ast stmts)
(fprintf op " }, FAIL, PARAMS);"))
;; last
(lambda ()
(fprintf op "SUCCESS();"))))
(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)
(make/dependencies (cons only-bootstrapped-code
(list source-code))
packaging-configuration)
(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
(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
[(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)
;; (define (package-standalone-xhtml a-module-path op)
;; ;; FIXME: write the runtime ...
;; ;; Next, write the function to load in each module.
;; (fprintf op #<<EOF

56
make-dependencies.rkt
View File

@ -9,6 +9,7 @@
"expression-structs.rkt"
"parameters.rkt"
"sets.rkt"
"make-structs.rkt"
racket/list
racket/match)
@ -20,39 +21,7 @@
[get-module-bytecode ((U String Path Input-Port) -> Bytes)])
(provide (all-defined-out))
(define-type Source (U OnlyStatements Any))
(define-struct: Configuration ([should-follow? : (Path -> Boolean)]
[before-first : (-> Void)]
[before-module-statements : ((U Expression #f)
(Listof Statement)
-> Void)]
[on-module-statements : ((U Expression #f)
(Listof Statement)
-> Void)]
[after-module-statements : ((U Expression #f)
(Listof Statement)
-> Void)]
[after-last : (-> Void)])
#:mutable)
(define debug-configuration (make-Configuration
(lambda (p) #t)
(lambda () (void))
(lambda (ast stmt)
(void))
(lambda (ast stmt)
(when (and ast (expression-module-path ast))
(printf "debug build configuration: visiting ~s\n"
(expression-module-path ast))))
(lambda (ast stmt)
(void))
(lambda () (void))))
(provide make/dependencies)
@ -64,8 +33,6 @@
(match config
[(struct Configuration (should-follow?
before-first
before-module-statements
on-module-statements
after-module-statements
after-last))
@ -130,22 +97,9 @@
(hash-set! visited (first sources) #t)
(let-values ([(ast stmts)
(get-ast-and-statements (first sources))])
(before-module-statements ast stmts)
(on-module-statements ast stmts)
(after-module-statements ast stmts)
(loop (collect-new-dependencies ast (rest sources))))])))
(before-first)
(follow-dependencies sources)
(after-last)])))
(define-struct: OnlyStatements ([code : (Listof Statement)]))
(: only-bootstrapped-code : OnlyStatements)
(define only-bootstrapped-code (make-OnlyStatements (get-bootstrapping-code)))
(loop (collect-new-dependencies ast (rest sources)))
(after-module-statements ast stmts))])))
(follow-dependencies sources)])))

50
make-structs.rkt Normal file
View File

@ -0,0 +1,50 @@
#lang typed/racket/base
(require "compiler.rkt"
"il-structs.rkt"
"get-dependencies.rkt"
"lexical-structs.rkt"
"bootstrapped-primitives.rkt"
"compiler-structs.rkt"
"expression-structs.rkt"
"parameters.rkt"
"sets.rkt"
racket/list
racket/match)
(provide (all-defined-out))
(define-type Source (U OnlyStatements Any))
(define-struct: Configuration ([should-follow? : (Path -> Boolean)]
[on-module-statements : ((U Expression #f)
(Listof Statement)
-> Void)]
[after-module-statements : ((U Expression #f)
(Listof Statement)
-> Void)]
[after-last : (-> Void)])
#:mutable)
(define debug-configuration (make-Configuration
(lambda (p) #t)
(lambda (ast stmt)
(when (and ast (expression-module-path ast))
(printf "debug build configuration: visiting ~s\n"
(expression-module-path ast))))
(lambda (ast stmt)
(void))
(lambda ()
(void))))
(define-struct: OnlyStatements ([code : (Listof Statement)]))
(: only-bootstrapped-code : OnlyStatements)
(define only-bootstrapped-code (make-OnlyStatements (get-bootstrapping-code)))