diff options
Diffstat (limited to 'csc/ir2.csc')
| -rw-r--r-- | csc/ir2.csc | 44 |
1 files changed, 40 insertions, 4 deletions
diff --git a/csc/ir2.csc b/csc/ir2.csc index bd2c1b6..fc31ce3 100644 --- a/csc/ir2.csc +++ b/csc/ir2.csc @@ -7,14 +7,21 @@ branch-false branch-true branch? + call-closure-args + call-closure-closure + call-closure? ir2=? kargs-expression kargs-refs kargs? + klabel-expression + klabel? ktail? make-atom make-branch + make-call-closure make-kargs + make-klabel make-ktail make-update update-atom @@ -112,6 +119,15 @@ (false branch-false)) + ; Calls the given closure. Closure is an atom, and args is a list of atoms. + (define-record-type <call-closure> + (make-call-closure closure args continuation) + call-closure? + (closure call-closure-closure) + (args call-closure-args) + (continuation call-closure-continuation)) + + ; CPS continuations. @@ -130,6 +146,13 @@ (expression kargs-expression)) + ; Ignores any incoming values and evaluates the given expression. + (define-record-type <klabel> + (make-klabel expression) + klabel? + (expression klabel-expression)) + + (define (ir2=?-sametype x y) (cond ((and (atom? x) (atom? y)) @@ -139,6 +162,21 @@ (and (ir1=? (update-ref x) (update-ref y)) (ir1=? (update-atom x) (update-atom y)) (= (update-continuation x) (update-continuation y)))) + ((and (branch? x) (branch? y)) + (and (ir1=? (branch-atom x) (branch-atom y)) + (= (branch-true x) (branch-true y)) + (= (branch-false x) (branch-false y)))) + ((and (call-closure? x) (call-closure? y)) + (let ((x-args (call-closure-args x)) + (y-args (call-closure-args y))) + (and (ir1=? (call-closure-closure x) (call-closure-closure y)) + (= (length x-args) (length y-args)) + (loop for x-arg in (call-closure-args x) + for y-arg in (call-closure-args y) + unless (ir1=? x-arg y-arg) + return #f + finally (return #t)) + (= (call-closure-continuation x) (call-closure-continuation y))))) ((and (ktail? x) (ktail? y)) #t) ((and (kargs? x) (kargs? y)) (let ((x-refs (kargs-refs x)) @@ -150,10 +188,8 @@ return #f finally (return #t)) (ir2=? (kargs-expression x) (kargs-expression y))))) - ((and (branch? x) (branch? y)) - (and (ir1=? (branch-atom x) (branch-atom y)) - (= (branch-true x) (branch-true y)) - (= (branch-false x) (branch-false y)))) + ((and (klabel? x) (klabel? y)) + (ir2=? (klabel-expression x) (klabel-expression y))) (else #f))) |