scsh-conservatory
/
scsh-make
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

testfile for make-rule-cml.

This commit is contained in:
jottbee 2005-02-21 05:13:27 +00:00
parent 376d5499e6
commit 8cc73cb7ea
1 changed files with 67 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
test-make-rule.scm Normal file
View File

@ -0,0 +1,67 @@
(define *a-out?* #t)
(define *b-out?* #t)
(define *c-out?* #t)
(define *d-out?* #t)
(define *e-out?* #t)
(define *f-out?* #t)
(define *g-out?* #t)
(define *h-out?* #t)
(define *i-out?* #t)
(define *j-out?* #t)
(define *k-out?* #t)
(define *l-out?* #t)
(define (is-a-out? ist) (display "setting a\n") (cons *a-out?* ist))
(define (is-b-out? pa ist) (display "setting b\n") (cons *b-out?* ist))
(define (is-c-out? pa pb ist) (display "setting c\n") (cons *c-out?* ist))
(define (is-d-out? pa pb pc ist) (display "setting d\n") (cons *d-out?* ist))
(define (is-e-out? pc pd ist) (display "setting e\n") (cons *e-out?* ist))
(define (is-f-out? pa pb pc pd pe ist) (cons *f-out?* ist))
(define (is-g-out? pa pb pc pd pe pf ist) (cons *g-out?* ist))
(define (is-h-out? pa pb pc pd pe pf pg ist) (cons *h-out?* ist))
(define (is-i-out? pa pb pc pd pe pf pg ph ist) (cons *i-out?* ist))
(define (is-j-out? pa pb pc pd pe pf pg ph pi ist) (cons *j-out?* ist))
(define (is-k-out? pa pb pc pd pe pf pg ph pi pj ist) (cons *k-out?* ist))
(define (is-l-out? pa pb pc pd pe pf pg ph pi pj pk ist) (cons *l-out?* ist))
(define (build-a b? ist) (display "a\n") (set! *a-out?* #f) (cons *a-out?* ist))
(define (build-b b? pa ist) (display "b\n") (set! *b-out?* #f) (cons *b-out?* ist))
(define (build-c b? pa pb ist) (display "c\n") (set! *c-out?* #f) (cons *c-out?* ist))
(define (build-d b? pa pb pc ist) (display "d\n") (set! *d-out?* #f) (cons *d-out?* ist))
(define (build-e b? pc pd ist) (display "e\n") (set! *e-out?* #f) (cons *e-out?* ist))
(define (build-f b? pa pb pc pd pe ist) (display "f\n") (set! *f-out?* #f) (cons *f-out?* ist))
(define (build-g b? pa pb pc pd pe pf ist) (display "g\n") (set! *g-out?* #f) (cons *g-out?* ist))
(define (build-h b? pa pb pc pd pe pf pg ist) (display "h\n") (set! *h-out?* #f) (cons *h-out?* ist))
(define (build-i b? pa pb pc pd pe pf pg ph ist) (display "i\n") (set! *i-out?* #f) (cons *i-out?* ist))
(define (build-j b? pa pb pc pd pe pf pg ph pi ist) (display "j\n") (set! *j-out?* #f) (cons *j-out?* ist))
(define (build-k b? pa pb pc pd pe pf pg ph pi pj ist) (display "k\n") (set! *k-out?* #f) (cons *k-out?* ist))
(define (build-l b? pa pb pc pd pe pf pg ph pi pj pk ist) (display "l\n") (set! *l-out?* #f) (cons *l-out?* ist))
(define a (make-rule (list) is-a-out? build-a))
(define b (make-rule (list a) is-b-out? build-b))
(define c (make-rule (list a b) is-c-out? build-c))
(define d (make-rule (list a b c) is-d-out? build-d))
(define e (make-rule (list c d) is-e-out? build-e))
;(define f (make-rule (list a b c d e) is-f-out? build-f))
;(define g (make-rule (list a b c d e f) is-g-out? build-g))
;(define h (make-rule (list a b c d e f g) is-h-out? build-h))
;(define i (make-rule (list a b c d e f g h) is-i-out? build-i))
;(define j (make-rule (list a b c d e f g h i) is-j-out? build-j))
;(define k (make-rule (list a b c d e f g h i j) is-k-out? build-k))
;(define l (make-rule (list a b c d e f g h i j k) is-l-out? build-l))
;(define rules (list a b c d e f g h i j k l))
(define rules (list a b c d e))
(define (make-rule-set rules rule-set)
(cond
((null? rules) rule-set)
(else (make-rule-set (cdr rules) (rule-set-add (car rules) rule-set)))))
(define rule-set (make-rule-set rules (make-empty-rule-set)))
(rule-make e '() rule-set)
(rule-make d '() rule-set)
(rule-make e '() rule-set)
(rule-make c '() rule-set)