From 3ed2d19eab900105cffed90e578cf256a67e3687 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sun, 26 Feb 2012 19:32:38 -0500 Subject: [PATCH] adding expectations for what happens for module-scoping test. 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. --- compiler/compiler.rkt | 134 ++++++++++++-------- compiler/il-structs.rkt | 33 +++-- compiler/optimize-il.rkt | 17 ++- image/private/colordb.js | 4 +- image/private/kernel.js | 4 +- js-assembler/assemble-expression.rkt | 14 +- js-assembler/assemble-helpers.rkt | 72 ++++++----- js-assembler/assemble-open-coded.rkt | 8 +- js-assembler/assemble-perform-statement.rkt | 5 +- js-assembler/collect-jump-targets.rkt | 16 ++- js-assembler/package.rkt | 2 +- js-assembler/runtime-src/baselib-modules.js | 73 ++++++++++- js-assembler/runtime-src/runtime.js | 13 +- resource/js-impl.js | 2 +- resource/specialize/js-impl.js | 2 +- tests/more-tests/module-scoping-helper.rkt | 14 +- tests/more-tests/module-scoping.expected | 14 ++ tests/more-tests/module-scoping.rkt | 22 +++- tests/run-more-tests.rkt | 1 + version.rkt | 2 +- web-world/js-impl.js | 4 +- 21 files changed, 319 insertions(+), 137 deletions(-) create mode 100644 tests/more-tests/module-scoping.expected diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index 3d1ef0f..c681de1 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -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])) diff --git a/compiler/il-structs.rkt b/compiler/il-structs.rkt index f4d277e..c53fef8 100644 --- a/compiler/il-structs.rkt +++ b/compiler/il-structs.rkt @@ -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)]) diff --git a/compiler/optimize-il.rkt b/compiler/optimize-il.rkt index 5f94553..d7fa332 100644 --- a/compiler/optimize-il.rkt +++ b/compiler/optimize-il.rkt @@ -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)]) diff --git a/image/private/colordb.js b/image/private/colordb.js index dccef36..68ffbb6 100644 --- a/image/private/colordb.js +++ b/image/private/colordb.js @@ -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]); }; diff --git a/image/private/kernel.js b/image/private/kernel.js index ed5584b..1b0a6d9 100644 --- a/image/private/kernel.js +++ b/image/private/kernel.js @@ -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); }; diff --git a/js-assembler/assemble-expression.rkt b/js-assembler/assemble-expression.rkt index cf7075f..ff7cd8d 100644 --- a/js-assembler/assemble-expression.rkt +++ b/js-assembler/assemble-expression.rkt @@ -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)"])) \ No newline at end of file + "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)))])) \ No newline at end of file diff --git a/js-assembler/assemble-helpers.rkt b/js-assembler/assemble-helpers.rkt index b7a85d5..d94e550 100644 --- a/js-assembler/assemble-helpers.rkt +++ b/js-assembler/assemble-helpers.rkt @@ -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)) diff --git a/js-assembler/assemble-open-coded.rkt b/js-assembler/assemble-open-coded.rkt index 9578ba6..cecdc62 100644 --- a/js-assembler/assemble-open-coded.rkt +++ b/js-assembler/assemble-open-coded.rkt @@ -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] diff --git a/js-assembler/assemble-perform-statement.rkt b/js-assembler/assemble-perform-statement.rkt index ba9b85b..81c6c1e 100644 --- a/js-assembler/assemble-perform-statement.rkt +++ b/js-assembler/assemble-perform-statement.rkt @@ -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))) diff --git a/js-assembler/collect-jump-targets.rkt b/js-assembler/collect-jump-targets.rkt index 09e8a16..4b5be2b 100644 --- a/js-assembler/collect-jump-targets.rkt +++ b/js-assembler/collect-jump-targets.rkt @@ -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))) diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index 530893b..132d4a0 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -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))] diff --git a/js-assembler/runtime-src/baselib-modules.js b/js-assembler/runtime-src/baselib-modules.js index b005891..3c67eca 100644 --- a/js-assembler/runtime-src/baselib-modules.js +++ b/js-assembler/runtime-src/baselib-modules.js @@ -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(); }; diff --git a/js-assembler/runtime-src/runtime.js b/js-assembler/runtime-src/runtime.js index 3e6d7f0..a3ba17b 100644 --- a/js-assembler/runtime-src/runtime.js +++ b/js-assembler/runtime-src/runtime.js @@ -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); } } }; diff --git a/resource/js-impl.js b/resource/js-impl.js index b60f681..27aca0f 100644 --- a/resource/js-impl.js +++ b/resource/js-impl.js @@ -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; diff --git a/resource/specialize/js-impl.js b/resource/specialize/js-impl.js index 538eff6..a5d449c 100644 --- a/resource/specialize/js-impl.js +++ b/resource/specialize/js-impl.js @@ -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; diff --git a/tests/more-tests/module-scoping-helper.rkt b/tests/more-tests/module-scoping-helper.rkt index abb79d9..4ec3eeb 100644 --- a/tests/more-tests/module-scoping-helper.rkt +++ b/tests/more-tests/module-scoping-helper.rkt @@ -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)) \ No newline at end of file diff --git a/tests/more-tests/module-scoping.expected b/tests/more-tests/module-scoping.expected new file mode 100644 index 0000000..8614c93 --- /dev/null +++ b/tests/more-tests/module-scoping.expected @@ -0,0 +1,14 @@ +0 +0 +1 +1 +2 +2 +0 +0 +1 +1 +2 +2 +3 +3 diff --git a/tests/more-tests/module-scoping.rkt b/tests/more-tests/module-scoping.rkt index 30b5bd7..a408ed0 100644 --- a/tests/more-tests/module-scoping.rkt +++ b/tests/more-tests/module-scoping.rkt @@ -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 \ No newline at end of file +(get-x) + +x+1 +x +(get-x) \ No newline at end of file diff --git a/tests/run-more-tests.rkt b/tests/run-more-tests.rkt index 7eae8b2..7e57836 100644 --- a/tests/run-more-tests.rkt +++ b/tests/run-more-tests.rkt @@ -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") diff --git a/version.rkt b/version.rkt index 68ece6f..19987ea 100644 --- a/version.rkt +++ b/version.rkt @@ -7,4 +7,4 @@ (provide version) (: version String) -(define version "1.167") +(define version "1.170") diff --git a/web-world/js-impl.js b/web-world/js-impl.js index dc71250..55cd01d 100644 --- a/web-world/js-impl.js +++ b/web-world/js-impl.js @@ -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');