diff --git a/extra/backtrack/backtrack-docs.factor b/extra/backtrack/backtrack-docs.factor new file mode 100644 index 0000000000..c654ac234f --- /dev/null +++ b/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 } ; \ No newline at end of file diff --git a/extra/backtrack/backtrack-tests.factor b/extra/backtrack/backtrack-tests.factor new file mode 100644 index 0000000000..d8e9830532 --- /dev/null +++ b/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 diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor index 9bef16d609..e4e13c3363 100755 --- a/extra/backtrack/backtrack.factor +++ b/extra/backtrack/backtrack.factor @@ -29,6 +29,10 @@ MACRO: checkpoint ( quot -- quot' ) [ 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