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