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

adding expectations for what happens for module-scoping test.

Browse Source 
fixing up the namespace stuff so it goes through getters and setters
trying to add the necessary to the il, but running into typed racket issues
corrected compilation of toplevelref so it works more correctly on module
variables.
This commit is contained in:
Danny Yoo 2012-02-26 19:32:38 -05:00
parent 8851726a92
commit 3ed2d19eab
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.167")
(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');