minor stack inference fixes

factor/jedit/FactorPlugin.java

@@ -82,6 +82,16 @@ public class FactorPlugin extends EditPlugin
 		}
 	} //}}}
 
+	//{{{ addNonEmpty() method
+	private static void addNonEmpty(String[] input, List output)
+	{
+		for(int i = 0; i < input.length; i++)
+		{
+			if(input[i].length() != 0)
+				output.add(input[i]);
+		}
+	} //}}}
+
 	//{{{ getExternalInstance() method
 	/**
 	 * Returns the object representing a connection to an external Factor instance.
@@ -97,15 +107,17 @@ public class FactorPlugin extends EditPlugin
 
 			try
 			{
-				String[] args = jEdit.getProperty("factor.external.args","-jedit")
+				List args = new ArrayList();
+				args.add(jEdit.getProperty("factor.external.program"));
+				args.add(jEdit.getProperty("factor.external.image"));
+				args.add("-no-ansi");
+				args.add("-no-smart-terminal");
+				String[] extraArgs = jEdit.getProperty(
+					"factor.external.args","-jedit")
 					.split(" ");
-				String[] nargs = new String[args.length + 4];
+				addNonEmpty(extraArgs,args);
-				nargs[0] = jEdit.getProperty("factor.external.program");
+				p = Runtime.getRuntime().exec((String[])args.toArray(
-				nargs[1] = jEdit.getProperty("factor.external.image");
+					new String[args.size()]));
-				nargs[2] = "-no-ansi";
-				nargs[3] = "-no-smart-terminal";
-				System.arraycopy(args,0,nargs,4,args.length);
-				p = Runtime.getRuntime().exec(nargs);
 				p.getErrorStream().close();
 
 				in = p.getInputStream();

library/bootstrap/init-stage2.factor

@@ -70,6 +70,33 @@ USE: kernel-internals
 
 init-error-handler
 
+! An experiment gone wrong...
+
+! : usage+ ( key -- )
+!     dup "usages" word-property
+!     [ succ ] [ 1 ] ifte*
+!     "usages" set-word-property ;
+! 
+! GENERIC: count-usages ( quot -- )
+! M: object count-usages drop ;
+! M: word count-usages usage+ ;
+! M: cons count-usages unswons count-usages count-usages ;
+! 
+! : tally-usages ( -- )
+!     [ f "usages" set-word-property ] each-word
+!     [ word-parameter count-usages ] each-word ;
+! 
+! : auto-inline ( count -- )
+!     #! Automatically inline all words called less than a count
+!     #! number of times.
+!     [
+!         2dup "usages" word-property dup 0 ? >= [
+!             t "inline" set-word-property
+!         ] [
+!             drop
+!         ] ifte
+!     ] each-word drop ;
+
 ! "Counting word usages..." print
 ! tally-usages
 ! 
@@ -91,6 +118,9 @@ os "win32" = "compile" get and [
 "Compiling system..." print
 "compile" get [ compile-all ] when
 
+"Unless you're working on the compiler, ignore the errors above." print
+"Not every word compiles, by design." print
+
 0 [ compiled? [ succ ] when ] each-word
 unparse write " words compiled" print
 

library/compiler/compiler.factor

@@ -96,4 +96,8 @@ M: compound (compile) ( word -- )
 
 : compile-all ( -- )
     #! Compile all words.
-    [ try-compile ] each-word ;
+    supported-cpu? [
+        [ try-compile ] each-word
+    ] [
+        "Unsupported CPU" print
+    ] ifte ;

library/inference/branches.factor

@@ -96,7 +96,9 @@ USE: prettyprint
     dup check-lengths unify-stacks ;
 
 : unify-effects ( list -- )
-    filter-terminators dup balanced? [
+    filter-terminators
+    [ "No branch has a stack effect" throw ] unless*
+    dup balanced? [
         dup unify-d-in d-in set
         dup unify-datastacks meta-d set
         unify-callstacks meta-r set
@@ -143,14 +145,19 @@ SYMBOL: dual-recursive-state
     ] catch ;
 
 : infer-base-cases ( branchlist -- list )
-    [ terminator-quot? not ] subset
+    dup [ dupd recursive-branch ] map [ ] subset nip ;
-    dup [ dupd recursive-branch ] map nip
-    [ ] subset ;
 
 : infer-base-case ( branchlist -- )
+    #! Can't do much if there is only one non-terminator branch.
+    #! Either the word is not recursive, or it is recursive
+    #! and the base case throws an error.
     [
-        infer-base-cases unify-effects
+        [ terminator-quot? not ] subset dup length 1 > [
-        effect dual-recursive-state get set-base
+            infer-base-cases unify-effects
+            effect dual-recursive-state get set-base
+        ] [
+            drop
+        ] ifte
     ] with-scope ;
 
 : (infer-branches) ( branchlist -- list )

library/test/inference.factor

@@ -196,7 +196,16 @@ SYMBOL: sym-test
 
 [ [ 1 | 1 ] ] [ [ get ] infer old-effect ] unit-test
 
-! [ [ 1 | 1 ] ] [ [ str>number ] infer old-effect ] unit-test
+: terminator-branch
+    dup [
+        car
+    ] [
+        not-a-number
+    ] ifte ;
+
+[ [ 1 | 1 ] ] [ [ terminator-branch ] infer old-effect ] unit-test
+
+[ [ 1 | 1 ] ] [ [ str>number ] infer old-effect ] unit-test
 
 ! Type inference
 

library/tools/word-tools.factor

@@ -102,28 +102,3 @@ USE: math
 
 : words. ( vocab -- )
     words . ;
-
-: usage+ ( key -- )
-    dup "usages" word-property
-    [ succ ] [ 1 ] ifte*
-    "usages" set-word-property ;
-
-GENERIC: count-usages ( quot -- )
-M: object count-usages drop ;
-M: word count-usages usage+ ;
-M: cons count-usages unswons count-usages count-usages ;
-
-: tally-usages ( -- )
-    [ f "usages" set-word-property ] each-word
-    [ word-parameter count-usages ] each-word ;
-
-: auto-inline ( count -- )
-    #! Automatically inline all words called less than a count
-    #! number of times.
-    [
-        2dup "usages" word-property dup 0 ? >= [
-            t "inline" set-word-property
-        ] [
-            drop
-        ] ifte
-    ] each-word drop ;