diff options
Diffstat (limited to 'csc/ir1.csc')
| -rw-r--r-- | csc/ir1.csc | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/csc/ir1.csc b/csc/ir1.csc index 3826c34..59911ab 100644 --- a/csc/ir1.csc +++ b/csc/ir1.csc @@ -161,7 +161,7 @@ ; corresponding to all arguments: first all of the normal arguments, then ; the rest argument if any. ; - ; body is the name of the clause. If the procedure is called with an + ; body is the name of the clause (??). If the procedure is called with an ; appropriate number of arguments, body is evaluated in tail position. ; Otherwise if there is an alternate, it should be a <lambda-case> ; expression, representing the next clause to try. If alternate is nil, an @@ -191,7 +191,7 @@ (expression letrec-expression)) - (define (ir1=? x y) + (define (ir1=?-sametype x y) (cond ((and (void? x) (void? y)) #t) ((and (constant? x) (constant? y)) @@ -233,8 +233,8 @@ (equal? (lambda-case-arguments x) (lambda-case-arguments y)) (eq? (lambda-case-rest x) (lambda-case-rest y)) (ir1=? (lambda-case-body x) (lambda-case-body y)) - (or (and (not (lambda-case-alternate x)) - (not (lambda-case-alternate y))) + (or (and (null? (lambda-case-alternate x)) + (null? (lambda-case-alternate y))) (ir1=? (lambda-case-alternate x) (lambda-case-alternate y))))) ((and (letrec? x) (letrec? y)) (and @@ -246,6 +246,12 @@ unless (ir1=? x-val y-val) return #f finally (return #t)) (ir1=? (letrec-expression x) (letrec-expression y)))) - ((and (ir1=? x x) (ir1=? y y)) + (else #f))) + + + (define (ir1=? x y) + (cond + ((ir1=?-sametype x y) #t) + ((and (ir1=?-sametype x x) (ir1=?-sametype y y)) #f) (else (error "One or more arguments has a type unknown to ir1=?" x y)))))) |