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

Port render-test-list.scm and helpers to use new-style units.

Browse Source 
svn: r5035
This commit is contained in:
Sam Tobin-Hochstadt 2006-12-05 22:51:47 +00:00
parent 3459c3a58f
commit 2b876b1f11
5 changed files with 1163 additions and 1166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,14 +8,14 @@
"render-helpers.ss" "render-helpers.ss"
"render-sigs.ss" "render-sigs.ss"
(lib "stx.ss" "syntax") (lib "stx.ss" "syntax")
(lib "unitsig.ss")) (lib "unit.ss"))
(require-for-template mzscheme (require-for-template mzscheme
"test-no-order.ss") "test-no-order.ss")
(define ddk-handlers@ (define-unit ddk-handlers@
(unit/sig ddk-handlers^ (import getbindings^ render-test-list^) (import getbindings^ render-test-list^)
(export ddk-handlers^)
;;!(function handle-end-ddk-list ;;!(function handle-end-ddk-list
;; (form (handle-end-ddk-list ae kf ks pat ;; (form (handle-end-ddk-list ae kf ks pat
@ -538,6 +538,6 @@
bv))))))))) bv)))))))))
;; end of ddk-handlers@ ;; end of ddk-handlers@
)) )
) )

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

@ -5,12 +5,13 @@
"update-binding-counts.scm" "update-binding-counts.scm"
"render-helpers.ss" "render-helpers.ss"
"render-sigs.ss" "render-sigs.ss"
(lib "unitsig.ss")) (lib "unit.ss"))
(require-for-template mzscheme) (require-for-template mzscheme)
(define getbindings@ (define-unit getbindings@
(unit/sig getbindings^ (import render-test-list^) (import render-test-list^)
(export getbindings^)
;;!(function next-outer ;;!(function next-outer
;; (form (next-outer p ae sf bv let-bound kf ks syntax bool) ;; (form (next-outer p ae sf bv let-bound kf ks syntax bool)
@ -123,5 +124,5 @@
cert))) cert)))
;; end getbindings@ ;; end getbindings@
)) )
) )

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

@ -1,5 +1,5 @@
(module render-sigs mzscheme (module render-sigs mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss"))
(provide (all-defined)) (provide (all-defined))

9
collects/mzlib/private/match/render-test-list-impl.ss
View File

@ -14,7 +14,7 @@
"render-helpers.ss") "render-helpers.ss")
(require "render-sigs.ss" (require "render-sigs.ss"
(lib "unitsig.ss")) (lib "unit.ss"))
(require-for-syntax "match-helper.ss" (require-for-syntax "match-helper.ss"
"match-expander-struct.ss" "match-expander-struct.ss"
@ -30,8 +30,9 @@
(define render-test-list@ (define-unit render-test-list@
(unit/sig render-test-list^ (import ddk-handlers^ getbindings^) (import ddk-handlers^ getbindings^)
(export render-test-list^)
;; some convenient syntax for make-reg-test and make-shape-test ;; some convenient syntax for make-reg-test and make-shape-test
(define make-test-gen (define make-test-gen
@ -606,6 +607,6 @@
"syntax error in pattern")])) "syntax error in pattern")]))
;; end of render-test-list@ ;; end of render-test-list@
)) )
) )

15
collects/mzlib/private/match/render-test-list.scm
View File

@ -7,18 +7,13 @@
"render-test-list-impl.ss" "render-test-list-impl.ss"
"getbindings.ss" "getbindings.ss"
"ddk-handlers.ss" "ddk-handlers.ss"
(lib "unitsig.ss")) (lib "unit.ss"))
(define rtl@ (define-compound-unit/infer rtl@
(compound-unit/sig
(import) (import)
(link (RTL : render-test-list^ (render-test-list@ DDK GET)) (export render-test-list^)
(GET : getbindings^ (getbindings@ RTL)) (link render-test-list@ getbindings@ ddk-handlers@))
(DDK : ddk-handlers^ (ddk-handlers@ GET RTL))
)
(export (var (RTL render-test-list)))
))
(define-values/invoke-unit/sig render-test-list^ rtl@) (define-values/invoke-unit/infer rtl@)
) )