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

trying to normalize namespaces between js-implemented and Whalesong-implemented

Browse Source
This commit is contained in:
Danny Yoo 2012-02-27 17:39:15 -05:00
parent c7a5bf9658
commit 5654cf7432
7 changed files with 102 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
compiler/compiler.rkt
View File

@ -21,6 +21,10 @@
[ensure-const-value (Any -> const-value)]) [ensure-const-value (Any -> const-value)])
(require/typed "../parser/modprovide.rkt"
[get-provided-names (Expression -> (Listof ModuleProvide))])
(provide (rename-out [-compile compile]) (provide (rename-out [-compile compile])
compile-general-procedure-call) compile-general-procedure-call)
@ -334,18 +338,17 @@
(apply append-instruction-sequences (apply append-instruction-sequences
(map compile-module-invoke (Module-requires mod))) (map compile-module-invoke (Module-requires mod)))
;; 2. Next, evaluate the module body. ;; 2. Store the prefix:
(make-Perform (make-ExtendEnvironment/Prefix! names)) (make-Perform (make-ExtendEnvironment/Prefix! names))
(make-AssignImmediate (make-ModulePrefixTarget path) (make-AssignImmediate (make-ModulePrefixTarget path)
(make-EnvWholePrefixReference 0)) (make-EnvWholePrefixReference 0))
;; 3. Next, evaluate the module body.
(compile (Module-code mod) (compile (Module-code mod)
(cons (Module-prefix mod) module-cenv) (cons (Module-prefix mod) module-cenv)
'val 'val
next-linkage/drop-multiple) next-linkage/drop-multiple)
;; 3. Finally, cleanup and return. ;; 4. Finally, cleanup and return.
(make-PopEnvironment (make-Const 1) (make-Const 0)) (make-PopEnvironment (make-Const 1) (make-Const 0))
(make-AssignImmediate 'proc (make-ControlStackLabel)) (make-AssignImmediate 'proc (make-ControlStackLabel))
(make-PopControlFrame) (make-PopControlFrame)
@ -399,22 +402,6 @@
on-return))])) 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)) (cond [(kernel-module-name? (ModuleVariable-module-name prefix-element))
(make-AssignPrimOp target (make-AssignPrimOp target
(make-PrimitivesReference (make-PrimitivesReference
(ModuleVariable-name prefix-element)))] (kernel-module-variable->primitive-name
prefix-element)
))]
[else [else
(make-AssignPrimOp target prefix-element)])] (make-AssignPrimOp target prefix-element)])]
[else [else
@ -527,6 +516,10 @@
singular-context-check)))) singular-context-check))))
(: compile-toplevel-set (ToplevelSet CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile-toplevel-set (ToplevelSet CompileTimeEnvironment Target Linkage -> InstructionSequence))
;; Compiles a toplevel mutation. ;; Compiles a toplevel mutation.
(define (compile-toplevel-set exp cenv target linkage) (define (compile-toplevel-set exp cenv target linkage)
@ -1015,7 +1008,7 @@
[(ModuleVariable? op-knowledge) [(ModuleVariable? op-knowledge)
(cond (cond
[(kernel-module-name? (ModuleVariable-module-name op-knowledge)) [(kernel-module-name? (ModuleVariable-module-name op-knowledge))
(ModuleVariable-name op-knowledge)] (kernel-module-variable->primitive-name op-knowledge)]
[else [else
#f])] #f])]
[else [else

52
compiler/kernel-primitives.rkt
View File

@ -3,7 +3,59 @@
(provide (all-defined-out)) (provide (all-defined-out))
(require "arity-structs.rkt" (require "arity-structs.rkt"
"lexical-structs.rkt"
"../type-helpers.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 (define-type OperandDomain (U 'number
'string 'string
'vector 'vector

10
js-assembler/assemble-perform-statement.rkt
View File

@ -2,6 +2,7 @@
(require "assemble-helpers.rkt" (require "assemble-helpers.rkt"
"../compiler/il-structs.rkt" "../compiler/il-structs.rkt"
"../compiler/lexical-structs.rkt" "../compiler/lexical-structs.rkt"
"../compiler/kernel-primitives.rkt"
"../parameters.rkt" "../parameters.rkt"
"assemble-structs.rkt" "assemble-structs.rkt"
racket/string) racket/string)
@ -47,13 +48,12 @@
;; the value here! It shouldn't be looking into Primitives... ;; the value here! It shouldn't be looking into Primitives...
[(ModuleVariable? n) [(ModuleVariable? n)
(cond (cond
[((current-kernel-module-locator?) [(kernel-module-name? (ModuleVariable-module-name n))
(ModuleVariable-module-name n))
(format "M.primitives[~s]" (format "M.primitives[~s]"
(symbol->string (ModuleVariable-name n)))] (symbol->string
(kernel-module-variable->primitive-name n)))]
[else [else
"'blah'" (format "{moduleName:~s,name:~s}"
#;(format "M.modules[~s].getNamespace().get(~s)"
(symbol->string (symbol->string
(ModuleLocator-name (ModuleLocator-name
(ModuleVariable-module-name n))) (ModuleVariable-module-name n)))

32
js-assembler/package.rkt
View File

@ -168,12 +168,31 @@
(define (get-provided-name-code bytecode) (define (get-provided-name-code bytecode)
(apply string-append (apply string-append
(map (lambda (p) (for/list ([modprovide (get-provided-names bytecode)]
(format "modrec.getNamespace().set(~s,exports[~s]);\n" [i (in-naturals)])
(symbol->string (ModuleProvide-internal-name p)) (string-append
(symbol->string (ModuleProvide-external-name p)))) (format "modrec.getNamespace().set(~s,exports[~s]);\n"
(get-provided-names bytecode)))) (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) (define (get-implementation-from-path path)
(let* ([name (rewrite-path path)] (let* ([name (rewrite-path path)]
@ -193,13 +212,16 @@
(format " (format "
if(--M.cbt<0) { throw arguments.callee; } if(--M.cbt<0) { throw arguments.callee; }
var modrec = M.modules[~s]; var modrec = M.modules[~s];
~a
var exports = {}; var exports = {};
modrec.isInvoked = true; modrec.isInvoked = true;
(function(MACHINE, EXPORTS){~a})(M, exports); (function(MACHINE, EXPORTS){~a})(M, exports);
~a ~a
modrec.privateExports = exports; modrec.privateExports = exports;
modrec.finalizeModuleInvokation();
return M.c.pop().label(M);" return M.c.pop().label(M);"
(symbol->string name) (symbol->string name)
(get-prefix-code bytecode)
text text
(get-provided-name-code bytecode))]) (get-provided-name-code bytecode))])

4
make/make.rkt
View File

@ -5,6 +5,7 @@
"../compiler/lexical-structs.rkt" "../compiler/lexical-structs.rkt"
"../compiler/compiler-structs.rkt" "../compiler/compiler-structs.rkt"
"../compiler/expression-structs.rkt" "../compiler/expression-structs.rkt"
"../compiler/kernel-primitives.rkt"
"../parameters.rkt" "../parameters.rkt"
"../sets.rkt" "../sets.rkt"
"get-dependencies.rkt" "get-dependencies.rkt"
@ -157,8 +158,7 @@
(let ([rp [ModuleLocator-real-path mp]]) (let ([rp [ModuleLocator-real-path mp]])
(cond (cond
;; Ignore modules that are implemented by Whalesong. ;; Ignore modules that are implemented by Whalesong.
[((current-kernel-module-locator?) [(kernel-module-name? mp)
mp)
acc] acc]
[(path? rp) [(path? rp)
(cons (make-ModuleSource rp) acc)] (cons (make-ModuleSource rp) acc)]

22
parameters.rkt
View File

@ -17,7 +17,6 @@
current-warn-unimplemented-kernel-primitive current-warn-unimplemented-kernel-primitive
current-seen-unimplemented-kernel-primitives current-seen-unimplemented-kernel-primitives
current-kernel-module-locator?
current-primitive-identifier? current-primitive-identifier?
@ -53,27 +52,6 @@
id))))) 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))))

2
version.rkt
View File

@ -7,4 +7,4 @@
(provide version) (provide version)
(: version String) (: version String)
(define version "1.178") (define version "1.185")