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

Use let-bound identifiers properly for handle-end-ddk-list.

Browse Source 
svn: r8372
This commit is contained in:
Sam Tobin-Hochstadt 2008-01-20 14:36:32 +00:00
parent f2c9c59b06
commit f951cac011
3 changed files with 35 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mzlib/private/match/ddk-handlers.ss
View File

@ -93,7 +93,7 @@
bv)) bv))
#,(let ([new-var (gensym 'exp)]) #,(let ([new-var (gensym 'exp)])
#`(let ([#,new-var (car #,exp-name)]) #`(let ([#,new-var (car #,exp-name)])
#,(next-outer #'the-pat #,(next-outer* #'the-pat
#`#,new-var #`#,new-var
sf sf
;(append (map cons bound new-vars) bv) ;(append (map cons bound new-vars) bv)
@ -103,19 +103,26 @@
;; bindings ;; bindings
let-bound let-bound
kf kf
(lambda (let-bound)
(lambda (sf bv) (lambda (sf bv)
;(printf "let-bound is: ~a~n" let-bound)
;(printf "bv is: ~a ~a~n"
; (map syntax-e (map car bv))
; (map syntax-object->datum (map cdr bv)))
#`(#,loop-name #`(#,loop-name
(cdr #,exp-name) (cdr #,exp-name)
#,@(map #,@(map
(lambda (lambda
(b-var (b-var
bindings-var) bindings-var)
(subst-bindings
#`(cons #`(cons
#,(get-bind-val #,(get-bind-val
b-var b-var
bv) bv)
#,bindings-var)) #,bindings-var)
bound binding-list-names))) let-bound))
bound binding-list-names))))
cert))))))])))) cert))))))]))))
(define (new-emit f) (emit f ae let-bound sf bv kf ksucc)) (define (new-emit f) (emit f ae let-bound sf bv kf ksucc))
(case k (case k

13
collects/mzlib/private/match/getbindings.ss
View File

@ -41,6 +41,19 @@
(next-outer-helper p ae sf bv let-bound (next-outer-helper p ae sf bv let-bound
(lambda (x) kf) (lambda (a b) ks) cert stx)) (lambda (x) kf) (lambda (a b) ks) cert stx))
(define/opt (next-outer*
p
ae ;; this is the actual expression
sf
bv
let-bound
kf
ks
cert
[stx (syntax '())])
(next-outer-helper p ae sf bv let-bound
(lambda (x) kf) (lambda (a b) (ks b)) cert stx))
;;!(function next-outer-helper ;;!(function next-outer-helper
;; (form (next-outer p ae sf bv let-bound kf-func ks-func syntax bool) ;; (form (next-outer p ae sf bv let-bound kf-func ks-func syntax bool)
;; -> ;; ->

2
collects/mzlib/private/match/render-sigs.ss
View File

@ -7,6 +7,6 @@
(define-signature ddk-handlers^ (handle-end-ddk-list handle-inner-ddk-list handle-ddk-vector handle-ddk-vector-inner)) (define-signature ddk-handlers^ (handle-end-ddk-list handle-inner-ddk-list handle-ddk-vector handle-ddk-vector-inner))
(define-signature getbindings^ (getbindings create-test-func next-outer)) (define-signature getbindings^ (getbindings create-test-func next-outer next-outer*))
) )