From c8faf78ffbe28f4e18e81d509132fd6f3c6cfb40 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 17 Feb 2012 12:23:11 -0500 Subject: [PATCH] renaming il to try matching dissertation --- Makefile | 4 +- compiler/bootstrapped-primitives.rkt | 62 ++++---- compiler/compiler.rkt | 198 +++++++++++++------------- compiler/il-structs.rkt | 18 +-- compiler/optimize-il.rkt | 52 +++---- js-assembler/assemble-helpers.rkt | 2 +- js-assembler/assemble.rkt | 80 +++++------ js-assembler/collect-jump-targets.rkt | 36 ++--- js-assembler/fracture.rkt | 4 +- make/make.rkt | 2 +- version.rkt | 2 +- 11 files changed, 230 insertions(+), 230 deletions(-) diff --git a/Makefile b/Makefile index 4bb07f5..69bc56b 100644 --- a/Makefile +++ b/Makefile @@ -45,8 +45,8 @@ cs019-doc: setup: - raco setup --no-docs -P dyoo whalesong.plt 1 15 + raco setup --no-docs -P dyoo whalesong.plt 1 16 planet-link: - raco planet link dyoo whalesong.plt 1 15 . + raco planet link dyoo whalesong.plt 1 16 . diff --git a/compiler/bootstrapped-primitives.rkt b/compiler/bootstrapped-primitives.rkt index 1211f5b..eaf02a6 100644 --- a/compiler/bootstrapped-primitives.rkt +++ b/compiler/bootstrapped-primitives.rkt @@ -43,16 +43,16 @@ ;; Precondition: the environment holds the f function that we want to jump into. ;; First, move f to the proc register - (make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f)) + (make-AssignImmediate 'proc (make-EnvLexicalReference 0 #f)) ;; Next, capture the envrionment and the current continuation closure,. (make-PushEnvironment 2 #f) - (make-AssignPrimOpStatement (make-EnvLexicalReference 0 #f) + (make-AssignPrimOp (make-EnvLexicalReference 0 #f) (make-CaptureControl 0 default-continuation-prompt-tag)) - (make-AssignPrimOpStatement (make-EnvLexicalReference 1 #f) + (make-AssignPrimOp (make-EnvLexicalReference 1 #f) ;; When capturing, skip over f and the two slots we just added. (make-CaptureEnvironment 3 default-continuation-prompt-tag)) - (make-AssignPrimOpStatement (make-EnvLexicalReference 2 #f) + (make-AssignPrimOp (make-EnvLexicalReference 2 #f) (make-MakeCompiledProcedure call/cc-closure-entry 1 ;; the continuation consumes a single value (list 0 1) @@ -61,7 +61,7 @@ (make-Const 0)) ;; Finally, do a tail call into f. - (make-AssignImmediateStatement 'argcount (make-Const 1)) + (make-AssignImmediate 'argcount (make-Const 1)) (compile-general-procedure-call '() (make-Const 1) ;; the stack at this point holds a single argument 'val @@ -70,13 +70,13 @@ ;; The code for the continuation code follows. It's supposed to ;; abandon the current continuation, initialize the control and environment, and then jump. call/cc-closure-entry - (make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f)) - (make-PerformStatement (make-InstallClosureValues!)) - (make-PerformStatement (make-RestoreControl! default-continuation-prompt-tag)) - (make-PerformStatement (make-RestoreEnvironment!)) - (make-AssignImmediateStatement 'proc (make-ControlStackLabel)) + (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f)) + (make-Perform (make-InstallClosureValues!)) + (make-Perform (make-RestoreControl! default-continuation-prompt-tag)) + (make-Perform (make-RestoreEnvironment!)) + (make-AssignImmediate 'proc (make-ControlStackLabel)) (make-PopControlFrame) - (make-GotoStatement (make-Reg 'proc))))) + (make-Goto (make-Reg 'proc))))) @@ -264,11 +264,11 @@ (let ([after-call/cc-code (make-label 'afterCallCCImplementation)]) (append - `(,(make-AssignPrimOpStatement (make-PrimitivesReference 'call/cc) + `(,(make-AssignPrimOp (make-PrimitivesReference 'call/cc) (make-MakeCompiledProcedure call/cc-label 1 '() 'call/cc)) - ,(make-AssignPrimOpStatement (make-PrimitivesReference 'call-with-current-continuation) + ,(make-AssignPrimOp (make-PrimitivesReference 'call-with-current-continuation) (make-MakeCompiledProcedure call/cc-label 1 '() 'call/cc)) - ,(make-GotoStatement (make-Label after-call/cc-code))) + ,(make-Goto (make-Label after-call/cc-code))) (make-call/cc-code) `(,after-call/cc-code))) @@ -281,35 +281,35 @@ [values-entry (make-label 'valuesEntry)] [on-zero-values (make-label 'onZeroValues)] [on-single-value (make-label 'onSingleValue)]) - `(,(make-GotoStatement (make-Label after-values-body-defn)) + `(,(make-Goto (make-Label after-values-body-defn)) ,values-entry - ,(make-TestAndJumpStatement (make-TestOne (make-Reg 'argcount)) on-single-value) - ,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) on-zero-values) + ,(make-TestAndJump (make-TestOne (make-Reg 'argcount)) on-single-value) + ,(make-TestAndJump (make-TestZero (make-Reg 'argcount)) on-zero-values) ;; Common case: we're running multiple values. Put the first in the val register ;; and go to the multiple value return. - ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f)) + ,(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f)) ,(make-PopEnvironment (make-Const 1) (make-Const 0)) - ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn)) + ,(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn)) ,(make-PopControlFrame) - ,(make-GotoStatement (make-Reg 'proc)) + ,(make-Goto (make-Reg 'proc)) ;; Special case: on a single value, just use the regular return address ,on-single-value - ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f)) + ,(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f)) ,(make-PopEnvironment (make-Const 1) (make-Const 0)) - ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel)) + ,(make-AssignImmediate 'proc (make-ControlStackLabel)) ,(make-PopControlFrame) - ,(make-GotoStatement (make-Reg 'proc)) + ,(make-Goto (make-Reg 'proc)) ;; On zero values, leave things be and just return. ,on-zero-values - ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn)) + ,(make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn)) ,(make-PopControlFrame) - ,(make-GotoStatement (make-Reg 'proc)) + ,(make-Goto (make-Reg 'proc)) ,after-values-body-defn - ,(make-AssignPrimOpStatement (make-PrimitivesReference 'values) + ,(make-AssignPrimOp (make-PrimitivesReference 'values) (make-MakeCompiledProcedure values-entry (make-ArityAtLeast 0) '() @@ -321,17 +321,17 @@ ;; As is apply: (let ([after-apply-code (make-label 'afterApplyCode)] [apply-entry (make-label 'applyEntry)]) - `(,(make-GotoStatement (make-Label after-apply-code)) + `(,(make-Goto (make-Label after-apply-code)) ,apply-entry ;; Push the procedure into proc. - ,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f)) + ,(make-AssignImmediate 'proc (make-EnvLexicalReference 0 #f)) ,(make-PopEnvironment (make-Const 1) (make-Const 0)) ;; Correct the number of arguments to be passed. - ,(make-AssignImmediateStatement 'argcount (make-SubtractArg (make-Reg 'argcount) + ,(make-AssignImmediate 'argcount (make-SubtractArg (make-Reg 'argcount) (make-Const 1))) ;; Splice in the list argument. - ,(make-PerformStatement (make-SpliceListIntoStack! (make-SubtractArg (make-Reg 'argcount) + ,(make-Perform (make-SpliceListIntoStack! (make-SubtractArg (make-Reg 'argcount) (make-Const 1)))) ;; Finally, jump into the procedure body @@ -342,5 +342,5 @@ ,after-apply-code - ,(make-AssignPrimOpStatement (make-PrimitivesReference 'apply) + ,(make-AssignPrimOp (make-PrimitivesReference 'apply) (make-MakeCompiledProcedure apply-entry (make-ArityAtLeast 2) '() 'apply)))))) \ No newline at end of file diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index 0ea5c0d..3928793 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -42,7 +42,7 @@ (append-instruction-sequences ;; Layout the lambda bodies... - (make-GotoStatement (make-Label after-lam-bodies)) + (make-Goto (make-Label after-lam-bodies)) (compile-lambda-bodies (collect-all-lambdas-with-bodies exp)) after-lam-bodies @@ -56,7 +56,7 @@ before-pop-prompt (if (eq? target 'val) empty-instruction-sequence - (make-AssignImmediateStatement target (make-Reg 'val)))))))) + (make-AssignImmediate target (make-Reg 'val)))))))) (define-struct: lam+cenv ([lam : (U Lam CaseLam)] @@ -198,21 +198,21 @@ (append-instruction-sequences (make-PopEnvironment (make-Const (length cenv)) (make-Const 0)) - (make-AssignImmediateStatement 'proc (make-ControlStackLabel)) + (make-AssignImmediate 'proc (make-ControlStackLabel)) (make-PopControlFrame) - (make-GotoStatement (make-Reg 'proc)))] + (make-Goto (make-Reg 'proc)))] [else ;; Under non-tail calls, leave the stack as is and just do the jump. (append-instruction-sequences - (make-AssignImmediateStatement 'proc (make-ControlStackLabel)) + (make-AssignImmediate 'proc (make-ControlStackLabel)) (make-PopControlFrame) - (make-GotoStatement (make-Reg 'proc)))])] + (make-Goto (make-Reg 'proc)))])] [(NextLinkage? linkage) empty-instruction-sequence] [(LabelLinkage? linkage) - (make-GotoStatement (make-Label (LabelLinkage-label linkage)))])) + (make-Goto (make-Label (LabelLinkage-label linkage)))])) @@ -295,12 +295,12 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-PerformStatement (make-ExtendEnvironment/Prefix! names)) + (make-Perform (make-ExtendEnvironment/Prefix! names)) (compile (Top-code top) (cons (Top-prefix top) cenv) 'val next-linkage/drop-multiple) - (make-AssignImmediateStatement target (make-Reg 'val)) + (make-AssignImmediate target (make-Reg 'val)) (make-PopEnvironment (make-Const 1) (make-Const 0)))))) @@ -326,21 +326,21 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-PerformStatement (make-InstallModuleEntry! name path module-entry)) - (make-GotoStatement (make-Label after-module-body)) + (make-Perform (make-InstallModuleEntry! name path module-entry)) + (make-Goto (make-Label after-module-body)) module-entry - (make-PerformStatement (make-MarkModuleInvoked! path)) + (make-Perform (make-MarkModuleInvoked! path)) ;; Module body definition: ;; 1. First invoke all the modules that this requires. (apply append-instruction-sequences (map compile-module-invoke (Module-requires mod))) ;; 2. Next, evaluate the module body. - (make-PerformStatement (make-ExtendEnvironment/Prefix! names)) + (make-Perform (make-ExtendEnvironment/Prefix! names)) - (make-AssignImmediateStatement (make-ModulePrefixTarget path) + (make-AssignImmediate (make-ModulePrefixTarget path) (make-EnvWholePrefixReference 0)) ;; TODO: we need to sequester the prefix of the module with the record. (compile (Module-code mod) @@ -350,12 +350,12 @@ ;; 3. Finally, cleanup and return. (make-PopEnvironment (make-Const 1) (make-Const 0)) - (make-AssignImmediateStatement 'proc (make-ControlStackLabel)) + (make-AssignImmediate 'proc (make-ControlStackLabel)) (make-PopControlFrame) - (make-PerformStatement (make-FinalizeModuleInvokation! path)) - (make-GotoStatement (make-Reg 'proc)) + (make-Perform (make-FinalizeModuleInvokation! path)) + (make-Goto (make-Reg 'proc)) after-module-body)))])) @@ -364,7 +364,7 @@ (end-with-linkage linkage cenv (append-instruction-sequences (compile-module-invoke (Require-path exp)) - (make-AssignImmediateStatement target (make-Const (void)))))) + (make-AssignImmediate target (make-Const (void)))))) (: compile-module-invoke (ModuleLocator -> InstructionSequence)) @@ -381,7 +381,7 @@ [on-return (make-LinkedLabel (make-label 'onReturn) on-return-multiple)]) (append-instruction-sequences - (make-TestAndJumpStatement (make-TestTrue + (make-TestAndJump (make-TestTrue (make-IsModuleLinked a-module-name)) linked) ;; TODO: raise an exception here that says that the module hasn't been @@ -389,13 +389,13 @@ (make-DebugPrint (make-Const (format "DEBUG: the module ~a hasn't been linked in!!!" (ModuleLocator-name a-module-name)))) - (make-GotoStatement (make-Label (LinkedLabel-label on-return))) + (make-Goto (make-Label (LinkedLabel-label on-return))) linked - (make-TestAndJumpStatement (make-TestTrue + (make-TestAndJump (make-TestTrue (make-IsModuleInvoked a-module-name)) (LinkedLabel-label on-return)) (make-PushControlFrame/Call on-return) - (make-GotoStatement (ModuleEntry a-module-name)) + (make-Goto (ModuleEntry a-module-name)) on-return-multiple (make-PopEnvironment (new-SubtractArg (make-Reg 'argcount) (make-Const 1)) @@ -437,14 +437,14 @@ empty-instruction-sequence] [(eq? context 'keep-multiple) - (make-AssignImmediateStatement 'argcount (make-Const 1))] + (make-AssignImmediate 'argcount (make-Const 1))] [(natural? context) (if (= context 1) empty-instruction-sequence (append-instruction-sequences - (make-AssignImmediateStatement 'argcount (make-Const 1)) - (make-PerformStatement (make-RaiseContextExpectedValuesError! + (make-AssignImmediate 'argcount (make-Const 1)) + (make-Perform (make-RaiseContextExpectedValuesError! context))))]))])) @@ -457,7 +457,7 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-AssignImmediateStatement target (make-Const + (make-AssignImmediate target (make-Const (ensure-const-value (Constant-v exp)))) singular-context-check)))) @@ -469,7 +469,7 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-AssignImmediateStatement target exp) + (make-AssignImmediate target exp) singular-context-check)))) @@ -480,7 +480,7 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-AssignImmediateStatement target + (make-AssignImmediate target (make-EnvLexicalReference (LocalRef-depth exp) (LocalRef-unbox? exp))) singular-context-check)))) @@ -495,12 +495,12 @@ (append-instruction-sequences (if (ToplevelRef-check-defined? exp) - (make-PerformStatement (make-CheckToplevelBound! + (make-Perform (make-CheckToplevelBound! (ToplevelRef-depth exp) (ToplevelRef-pos exp))) empty-instruction-sequence) - (make-AssignImmediateStatement + (make-AssignImmediate target (make-EnvPrefixReference (ToplevelRef-depth exp) (ToplevelRef-pos exp))) @@ -521,7 +521,7 @@ cenv (append-instruction-sequences get-value-code - (make-AssignImmediateStatement target (make-Const (void))) + (make-AssignImmediate target (make-Const (void))) singular-context-check))))) @@ -544,7 +544,7 @@ [a-code (compile (Branch-alternative exp) cenv target linkage)]) (append-instruction-sequences p-code - (make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) + (make-TestAndJump (make-TestFalse (make-Reg 'val)) f-branch:) c-code f-branch: a-code @@ -588,7 +588,7 @@ (emit-values-context-check-on-procedure-return (linkage-context linkage) on-return/multiple on-return) - (make-AssignImmediateStatement target (make-Reg 'val)))))] + (make-AssignImmediate target (make-Reg 'val)))))] [else (let* ([on-return/multiple (make-label 'beforePromptPopMultiple)] [on-return (make-LinkedLabel (make-label 'beforePromptPop) @@ -621,16 +621,16 @@ ;; Evaluate the first expression in a multiple-value context, and get the values on the stack. (compile (first seq) cenv 'val next-linkage/keep-multiple-on-stack) - (make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-first-seq) + (make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-first-seq) (make-PushImmediateOntoEnvironment (make-Reg 'val) #f) after-first-seq ;; At this time, the argcount values are on the stack. ;; Next, we save those values temporarily in a throwaway control frame. (make-PushControlFrame/Generic) - (make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Count) + (make-AssignImmediate (make-ControlFrameTemporary 'pendingBegin0Count) (make-Reg 'argcount)) - (make-PerformStatement (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount))) - (make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Values) + (make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount))) + (make-AssignImmediate (make-ControlFrameTemporary 'pendingBegin0Values) (make-EnvLexicalReference 0 #f)) (make-PopEnvironment (make-Const 1) (make-Const 0))))] @@ -639,11 +639,11 @@ (append-instruction-sequences ;; Reinstate the values of the first expression, and drop the throwaway control frame. (make-PushImmediateOntoEnvironment (make-ControlFrameTemporary 'pendingBegin0Values) #f) - (make-PerformStatement (make-SpliceListIntoStack! (make-Const 0))) - (make-AssignImmediateStatement 'argcount (make-ControlFrameTemporary 'pendingBegin0Count)) + (make-Perform (make-SpliceListIntoStack! (make-Const 0))) + (make-AssignImmediate 'argcount (make-ControlFrameTemporary 'pendingBegin0Count)) (make-PopControlFrame) - (make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated) - (make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f)) + (make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-values-reinstated) + (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f)) (make-PopEnvironment (make-Const 1) (make-Const 0)) after-values-reinstated))]) @@ -654,7 +654,7 @@ reinstate-values-on-stack - (make-AssignImmediateStatement target (make-Reg 'val)) + (make-AssignImmediate target (make-Reg 'val)) ;; TODO: context needs check for arguments. (cond @@ -665,20 +665,20 @@ (make-PopEnvironment (make-Const (length cenv)) (new-SubtractArg (make-Reg 'argcount) (make-Const 1))) - (make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn)) + (make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn)) (make-PopControlFrame) - (make-GotoStatement (make-Reg 'proc)))] + (make-Goto (make-Reg 'proc)))] [else (append-instruction-sequences - (make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn)) + (make-AssignImmediate 'proc (make-ControlStackLabel/MultipleValueReturn)) (make-PopControlFrame) - (make-GotoStatement (make-Reg 'proc)))])] + (make-Goto (make-Reg 'proc)))])] [(NextLinkage? linkage) empty-instruction-sequence] [(LabelLinkage? linkage) - (make-GotoStatement (make-Label (LabelLinkage-label linkage)))])))])) + (make-Goto (make-Label (LabelLinkage-label linkage)))])))])) @@ -693,7 +693,7 @@ linkage cenv (append-instruction-sequences - (make-AssignPrimOpStatement + (make-AssignPrimOp target (make-MakeCompiledProcedure (Lam-entry-label exp) (Lam-arity exp) @@ -708,7 +708,7 @@ linkage cenv (append-instruction-sequences - (make-AssignPrimOpStatement + (make-AssignPrimOp target (make-MakeCompiledProcedure (EmptyClosureReference-entry-label exp) (EmptyClosureReference-arity exp) @@ -740,7 +740,7 @@ (apply append-instruction-sequences (map (lambda: ([lam : (U Lam EmptyClosureReference)] [target : Target]) - (make-AssignPrimOpStatement + (make-AssignPrimOp target (cond [(Lam? lam) @@ -759,7 +759,7 @@ (make-EnvLexicalReference i #f))))) ;; Make the case lambda as a regular compiled procedure. Its closed values are the lambdas. - (make-AssignPrimOpStatement + (make-AssignPrimOp (adjust-target-depth target n) (make-MakeCompiledProcedure (CaseLam-entry-label exp) (merge-arities (map Lam-arity (CaseLam-clauses exp))) @@ -829,7 +829,7 @@ linkage cenv (append-instruction-sequences - (make-AssignPrimOpStatement + (make-AssignPrimOp target (make-MakeCompiledProcedureShell (Lam-entry-label exp) (if (Lam-rest? exp) @@ -845,7 +845,7 @@ (define (compile-lambda-body exp cenv) (let: ([maybe-unsplice-rest-argument : InstructionSequence (if (Lam-rest? exp) - (make-PerformStatement + (make-Perform (make-UnspliceRestFromStack! (make-Const (Lam-num-parameters exp)) (new-SubtractArg (make-Reg 'argcount) @@ -855,7 +855,7 @@ (if (not (empty? (Lam-closure-map exp))) (append-instruction-sequences (make-Comment (format "installing closure for ~s" (Lam-name exp))) - (make-PerformStatement (make-InstallClosureValues!))) + (make-Perform (make-InstallClosureValues!))) empty-instruction-sequence)] [lam-body-code : InstructionSequence (compile (Lam-body exp) @@ -881,18 +881,18 @@ [i : Natural]) (let ([not-match (make-label 'notMatch)]) (append-instruction-sequences - (make-TestAndJumpStatement (make-TestClosureArityMismatch + (make-TestAndJump (make-TestClosureArityMismatch (make-CompiledProcedureClosureReference (make-Reg 'proc) i) (make-Reg 'argcount)) not-match) ;; Set the procedure register to the lam - (make-AssignImmediateStatement + (make-AssignImmediate 'proc (make-CompiledProcedureClosureReference (make-Reg 'proc) i)) - (make-GotoStatement (make-Label + (make-Goto (make-Label (cond [(Lam? lam) (Lam-entry-label lam)] [(EmptyClosureReference? lam) @@ -971,8 +971,8 @@ (error 'impossible)] [(Const? op-knowledge) (append-instruction-sequences - (make-AssignImmediateStatement 'proc op-knowledge) - (make-PerformStatement + (make-AssignImmediate 'proc op-knowledge) + (make-Perform (make-RaiseOperatorApplicationError! (make-Reg 'proc))))] [else (default)])))) @@ -1040,7 +1040,7 @@ (make-PushEnvironment (length (App-operands exp)) #f) proc-code (juggle-operands operand-codes) - (make-AssignImmediateStatement 'argcount + (make-AssignImmediate 'argcount (make-Const (length (App-operands exp)))) (compile-general-procedure-call cenv (make-Const (length (App-operands exp))) @@ -1073,7 +1073,7 @@ (make-PushEnvironment (length (App-operands exp)) #f) (apply append-instruction-sequences operand-codes) proc-code - (make-AssignImmediateStatement 'argcount (make-Const (length (App-operands exp)))) + (make-AssignImmediate 'argcount (make-Const (length (App-operands exp)))) (compile-primitive-procedure-call cenv (make-Const (length (App-operands exp))) target @@ -1119,10 +1119,10 @@ (build-list (length (App-operands exp)) (lambda: ([i : Natural]) (make-EnvLexicalReference i #f))))) - (make-AssignImmediateStatement 'proc (make-PrimitiveKernelValue kernel-op)) - (make-AssignImmediateStatement 'argcount + (make-AssignImmediate 'proc (make-PrimitiveKernelValue kernel-op)) + (make-AssignImmediate 'argcount (make-Const (length (App-operands exp)))) - (make-PerformStatement (make-RaiseArityMismatchError! + (make-Perform (make-RaiseArityMismatchError! (make-Reg 'proc) expected-arity (make-Const n)))))) @@ -1166,7 +1166,7 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-AssignPrimOpStatement target + (make-AssignPrimOp target (make-CallKernelPrimitiveProcedure kernel-op operand-poss @@ -1245,7 +1245,7 @@ (append-instruction-sequences stack-pushing-code rest-operand-code - (make-AssignPrimOpStatement (adjust-target-depth target (length rest-operands)) + (make-AssignPrimOp (adjust-target-depth target (length rest-operands)) (make-CallKernelPrimitiveProcedure kernel-op (append constant-operand-poss rest-operand-poss) @@ -1371,7 +1371,7 @@ (length (App-operands exp))) empty-instruction-sequence] [else - (make-PerformStatement + (make-Perform (make-RaiseArityMismatchError! (make-Reg 'proc) (StaticallyKnownLam-arity static-knowledge) @@ -1430,9 +1430,9 @@ ;; last operand at 'val into env[n]. (append-instruction-sequences (car ops) - (make-AssignImmediateStatement 'proc + (make-AssignImmediate 'proc (make-EnvLexicalReference n #f)) - (make-AssignImmediateStatement (make-EnvLexicalReference n #f) + (make-AssignImmediate (make-EnvLexicalReference n #f) (make-Reg 'val))))] [else ;; Otherwise, add instructions to juggle the operator and operands in the stack. @@ -1471,7 +1471,7 @@ linkage cenv (append-instruction-sequences - (make-PerformStatement (make-CheckClosureAndArity!)) + (make-Perform (make-CheckClosureAndArity!)) (compile-compiled-procedure-application cenv number-of-arguments 'dynamic @@ -1492,12 +1492,12 @@ linkage cenv (append-instruction-sequences - (make-PerformStatement (make-CheckPrimitiveArity!)) - (make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure)) + (make-Perform (make-CheckPrimitiveArity!)) + (make-AssignPrimOp 'val (make-ApplyPrimitiveProcedure)) (make-PopEnvironment number-of-arguments (make-Const 0)) (if (eq? target 'val) empty-instruction-sequence - (make-AssignImmediateStatement target (make-Reg 'val))) + (make-AssignImmediate target (make-Reg 'val))) (emit-singular-context linkage)))) @@ -1516,7 +1516,7 @@ after-call (linkage-context linkage)))]) (append-instruction-sequences - (make-AssignImmediateStatement 'argcount + (make-AssignImmediate 'argcount (make-Const n)) (compile-compiled-procedure-application cenv (make-Const n) @@ -1560,7 +1560,7 @@ [(eq? target 'val) empty-instruction-sequence] [else - (make-AssignImmediateStatement target (make-Reg 'val))])] + (make-AssignImmediate target (make-Reg 'val))])] [on-return/multiple (make-label 'procReturnMultiple)] @@ -1572,7 +1572,7 @@ [nontail-jump-into-procedure (append-instruction-sequences (make-PushControlFrame/Call on-return) - (make-GotoStatement entry-point-target))]) + (make-Goto entry-point-target))]) (cond [(ReturnLinkage? linkage) (cond @@ -1588,13 +1588,13 @@ (append-instruction-sequences reuse-the-stack ;; Assign the proc value of the existing call frame. - (make-PerformStatement (make-SetFrameCallee! (make-Reg 'proc))) - (make-GotoStatement entry-point-target)))] + (make-Perform (make-SetFrameCallee! (make-Reg 'proc))) + (make-Goto entry-point-target)))] [else ;; This case happens when we should be returning to a caller, but where ;; we are not in tail position. - (make-GotoStatement entry-point-target)])] + (make-Goto entry-point-target)])] [else (error 'compile "return linkage, target not val: ~s" target)])] @@ -1608,7 +1608,7 @@ [maybe-jump-to-label (if (LabelLinkage? linkage) - (make-GotoStatement (make-Label (LabelLinkage-label linkage))) + (make-Goto (make-Label (LabelLinkage-label linkage))) empty-instruction-sequence)]) (append-instruction-sequences @@ -1639,9 +1639,9 @@ (let ([after-return (make-label 'afterReturn)]) (append-instruction-sequences on-return/multiple - (make-GotoStatement (make-Label after-return)) + (make-Goto (make-Label after-return)) on-return - (make-AssignImmediateStatement 'argcount (make-Const 1)) + (make-AssignImmediate 'argcount (make-Const 1)) after-return))] [(natural? context) @@ -1649,7 +1649,7 @@ [(= context 1) (append-instruction-sequences on-return/multiple - (make-PerformStatement + (make-Perform (make-RaiseContextExpectedValuesError! 1)) on-return)] [else @@ -1657,11 +1657,11 @@ (append-instruction-sequences on-return/multiple ;; if the wrong number of arguments come in, die - (make-TestAndJumpStatement (make-TestZero (new-SubtractArg (make-Reg 'argcount) + (make-TestAndJump (make-TestZero (new-SubtractArg (make-Reg 'argcount) (make-Const context))) after-value-check) on-return - (make-PerformStatement + (make-Perform (make-RaiseContextExpectedValuesError! context)) after-value-check))])])) @@ -1920,7 +1920,7 @@ [i : Natural]) (append-instruction-sequences (make-Comment (format "Installing shell for ~s\n" (Lam-name lam))) - (make-PerformStatement (make-FixClosureShellMap! i + (make-Perform (make-FixClosureShellMap! i (Lam-closure-map lam))))) (LetRec-procs exp) (build-list n (lambda: ([i : Natural]) i)))) @@ -1971,7 +1971,7 @@ [from : OpArg]) (append-instruction-sequences (make-Comment "install-value: installing value") - (make-AssignImmediateStatement to from))) + (make-AssignImmediate to from))) (build-list count (lambda: ([i : Natural]) (make-EnvLexicalReference (+ i (InstallValue-depth exp) @@ -1987,7 +1987,7 @@ (: compile-box-environment-value (BoxEnv CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-box-environment-value exp cenv target linkage) (append-instruction-sequences - (make-AssignPrimOpStatement (make-EnvLexicalReference (BoxEnv-depth exp) #f) + (make-AssignPrimOp (make-EnvLexicalReference (BoxEnv-depth exp) #f) (make-MakeBoxedEnvironmentValue (BoxEnv-depth exp))) (compile (BoxEnv-body exp) cenv target linkage))) @@ -2001,11 +2001,11 @@ (define (in-return-context) (append-instruction-sequences (compile (WithContMark-key exp) cenv 'val next-linkage/expects-single) - (make-AssignImmediateStatement + (make-AssignImmediate (make-ControlFrameTemporary 'pendingContinuationMarkKey) (make-Reg 'val)) (compile (WithContMark-value exp) cenv 'val next-linkage/expects-single) - (make-PerformStatement (make-InstallContinuationMarkEntry!)) + (make-Perform (make-InstallContinuationMarkEntry!)) (compile (WithContMark-body exp) cenv target linkage))) (: in-other-context ((U NextLinkage LabelLinkage) -> InstructionSequence)) @@ -2021,14 +2021,14 @@ [(eq? target 'val) empty-instruction-sequence] [else - (make-AssignImmediateStatement target (make-Reg 'val))])]) + (make-AssignImmediate target (make-Reg 'val))])]) (append-instruction-sequences (make-PushControlFrame/Call on-return:) (compile (WithContMark-key exp) cenv 'val next-linkage/expects-single) - (make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingContinuationMarkKey) + (make-AssignImmediate (make-ControlFrameTemporary 'pendingContinuationMarkKey) (make-Reg 'val)) (compile (WithContMark-value exp) cenv 'val next-linkage/expects-single) - (make-PerformStatement (make-InstallContinuationMarkEntry!)) + (make-Perform (make-InstallContinuationMarkEntry!)) (compile (WithContMark-body exp) cenv 'val return-linkage/nontail) check-values-context-on-procedure-return maybe-migrate-val-to-target))) @@ -2040,7 +2040,7 @@ [(LabelLinkage? linkage) (append-instruction-sequences (in-other-context linkage) - (make-GotoStatement (make-Label (LabelLinkage-label linkage))))])) + (make-Goto (make-Label (LabelLinkage-label linkage))))])) (: compile-apply-values (ApplyValues CompileTimeEnvironment Target Linkage -> InstructionSequence)) @@ -2066,14 +2066,14 @@ 'val next-linkage/keep-multiple-on-stack) - (make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-args-evaluated) + (make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-args-evaluated) ;; In the common case where we do get values back, we push val onto the stack too, ;; so that we have n values on the stack before we jump to the procedure call. (make-PushImmediateOntoEnvironment (make-Reg 'val) #f) after-args-evaluated ;; Retrieve the procedure off the temporary control frame. - (make-AssignImmediateStatement + (make-AssignImmediate 'proc (make-ControlFrameTemporary 'pendingApplyValuesProc)) @@ -2105,7 +2105,7 @@ (apply append-instruction-sequences (map (lambda: ([id : ToplevelRef] [from : OpArg]) - (make-AssignImmediateStatement + (make-AssignImmediate ;; Slightly subtle: the toplevelrefs were with respect to the ;; stack at the beginning of def-values, but at the moment, ;; there may be additional values that are currently there. @@ -2140,7 +2140,7 @@ (end-with-linkage linkage cenv (append-instruction-sequences - (make-AssignImmediateStatement target exp) + (make-AssignImmediate target exp) singular-context-check)))] [else ;; Maybe warn about the unimplemented kernel primitive. @@ -2150,7 +2150,7 @@ id) ((current-warn-unimplemented-kernel-primitive) id)) - (make-PerformStatement (make-RaiseUnimplementedPrimitiveError! id))]))) + (make-Perform (make-RaiseUnimplementedPrimitiveError! id))]))) diff --git a/compiler/il-structs.rkt b/compiler/il-structs.rkt index 8c17162..3301803 100644 --- a/compiler/il-structs.rkt +++ b/compiler/il-structs.rkt @@ -163,9 +163,9 @@ DebugPrint Comment - AssignImmediateStatement - AssignPrimOpStatement - PerformStatement + AssignImmediate + AssignPrimOp + Perform PopEnvironment PushEnvironment @@ -176,7 +176,7 @@ PushControlFrame/Prompt PopControlFrame)) -(define-type BranchingStatement (U GotoStatement TestAndJumpStatement)) +(define-type BranchingStatement (U Goto TestAndJump)) ;; instruction sequences @@ -201,10 +201,10 @@ #:transparent) -(define-struct: AssignImmediateStatement ([target : Target] +(define-struct: AssignImmediate ([target : Target] [value : OpArg]) #:transparent) -(define-struct: AssignPrimOpStatement ([target : Target] +(define-struct: AssignPrimOp ([target : Target] [op : PrimitiveOperator]) #:transparent) @@ -252,18 +252,18 @@ -(define-struct: GotoStatement ([target : (U Label +(define-struct: Goto ([target : (U Label Reg ModuleEntry CompiledProcedureEntry)]) #:transparent) -(define-struct: PerformStatement ([op : PrimitiveCommand]) +(define-struct: Perform ([op : PrimitiveCommand]) #:transparent) -(define-struct: TestAndJumpStatement ([op : PrimitiveTest] +(define-struct: TestAndJump ([op : PrimitiveTest] [label : Symbol]) #:transparent) diff --git a/compiler/optimize-il.rkt b/compiler/optimize-il.rkt index 194afa0..5f94553 100644 --- a/compiler/optimize-il.rkt +++ b/compiler/optimize-il.rkt @@ -50,8 +50,8 @@ ;; If there's a label, immediately followed by a direct Goto jump, ;; just equate the label and the jump. - [(and (symbol? last-stmt) (GotoStatement? next-stmt)) - (define goto-target (GotoStatement-target next-stmt)) + [(and (symbol? last-stmt) (Goto? next-stmt)) + (define goto-target (Goto-target next-stmt)) (cond [(Label? goto-target) (log-debug (format "merging label ~a and ~a" last-stmt (Label-name goto-target))) @@ -192,18 +192,18 @@ ;(cons a-stmt (loop (rest stmts))) ] - [(AssignImmediateStatement? a-stmt) - (cons (make-AssignImmediateStatement (rewrite-target (AssignImmediateStatement-target a-stmt)) - (rewrite-oparg (AssignImmediateStatement-value a-stmt))) + [(AssignImmediate? a-stmt) + (cons (make-AssignImmediate (rewrite-target (AssignImmediate-target a-stmt)) + (rewrite-oparg (AssignImmediate-value a-stmt))) (loop (rest stmts)))] - [(AssignPrimOpStatement? a-stmt) - (cons (make-AssignPrimOpStatement (rewrite-target (AssignPrimOpStatement-target a-stmt)) - (rewrite-primop (AssignPrimOpStatement-op a-stmt))) + [(AssignPrimOp? a-stmt) + (cons (make-AssignPrimOp (rewrite-target (AssignPrimOp-target a-stmt)) + (rewrite-primop (AssignPrimOp-op a-stmt))) (loop (rest stmts)))] - [(PerformStatement? a-stmt) - (cons (make-PerformStatement (rewrite-primcmd (PerformStatement-op a-stmt))) + [(Perform? a-stmt) + (cons (make-Perform (rewrite-primcmd (Perform-op a-stmt))) (loop (rest stmts)))] [(PopEnvironment? a-stmt) @@ -242,19 +242,19 @@ [(PopControlFrame? a-stmt) (cons a-stmt (loop (rest stmts)))] - [(GotoStatement? a-stmt) - (define target (GotoStatement-target a-stmt)) + [(Goto? a-stmt) + (define target (Goto-target a-stmt)) (cond [(Label? target) - (cons (make-GotoStatement (make-Label (ref (Label-name target)))) + (cons (make-Goto (make-Label (ref (Label-name target)))) (loop (rest stmts)))] [else (cons a-stmt (loop (rest stmts)))])] - [(TestAndJumpStatement? a-stmt) - (cons (make-TestAndJumpStatement (rewrite-primtest (TestAndJumpStatement-op a-stmt)) - (ref (TestAndJumpStatement-label a-stmt))) + [(TestAndJump? a-stmt) + (cons (make-TestAndJump (rewrite-primtest (TestAndJump-op a-stmt)) + (ref (TestAndJump-label a-stmt))) (loop (rest stmts)))])]))])) @@ -283,13 +283,13 @@ ;; instruction. [(and (PushEnvironment? first-stmt) (equal? first-stmt (make-PushEnvironment 1 #f)) - (AssignImmediateStatement? second-stmt)) - (let ([target (AssignImmediateStatement-target second-stmt)]) + (AssignImmediate? second-stmt)) + (let ([target (AssignImmediate-target second-stmt)]) (cond [(equal? target (make-EnvLexicalReference 0 #f)) (loop (cons (make-PushImmediateOntoEnvironment (adjust-oparg-depth - (AssignImmediateStatement-value second-stmt) -1) + (AssignImmediate-value second-stmt) -1) #f) (rest (rest statements))))] [else @@ -342,20 +342,20 @@ ;#f #t] - [(AssignImmediateStatement? stmt) - (equal? (AssignImmediateStatement-target stmt) - (AssignImmediateStatement-value stmt))] + [(AssignImmediate? stmt) + (equal? (AssignImmediate-target stmt) + (AssignImmediate-value stmt))] - [(AssignPrimOpStatement? stmt) + [(AssignPrimOp? stmt) #f] - [(PerformStatement? stmt) + [(Perform? stmt) #f] - [(GotoStatement? stmt) + [(Goto? stmt) #f] - [(TestAndJumpStatement? stmt) + [(TestAndJump? stmt) #f] [(PopEnvironment? stmt) diff --git a/js-assembler/assemble-helpers.rkt b/js-assembler/assemble-helpers.rkt index 2d1c447..b7a85d5 100644 --- a/js-assembler/assemble-helpers.rkt +++ b/js-assembler/assemble-helpers.rkt @@ -421,7 +421,7 @@ (: block-looks-like-context-expected-values? (BasicBlock -> (U Natural False))) (define (block-looks-like-context-expected-values? a-block) (match (BasicBlock-stmts a-block) - [(list (struct PerformStatement ((struct RaiseContextExpectedValuesError! (expected)))) + [(list (struct Perform ((struct RaiseContextExpectedValuesError! (expected)))) stmts ...) expected] [else diff --git a/js-assembler/assemble.rkt b/js-assembler/assemble.rkt index 2096728..34168f6 100644 --- a/js-assembler/assemble.rkt +++ b/js-assembler/assemble.rkt @@ -162,15 +162,15 @@ EOF (next)] [(DebugPrint? stmt) (next)] - [(AssignImmediateStatement? stmt) + [(AssignImmediate? stmt) (next)] - [(AssignPrimOpStatement? stmt) + [(AssignPrimOp? stmt) (next)] - [(PerformStatement? stmt) + [(Perform? stmt) (next)] - [(TestAndJumpStatement? stmt) + [(TestAndJump? stmt) (next)] - [(GotoStatement? stmt) + [(Goto? stmt) (next)] [(PushEnvironment? stmt) (next)] @@ -247,7 +247,7 @@ EOF (: default (UnlabeledStatement -> 'ok)) (define (default stmt) (when (and (empty? (rest stmts)) - (not (GotoStatement? stmt))) + (not (Goto? stmt))) (log-debug (format "Last statement of the block ~a is not a goto" name))) (display (assemble-statement stmt blockht) op) @@ -266,17 +266,17 @@ EOF [(DebugPrint? stmt) (default stmt)] - [(AssignImmediateStatement? stmt) + [(AssignImmediate? stmt) (default stmt)] - [(AssignPrimOpStatement? stmt) + [(AssignPrimOp? stmt) (default stmt)] - [(PerformStatement? stmt) + [(Perform? stmt) (default stmt)] - [(TestAndJumpStatement? stmt) - (define test (TestAndJumpStatement-op stmt)) + [(TestAndJump? stmt) + (define test (TestAndJump-op stmt)) (: test-code String) (define test-code (cond @@ -306,14 +306,14 @@ EOF (display test-code op) (display "{" op) (cond - [(set-contains? entry-points (TestAndJumpStatement-label stmt)) - (display (assemble-jump (make-Label (TestAndJumpStatement-label stmt)) + [(set-contains? entry-points (TestAndJump-label stmt)) + (display (assemble-jump (make-Label (TestAndJump-label stmt)) blockht) op)] [else (assemble-block-statements (BasicBlock-name - (hash-ref blockht (TestAndJumpStatement-label stmt))) + (hash-ref blockht (TestAndJump-label stmt))) (BasicBlock-stmts - (hash-ref blockht (TestAndJumpStatement-label stmt))) + (hash-ref blockht (TestAndJump-label stmt))) blockht entry-points op)]) @@ -322,9 +322,9 @@ EOF (display "}" op) 'ok] - [(GotoStatement? stmt) + [(Goto? stmt) (let loop ([stmt stmt]) - (define target (GotoStatement-target stmt)) + (define target (Goto-target stmt)) (cond [(Label? target) (define target-block (hash-ref blockht (Label-name target))) @@ -335,7 +335,7 @@ EOF ;; inline and follow the goto. [(and (not (empty? target-statements)) (= 1 (length target-statements)) - (GotoStatement? (first target-statements))) + (Goto? (first target-statements))) (loop (first target-statements))] [(set-contains? entry-points (Label-name target)) (display (assemble-statement stmt blockht) op) @@ -403,21 +403,21 @@ EOF [(DebugPrint? stmt) (default)] - [(AssignImmediateStatement? stmt) + [(AssignImmediate? stmt) (default)] - [(AssignPrimOpStatement? stmt) + [(AssignPrimOp? stmt) (default)] - [(PerformStatement? stmt) + [(Perform? stmt) (default)] - [(TestAndJumpStatement? stmt) - (cons (TestAndJumpStatement-label stmt) + [(TestAndJump? stmt) + (cons (TestAndJump-label stmt) (loop (rest stmts)))] - [(GotoStatement? stmt) - (define target (GotoStatement-target stmt)) + [(Goto? stmt) + (define target (Goto-target stmt)) (cond [(Label? target) (cons (Label-name target) @@ -470,23 +470,23 @@ EOF (format "M.params.currentOutputPort.writeDomNode(M, $('').text(~a));" (assemble-oparg (DebugPrint-value stmt) blockht))] - [(AssignImmediateStatement? stmt) - (let: ([t : (String -> String) (assemble-target (AssignImmediateStatement-target stmt))] - [v : OpArg (AssignImmediateStatement-value stmt)]) + [(AssignImmediate? stmt) + (let: ([t : (String -> String) (assemble-target (AssignImmediate-target stmt))] + [v : OpArg (AssignImmediate-value stmt)]) (t (assemble-oparg v blockht)))] - [(AssignPrimOpStatement? stmt) - ((assemble-target (AssignPrimOpStatement-target stmt)) - (assemble-op-expression (AssignPrimOpStatement-op stmt) + [(AssignPrimOp? stmt) + ((assemble-target (AssignPrimOp-target stmt)) + (assemble-op-expression (AssignPrimOp-op stmt) blockht))] - [(PerformStatement? stmt) - (assemble-op-statement (PerformStatement-op stmt) blockht)] + [(Perform? stmt) + (assemble-op-statement (Perform-op stmt) blockht)] - [(TestAndJumpStatement? stmt) - (let*: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)] + [(TestAndJump? stmt) + (let*: ([test : PrimitiveTest (TestAndJump-op stmt)] [jump : String (assemble-jump - (make-Label (TestAndJumpStatement-label stmt)) + (make-Label (TestAndJump-label stmt)) blockht)]) ;; to help localize type checks, we add a type annotation here. (ann (cond @@ -519,8 +519,8 @@ EOF jump)]) String))] - [(GotoStatement? stmt) - (assemble-jump (GotoStatement-target stmt) + [(Goto? stmt) + (assemble-jump (Goto-target stmt) blockht)] [(PushControlFrame/Generic? stmt) @@ -632,8 +632,8 @@ EOF (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)) + [(AssignPrimOp? first-stmt) + (define op (AssignPrimOp-op first-stmt)) (cond [(MakeCompiledProcedure? op) (cons (MakeCompiledProcedure-label op) diff --git a/js-assembler/collect-jump-targets.rkt b/js-assembler/collect-jump-targets.rkt index bd5a264..09e8a16 100644 --- a/js-assembler/collect-jump-targets.rkt +++ b/js-assembler/collect-jump-targets.rkt @@ -25,17 +25,17 @@ (LinkedLabel-linked-to stmt))] [(DebugPrint? stmt) empty] - [(AssignImmediateStatement? stmt) - (let: ([v : OpArg (AssignImmediateStatement-value stmt)]) + [(AssignImmediate? stmt) + (let: ([v : OpArg (AssignImmediate-value stmt)]) (collect-input v))] - [(AssignPrimOpStatement? stmt) - (collect-primitive-operator (AssignPrimOpStatement-op stmt))] - [(PerformStatement? stmt) - (collect-primitive-command (PerformStatement-op stmt))] - [(TestAndJumpStatement? stmt) - (list (TestAndJumpStatement-label stmt))] - [(GotoStatement? stmt) - (collect-input (GotoStatement-target stmt))] + [(AssignPrimOp? stmt) + (collect-primitive-operator (AssignPrimOp-op stmt))] + [(Perform? stmt) + (collect-primitive-command (Perform-op stmt))] + [(TestAndJump? stmt) + (list (TestAndJump-label stmt))] + [(Goto? stmt) + (collect-input (Goto-target stmt))] [(PushEnvironment? stmt) empty] [(PopEnvironment? stmt) @@ -172,16 +172,16 @@ (LinkedLabel-linked-to stmt))] [(DebugPrint? stmt) empty] - [(AssignImmediateStatement? stmt) - (let: ([v : OpArg (AssignImmediateStatement-value stmt)]) + [(AssignImmediate? stmt) + (let: ([v : OpArg (AssignImmediate-value stmt)]) (collect-input v))] - [(AssignPrimOpStatement? stmt) - (collect-primitive-operator (AssignPrimOpStatement-op stmt))] - [(PerformStatement? stmt) - (collect-primitive-command (PerformStatement-op stmt))] - [(TestAndJumpStatement? stmt) + [(AssignPrimOp? stmt) + (collect-primitive-operator (AssignPrimOp-op stmt))] + [(Perform? stmt) + (collect-primitive-command (Perform-op stmt))] + [(TestAndJump? stmt) empty] - [(GotoStatement? stmt) + [(Goto? stmt) empty] [(PushEnvironment? stmt) empty] diff --git a/js-assembler/fracture.rkt b/js-assembler/fracture.rkt index 33716df..fffd790 100644 --- a/js-assembler/fracture.rkt +++ b/js-assembler/fracture.rkt @@ -73,7 +73,7 @@ name (if last-stmt-goto? (reverse acc) - (reverse (cons (make-GotoStatement (make-Label label-name)) + (reverse (cons (make-Goto (make-Label label-name)) acc)))) basic-blocks) (cdr stmts) @@ -94,7 +94,7 @@ (cons first-stmt acc) basic-blocks (cdr stmts) - (GotoStatement? (car stmts)))]))])))) + (Goto? (car stmts)))]))])))) (define end-time (current-inexact-milliseconds)) (fprintf (current-timing-port) " assemble fracture: ~a milliseconds\n" (- end-time start-time)) diff --git a/make/make.rkt b/make/make.rkt index a093291..82db08b 100644 --- a/make/make.rkt +++ b/make/make.rkt @@ -59,7 +59,7 @@ [(ModuleLocator? maybe-module-locator) (append (my-force stmts) ;; Set the main module name - (list (make-PerformStatement + (list (make-Perform (make-AliasModuleAsMain! maybe-module-locator))))] [else diff --git a/version.rkt b/version.rkt index 93e3fd4..b83c1d9 100644 --- a/version.rkt +++ b/version.rkt @@ -7,4 +7,4 @@ (provide version) (: version String) -(define version "1.147") +(define version "1.150")