fix for issue 86: pruning dead test targets away for now
This commit is contained in:
commit
ca2e773d36
|
@ -312,9 +312,6 @@
|
|||
;; Generates code to write out the top prefix, evaluate the rest of the body,
|
||||
;; and then pop the top prefix off.
|
||||
(define (compile-module mod cenv target linkage)
|
||||
;; fixme: this is not right yet. This should instead install a module record
|
||||
;; that has not yet been invoked.
|
||||
;; fixme: This also needs to generate code for the requires and provides.
|
||||
(match mod
|
||||
[(struct Module (name path prefix requires provides code))
|
||||
(let*: ([after-module-body (make-label 'afterModuleBody)]
|
||||
|
@ -342,7 +339,7 @@
|
|||
|
||||
(make-AssignImmediate (make-ModulePrefixTarget path)
|
||||
(make-EnvWholePrefixReference 0))
|
||||
;; TODO: we need to sequester the prefix of the module with the record.
|
||||
|
||||
(compile (Module-code mod)
|
||||
(cons (Module-prefix mod) module-cenv)
|
||||
'val
|
||||
|
@ -353,7 +350,7 @@
|
|||
(make-AssignImmediate 'proc (make-ControlStackLabel))
|
||||
(make-PopControlFrame)
|
||||
|
||||
|
||||
;; We sequester the prefix of the module with the record.
|
||||
(make-Perform (make-FinalizeModuleInvokation! path))
|
||||
(make-Goto (make-Reg 'proc))
|
||||
|
||||
|
@ -381,8 +378,7 @@
|
|||
[on-return (make-LinkedLabel (make-label 'onReturn)
|
||||
on-return-multiple)])
|
||||
(append-instruction-sequences
|
||||
(make-TestAndJump (make-TestTrue
|
||||
(make-IsModuleLinked a-module-name))
|
||||
(make-TestAndJump (make-TestTrue (make-ModulePredicate a-module-name 'linked?))
|
||||
linked)
|
||||
;; TODO: raise an exception here that says that the module hasn't been
|
||||
;; linked yet.
|
||||
|
@ -392,7 +388,7 @@
|
|||
(make-Goto (make-Label (LinkedLabel-label on-return)))
|
||||
linked
|
||||
(make-TestAndJump (make-TestTrue
|
||||
(make-IsModuleInvoked a-module-name))
|
||||
(make-ModulePredicate a-module-name 'invoked?))
|
||||
(LinkedLabel-label on-return))
|
||||
(make-PushControlFrame/Call on-return)
|
||||
(make-Goto (ModuleEntry a-module-name))
|
||||
|
@ -409,6 +405,18 @@
|
|||
((current-kernel-module-locator?) name))
|
||||
|
||||
|
||||
;; (: kernel-module-locator? (ModuleLocator -> Boolean))
|
||||
;; ;; Produces true if the ModuleLocator is pointing to a module that's marked
|
||||
;; ;; as kernel.
|
||||
;; (define (kernel-module-locator? a-module-locator)
|
||||
;; (or (symbol=? (ModuleLocator-name
|
||||
;; a-module-locator)
|
||||
;; '#%kernel)
|
||||
;; (symbol=? (ModuleLocator-name
|
||||
;; a-module-locator)
|
||||
;; 'whalesong/lang/kernel.rkt)))
|
||||
|
||||
|
||||
|
||||
|
||||
(: emit-singular-context (Linkage -> InstructionSequence))
|
||||
|
@ -496,16 +504,26 @@
|
|||
cenv
|
||||
(append-instruction-sequences
|
||||
|
||||
;; If it's a module variable, we need to look there.
|
||||
(cond
|
||||
[(ModuleVariable? prefix-element)
|
||||
(cond [(kernel-module-name? (ModuleVariable-module-name prefix-element))
|
||||
(make-AssignPrimOp target
|
||||
(make-PrimitivesReference
|
||||
(ModuleVariable-name prefix-element)))]
|
||||
[else
|
||||
(make-AssignPrimOp target prefix-element)])]
|
||||
[else
|
||||
(append-instruction-sequences
|
||||
(if (ToplevelRef-check-defined? exp)
|
||||
(make-Perform (make-CheckToplevelBound!
|
||||
(ToplevelRef-depth exp)
|
||||
(ToplevelRef-pos exp)))
|
||||
empty-instruction-sequence)
|
||||
|
||||
(make-AssignImmediate
|
||||
target
|
||||
(make-EnvPrefixReference (ToplevelRef-depth exp)
|
||||
(ToplevelRef-pos exp)))
|
||||
(ToplevelRef-pos exp))))])
|
||||
singular-context-check))))
|
||||
|
||||
|
||||
|
@ -518,8 +536,13 @@
|
|||
(let ([lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp)
|
||||
(ToplevelSet-pos exp))])
|
||||
(let ([get-value-code
|
||||
(compile (ToplevelSet-value exp) cenv lexical-pos
|
||||
(cond
|
||||
[(ModuleVariable? prefix-element)
|
||||
(compile (ToplevelSet-value exp) cenv prefix-element
|
||||
next-linkage/expects-single)]
|
||||
[else
|
||||
(compile (ToplevelSet-value exp) cenv lexical-pos
|
||||
next-linkage/expects-single)])]
|
||||
[singular-context-check (emit-singular-context linkage)])
|
||||
(end-with-linkage
|
||||
linkage
|
||||
|
@ -991,7 +1014,7 @@
|
|||
id)]
|
||||
[(ModuleVariable? op-knowledge)
|
||||
(cond
|
||||
[(kernel-module-locator? (ModuleVariable-module-name op-knowledge))
|
||||
[(kernel-module-name? (ModuleVariable-module-name op-knowledge))
|
||||
(ModuleVariable-name op-knowledge)]
|
||||
[else
|
||||
#f])]
|
||||
|
@ -1000,16 +1023,6 @@
|
|||
|
||||
|
||||
|
||||
(: kernel-module-locator? (ModuleLocator -> Boolean))
|
||||
;; Produces true if the ModuleLocator is pointing to a module that's marked
|
||||
;; as kernel.
|
||||
(define (kernel-module-locator? a-module-locator)
|
||||
(or (symbol=? (ModuleLocator-name
|
||||
a-module-locator)
|
||||
'#%kernel)
|
||||
(symbol=? (ModuleLocator-name
|
||||
a-module-locator)
|
||||
'whalesong/lang/kernel.rkt)))
|
||||
|
||||
|
||||
|
||||
|
@ -1168,7 +1181,8 @@
|
|||
[operand-poss
|
||||
(simple-operands->opargs (map (lambda: ([op : Expression])
|
||||
(adjust-expression-depth op n n))
|
||||
(App-operands exp)))])
|
||||
(App-operands exp))
|
||||
operand-knowledge)])
|
||||
(end-with-linkage
|
||||
linkage cenv
|
||||
(append-instruction-sequences
|
||||
|
@ -1205,11 +1219,13 @@
|
|||
(length constant-operands)
|
||||
n))
|
||||
rest-operands))]
|
||||
[(constant-operand-knowledge)
|
||||
(map (lambda: ([arg : Expression])
|
||||
(extract-static-knowledge arg extended-cenv))
|
||||
constant-operands)]
|
||||
|
||||
[(operand-knowledge)
|
||||
(append (map (lambda: ([arg : Expression])
|
||||
(extract-static-knowledge arg extended-cenv))
|
||||
constant-operands)
|
||||
(append constant-operand-knowledge
|
||||
(map (lambda: ([arg : Expression])
|
||||
(extract-static-knowledge arg extended-cenv))
|
||||
rest-operands))]
|
||||
|
@ -1229,7 +1245,7 @@
|
|||
(make-Const 0))]
|
||||
|
||||
[(constant-operand-poss)
|
||||
(simple-operands->opargs constant-operands)]
|
||||
(simple-operands->opargs constant-operands constant-operand-knowledge)]
|
||||
|
||||
[(rest-operand-poss)
|
||||
(build-list (length rest-operands)
|
||||
|
@ -1267,15 +1283,17 @@
|
|||
(define (ensure-simple-expression e)
|
||||
(if (or (Constant? e)
|
||||
(LocalRef? e)
|
||||
(ToplevelRef? e))
|
||||
(ToplevelRef? e)
|
||||
)
|
||||
e
|
||||
(error 'ensure-simple-expression)))
|
||||
|
||||
|
||||
(: simple-operands->opargs ((Listof Expression) -> (Listof OpArg)))
|
||||
;; Produces a list of OpArgs if all the operands are particularly simple, and false therwise.
|
||||
(define (simple-operands->opargs rands)
|
||||
(map (lambda: ([e : Expression])
|
||||
(: simple-operands->opargs ((Listof Expression) (Listof CompileTimeEnvironmentEntry) -> (Listof (U OpArg ModuleVariable))))
|
||||
;; Produces a list of OpArgs if all the operands are particularly simple, and false otherwise.
|
||||
(define (simple-operands->opargs rands knowledge)
|
||||
(map (lambda: ([e : Expression]
|
||||
[k : CompileTimeEnvironmentEntry])
|
||||
(cond
|
||||
[(Constant? e)
|
||||
(make-Const (ensure-const-value (Constant-v e)))]
|
||||
|
@ -1283,11 +1301,15 @@
|
|||
(make-EnvLexicalReference (LocalRef-depth e)
|
||||
(LocalRef-unbox? e))]
|
||||
[(ToplevelRef? e)
|
||||
(make-EnvPrefixReference (ToplevelRef-depth e)
|
||||
(ToplevelRef-pos e))]
|
||||
(cond
|
||||
[(ModuleVariable? k)
|
||||
k]
|
||||
[else
|
||||
(make-EnvPrefixReference (ToplevelRef-depth e) (ToplevelRef-pos e))])]
|
||||
[else
|
||||
(error 'all-operands-are-constant "Impossible")]))
|
||||
rands))
|
||||
rands
|
||||
knowledge))
|
||||
|
||||
|
||||
|
||||
|
@ -2212,6 +2234,8 @@
|
|||
[(ControlFrameTemporary? target)
|
||||
target]
|
||||
[(ModulePrefixTarget? target)
|
||||
target]
|
||||
[(ModuleVariable? target)
|
||||
target]))
|
||||
|
||||
|
||||
|
|
|
@ -35,10 +35,10 @@
|
|||
CompiledProcedureEntry
|
||||
CompiledProcedureClosureReference
|
||||
ModuleEntry
|
||||
IsModuleInvoked
|
||||
IsModuleLinked
|
||||
ModulePredicate
|
||||
PrimitiveKernelValue
|
||||
VariableReference))
|
||||
VariableReference
|
||||
))
|
||||
|
||||
|
||||
;; Targets: these are the allowable lhs's for a targetted assignment.
|
||||
|
@ -47,7 +47,11 @@
|
|||
EnvPrefixReference
|
||||
PrimitivesReference
|
||||
ControlFrameTemporary
|
||||
ModulePrefixTarget))
|
||||
ModulePrefixTarget
|
||||
ModuleVariable
|
||||
))
|
||||
|
||||
(define-struct: ModuleVariableThing () #:transparent)
|
||||
|
||||
|
||||
;; When we need to store a value temporarily in the top control frame, we can use this as a target.
|
||||
|
@ -63,6 +67,11 @@
|
|||
(define-struct: ModulePrefixTarget ([path : ModuleLocator])
|
||||
#:transparent)
|
||||
|
||||
(define-struct: ModuleVariableReference ([name : Symbol]
|
||||
[module-name : ModuleLocator])
|
||||
#:transparent)
|
||||
|
||||
|
||||
|
||||
(define-type const-value
|
||||
(Rec C
|
||||
|
@ -148,12 +157,9 @@
|
|||
(define-struct: ModuleEntry ([name : ModuleLocator])
|
||||
#:transparent)
|
||||
|
||||
;; Produces true if the module has already been invoked
|
||||
(define-struct: IsModuleInvoked ([name : ModuleLocator])
|
||||
#:transparent)
|
||||
|
||||
;; Produces true if the module has been loaded into the machine
|
||||
(define-struct: IsModuleLinked ([name : ModuleLocator])
|
||||
(define-struct: ModulePredicate ([module-name : ModuleLocator]
|
||||
[pred : (U 'invoked? 'linked?)])
|
||||
#:transparent)
|
||||
|
||||
|
||||
|
@ -281,10 +287,15 @@
|
|||
;; Primitive Operators
|
||||
|
||||
;; The operators that return values, that are used in AssignPrimopStatement.
|
||||
;; The reason this is here is really to get around what looks like a Typed Racket issue.
|
||||
;; I would prefer to move these all to OpArgs, but if I do, Typed Racket takes much longer
|
||||
;; to type my program than I'd like.
|
||||
(define-type PrimitiveOperator (U GetCompiledProcedureEntry
|
||||
MakeCompiledProcedure
|
||||
MakeCompiledProcedureShell
|
||||
|
||||
ModuleVariable
|
||||
PrimitivesReference
|
||||
|
||||
MakeBoxedEnvironmentValue
|
||||
|
||||
|
@ -322,7 +333,7 @@
|
|||
|
||||
(define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName/Inline]
|
||||
|
||||
[operands : (Listof OpArg)]
|
||||
[operands : (Listof (U OpArg ModuleVariable))]
|
||||
[expected-operand-types : (Listof OperandDomain)]
|
||||
;; For each operand, #t will add code to typecheck the operand
|
||||
[typechecks? : (Listof Boolean)])
|
||||
|
|
|
@ -102,9 +102,7 @@
|
|||
oparg]
|
||||
[(ModuleEntry? oparg)
|
||||
oparg]
|
||||
[(IsModuleInvoked? oparg)
|
||||
oparg]
|
||||
[(IsModuleLinked? oparg)
|
||||
[(ModulePredicate? oparg)
|
||||
oparg]
|
||||
[(PrimitiveKernelValue? oparg)
|
||||
oparg]
|
||||
|
@ -142,7 +140,14 @@
|
|||
op]
|
||||
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
op]))
|
||||
op]
|
||||
|
||||
[(ModuleVariable? op)
|
||||
op]
|
||||
|
||||
[(PrimitivesReference? op)
|
||||
op]
|
||||
))
|
||||
|
||||
|
||||
(: rewrite-primcmd (PrimitiveCommand -> PrimitiveCommand))
|
||||
|
@ -421,9 +426,7 @@
|
|||
oparg]
|
||||
[(ModuleEntry? oparg)
|
||||
oparg]
|
||||
[(IsModuleInvoked? oparg)
|
||||
oparg]
|
||||
[(IsModuleLinked? oparg)
|
||||
[(ModulePredicate? oparg)
|
||||
oparg]
|
||||
[(VariableReference? oparg)
|
||||
(let ([t (VariableReference-toplevel oparg)])
|
||||
|
|
|
@ -2,8 +2,8 @@
|
|||
// JavaScript land...
|
||||
|
||||
|
||||
var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].namespace;
|
||||
var colorStruct = colorNamespace['struct:color'];
|
||||
var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].getNamespace();
|
||||
var colorStruct = colorNamespace.get('struct:color');
|
||||
var makeColor = function(r,g,b,a) { return colorStruct.constructor([r,g,b,a]); };
|
||||
|
||||
|
||||
|
|
|
@ -4,8 +4,8 @@
|
|||
|
||||
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].namespace;
|
||||
var colorStruct = colorNamespace['struct:color'];
|
||||
var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].getNamespace();
|
||||
var colorStruct = colorNamespace.get('struct:color');
|
||||
var makeColor = function(r,g,b,a) { return colorStruct.constructor([r,g,b,a]); };
|
||||
var isColor = colorStruct.predicate;
|
||||
var colorRed = function(c) { return colorStruct.accessor(c, 0); };
|
||||
|
|
|
@ -3,6 +3,7 @@
|
|||
(require "assemble-structs.rkt"
|
||||
"assemble-helpers.rkt"
|
||||
"assemble-open-coded.rkt"
|
||||
"../compiler/lexical-structs.rkt"
|
||||
"../compiler/il-structs.rkt"
|
||||
racket/string)
|
||||
|
||||
|
@ -69,5 +70,16 @@
|
|||
|
||||
[(CallKernelPrimitiveProcedure? op)
|
||||
(open-code-kernel-primitive-procedure op blockht)]
|
||||
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
"M.p._i(M)"]))
|
||||
"M.p._i(M)"]
|
||||
|
||||
[(ModuleVariable? op)
|
||||
(format "M.modules[~s].getNamespace().get(~s)"
|
||||
(symbol->string
|
||||
(ModuleLocator-name
|
||||
(ModuleVariable-module-name op)))
|
||||
(symbol->string (ModuleVariable-name op)))]
|
||||
|
||||
[(PrimitivesReference? op)
|
||||
(format "M.primitives[~s]" (symbol->string (PrimitivesReference-name op)))]))
|
|
@ -30,6 +30,7 @@
|
|||
assemble-display-name
|
||||
assemble-location
|
||||
assemble-numeric-constant
|
||||
assemble-module-variable-ref
|
||||
|
||||
block-looks-like-context-expected-values?
|
||||
block-looks-like-pop-multiple-values-and-continue?)
|
||||
|
@ -69,10 +70,8 @@
|
|||
(assemble-primitive-kernel-value v)]
|
||||
[(ModuleEntry? v)
|
||||
(assemble-module-entry v)]
|
||||
[(IsModuleInvoked? v)
|
||||
(assemble-is-module-invoked v)]
|
||||
[(IsModuleLinked? v)
|
||||
(assemble-is-module-linked v)]
|
||||
[(ModulePredicate? v)
|
||||
(assemble-module-predicate v)]
|
||||
[(VariableReference? v)
|
||||
(assemble-variable-reference v)]))
|
||||
|
||||
|
@ -90,10 +89,16 @@
|
|||
(symbol->string (PrimitivesReference-name target))
|
||||
(symbol->string (PrimitivesReference-name target))
|
||||
rhs))]
|
||||
[(ModuleVariable? target)
|
||||
(lambda: ([rhs : String])
|
||||
(format "M.modules[~s].getNamespace().set(~s,~s);"
|
||||
(symbol->string (ModuleLocator-name (ModuleVariable-module-name target)))
|
||||
(symbol->string (ModuleVariable-name target))
|
||||
rhs))]
|
||||
[else
|
||||
(lambda: ([rhs : String])
|
||||
(format "~a=~a;"
|
||||
(cond
|
||||
(ann (cond
|
||||
[(eq? target 'proc)
|
||||
"M.p"]
|
||||
[(eq? target 'val)
|
||||
|
@ -109,6 +114,7 @@
|
|||
[(ModulePrefixTarget? target)
|
||||
(format "M.modules[~s].prefix"
|
||||
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])
|
||||
String)
|
||||
rhs))]))
|
||||
|
||||
|
||||
|
@ -471,17 +477,25 @@
|
|||
(symbol->string (ModuleLocator-name (ModuleEntry-name entry)))))
|
||||
|
||||
|
||||
(: assemble-is-module-invoked (IsModuleInvoked -> String))
|
||||
(define (assemble-is-module-invoked entry)
|
||||
(: assemble-module-variable-ref (ModuleVariable -> String))
|
||||
(define (assemble-module-variable-ref var)
|
||||
(format "M.modules[~s].getNamespace().get(~s)"
|
||||
(symbol->string (ModuleLocator-name (ModuleVariable-module-name var)))
|
||||
(symbol->string (ModuleVariable-name var))))
|
||||
|
||||
|
||||
(: assemble-module-predicate (ModulePredicate -> String))
|
||||
(define (assemble-module-predicate entry)
|
||||
(define modname (ModulePredicate-module-name entry))
|
||||
(define pred (ModulePredicate-pred entry))
|
||||
(cond
|
||||
[(eq? pred 'invoked?)
|
||||
(format "M.modules[~s].isInvoked"
|
||||
(symbol->string (ModuleLocator-name (IsModuleInvoked-name entry)))))
|
||||
(symbol->string (ModuleLocator-name modname)))]
|
||||
|
||||
|
||||
(: assemble-is-module-linked (IsModuleLinked -> String))
|
||||
(define (assemble-is-module-linked entry)
|
||||
[(eq? pred 'linked?)
|
||||
(format "(M.modules[~s]!==undefined)"
|
||||
(symbol->string (ModuleLocator-name (IsModuleLinked-name entry)))))
|
||||
|
||||
(symbol->string (ModuleLocator-name modname)))]))
|
||||
|
||||
|
||||
(: assemble-variable-reference (VariableReference -> String))
|
||||
|
|
|
@ -19,8 +19,12 @@
|
|||
(: open-code-kernel-primitive-procedure (CallKernelPrimitiveProcedure Blockht -> String))
|
||||
(define (open-code-kernel-primitive-procedure op blockht)
|
||||
(let*: ([operator : KernelPrimitiveName/Inline (CallKernelPrimitiveProcedure-operator op)]
|
||||
[operands : (Listof String) (map (lambda: ([op : OpArg])
|
||||
(assemble-oparg op blockht))
|
||||
[operands : (Listof String) (map (lambda: ([op : (U OpArg ModuleVariable)])
|
||||
(cond
|
||||
[(OpArg? op)
|
||||
(assemble-oparg op blockht)]
|
||||
[(ModuleVariable? op)
|
||||
(assemble-module-variable-ref op)]))
|
||||
(CallKernelPrimitiveProcedure-operands op))]
|
||||
[checked-operands : (Listof String)
|
||||
(map (lambda: ([dom : OperandDomain]
|
||||
|
|
|
@ -34,7 +34,7 @@
|
|||
(string-join (map
|
||||
(lambda: ([n : (U Symbol False GlobalBucket ModuleVariable)])
|
||||
(cond [(symbol? n)
|
||||
(format "M.params.currentNamespace[~s]||M.primitives[~s]"
|
||||
(format "M.params.currentNamespace.get(~s)||M.primitives[~s]"
|
||||
(symbol->string n)
|
||||
(symbol->string n))]
|
||||
[(eq? n #f)
|
||||
|
@ -52,7 +52,8 @@
|
|||
(format "M.primitives[~s]"
|
||||
(symbol->string (ModuleVariable-name n)))]
|
||||
[else
|
||||
(format "M.modules[~s].namespace[~s]"
|
||||
"'blah'"
|
||||
#;(format "M.modules[~s].getNamespace().get(~s)"
|
||||
(symbol->string
|
||||
(ModuleLocator-name
|
||||
(ModuleVariable-module-name n)))
|
||||
|
|
|
@ -87,9 +87,7 @@
|
|||
empty]
|
||||
[(ModuleEntry? an-input)
|
||||
empty]
|
||||
[(IsModuleInvoked? an-input)
|
||||
empty]
|
||||
[(IsModuleLinked? an-input)
|
||||
[(ModulePredicate? an-input)
|
||||
empty]
|
||||
[(VariableReference? an-input)
|
||||
empty]))
|
||||
|
@ -121,6 +119,10 @@
|
|||
[(MakeBoxedEnvironmentValue? op)
|
||||
empty]
|
||||
[(CallKernelPrimitiveProcedure? op)
|
||||
empty]
|
||||
[(ModuleVariable? op)
|
||||
empty]
|
||||
[(PrimitivesReference? op)
|
||||
empty]))
|
||||
|
||||
|
||||
|
@ -234,9 +236,7 @@
|
|||
empty]
|
||||
[(ModuleEntry? an-input)
|
||||
empty]
|
||||
[(IsModuleInvoked? an-input)
|
||||
empty]
|
||||
[(IsModuleLinked? an-input)
|
||||
[(ModulePredicate? an-input)
|
||||
empty]
|
||||
[(VariableReference? an-input)
|
||||
empty]))
|
||||
|
@ -268,6 +268,10 @@
|
|||
[(MakeBoxedEnvironmentValue? op)
|
||||
empty]
|
||||
[(CallKernelPrimitiveProcedure? op)
|
||||
empty]
|
||||
[(ModuleVariable? op)
|
||||
empty]
|
||||
[(PrimitivesReference? op)
|
||||
empty]))
|
||||
|
||||
(: collect-primitive-command (PrimitiveCommand -> (Listof Symbol)))
|
||||
|
|
|
@ -170,7 +170,7 @@
|
|||
[(struct Top [_ (struct Module (name path prefix requires provides code))])
|
||||
(apply string-append
|
||||
(map (lambda (p)
|
||||
(format "modrec.namespace[~s] = exports[~s];\n"
|
||||
(format "modrec.getNamespace().set(~s,exports[~s]);\n"
|
||||
(symbol->string (ModuleProvide-internal-name p))
|
||||
(symbol->string (ModuleProvide-external-name p))))
|
||||
provides))]
|
||||
|
|
|
@ -7,13 +7,80 @@
|
|||
var exports = {};
|
||||
baselib.modules = exports;
|
||||
|
||||
var Namespace = function(modrec) {
|
||||
this.modrec = modrec;
|
||||
// string -> integer
|
||||
// Returns the position within the prefix that we should be looking.
|
||||
this.mapping = {};
|
||||
this.extra = {};
|
||||
};
|
||||
|
||||
Namespace.prototype.get = function(name) {
|
||||
var i;
|
||||
if (this.mapping.hasOwnProperty(name)) {
|
||||
return this.modrec.prefix[this.mapping[name]];
|
||||
}
|
||||
if (this.extra.hasOwnProperty(name)) {
|
||||
return this.extra[name];
|
||||
}
|
||||
if (this.modrec.prefix) {
|
||||
for (i = 0; i < len; i++) {
|
||||
if (this.modrec.prefix.names[i] === name) {
|
||||
this.mapping[name] = i;
|
||||
return this.modrec.prefix[this.mapping[name]];
|
||||
}
|
||||
}
|
||||
}
|
||||
return undefined;
|
||||
};
|
||||
|
||||
Namespace.prototype.refreshPrefixMapping = function() {
|
||||
var prefix = this.modrec.prefix;
|
||||
var name;
|
||||
var i;
|
||||
for (i = 0; i < prefix.length; i++) {
|
||||
name = prefix.names[i];
|
||||
this.mapping[name] = i;
|
||||
if (this.extra.hasOwnProperty(name)) {
|
||||
prefix[i] = this.extra[name];
|
||||
delete this.extra[name];
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
Namespace.prototype.hasKey = function(name) {
|
||||
return this.mapping.hasOwnProperty(name);
|
||||
};
|
||||
|
||||
Namespace.prototype.set = function(name, value) {
|
||||
var i;
|
||||
if (this.mapping.hasOwnProperty(name)) {
|
||||
this.modrec.prefix[this.mapping[name]] = value;
|
||||
return;
|
||||
};
|
||||
if (this.extra.hasOwnProperty(name)) {
|
||||
this.extra[name] = value;
|
||||
return;
|
||||
}
|
||||
if (this.modrec.prefix) {
|
||||
for (i = 0; i < len; i++) {
|
||||
if (this.modrec.prefix.names[i] === name) {
|
||||
this.mapping[name] = i;
|
||||
this.modrec.prefix[this.mapping[name]] = value;
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
this.extra[name] = value;
|
||||
return;
|
||||
};
|
||||
|
||||
var ModuleRecord = function (name, label) {
|
||||
this.name = name;
|
||||
this.label = label;
|
||||
this.isInvoked = false;
|
||||
this.prefix = false;
|
||||
this.namespace = {};
|
||||
this.namespace = new Namespace(this);
|
||||
|
||||
// JavaScript-implemented code will assign privateExports
|
||||
// with all of the exported identifiers.
|
||||
|
@ -27,9 +94,7 @@
|
|||
|
||||
ModuleRecord.prototype.finalizeModuleInvokation = function () {
|
||||
var i, len = this.prefix.names.length;
|
||||
for (i = 0; i < len; i++) {
|
||||
this.namespace[this.prefix.names[i]] = this.prefix[i];
|
||||
}
|
||||
this.namespace.refreshPrefixMapping();
|
||||
};
|
||||
|
||||
|
||||
|
|
|
@ -278,7 +278,10 @@
|
|||
toDomNode(exn, MACHINE.params['print-mode']));
|
||||
},
|
||||
|
||||
'currentNamespace': {},
|
||||
'currentNamespace': { get: function() {},
|
||||
set : function() {},
|
||||
hasKey : function() { return false; }
|
||||
},
|
||||
|
||||
// These parameters control how often
|
||||
// control yields back to the browser
|
||||
|
@ -307,14 +310,14 @@
|
|||
// Try to get the continuation mark key used for procedure application tracing.
|
||||
var getTracedAppKey = function(MACHINE) {
|
||||
if (MACHINE.modules['whalesong/lang/private/traced-app.rkt']) {
|
||||
return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].namespace['traced-app-key'] || 'traced-app-key';
|
||||
return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].getNamespace().get('traced-app-key') || 'traced-app-key';
|
||||
}
|
||||
return undefined;
|
||||
};
|
||||
|
||||
var getTracedCalleeKey = function(MACHINE) {
|
||||
if (MACHINE.modules['whalesong/lang/private/traced-app.rkt']) {
|
||||
return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].namespace['traced-callee-key'] || 'traced-callee-key';
|
||||
return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].getNamespace().get('traced-callee-key') || 'traced-callee-key';
|
||||
}
|
||||
return undefined;
|
||||
};
|
||||
|
@ -759,8 +762,8 @@
|
|||
machine = machine || runtime.currentMachine;
|
||||
for (i = 0; i < machine.mainModules.length; i++) {
|
||||
var ns = machine.mainModules[i].getNamespace();
|
||||
if(ns.hasOwnProperty(name)) {
|
||||
return ns[name];
|
||||
if(ns.hasKey(name)) {
|
||||
return ns.get(name);
|
||||
}
|
||||
}
|
||||
};
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace()['struct:resource'];
|
||||
var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace().get('struct:resource');
|
||||
|
||||
var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure;
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace()['struct:resource'];
|
||||
var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace().get('struct:resource');
|
||||
|
||||
var makeClosure = plt.baselib.functions.makeClosure;
|
||||
var finalizeClosureCall = plt.baselib.functions.finalizeClosureCall;
|
||||
|
|
|
@ -1,10 +1,22 @@
|
|||
#lang planet dyoo/whalesong
|
||||
(require (for-syntax racket/base))
|
||||
(provide x x++ x=0)
|
||||
(provide x x++ x+1 x=0 get-x)
|
||||
(define x 0)
|
||||
|
||||
(define (set-x v)
|
||||
(set! x v))
|
||||
|
||||
(define (get-x)
|
||||
x)
|
||||
|
||||
(define-syntax (x++ stx)
|
||||
#'(plusplus-x))
|
||||
|
||||
(define-syntax (x+1 stx)
|
||||
#'(set-x (add1 x)))
|
||||
|
||||
(define (plusplus-x)
|
||||
(set! x (add1 x)))
|
||||
|
||||
(define-syntax (x=0 stx)
|
||||
#'(set-x 0))
|
14
tests/more-tests/module-scoping.expected
Normal file
14
tests/more-tests/module-scoping.expected
Normal file
|
@ -0,0 +1,14 @@
|
|||
0
|
||||
0
|
||||
1
|
||||
1
|
||||
2
|
||||
2
|
||||
0
|
||||
0
|
||||
1
|
||||
1
|
||||
2
|
||||
2
|
||||
3
|
||||
3
|
|
@ -1,13 +1,27 @@
|
|||
#lang planet dyoo/whalesong
|
||||
(require "module-scoping-helper.rkt")
|
||||
x
|
||||
x++
|
||||
x ;; 0
|
||||
(get-x) ;; 0
|
||||
|
||||
x+1
|
||||
x ;; 1
|
||||
(get-x) ;; 1
|
||||
|
||||
x++
|
||||
x
|
||||
(get-x)
|
||||
|
||||
x=0
|
||||
x
|
||||
(get-x)
|
||||
|
||||
x++
|
||||
x
|
||||
(get-x)
|
||||
x++
|
||||
x
|
||||
x++
|
||||
(get-x)
|
||||
|
||||
x+1
|
||||
x
|
||||
(get-x)
|
|
@ -8,6 +8,7 @@
|
|||
|
||||
(test "more-tests/simple.rkt")
|
||||
(test "more-tests/booleans.rkt")
|
||||
(test "more-tests/module-scoping.rkt")
|
||||
(test "more-tests/checking.rkt")
|
||||
(test "more-tests/string-tests.rkt")
|
||||
(test "more-tests/chars.rkt")
|
||||
|
|
|
@ -7,4 +7,4 @@
|
|||
(provide version)
|
||||
(: version String)
|
||||
|
||||
(define version "1.168")
|
||||
(define version "1.170")
|
||||
|
|
|
@ -33,10 +33,10 @@
|
|||
|
||||
|
||||
var resourceStructType =
|
||||
MACHINE.modules['whalesong/resource/structs.rkt'].namespace['struct:resource'];
|
||||
MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace().get('struct:resource');
|
||||
|
||||
var eventStructType =
|
||||
MACHINE.modules['whalesong/web-world/event.rkt'].namespace['struct:event'];
|
||||
MACHINE.modules['whalesong/web-world/event.rkt'].getNamespace().get('struct:event');
|
||||
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user