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

Last change on this file since 34337 was 34337, checked in by kon, 22 months ago

expose more

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     ((amb-failure-continuation)) )
45    ((_ ?ls)
46     (amb-thunks (list-constantly ?ls)) ) ) )
47
48(define-syntax choose
49  (syntax-rules ()
50    ((_)
51     ((amb-failure-continuation)) )
52    ((_ ?ls)
53      (amb-thunks-shuffled (list-constantly ?ls) (amb-random-function)) ) ) )
54
55(define-syntax one-of
56  (syntax-rules ()
57    ((_ ?expr)
58      (amb-find ?expr) ) ) )
59
60(define-syntax all-of
61  (syntax-rules ()
62    ((_ ?expr)
63      (amb-collect ?expr) ) ) )
64
65(define-syntax required
66  (syntax-rules ()
67    ((_ ?expr)
68     (amb-assert ?expr) ) ) )
69
70;;
71
72(define (implies a b)
73  (or (not a) b) )
74
75(define (distinct? xs #!optional (eql? equal?))
76  (check-procedure 'distinct? eql? '=?)
77  (every
78    (lambda (t) (fx= 1 (count-member t xs eql?)))
79    (check-list 'distinct? xs 'list)) )
80
81;;;
82
83;;
84
85(define (count-member x xs #!optional (eql? equal?))
86  (count (cut eql? x <>) xs) )
87
88(define (list-constantly ls)
89  (map constantly ls) )
90
91) ;module amb-extras
Note: See TracBrowser for help on using the repository browser.