Made backtrack actually faster by removing list push/pops

diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor
index 22c9afb322c310dc990bfd122e5f2c2bfc717a79..3c1a79412118bd5891a2fab0b58da82e0c3e2b0a 100755 (executable)
--- a/extra/backtrack/backtrack.factor
+++ b/extra/backtrack/backtrack.factor
@@ -7,51 +7,56 @@ USING: kernel continuations combinators sequences quotations arrays namespaces
 IN: backtrack\r
 \r
 SYMBOL: failure\r
-V{ } failure set-global\r
 \r
 ERROR: amb-failure ;\r
 \r
 M: amb-failure summary drop "Backtracking failure" ;\r
 \r
 : fail ( -- )\r
-    failure get dup empty? [ amb-failure ]\r
-    [ pop continue ] if ;\r
+    failure get [ continue ]\r
+    [ amb-failure ] if* ;\r
 \r
 : require ( ? -- )\r
     [ fail ] unless ;\r
 \r
 MACRO: checkpoint ( quot -- quot' )\r
-    '[ [ '[ failure get push , continue ] callcc0 @ ] callcc0 ] ;\r
+    '[ failure get ,\r
+       '[ '[ failure set , continue ] callcc0\r
+          , failure set @ ] callcc0 ] ;\r
 \r
 : number-from ( from -- from+n )\r
     [ 1 + number-from ] checkpoint ;\r
 \r
 <PRIVATE\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 <=>\r
-    { { +lt+ [ fail ] }\r
-      { +eq+ [ ] }\r
-      { +gt+ [ [ 1 + number-from-to ] checkpoint ] } } case ;\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
+    [ [ first ] [ rest ] bi\r
+      '[ , [ drop , unsafe-amb ] checkpoint ] ] if ;\r
+\r
 PRIVATE> \r
 \r
 : amb-lazy ( seq -- elt )\r
     [ amb-integer ] [ nth ] bi ;\r
 \r
-MACRO: amb ( seq -- quot )\r
-    dup length\r
-    { { 0 [ drop [ fail f ] ] }\r
-      { 1 [ first 1quotation ] }\r
-      [ drop [ first ] [ rest ] bi\r
-        '[ , [ drop , amb ] checkpoint ] ] } case ;\r
+: amb ( seq -- elt )\r
+    dup empty?\r
+    [ drop fail f ]\r
+    [ unsafe-amb ] if ; inline\r
 \r
 MACRO: amb-execute ( seq -- quot )\r
-    [ length ] [ <enum> [ 1quotation ] assoc-map ] bi\r
-    '[ , amb , case ] ;\r
+    [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi\r
+    '[ , 0 unsafe-number-from-to nip , case ] ;\r
 \r
 : if-amb ( true false -- )\r
     [\r