diff options
| -rw-r--r-- | csc/cps-test.csc | 18 | ||||
| -rw-r--r-- | csc/cps.csc | 8 | ||||
| -rw-r--r-- | csc/ir2.csc | 100 |
3 files changed, 57 insertions, 69 deletions
diff --git a/csc/cps-test.csc b/csc/cps-test.csc new file mode 100644 index 0000000..dd66078 --- /dev/null +++ b/csc/cps-test.csc @@ -0,0 +1,18 @@ +(import (scheme base) + (only (csc ir2) + ir2=? + make-atom + make-tail + make-constant) + (only (csc testing) + assert-equal + test) + (csc cps)) + + +(test atom-const + (assert-equal ir2=? + (make-atom + (make-constant 5) + (make-tail)) + (ir1->ir2 (make-constant 5)))) diff --git a/csc/cps.csc b/csc/cps.csc index 561a698..bd4f088 100644 --- a/csc/cps.csc +++ b/csc/cps.csc @@ -1,16 +1,19 @@ (define-library (csc cps) + (export + ir1->ir2) (import (only (csc ir1) make-constant constant? lexical-ref? library-ref?) (only (csc ir2) - (make-atom)) + make-atom + make-tail) (scheme base)) (begin - (define (to-cps expr k) + (define (to-cps expr continuation) (cond ((or (constant? expr) (lexical-ref? expr) @@ -20,3 +23,4 @@ (define (ir1->ir2 program) + (to-cps program (make-tail))))) diff --git a/csc/ir2.csc b/csc/ir2.csc index 46dbad1..708d7b1 100644 --- a/csc/ir2.csc +++ b/csc/ir2.csc @@ -1,74 +1,30 @@ (define-library (csc ir2) (export - lambda-body - lambda-case-alternate - lambda-case-arguments - lambda-case-body - lambda-case-gensyms - lambda-case-rest - lambda-case? - make-lambda-case + atom-continuation + atom-expression + atom? + ir2=? + make-atom + make-tail + tail? ; Re-exports from IR1. - call-arguments - call-procedure - call? constant-expression constant? - if-alternate - if-consequent - if-test - if? - lambda? - make-call - make-constant - make-if - make-lambda - make-sequence - make-toplevel-define - make-toplevel-ref - make-void - sequence-head - sequence-tail - sequence? - toplevel-define-expression - toplevel-define-name - toplevel-define? - toplevel-ref-name - toplevel-ref? - void?) + make-constant) (import (scheme base) (only (csc ir1) - call-arguments - call-procedure - call? - constant-expression constant? - if-alternate - if-consequent - if-test - if? - lambda-body - lambda? - make-call - make-constant - make-if - make-lambda - make-sequence - make-toplevel-define - make-void - sequence-head - sequence-tail - sequence? - toplevel-define-expression - toplevel-define-name - toplevel-define? - void?)) + ir1=? + make-constant)) (begin ; This library defines the intermediate representation IR2. ; It's CPS time bitch. + ; CPS expressions. + + ; An atom consists of an ir1 expression and a continuation. (define-record-type <atom> (make-atom expression continuation) @@ -77,17 +33,27 @@ (continuation atom-continuation)) - ; <variable> - (define-record-type <variable> - (make-variable k var + ; CPS continuations. + + + ; tail is the tail continuation. + (define-record-type <tail> + (make-tail) + tail?) - ; <closure-ref> idx - ; Reference to a variable by index in the closure. - (define-record-type <closure-ref> - (make-closure-ref idx) - closure-ref? - (idx closure-ref-index)) + (define (ir2=?-sametype x y) + (cond + ((and (atom? x) (atom? y)) + (and (ir1=? (atom-expression x) (atom-expression y)) + (ir2=? (atom-continuation x) (atom-continuation y)))) + ((and (tail? x) (tail? y)) #t) + (else #f))) - ; <lambda-case> arguments rest + (define (ir2=? x y) + (cond + ((ir2=?-sametype x y) #t) + ((and (ir2=?-sametype x x) (ir2=?-sametype y y)) + #f) + (else (error "One or more arguments has a type unknown to ir2=?" x y)))))) |