comments
This commit is contained in:
Danny Yoo
commit
43bff9fefe
|
|
@ -1417,13 +1417,13 @@
|
|||
linkage
|
||||
cenv
|
||||
(append-instruction-sequences
|
||||
(make-TestAndJumpStatement (make-TestPrimitiveProcedure
|
||||
(make-Reg 'proc))
|
||||
primitive-branch)
|
||||
;; (make-TestAndJumpStatement (make-TestPrimitiveProcedure
|
||||
;; (make-Reg 'proc))
|
||||
;; primitive-branch)
|
||||
|
||||
|
||||
;; Compiled branch
|
||||
(make-PerformStatement (make-CheckClosureArity! (make-Reg 'argcount)))
|
||||
(make-PerformStatement (make-CheckClosureAndArity! (make-Reg 'argcount)))
|
||||
(compile-compiled-procedure-application cenv
|
||||
number-of-arguments
|
||||
'dynamic
|
||||
|
|
@ -1431,24 +1431,24 @@
|
|||
compiled-linkage)
|
||||
|
||||
;; Primitive branch
|
||||
primitive-branch
|
||||
(make-PerformStatement (make-CheckPrimitiveArity! (make-Reg 'argcount)))
|
||||
(compile-primitive-application cenv target primitive-linkage)
|
||||
;; primitive-branch
|
||||
;; (make-PerformStatement (make-CheckPrimitiveArity! (make-Reg 'argcount)))
|
||||
;; (compile-primitive-application cenv target primitive-linkage)
|
||||
after-call)))))
|
||||
|
||||
|
||||
|
||||
(: compile-primitive-application (CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-primitive-application cenv target linkage)
|
||||
(let ([singular-context-check (emit-singular-context linkage)])
|
||||
(append-instruction-sequences
|
||||
(make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
|
||||
(make-PopEnvironment (make-Reg 'argcount)
|
||||
(make-Const 0))
|
||||
(if (eq? target 'val)
|
||||
empty-instruction-sequence
|
||||
(make-AssignImmediateStatement target (make-Reg 'val)))
|
||||
singular-context-check)))
|
||||
;; (: compile-primitive-application (CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; (define (compile-primitive-application cenv target linkage)
|
||||
;; (let ([singular-context-check (emit-singular-context linkage)])
|
||||
;; (append-instruction-sequences
|
||||
;; (make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
|
||||
;; (make-PopEnvironment (make-Reg 'argcount)
|
||||
;; (make-Const 0))
|
||||
;; (if (eq? target 'val)
|
||||
;; empty-instruction-sequence
|
||||
;; (make-AssignImmediateStatement target (make-Reg 'val)))
|
||||
;; singular-context-check)))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -280,7 +280,6 @@
|
|||
(define-type PrimitiveOperator (U GetCompiledProcedureEntry
|
||||
MakeCompiledProcedure
|
||||
MakeCompiledProcedureShell
|
||||
ApplyPrimitiveProcedure
|
||||
|
||||
|
||||
MakeBoxedEnvironmentValue
|
||||
|
|
@ -312,15 +311,6 @@
|
|||
#:transparent)
|
||||
|
||||
|
||||
;; Applies the primitive procedure that's stored in the proc register, using
|
||||
;; the argcount number of values that are bound in the environment as arguments
|
||||
;; to that primitive.
|
||||
(define-struct: ApplyPrimitiveProcedure ()
|
||||
#:transparent)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -356,14 +346,12 @@
|
|||
TestTrue
|
||||
TestOne
|
||||
TestZero
|
||||
TestPrimitiveProcedure
|
||||
TestClosureArityMismatch
|
||||
))
|
||||
(define-struct: TestFalse ([operand : OpArg]) #:transparent)
|
||||
(define-struct: TestTrue ([operand : OpArg]) #:transparent)
|
||||
(define-struct: TestOne ([operand : OpArg]) #:transparent)
|
||||
(define-struct: TestZero ([operand : OpArg]) #:transparent)
|
||||
(define-struct: TestPrimitiveProcedure ([operand : OpArg]) #:transparent)
|
||||
(define-struct: TestClosureArityMismatch ([closure : OpArg]
|
||||
[n : OpArg]) #:transparent)
|
||||
|
||||
|
|
@ -375,13 +363,10 @@
|
|||
[pos : Natural])
|
||||
#:transparent)
|
||||
|
||||
;; Check the closure procedure value in 'proc and make sure it can accept the
|
||||
;; # of arguments (stored as a number in the argcount register.).
|
||||
(define-struct: CheckClosureArity! ([num-args : OpArg])
|
||||
;; Check the closure procedure value in 'proc and make sure it's a closure
|
||||
;; that can accept the right arguments (stored as a number in the argcount register.).
|
||||
(define-struct: CheckClosureAndArity! ([num-args : OpArg])
|
||||
#:transparent)
|
||||
(define-struct: CheckPrimitiveArity! ([num-args : OpArg])
|
||||
#:transparent)
|
||||
|
||||
|
||||
|
||||
;; Extends the environment with a prefix that holds
|
||||
|
|
@ -481,8 +466,7 @@
|
|||
|
||||
(define-type PrimitiveCommand (U
|
||||
CheckToplevelBound!
|
||||
CheckClosureArity!
|
||||
CheckPrimitiveArity!
|
||||
CheckClosureAndArity!
|
||||
|
||||
ExtendEnvironment/Prefix!
|
||||
InstallClosureValues!
|
||||
|
|
|
|||
|
|
@ -128,8 +128,6 @@
|
|||
(MakeCompiledProcedureShell-arity op)
|
||||
(MakeCompiledProcedureShell-display-name op))]
|
||||
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
op]
|
||||
|
||||
[(MakeBoxedEnvironmentValue? op)
|
||||
op]
|
||||
|
|
|
|||
8
examples/fact.rkt
Normal file
8
examples/fact.rkt
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
#lang planet dyoo/whalesong
|
||||
(provide fact)
|
||||
(define (fact x)
|
||||
(cond
|
||||
[(= x 0)
|
||||
1]
|
||||
[else
|
||||
(* x (fact (sub1 x)))]))
|
||||
|
|
@ -14,10 +14,10 @@
|
|||
(define (assemble-op-expression op)
|
||||
(cond
|
||||
[(GetCompiledProcedureEntry? op)
|
||||
"MACHINE.proc.label"]
|
||||
"M.proc.label"]
|
||||
|
||||
[(MakeCompiledProcedure? op)
|
||||
(format "new RUNTIME.Closure(~a, ~a, [~a], ~a)"
|
||||
(format "new RT.Closure(~a, ~a, [~a], ~a)"
|
||||
(assemble-label (make-Label (MakeCompiledProcedure-label op)))
|
||||
(assemble-arity (MakeCompiledProcedure-arity op))
|
||||
(string-join (map
|
||||
|
|
@ -31,20 +31,17 @@
|
|||
(assemble-display-name (MakeCompiledProcedure-display-name op)))]
|
||||
|
||||
[(MakeCompiledProcedureShell? op)
|
||||
(format "new RUNTIME.Closure(~a, ~a, undefined, ~a)"
|
||||
(format "new RT.Closure(~a, ~a, undefined, ~a)"
|
||||
(assemble-label (make-Label (MakeCompiledProcedureShell-label op)))
|
||||
(assemble-arity (MakeCompiledProcedureShell-arity op))
|
||||
(assemble-display-name (MakeCompiledProcedureShell-display-name op)))]
|
||||
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
(format "MACHINE.proc(MACHINE)")]
|
||||
|
||||
[(CaptureEnvironment? op)
|
||||
(format "MACHINE.env.slice(0, MACHINE.env.length - ~a)"
|
||||
(format "M.env.slice(0, M.env.length - ~a)"
|
||||
(CaptureEnvironment-skip op))]
|
||||
|
||||
[(CaptureControl? op)
|
||||
(format "MACHINE.captureControl(~a, ~a)"
|
||||
(format "M.captureControl(~a, ~a)"
|
||||
(CaptureControl-skip op)
|
||||
(let: ([tag : (U DefaultContinuationPromptTag OpArg)
|
||||
(CaptureControl-tag op)])
|
||||
|
|
@ -55,7 +52,7 @@
|
|||
|
||||
|
||||
[(MakeBoxedEnvironmentValue? op)
|
||||
(format "[MACHINE.env[MACHINE.env.length - 1 - ~a]]"
|
||||
(format "[M.env[M.env.length - 1 - ~a]]"
|
||||
(MakeBoxedEnvironmentValue-depth op))]
|
||||
|
||||
[(CallKernelPrimitiveProcedure? op)
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@
|
|||
(cond
|
||||
[(PrimitivesReference? target)
|
||||
(lambda: ([rhs : String])
|
||||
(format "RUNTIME.Primitives[~s]=RUNTIME.Primitives[~s]||~a;"
|
||||
(format "RT.Primitives[~s]=RT.Primitives[~s]||~a;"
|
||||
(symbol->string (PrimitivesReference-name target))
|
||||
(symbol->string (PrimitivesReference-name target))
|
||||
rhs))]
|
||||
|
|
@ -83,11 +83,11 @@
|
|||
(format "~a=~a;"
|
||||
(cond
|
||||
[(eq? target 'proc)
|
||||
"MACHINE.proc"]
|
||||
"M.proc"]
|
||||
[(eq? target 'val)
|
||||
"MACHINE.val"]
|
||||
"M.val"]
|
||||
[(eq? target 'argcount)
|
||||
"MACHINE.argcount"]
|
||||
"M.argcount"]
|
||||
[(EnvLexicalReference? target)
|
||||
(assemble-lexical-reference target)]
|
||||
[(EnvPrefixReference? target)
|
||||
|
|
@ -95,7 +95,7 @@
|
|||
[(ControlFrameTemporary? target)
|
||||
(assemble-control-frame-temporary target)]
|
||||
[(ModulePrefixTarget? target)
|
||||
(format "MACHINE.modules[~s].prefix"
|
||||
(format "M.modules[~s].prefix"
|
||||
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])
|
||||
rhs))]))
|
||||
|
||||
|
|
@ -103,7 +103,7 @@
|
|||
|
||||
(: assemble-control-frame-temporary (ControlFrameTemporary -> String))
|
||||
(define (assemble-control-frame-temporary t)
|
||||
(format "MACHINE.control[MACHINE.control.length-1].~a"
|
||||
(format "M.control[M.control.length-1].~a"
|
||||
(ControlFrameTemporary-name t)))
|
||||
|
||||
;; fixme: use js->string
|
||||
|
|
@ -111,38 +111,38 @@
|
|||
(define (assemble-const stmt)
|
||||
(let: loop : String ([val : const-value (Const-const stmt)])
|
||||
(cond [(symbol? val)
|
||||
(format "RUNTIME.makeSymbol(~s)" (symbol->string val))]
|
||||
(format "RT.makeSymbol(~s)" (symbol->string val))]
|
||||
[(pair? val)
|
||||
(format "RUNTIME.makePair(~a,~a)"
|
||||
(format "RT.makePair(~a,~a)"
|
||||
(loop (car val))
|
||||
(loop (cdr val)))]
|
||||
[(boolean? val)
|
||||
(if val "true" "false")]
|
||||
[(void? val)
|
||||
"RUNTIME.VOID"]
|
||||
"RT.VOID"]
|
||||
[(empty? val)
|
||||
(format "RUNTIME.NULL")]
|
||||
(format "RT.NULL")]
|
||||
[(number? val)
|
||||
(assemble-numeric-constant val)]
|
||||
[(string? val)
|
||||
(format "~s" val)]
|
||||
[(char? val)
|
||||
(format "RUNTIME.makeChar(~s)" (string val))]
|
||||
(format "RT.makeChar(~s)" (string val))]
|
||||
[(bytes? val)
|
||||
(format "RUNTIME.makeBytes(~a)"
|
||||
(format "RT.makeBytes(~a)"
|
||||
(string-join (for/list ([a-byte val])
|
||||
(number->string a-byte))
|
||||
","))]
|
||||
[(path? val)
|
||||
(format "RUNTIME.makePath(~s)"
|
||||
(format "RT.makePath(~s)"
|
||||
(path->string val))]
|
||||
[(vector? val)
|
||||
(format "RUNTIME.makeVector(~a)"
|
||||
(format "RT.makeVector(~a)"
|
||||
(string-join (for/list ([elt (vector->list val)])
|
||||
(loop elt))
|
||||
","))]
|
||||
[(box? val)
|
||||
(format "RUNTIME.makeBox(~s)"
|
||||
(format "RT.makeBox(~s)"
|
||||
(loop (unbox val)))])))
|
||||
|
||||
|
||||
|
|
@ -152,9 +152,9 @@
|
|||
(let loop ([vals vals])
|
||||
(cond
|
||||
[(empty? vals)
|
||||
"RUNTIME.NULL"]
|
||||
"RT.NULL"]
|
||||
[else
|
||||
(format "RUNTIME.makePair(~a,~a)" (first vals) (loop (rest vals)))])))
|
||||
(format "RT.makePair(~a,~a)" (first vals) (loop (rest vals)))])))
|
||||
|
||||
|
||||
|
||||
|
|
@ -171,15 +171,15 @@
|
|||
(define (floating-number->js a-num)
|
||||
(cond
|
||||
[(eqv? a-num -0.0)
|
||||
"RUNTIME.NEGATIVE_ZERO"]
|
||||
"RT.NEGATIVE_ZERO"]
|
||||
[(eqv? a-num +inf.0)
|
||||
"RUNTIME.INF"]
|
||||
"RT.INF"]
|
||||
[(eqv? a-num -inf.0)
|
||||
"RUNTIME.NEGATIVE_INF"]
|
||||
"RT.NEGATIVE_INF"]
|
||||
[(eqv? a-num +nan.0)
|
||||
"RUNTIME.NAN"]
|
||||
"RT.NAN"]
|
||||
[else
|
||||
(string-append "RUNTIME.makeFloat(" (number->string a-num) ")")]))
|
||||
(string-append "RT.makeFloat(" (number->string a-num) ")")]))
|
||||
|
||||
;; FIXME: fix the type signature when typed-racket isn't breaking on
|
||||
;; (define-predicate ExactRational? (U Exact-Rational))
|
||||
|
|
@ -188,7 +188,7 @@
|
|||
(cond [(= (denominator a-num) 1)
|
||||
(string-append (integer->js (ensure-integer (numerator a-num))))]
|
||||
[else
|
||||
(string-append "RUNTIME.makeRational("
|
||||
(string-append "RT.makeRational("
|
||||
(integer->js (ensure-integer (numerator a-num)))
|
||||
","
|
||||
(integer->js (ensure-integer (denominator a-num)))
|
||||
|
|
@ -211,7 +211,7 @@
|
|||
(number->string an-int)]
|
||||
;; overflow case
|
||||
[else
|
||||
(string-append "RUNTIME.makeBignum("
|
||||
(string-append "RT.makeBignum("
|
||||
(format "~s" (number->string an-int))
|
||||
")")]))
|
||||
|
||||
|
|
@ -223,7 +223,7 @@
|
|||
(floating-number->js a-num)]
|
||||
|
||||
[(complex? a-num)
|
||||
(string-append "RUNTIME.makeComplex("
|
||||
(string-append "RT.makeComplex("
|
||||
(assemble-numeric-constant (real-part a-num))
|
||||
","
|
||||
(assemble-numeric-constant (imag-part a-num))
|
||||
|
|
@ -253,26 +253,26 @@
|
|||
(: assemble-lexical-reference (EnvLexicalReference -> String))
|
||||
(define (assemble-lexical-reference a-lex-ref)
|
||||
(if (EnvLexicalReference-unbox? a-lex-ref)
|
||||
(format "MACHINE.env[MACHINE.env.length-~a][0]"
|
||||
(format "M.env[M.env.length-~a][0]"
|
||||
(add1 (EnvLexicalReference-depth a-lex-ref)))
|
||||
(format "MACHINE.env[MACHINE.env.length-~a]"
|
||||
(format "M.env[M.env.length-~a]"
|
||||
(add1 (EnvLexicalReference-depth a-lex-ref)))))
|
||||
|
||||
(: assemble-prefix-reference (EnvPrefixReference -> String))
|
||||
(define (assemble-prefix-reference a-ref)
|
||||
(format "MACHINE.env[MACHINE.env.length-~a][~a]"
|
||||
(format "M.env[M.env.length-~a][~a]"
|
||||
(add1 (EnvPrefixReference-depth a-ref))
|
||||
(EnvPrefixReference-pos a-ref)))
|
||||
|
||||
(: assemble-whole-prefix-reference (EnvWholePrefixReference -> String))
|
||||
(define (assemble-whole-prefix-reference a-prefix-ref)
|
||||
(format "MACHINE.env[MACHINE.env.length-~a]"
|
||||
(format "M.env[M.env.length-~a]"
|
||||
(add1 (EnvWholePrefixReference-depth a-prefix-ref))))
|
||||
|
||||
|
||||
(: assemble-reg (Reg -> String))
|
||||
(define (assemble-reg a-reg)
|
||||
(string-append "MACHINE." (symbol->string (Reg-name a-reg))))
|
||||
(string-append "M." (symbol->string (Reg-name a-reg))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -302,12 +302,12 @@
|
|||
|
||||
(: assemble-control-stack-label (ControlStackLabel -> String))
|
||||
(define (assemble-control-stack-label a-csl)
|
||||
"MACHINE.control[MACHINE.control.length-1].label")
|
||||
"M.control[M.control.length-1].label")
|
||||
|
||||
|
||||
(: assemble-control-stack-label/multiple-value-return (ControlStackLabel/MultipleValueReturn -> String))
|
||||
(define (assemble-control-stack-label/multiple-value-return a-csl)
|
||||
"MACHINE.control[MACHINE.control.length-1].label.multipleValueReturn")
|
||||
"M.control[M.control.length-1].label.multipleValueReturn")
|
||||
|
||||
|
||||
|
||||
|
|
@ -328,7 +328,7 @@
|
|||
|
||||
(: assemble-default-continuation-prompt-tag (-> String))
|
||||
(define (assemble-default-continuation-prompt-tag)
|
||||
"RUNTIME.DEFAULT_CONTINUATION_PROMPT_TAG")
|
||||
"RT.DEFAULT_CONTINUATION_PROMPT_TAG")
|
||||
|
||||
|
||||
|
||||
|
|
@ -337,7 +337,7 @@
|
|||
;; lexical references: they must remain boxes. So all we need is
|
||||
;; the depth into the environment.
|
||||
(define (assemble-env-reference/closure-capture depth)
|
||||
(format "MACHINE.env[MACHINE.env.length - ~a]"
|
||||
(format "M.env[M.env.length - ~a]"
|
||||
(add1 depth)))
|
||||
|
||||
|
||||
|
|
@ -350,7 +350,7 @@
|
|||
[(natural? an-arity)
|
||||
(number->string an-arity)]
|
||||
[(ArityAtLeast? an-arity)
|
||||
(format "(RUNTIME.makeArityAtLeast(~a))"
|
||||
(format "(RT.makeArityAtLeast(~a))"
|
||||
(ArityAtLeast-value an-arity))]
|
||||
[(listof-atomic-arity? an-arity)
|
||||
(assemble-listof-assembled-values
|
||||
|
|
@ -360,7 +360,7 @@
|
|||
[(natural? atomic-arity)
|
||||
(number->string atomic-arity)]
|
||||
[(ArityAtLeast? atomic-arity)
|
||||
(format "(RUNTIME.makeArityAtLeast(~a))"
|
||||
(format "(RT.makeArityAtLeast(~a))"
|
||||
(ArityAtLeast-value atomic-arity))]))
|
||||
an-arity))]))
|
||||
|
||||
|
|
@ -370,7 +370,7 @@
|
|||
|
||||
(: assemble-jump (OpArg -> String))
|
||||
(define (assemble-jump target)
|
||||
(format "return(~a)(MACHINE);" (assemble-oparg target)))
|
||||
(format "return(~a)(M);" (assemble-oparg target)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -399,25 +399,25 @@
|
|||
|
||||
(: assemble-primitive-kernel-value (PrimitiveKernelValue -> String))
|
||||
(define (assemble-primitive-kernel-value a-prim)
|
||||
(format "MACHINE.primitives[~s]" (symbol->string (PrimitiveKernelValue-id a-prim))))
|
||||
(format "M.primitives[~s]" (symbol->string (PrimitiveKernelValue-id a-prim))))
|
||||
|
||||
|
||||
|
||||
(: assemble-module-entry (ModuleEntry -> String))
|
||||
(define (assemble-module-entry entry)
|
||||
(format "MACHINE.modules[~s].label"
|
||||
(format "M.modules[~s].label"
|
||||
(symbol->string (ModuleLocator-name (ModuleEntry-name entry)))))
|
||||
|
||||
|
||||
(: assemble-is-module-invoked (IsModuleInvoked -> String))
|
||||
(define (assemble-is-module-invoked entry)
|
||||
(format "MACHINE.modules[~s].isInvoked"
|
||||
(format "M.modules[~s].isInvoked"
|
||||
(symbol->string (ModuleLocator-name (IsModuleInvoked-name entry)))))
|
||||
|
||||
|
||||
(: assemble-is-module-linked (IsModuleLinked -> String))
|
||||
(define (assemble-is-module-linked entry)
|
||||
(format "(MACHINE.modules[~s]!==undefined)"
|
||||
(format "(M.modules[~s]!==undefined)"
|
||||
(symbol->string (ModuleLocator-name (IsModuleLinked-name entry)))))
|
||||
|
||||
|
||||
|
|
@ -425,6 +425,6 @@
|
|||
(: assemble-variable-reference (VariableReference -> String))
|
||||
(define (assemble-variable-reference varref)
|
||||
(let ([t (VariableReference-toplevel varref)])
|
||||
(format "(new RUNTIME.VariableReference(MACHINE.env[MACHINE.env.length-~a],~a))"
|
||||
(format "(new RT.VariableReference(M.env[M.env.length-~a],~a))"
|
||||
(add1 (ToplevelRef-depth t))
|
||||
(ToplevelRef-pos t))))
|
||||
|
|
@ -70,7 +70,7 @@
|
|||
(assemble-boolean-chain "plt.baselib.numbers.greaterThanOrEqual" checked-operands)]
|
||||
|
||||
[(cons)
|
||||
(format "RUNTIME.makePair(~a, ~a)"
|
||||
(format "RT.makePair(~a,~a)"
|
||||
(first checked-operands)
|
||||
(second checked-operands))]
|
||||
|
||||
|
|
@ -85,21 +85,21 @@
|
|||
(assemble-listof-assembled-values checked-operands))]
|
||||
|
||||
[(list?)
|
||||
(format "RUNTIME.isList(~a)"
|
||||
(format "RT.isList(~a)"
|
||||
(first checked-operands))]
|
||||
|
||||
[(pair?)
|
||||
(format "RUNTIME.isPair(~a)"
|
||||
(format "RT.isPair(~a)"
|
||||
(first checked-operands))]
|
||||
|
||||
[(null?)
|
||||
(format "(~a === RUNTIME.NULL)" (first checked-operands))]
|
||||
(format "(~a===RT.NULL)" (first checked-operands))]
|
||||
|
||||
[(not)
|
||||
(format "(~a === false)" (first checked-operands))]
|
||||
(format "(~a===false)" (first checked-operands))]
|
||||
|
||||
[(eq?)
|
||||
(format "(~a === ~a)" (first checked-operands) (second checked-operands))])))
|
||||
(format "(~a===~a)" (first checked-operands) (second checked-operands))])))
|
||||
|
||||
|
||||
|
||||
|
|
@ -154,16 +154,16 @@
|
|||
(let: ([predicate : String
|
||||
(case domain
|
||||
[(number)
|
||||
(format "RUNTIME.isNumber")]
|
||||
(format "RT.isNumber")]
|
||||
[(string)
|
||||
(format "RUNTIME.isString")]
|
||||
(format "RT.isString")]
|
||||
[(list)
|
||||
(format "RUNTIME.isList")]
|
||||
(format "RT.isList")]
|
||||
[(pair)
|
||||
(format "RUNTIME.isPair")]
|
||||
(format "RT.isPair")]
|
||||
[(box)
|
||||
(format "RUNTIME.isBox")])])
|
||||
(format "RUNTIME.testArgument(MACHINE, ~s, ~a, ~a, ~a, ~s)"
|
||||
(format "RT.isBox")])])
|
||||
(format "RT.testArgument(M,~s,~a,~a,~a,~s)"
|
||||
(symbol->string domain)
|
||||
predicate
|
||||
operand-string
|
||||
|
|
|
|||
|
|
@ -14,39 +14,31 @@
|
|||
(cond
|
||||
|
||||
[(CheckToplevelBound!? op)
|
||||
(format "if (MACHINE.env[MACHINE.env.length - 1 - ~a][~a] === undefined) { RUNTIME.raiseUnboundToplevelError(MACHINE.env[MACHINE.env.length - 1 - ~a].names[~a]); }"
|
||||
(format "if (M.env[M.env.length - 1 - ~a][~a] === undefined) { RT.raiseUnboundToplevelError(M.env[M.env.length - 1 - ~a].names[~a]); }"
|
||||
(CheckToplevelBound!-depth op)
|
||||
(CheckToplevelBound!-pos op)
|
||||
(CheckToplevelBound!-depth op)
|
||||
(CheckToplevelBound!-pos op))]
|
||||
|
||||
|
||||
[(CheckClosureArity!? op)
|
||||
(format "if(!(MACHINE.proc instanceof RUNTIME.Closure)){RUNTIME.raiseOperatorIsNotClosure(MACHINE,MACHINE.proc);}if(!RUNTIME.isArityMatching(MACHINE.proc.racketArity,~a)){RUNTIME.raiseArityMismatchError(MACHINE, MACHINE.proc,~a);}"
|
||||
(assemble-oparg (CheckClosureArity!-num-args op))
|
||||
(assemble-oparg (CheckClosureArity!-num-args op)))]
|
||||
[(CheckClosureAndArity!? op)
|
||||
(format "RT.checkClosureAndArity(M, ~a);"
|
||||
(assemble-oparg (CheckClosureAndArity!-num-args op)))]
|
||||
|
||||
|
||||
[(CheckPrimitiveArity!? op)
|
||||
(format "if(!RUNTIME.isArityMatching(MACHINE.proc.racketArity,~a)){RUNTIME.raiseArityMismatchError(MACHINE,MACHINE.proc,~a);}"
|
||||
(assemble-oparg (CheckPrimitiveArity!-num-args op))
|
||||
(assemble-oparg (CheckPrimitiveArity!-num-args op)))]
|
||||
|
||||
|
||||
[(ExtendEnvironment/Prefix!? op)
|
||||
(let: ([names : (Listof (U Symbol False GlobalBucket ModuleVariable)) (ExtendEnvironment/Prefix!-names op)])
|
||||
(format "MACHINE.env.push([~a]);MACHINE.env[MACHINE.env.length-1].names=[~a];"
|
||||
(format "M.env.push([~a]);M.env[M.env.length-1].names=[~a];"
|
||||
(string-join (map
|
||||
(lambda: ([n : (U Symbol False GlobalBucket ModuleVariable)])
|
||||
(cond [(symbol? n)
|
||||
(format "MACHINE.params.currentNamespace[~s] || MACHINE.primitives[~s]"
|
||||
(format "M.params.currentNamespace[~s] || M.primitives[~s]"
|
||||
(symbol->string n)
|
||||
(symbol->string n))]
|
||||
[(eq? n #f)
|
||||
"false"]
|
||||
[(GlobalBucket? n)
|
||||
;; FIXME: maybe we should keep a set of global variables here?
|
||||
(format "MACHINE.primitives[~s]"
|
||||
(format "M.primitives[~s]"
|
||||
(symbol->string (GlobalBucket-name n)))]
|
||||
;; FIXME: this should be looking at the module path and getting
|
||||
;; the value here! It shouldn't be looking into Primitives...
|
||||
|
|
@ -54,10 +46,10 @@
|
|||
(cond
|
||||
[((current-kernel-module-locator?)
|
||||
(ModuleVariable-module-name n))
|
||||
(format "MACHINE.primitives[~s]"
|
||||
(format "M.primitives[~s]"
|
||||
(symbol->string (ModuleVariable-name n)))]
|
||||
[else
|
||||
(format "MACHINE.modules[~s].namespace[~s]"
|
||||
(format "M.modules[~s].namespace[~s]"
|
||||
(symbol->string
|
||||
(ModuleLocator-name
|
||||
(ModuleVariable-module-name n)))
|
||||
|
|
@ -79,13 +71,13 @@
|
|||
",")))]
|
||||
|
||||
[(InstallClosureValues!? op)
|
||||
"MACHINE.env.splice.apply(MACHINE.env,[MACHINE.env.length, 0].concat(MACHINE.proc.closedVals));"]
|
||||
"M.env.push.apply(M.env,M.proc.closedVals);"]
|
||||
|
||||
[(RestoreEnvironment!? op)
|
||||
"MACHINE.env=MACHINE.env[MACHINE.env.length-2].slice(0);"]
|
||||
"M.env=M.env[M.env.length-2].slice(0);"]
|
||||
|
||||
[(RestoreControl!? op)
|
||||
(format "MACHINE.restoreControl(~a);"
|
||||
(format "M.restoreControl(~a);"
|
||||
(let: ([tag : (U DefaultContinuationPromptTag OpArg)
|
||||
(RestoreControl!-tag op)])
|
||||
(cond
|
||||
|
|
@ -95,7 +87,7 @@
|
|||
(assemble-oparg tag)])))]
|
||||
|
||||
[(FixClosureShellMap!? op)
|
||||
(format "MACHINE.env[MACHINE.env.length-~a].closedVals=[~a];"
|
||||
(format "M.env[M.env.length-~a].closedVals=[~a];"
|
||||
(add1 (FixClosureShellMap!-depth op))
|
||||
(string-join (map
|
||||
assemble-env-reference/closure-capture
|
||||
|
|
@ -107,60 +99,60 @@
|
|||
","))]
|
||||
|
||||
[(SetFrameCallee!? op)
|
||||
(format "MACHINE.control[MACHINE.control.length-1].proc = ~a;"
|
||||
(format "M.control[M.control.length-1].proc = ~a;"
|
||||
(assemble-oparg (SetFrameCallee!-proc op)))]
|
||||
|
||||
[(SpliceListIntoStack!? op)
|
||||
(format "MACHINE.spliceListIntoStack(~a);"
|
||||
(format "M.spliceListIntoStack(~a);"
|
||||
(assemble-oparg (SpliceListIntoStack!-depth op)))]
|
||||
|
||||
[(UnspliceRestFromStack!? op)
|
||||
(format "MACHINE.unspliceRestFromStack(~a,~a);"
|
||||
(format "M.unspliceRestFromStack(~a,~a);"
|
||||
(assemble-oparg (UnspliceRestFromStack!-depth op))
|
||||
(assemble-oparg (UnspliceRestFromStack!-length op)))]
|
||||
|
||||
[(InstallContinuationMarkEntry!? op)
|
||||
(string-append "MACHINE.installContinuationMarkEntry("
|
||||
"MACHINE.control[MACHINE.control.length-1].pendingContinuationMarkKey,"
|
||||
"MACHINE.val);")]
|
||||
(string-append "M.installContinuationMarkEntry("
|
||||
"M.control[M.control.length-1].pendingContinuationMarkKey,"
|
||||
"M.val);")]
|
||||
|
||||
[(RaiseContextExpectedValuesError!? op)
|
||||
(format "RUNTIME.raiseContextExpectedValuesError(MACHINE,~a);"
|
||||
(format "RT.raiseContextExpectedValuesError(M,~a);"
|
||||
(RaiseContextExpectedValuesError!-expected op))]
|
||||
|
||||
|
||||
[(RaiseArityMismatchError!? op)
|
||||
(format "RUNTIME.raiseArityMismatchError(MACHINE,~a,~a);"
|
||||
(format "RT.raiseArityMismatchError(M,~a,~a);"
|
||||
(assemble-oparg (RaiseArityMismatchError!-proc op))
|
||||
(assemble-oparg (RaiseArityMismatchError!-received op)))]
|
||||
|
||||
|
||||
[(RaiseOperatorApplicationError!? op)
|
||||
(format "RUNTIME.raiseOperatorApplicationError(MACHINE,~a);"
|
||||
(format "RT.raiseOperatorApplicationError(M,~a);"
|
||||
(assemble-oparg (RaiseOperatorApplicationError!-operator op)))]
|
||||
|
||||
|
||||
[(RaiseUnimplementedPrimitiveError!? op)
|
||||
(format "RUNTIME.raiseUnimplementedPrimitiveError(MACHINE,~s);"
|
||||
(format "RT.raiseUnimplementedPrimitiveError(M,~s);"
|
||||
(symbol->string (RaiseUnimplementedPrimitiveError!-name op)))]
|
||||
|
||||
|
||||
[(InstallModuleEntry!? op)
|
||||
(format "MACHINE.modules[~s]=new RUNTIME.ModuleRecord(~s,~a);"
|
||||
(format "M.modules[~s]=new RT.ModuleRecord(~s,~a);"
|
||||
(symbol->string (ModuleLocator-name (InstallModuleEntry!-path op)))
|
||||
(symbol->string (InstallModuleEntry!-name op))
|
||||
(assemble-label (make-Label (InstallModuleEntry!-entry-point op))))]
|
||||
|
||||
[(MarkModuleInvoked!? op)
|
||||
(format "MACHINE.modules[~s].isInvoked=true;"
|
||||
(format "M.modules[~s].isInvoked=true;"
|
||||
(symbol->string (ModuleLocator-name (MarkModuleInvoked!-path op))))]
|
||||
|
||||
|
||||
[(AliasModuleAsMain!? op)
|
||||
(format "MACHINE.mainModules.push(MACHINE.modules[~s]);"
|
||||
(format "M.mainModules.push(M.modules[~s]);"
|
||||
(symbol->string (ModuleLocator-name (AliasModuleAsMain!-from op))))]
|
||||
|
||||
[(FinalizeModuleInvokation!? op)
|
||||
(format "MACHINE.modules[~s].finalizeModuleInvokation();"
|
||||
(format "M.modules[~s].finalizeModuleInvokation();"
|
||||
(symbol->string
|
||||
(ModuleLocator-name (FinalizeModuleInvokation!-path op))))]))
|
||||
|
|
|
|||
|
|
@ -14,7 +14,8 @@
|
|||
"../sets.rkt"
|
||||
"../helpers.rkt"
|
||||
racket/string
|
||||
racket/list)
|
||||
racket/list
|
||||
racket/match)
|
||||
(require/typed "../logger.rkt"
|
||||
[log-debug (String -> Void)])
|
||||
|
||||
|
|
@ -39,34 +40,40 @@
|
|||
;; What's emitted is a function expression that, when invoked, runs the
|
||||
;; statements.
|
||||
(define (assemble/write-invoke stmts op)
|
||||
(display "(function(MACHINE, success, fail, params) {\n" op)
|
||||
(display "(function(M, success, fail, params) {\n" op)
|
||||
(display "var param;\n" op)
|
||||
(display "var RUNTIME = plt.runtime;\n" op)
|
||||
(display "var RT = plt.runtime;\n" op)
|
||||
|
||||
(define-values (basic-blocks entry-points) (fracture stmts))
|
||||
|
||||
(write-blocks basic-blocks (list->set entry-points) op)
|
||||
|
||||
(define function-entry-and-exit-names
|
||||
(list->set (get-function-entry-and-exit-names stmts)))
|
||||
|
||||
(write-blocks basic-blocks
|
||||
(list->set entry-points)
|
||||
function-entry-and-exit-names
|
||||
op)
|
||||
|
||||
(write-linked-label-attributes stmts op)
|
||||
|
||||
(display "MACHINE.params.currentErrorHandler = fail;\n" op)
|
||||
(display "MACHINE.params.currentSuccessHandler = success;\n" op)
|
||||
(display "M.params.currentErrorHandler = fail;\n" op)
|
||||
(display "M.params.currentSuccessHandler = success;\n" op)
|
||||
(display #<<EOF
|
||||
for (param in params) {
|
||||
if (params.hasOwnProperty(param)) {
|
||||
MACHINE.params[param] = params[param];
|
||||
M.params[param] = params[param];
|
||||
}
|
||||
}
|
||||
EOF
|
||||
op)
|
||||
(fprintf op "MACHINE.trampoline(~a); })"
|
||||
(fprintf op "M.trampoline(~a); })"
|
||||
(assemble-label (make-Label (BasicBlock-name (first basic-blocks))))))
|
||||
|
||||
|
||||
|
||||
(: write-blocks ((Listof BasicBlock) (Setof Symbol) Output-Port -> Void))
|
||||
(: write-blocks ((Listof BasicBlock) (Setof Symbol) (Setof Symbol) Output-Port -> Void))
|
||||
;; Write out all the basic blocks associated to an entry point.
|
||||
(define (write-blocks blocks entry-points op)
|
||||
(define (write-blocks blocks entry-points function-entry-and-exit-names op)
|
||||
(: blockht : Blockht)
|
||||
(define blockht (make-hash))
|
||||
|
||||
|
|
@ -82,6 +89,7 @@ EOF
|
|||
(assemble-basic-block (hash-ref blockht s)
|
||||
blockht
|
||||
entry-points
|
||||
function-entry-and-exit-names
|
||||
op)
|
||||
(newline op))
|
||||
entry-points))
|
||||
|
|
@ -169,11 +177,30 @@ EOF
|
|||
|
||||
|
||||
|
||||
(: assemble-basic-block (BasicBlock Blockht (Setof Symbol) Output-Port -> 'ok))
|
||||
(define (assemble-basic-block a-basic-block blockht entry-points op)
|
||||
(fprintf op "var ~a = function(MACHINE) { if(--MACHINE.callsBeforeTrampoline < 0) { throw ~a; }\n"
|
||||
(assemble-label (make-Label (BasicBlock-name a-basic-block)))
|
||||
(assemble-label (make-Label (BasicBlock-name a-basic-block))))
|
||||
(: assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok))
|
||||
(define (assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)
|
||||
(match (BasicBlock-stmts a-basic-block)
|
||||
[(list (struct PerformStatement ((struct RaiseContextExpectedValuesError! (expected))))
|
||||
stmts ...)
|
||||
(fprintf op "~a=RT.si_context_expected(~a);\n"
|
||||
(assemble-label (make-Label (BasicBlock-name a-basic-block)))
|
||||
expected)
|
||||
'ok]
|
||||
[else
|
||||
(default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)]))
|
||||
|
||||
|
||||
|
||||
(: default-assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok))
|
||||
(define (default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)
|
||||
(cond
|
||||
[(set-contains? function-entry-and-exit-names (BasicBlock-name a-basic-block))
|
||||
(fprintf op "var ~a=function(M){if(--M.cbt<0){throw ~a;}\n"
|
||||
(assemble-label (make-Label (BasicBlock-name a-basic-block)))
|
||||
(assemble-label (make-Label (BasicBlock-name a-basic-block))))]
|
||||
[else
|
||||
(fprintf op "var ~a=function(M){--M.cbt<0;\n"
|
||||
(assemble-label (make-Label (BasicBlock-name a-basic-block))))])
|
||||
(assemble-block-statements (BasicBlock-name a-basic-block)
|
||||
(BasicBlock-stmts a-basic-block)
|
||||
blockht
|
||||
|
|
@ -184,6 +211,7 @@ EOF
|
|||
|
||||
|
||||
|
||||
|
||||
(: assemble-block-statements (Symbol (Listof UnlabeledStatement) Blockht (Setof Symbol) Output-Port -> 'ok))
|
||||
(define (assemble-block-statements name stmts blockht entry-points op)
|
||||
|
||||
|
|
@ -236,12 +264,12 @@ EOF
|
|||
(format "if(~a===0)"
|
||||
(assemble-oparg (TestZero-operand test)))]
|
||||
|
||||
[(TestPrimitiveProcedure? test)
|
||||
(format "if(typeof(~a)==='function')"
|
||||
(assemble-oparg (TestPrimitiveProcedure-operand test)))]
|
||||
;; [(TestPrimitiveProcedure? test)
|
||||
;; (format "if(typeof(~a)==='function')"
|
||||
;; (assemble-oparg (TestPrimitiveProcedure-operand test)))]
|
||||
|
||||
[(TestClosureArityMismatch? test)
|
||||
(format "if(!RUNTIME.isArityMatching((~a).racketArity,~a))"
|
||||
(format "if(!RT.isArityMatching((~a).racketArity,~a))"
|
||||
(assemble-oparg (TestClosureArityMismatch-closure test))
|
||||
(assemble-oparg (TestClosureArityMismatch-n test)))]))
|
||||
(display test-code op)
|
||||
|
|
@ -399,7 +427,7 @@ EOF
|
|||
(define assembled
|
||||
(cond
|
||||
[(DebugPrint? stmt)
|
||||
(format "MACHINE.params.currentOutputPort.writeDomNode(MACHINE, $('<span/>').text(~a));"
|
||||
(format "M.params.currentOutputPort.writeDomNode(M, $('<span/>').text(~a));"
|
||||
(assemble-oparg (DebugPrint-value stmt)))]
|
||||
[(AssignImmediateStatement? stmt)
|
||||
(let: ([t : (String -> String) (assemble-target (AssignImmediateStatement-target stmt))]
|
||||
|
|
@ -435,12 +463,8 @@ EOF
|
|||
(format "if(~a===0){~a}"
|
||||
(assemble-oparg (TestZero-operand test))
|
||||
jump)]
|
||||
[(TestPrimitiveProcedure? test)
|
||||
(format "if(typeof(~a)==='function'){~a}"
|
||||
(assemble-oparg (TestPrimitiveProcedure-operand test))
|
||||
jump)]
|
||||
[(TestClosureArityMismatch? test)
|
||||
(format "if(!RUNTIME.isArityMatching((~a).racketArity,~a)){~a}"
|
||||
(format "if(!RT.isArityMatching((~a).racketArity,~a)){~a}"
|
||||
(assemble-oparg (TestClosureArityMismatch-closure test))
|
||||
(assemble-oparg (TestClosureArityMismatch-n test))
|
||||
jump)])
|
||||
|
|
@ -450,10 +474,10 @@ EOF
|
|||
(assemble-jump (GotoStatement-target stmt))]
|
||||
|
||||
[(PushControlFrame/Generic? stmt)
|
||||
"MACHINE.control.push(new RUNTIME.Frame());"]
|
||||
"M.control.push(new RT.Frame());"]
|
||||
|
||||
[(PushControlFrame/Call? stmt)
|
||||
(format "MACHINE.control.push(new RUNTIME.CallFrame(~a,MACHINE.proc));"
|
||||
(format "M.control.push(new RT.CallFrame(~a,M.proc));"
|
||||
(let: ([label : (U Symbol LinkedLabel) (PushControlFrame/Call-label stmt)])
|
||||
(cond
|
||||
[(symbol? label)
|
||||
|
|
@ -463,7 +487,7 @@ EOF
|
|||
|
||||
[(PushControlFrame/Prompt? stmt)
|
||||
;; fixme: use a different frame structure
|
||||
(format "MACHINE.control.push(new RUNTIME.PromptFrame(~a,~a));"
|
||||
(format "M.control.push(new RT.PromptFrame(~a,~a));"
|
||||
(let: ([label : (U Symbol LinkedLabel) (PushControlFrame/Prompt-label stmt)])
|
||||
(cond
|
||||
[(symbol? label)
|
||||
|
|
@ -480,12 +504,12 @@ EOF
|
|||
(assemble-oparg tag)])))]
|
||||
|
||||
[(PopControlFrame? stmt)
|
||||
"MACHINE.control.pop();"]
|
||||
"M.control.pop();"]
|
||||
|
||||
[(PushEnvironment? stmt)
|
||||
(if (= (PushEnvironment-n stmt) 0)
|
||||
""
|
||||
(format "MACHINE.env.push(~a);" (string-join
|
||||
(format "M.env.push(~a);" (string-join
|
||||
(build-list (PushEnvironment-n stmt)
|
||||
(lambda: ([i : Natural])
|
||||
(if (PushEnvironment-unbox? stmt)
|
||||
|
|
@ -496,16 +520,16 @@ EOF
|
|||
(let: ([skip : OpArg (PopEnvironment-skip stmt)])
|
||||
(cond
|
||||
[(and (Const? skip) (= (ensure-natural (Const-const skip)) 0))
|
||||
(format "MACHINE.env.length-=~a;"
|
||||
(format "M.env.length-=~a;"
|
||||
(assemble-oparg (PopEnvironment-n stmt)))]
|
||||
[else
|
||||
(format "MACHINE.env.splice(MACHINE.env.length-(~a +~a),~a);"
|
||||
(format "M.env.splice(M.env.length-(~a +~a),~a);"
|
||||
(assemble-oparg (PopEnvironment-skip stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt)))]))]
|
||||
|
||||
[(PushImmediateOntoEnvironment? stmt)
|
||||
(format "MACHINE.env.push(~a);"
|
||||
(format "M.env.push(~a);"
|
||||
(let: ([val-string : String
|
||||
(cond [(PushImmediateOntoEnvironment-box? stmt)
|
||||
(format "[~a]" (assemble-oparg (PushImmediateOntoEnvironment-value stmt)))]
|
||||
|
|
@ -532,3 +556,31 @@ EOF
|
|||
(if (natural? n)
|
||||
n
|
||||
(error 'ensure-natural)))
|
||||
|
||||
|
||||
|
||||
(: get-function-entry-and-exit-names ((Listof Statement) -> (Listof Symbol)))
|
||||
(define (get-function-entry-and-exit-names stmts)
|
||||
(cond
|
||||
[(empty? stmts)
|
||||
'()]
|
||||
[else
|
||||
(define first-stmt (first stmts))
|
||||
(cond
|
||||
[(LinkedLabel? first-stmt)
|
||||
(cons (LinkedLabel-label first-stmt)
|
||||
(cons (LinkedLabel-linked-to first-stmt)
|
||||
(get-function-entry-and-exit-names (rest stmts))))]
|
||||
[(AssignPrimOpStatement? first-stmt)
|
||||
(define op (AssignPrimOpStatement-op first-stmt))
|
||||
(cond
|
||||
[(MakeCompiledProcedure? op)
|
||||
(cons (MakeCompiledProcedure-label op)
|
||||
(get-function-entry-and-exit-names (rest stmts)))]
|
||||
[(MakeCompiledProcedureShell? first-stmt)
|
||||
(cons (MakeCompiledProcedureShell-label op)
|
||||
(get-function-entry-and-exit-names (rest stmts)))]
|
||||
[else
|
||||
(get-function-entry-and-exit-names (rest stmts))])]
|
||||
[else
|
||||
(get-function-entry-and-exit-names (rest stmts))])]))
|
||||
|
|
|
|||
|
|
@ -112,8 +112,8 @@
|
|||
(list (MakeCompiledProcedure-label op))]
|
||||
[(MakeCompiledProcedureShell? op)
|
||||
(list (MakeCompiledProcedureShell-label op))]
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
empty]
|
||||
;; [(ApplyPrimitiveProcedure? op)
|
||||
;; empty]
|
||||
[(CaptureEnvironment? op)
|
||||
empty]
|
||||
[(CaptureControl? op)
|
||||
|
|
@ -258,8 +258,8 @@
|
|||
(list (MakeCompiledProcedure-label op))]
|
||||
[(MakeCompiledProcedureShell? op)
|
||||
(list (MakeCompiledProcedureShell-label op))]
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
empty]
|
||||
;; [(ApplyPrimitiveProcedure? op)
|
||||
;; empty]
|
||||
[(CaptureEnvironment? op)
|
||||
empty]
|
||||
[(CaptureControl? op)
|
||||
|
|
@ -279,7 +279,7 @@
|
|||
;; currently written this way because I'm hitting some bad type-checking behavior.
|
||||
#;([(CheckToplevelBound!? op)
|
||||
empty]
|
||||
[(CheckClosureArity!? op)
|
||||
[(CheckClosureAndArity!? op)
|
||||
empty]
|
||||
[(CheckPrimitiveArity!? op)
|
||||
empty]
|
||||
|
|
|
|||
|
|
@ -19,10 +19,12 @@
|
|||
racket/port
|
||||
(prefix-in query: "../lang/js/query.rkt")
|
||||
(prefix-in resource-query: "../resource/query.rkt")
|
||||
(planet dyoo/closure-compile:1:1)
|
||||
(prefix-in runtime: "get-runtime.rkt")
|
||||
(prefix-in racket: racket/base))
|
||||
|
||||
;; There is a dynamic require for (planet dyoo/closure-compile) that's done
|
||||
;; if compression is turned on.
|
||||
|
||||
|
||||
;; TODO: put proper contracts here
|
||||
|
||||
|
|
@ -155,23 +157,23 @@
|
|||
module-requires))
|
||||
(let ([module-body-text
|
||||
(format "
|
||||
if(--MACHINE.callsBeforeTrampoline<0) { throw arguments.callee; }
|
||||
var modrec = MACHINE.modules[~s];
|
||||
if(--M.cbt<0) { throw arguments.callee; }
|
||||
var modrec = M.modules[~s];
|
||||
var exports = {};
|
||||
modrec.isInvoked = true;
|
||||
(function(MACHINE, RUNTIME, EXPORTS){~a})(MACHINE, plt.runtime, exports);
|
||||
(function(MACHINE, EXPORTS){~a})(M, exports);
|
||||
~a
|
||||
modrec.privateExports = exports;
|
||||
return MACHINE.control.pop().label(MACHINE);"
|
||||
return M.control.pop().label(M);"
|
||||
(symbol->string name)
|
||||
text
|
||||
(get-provided-name-code bytecode))])
|
||||
|
||||
(make-UninterpretedSource
|
||||
(format "
|
||||
MACHINE.modules[~s] =
|
||||
M.modules[~s] =
|
||||
new plt.runtime.ModuleRecord(~s,
|
||||
function(MACHINE) {
|
||||
function(M) {
|
||||
~a
|
||||
});
|
||||
"
|
||||
|
|
@ -204,10 +206,10 @@ MACHINE.modules[~s] =
|
|||
(let ([name (rewrite-path (path->string path))]
|
||||
[afterName (gensym 'afterName)])
|
||||
(format "var ~a = function() { ~a };
|
||||
if (! MACHINE.modules[~s].isInvoked) {
|
||||
MACHINE.modules[~s].internalInvoke(MACHINE,
|
||||
if (! M.modules[~s].isInvoked) {
|
||||
M.modules[~s].internalInvoke(M,
|
||||
~a,
|
||||
MACHINE.params.currentErrorHandler);
|
||||
M.params.currentErrorHandler);
|
||||
} else {
|
||||
~a();
|
||||
}"
|
||||
|
|
@ -229,7 +231,7 @@ MACHINE.modules[~s] =
|
|||
;; following module paths of a source's dependencies.
|
||||
;;
|
||||
;; The generated output defines a function called 'invoke' with
|
||||
;; four arguments (MACHINE, SUCCESS, FAIL, PARAMS). When called, it will
|
||||
;; four arguments (M, SUCCESS, FAIL, PARAMS). When called, it will
|
||||
;; execute the code to either run standalone expressions or
|
||||
;; load in modules.
|
||||
(define (package source-code
|
||||
|
|
@ -265,7 +267,7 @@ MACHINE.modules[~s] =
|
|||
plt.runtime.setReadyFalse();
|
||||
(")
|
||||
(assemble/write-invoke stmts op)
|
||||
(fprintf op ")(MACHINE,
|
||||
(fprintf op ")(M,
|
||||
function() {
|
||||
if (window.console && window.console.log) {
|
||||
window.console.log('loaded ' + ~s);
|
||||
|
|
@ -308,7 +310,7 @@ MACHINE.modules[~s] =
|
|||
;; last
|
||||
on-last-src))
|
||||
|
||||
(fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {")
|
||||
(fprintf op "var invoke = (function(M, SUCCESS, FAIL, PARAMS) {")
|
||||
(fprintf op " plt.runtime.ready(function() {")
|
||||
(fprintf op " plt.runtime.setReadyFalse();")
|
||||
(make (list (make-MainModuleSource source-code))
|
||||
|
|
@ -347,7 +349,7 @@ MACHINE.modules[~s] =
|
|||
;; on
|
||||
(lambda (src ast stmts)
|
||||
(assemble/write-invoke stmts op)
|
||||
(fprintf op "(MACHINE, function() { "))
|
||||
(fprintf op "(M, function() { "))
|
||||
|
||||
;; after
|
||||
(lambda (src)
|
||||
|
|
@ -360,16 +362,18 @@ MACHINE.modules[~s] =
|
|||
(display (runtime:get-runtime) op)
|
||||
|
||||
(newline op)
|
||||
(fprintf op "(function(MACHINE, SUCCESS, FAIL, PARAMS) {")
|
||||
(fprintf op "(function(M, SUCCESS, FAIL, PARAMS) {")
|
||||
(make (list only-bootstrapped-code) packaging-configuration)
|
||||
(fprintf op "})(plt.runtime.currentMachine,\nfunction(){ plt.runtime.setReadyTrue(); },\nfunction(){},\n{});\n")))
|
||||
|
||||
|
||||
|
||||
(define closure-compile-ns (make-base-namespace))
|
||||
(define (compress x)
|
||||
(cond [(current-compress-javascript?)
|
||||
(log-debug "compressing javascript...")
|
||||
(closure-compile x)]
|
||||
(parameterize ([current-namespace closure-compile-ns])
|
||||
(define closure-compile (dynamic-require '(planet dyoo/closure-compile) 'closure-compile))
|
||||
(closure-compile x))]
|
||||
[else
|
||||
(log-debug "not compressing javascript...")
|
||||
x]))
|
||||
|
|
@ -465,12 +469,12 @@ EOF
|
|||
(define invoke-main-module-code
|
||||
#<<EOF
|
||||
var invokeMainModule = function() {
|
||||
var MACHINE = plt.runtime.currentMachine;
|
||||
invoke(MACHINE,
|
||||
var M = plt.runtime.currentMachine;
|
||||
invoke(M,
|
||||
function() {
|
||||
var startTime = new Date().valueOf();
|
||||
plt.runtime.invokeMains(
|
||||
MACHINE,
|
||||
M,
|
||||
function() {
|
||||
// On main module invokation success:
|
||||
var stopTime = new Date().valueOf();
|
||||
|
|
@ -478,25 +482,25 @@ var invokeMainModule = function() {
|
|||
window.console.log('evaluation took ' + (stopTime - startTime) + ' milliseconds');
|
||||
}
|
||||
},
|
||||
function(MACHINE, e) {
|
||||
function(M, e) {
|
||||
var contMarkSet, context, i, appName;
|
||||
// On main module invokation failure
|
||||
if (window.console && window.console.log) {
|
||||
window.console.log(e.stack || e);
|
||||
}
|
||||
|
||||
MACHINE.params.currentErrorDisplayer(
|
||||
MACHINE, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));
|
||||
M.params.currentErrorDisplayer(
|
||||
M, $(plt.baselib.format.toDomNode(e.stack || e)).css('color', 'red'));
|
||||
|
||||
if (e.hasOwnProperty('racketError') &&
|
||||
plt.baselib.exceptions.isExn(e.racketError)) {
|
||||
contMarkSet = plt.baselib.exceptions.exnContMarks(e.racketError);
|
||||
if (contMarkSet) {
|
||||
context = contMarkSet.getContext(MACHINE);
|
||||
context = contMarkSet.getContext(M);
|
||||
for (i = 0; i < context.length; i++) {
|
||||
if (plt.runtime.isVector(context[i])) {
|
||||
MACHINE.params.currentErrorDisplayer(
|
||||
MACHINE,
|
||||
M.params.currentErrorDisplayer(
|
||||
M,
|
||||
$('<div/>').text(' at ' + context[i].elts[0] +
|
||||
', line ' + context[i].elts[2] +
|
||||
', column ' + context[i].elts[3])
|
||||
|
|
@ -505,8 +509,8 @@ var invokeMainModule = function() {
|
|||
.css('whitespace', 'pre')
|
||||
.css('color', 'red'));
|
||||
} else if (plt.runtime.isProcedure(context[i])) {
|
||||
MACHINE.params.currentErrorDisplayer(
|
||||
MACHINE,
|
||||
M.params.currentErrorDisplayer(
|
||||
M,
|
||||
$('<div/>').text(' in ' + context[i].displayName)
|
||||
.addClass('stacktrace')
|
||||
.css('margin-left', '10px')
|
||||
|
|
|
|||
|
|
@ -61,12 +61,11 @@
|
|||
// I'd personally love for this to be a macro and avoid the
|
||||
// extra function call here.
|
||||
var finalizeClosureCall = function (MACHINE) {
|
||||
MACHINE.callsBeforeTrampoline--;
|
||||
var i, returnArgs = [].slice.call(arguments, 1);
|
||||
MACHINE.cbt--;
|
||||
var returnArgs = [].slice.call(arguments, 1);
|
||||
|
||||
// clear out stack space
|
||||
// TODO: replace with a splice.
|
||||
MACHINE.env.length = MACHINE.env.length - MACHINE.argcount;
|
||||
MACHINE.env.length -= MACHINE.argcount;
|
||||
|
||||
if (returnArgs.length === 1) {
|
||||
MACHINE.val = returnArgs[0];
|
||||
|
|
@ -77,10 +76,7 @@
|
|||
} else {
|
||||
MACHINE.argcount = returnArgs.length;
|
||||
MACHINE.val = returnArgs.shift();
|
||||
// TODO: replace with a splice.
|
||||
for (i = 0; i < MACHINE.argcount - 1; i++) {
|
||||
MACHINE.env.push(returnArgs.pop());
|
||||
}
|
||||
MACHINE.env.push.apply(MACHINE.env, returnArgs.reverse());
|
||||
return MACHINE.control.pop().label.multipleValueReturn(MACHINE);
|
||||
}
|
||||
};
|
||||
|
|
@ -311,15 +307,6 @@
|
|||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
var makePrimitiveProcedure = function (name, arity, f) {
|
||||
f.racketArity = arity;
|
||||
f.displayName = name;
|
||||
return f;
|
||||
};
|
||||
|
||||
var makeClosure = function (name, arity, f, closureArgs) {
|
||||
if (! closureArgs) { closureArgs = []; }
|
||||
return new Closure(f,
|
||||
|
|
@ -329,6 +316,23 @@
|
|||
};
|
||||
|
||||
|
||||
var makePrimitiveProcedure = function (name, arity, f) {
|
||||
// f.racketArity = arity;
|
||||
// f.displayName = name;
|
||||
// return f;
|
||||
return makeClosure(name,
|
||||
arity,
|
||||
function(M) {
|
||||
--M.cbt;
|
||||
M.val = f(M);
|
||||
M.env.length -= M.argcount;
|
||||
return M.control.pop().label(M);
|
||||
},
|
||||
[]);
|
||||
};
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
8985
js-assembler/runtime-src/jquery.js
vendored
8985
js-assembler/runtime-src/jquery.js
vendored
File diff suppressed because one or more lines are too long
|
|
@ -186,7 +186,7 @@
|
|||
|
||||
|
||||
var defaultCurrentPrintImplementation = function defaultCurrentPrintImplementation(MACHINE) {
|
||||
if(--MACHINE.callsBeforeTrampoline < 0) {
|
||||
if(--MACHINE.cbt < 0) {
|
||||
throw defaultCurrentPrintImplementation;
|
||||
}
|
||||
var oldArgcount = MACHINE.argcount;
|
||||
|
|
@ -211,12 +211,12 @@
|
|||
// The MACHINE
|
||||
|
||||
var Machine = function() {
|
||||
this.callsBeforeTrampoline = STACK_LIMIT_ESTIMATE;
|
||||
this.val = undefined;
|
||||
this.proc = undefined;
|
||||
this.argcount = undefined;
|
||||
this.env = [];
|
||||
this.control = []; // Arrayof (U Frame CallFrame PromptFrame)
|
||||
this.cbt = STACK_LIMIT_ESTIMATE; // calls before trampoline
|
||||
this.val = undefined; // value register
|
||||
this.proc = undefined; // procedure register
|
||||
this.argcount = undefined; // argument count
|
||||
this.env = []; // environment
|
||||
this.control = []; // control: Arrayof (U Frame CallFrame PromptFrame)
|
||||
this.running = false;
|
||||
this.modules = {}; // String -> ModuleRecord
|
||||
this.mainModules = []; // Arrayof String
|
||||
|
|
@ -444,17 +444,16 @@
|
|||
|
||||
|
||||
Machine.prototype.trampoline = function(initialJump) {
|
||||
var MACHINE = this;
|
||||
var thunk = initialJump;
|
||||
var startTime = (new Date()).valueOf();
|
||||
MACHINE.callsBeforeTrampoline = STACK_LIMIT_ESTIMATE;
|
||||
MACHINE.params.numBouncesBeforeYield =
|
||||
MACHINE.params.maxNumBouncesBeforeYield;
|
||||
MACHINE.running = true;
|
||||
this.cbt = STACK_LIMIT_ESTIMATE;
|
||||
this.params.numBouncesBeforeYield =
|
||||
this.params.maxNumBouncesBeforeYield;
|
||||
this.running = true;
|
||||
|
||||
while(true) {
|
||||
try {
|
||||
thunk(MACHINE);
|
||||
thunk(this);
|
||||
break;
|
||||
} catch (e) {
|
||||
// There are a few kinds of things that can get thrown
|
||||
|
|
@ -479,35 +478,36 @@
|
|||
// The running flag is set to false.
|
||||
if (typeof(e) === 'function') {
|
||||
thunk = e;
|
||||
MACHINE.callsBeforeTrampoline = STACK_LIMIT_ESTIMATE;
|
||||
this.cbt = STACK_LIMIT_ESTIMATE;
|
||||
|
||||
if (MACHINE.params.numBouncesBeforeYield-- < 0) {
|
||||
if (this.params.numBouncesBeforeYield-- < 0) {
|
||||
recomputeMaxNumBouncesBeforeYield(
|
||||
MACHINE,
|
||||
this,
|
||||
(new Date()).valueOf() - startTime);
|
||||
scheduleTrampoline(MACHINE, thunk);
|
||||
scheduleTrampoline(this, thunk);
|
||||
return;
|
||||
}
|
||||
} else if (e instanceof Pause) {
|
||||
var restart = makeRestartFunction(MACHINE);
|
||||
var restart = makeRestartFunction(this);
|
||||
e.onPause(restart);
|
||||
return;
|
||||
} else if (e instanceof HaltError) {
|
||||
MACHINE.running = false;
|
||||
e.onHalt(MACHINE);
|
||||
this.running = false;
|
||||
e.onHalt(this);
|
||||
return;
|
||||
} else {
|
||||
// General error condition: just exit out
|
||||
// of the trampoline and call the current error handler.
|
||||
MACHINE.running = false;
|
||||
MACHINE.params.currentErrorHandler(MACHINE, e);
|
||||
this.running = false;
|
||||
this.params.currentErrorHandler(this, e);
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
MACHINE.running = false;
|
||||
this.running = false;
|
||||
var that = this;
|
||||
setTimeout(
|
||||
function() { MACHINE.params.currentSuccessHandler(MACHINE); },
|
||||
function() { that.params.currentSuccessHandler(that); },
|
||||
0);
|
||||
return;
|
||||
};
|
||||
|
|
@ -655,6 +655,33 @@
|
|||
|
||||
|
||||
|
||||
var checkClosureAndArity = function(M, n) {
|
||||
if(!(M.proc instanceof Closure)){
|
||||
raiseOperatorIsNotClosure(M,M.proc);
|
||||
}
|
||||
if(!isArityMatching(M.proc.racketArity,n)) {
|
||||
raiseArityMismatchError(M, M.proc,n);
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
// Superinstructions to try to reduce code size.
|
||||
var si_context_expected = function(n) {
|
||||
if (n === 1) { return si_context_expected_1; }
|
||||
return function(M) { raiseContextExpectedValuesError(M, n); }
|
||||
};
|
||||
var si_context_expected_1 = function(M) { raiseContextExpectedValuesError(M, 1); }
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
//////////////////////////////////////////////////////////////////////
|
||||
|
|
@ -784,4 +811,8 @@
|
|||
exports['getTracedAppKey'] = getTracedAppKey;
|
||||
exports['getTracedCalleeKey'] = getTracedCalleeKey;
|
||||
|
||||
exports['si_context_expected'] = si_context_expected;
|
||||
exports['checkClosureAndArity'] = checkClosureAndArity;
|
||||
|
||||
|
||||
}(this.plt, this.plt.baselib));
|
||||
|
|
@ -1,18 +1,21 @@
|
|||
var VOID = plt.baselib.constants.VOID_VALUE;
|
||||
var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure;
|
||||
|
||||
EXPORTS['alert'] =
|
||||
RUNTIME.makePrimitiveProcedure(
|
||||
makePrimitiveProcedure(
|
||||
'alert',
|
||||
1,
|
||||
function(MACHINE) {
|
||||
var elt = MACHINE.env[MACHINE.env.length - 1];
|
||||
alert(String(elt));
|
||||
return RUNTIME.VOID;
|
||||
return VOID;
|
||||
});
|
||||
|
||||
|
||||
EXPORTS['body'] = $(document.body);
|
||||
|
||||
EXPORTS['$'] =
|
||||
RUNTIME.makePrimitiveProcedure(
|
||||
makePrimitiveProcedure(
|
||||
'$',
|
||||
1,
|
||||
function(MACHINE) {
|
||||
|
|
@ -21,7 +24,7 @@ EXPORTS['$'] =
|
|||
});
|
||||
|
||||
EXPORTS['call-method'] =
|
||||
RUNTIME.makePrimitiveProcedure(
|
||||
makePrimitiveProcedure(
|
||||
'call-method',
|
||||
plt.baselib.arity.makeArityAtLeast(2),
|
||||
function(MACHINE) {
|
||||
|
|
@ -40,7 +43,7 @@ EXPORTS['call-method'] =
|
|||
|
||||
// Javascript-specific extensions. A small experiment.
|
||||
EXPORTS['viewport-width'] =
|
||||
RUNTIME.makePrimitiveProcedure(
|
||||
makePrimitiveProcedure(
|
||||
'viewport-width',
|
||||
0,
|
||||
function(MACHINE) {
|
||||
|
|
@ -48,7 +51,7 @@ EXPORTS['viewport-width'] =
|
|||
});
|
||||
|
||||
EXPORTS['viewport-height'] =
|
||||
RUNTIME.makePrimitiveProcedure(
|
||||
makePrimitiveProcedure(
|
||||
'viewport-height',
|
||||
0,
|
||||
function(MACHINE) {
|
||||
|
|
@ -57,7 +60,7 @@ EXPORTS['viewport-height'] =
|
|||
|
||||
|
||||
EXPORTS['in-javascript-context?'] =
|
||||
RUNTIME.makePrimitiveProcedure(
|
||||
makePrimitiveProcedure(
|
||||
'in-javascript-context?',
|
||||
0,
|
||||
function(MACHINE) {
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
(require racket/contract
|
||||
racket/runtime-path
|
||||
racket/gui/base
|
||||
syntax/modresolve)
|
||||
|
||||
|
||||
|
|
@ -15,7 +16,7 @@
|
|||
[lookup-module-requires (path? . -> . (listof path?))])
|
||||
|
||||
(define-runtime-path record.rkt "record.rkt")
|
||||
(define ns (make-base-empty-namespace))
|
||||
(define ns (make-gui-namespace))
|
||||
|
||||
;; query: module-path -> string?
|
||||
;; Given a module, see if it's implemented via Javascript.
|
||||
|
|
|
|||
|
|
@ -4,13 +4,14 @@
|
|||
racket/runtime-path
|
||||
syntax/modresolve
|
||||
racket/path
|
||||
"structs.rkt")
|
||||
"structs.rkt"
|
||||
racket/gui/base)
|
||||
|
||||
|
||||
(provide/contract [query (module-path? . -> . (listof resource?))])
|
||||
|
||||
(define-runtime-path record.rkt "record.rkt")
|
||||
(define ns (make-base-namespace))
|
||||
(define ns (make-gui-namespace))
|
||||
|
||||
;; query: module-path -> (listof record)
|
||||
;; Given a module, collect all of its resource records
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ Google Chrome should be in @filepath{/contrib/bin/google-chrome}.
|
|||
|
||||
@section{Usage}
|
||||
The @filepath{whalesong} launcher in the subdirectory will compile
|
||||
programs to standalone @filepath{.xhtml} files.
|
||||
programs to @filepath{.html} and @filepath{.js} files.
|
||||
|
||||
|
||||
Example usage: using @litchar{whalesong build} to compile a whalesong program.
|
||||
|
|
@ -81,7 +81,7 @@ fermi ~/whalesong/examples $ cat hello.rkt
|
|||
|
||||
fermi ~/whalesong/examples $ ../whalesong build hello.rkt
|
||||
|
||||
fermi ~/whalesong/examples $ google-chrome hello.xhtml
|
||||
fermi ~/whalesong/examples $ google-chrome hello.html
|
||||
Created new window in existing browser session.
|
||||
|
||||
fermi ~/whalesong/examples $
|
||||
|
|
@ -124,12 +124,16 @@ $
|
|||
However, it can also be packaged with @filepath{whalesong}.
|
||||
@verbatim|{
|
||||
$ whalesong build hello.rkt
|
||||
Writing program #<path:/home/dyoo/work/whalesong/examples/hello.js>
|
||||
Writing html #<path:/home/dyoo/work/whalesong/examples/hello.html>
|
||||
|
||||
$ ls -l hello.xhtml
|
||||
-rw-rw-r-- 1 dyoo nogroup 692213 Jun 7 18:00 hello.xhtml
|
||||
$ ls -l hello.html
|
||||
-rw-r--r-- 1 dyoo dyoo 3817 2011-09-10 15:02 hello.html
|
||||
$ ls -l hello.js
|
||||
-rw-r--r-- 1 dyoo dyoo 2129028 2011-09-10 15:02 hello.js
|
||||
}|
|
||||
Running @tt{whalesong build} on a Racket program will produce a self-contained
|
||||
@filepath{.xhtml} file. If we open this file in our favorite web browser,
|
||||
Running @tt{whalesong build} on a Racket program will produce
|
||||
@filepath{.html} and @filepath{.js} files. If we open this file in our favorite web browser,
|
||||
we should see a triumphant message show on screen.
|
||||
|
||||
|
||||
|
|
@ -202,10 +206,59 @@ by @racket[on-tick], though because we're on the web, we can
|
|||
bind to many other kinds of web events (by using @racket[view-bind]).}
|
||||
]
|
||||
|
||||
The rest of this document describes the API.
|
||||
|
||||
|
||||
|
||||
@subsection{More web-world examples}
|
||||
Here are a collection of web-world demos:
|
||||
@itemize[
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.html"]{attr-animation.html} [@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.rkt"]{src}] Uses @racket[update-view-attr] and @racket[on-tick] to perform a simple color animation.}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.html"]{dwarves.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.rkt"]{src}]
|
||||
Uses @racket[view-show] and @racket[view-hide] to manipulate a view. Click on a dwarf to make them hide.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.html"]{dwarves-with-remove.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.rkt"]{src}]
|
||||
Uses @racket[view-focus?] and @racket[view-remove] to see if a dwarf should be removed from the view.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/field/field.html"]{field.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/field/field.rkt"]{src}]
|
||||
Uses @racket[view-bind] to read a text field, and @racket[update-view-text] to change
|
||||
the text content of an element.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/phases/phases.html"]{phases.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/phases/phases.rkt"]{src}]
|
||||
Switches out one view entirely in place of another. Different views can correspond to phases in a program.
|
||||
}
|
||||
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.html"]{tick-tock.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.rkt"]{src}]
|
||||
Uses @racket[on-tick] to show a timer counting up.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/redirected/redirected.html"]{redirected.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/redirected/redirected.rkt"]{src}]
|
||||
Uses @racket[on-tick] to show a timer counting up, and also uses @racket[open-output-element] to
|
||||
pipe side-effecting @racket[printf]s to a hidden @tt{div}.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/todo/todo.html"]{todo.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/todo/todo.rkt"]{src}]
|
||||
A simple TODO list manager.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.html"]{where-am-i.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.rkt"]{src}]
|
||||
Uses @racket[on-location-change] and @racket[on-mock-location-change] to demonstrate location services.
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
scribble/eval
|
||||
racket/sandbox
|
||||
racket/port
|
||||
racket/list
|
||||
(only-in racket/contract any/c)
|
||||
racket/runtime-path
|
||||
"scribble-helpers.rkt"
|
||||
|
|
@ -99,7 +100,8 @@ The GitHub source repository to Whalesong can be found at
|
|||
|
||||
|
||||
Prerequisites: at least @link["http://racket-lang.org/"]{Racket
|
||||
5.1.1}, and a @link["http://www.java.com"]{Java 1.6} SDK.
|
||||
5.1.1}. If you wish to use the JavaScript compression option,
|
||||
you will need @link["http://www.java.com"]{Java 1.6} SDK.
|
||||
@; (This might be superfluous information, so commented out
|
||||
@; for the moment...)
|
||||
@;The majority of the project is written
|
||||
|
|
@ -194,7 +196,7 @@ recompile Whalesong on every single use, which can be very expensive.
|
|||
|
||||
|
||||
|
||||
@subsection{Making Standalone @tt{.xhtml} files with Whalesong}
|
||||
@subsection{Making @tt{.html} files with Whalesong}
|
||||
|
||||
Let's try making a simple, standalone executable. At the moment, the
|
||||
program must be written in the base language of @racket[(planet
|
||||
|
|
@ -219,21 +221,28 @@ $
|
|||
}|
|
||||
However, it can also be packaged with @filepath{whalesong}.
|
||||
@verbatim|{
|
||||
$ whalesong build hello.rkt
|
||||
$ whalesong build hello.rkt
|
||||
Writing program #<path:/home/dyoo/work/whalesong/examples/hello.js>
|
||||
Writing html #<path:/home/dyoo/work/whalesong/examples/hello.html>
|
||||
|
||||
$ ls -l hello.html
|
||||
-rw-r--r-- 1 dyoo dyoo 3817 2011-09-10 15:02 hello.html
|
||||
$ ls -l hello.js
|
||||
-rw-r--r-- 1 dyoo dyoo 2129028 2011-09-10 15:02 hello.js
|
||||
|
||||
$ ls -l hello.xhtml
|
||||
-rw-rw-r-- 1 dyoo nogroup 692213 Jun 7 18:00 hello.xhtml
|
||||
}|
|
||||
Running @tt{whalesong build} on a Racket program will produce a self-contained
|
||||
@filepath{.xhtml} file. If you open this file in your favorite web browser,
|
||||
you should see a triumphant message show on screen.
|
||||
|
||||
@margin-note{Visit @link["http://hashcollision.org/whalesong/examples/hello/hello.html"]{hello.html} to execute this program.}
|
||||
Running @tt{whalesong build} on a Racket program will produce a
|
||||
@filepath{.html} and @filepath{.js} file. If you open the
|
||||
@filepath{.html} in your favorite web browser, you should see a
|
||||
triumphant message show on screen.
|
||||
|
||||
|
||||
We can do something slightly more interesting. Let's write a Whalesong program
|
||||
that accesses the JavaScript DOM. Call this file @filepath{dom-play.rkt}.
|
||||
@margin-note{
|
||||
The generated program can be downloaded here: @link["http://hashcollision.org/whalesong/examples/dom-play.xhtml"]{dom-play.xhtml}
|
||||
}
|
||||
Visit @link["http://hashcollision.org/whalesong/examples/dom-play/dom-play.html"]{dom-play.html} to execute this program.}
|
||||
|
||||
@filebox["dom-play.rkt"]{
|
||||
@codeblock|{
|
||||
|
|
@ -272,7 +281,7 @@ The generated program can be downloaded here: @link["http://hashcollision.org/wh
|
|||
}|}
|
||||
This program uses the @link["http:/jquery.com"]{JQuery} API provided by @racketmodname[(planet dyoo/whalesong/js)],
|
||||
as well as the native JavaScript FFI to produce output on the browser.
|
||||
If w run Whalesong on this program, and view the resulting @filepath{dom-play.xhtml} in your
|
||||
If w run Whalesong on this program, and view the resulting @filepath{dom-play.html} in your
|
||||
web browser, we should see a pale, green page with some output.
|
||||
|
||||
|
||||
|
|
@ -289,12 +298,12 @@ function and define it in a module called @filepath{fact.rkt}:
|
|||
|
||||
@margin-note{
|
||||
The files can also be downloaded here:
|
||||
@itemlist[@item{@link["http://hashcollision.org/whalesong/fact-example/fact.rkt"]{fact.rkt}}
|
||||
@item{@link["http://hashcollision.org/whalesong/fact-example/index.html"]{index.html}}]
|
||||
@itemlist[@item{@link["http://hashcollision.org/whalesong/examples/fact/fact.rkt"]{fact.rkt}}
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/fact/index.html"]{index.html}}]
|
||||
with generated JavaScript binaries here:
|
||||
@itemlist[
|
||||
@item{@link["http://hashcollision.org/whalesong/fact-example/fact.js"]{fact.js}}
|
||||
@item{@link["http://hashcollision.org/whalesong/fact-example/runtime.js"]{runtime.js}}
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/fact/fact.js"]{fact.js}}
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/fact/runtime.js"]{runtime.js}}
|
||||
]
|
||||
}
|
||||
|
||||
|
|
@ -311,7 +320,7 @@ with generated JavaScript binaries here:
|
|||
(* x (fact (sub1 x)))]))
|
||||
}|}
|
||||
|
||||
Instead of creating a standalone @tt{.xhtml}, we can use @tt{whalesong} to
|
||||
Instead of creating a standalone @tt{.html}, we can use @tt{whalesong} to
|
||||
get us the module's code. From the command-line:
|
||||
@verbatim|{
|
||||
$ whalesong get-javascript fact.rkt > fact.js
|
||||
|
|
@ -373,6 +382,7 @@ The factorial of 10000 is <span id="answer">being computed</span>.
|
|||
}|
|
||||
}
|
||||
|
||||
@margin-note{See: @link["http://hashcollision.org/whalesong/examples/fact/bad-index.html"]{bad-index.html}.}
|
||||
Replacing the @racket[10000] with @racket["one-billion-dollars"] should
|
||||
reliably produce a proper error message.
|
||||
|
||||
|
|
@ -385,28 +395,29 @@ Whalesong provides a command-line utility called @tt{whalesong} for
|
|||
translating Racket to JavaScript. It can be run in several modes:
|
||||
|
||||
@itemize[
|
||||
@item{To create standalone XHTML documents}
|
||||
@item{To create HTML + js documents}
|
||||
@item{To output the compiled JavaScript as a single @filepath{.js} file}
|
||||
@item{To output the compiled JavaScript as several @filepath{.js} files, one per module. (this isn't done yet...)}
|
||||
]
|
||||
|
||||
Using @tt{whalesong} to generate standalone XHTML documents is
|
||||
Using @tt{whalesong} to generate HTML+js documents is
|
||||
relatively straightforward with the @tt{build} command. To use it,
|
||||
pass the name of the file to it:
|
||||
@verbatim|{
|
||||
$ whalesong build [name-of-racket-file]
|
||||
}|
|
||||
An @filepath{.xhtml} will be written to the current directory.
|
||||
A @filepath{.html} and @filepath{.js} will be written to the current directory, as will any external resources that the program uses.
|
||||
|
||||
Almost all of the @tt{whalesong} commands support two command line options:
|
||||
|
||||
@itemize{
|
||||
|
||||
@item{@verbatim{--compress-javascript}: Use Google Closure's JavaScript
|
||||
@item{@verbatim{--compress-javascript} Use Google Closure's JavaScript
|
||||
compiler to significantly compress the JavaScript. Using this
|
||||
currently requires a Java 1.6 JDK.}
|
||||
|
||||
@item{@verbatim{--verbose}: write verbose debugging information to standard error.}
|
||||
@item{@verbatim{--verbose} Write verbose debugging information to standard error.}
|
||||
|
||||
@item{@verbatim{--dest-dir} Write files to a separate directory, rather than the current directory.}
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -421,11 +432,10 @@ program.
|
|||
|
||||
@subsection{@tt{build}}
|
||||
|
||||
Given the name of a program, this builds a standalone
|
||||
@filepath{.xhtml} file into the current working directory that
|
||||
executes the program in a web browser.
|
||||
Given the name of a program, this builds
|
||||
@filepath{.html} and @filepath{.js} files into the current working directory.
|
||||
|
||||
The @filepath{.xhtml} should be self-contained, with an exception: if
|
||||
The @filepath{.html} and @filepath{.js} should be self-contained, with an exception: if
|
||||
the file uses any external @tech{resource}s by using
|
||||
@racket[define-resource], those resources are written into the current
|
||||
working directory, if they do not already exist there.
|
||||
|
|
@ -545,7 +555,7 @@ the page itself is a source of state, it too will be passed to
|
|||
callbacks. This library presents a functional version of the DOM in
|
||||
the form of a @tech{view}.
|
||||
|
||||
|
||||
@margin-note{Visit @link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.html"]{tick-tock.html} to execute this program.}
|
||||
Let's demonstrate this by creating a basic ticker that counts on the
|
||||
screen every second.
|
||||
|
||||
|
|
@ -611,6 +621,56 @@ by @racket[on-tick], though because we're on the web, we can
|
|||
bind to many other kinds of web events (by using @racket[view-bind]).}
|
||||
]
|
||||
|
||||
@subsection{More web-world examples}
|
||||
Here are a collection of web-world demos:
|
||||
@itemize[
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.html"]{attr-animation.html} [@link["http://hashcollision.org/whalesong/examples/attr-animation/attr-animation.rkt"]{src}] Uses @racket[update-view-attr] and @racket[on-tick] to perform a simple color animation.}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.html"]{dwarves.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/dwarves/dwarves.rkt"]{src}]
|
||||
Uses @racket[view-show] and @racket[view-hide] to manipulate a view. Click on a dwarf to make them hide.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.html"]{dwarves-with-remove.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/dwarves-with-remove/dwarves-with-remove.rkt"]{src}]
|
||||
Uses @racket[view-focus?] and @racket[view-remove] to see if a dwarf should be removed from the view.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/field/field.html"]{field.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/field/field.rkt"]{src}]
|
||||
Uses @racket[view-bind] to read a text field, and @racket[update-view-text] to change
|
||||
the text content of an element.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/phases/phases.html"]{phases.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/phases/phases.rkt"]{src}]
|
||||
Switches out one view entirely in place of another. Different views can correspond to phases in a program.
|
||||
}
|
||||
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.html"]{tick-tock.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/tick-tock/tick-tock.rkt"]{src}]
|
||||
Uses @racket[on-tick] to show a timer counting up.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/redirected/redirected.html"]{redirected.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/redirected/redirected.rkt"]{src}]
|
||||
Uses @racket[on-tick] to show a timer counting up, and also uses @racket[open-output-element] to
|
||||
pipe side-effecting @racket[printf]s to a hidden @tt{div}.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/todo/todo.html"]{todo.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/todo/todo.rkt"]{src}]
|
||||
A simple TODO list manager.
|
||||
}
|
||||
|
||||
@item{@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.html"]{where-am-i.html}
|
||||
[@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.rkt"]{src}]
|
||||
Uses @racket[on-location-change] and @racket[on-mock-location-change] to demonstrate location services.
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
|
||||
@subsection{@racket[big-bang] and its options}
|
||||
@declare-exporting/this-package[web-world]
|
||||
|
|
@ -824,6 +884,11 @@ Update the form value of the node at the focus.}
|
|||
@defproc[(view-append-child [d dom]) view]{
|
||||
Add the dom node @racket[d] as the last child of the focused node.}
|
||||
|
||||
@defproc[(view-remove [v view]) view]{
|
||||
Remove the dom node at the focus from the view @racket[v]. Focus tries to move
|
||||
to the right, if there's a next sibling. If that fails, focus then
|
||||
moves to the left, if there's a previous sibling. If that fails too,
|
||||
then focus moves to the parent.}
|
||||
|
||||
|
||||
@subsection{Events}
|
||||
|
|
@ -1569,14 +1634,26 @@ Whalesong uses code and utilities from the following external projects:
|
|||
]
|
||||
|
||||
The following folks have helped tremendously in the implementation of
|
||||
Whalesong by implementing libraries, giving guidence, and suggesting
|
||||
improvements:
|
||||
Whalesong by implementing libraries, giving guidence, reporting bugs,
|
||||
and suggesting improvements.
|
||||
|
||||
@itemlist[
|
||||
@;;;;
|
||||
@; in no particular order... really! I'm shuffling them! :)
|
||||
@;;;;
|
||||
@(apply itemlist
|
||||
(shuffle (list
|
||||
@item{Ethan Cecchetti}
|
||||
@item{Scott Newman}
|
||||
@item{Zhe Zhang}
|
||||
@item{Jens Axel Søgaard}
|
||||
@item{Jay McCarthy}
|
||||
@item{Sam Tobin-Hochstadt}
|
||||
@item{Doug Orleans}
|
||||
@item{Richard Cleis}
|
||||
@item{Asumu Takikawa}
|
||||
@item{Eric Hanchrow}
|
||||
@item{Greg Hendershott}
|
||||
@item{Shriram Krishnamurthi}
|
||||
@item{Emmanuel Schanzer}
|
||||
]
|
||||
@item{Robby Findler}))
|
||||
)
|
||||
|
|
@ -308,15 +308,15 @@
|
|||
[else
|
||||
'ok]))]
|
||||
|
||||
[(CheckClosureArity!? op)
|
||||
[(CheckClosureAndArity!? op)
|
||||
(let: ([clos : SlotValue (machine-proc m)])
|
||||
(cond
|
||||
[(closure? clos)
|
||||
(if (arity-match? (closure-arity clos)
|
||||
(ensure-natural (evaluate-oparg m (CheckClosureArity!-num-args op))))
|
||||
(ensure-natural (evaluate-oparg m (CheckClosureAndArity!-num-args op))))
|
||||
'ok
|
||||
(error 'check-closure-arity "arity mismatch: passed ~s args to ~s"
|
||||
(ensure-natural (evaluate-oparg m (CheckClosureArity!-num-args op)))
|
||||
(ensure-natural (evaluate-oparg m (CheckClosureAndArity!-num-args op)))
|
||||
(closure-display-name clos)))]
|
||||
[else
|
||||
(error 'check-closure-arity "not a closure: ~s" clos)]))]
|
||||
|
|
@ -654,23 +654,7 @@
|
|||
(MakeCompiledProcedureShell-arity op)
|
||||
'()
|
||||
(MakeCompiledProcedureShell-display-name op)))]
|
||||
|
||||
[(ApplyPrimitiveProcedure? op)
|
||||
(let: ([prim : SlotValue (machine-proc m)]
|
||||
[args : (Listof PrimitiveValue)
|
||||
(map ensure-primitive-value (take (machine-env m)
|
||||
(ensure-natural (machine-argcount m))))])
|
||||
(cond
|
||||
[(primitive-proc? prim)
|
||||
(target-updater! m (ensure-primitive-value
|
||||
(parameterize ([current-output-port
|
||||
(current-simulated-output-port)])
|
||||
(apply (primitive-proc-f prim)
|
||||
m
|
||||
args))))]
|
||||
[else
|
||||
(error 'apply-primitive-procedure)]))]
|
||||
|
||||
|
||||
[(CaptureEnvironment? op)
|
||||
(target-updater! m (make-CapturedEnvironment (drop (machine-env m)
|
||||
(CaptureEnvironment-skip op))))]
|
||||
|
|
|
|||
1
tests/more-tests/weird-cc.expected
Normal file
1
tests/more-tests/weird-cc.expected
Normal file
|
|
@ -0,0 +1 @@
|
|||
11213
|
||||
5
tests/more-tests/weird-cc.rkt
Normal file
5
tests/more-tests/weird-cc.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang planet dyoo/whalesong
|
||||
(define program (lambda () (let ((y (call/cc (lambda (c) c)))) (display 1) (call/cc (lambda (c) (y c))) (display 2) (call/cc (lambda (c) (y c))) (display 3))))
|
||||
|
||||
(program)
|
||||
(newline)
|
||||
|
|
@ -27,3 +27,4 @@
|
|||
(test "more-tests/conform.rkt")
|
||||
(test "more-tests/earley.rkt")
|
||||
(test "more-tests/view.rkt")
|
||||
(test "more-tests/weird-cc.rkt")
|
||||
|
|
|
|||
|
|
@ -2,9 +2,9 @@
|
|||
|
||||
(require "test-parse.rkt"
|
||||
"test-parse-bytecode.rkt"
|
||||
"test-simulator.rkt"
|
||||
"test-compiler.rkt"
|
||||
"test-compiler-2.rkt"
|
||||
;; "test-simulator.rkt"
|
||||
;; "test-compiler.rkt"
|
||||
;; "test-compiler-2.rkt"
|
||||
"test-assemble.rkt"
|
||||
"test-browser-evaluate.rkt"
|
||||
"test-package.rkt"
|
||||
|
|
|
|||
|
|
@ -46,8 +46,8 @@
|
|||
"(function() { "
|
||||
|
||||
runtime
|
||||
"var RUNTIME = plt.runtime;"
|
||||
"var MACHINE = new plt.runtime.Machine();\n"
|
||||
"var RT = plt.runtime;"
|
||||
"var M = new plt.runtime.Machine();\n"
|
||||
|
||||
"return function(success, fail, params){"
|
||||
snippet
|
||||
|
|
@ -55,7 +55,7 @@
|
|||
"});")])
|
||||
(displayln snippet)
|
||||
(display code op))))))
|
||||
(define (E-single a-statement (inspector "MACHINE.val"))
|
||||
(define (E-single a-statement (inspector "M.val"))
|
||||
(evaluated-value ((force -E) (cons a-statement inspector))))
|
||||
|
||||
;; evaluating many expressions[.
|
||||
|
|
@ -65,25 +65,25 @@
|
|||
[inspector (cdr a-statement+inspector)])
|
||||
|
||||
(display runtime op)
|
||||
"var RUNTIME = plt.runtime;"
|
||||
(display "var MACHINE = new plt.runtime.Machine();\n" op)
|
||||
"var RT = plt.runtime;"
|
||||
(display "var M = new plt.runtime.Machine();\n" op)
|
||||
(display "(function() { " op)
|
||||
(display "var myInvoke = " op)
|
||||
(assemble/write-invoke a-statement op)
|
||||
(display ";" op)
|
||||
(fprintf op
|
||||
"return function(succ, fail, params) {
|
||||
var newParams = { currentDisplayer: function(MACHINE, v) {
|
||||
var newParams = { currentDisplayer: function(M, v) {
|
||||
params.currentDisplayer(v); } };
|
||||
|
||||
myInvoke(MACHINE,
|
||||
myInvoke(M,
|
||||
function(v) { succ(plt.runtime.toDisplayedString(~a));},
|
||||
function(MACHINE, exn) { fail(exn); },
|
||||
function(M, exn) { fail(exn); },
|
||||
newParams);
|
||||
}"
|
||||
inspector)
|
||||
(display "})" op))))))
|
||||
(define (E-many stmts (inspector "MACHINE.val"))
|
||||
(define (E-many stmts (inspector "M.val"))
|
||||
(evaluated-value ((force -E-many) (cons stmts inspector))))
|
||||
|
||||
|
||||
|
|
@ -108,27 +108,27 @@
|
|||
;; Assigning to proc means val should still be uninitialized.
|
||||
(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny")))
|
||||
"#<undefined>")
|
||||
;; But we should see the assignment if we inspect MACHINE.proc.
|
||||
;; But we should see the assignment if we inspect M.proc.
|
||||
(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny"))
|
||||
"MACHINE.proc")
|
||||
"M.proc")
|
||||
"Danny")
|
||||
|
||||
|
||||
(test (E-single (make-PushEnvironment 1 #f)
|
||||
"MACHINE.env.length")
|
||||
"M.env.length")
|
||||
"1")
|
||||
(test (E-single (make-PushEnvironment 20 #f)
|
||||
"MACHINE.env.length")
|
||||
"M.env.length")
|
||||
"20")
|
||||
|
||||
;; PopEnvironment
|
||||
(test (E-many (list (make-PushEnvironment 2 #f))
|
||||
"MACHINE.env.length")
|
||||
"M.env.length")
|
||||
"2")
|
||||
(test (E-many (list (make-PushEnvironment 2 #f)
|
||||
(make-PopEnvironment (make-Const 1)
|
||||
(make-Const 0)))
|
||||
"MACHINE.env.length")
|
||||
"M.env.length")
|
||||
"1")
|
||||
|
||||
|
||||
|
|
@ -137,39 +137,39 @@
|
|||
(test (E-many (list (make-PushEnvironment 2 #f)
|
||||
(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f)
|
||||
(make-Const 12345)))
|
||||
"MACHINE.env[1]")
|
||||
"M.env[1]")
|
||||
"12345")
|
||||
(test (E-many (list (make-PushEnvironment 2 #f)
|
||||
(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f)
|
||||
(make-Const 12345)))
|
||||
"MACHINE.env[0]")
|
||||
"M.env[0]")
|
||||
"#<undefined>")
|
||||
(test (E-many (list (make-PushEnvironment 2 #f)
|
||||
(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f)
|
||||
(make-Const 12345)))
|
||||
"MACHINE.env[0]")
|
||||
"M.env[0]")
|
||||
"12345")
|
||||
|
||||
|
||||
;; Toplevel Environment loading
|
||||
(test (E-single (make-PerformStatement (make-ExtendEnvironment/Prefix! '(pi)))
|
||||
"plt.runtime.toWrittenString(MACHINE.env[0]).slice(0, 5)")
|
||||
"plt.runtime.toWrittenString(M.env[0]).slice(0, 5)")
|
||||
"3.141")
|
||||
|
||||
|
||||
|
||||
;; Simple application
|
||||
(test (E-many (list (make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
|
||||
(make-PushEnvironment 2 #f)
|
||||
(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f)
|
||||
(make-Const 3))
|
||||
(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f)
|
||||
(make-Const 4))
|
||||
(make-AssignImmediateStatement 'argcount (make-Const 2))
|
||||
(make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
|
||||
'done))
|
||||
"7")
|
||||
;; (test (E-many (list (make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
;; (make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
|
||||
;; (make-PushEnvironment 2 #f)
|
||||
;; (make-AssignImmediateStatement (make-EnvLexicalReference 0 #f)
|
||||
;; (make-Const 3))
|
||||
;; (make-AssignImmediateStatement (make-EnvLexicalReference 1 #f)
|
||||
;; (make-Const 4))
|
||||
;; (make-AssignImmediateStatement 'argcount (make-Const 2))
|
||||
;; (make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
|
||||
;; 'done))
|
||||
;; "7")
|
||||
|
||||
|
||||
|
||||
|
|
@ -180,7 +180,7 @@
|
|||
(make-GotoStatement (make-Label 'afterLambda))
|
||||
'afterLambda
|
||||
(make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0 '() 'closureStart)))
|
||||
"MACHINE.val.displayName")
|
||||
"M.val.displayName")
|
||||
"closureStart")
|
||||
|
||||
|
||||
|
|
@ -197,7 +197,7 @@
|
|||
(make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0
|
||||
(list 0 1)
|
||||
'closureStart)))
|
||||
"MACHINE.val.closedVals[1] + ',' + MACHINE.val.closedVals[0]")
|
||||
"M.val.closedVals[1] + ',' + M.val.closedVals[0]")
|
||||
"hello,world")
|
||||
|
||||
;; Let's try to install the closure values.
|
||||
|
|
@ -220,7 +220,7 @@
|
|||
(make-Const 0))
|
||||
(make-GotoStatement (make-Label 'closureStart))
|
||||
'theEnd)
|
||||
"plt.runtime.toWrittenString(MACHINE.env.length) + ',' + MACHINE.env[1] + ',' + MACHINE.env[0]")
|
||||
"plt.runtime.toWrittenString(M.env.length) + ',' + M.env[1] + ',' + M.env[0]")
|
||||
"2,hello,world")
|
||||
|
||||
|
||||
|
|
@ -244,7 +244,7 @@
|
|||
(make-PopEnvironment (make-Const 2) (make-Const 0))
|
||||
(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
|
||||
'theEnd)
|
||||
"typeof(MACHINE.val) + ',' + (MACHINE.val === MACHINE.proc.label)")
|
||||
"typeof(M.val) + ',' + (M.val === M.proc.label)")
|
||||
"function,true")
|
||||
|
||||
|
||||
|
|
@ -265,7 +265,7 @@
|
|||
(list 0 1)
|
||||
'closureStart))
|
||||
(make-PopEnvironment (make-Const 2) (make-Const 0))
|
||||
(make-PerformStatement (make-CheckClosureArity! (make-Const 5)))
|
||||
(make-PerformStatement (make-CheckClosureAndArity! (make-Const 5)))
|
||||
'theEnd)))
|
||||
|
||||
;; this should fail, since the check is for 1, but the closure expects 5.
|
||||
|
|
@ -288,7 +288,7 @@
|
|||
(list 0 1)
|
||||
'closureStart))
|
||||
(make-PopEnvironment (make-Const 2) (make-Const 0))
|
||||
(make-PerformStatement (make-CheckClosureArity! (make-Const 1)))
|
||||
(make-PerformStatement (make-CheckClosureAndArity! (make-Const 1)))
|
||||
'theEnd)))
|
||||
(error 'expected-failure))
|
||||
|
||||
|
|
@ -315,48 +315,48 @@
|
|||
end))
|
||||
"ok")
|
||||
|
||||
;; Test for primitive procedure
|
||||
(test (E-many `(,(make-AssignImmediateStatement 'val (make-Const '+))
|
||||
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'ok))
|
||||
,(make-GotoStatement (make-Label 'end))
|
||||
onTrue
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
|
||||
end))
|
||||
"ok")
|
||||
;; ;; Test for primitive procedure
|
||||
;; (test (E-many `(,(make-AssignImmediateStatement 'val (make-Const '+))
|
||||
;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'ok))
|
||||
;; ,(make-GotoStatement (make-Label 'end))
|
||||
;; onTrue
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
|
||||
;; end))
|
||||
;; "ok")
|
||||
|
||||
;; Give a primitive procedure in val
|
||||
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
,(make-AssignImmediateStatement 'val (make-EnvPrefixReference 0 0))
|
||||
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
|
||||
,(make-GotoStatement (make-Label 'end))
|
||||
onTrue
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'ok))
|
||||
end))
|
||||
"ok")
|
||||
;; ;; Give a primitive procedure in val
|
||||
;; (test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
;; ,(make-AssignImmediateStatement 'val (make-EnvPrefixReference 0 0))
|
||||
;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
|
||||
;; ,(make-GotoStatement (make-Label 'end))
|
||||
;; onTrue
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'ok))
|
||||
;; end))
|
||||
;; "ok")
|
||||
|
||||
;; Give a primitive procedure in proc, but test val
|
||||
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
|
||||
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
|
||||
,(make-GotoStatement (make-Label 'end))
|
||||
onTrue
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'a-procedure))
|
||||
end))
|
||||
"not-a-procedure")
|
||||
;; ;; Give a primitive procedure in proc, but test val
|
||||
;; (test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
;; ,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
|
||||
;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
|
||||
;; ,(make-GotoStatement (make-Label 'end))
|
||||
;; onTrue
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'a-procedure))
|
||||
;; end))
|
||||
;; "not-a-procedure")
|
||||
|
||||
;; Give a primitive procedure in proc and test proc
|
||||
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
|
||||
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue)
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
|
||||
,(make-GotoStatement (make-Label 'end))
|
||||
onTrue
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'a-procedure))
|
||||
end))
|
||||
"a-procedure")
|
||||
;; ;; Give a primitive procedure in proc and test proc
|
||||
;; (test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
|
||||
;; ,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
|
||||
;; ,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue)
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
|
||||
;; ,(make-GotoStatement (make-Label 'end))
|
||||
;; onTrue
|
||||
;; ,(make-AssignImmediateStatement 'val (make-Const 'a-procedure))
|
||||
;; end))
|
||||
;; "a-procedure")
|
||||
|
||||
|
||||
|
||||
|
|
@ -364,7 +364,7 @@
|
|||
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(advisor)))
|
||||
,(make-AssignImmediateStatement 'val (make-Const "Kathi"))
|
||||
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val)))
|
||||
"MACHINE.env[0][0]")
|
||||
"M.env[0][0]")
|
||||
"Kathi")
|
||||
|
||||
|
||||
|
|
@ -381,7 +381,7 @@
|
|||
,(make-AssignImmediateStatement 'val (make-Const "Shriram"))
|
||||
,(make-AssignImmediateStatement (make-EnvPrefixReference 0 0) (make-Reg 'val))
|
||||
,(make-PerformStatement (make-CheckToplevelBound! 0 0)))
|
||||
"MACHINE.env[0][0]")
|
||||
"M.env[0][0]")
|
||||
"Shriram")
|
||||
|
||||
|
||||
|
|
@ -391,7 +391,7 @@
|
|||
(make-Const '(1 2 3)))
|
||||
,(make-AssignImmediateStatement 'argcount (make-Const 1))
|
||||
,(make-PerformStatement (make-SpliceListIntoStack! (make-Const 0))))
|
||||
"MACHINE.argcount + ',' + MACHINE.env[0] + ',' + MACHINE.env[1] + ',' + MACHINE.env[2]")
|
||||
"M.argcount + ',' + M.env[0] + ',' + M.env[1] + ',' + M.env[2]")
|
||||
"3,3,2,1")
|
||||
|
||||
|
||||
|
|
@ -404,7 +404,7 @@
|
|||
(make-Const '(1 2 3)))
|
||||
,(make-AssignImmediateStatement 'argcount (make-Const 3))
|
||||
,(make-PerformStatement (make-SpliceListIntoStack! (make-Const 2))))
|
||||
"MACHINE.argcount + ',' + MACHINE.env[0] + ',' + MACHINE.env[1] + ',' + MACHINE.env[2] + ',' + MACHINE.env[3] + ',' + MACHINE.env[4]")
|
||||
"M.argcount + ',' + M.env[0] + ',' + M.env[1] + ',' + M.env[2] + ',' + M.env[3] + ',' + M.env[4]")
|
||||
"5,3,2,1,world,hello")
|
||||
|
||||
|
||||
|
|
@ -420,7 +420,7 @@
|
|||
,(make-AssignImmediateStatement 'argcount (make-Const 1))
|
||||
,(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 0)
|
||||
(make-Const 1))))
|
||||
"MACHINE.argcount + ',' + plt.runtime.isList(MACHINE.env[0])")
|
||||
"M.argcount + ',' + plt.runtime.isList(M.env[0])")
|
||||
"1,true")
|
||||
|
||||
|
||||
|
|
@ -438,7 +438,7 @@
|
|||
(make-Const 'z))
|
||||
,(make-AssignImmediateStatement 'argcount (make-Const 5))
|
||||
,(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 2) (make-Const 3))))
|
||||
"MACHINE.argcount + ',' + MACHINE.env.length + ',' + plt.runtime.isList(MACHINE.env[0]) + ',' + MACHINE.env[2] + ',' + MACHINE.env[1]")
|
||||
"M.argcount + ',' + M.env.length + ',' + plt.runtime.isList(M.env[0]) + ',' + M.env[2] + ',' + M.env[1]")
|
||||
"3,3,true,hello,world")
|
||||
|
||||
|
||||
|
|
@ -457,7 +457,7 @@
|
|||
bad
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'bad))
|
||||
end)
|
||||
"MACHINE.val")
|
||||
"M.val")
|
||||
"ok")
|
||||
|
||||
|
||||
|
|
@ -474,7 +474,7 @@
|
|||
ok
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'ok))
|
||||
end)
|
||||
"MACHINE.val")
|
||||
"M.val")
|
||||
"ok")
|
||||
|
||||
(test (E-many `(procedure-entry
|
||||
|
|
@ -490,7 +490,7 @@
|
|||
ok
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'ok))
|
||||
end)
|
||||
"MACHINE.val")
|
||||
"M.val")
|
||||
"ok")
|
||||
|
||||
(test (E-many `(procedure-entry
|
||||
|
|
@ -506,7 +506,7 @@
|
|||
bad
|
||||
,(make-AssignImmediateStatement 'val (make-Const 'bad))
|
||||
end)
|
||||
"MACHINE.val")
|
||||
"M.val")
|
||||
"ok")
|
||||
|
||||
|
||||
|
|
@ -521,7 +521,7 @@
|
|||
'proc
|
||||
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry))
|
||||
,(make-AssignImmediateStatement 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 0)))
|
||||
"MACHINE.val")
|
||||
"M.val")
|
||||
"4")
|
||||
|
||||
(test (E-many `(,(make-PushImmediateOntoEnvironment (make-Const 3) #f)
|
||||
|
|
@ -532,7 +532,7 @@
|
|||
'proc
|
||||
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry))
|
||||
,(make-AssignImmediateStatement 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 1)))
|
||||
"MACHINE.val")
|
||||
"M.val")
|
||||
"3")
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -6,19 +6,20 @@
|
|||
|
||||
|
||||
;; draw: world view -> view
|
||||
(define (draw w v)
|
||||
(update-view-text (view-focus v "counter") w))
|
||||
(define (draw w dom)
|
||||
(update-view-text (view-focus dom "counter") w))
|
||||
|
||||
|
||||
|
||||
;; tick: world view -> world
|
||||
(define (tick w v)
|
||||
(printf "Tick ~s\n" w)
|
||||
(+ w 1))
|
||||
(add1 w))
|
||||
|
||||
(define (stop? world dom)
|
||||
(> world 10))
|
||||
|
||||
(big-bang 0
|
||||
(initial-view index.html)
|
||||
(to-draw draw)
|
||||
(on-tick tick 1)
|
||||
(stop-when (lambda (w v)
|
||||
(> w 10))))
|
||||
(stop-when stop?))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/*jslint browser: true, unparam: true, vars: true, white: true, plusplus: true, maxerr: 50, indent: 4 */
|
||||
/*jslint browser: true, unparam: true, vars: true, white: true, plusplus: true, maxerr: 50, indent: 4, forin: true */
|
||||
/*global plt,MACHINE,$,EXPORTS,TreeCursor*/
|
||||
(function() {
|
||||
|
||||
|
|
@ -618,8 +618,7 @@
|
|||
|
||||
|
||||
var isDomNode = function(x) {
|
||||
return (x.hasOwnProperty('nodeType') &&
|
||||
x.nodeType === 1);
|
||||
return (x.nodeType === 1);
|
||||
};
|
||||
|
||||
|
||||
|
|
@ -754,8 +753,11 @@
|
|||
var objectToEvent = function(obj) {
|
||||
var key, val;
|
||||
var result = makeList();
|
||||
// Note: for some reason, jslint is not satisfied that I check
|
||||
// that the object has a hasOwnProperty before I use it. I've intentionally
|
||||
// turned off jslint's forin check because it's breaking here:
|
||||
for (key in obj) {
|
||||
if (obj.hasOwnProperty(key)) {
|
||||
if (obj.hasOwnProperty && obj.hasOwnProperty(key)) {
|
||||
val = obj[key];
|
||||
if (typeof(val) === 'number') {
|
||||
result = makePair(makeList(makeSymbol(key),
|
||||
|
|
@ -886,7 +888,9 @@
|
|||
LocationEventSource.prototype.onStart = function(fireEvent) {
|
||||
if (this.id === undefined) {
|
||||
var success = function(position) {
|
||||
if (position.hasOwnProperty('coords') &&
|
||||
if (position.hasOwnProperty &&
|
||||
position.hasOwnProperty('coords') &&
|
||||
position.coords.hasOwnProperty &&
|
||||
position.coords.hasOwnProperty('latitude') &&
|
||||
position.coords.hasOwnProperty('longitude')) {
|
||||
fireEvent(undefined,
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user