Fixed case-lambda reductions bug
Removed let*-values prule, faked as mrule Suppressed copies of warning messages svn: r4246 original commit: 1a2eea24ad962e4906c3231127f4a9e3a9d207b6
This commit is contained in:
parent
cbf83f809b
commit
d75f99286b
|
@ -51,8 +51,6 @@
|
|||
(apply append (map loop (map cdr (or rbs null))))]
|
||||
[(AnyQ p:let-values (_ _ _ _ rhss body))
|
||||
(append (loops rhss) (loop body))]
|
||||
[(AnyQ p:let*-values (_ _ _ inner))
|
||||
(loop inner)]
|
||||
[(AnyQ p:letrec-values (_ _ _ _ rhss body))
|
||||
(append (loops rhss) (loop body))]
|
||||
[(AnyQ p:letrec-syntaxes+values (_ _ _ _ srhss _ vrhss body))
|
||||
|
|
|
@ -50,7 +50,6 @@
|
|||
(define-struct (p:lambda prule) (renames body) #f)
|
||||
(define-struct (p:case-lambda prule) (renames+bodies) #f)
|
||||
(define-struct (p:let-values prule) (renames rhss body) #f)
|
||||
(define-struct (p:let*-values prule) (inner) #f)
|
||||
(define-struct (p:letrec-values prule) (renames rhss body) #f)
|
||||
(define-struct (p:letrec-syntaxes+values prule) (srenames srhss vrenames vrhss body) #f)
|
||||
|
||||
|
|
|
@ -3,6 +3,7 @@
|
|||
(require "yacc-ext.ss"
|
||||
"yacc-interrupted.ss"
|
||||
"deriv.ss"
|
||||
"deriv-util.ss"
|
||||
"deriv-tokens.ss")
|
||||
(provide parse-derivation)
|
||||
|
||||
|
@ -340,7 +341,8 @@
|
|||
(#:args e1 e2 rs)
|
||||
;; let*-values with bindings is "macro-like"
|
||||
[(prim-let*-values ! (? EE))
|
||||
(make-p:let*-values e1 e2 rs $3)]
|
||||
(let ([next-e1 (lift/deriv-e1 $3)])
|
||||
(make-mrule e1 e2 (make-transformation e1 next-e1 rs e1 next-e1 null) $3))]
|
||||
;; No bindings... model as "let"
|
||||
[(prim-let*-values NoError renames-let (? NextEEs 'rhss) next-group (? EB 'body))
|
||||
(make-p:let-values e1 e2 rs $3 $4 $6)])
|
||||
|
|
|
@ -108,7 +108,6 @@
|
|||
(struct p:lambda (renames body))
|
||||
(struct p:case-lambda (renames+bodies))
|
||||
(struct p:let-values (renames body))
|
||||
(struct p:let*-values (inner))
|
||||
(struct p:letrec-values (renames rhss body))
|
||||
(struct p:letrec-syntaxes+values (srenames srhss vrenames vrhss body))
|
||||
(struct p:module (body))
|
||||
|
|
|
@ -179,9 +179,7 @@
|
|||
[Expr (?vrhs ...) vrhss]
|
||||
[Block ?body body]
|
||||
=> (lambda (mid)
|
||||
(if (eq? mid e2)
|
||||
null
|
||||
(list (walk mid e2 "Remove syntax bindings")))))]
|
||||
(list (walk mid e2 "Remove syntax bindings"))))]
|
||||
;; The auto-tagged atomic primitives
|
||||
[(AnyQ p:#%datum (e1 e2 rs tagged-stx) exni)
|
||||
(append (if (eq? e1 tagged-stx)
|
||||
|
|
Loading…
Reference in New Issue
Block a user