fixes

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4abb15eaad9866febd526b263ab5242973007b38..024ec076d5f359f3d9538494d1b8c7ba6b7cb005 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -62,11 +62,9 @@
 - nicer way to combine two paths\r
 - catchstack lists\r
 - OOP\r
-- refactor sort\r
 - ditch object paths\r
 - browser responder for word links in HTTPd; inspect responder for\r
   objects\r
-- use keep instead of tuck, try to remove usages of transp\r
 - worddef props\r
 - prettyprint: when unparse called due to recursion, write a link\r
 - prettyprinter should output {{ ... }} syntax for hashtables\r

diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index 74b768b0afd71f37f1801a770917372bb6327903..6294883eca020eee1db341942f871117f48f14d3 100644 (file)
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -221,4 +221,6 @@ SYMBOL: compile-callstack
 : compile ( word -- )
     [ postpone-word compile-postponed ] with-compiler ;
 
-: compiled word compile ; parsing
+: compiled
+    #! Compile the most recently defined word.
+    word compile ; parsing

diff --git a/library/lists.factor b/library/lists.factor
index c02013cf14d45e91fe3fc18f7411025670e4a298..30211574a499d07474185d7e81edb4b7749a4836 100644 (file)
--- a/library/lists.factor
+++ b/library/lists.factor
@@ -76,28 +76,28 @@ USE: vectors
     dup cons? [ tail ] when not ;
 
 : partition-add ( obj ? ret1 ret2 -- ret1 ret2 )
-    rot [ >r cons r> ] [ swapd cons ] ifte ; inline
+    rot [ swapd cons ] [ >r cons r> ] ifte ; inline
 
-: partition-step ( list combinator -- cdr combinator car ? )
-    over car over call >r >r unswons r> swap r> ; inline
+: partition-step ( ref list combinator -- ref cdr combinator car ? )
+    pick pick car pick call >r >r unswons r> swap r> ; inline
 
-: (partition) ( list combinator ret1 ret2 -- ret1 ret2 )
+: (partition) ( ref list combinator ret1 ret2 -- ret1 ret2 )
     >r >r  over [
         partition-step  r> r> partition-add  (partition)
     ] [
-        2drop  r> r>
+        3drop  r> r>
     ] ifte ; inline
 
-: partition ( list ref combinator -- list1 list2 )
+: partition ( ref list combinator -- list1 list2 )
     #! The combinator must have stack effect:
     #! ( ref element -- ? )
-    cons [ ] [ ] (partition) ; inline
+    [ ] [ ] (partition) ; inline
 
 : sort ( list comparator -- sorted )
     #! To sort in ascending order, comparator must have stack
     #! effect ( x y -- x>y ).
     over [
-        ( Partition ) [ >r uncons over r> partition ] keep
+        ( Partition ) [ >r uncons dupd r> partition ] keep
         ( Recurse ) [ sort swap ] keep sort
         ( Combine ) swapd cons append
     ] [

diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor
index fe33e4a19dd5b70a053bc5c1e9d13be8ccfca925..a9fe1578e43a8f1af238700dab45921e99364afd 100644 (file)
--- a/library/platform/native/parse-syntax.factor
+++ b/library/platform/native/parse-syntax.factor
@@ -113,10 +113,6 @@ USE: unparser
 
 IN: syntax
 
-: recursive-infer ( -- )
-    #! Mark the last word to be recursively inferred (eg, cond).
-    word  t "recursive-infer" set-word-property ; parsing
-
 : inline ( -- )
     #! Mark the last word to be inlined.
     word  t "inline" set-word-property ; parsing

diff --git a/library/tools/inference.factor b/library/tools/inference.factor
index 011ce1dab2ece386cc83fbe051ce29f329be58db..b997ed4659638e7c15c0c9ee0e8077e74ab01174 100644 (file)
--- a/library/tools/inference.factor
+++ b/library/tools/inference.factor
@@ -96,9 +96,8 @@ SYMBOL: entry-effect
     #! either execute the word in the meta interpreter (if it is
     #! side-effect-free and all parameters are literal), or
     #! simply apply its stack effect to the meta-interpreter.
-    dup car ensure-d
     swap "infer" word-property dup [
-        nip call
+        swap car ensure-d call
     ] [
         drop consume/produce
     ] ifte ;
@@ -118,13 +117,34 @@ SYMBOL: entry-effect
         base-case off  effect entry-effect set
     ] extend ;
 
+: init-inference ( recursive-state -- )
+    init-interpreter
+    0 d-in set
+    0 r-in set
+    recursive-state set ;
+
 DEFER: (infer)
 
+: with-recursive-state ( word quot -- )
+    over <recursive-state> cons recursive-state cons@
+    call
+    recursive-state uncons@ drop ;
+
+: recursive-infer ( quot -- )
+    [
+        recursive-state get init-inference
+        (infer)  effect
+    ] with-scope ;
+
 : apply-compound ( word -- )
     #! Infer a compound word's stack effect.
-    dup <recursive-state> cons recursive-state cons@
-    word-parameter (infer)
-    recursive-state uncons@ drop ;
+    [
+        word-parameter [
+            recursive-infer consume/produce
+        ] [
+            [ (infer) ] when
+        ] catch
+    ] with-recursive-state ;
 
 : apply-word ( word -- )
     #! Apply the word's stack effect to the inferencer state.
@@ -184,12 +204,6 @@ DEFER: (infer)
         push-d
     ] ifte ;
 
-: init-inference ( -- )
-    init-interpreter
-    0 d-in set
-    0 r-in set
-    f recursive-state set ;
-
 : (infer) ( quot -- )
     #! Recursive calls to this word are made for nested
     #! quotations.
@@ -290,7 +304,11 @@ DEFER: (infer)
 
 : infer ( quot -- [ in | out ] )
     #! Stack effect of a quotation.
-    [ init-inference (infer)  effect ] with-scope ;
+    [ f init-inference (infer)  effect ] with-scope ;
+
+: try-infer ( quot -- effect/f )
+    #! Push f if inference fails.
+    [ infer ] [ [ drop f ] when ] catch ;
 
 : meta-infer ( word -- )
     #! Mark a word as being partially evaluated.
@@ -309,13 +327,22 @@ DEFER: (infer)
 \ r> [ pop-r push-d ] "infer" set-word-property
 
 \ drop meta-infer
+\ 2drop meta-infer 
+\ 3drop meta-infer
 \ dup meta-infer
+\ 2dup meta-infer
+\ 3dup meta-infer
 \ swap meta-infer
 \ over meta-infer
 \ pick meta-infer
 \ nip meta-infer
 \ tuck meta-infer
 \ rot meta-infer
+\ -rot meta-infer
+\ 2nip meta-infer
+\ transp meta-infer
+\ dupd meta-infer
+\ swapd meta-infer
 
 \ + [ 2 | 1 ] "infer-effect" set-word-property
 \ - [ 2 | 1 ] "infer-effect" set-word-property