passing count of arguments in val for procedure call
This commit is contained in:
dyoo
parent
5b5499d241
commit
c8189e4c1e
|
|
@ -402,8 +402,7 @@ EOF
|
|||
(CheckToplevelBound!-pos op))]
|
||||
|
||||
[(CheckClosureArity!? op)
|
||||
(format "if (! (MACHINE.proc instanceof RUNTIME.Closure && MACHINE.proc.arity === ~a)) { if (! (MACHINE.proc instanceof RUNTIME.Closure)) { throw new Error(\"not a closure\"); } else { throw new Error(\"arity failure\"); } }"
|
||||
(CheckClosureArity!-arity op))]
|
||||
(format "if (! (MACHINE.proc instanceof RUNTIME.Closure && MACHINE.proc.arity === MACHINE.val)) { if (! (MACHINE.proc instanceof RUNTIME.Closure)) { throw new Error(\"not a closure\"); } else { throw new Error(\"arity failure\"); } }")]
|
||||
|
||||
[(ExtendEnvironment/Prefix!? op)
|
||||
(let: ([names : (Listof (U Symbol False ModuleVariable)) (ExtendEnvironment/Prefix!-names op)])
|
||||
|
|
|
|||
48
compile.rkt
48
compile.rkt
|
|
@ -208,6 +208,7 @@
|
|||
|
||||
(: compile-constant (Constant CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-constant exp cenv target linkage)
|
||||
;; Compiles constant values.
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
|
|
@ -217,6 +218,7 @@
|
|||
|
||||
(: compile-local-reference (LocalRef CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-local-reference exp cenv target linkage)
|
||||
;; Compiles local references.
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
|
|
@ -227,6 +229,7 @@
|
|||
|
||||
|
||||
(: compile-toplevel-reference (ToplevelRef CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Compiles toplevel references.
|
||||
(define (compile-toplevel-reference exp cenv target linkage)
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
|
|
@ -241,6 +244,7 @@
|
|||
|
||||
|
||||
(: compile-toplevel-set (ToplevelSet CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Compiles toplevel definition.
|
||||
(define (compile-toplevel-set exp cenv target linkage)
|
||||
(let* ([var (ToplevelSet-name exp)]
|
||||
[lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp)
|
||||
|
|
@ -257,6 +261,7 @@
|
|||
|
||||
|
||||
(: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Compiles a conditional branch.
|
||||
(define (compile-branch exp cenv target linkage)
|
||||
(let: ([t-branch : LabelLinkage (make-LabelLinkage (make-label 'trueBranch))]
|
||||
[f-branch : LabelLinkage (make-LabelLinkage (make-label 'falseBranch))]
|
||||
|
|
@ -281,6 +286,7 @@
|
|||
|
||||
|
||||
(: compile-sequence ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Compiles a sequence of expressions. The last expression will be compiled in the provided linkage.
|
||||
(define (compile-sequence seq cenv target linkage)
|
||||
;; All but the last will use next-linkage linkage.
|
||||
(if (last-exp? seq)
|
||||
|
|
@ -290,7 +296,8 @@
|
|||
|
||||
|
||||
(: compile-splice ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Wrap a continuation prompt around each of the expressions.
|
||||
;; Compiles a sequence of expressions. A continuation prompt wraps around each of the expressions
|
||||
;; to delimit any continuation captures.
|
||||
(define (compile-splice seq cenv target linkage)
|
||||
(cond [(last-exp? seq)
|
||||
(let ([before-pop-prompt (make-label 'beforePromptPop)])
|
||||
|
|
@ -349,6 +356,7 @@
|
|||
|
||||
(: compile-lambda-body (Lam CompileTimeEnvironment -> InstructionSequence))
|
||||
;; Compiles the body of the lambda in the appropriate environment.
|
||||
;; Closures will target their value to the 'val register, and use return linkage.
|
||||
(define (compile-lambda-body exp cenv)
|
||||
(append-instruction-sequences
|
||||
|
||||
|
|
@ -363,7 +371,6 @@
|
|||
(append (map (lambda: ([d : Natural])
|
||||
(list-ref cenv d))
|
||||
(Lam-closure-map exp))
|
||||
;; fixme: We need to capture the cenv so we can maintain static knowledge
|
||||
(build-list (Lam-num-parameters exp) (lambda: ([i : Natural]) '?)))
|
||||
'val
|
||||
return-linkage)))
|
||||
|
|
@ -381,12 +388,15 @@
|
|||
(lam+cenv-cenv (first exps)))
|
||||
(compile-lambda-bodies (rest exps)))]))
|
||||
|
||||
|
||||
(: extend-compile-time-environment/scratch-space (CompileTimeEnvironment Natural -> CompileTimeEnvironment))
|
||||
(define (extend-compile-time-environment/scratch-space cenv n)
|
||||
(append (build-list n (lambda: ([i : Natural])
|
||||
'?))
|
||||
cenv))
|
||||
|
||||
|
||||
|
||||
(: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Compiles procedure application
|
||||
;; Special cases: if we know something about the operator, the compiler will special case.
|
||||
|
|
@ -794,8 +804,9 @@
|
|||
;; Compiled branch
|
||||
(LabelLinkage-label compiled-branch)
|
||||
(make-instruction-sequence
|
||||
`(,(make-PerformStatement (make-CheckClosureArity! n))))
|
||||
(compile-proc-appl extended-cenv (make-Reg 'val) n target compiled-linkage)
|
||||
`(,(make-AssignImmediateStatement 'val (make-Const n))
|
||||
,(make-PerformStatement (make-CheckClosureArity!))))
|
||||
(compile-procedure-application extended-cenv (make-Reg 'val) n target compiled-linkage)
|
||||
|
||||
|
||||
|
||||
|
|
@ -826,7 +837,7 @@
|
|||
linkage
|
||||
after-call)])
|
||||
(append-instruction-sequences
|
||||
(compile-proc-appl extended-cenv
|
||||
(compile-procedure-application extended-cenv
|
||||
(make-Label (StaticallyKnownLam-entry-point static-knowledge))
|
||||
n
|
||||
target
|
||||
|
|
@ -838,12 +849,12 @@
|
|||
|
||||
|
||||
|
||||
(: compile-proc-appl (CompileTimeEnvironment (U Label Reg) Natural Target Linkage -> InstructionSequence))
|
||||
(: compile-procedure-application (CompileTimeEnvironment (U Label Reg) Natural Target Linkage -> InstructionSequence))
|
||||
;; Three fundamental cases for general compiled-procedure application.
|
||||
;; 1. Tail calls.
|
||||
;; 2. Non-tail calls (next/label linkage) that write to val
|
||||
;; 3. Calls in argument position (next/label linkage) that write to the stack.
|
||||
(define (compile-proc-appl cenv-with-args entry-point n target linkage)
|
||||
(define (compile-procedure-application cenv-with-args entry-point n target linkage)
|
||||
(cond [(ReturnLinkage? linkage)
|
||||
(cond
|
||||
[(eq? target 'val)
|
||||
|
|
@ -1182,29 +1193,6 @@
|
|||
target]))
|
||||
|
||||
|
||||
(: adjust-oparg-depth (OpArg Integer -> OpArg))
|
||||
(define (adjust-oparg-depth arg n)
|
||||
(cond
|
||||
[(Const? arg)
|
||||
arg]
|
||||
|
||||
[(Reg? arg)
|
||||
arg]
|
||||
|
||||
[(Label? arg)
|
||||
arg]
|
||||
|
||||
[(EnvLexicalReference? arg)
|
||||
(make-EnvLexicalReference (ensure-natural (+ n (EnvLexicalReference-depth arg)))
|
||||
(EnvLexicalReference-unbox? arg))]
|
||||
[(EnvPrefixReference? arg)
|
||||
(make-EnvPrefixReference (ensure-natural (+ n (EnvPrefixReference-depth arg)))
|
||||
(EnvPrefixReference-pos arg))]
|
||||
[(EnvWholePrefixReference? arg)
|
||||
(make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth arg))))]))
|
||||
|
||||
|
||||
|
||||
|
||||
(: adjust-expression-depth (Expression Natural Natural -> Expression))
|
||||
;; Redirects references to the stack to route around a region of size n.
|
||||
|
|
|
|||
|
|
@ -231,8 +231,9 @@
|
|||
[pos : Natural])
|
||||
#:transparent)
|
||||
|
||||
;; Check the closure procedure value in 'proc and make sure it can accept n values.
|
||||
(define-struct: CheckClosureArity! ([arity : Natural])
|
||||
;; Check the closure procedure value in 'proc and make sure it can accept the
|
||||
;; # of arguments (stored as a number in the val register.).
|
||||
(define-struct: CheckClosureArity! ()
|
||||
#:transparent)
|
||||
|
||||
;; Extends the environment with a prefix that holds
|
||||
|
|
|
|||
|
|
@ -227,10 +227,10 @@
|
|||
(cond
|
||||
[(closure? clos)
|
||||
(if (= (closure-arity clos)
|
||||
(CheckClosureArity!-arity op))
|
||||
(ensure-natural (ensure-primitive-value (machine-val m))))
|
||||
'ok
|
||||
(error 'check-closure-arity "arity mismatch: passed ~s args to ~s"
|
||||
(CheckClosureArity!-arity op)
|
||||
(machine-val m)
|
||||
(closure-display-name clos)))]
|
||||
[else
|
||||
(error 'check-closure-arity "not a closure: ~s" clos)]))]
|
||||
|
|
@ -612,9 +612,11 @@
|
|||
[else
|
||||
(error 'ensure-toplevel)]))
|
||||
|
||||
(: ensure-natural (Integer -> Natural))
|
||||
(define-predicate natural? Natural)
|
||||
|
||||
(: ensure-natural (Any -> Natural))
|
||||
(define (ensure-natural x)
|
||||
(if (>= x 0)
|
||||
(if (natural? x)
|
||||
x
|
||||
(error 'ensure-natural)))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user