1 ! Copyright (C) 2008 William Schlieper
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
4 USING: kernel continuations combinators sequences quotations arrays namespaces
\r
5 fry summary assocs math math.order macros ;
\r
10 V{ } failure set-global
\r
12 ERROR: amb-failure ;
\r
14 M: amb-failure summary drop "Backtracking failure" ;
\r
17 failure get dup empty? [ amb-failure ]
\r
18 [ pop continue ] if ;
\r
23 MACRO: checkpoint ( quot -- quot' )
\r
24 '[ [ '[ failure get push , continue ] callcc0 @ ] callcc0 ] ;
\r
26 : number-from ( from -- from+n )
\r
27 [ 1 + number-from ] checkpoint ;
\r
31 : number-from-to ( to from -- to from+n )
\r
35 { +gt+ [ [ 1 + number-from-to ] checkpoint ] } } case ;
\r
37 : amb-integer ( seq -- int )
\r
38 length 1 - 0 number-from-to nip ;
\r
42 : amb-lazy ( seq -- elt )
\r
43 [ amb-integer ] [ nth ] bi ;
\r
45 MACRO: amb ( seq -- quot )
\r
47 { { 0 [ drop [ fail f ] ] }
\r
48 { 1 [ first 1quotation ] }
\r
49 [ drop [ first ] [ rest ] bi
\r
50 '[ , [ drop , amb ] checkpoint ] ] } case ;
\r
52 MACRO: amb-execute ( seq -- quot )
\r
53 [ length ] [ <enum> [ 1quotation ] assoc-map ] bi
\r
56 : if-amb ( true false -- )
\r
59 [ '[ @ require t ] ]
\r
62 ] with-scope ; inline
\r