diff --git a/bootstrapped-primitives.rkt b/bootstrapped-primitives.rkt index 86778eb..f87aafa 100644 --- a/bootstrapped-primitives.rkt +++ b/bootstrapped-primitives.rkt @@ -4,14 +4,19 @@ "il-structs.rkt" "compiler.rkt" "compiler-structs.rkt" - "typed-parse.rkt" - "parameters.rkt") + "typed-parse.rkt") + +(require/typed "parameters.rkt" + (current-defined-name (Parameterof (U Symbol LamPositionalName)))) + + (provide get-bootstrapping-code) + ;; The primitive code necessary to do call/cc (: call/cc-label Symbol) diff --git a/get-dependencies.rkt b/get-dependencies.rkt index 98f4424..a9385f4 100644 --- a/get-dependencies.rkt +++ b/get-dependencies.rkt @@ -10,8 +10,6 @@ (provide get-dependencies get-dependencies*) - - (: get-dependencies (Expression -> (Listof ModuleName))) (define (get-dependencies expr) (let ([deps ((inst new-set ModuleName))]) @@ -20,86 +18,16 @@ [(Top? expr) (visit (Top-code expr)) 'ok] - [(Constant? expr) - 'ok] - [(ToplevelRef? expr) - 'ok] - [(ToplevelSet? expr) - 'ok] - [(LocalRef? expr) - 'ok] - [(Branch? expr) - (visit (Branch-predicate expr)) - (visit (Branch-consequent expr)) - (visit (Branch-alternative expr)) - 'ok] - [(Lam? expr) - (visit (Lam-body expr)) - 'ok] - [(CaseLam? expr) - (for-each visit (CaseLam-clauses expr)) - 'ok] - [(EmptyClosureReference? expr) - 'ok] - [(Seq? expr) - (for-each visit (Seq-actions expr)) - 'ok] - [(Splice? expr) - (for-each visit (Splice-actions expr)) - 'ok] - [(Begin0? expr) - (for-each visit (Begin0-actions expr)) - 'ok] - [(App? expr) - (visit (App-operator expr)) - (for-each visit (App-operands expr)) - 'ok] - [(Let1? expr) - (visit (Let1-rhs expr)) - (visit (Let1-body expr)) - 'ok] - [(LetVoid? expr) - (visit (LetVoid-body expr)) - 'ok] - [(LetRec? expr) - (for-each visit (LetRec-procs expr)) - (visit (LetRec-body expr)) - 'ok] - [(InstallValue? expr) - (visit (InstallValue-body expr)) - 'ok] - [(BoxEnv? expr) - (visit (BoxEnv-body expr)) - 'ok] - [(WithContMark? expr) - (visit (WithContMark-key expr)) - (visit (WithContMark-value expr)) - (visit (WithContMark-body expr)) - 'ok] - [(ApplyValues? expr) - (visit (ApplyValues-proc expr)) - (visit (ApplyValues-args-expr expr)) - 'ok] - [(DefValues? expr) - (visit (DefValues-rhs expr)) - 'ok] - [(PrimitiveKernelValue? expr) - 'ok] [(Module? expr) (for-each (lambda: ([mn : ModuleName]) (set-insert! deps mn)) (Module-requires expr)) 'ok] - [(VariableReference? expr) - 'ok] - [(Require? expr) - (set-insert! deps (Require-path expr)) + [else 'ok])) (set->list deps))) - - (: get-dependencies* (Expression -> (Listof ModuleName))) (define (get-dependencies* expr) '()) \ No newline at end of file diff --git a/parameters.rkt b/parameters.rkt index 954f132..2efeec3 100644 --- a/parameters.rkt +++ b/parameters.rkt @@ -1,19 +1,23 @@ -#lang typed/racket/base +#lang racket/base (require "expression-structs.rkt" racket/path) + (provide current-defined-name current-module-path current-root-path) -(: current-defined-name (Parameterof (U Symbol LamPositionalName))) + + +;(: current-defined-name (Parameterof (U Symbol LamPositionalName))) (define current-defined-name (make-parameter 'unknown)) -(: current-module-path (Parameterof (U False Path))) -(define current-module-path (make-parameter #f)) +;(: current-module-path (Parameterof (U False Path))) +(define current-module-path + (make-parameter (build-path (current-directory) "anonymous-module.rkt"))) -(: current-root-path (Parameterof Path)) +;(: current-root-path (Parameterof Path)) (define current-root-path (make-parameter (normalize-path (current-directory)))) diff --git a/parse-bytecode-5.1.1.rkt b/parse-bytecode-5.1.1.rkt index 782d567..93b82e7 100644 --- a/parse-bytecode-5.1.1.rkt +++ b/parse-bytecode-5.1.1.rkt @@ -6,6 +6,8 @@ "path-rewriter.rkt" "parameters.rkt" "lam-entry-gensym.rkt" + "get-module-bytecode.rkt" + racket/path syntax/modresolve) @@ -17,7 +19,6 @@ (provide parse-bytecode - parse-bytecode/single-module reset-lam-label-counter!/unit-testing) @@ -105,31 +106,29 @@ -;; parse-bytecode: Input-Port -> Expression +;; parse-bytecode: (U Input-Port Path) -> Expression (define (parse-bytecode in) - (parameterize ([seen-closures (make-hasheq)]) - (let ([compilation-top (zo-parse in)]) - (parse-top compilation-top)))) + (cond + [(input-port? in) + (parameterize ([seen-closures (make-hasheq)]) + (let ([compilation-top (zo-parse in)]) + (parse-top compilation-top)))] + + [(path? in) + (let*-values ([(normal-path) (normalize-path in)] + [(base file-path dir?) (split-path normal-path)]) + (parameterize ([current-module-path normal-path] + [current-directory (cond [(path? base) + base] + [else + (error 'parse-bytecode)])]) + (parse-bytecode + (open-input-bytes (get-module-bytecode normal-path)))))] + [else + (error 'parse-bytecode "Don't know how to parse from ~e" in)])) -;; Similar to parse-bytecode, but does a little cleanup to make -;; sure the name is as expected. -(define (parse-bytecode/single-module in path-name) - (let ([parsed (parse-bytecode in)]) - (match parsed - [(struct Top - (prefix - (struct Module (name (struct ModuleName ('self 'self)) - prefix - requires - body)))) - (make-Top prefix - (make-Module name - (make-ModuleName path-name 'self) - prefix - requires - body))]))) diff --git a/test-get-dependencies.rkt b/test-get-dependencies.rkt new file mode 100644 index 0000000..f57595c --- /dev/null +++ b/test-get-dependencies.rkt @@ -0,0 +1,14 @@ +#lang racket +(require "get-dependencies.rkt" + "get-module-bytecode.rkt" + "parse-bytecode-5.1.1.rkt") + +(define e + (parse-bytecode (build-path "get-dependencies.rkt"))) + +(get-dependencies e) + + + + + (get-dependencies (parse-bytecode (build-path "/home/dyoo/local/racket-5.1.1/lib/racket/collects/scheme/base.rkt"))) \ No newline at end of file diff --git a/test-helpers.rkt b/test-helpers.rkt index 9a88bc1..13c452b 100644 --- a/test-helpers.rkt +++ b/test-helpers.rkt @@ -5,11 +5,12 @@ "compiler-structs.rkt" "compiler.rkt" "parse-bytecode-5.1.1.rkt" + "get-module-bytecode.rkt" "language-namespace.rkt" syntax/modcode) -(provide parse run-compiler) +(provide parse parse-module run-compiler) (define-runtime-path kernel-language-path "lang/kernel.rkt") @@ -32,6 +33,9 @@ (open-input-bytes (get-output-bytes op)))))) +(define (parse-module x) + (parse-bytecode (open-input-bytes (get-module-bytecode x)))) + (define (run-compiler code) (compile (parse code) 'val next-linkage/drop-multiple)) \ No newline at end of file