diff options
Diffstat (limited to 'csc/ir2.csc')
| -rw-r--r-- | csc/ir2.csc | 52 |
1 files changed, 42 insertions, 10 deletions
diff --git a/csc/ir2.csc b/csc/ir2.csc index fc31ce3..1872b65 100644 --- a/csc/ir2.csc +++ b/csc/ir2.csc @@ -10,6 +10,9 @@ call-closure-args call-closure-closure call-closure? + closure-cases + closure-continuation + closure? ir2=? kargs-expression kargs-refs @@ -17,12 +20,18 @@ klabel-expression klabel? ktail? + lambda-args-kargs + lambda-args-nargs + lambda-args-rest + lambda-args? make-atom make-branch make-call-closure + make-closure make-kargs make-klabel make-ktail + make-lambda-args make-update update-atom update-continuation @@ -61,6 +70,7 @@ make-lexical-ref make-lexical-set make-library-ref) + (only (csc list) all) (only (csc loop) loop return)) @@ -128,6 +138,26 @@ (continuation call-closure-continuation)) + ; One branch of a case-lambda. nargs encodes the number of required + ; arguments, and rest is a boolean indicating whether the function takes a + ; rest parameter. kargs is a continuation ID pointing to a + ; kargs continuation. + (define-record-type <lambda-args> + (make-lambda-args nargs rest kargs) + lambda-args? + (nargs lambda-args-nargs) + (rest lambda-args-rest) + (kargs lambda-args-kargs)) + + + ; A lambda expression. + (define-record-type <closure> + (make-closure cases continuation) + closure? + (cases closure-cases) + (continuation closure-continuation)) + + ; CPS continuations. @@ -171,22 +201,24 @@ (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)) + (all (lambda (x) x) (map ir1=? x-args y-args)) (= (call-closure-continuation x) (call-closure-continuation y))))) + ((and (lambda-args? x) (lambda-args? y)) + (and (= (lambda-args-nargs x) (lambda-args-nargs y)) + (boolean=? (lambda-args-rest x) (lambda-args-rest y)) + (= (lambda-args-kargs x) (lambda-args-kargs y)))) + ((and (closure? x) (closure? y)) + (let ((x-cases (closure-cases x)) + (y-cases (closure-cases y))) + (and (= (length x-cases) (length y-cases)) + (all (lambda (x) x) (map ir2=? x-cases y-cases)) + (= (closure-continuation x) (closure-continuation y))))) ((and (ktail? x) (ktail? y)) #t) ((and (kargs? x) (kargs? y)) (let ((x-refs (kargs-refs x)) (y-refs (kargs-refs y))) (and (= (length x-refs) (length y-refs)) - (loop for x-ref in x-refs - for y-ref in y-refs - unless (ir1=? x-ref y-ref) - return #f - finally (return #t)) + (all (lambda (x) x) (map ir1=? x-refs y-refs)) (ir2=? (kargs-expression x) (kargs-expression y))))) ((and (klabel? x) (klabel? y)) (ir2=? (klabel-expression x) (klabel-expression y))) |