diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index 5feb163..99a5c31 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -21,6 +21,10 @@ [ensure-const-value (Any -> const-value)]) +(require/typed "../parser/modprovide.rkt" + [get-provided-names (Expression -> (Listof ModuleProvide))]) + + (provide (rename-out [-compile compile]) compile-general-procedure-call) @@ -334,18 +338,17 @@ (apply append-instruction-sequences (map compile-module-invoke (Module-requires mod))) - ;; 2. Next, evaluate the module body. + ;; 2. Store the prefix: (make-Perform (make-ExtendEnvironment/Prefix! names)) - (make-AssignImmediate (make-ModulePrefixTarget path) (make-EnvWholePrefixReference 0)) - + ;; 3. Next, evaluate the module body. (compile (Module-code mod) (cons (Module-prefix mod) module-cenv) 'val next-linkage/drop-multiple) - ;; 3. Finally, cleanup and return. + ;; 4. Finally, cleanup and return. (make-PopEnvironment (make-Const 1) (make-Const 0)) (make-AssignImmediate 'proc (make-ControlStackLabel)) (make-PopControlFrame) @@ -399,22 +402,6 @@ on-return))])) -(: kernel-module-name? (ModuleLocator -> Boolean)) -;; Produces true if the module is hardcoded. -(define (kernel-module-name? name) - ((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))) @@ -510,7 +497,9 @@ (cond [(kernel-module-name? (ModuleVariable-module-name prefix-element)) (make-AssignPrimOp target (make-PrimitivesReference - (ModuleVariable-name prefix-element)))] + (kernel-module-variable->primitive-name + prefix-element) + ))] [else (make-AssignPrimOp target prefix-element)])] [else @@ -527,6 +516,10 @@ singular-context-check)))) + + + + (: compile-toplevel-set (ToplevelSet CompileTimeEnvironment Target Linkage -> InstructionSequence)) ;; Compiles a toplevel mutation. (define (compile-toplevel-set exp cenv target linkage) @@ -1015,7 +1008,7 @@ [(ModuleVariable? op-knowledge) (cond [(kernel-module-name? (ModuleVariable-module-name op-knowledge)) - (ModuleVariable-name op-knowledge)] + (kernel-module-variable->primitive-name op-knowledge)] [else #f])] [else diff --git a/compiler/kernel-primitives.rkt b/compiler/kernel-primitives.rkt index 34fc331..584f1ac 100644 --- a/compiler/kernel-primitives.rkt +++ b/compiler/kernel-primitives.rkt @@ -3,7 +3,59 @@ (provide (all-defined-out)) (require "arity-structs.rkt" + "lexical-structs.rkt" "../type-helpers.rkt") + + + + +(: kernel-module-name? (ModuleLocator -> Boolean)) +;; Produces true if the module is hardcoded. +(define (kernel-module-name? name) + + + (: kernel-locator? (ModuleLocator -> Boolean)) + (define (kernel-locator? locator) + (or (and (eq? (ModuleLocator-name locator) '#%kernel) + (eq? (ModuleLocator-real-path locator) '#%kernel)) + (eq? (ModuleLocator-name locator) + 'whalesong/lang/kernel.rkt))) + + + (: paramz-locator? (ModuleLocator -> Boolean)) + (define (paramz-locator? locator) + (or (and (eq? (ModuleLocator-name locator) '#%paramz) + (eq? (ModuleLocator-real-path locator) '#%paramz)))) + + + (: kernel-module-locator? (ModuleLocator -> Boolean)) + ;; Produces true if the given module locator should be treated as a primitive root one + ;; that is implemented by us. + (define (kernel-module-locator? locator) + (or (kernel-locator? locator) + (paramz-locator? locator))) + + + (kernel-module-locator? name)) + + + +;; Given a kernel-labeled ModuleVariable, returns the kernel name for it. +(: kernel-module-variable->primitive-name (ModuleVariable -> Symbol)) +(define (kernel-module-variable->primitive-name a-modvar) + ;; FIXME: remap if the module is something else like whalesong/unsafe/ops + + (ModuleVariable-name a-modvar)) + + + + + + + + + + (define-type OperandDomain (U 'number 'string 'vector diff --git a/js-assembler/assemble-perform-statement.rkt b/js-assembler/assemble-perform-statement.rkt index 9b98f12..752e6ba 100644 --- a/js-assembler/assemble-perform-statement.rkt +++ b/js-assembler/assemble-perform-statement.rkt @@ -2,6 +2,7 @@ (require "assemble-helpers.rkt" "../compiler/il-structs.rkt" "../compiler/lexical-structs.rkt" + "../compiler/kernel-primitives.rkt" "../parameters.rkt" "assemble-structs.rkt" racket/string) @@ -47,13 +48,12 @@ ;; the value here! It shouldn't be looking into Primitives... [(ModuleVariable? n) (cond - [((current-kernel-module-locator?) - (ModuleVariable-module-name n)) + [(kernel-module-name? (ModuleVariable-module-name n)) (format "M.primitives[~s]" - (symbol->string (ModuleVariable-name n)))] + (symbol->string + (kernel-module-variable->primitive-name n)))] [else - "'blah'" - #;(format "M.modules[~s].getNamespace().get(~s)" + (format "{moduleName:~s,name:~s}" (symbol->string (ModuleLocator-name (ModuleVariable-module-name n))) diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index 93b00a9..288889e 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -168,12 +168,31 @@ (define (get-provided-name-code bytecode) (apply string-append - (map (lambda (p) - (format "modrec.getNamespace().set(~s,exports[~s]);\n" - (symbol->string (ModuleProvide-internal-name p)) - (symbol->string (ModuleProvide-external-name p)))) - (get-provided-names bytecode)))) + (for/list ([modprovide (get-provided-names bytecode)] + [i (in-naturals)]) + (string-append + (format "modrec.getNamespace().set(~s,exports[~s]);\n" + (symbol->string (ModuleProvide-internal-name modprovide)) + (symbol->string (ModuleProvide-external-name modprovide))) + (format "modrec.prefix[~a]=exports[~s];\n" + i + (symbol->string (ModuleProvide-internal-name modprovide))))))) + (define (get-prefix-code bytecode) + (format "modrec.prefix=[~a];modrec.prefix.names=[~a];modrec.prefix.internalNames=[~a];" + (string-join (map (lambda (n) "void(0)") + (get-provided-names bytecode)) + ",") + (string-join (map (lambda (n) + (format "~s" (symbol->string + (ModuleProvide-external-name n)))) + (get-provided-names bytecode)) + ",") + (string-join (map (lambda (n) + (format "~s" (symbol->string + (ModuleProvide-internal-name n)))) + (get-provided-names bytecode)) + ","))) (define (get-implementation-from-path path) (let* ([name (rewrite-path path)] @@ -193,13 +212,16 @@ (format " if(--M.cbt<0) { throw arguments.callee; } var modrec = M.modules[~s]; + ~a var exports = {}; modrec.isInvoked = true; (function(MACHINE, EXPORTS){~a})(M, exports); ~a modrec.privateExports = exports; + modrec.finalizeModuleInvokation(); return M.c.pop().label(M);" (symbol->string name) + (get-prefix-code bytecode) text (get-provided-name-code bytecode))]) diff --git a/make/make.rkt b/make/make.rkt index 82db08b..3ce0210 100644 --- a/make/make.rkt +++ b/make/make.rkt @@ -5,6 +5,7 @@ "../compiler/lexical-structs.rkt" "../compiler/compiler-structs.rkt" "../compiler/expression-structs.rkt" + "../compiler/kernel-primitives.rkt" "../parameters.rkt" "../sets.rkt" "get-dependencies.rkt" @@ -157,8 +158,7 @@ (let ([rp [ModuleLocator-real-path mp]]) (cond ;; Ignore modules that are implemented by Whalesong. - [((current-kernel-module-locator?) - mp) + [(kernel-module-name? mp) acc] [(path? rp) (cons (make-ModuleSource rp) acc)] diff --git a/parameters.rkt b/parameters.rkt index f2c625f..2b3592d 100644 --- a/parameters.rkt +++ b/parameters.rkt @@ -17,7 +17,6 @@ current-warn-unimplemented-kernel-primitive current-seen-unimplemented-kernel-primitives - current-kernel-module-locator? current-primitive-identifier? @@ -53,27 +52,6 @@ id))))) -(: current-kernel-module-locator? (Parameterof (ModuleLocator -> Boolean))) -;; Produces true if the given module locator should be treated as a primitive root one -;; that is implemented by us. -(define current-kernel-module-locator? - (make-parameter - (lambda: ([locator : ModuleLocator]) - (or (kernel-locator? locator) - (paramz-locator? locator))))) - -(: kernel-locator? (ModuleLocator -> Boolean)) -(define (kernel-locator? locator) - (or (and (eq? (ModuleLocator-name locator) '#%kernel) - (eq? (ModuleLocator-real-path locator) '#%kernel)) - (eq? (ModuleLocator-name locator) - 'whalesong/lang/kernel.rkt))) - - -(: paramz-locator? (ModuleLocator -> Boolean)) -(define (paramz-locator? locator) - (or (and (eq? (ModuleLocator-name locator) '#%paramz) - (eq? (ModuleLocator-real-path locator) '#%paramz)))) diff --git a/version.rkt b/version.rkt index a4d7469..a9bcae3 100644 --- a/version.rkt +++ b/version.rkt @@ -7,4 +7,4 @@ (provide version) (: version String) -(define version "1.178") +(define version "1.185")