diff --git a/whalesong/compiler/compiler.rkt b/whalesong/compiler/compiler.rkt index d1282e6..5be1f61 100644 --- a/whalesong/compiler/compiler.rkt +++ b/whalesong/compiler/compiler.rkt @@ -440,8 +440,7 @@ (make-AssignPrimOp target (make-PrimitivesReference (kernel-module-variable->primitive-name - prefix-element) - ))] + prefix-element)))] [else (make-AssignImmediate target @@ -453,11 +452,10 @@ (if (ToplevelRef-check-defined? exp) (make-Perform (make-CheckGlobalBound! (GlobalBucket-name prefix-element))) empty-instruction-sequence) - (make-AssignImmediate + (make-AssignPrimOp target (make-GlobalsReference (GlobalBucket-name prefix-element))))] - [(or (eq? prefix-element #f) - (symbol? prefix-element)) + [(or (eq? prefix-element #f) (symbol? prefix-element)) (append-instruction-sequences (if (ToplevelRef-check-defined? exp) (make-Perform (make-CheckToplevelBound! @@ -2080,24 +2078,32 @@ ;; values are on the stack. (if (> n 0) (apply append-instruction-sequences - (map (lambda: ([id : ToplevelRef] - [from : OpArg]) - (make-AssignImmediate - ;; Slightly subtle: the toplevelrefs were with respect to the - ;; stack at the beginning of def-values, but at the moment, - ;; there may be additional values that are currently there. - (make-EnvPrefixReference (+ (ensure-natural (sub1 n)) - (ToplevelRef-depth id)) - (ToplevelRef-pos id) - #f) - from)) - ids - (if (> n 0) - (cons (make-Reg 'val) - (build-list (sub1 n) - (lambda: ([i : Natural]) - (make-EnvLexicalReference i #f)))) - empty))) + (map (lambda: ([id : ToplevelRef] + [from : OpArg]) + (define prefix + (ensure-prefix (list-ref cenv (ToplevelRef-depth id)))) + (define prefix-element (list-ref (Prefix-names prefix) (ToplevelRef-pos id))) + (cond + [(GlobalBucket? prefix-element) + (make-AssignImmediate (make-GlobalsReference (GlobalBucket-name prefix-element)) + from)] + [else + ;; Slightly subtle: the toplevelrefs were with respect to the + ;; stack at the beginning of def-values, but at the moment, + ;; there may be additional values that are currently there. + (make-AssignImmediate + (make-EnvPrefixReference (+ (ensure-natural (sub1 n)) + (ToplevelRef-depth id)) + (ToplevelRef-pos id) + #f) + from)])) + ids + (if (> n 0) + (cons (make-Reg 'val) + (build-list (sub1 n) + (lambda: ([i : Natural]) + (make-EnvLexicalReference i #f)))) + empty))) empty-instruction-sequence) ;; Finally, make sure any multiple values are off the stack. @@ -2175,6 +2181,8 @@ (EnvPrefixReference-modvar? target))] [(PrimitivesReference? target) target] + [(GlobalsReference? target) + target] [(ControlFrameTemporary? target) target] [(ModulePrefixTarget? target) diff --git a/whalesong/compiler/il-structs.rkt b/whalesong/compiler/il-structs.rkt index 94c2095..2a87fd9 100644 --- a/whalesong/compiler/il-structs.rkt +++ b/whalesong/compiler/il-structs.rkt @@ -38,7 +38,6 @@ ModulePredicate PrimitiveKernelValue VariableReference - GlobalsReference )) diff --git a/whalesong/js-assembler/assemble-expression.rkt b/whalesong/js-assembler/assemble-expression.rkt index 481e4f3..211860c 100644 --- a/whalesong/js-assembler/assemble-expression.rkt +++ b/whalesong/js-assembler/assemble-expression.rkt @@ -102,4 +102,7 @@ (symbol->string (ModuleVariable-name op)))] [(PrimitivesReference? op) - (format "M.primitives[~s]" (symbol->string (PrimitivesReference-name op)))])) \ No newline at end of file + (format "M.primitives[~s]" (symbol->string (PrimitivesReference-name op)))] + + [(GlobalsReference? op) + (format "M.globals[~s]" (symbol->string (GlobalsReference-name op)))])) \ No newline at end of file diff --git a/whalesong/js-assembler/assemble-helpers.rkt b/whalesong/js-assembler/assemble-helpers.rkt index be54418..cfaaf5c 100644 --- a/whalesong/js-assembler/assemble-helpers.rkt +++ b/whalesong/js-assembler/assemble-helpers.rkt @@ -115,6 +115,8 @@ (assemble-prefix-reference target)] [(ControlFrameTemporary? target) (assemble-control-frame-temporary target)] + [(GlobalsReference? target) + (format "M.globals[~s]" (symbol->string (GlobalsReference-name target)))] [(ModulePrefixTarget? target) (format "M.modules[~s].prefix" (symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))]) diff --git a/whalesong/js-assembler/assemble-perform-statement.rkt b/whalesong/js-assembler/assemble-perform-statement.rkt index 152a4d6..034d283 100644 --- a/whalesong/js-assembler/assemble-perform-statement.rkt +++ b/whalesong/js-assembler/assemble-perform-statement.rkt @@ -21,6 +21,10 @@ (CheckToplevelBound!-pos op) (add1 (CheckToplevelBound!-depth op)) (CheckToplevelBound!-pos op))] + [(CheckGlobalBound!? op) + (format "if (M.globals[~s]===void(0)){ RT.raiseUnboundToplevelError(M,~s); }" + (symbol->string (CheckGlobalBound!-name op)) + (symbol->string (CheckGlobalBound!-name op)))] [(CheckClosureAndArity!? op) diff --git a/whalesong/js-assembler/collect-jump-targets.rkt b/whalesong/js-assembler/collect-jump-targets.rkt index 8faeaed..6115f65 100644 --- a/whalesong/js-assembler/collect-jump-targets.rkt +++ b/whalesong/js-assembler/collect-jump-targets.rkt @@ -125,6 +125,8 @@ [(ModuleVariable? op) empty] [(PrimitivesReference? op) + empty] + [(GlobalsReference? op) empty])) @@ -276,6 +278,8 @@ [(ModuleVariable? op) empty] [(PrimitivesReference? op) + empty] + [(GlobalsReference? op) empty])) (: collect-primitive-command (PrimitiveCommand -> (Listof Symbol))) diff --git a/whalesong/repl-prototype/server.rkt b/whalesong/repl-prototype/server.rkt index 7900b72..0239512 100644 --- a/whalesong/repl-prototype/server.rkt +++ b/whalesong/repl-prototype/server.rkt @@ -73,6 +73,7 @@ (define op (open-output-bytes)) (write raw-bytecode op) (define whalesong-bytecode (parse-bytecode (open-input-bytes (get-output-bytes op)))) + (pretty-print whalesong-bytecode) (define compiled-bytecode (compile-for-repl whalesong-bytecode)) (pretty-print compiled-bytecode) (define assembled-op (open-output-string))