source: project/release/4/amb/trunk/amb-extras.scm @ 34422

Last change on this file since 34422 was 34422, checked in by kon, 4 months ago

comments

File size: 1.5 KB
Line 
1;;;; amb-extras.scm
2;;;; Kon Lovett, Mar '09
3;;;; Kon Lovett, Mar '17
4;;;; Kon Lovett, Aug '17
5
6(module amb-extras
7
8(;export
9  amb1
10  choose
11  one-of
12  all-of
13  required
14  implies
15  distinct?
16  ;
17  count-member
18  list-constantly)
19
20(import scheme)
21
22(import chicken)
23
24(import
25  (only extras random)
26  (only data-structures sort! constantly))
27(require-library extras data-structures)
28
29(import (only (srfi 1) count every))
30(require-library (srfi 1))
31
32(import (only type-checks check-list check-procedure))
33(require-library type-checks)
34
35(require-extension amb)
36
37;;;
38
39;;
40
41(define-syntax amb1
42  (syntax-rules ()
43    ;
44    ((_)
45     ((amb-failure-continuation)) )
46    ;
47    ((_ ?ls)
48     (amb-thunks (list-constantly ?ls)) ) ) )
49
50(define-syntax choose
51  (syntax-rules ()
52    ;
53    ((_)
54     ((amb-failure-continuation)) )
55    ;
56    ((_ ?ls)
57      (amb-thunks-shuffled (list-constantly ?ls) (amb-random-function)) ) ) )
58
59(define-syntax one-of
60  (syntax-rules ()
61    ((_ ?expr)
62      (amb-find ?expr) ) ) )
63
64(define-syntax all-of
65  (syntax-rules ()
66    ((_ ?expr)
67      (amb-collect ?expr) ) ) )
68
69(define-syntax required
70  (syntax-rules ()
71    ((_ ?expr)
72     (amb-assert ?expr) ) ) )
73
74;;
75
76(define (implies a b)
77  (or (not a) b) )
78
79(define (distinct? xs #!optional (eql? equal?))
80  (check-procedure 'distinct? eql? '=?)
81  (every
82    (lambda (t) (fx= 1 (count-member t xs eql?)))
83    (check-list 'distinct? xs 'list)) )
84
85;;;
86
87;;
88
89(define (count-member x xs #!optional (eql? equal?))
90  (count (cut eql? x <>) xs) )
91
92(define (list-constantly ls)
93  (map constantly ls) )
94
95) ;module amb-extras
Note: See TracBrowser for help on using the repository browser.