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

Renamed ModuleName to ModuleLocator, since that's more accurate of a name.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-24 11:07:21 -04:00
parent 246549465e
commit 042f52f45c
14 changed files with 65 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler.rkt
View File

@ -359,7 +359,7 @@
`(,(make-AssignImmediateStatement target (make-Const (void))))))))
(: compile-module-invoke (ModuleName -> InstructionSequence))
(: compile-module-invoke (ModuleLocator -> InstructionSequence))
;; Generates code that will invoke a module (if it hasn't been invoked yet)
;; FIXME: assumes the module has already been linked. We should error out
;; if the module hasn't been linked yet.
@ -381,7 +381,7 @@
;; linked yet.
,(make-DebugPrint (make-Const
(format "DEBUG: the module ~a hasn't been linked in!!!"
(ModuleName-name a-module-name))))
(ModuleLocator-name a-module-name))))
,(make-GotoStatement (make-Label already-loaded))
,linked
,(make-TestAndBranchStatement (make-TestTrue
@ -397,12 +397,12 @@
,already-loaded)))]))
(: kernel-module-name? (ModuleName -> Boolean))
(: kernel-module-name? (ModuleLocator -> Boolean))
;; Produces true if the module is hardcoded.
(define (kernel-module-name? name)
(or (and (eq? (ModuleName-name name) '#%kernel)
(eq? (ModuleName-real-path name) '#%kernel))
(eq? (ModuleName-name name) 'whalesong/lang/kernel)))
(or (and (eq? (ModuleLocator-name name) '#%kernel)
(eq? (ModuleLocator-real-path name) '#%kernel))
(eq? (ModuleLocator-name name) 'whalesong/lang/kernel)))
@ -977,7 +977,7 @@
(default)]
[(ModuleVariable? op-knowledge)
(cond
[(symbol=? (ModuleName-name
[(symbol=? (ModuleLocator-name
(ModuleVariable-module-name op-knowledge))
'#%kernel)
(let ([op (ModuleVariable-name op-knowledge)])

6
expression-structs.rkt
View File

@ -34,9 +34,9 @@
(define-struct: Module ([name : Symbol]
[path : ModuleName]
[path : ModuleLocator]
[prefix : Prefix]
[requires : (Listof ModuleName)]
[requires : (Listof ModuleLocator)]
[code : Expression])
#:transparent)
@ -143,7 +143,7 @@
(define-struct: VariableReference ([toplevel : ToplevelRef]) #:transparent)
(define-struct: Require ([path : ModuleName]) #:transparent)
(define-struct: Require ([path : ModuleLocator]) #:transparent)

10
get-dependencies.rkt
View File

@ -11,16 +11,16 @@
expression-module-path)
(: get-dependencies (Expression -> (Listof ModuleName)))
(: get-dependencies (Expression -> (Listof ModuleLocator)))
(define (get-dependencies expr)
(let ([deps ((inst new-set ModuleName))])
(let ([deps ((inst new-set ModuleLocator))])
(let: visit : 'ok ([expr : Expression expr])
(cond
[(Top? expr)
(visit (Top-code expr))
'ok]
[(Module? expr)
(for-each (lambda: ([mn : ModuleName])
(for-each (lambda: ([mn : ModuleLocator])
(set-insert! deps mn))
(Module-requires expr))
'ok]
@ -29,8 +29,8 @@
(set->list deps)))
(: expression-module-path (Expression -> (U False ModuleName)))
;; Given a toplevel expression of a module, returns its self-declared ModuleName.
(: expression-module-path (Expression -> (U False ModuleLocator)))
;; Given a toplevel expression of a module, returns its self-declared ModuleLocator.
;; If we can't find one, return false.
(define (expression-module-path expr)
(cond

8
il-structs.rkt
View File

@ -95,15 +95,15 @@
#:transparent)
;; Produces the entry point of the module.
(define-struct: ModuleEntry ([name : ModuleName])
(define-struct: ModuleEntry ([name : ModuleLocator])
#:transparent)
;; Produces true if the module has already been invoked
(define-struct: IsModuleInvoked ([name : ModuleName])
(define-struct: IsModuleInvoked ([name : ModuleLocator])
#:transparent)
;; Produces true if the module has been loaded into the machine
(define-struct: IsModuleLinked ([name : ModuleName])
(define-struct: IsModuleLinked ([name : ModuleLocator])
#:transparent)
@ -408,7 +408,7 @@
;; Installs a module record into the machine
(define-struct: InstallModuleEntry! ([name : Symbol]
[path : ModuleName]
[path : ModuleLocator]
[entry-point : Symbol])
#:transparent)

6
js-assembler/assemble-helpers.rkt
View File

@ -279,19 +279,19 @@
(: assemble-module-entry (ModuleEntry -> String))
(define (assemble-module-entry entry)
(format "MACHINE.modules[~s].label"
(symbol->string (ModuleName-name (ModuleEntry-name entry)))))
(symbol->string (ModuleLocator-name (ModuleEntry-name entry)))))
(: assemble-is-module-invoked (IsModuleInvoked -> String))
(define (assemble-is-module-invoked entry)
(format "MACHINE.modules[~s].label"
(symbol->string (ModuleName-name (IsModuleInvoked-name entry)))))
(symbol->string (ModuleLocator-name (IsModuleInvoked-name entry)))))
(: assemble-is-module-linked (IsModuleLinked -> String))
(define (assemble-is-module-linked entry)
(format "(MACHINE.modules[~s] !== undefined)"
(symbol->string (ModuleName-name (IsModuleLinked-name entry)))))
(symbol->string (ModuleLocator-name (IsModuleLinked-name entry)))))

2
js-assembler/assemble-perform-statement.rkt
View File

@ -133,6 +133,6 @@
[(InstallModuleEntry!? op)
(format "MACHINE.modules[~s]=new RUNTIME.ModuleRecord(~s, ~a);"
(symbol->string (ModuleName-name (InstallModuleEntry!-path op)))
(symbol->string (ModuleLocator-name (InstallModuleEntry!-path op)))
(symbol->string (InstallModuleEntry!-name op))
(assemble-label (make-Label (InstallModuleEntry!-entry-point op))))]))

6
lexical-structs.rkt
View File

@ -16,14 +16,14 @@
#:transparent)
;; A ModuleName is an identifier for a Module.
(define-struct: ModuleName ([name : Symbol]
;; A ModuleLocator is an identifier for a Module.
(define-struct: ModuleLocator ([name : Symbol]
[real-path : (U Symbol Path)])
#:transparent)
(define-struct: ModuleVariable ([name : Symbol]
[module-name : ModuleName])
[module-name : ModuleLocator])
#:transparent)

4
make-dependencies.rkt
View File

@ -74,9 +74,9 @@
[else
(let* ([dependent-module-names (get-dependencies ast)]
[paths
(foldl (lambda: ([mp : ModuleName]
(foldl (lambda: ([mp : ModuleLocator]
[acc : (Listof Source)])
(let ([rp [ModuleName-real-path mp]])
(let ([rp [ModuleLocator-real-path mp]])
(cond [(and (path? rp)
(should-follow? rp)

22
parse-bytecode-5.1.1.rkt
View File

@ -157,18 +157,18 @@
;; maybe-fix-module-name: expression -> expression
;; When we're compiling a module directly from memory, it doesn't have a file path.
;; We rewrite the ModuleName to its given name.
;; We rewrite the ModuleLocator to its given name.
(define (maybe-fix-module-name exp)
(match exp
[(struct Top (top-prefix
(struct Module ((and name (? symbol?))
(struct ModuleName ('self 'self))
(struct ModuleLocator ('self 'self))
module-prefix
module-requires
module-code))))
(make-Top top-prefix
(make-Module name
(make-ModuleName name name) (current-module-path)
(make-ModuleLocator name name) (current-module-path)
module-prefix
module-requires
module-code))]
@ -218,12 +218,12 @@
(define (wrap-module-name resolved-path-name)
(cond
[(symbol? resolved-path-name)
(make-ModuleName resolved-path-name resolved-path-name)]
(make-ModuleLocator resolved-path-name resolved-path-name)]
[(path? resolved-path-name)
(let ([rewritten-path (rewrite-path resolved-path-name)])
(cond
[(symbol? rewritten-path)
(make-ModuleName (rewrite-path resolved-path-name)
(make-ModuleLocator (rewrite-path resolved-path-name)
(normalize-path resolved-path-name))]
[else
(error 'wrap-module-name "Unable to resolve module path ~s."
@ -287,12 +287,12 @@
(let ([resolved-path ((current-module-path-resolver) path (current-module-path))])
(cond
[(symbol? resolved-path)
(make-Require (make-ModuleName resolved-path resolved-path))]
(make-Require (make-ModuleLocator resolved-path resolved-path))]
[(path? resolved-path)
(let ([rewritten-path (rewrite-path resolved-path)])
(cond
[(symbol? rewritten-path)
(make-Require (make-ModuleName rewritten-path
(make-Require (make-ModuleLocator rewritten-path
(normalize-path resolved-path)))]
[else
(printf "Internal error: I don't know how to handle the require for ~s" require-statement)
@ -304,7 +304,7 @@
(printf "Internal error: I don't know how to handle the require for ~s" require-statement)
(error 'parse-req)]))])))
;; parse-req-reqs: (stx -> (listof ModuleName))
;; parse-req-reqs: (stx -> (listof ModuleLocator))
(define (parse-req-reqs reqs)
(match reqs
[(struct stx (encoded))
@ -371,7 +371,7 @@
(cond
[(symbol? self-path)
(make-Module name
(make-ModuleName self-path self-path)
(make-ModuleLocator self-path self-path)
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
(parse-mod-body body))]
@ -380,7 +380,7 @@
(cond
[(symbol? rewritten-path)
(make-Module name
(make-ModuleName rewritten-path
(make-ModuleLocator rewritten-path
(normalize-path self-path))
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
@ -389,7 +389,7 @@
(error 'parse-mod "Internal error: unable to resolve module path ~s" self-path)]))]))]))
;; parse-mod-requires: module-path-index (listof (pair (U Integer #f) (listof module-path-index))) -> (listof ModuleName)
;; parse-mod-requires: module-path-index (listof (pair (U Integer #f) (listof module-path-index))) -> (listof ModuleLocator)
(define (parse-mod-requires enclosing-module-path-index requires)
;; We only care about phase 0 --- the runtime.
(let ([resolver (current-module-path-index-resolver)])

2
parse.rkt
View File

@ -51,7 +51,7 @@
[(current-language)
=> (lambda (lang)
(if (member sym lang)
(make-ModuleVariable sym (make-ModuleName '#%kernel '#%kernel))
(make-ModuleVariable sym (make-ModuleLocator '#%kernel '#%kernel))
#f))]
[else
#f]))

12
simulator/simulator.rkt
View File

@ -458,12 +458,12 @@
[(InstallModuleEntry!? op)
(printf "installing module ~s\n"
(ModuleName-name
(ModuleLocator-name
(InstallModuleEntry!-path op)))
(hash-set! (machine-modules m)
(ModuleName-name (InstallModuleEntry!-path op))
(ModuleLocator-name (InstallModuleEntry!-path op))
(make-module-record (InstallModuleEntry!-name op)
(ModuleName-name
(ModuleLocator-name
(InstallModuleEntry!-path op))
(InstallModuleEntry!-entry-point op)
#f
@ -856,17 +856,17 @@
[(ModuleEntry? an-oparg)
(let ([a-module (hash-ref (machine-modules m)
(ModuleName-name (ModuleEntry-name an-oparg)))])
(ModuleLocator-name (ModuleEntry-name an-oparg)))])
(module-record-label a-module))]
[(IsModuleInvoked? an-oparg)
(let ([a-module (hash-ref (machine-modules m)
(ModuleName-name (IsModuleInvoked-name an-oparg)))])
(ModuleLocator-name (IsModuleInvoked-name an-oparg)))])
(module-record-invoked? a-module))]
[(IsModuleLinked? an-oparg)
(hash-has-key? (machine-modules m)
(ModuleName-name (IsModuleLinked-name an-oparg)))]
(ModuleLocator-name (IsModuleLinked-name an-oparg)))]
[(VariableReference? an-oparg)
(let ([t (VariableReference-toplevel an-oparg)])

10
tests/test-get-dependencies.rkt
View File

@ -31,8 +31,8 @@
(define (module-name< x y)
(string<? (symbol->string (ModuleName-name x))
(symbol->string (ModuleName-name y))))
(string<? (symbol->string (ModuleLocator-name x))
(symbol->string (ModuleLocator-name y))))
@ -61,10 +61,10 @@
module-name<)
(sort
(list (make-ModuleName 'collects/racket/base.rkt
(list (make-ModuleLocator 'collects/racket/base.rkt
(normalize-path (build-path collects-dir "racket" "base.rkt")))
(make-ModuleName 'collects/racket/math.rkt
(make-ModuleLocator 'collects/racket/math.rkt
(normalize-path (build-path collects-dir "racket" "math.rkt")))
(make-ModuleName 'whalesong/get-module-bytecode.rkt
(make-ModuleLocator 'whalesong/get-module-bytecode.rkt
(normalize-path (build-path compiler-path "get-module-bytecode.rkt"))))
module-name<)))

12
tests/test-parse-bytecode.rkt
View File

@ -340,7 +340,7 @@
42))
[(struct Top ((struct Prefix (list))
(struct Module ((? symbol?)
(? ModuleName?)
(? ModuleLocator?)
(? Prefix?) ;; the prefix will include a reference to print-values.
_ ;; requires
(struct Splice ((list (struct ApplyValues
@ -354,7 +354,7 @@
(define x "x")))
[(struct Top ((struct Prefix ((? list?)))
(struct Module ((? symbol?)
(? ModuleName?)
(? ModuleLocator?)
(? Prefix?) ;; the prefix will include a reference to print-values.
_ ;; requires
(struct Splice ((list (struct DefValues
@ -409,7 +409,7 @@
(match (run-my-parse #'(module foo racket/base))
[(struct Top ((? Prefix?)
(struct Module ('foo
(struct ModuleName
(struct ModuleLocator
('whalesong/tests/foo.rkt
(? (lambda (p)
(and (path? p)
@ -418,7 +418,7 @@
(build-path this-test-path "foo.rkt"))))))))
(struct Prefix (list))
(list (struct ModuleName ('collects/racket/base.rkt
(list (struct ModuleLocator ('collects/racket/base.rkt
_)))
(struct Splice ('()))))))
#t]
@ -434,9 +434,9 @@
(#%provide f))))
[(struct Top ((struct Prefix ((list '#f)))
(struct Module ('foo
(struct ModuleName ('self _ #;(build-path "root/foo/bar.rkt")))
(struct ModuleLocator ('self _ #;(build-path "root/foo/bar.rkt")))
(struct Prefix ((list 'f)))
(list (struct ModuleName ('#%kernel '#%kernel)))
(list (struct ModuleLocator ('#%kernel '#%kernel)))
(struct Splice ((list (struct DefValues ((list (struct ToplevelRef (0 0)))
(struct Constant ('ok)))))))))))
'#t]))

16
tests/test-parse.rkt
View File

@ -211,7 +211,7 @@
'lamEntry2)))
(test (parse '(+ x x))
(make-Top (make-Prefix `(,(make-ModuleVariable '+ (make-ModuleName '#%kernel '#%kernel))
(make-Top (make-Prefix `(,(make-ModuleVariable '+ (make-ModuleLocator '#%kernel '#%kernel))
x))
(make-App (make-ToplevelRef 2 0)
(list (make-ToplevelRef 2 1)
@ -219,7 +219,7 @@
(test (parse '(lambda (x) (+ x x)))
(make-Top (make-Prefix `(,(make-ModuleVariable '+ (make-ModuleName '#%kernel '#%kernel))))
(make-Top (make-Prefix `(,(make-ModuleVariable '+ (make-ModuleLocator '#%kernel '#%kernel))))
(make-Lam 'unknown 1 #f
(make-App (make-ToplevelRef 2 0)
(list (make-LocalRef 3 #f)
@ -229,8 +229,8 @@
(test (parse '(lambda (x)
(+ (* x x) x)))
(make-Top (make-Prefix `(,(make-ModuleVariable '* (make-ModuleName '#%kernel '#%kernel))
,(make-ModuleVariable '+ (make-ModuleName '#%kernel '#%kernel))))
(make-Top (make-Prefix `(,(make-ModuleVariable '* (make-ModuleLocator '#%kernel '#%kernel))
,(make-ModuleVariable '+ (make-ModuleLocator '#%kernel '#%kernel))))
(make-Lam 'unknown 1 #f
;; stack layout: [???, ???, prefix, x]
(make-App (make-ToplevelRef 2 1)
@ -289,7 +289,7 @@
(test (parse '(let* ([x 3]
[x (add1 x)])
(add1 x)))
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 (make-ModuleName '#%kernel '#%kernel))))
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 (make-ModuleLocator '#%kernel '#%kernel))))
;; stack layout: [prefix]
@ -418,7 +418,7 @@
(test (parse '(let ([x 0])
(lambda ()
(set! x (add1 x)))))
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 (make-ModuleName '#%kernel '#%kernel))))
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 (make-ModuleLocator '#%kernel '#%kernel))))
(make-Let1 (make-Constant 0)
(make-BoxEnv 0
(make-Lam 'unknown 0 #f
@ -437,7 +437,7 @@
[y 1])
(lambda ()
(set! x (add1 x)))))
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 (make-ModuleName '#%kernel '#%kernel))))
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 (make-ModuleLocator '#%kernel '#%kernel))))
(make-LetVoid 2
(make-Seq (list
(make-InstallValue 1 0 (make-Constant 0) #t)
@ -465,7 +465,7 @@
(reset!)
(list a b)))
(make-Top
(make-Prefix `(a b ,(make-ModuleVariable 'list (make-ModuleName '#%kernel '#%kernel)) reset!))
(make-Prefix `(a b ,(make-ModuleVariable 'list (make-ModuleLocator '#%kernel '#%kernel)) reset!))
(make-Splice
(list
(make-ToplevelSet 0 0 (make-Constant '(hello)))