Merge branch 'master' of git://factorcode.org/git/factor

extra/backtrack/backtrack-docs.factor

@@ -0,0 +1,53 @@
+! Copyright (c) 2009 Samuel Tardieu.
+! See See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: backtrack
+
+HELP: fail
+{ $description "Signal that the current alternative is not acceptable. This will cause either backtracking to occur, or a failure to be signalled, as explained in the " { $link amb } " word description." }
+{ $see-also amb cut-amb }
+;
+
+HELP: amb
+{ $values
+  { "seq" "the alternatives" }
+  { "elt" "one of the alternatives" }
+}
+{ $description "The amb (ambiguous) word saves the state of the current computation (through the " { $vocab-link "continuations" } " vocabulary) and returns the first alternative. When " { $link fail } " is invoked, the saved state will be restored and the next alternative will be returned. When there are no more alternatives, " { $link fail } " will go up one level to the location of the previous " { $link amb } " call. If there are no more calls up the chain, an error will be signalled." }
+{ $see-also fail cut-amb }
+;
+
+HELP: cut-amb
+{ $description "Reset the amb system. Calling this word resets the whole stack of " { $link amb } " calls and should not be done lightly."}
+{ $see-also amb fail }
+;
+
+HELP: amb-execute
+{ $values
+  { "seq" "a list of words" }
+}
+{ $description "Execute the first word in the list, and go to the next one if " { $link fail } " is called." } ;
+
+HELP: if-amb
+{ $values
+  { "true" "a quotation with stack effect ( -- ? )" }
+  { "false" "a quotation" }
+  { "?" "a boolean" }
+}
+{ $description "Execute the first quotation and returns " { $link t } " if it returns " { $link t } " itself. If it fails with " { $link fail } " or returns " { $link f } ", then the second quotation is executed and " { $link f } " is returned." } ;
+
+HELP: amb-all
+{ $values
+  { "quot" "a quotation with stack effect ( -- )" }
+}
+{ $description "Execute all the alternatives in the quotation by calling " { $link fail } " repeatedly at the end." }
+{ $see-also bag-of fail }
+;
+
+HELP: bag-of
+{ $values
+  { "quot" "a quotation with stack effect ( -- result )" }
+  { "seq" "a sequence" }
+}
+{ $description "Execute all the alternatives in the quotation and collect the results." }
+{ $see-also amb-all } ;

extra/backtrack/backtrack-tests.factor

@@ -0,0 +1,15 @@
+! Copyright (c) 2009 Samuel Tardieu.
+! See See http://factorcode.org/license.txt for BSD license.
+USING: backtrack math tools.test ;
+
+cut-amb
+[ 1 ] [ { 1 2 } amb ] unit-test
+[ V{ { 1 2 } } ] [ [ { 1 2 } ] bag-of ] unit-test
+[ V{ 1 2 } ] [ [ { 1 2 } amb ] bag-of ] unit-test
+[ cut-amb { } amb ] must-fail
+[ fail ] must-fail
+[ V{ 1 10 2 20 } ] [ [ { 1 2 } amb { 1 10 } amb * ] bag-of ] unit-test
+[ V{ 7 -1 } ] [ [ 3 4 { + - } amb-execute ] bag-of ] unit-test
+[ "foo" t ] [ [ "foo" t ] [ "bar" ] if-amb ] unit-test
+[ "bar" f ] [ [ "foo" f ] [ "bar" ] if-amb ] unit-test
+[ "bar" f ] [ [ "foo" fail ] [ "bar" ] if-amb ] unit-test

extra/backtrack/backtrack.factor

@@ -29,6 +29,10 @@ MACRO: checkpoint ( quot -- quot' )
 
 <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 ;
 
@@ -57,13 +61,19 @@ MACRO: amb-execute ( seq -- quot )
     [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi
     '[ _ 0 unsafe-number-from-to nip _ case ] ;
 
-: if-amb ( true false -- )
+: if-amb ( true false -- ? )
     [
         [ { t f } amb ]
         [ '[ @ require t ] ]
         [ '[ @ f ] ]
         tri* if
-    ] with-scope ; inline
+    ] 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