suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed hiding bugs

Browse Source 
in case-lambda, fixed renaming bug
  in let-values and letrec-values, fixed hiding on errors
  fixed do-rename loop; now let bound-id=? works as expected!
Added hide.ss to debug.ss exports

svn: r4347
This commit is contained in:
Ryan Culpepper 2006-09-15 13:18:50 +00:00
parent 711690e959
commit 27ce8d0f3b
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/macro-debugger/model/debug.ss
View File

@ -3,6 +3,7 @@
(require (lib "plt-match.ss")) (require (lib "plt-match.ss"))
(require "trace.ss" (require "trace.ss"
"deriv-util.ss" "deriv-util.ss"
"hide.ss"
"hiding-policies.ss" "hiding-policies.ss"
"deriv.ss") "deriv.ss")
@ -10,6 +11,7 @@
(all-from "deriv.ss") (all-from "deriv.ss")
(all-from "deriv-util.ss") (all-from "deriv-util.ss")
(all-from "hiding-policies.ss") (all-from "hiding-policies.ss")
(all-from "hide.ss")
(all-from (lib "plt-match.ss")) (all-from (lib "plt-match.ss"))
find-deriv) find-deriv)

14
collects/macro-debugger/model/hide.ss
View File

@ -206,7 +206,7 @@
[for-bderiv BODY body]))] [for-bderiv BODY body]))]
[(AnyQ p:case-lambda (e1 e2 rs renames+bodies)) [(AnyQ p:case-lambda (e1 e2 rs renames+bodies))
(let ([var-renames (map car renames+bodies)]) (let ([var-renames (map caar renames+bodies)])
(>>P d (make-p:case-lambda renames+bodies) (>>P d (make-p:case-lambda renames+bodies)
(case-lambda [FORMALS . BODY] ...) (case-lambda [FORMALS . BODY] ...)
([for-renames (FORMALS ...) var-renames] ([for-renames (FORMALS ...) var-renames]
@ -221,7 +221,7 @@
[for-bderiv BODY body])))] [for-bderiv BODY body])))]
[(AnyQ p:letrec-values (e1 e2 rs renames rhss body)) [(AnyQ p:letrec-values (e1 e2 rs renames rhss body))
(let ([var-renames (map stx-car (stx-car renames))]) (let ([var-renames (if renames (map stx-car (stx-car renames)) null)])
(>>P d (make-p:letrec-values renames rhss body) (>>P d (make-p:letrec-values renames rhss body)
(letrec-values ([VARS RHS] ...) . BODY) (letrec-values ([VARS RHS] ...) . BODY)
([for-renames (VARS ...) var-renames] ([for-renames (VARS ...) var-renames]
@ -229,8 +229,8 @@
[for-bderiv BODY body])))] [for-bderiv BODY body])))]
[(AnyQ p:letrec-syntaxes+values (e1 e2 rs srenames srhss vrenames vrhss body)) [(AnyQ p:letrec-syntaxes+values (e1 e2 rs srenames srhss vrenames vrhss body))
(let ([svar-renames (map stx-car (stx-car srenames))] (let ([svar-renames (if srenames (map stx-car (stx-car srenames)) null)]
[vvar-renames (map stx-car (stx-car vrenames))]) [vvar-renames (if vrenames (map stx-car (stx-car vrenames)) null)])
(>>Pn d (make-p:letrec-syntaxes+values srenames srhss vrenames vrhss body) (>>Pn d (make-p:letrec-syntaxes+values srenames srhss vrenames vrhss body)
(letrec-syntaxes+values ([SVARS SRHS] ...) ([VVARS VRHS] ...) . BODY) (letrec-syntaxes+values ([SVARS SRHS] ...) ([VVARS VRHS] ...) . BODY)
([for-renames (SVARS ...) svar-renames] ([for-renames (SVARS ...) svar-renames]
@ -502,8 +502,8 @@
(loop (cdr clauses) (cdr renames+bodies))) (loop (cdr clauses) (cdr renames+bodies)))
null))))] null))))]
[(AnyQ p:let-values (e1 e2 rs renames rhss body)) [(AnyQ p:let-values (e1 e2 rs renames rhss body))
(>>Seek [#:append (map for-deriv rhss)] (>>Seek [#:rename (do-rename/let e1 renames)]
[#:rename (do-rename/let e1 renames)] [#:append (map for-deriv rhss)]
(for-bderiv body))] (for-bderiv body))]
[(AnyQ p:letrec-values (e1 e2 rs renames rhss body)) [(AnyQ p:letrec-values (e1 e2 rs renames rhss body))
(>>Seek [#:rename (do-rename/let e1 renames)] (>>Seek [#:rename (do-rename/let e1 renames)]
@ -1181,6 +1181,8 @@
(loop (syntax-e stx) (syntax-e rename) active?)))] (loop (syntax-e stx) (syntax-e rename) active?)))]
[(syntax? rename) [(syntax? rename)
(loop stx (syntax-e rename) active?)] (loop stx (syntax-e rename) active?)]
[(syntax? stx)
(loop (syntax-e stx) rename active?)]
[(and (pair? stx) (pair? rename)) [(and (pair? stx) (pair? rename))
(append (append
(loop (car stx) (car rename) active?) (loop (car stx) (car rename) active?)