inference fix

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 8f2df9ac7ac92e039a2d330f8f7cf129645a208c..f7d1f4f08fc0face19144435d1aedb392ae6de8f 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,5 +1,4 @@
 - FUNCTION: not updating crossref correctly\r
-- UI word wrap: sometimes a space appears at the front\r
 - need line and paragraph spacing\r
 - update HTML stream\r
 - help cross-referencing\r
@@ -7,13 +6,6 @@
 - if cell is rebound, and we allocate c objects, bang\r
 - runtime primitives like fopen: check for null input\r
 - -with combinators are awkward\r
-- cleanups:\r
-  alien/compiler\r
-  inference/shuffle\r
-  inference-words inline-block\r
-  io/buffer - use aliens not integers\r
-  alien/malloc - use aliens not integers\r
-  ui/line-editor - don't use variables\r
 - amd64 to do:\r
   - alien calls\r
   - port ffi to win64\r
@@ -40,10 +32,7 @@
 - stream server can hang because of exception handler limitations\r
 - better i/o scheduler\r
 - if two tasks write to a unix stream, the buffer can overflow\r
-- inference bug\r
-\r
 - font problem: http://iarc1.ece.utexas.edu/~erg/font-bug.JPG\r
-\r
 - implement 3.3 floor  4.7 ceiling  4.5 truncate\r
 \r
 ALL TESTS BELOW FAIL ON x86 linux 32bit\r

diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor
index 51d303eba2789b1faf95d5453bfd73f1684fb68d..208cef59da99a2b2a0b6eddc0f565f003a101898 100644 (file)
--- a/library/alien/aliens.factor
+++ b/library/alien/aliens.factor
@@ -38,7 +38,3 @@ M: alien = ( obj obj -- ? )
 
 : library-abi ( library -- abi )
     library "abi" swap ?hash [ "cdecl" ] unless* ;
-
-: DLL" skip-blank parse-string dlopen swons ; parsing
-
-: ALIEN: scan-word <alien> swons ; parsing

diff --git a/library/alien/syntax.factor b/library/alien/syntax.factor
index ca3130cfb690fd0b5c38bec434de3de168c07bc0..674c114564fa959114faf4db1265625c7b8e4fc6 100644 (file)
--- a/library/alien/syntax.factor
+++ b/library/alien/syntax.factor
@@ -4,6 +4,10 @@ IN: !syntax
 USING: alien compiler kernel lists math namespaces parser
 sequences syntax words ;
 
+: DLL" skip-blank parse-string dlopen swons ; parsing
+
+: ALIEN: scan-word <alien> swons ; parsing
+
 ! usage of 'LIBRARY:' and 'FUNCTION:' :
 !
 !     LIBRARY: gl

diff --git a/library/inference/words.factor b/library/inference/words.factor
index 7dbc19f095c2268c680a9c341312c2e5dad3d3a7..67fb2b5064fe628e248db659a039db09c84accc5 100644 (file)
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -25,7 +25,7 @@ strings vectors words ;
     " was already attempted, and failed" append3
     inference-error ;
 
-TUPLE: rstate label quot base-case? ;
+TUPLE: rstate label base-case? ;
 
 : nest-node ( -- dataflow current )
     dataflow-graph get  dataflow-graph off
@@ -37,8 +37,7 @@ TUPLE: rstate label quot base-case? ;
     r> current-node set ;
 
 : with-recursive-state ( word label base-case quot -- )
-    >r >r over word-def r> <rstate> cons
-    recursive-state [ cons ] change r>
+    >r <rstate> cons recursive-state [ cons ] change r>
     nest-node 2slip unnest-node ; inline
 
 : inline-block ( word base-case -- node-block variables )
@@ -109,8 +108,10 @@ M: #call-label collect-recursion* ( label node -- )
     #! control flow by throwing an exception or restoring a
     #! continuation.
     [
-        recursive-state get init-inference over >r inline-block
-        nip [ terminated? get effect ] bind r>
+        dup inferring-base-case set
+        recursive-state get init-inference
+        over >r inline-block nip
+        [ terminated? get effect ] bind r>
     ] with-scope over consume/produce over [ terminate ] when ;
 
 GENERIC: apply-word
@@ -119,12 +120,18 @@ M: object apply-word ( word -- )
     #! A primitive with an unknown stack effect.
     no-effect ;
 
+: save-effect ( word terminates effect -- )
+    inferring-base-case get [
+        3drop
+    ] [
+        >r dupd "terminates" set-word-prop r>
+        "infer-effect" set-word-prop
+    ] if ;
+
 M: compound apply-word ( word -- )
     #! Infer a compound word's stack effect.
     [
-        dup dup f infer-compound
-        >r "terminates" set-word-prop r>
-        "infer-effect" set-word-prop
+        dup f infer-compound save-effect
     ] [
         swap t "no-effect" set-word-prop rethrow
     ] recover ;

diff --git a/library/test/collections/sequences.factor b/library/test/collections/sequences.factor
index 39cfaebd5529a986b86ee52751559b28ec7125c0..8def7aaf838accb505d9a50b30e6d0d2357f5d84 100644 (file)
--- a/library/test/collections/sequences.factor
+++ b/library/test/collections/sequences.factor
@@ -134,12 +134,12 @@ unit-test
     sorter-seq >array nip
 ] unit-test
 
-[ [ ] ] [ [ ] number-sort ] unit-test
+[ [ ] ] [ [ ] natural-sort ] unit-test
 
 [ t ] [
     100 [
         drop
-        1000 [ drop 1000 random-int ] map number-sort [ <= ] monotonic?
+        100 [ drop 20 random-int [ drop 1000 random-int ] map ] map natural-sort [ <=> 0 <= ] monotonic?
     ] all?
 ] unit-test
 

diff --git a/library/test/math/integer.factor b/library/test/math/integer.factor
index ee3b85e3c932705262372c6ad5eecd6fbe8e81b3..31e0c5d2fb27923855e9f8e414b788c944443ef2 100644 (file)
--- a/library/test/math/integer.factor
+++ b/library/test/math/integer.factor
@@ -55,7 +55,7 @@ USING: kernel math namespaces prettyprint test ;
 ] unit-test
 
 : verify-gcd ( x y )
-    2dup gcd ( a d )
+    2dup swap gcd ( a d )
     >r rot * swap rem r> = ; 
 
 [ t ] [ 123 124 verify-gcd ] unit-test