-! Copyright (C) 2008 William Schlieper\r
-! See http://factorcode.org/license.txt for BSD license.\r
-\r
-USING: assocs combinators continuations fry kernel macros math\r
-namespaces quotations sequences summary ;\r
-\r
-IN: backtrack\r
-\r
-SYMBOL: failure\r
-\r
-ERROR: amb-failure ;\r
-\r
-M: amb-failure summary drop "Backtracking failure" ;\r
-\r
-: fail ( -- )\r
- failure get [ continue ] [ amb-failure ] if* ;\r
-\r
-: must-be-true ( ? -- )\r
- [ fail ] unless ;\r
-\r
-MACRO: checkpoint ( quot -- quot' )\r
- '[\r
- failure get _ '[\r
- '[ failure set _ continue ] callcc0\r
- _ failure set @\r
- ] callcc0\r
- ] ;\r
-\r
-: number-from ( from -- from+n )\r
- [ 1 + number-from ] checkpoint ;\r
-\r
-<PRIVATE\r
-\r
-: preserve ( quot var -- ) [ get [ call ] dip ] keep set ; inline\r
-\r
-: amb-preserve ( quot -- ) failure preserve ; inline\r
-\r
-: unsafe-number-from-to ( to from -- to from+n )\r
- 2dup = [ [ 1 + unsafe-number-from-to ] checkpoint ] unless ;\r
-\r
-: number-from-to ( to from -- to from+n )\r
- 2dup < [ fail ] when unsafe-number-from-to ;\r
-\r
-: amb-integer ( seq -- int )\r
- length 1 - 0 number-from-to nip ;\r
-\r
-MACRO: unsafe-amb ( seq -- quot )\r
- dup length 1 = [\r
- first 1quotation\r
- ] [\r
- unclip swap '[ _ [ drop _ unsafe-amb ] checkpoint ]\r
- ] if ;\r
-\r
-PRIVATE> \r
-\r
-: amb-lazy ( seq -- elt )\r
- [ amb-integer ] [ nth ] bi ;\r
-\r
-: amb ( seq -- elt )\r
- [ fail f ] [ unsafe-amb ] if-empty ; inline\r
-\r
-MACRO: amb-execute ( seq -- quot )\r
- [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi\r
- '[ _ 0 unsafe-number-from-to nip _ case ] ;\r
-\r
-: if-amb ( true false -- ? )\r
- [\r
- [ { t f } amb ]\r
- [ '[ @ must-be-true t ] ]\r
- [ '[ @ f ] ]\r
- tri* if\r
- ] amb-preserve ; inline\r
-\r
-: cut-amb ( -- )\r
- f failure set ;\r
-\r
-: amb-all ( quot -- )\r
- [ { t f } amb [ call fail ] [ drop ] if ] amb-preserve ; inline\r
-\r
-: bag-of ( quot -- seq )\r
- V{ } clone [ '[ @ _ push ] amb-all ] keep ; inline\r
+! Copyright (C) 2008 William Schlieper
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: assocs combinators continuations fry kernel macros math
+namespaces quotations sequences summary ;
+
+IN: backtrack
+
+SYMBOL: failure
+
+ERROR: amb-failure ;
+
+M: amb-failure summary drop "Backtracking failure" ;
+
+: fail ( -- )
+ failure get [ continue ] [ amb-failure ] if* ;
+
+: must-be-true ( ? -- )
+ [ fail ] unless ;
+
+MACRO: checkpoint ( quot -- quot' )
+ '[
+ failure get _ '[
+ '[ failure set _ continue ] callcc0
+ _ failure set @
+ ] callcc0
+ ] ;
+
+: number-from ( from -- from+n )
+ [ 1 + number-from ] checkpoint ;
+
+<PRIVATE
+
+: preserve ( quot var -- ) [ get [ call ] dip ] keep set ; inline
+
+: amb-preserve ( quot -- ) failure preserve ; inline
+
+: unsafe-number-from-to ( to from -- to from+n )
+ 2dup = [ [ 1 + unsafe-number-from-to ] checkpoint ] unless ;
+
+: number-from-to ( to from -- to from+n )
+ 2dup < [ fail ] when unsafe-number-from-to ;
+
+: amb-integer ( seq -- int )
+ length 1 - 0 number-from-to nip ;
+
+MACRO: unsafe-amb ( seq -- quot )
+ dup length 1 = [
+ first 1quotation
+ ] [
+ unclip swap '[ _ [ drop _ unsafe-amb ] checkpoint ]
+ ] if ;
+
+PRIVATE>
+
+: amb-lazy ( seq -- elt )
+ [ amb-integer ] [ nth ] bi ;
+
+: amb ( seq -- elt )
+ [ fail f ] [ unsafe-amb ] if-empty ; inline
+
+MACRO: amb-execute ( seq -- quot )
+ [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi
+ '[ _ 0 unsafe-number-from-to nip _ case ] ;
+
+: if-amb ( true false -- ? )
+ [
+ [ { t f } amb ]
+ [ '[ @ must-be-true t ] ]
+ [ '[ @ f ] ]
+ tri* if
+ ] amb-preserve ; inline
+
+: cut-amb ( -- )
+ f failure set ;
+
+: amb-all ( quot -- )
+ [ { t f } amb [ call fail ] [ drop ] if ] amb-preserve ; inline
+
+: bag-of ( quot -- seq )
+ V{ } clone [ '[ @ _ push ] amb-all ] keep ; inline