diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index 3717657..51559a7 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -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 #< 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)]))) diff --git a/make-structs.rkt b/make-structs.rkt new file mode 100644 index 0000000..c77b840 --- /dev/null +++ b/make-structs.rkt @@ -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)))