1 ! Copyright (C) 2008 William Schlieper
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: assocs combinators continuations fry kernel macros math
5 namespaces quotations sequences summary ;
13 M: amb-failure summary drop "Backtracking failure" ;
16 failure get [ continue ] [ amb-failure ] if* ;
18 : must-be-true ( ? -- )
21 MACRO: checkpoint ( quot -- quot' )
24 '[ failure set _ continue ] callcc0
29 : number-from ( from -- from+n )
30 [ 1 + number-from ] checkpoint ;
34 : preserve ( quot var -- ) [ get [ call ] dip ] keep set ; inline
36 : amb-preserve ( quot -- ) failure preserve ; inline
38 : unsafe-number-from-to ( to from -- to from+n )
39 2dup = [ [ 1 + unsafe-number-from-to ] checkpoint ] unless ;
41 : number-from-to ( to from -- to from+n )
42 2dup < [ fail ] when unsafe-number-from-to ;
44 : amb-integer ( seq -- int )
45 length 1 - 0 number-from-to nip ;
47 MACRO: unsafe-amb ( seq -- quot )
51 unclip swap '[ _ [ drop _ unsafe-amb ] checkpoint ]
56 : amb-lazy ( seq -- elt )
57 [ amb-integer ] [ nth ] bi ;
60 [ fail f ] [ unsafe-amb ] if-empty ; inline
62 MACRO: amb-execute ( seq -- quot )
63 [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi
64 '[ _ 0 unsafe-number-from-to nip _ case ] ;
66 : if-amb ( true false -- ? )
69 [ '[ @ must-be-true t ] ]
72 ] amb-preserve ; inline
78 [ { t f } amb [ call fail ] [ drop ] if ] amb-preserve ; inline
80 : bag-of ( quot -- seq )
81 V{ } clone [ '[ @ _ push ] amb-all ] keep ; inline