]> gitweb.factorcode.org Git - factor.git/commitdiff
backtrack: some cleanup.
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 2 Jun 2015 02:46:08 +0000 (19:46 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 2 Jun 2015 02:46:08 +0000 (19:46 -0700)
extra/backtrack/backtrack.factor

index e4e13c3363ae4328b363f59bb301c8b2c1999515..27c40b637fcf9026a02bd264b52867725815acdb 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 William Schlieper\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 \r
-USING: kernel continuations combinators sequences quotations arrays namespaces\r
-       fry summary assocs math math.order macros ;\r
+USING: assocs combinators continuations fry kernel macros math\r
+namespaces quotations sequences summary ;\r
 \r
 IN: backtrack\r
 \r
@@ -13,16 +13,18 @@ ERROR: amb-failure ;
 M: amb-failure summary drop "Backtracking failure" ;\r
 \r
 : fail ( -- )\r
-    failure get [ continue ]\r
-    [ amb-failure ] if* ;\r
+    failure get [ continue ] [ amb-failure ] if* ;\r
 \r
 : require ( ? -- )\r
     [ fail ] unless ;\r
 \r
 MACRO: checkpoint ( quot -- quot' )\r
-    '[ failure get _\r
-       '[ '[ failure set _ continue ] callcc0\r
-          _ failure set @ ] callcc0 ] ;\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
@@ -43,10 +45,11 @@ MACRO: checkpoint ( quot -- quot' )
     length 1 - 0 number-from-to nip ;\r
 \r
 MACRO: unsafe-amb ( seq -- quot )\r
-    dup length 1 =\r
-    [ first 1quotation ]\r
-    [ [ first ] [ rest ] bi\r
-      '[ _ [ drop _ unsafe-amb ] checkpoint ] ] if ;\r
+    dup length 1 = [\r
+        first 1quotation\r
+    ] [\r
+        unclip swap '[ _ [ drop _ unsafe-amb ] checkpoint ]\r
+    ] if ;\r
 \r
 PRIVATE> \r
 \r
@@ -54,8 +57,7 @@ PRIVATE>
     [ amb-integer ] [ nth ] bi ;\r
 \r
 : amb ( seq -- elt )\r
-    [ fail f ]\r
-    [ unsafe-amb ] if-empty ; inline\r
+    [ fail f ] [ unsafe-amb ] if-empty ; inline\r
 \r
 MACRO: amb-execute ( seq -- quot )\r
     [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi\r