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

fix for issue 86: pruning dead test targets away for now

Browse Source
This commit is contained in:
Danny Yoo 2012-02-27 12:40:07 -05:00
commit ca2e773d36
21 changed files with 319 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
compiler/compiler.rkt
View File

@ -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)]
@ -341,8 +338,8 @@
(make-Perform (make-ExtendEnvironment/Prefix! names))
(make-AssignImmediate (make-ModulePrefixTarget path)
(make-EnvWholePrefixReference 0))
;; TODO: we need to sequester the prefix of the module with the record.
(make-EnvWholePrefixReference 0))
(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,9 +378,8 @@
[on-return (make-LinkedLabel (make-label 'onReturn)
on-return-multiple)])
(append-instruction-sequences
(make-TestAndJump (make-TestTrue
(make-IsModuleLinked a-module-name))
linked)
(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.
(make-DebugPrint (make-Const
@ -392,8 +388,8 @@
(make-Goto (make-Label (LinkedLabel-label on-return)))
linked
(make-TestAndJump (make-TestTrue
(make-IsModuleInvoked a-module-name))
(LinkedLabel-label on-return))
(make-ModulePredicate a-module-name 'invoked?))
(LinkedLabel-label on-return))
(make-PushControlFrame/Call on-return)
(make-Goto (ModuleEntry a-module-name))
on-return-multiple
@ -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))
@ -495,18 +503,28 @@
(end-with-linkage linkage
cenv
(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)))
singular-context-check))))
;; 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))))])
singular-context-check))))
(: compile-toplevel-set (ToplevelSet CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -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
next-linkage/expects-single)]
(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)
@ -1252,11 +1268,11 @@
stack-pushing-code
rest-operand-code
(make-AssignPrimOp (adjust-target-depth target (length rest-operands))
(make-CallKernelPrimitiveProcedure
kernel-op
(append constant-operand-poss rest-operand-poss)
expected-operand-types
typechecks?))
(make-CallKernelPrimitiveProcedure
kernel-op
(append constant-operand-poss rest-operand-poss)
expected-operand-types
typechecks?))
stack-popping-code
singular-context-check)))])])))
@ -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]))

33
compiler/il-structs.rkt
View File

@ -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,11 +287,16 @@
;; 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
CaptureEnvironment
@ -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)])

17
compiler/optimize-il.rkt
View File

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

4
image/private/colordb.js
View File

@ -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
image/private/kernel.js
View File

@ -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); };

14
js-assembler/assemble-expression.rkt
View File

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

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

@ -30,7 +30,8 @@
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,25 +89,32 @@
(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
[(eq? target 'proc)
"M.p"]
[(eq? target 'val)
"M.v"]
[(eq? target 'argcount)
"M.a"]
[(EnvLexicalReference? target)
(assemble-lexical-reference target)]
[(EnvPrefixReference? target)
(assemble-prefix-reference target)]
[(ControlFrameTemporary? target)
(assemble-control-frame-temporary target)]
[(ModulePrefixTarget? target)
(format "M.modules[~s].prefix"
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])
(ann (cond
[(eq? target 'proc)
"M.p"]
[(eq? target 'val)
"M.v"]
[(eq? target 'argcount)
"M.a"]
[(EnvLexicalReference? target)
(assemble-lexical-reference target)]
[(EnvPrefixReference? target)
(assemble-prefix-reference target)]
[(ControlFrameTemporary? target)
(assemble-control-frame-temporary target)]
[(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)
(format "M.modules[~s].isInvoked"
(symbol->string (ModuleLocator-name (IsModuleInvoked-name 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-is-module-linked (IsModuleLinked -> String))
(define (assemble-is-module-linked entry)
(format "(M.modules[~s]!==undefined)"
(symbol->string (ModuleLocator-name (IsModuleLinked-name entry)))))
(: 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 modname)))]
[(eq? pred 'linked?)
(format "(M.modules[~s]!==undefined)"
(symbol->string (ModuleLocator-name modname)))]))
(: assemble-variable-reference (VariableReference -> String))

8
js-assembler/assemble-open-coded.rkt
View File

@ -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]

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

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

16
js-assembler/collect-jump-targets.rkt
View File

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

2
js-assembler/package.rkt
View File

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

73
js-assembler/runtime-src/baselib-modules.js
View File

@ -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();
};

13
js-assembler/runtime-src/runtime.js
View File

@ -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);
}
}
};

2
resource/js-impl.js
View File

@ -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;

2
resource/specialize/js-impl.js
View File

@ -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;

14
tests/more-tests/module-scoping-helper.rkt
View File

@ -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
View File

@ -0,0 +1,14 @@
0
0
1
1
2
2
0
0
1
1
2
2
3
3

22
tests/more-tests/module-scoping.rkt
View File

@ -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++
x
(get-x)
x+1
x
(get-x)

1
tests/run-more-tests.rkt
View File

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

2
version.rkt
View File

@ -7,4 +7,4 @@
(provide version)
(: version String)
(define version "1.168")
(define version "1.170")

4
web-world/js-impl.js
View File

@ -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');