From ba8e8d26affd8ffc8b14e9a05c8f8fb91f04d40b Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 28 Apr 2011 14:53:00 -0400 Subject: [PATCH] trying to move some code into the optimize-il section, so I can simplify the compiler. --- compiler.rkt | 33 +++++++++++++++++----------- optimize-il.rkt | 57 ++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 77 insertions(+), 13 deletions(-) diff --git a/compiler.rkt b/compiler.rkt index 0f3c1d5..cb31e21 100644 --- a/compiler.rkt +++ b/compiler.rkt @@ -1182,27 +1182,27 @@ (: emit-values-context-check-on-procedure-return (ValuesContext Symbol LinkedLabel -> InstructionSequence)) ;; When we come back from a procedure call, the following code ensures the context's expectations ;; are met. -(define (emit-values-context-check-on-procedure-return context proc-return-multiple proc-return) +(define (emit-values-context-check-on-procedure-return context on-return/multiple on-return) (cond [(eq? context 'tail) - (append-instruction-sequences proc-return-multiple - proc-return)] + (append-instruction-sequences on-return/multiple + on-return)] [(eq? context 'drop-multiple) (append-instruction-sequences - proc-return-multiple + on-return/multiple (make-instruction-sequence `(,(make-PopEnvironment (SubtractArg (make-Reg 'argcount) (make-Const 1)) (make-Const 0)))) - proc-return)] + on-return)] [(eq? context 'keep-multiple) (let ([after-return (make-label 'afterReturn)]) (append-instruction-sequences - proc-return-multiple + on-return/multiple (make-instruction-sequence `(,(make-GotoStatement (make-Label after-return)))) - proc-return + on-return (make-instruction-sequence `(,(make-AssignImmediateStatement 'argcount (make-Const 1)))) after-return))] @@ -1211,15 +1211,15 @@ (cond [(= context 1) (append-instruction-sequences - proc-return-multiple + on-return/multiple (make-instruction-sequence `(,(make-PerformStatement (make-RaiseContextExpectedValuesError! 1)))) - proc-return)] + on-return)] [else (let ([after-value-check (make-label 'afterValueCheck)]) (append-instruction-sequences - proc-return-multiple + on-return/multiple (make-instruction-sequence `( ;; if the wrong number of arguments come in, die @@ -1228,7 +1228,7 @@ (make-SubtractArg (make-Reg 'argcount) (make-Const context)) after-value-check))) - proc-return + on-return (make-instruction-sequence `(,(make-PerformStatement (make-RaiseContextExpectedValuesError! context)))) @@ -1239,7 +1239,9 @@ (: extract-static-knowledge (Expression CompileTimeEnvironment -> CompileTimeEnvironmentEntry)) -;; Statically determines what we know about exp, given the compile time environment. +;; Statically determines what we know about the expression, given the compile time environment. +;; We should do more here eventually, including things like type inference or flow analysis, so that +;; we can generate better code. (define (extract-static-knowledge exp cenv) (cond [(Lam? exp) @@ -1271,6 +1273,8 @@ (: compile-let1 (Let1 CompileTimeEnvironment Target Linkage -> InstructionSequence)) +;; Single value binding. Since there's only one rhs, we have more static guarantees we can make, +;; which is why we can use extract-static-knowledge here. (define (compile-let1 exp cenv target linkage) (let*: ([rhs-code : InstructionSequence (compile (Let1-rhs exp) @@ -1309,7 +1313,10 @@ + (: compile-let-void (LetVoid CompileTimeEnvironment Target Linkage -> InstructionSequence)) +;; Binding several values. Unlike before, it has less knowledge about what values will be bound, +;; and so there's less analysis here. (define (compile-let-void exp cenv target linkage) (let*: ([n : Natural (LetVoid-count exp)] [after-let : Symbol (make-label 'afterLet)] @@ -1349,6 +1356,8 @@ (: compile-let-rec (LetRec CompileTimeEnvironment Target Linkage -> InstructionSequence)) +;; Compiled recursive Lams. Each lambda is installed as a shell, and then the closures +;; are installed in-place. (define (compile-let-rec exp cenv target linkage) (let*: ([extended-cenv : CompileTimeEnvironment (append (map (lambda: ([p : Lam]) diff --git a/optimize-il.rkt b/optimize-il.rkt index 9d14f9c..eeb0ae8 100644 --- a/optimize-il.rkt +++ b/optimize-il.rkt @@ -14,7 +14,7 @@ (define (optimize-il statements) ;; For now, replace pairs of PushEnvironment / AssignImmediate(0, ...) ;; We should do some more optimizations here, like peephole... - (let loop ([statements statements]) + (let loop ([statements (filter not-no-op? statements)]) (cond [(empty? statements) empty] @@ -47,6 +47,61 @@ (default)]))]))]))) +(: not-no-op? (Statement -> Boolean)) +(define (not-no-op? stmt) (not (no-op? stmt))) + + +(: no-op? (Statement -> Boolean)) +;; Produces true if the statement should have no effect. +(define (no-op? stmt) + (cond + [(symbol? stmt) + #f] + + [(LinkedLabel? stmt) + #f] + + [(AssignImmediateStatement? stmt) + (equal? (AssignImmediateStatement-target stmt) + (AssignImmediateStatement-value stmt))] + + [(AssignPrimOpStatement? stmt) + #f] + + [(PerformStatement? stmt) + #f] + + [(GotoStatement? stmt) + #f] + + [(TestAndBranchStatement? stmt) + #f] + + [(PopEnvironment? stmt) + (and (Const? (PopEnvironment-n stmt)) + (equal? (PopEnvironment-n stmt) + (make-Const 0)))] + + [(PushEnvironment? stmt) + (= (PushEnvironment-n stmt) 0)] + + [(PushImmediateOntoEnvironment? stmt) + #f] + + [(PushControlFrame/Generic? stmt) + #f] + + [(PushControlFrame/Call? stmt) + #f] + + [(PushControlFrame/Prompt? stmt) + #f] + + [(PopControlFrame? stmt) + #f])) + + + (: adjust-oparg-depth (OpArg Integer -> OpArg))