recursive type inference

TODO.FACTOR.txt

@@ -8,7 +8,6 @@
 + inference/dataflow:
 
 - type inference
-- handle odd base cases, with code after ifte
 
 + compiler:
 
@@ -37,9 +36,7 @@
 - stream server can hang because of exception handler limitations
 - listener should be multithreaded
 - compile all, infer all commands
-- type something -- no completions -- hit another key -- not inserted
 - faster completion
-- sidekick: still parsing too much
 - errors don't always disappear
 - NPE in ErrorHighlight
 - maple-like: press enter at old commands to evaluate there
@@ -48,6 +45,7 @@
 
 + kernel:
 
+- after bootstrapping, classes hash is messed up
 - do partial objects cause problems?
 - profiler is inaccurate: wrong word on cs
 - better i/o scheduler

factor/jedit/FactorCompletion.java

@@ -88,15 +88,21 @@ public class FactorCompletion extends SideKickCompletion
 	public boolean handleKeystroke(int selectedIndex, char keyChar)
 	{
 		if(keyChar == '\t' || keyChar == '\n')
+		{
 			insert(selectedIndex);
+			return false;
+		}
+		else if(keyChar == ' ')
+		{
+			insert(selectedIndex);
+			textArea.userInput(' ');
+			return false;
+		}
 		else
+		{
 			textArea.userInput(keyChar);
-
+			return true;
-		boolean ws = (ReadTable.DEFAULT_READTABLE
+		}
-			.getCharacterType(keyChar)
-			== ReadTable.WHITESPACE);
-
-		return !ws;
 	}
 
 	public ListCellRenderer getRenderer()

library/inference/words.factor

@@ -132,20 +132,22 @@ M: symbol (apply-word) ( word -- )
         ] when
     ] when ;
 
+: decompose ( x y -- effect )
+    #! Return a stack effect such that x*effect = y.
+    2unlist >r
+    swap 2unlist >r
+    over length over length - head nip
+    r> append
+    r> 2list ;
+
 : base-case ( word -- effect )
+    effect swap
     [
         inferring-base-case on
         copy-inference
         inline-compound
         inferring-base-case off
-    ] with-scope ;
+    ] with-scope decompose ;
-
-: decompose ( x y -- effect )
-    #! Return a stack effect such that x*effect = y.
-    2unlist >r swap 2unlist swap length tail append
-    ! workaround
-    [ drop object ] map
-    r> 2list ;
 
 : recursive-word ( word label -- )
     #! Handle a recursive call, by either applying a previously
@@ -155,7 +157,7 @@ M: symbol (apply-word) ( word -- )
         drop word-name " does not have a base case." cat2 throw
     ] [
         2dup [ drop #call-label ] [ nip #call ] ifte
-        rot base-case effect swap decompose (consume/produce)
+        rot base-case (consume/produce)
     ] ifte ;
 
 : apply-word ( word -- )
@@ -181,10 +183,6 @@ M: symbol (apply-word) ( word -- )
 
 \ call [ infer-call ] "infer" set-word-property
 
-! These are due to bugs and will be removed
-\ * [ [ number number ] [ number ] ] "infer-effect" set-word-property
-\ gcd [ [ number number ] [ number ] ] "infer-effect" set-word-property
-
 \ undefined-method t "terminator" set-word-property
 \ not-a-number t "terminator" set-word-property
 \ throw t "terminator" set-word-property

library/math/integer.factor

@@ -40,15 +40,18 @@ USE: math
         (fraction>)
     ] ifte ; inline
 
+: division-by-zero ( x y -- )
+    "Division by zero" throw drop ;
+
 : integer/ ( x y -- x/y )
     dup 0 number= [
-        "Division by zero" throw drop
+        division-by-zero
     ] [
         dup 0 < [
             swap neg swap neg
         ] when
         2dup gcd tuck /i >r /i r> fraction>
-    ] ifte ;
+    ] ifte ; inline
 
 M: fixnum number= fixnum= ;
 M: fixnum < fixnum< ;

library/test/inference.factor

@@ -15,12 +15,19 @@ USE: generic
 [ [ [ object ] [ object object ] ] [ [ object ] f ] decompose ]
 unit-test
 
-[ [ [ fixnum fixnum ] f ] ]
+[ [ [ cons vector cons integer object cons ] [ cons vector cons ] ] ]
 [
-    [ [ rational rational ] [ rational fixnum ] ]
+    [ [ vector ] [ cons vector cons integer object cons ] ]
-    [ [ object ] f ] decompose
+    [ [ vector ] [ cons vector cons ] ]
+    decompose
+]
+
+[ [ [ object ] [ object ] ] ]
+[
+    [ [ object number ] [ object ] ]
+    [ [ object number ] [ object ] ]
+    decompose
 ]
-unit-test
 
 : old-effect ( [ in-types out-types ] -- [ in | out ] )
     uncons car length >r length r> cons ;