103 lines
4.3 KiB
Scheme
103 lines
4.3 KiB
Scheme
(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 (reset!)
|
|
(set! *a-out?* #t)
|
|
(set! *b-out?* #t)
|
|
(set! *c-out?* #t)
|
|
(set! *d-out?* #t)
|
|
(set! *e-out?* #t))
|
|
|
|
(define (is-a-out? ist) (display "setting a\n") (cons *a-out?* ist))
|
|
(define (is-b-out? . args) (display "setting b\n") (cons *b-out?* (last args)))
|
|
(define (is-c-out? . args) (display "setting c\n") (cons *c-out?* (last args)))
|
|
(define (is-d-out? . args) (display "setting d\n") (cons *d-out?* (last args)))
|
|
(define (is-e-out? . args) (display "setting e\n") (cons *e-out?* (last args)))
|
|
(define (is-f-out? . args) (display "setting f\n") (cons *f-out?* (last args)))
|
|
(define (is-g-out? . args) (display "setting f\n") (cons *g-out?* (last args)))
|
|
(define (is-h-out? . args) (display "setting f\n") (cons *h-out?* (last args)))
|
|
(define (is-i-out? . args) (display "setting f\n") (cons *i-out?* (last args)))
|
|
(define (is-j-out? . args) (display "setting f\n") (cons *j-out?* (last args)))
|
|
(define (is-k-out? . args) (display "setting f\n") (cons *k-out?* (last args)))
|
|
(define (is-l-out? . args) (display "setting f\n") (cons *l-out?* (last args)))
|
|
|
|
(define (build-a b? . args)
|
|
(display "a\n") (set! *a-out?* #f) (cons *a-out?* (last args)))
|
|
(define (build-b b? . args)
|
|
(display "b\n") (set! *b-out?* #f) (cons *b-out?* (last args)))
|
|
(define (build-c b? . args)
|
|
(display "c\n") (set! *c-out?* #f) (cons *c-out?* (last args)))
|
|
(define (build-d b? . args)
|
|
(display "d\n") (set! *d-out?* #f) (cons *d-out?* (last args)))
|
|
(define (build-e b? . args)
|
|
(display "e\n") (set! *e-out?* #f) (cons *e-out?* (last args)))
|
|
(define (build-f b? . args)
|
|
(display "f\n") (set! *f-out?* #f) (cons *f-out?* (last args)))
|
|
(define (build-g b? . args)
|
|
(display "g\n") (set! *g-out?* #f) (cons *g-out?* (last args)))
|
|
(define (build-h b? . args)
|
|
(display "h\n") (set! *h-out?* #f) (cons *h-out?* (last args)))
|
|
(define (build-i b? . args)
|
|
(display "i\n") (set! *i-out?* #f) (cons *i-out?* (last args)))
|
|
(define (build-j b? . args)
|
|
(display "j\n") (set! *j-out?* #f) (cons *j-out?* (last args)))
|
|
(define (build-k b? . args)
|
|
(display "k\n") (set! *k-out?* #f) (cons *k-out?* (last args)))
|
|
(define (build-l b? . args)
|
|
(display "l\n") (set! *l-out?* #f) (cons *l-out?* (last args)))
|
|
|
|
;(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 b) is-c-out? build-c))
|
|
;(define d (make-rule (list b) 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 'unset-rule-set)
|
|
|
|
(define (make!)
|
|
(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 b) is-c-out? build-c))
|
|
(define d (make-rule (list b) is-d-out? build-d))
|
|
(define e (make-rule (list b c d) is-e-out? build-e))
|
|
(define f (make-rule (list b c d e) is-f-out? build-f))
|
|
(define g (make-rule (list b c d e f) is-g-out? build-g))
|
|
(define h (make-rule (list 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))
|
|
(reset!)
|
|
(set! rule-set (make-rule-set rules (make-empty-rule-set)))
|
|
(rule-make l '() rule-set))
|
|
;(rule-make d '() rule-set)
|
|
;(rule-make e '() rule-set)
|
|
;(rule-make c '() rule-set)
|
|
|