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

seeing if we can reliably get the module bytecode

Browse Source
This commit is contained in:
Danny Yoo 2011-05-19 15:43:30 -04:00
parent 7350d5d832
commit 5576e962f6
6 changed files with 57 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
bootstrapped-primitives.rkt
View File

@ -4,14 +4,19 @@
"il-structs.rkt" "il-structs.rkt"
"compiler.rkt" "compiler.rkt"
"compiler-structs.rkt" "compiler-structs.rkt"
"typed-parse.rkt" "typed-parse.rkt")
"parameters.rkt")
(require/typed "parameters.rkt"
(current-defined-name (Parameterof (U Symbol LamPositionalName))))
(provide get-bootstrapping-code) (provide get-bootstrapping-code)
;; The primitive code necessary to do call/cc ;; The primitive code necessary to do call/cc
(: call/cc-label Symbol) (: call/cc-label Symbol)

74
get-dependencies.rkt
View File

@ -10,8 +10,6 @@
(provide get-dependencies get-dependencies*) (provide get-dependencies get-dependencies*)
(: get-dependencies (Expression -> (Listof ModuleName))) (: get-dependencies (Expression -> (Listof ModuleName)))
(define (get-dependencies expr) (define (get-dependencies expr)
(let ([deps ((inst new-set ModuleName))]) (let ([deps ((inst new-set ModuleName))])
@ -20,86 +18,16 @@
[(Top? expr) [(Top? expr)
(visit (Top-code expr)) (visit (Top-code expr))
'ok] '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) [(Module? expr)
(for-each (lambda: ([mn : ModuleName]) (for-each (lambda: ([mn : ModuleName])
(set-insert! deps mn)) (set-insert! deps mn))
(Module-requires expr)) (Module-requires expr))
'ok] 'ok]
[(VariableReference? expr) [else
'ok]
[(Require? expr)
(set-insert! deps (Require-path expr))
'ok])) 'ok]))
(set->list deps))) (set->list deps)))
(: get-dependencies* (Expression -> (Listof ModuleName))) (: get-dependencies* (Expression -> (Listof ModuleName)))
(define (get-dependencies* expr) (define (get-dependencies* expr)
'()) '())

14
parameters.rkt
View File

@ -1,19 +1,23 @@
#lang typed/racket/base #lang racket/base
(require "expression-structs.rkt" (require "expression-structs.rkt"
racket/path) racket/path)
(provide current-defined-name (provide current-defined-name
current-module-path current-module-path
current-root-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)) (define current-defined-name (make-parameter 'unknown))
(: current-module-path (Parameterof (U False Path))) ;(: current-module-path (Parameterof (U False Path)))
(define current-module-path (make-parameter #f)) (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 (define current-root-path
(make-parameter (normalize-path (current-directory)))) (make-parameter (normalize-path (current-directory))))

43
parse-bytecode-5.1.1.rkt
View File

@ -6,6 +6,8 @@
"path-rewriter.rkt" "path-rewriter.rkt"
"parameters.rkt" "parameters.rkt"
"lam-entry-gensym.rkt" "lam-entry-gensym.rkt"
"get-module-bytecode.rkt"
racket/path
syntax/modresolve) syntax/modresolve)
@ -17,7 +19,6 @@
(provide parse-bytecode (provide parse-bytecode
parse-bytecode/single-module
reset-lam-label-counter!/unit-testing) 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) (define (parse-bytecode in)
(parameterize ([seen-closures (make-hasheq)]) (cond
(let ([compilation-top (zo-parse in)]) [(input-port? in)
(parse-top compilation-top)))) (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))])))

14
test-get-dependencies.rkt Normal file
View File

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

6
test-helpers.rkt
View File

@ -5,11 +5,12 @@
"compiler-structs.rkt" "compiler-structs.rkt"
"compiler.rkt" "compiler.rkt"
"parse-bytecode-5.1.1.rkt" "parse-bytecode-5.1.1.rkt"
"get-module-bytecode.rkt"
"language-namespace.rkt" "language-namespace.rkt"
syntax/modcode) syntax/modcode)
(provide parse run-compiler) (provide parse parse-module run-compiler)
(define-runtime-path kernel-language-path (define-runtime-path kernel-language-path
"lang/kernel.rkt") "lang/kernel.rkt")
@ -32,6 +33,9 @@
(open-input-bytes (get-output-bytes op)))))) (open-input-bytes (get-output-bytes op))))))
(define (parse-module x)
(parse-bytecode (open-input-bytes (get-module-bytecode x))))
(define (run-compiler code) (define (run-compiler code)
(compile (parse code) 'val next-linkage/drop-multiple)) (compile (parse code) 'val next-linkage/drop-multiple))