]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/backtrack/backtrack.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / extra / backtrack / backtrack.factor
index 2b4c771c9365eab4032d76bfa0516db64bee24c2..a87a031e001f7b079df934d94da8f3729e282364 100644 (file)
@@ -1,81 +1,81 @@
-! 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