Imported https://downloads.factorcode.org/releases/0.53/Factor-0.53.jar

.cvskeywords

@@ -1,14 +1,24 @@
-./factor/compiler/StackEffect.java: * $Id: StackEffect.java,v 1.6 2004/02/15 22:24:19 slava Exp $
+./factor/compiler/CompiledList.java: * $Id: CompiledList.java,v 1.5 2004/03/07 22:51:00 slava Exp $
-./factor/compiler/LocalAllocator.java: * $Id: LocalAllocator.java,v 1.9 2004/02/17 20:36:09 slava Exp $
+./factor/compiler/StackEffect.java: * $Id: StackEffect.java,v 1.12 2004/03/05 21:09:10 slava Exp $
+./factor/compiler/Literal.java: * $Id: Literal.java,v 1.1 2004/02/28 19:51:53 slava Exp $
 ./factor/compiler/FactorCompilerException.java: * $Id: FactorCompilerException.java,v 1.1 2004/01/27 19:55:40 slava Exp $
-./factor/compiler/CompiledDefinition.java:* $Id: CompiledDefinition.java,v 1.4 2004/02/15 22:24:19 slava Exp $
+./factor/compiler/CompiledDefinition.java:* $Id: CompiledDefinition.java,v 1.8 2004/03/07 22:51:00 slava Exp $
+./factor/compiler/Result.java: * $Id: Result.java,v 1.1 2004/02/28 19:51:53 slava Exp $
+./factor/compiler/ConstantPoolString.java: * $Id: ConstantPoolString.java,v 1.1 2004/02/28 19:51:53 slava Exp $
+./factor/compiler/Null.java: * $Id: Null.java,v 1.2 2004/03/01 02:37:01 slava Exp $
+./factor/compiler/RecursiveState.java: * $Id: RecursiveState.java,v 1.5 2004/03/28 21:25:13 slava Exp $
+./factor/compiler/FactorCompiler.java: * $Id: FactorCompiler.java,v 1.11 2004/03/24 02:50:28 slava Exp $
+./factor/compiler/RecursiveForm.java: * $Id: RecursiveForm.java,v 1.5 2004/03/04 23:33:42 slava Exp $
+./factor/compiler/CompiledChoice.java: * $Id: CompiledChoice.java,v 1.7 2004/03/28 21:25:13 slava Exp $
+./factor/compiler/FlowObject.java: * $Id: FlowObject.java,v 1.3 2004/03/28 21:25:13 slava Exp $
+./factor/prettyprint.factor:! $Id: prettyprint.factor,v 1.3 2004/03/26 05:06:36 slava Exp $
 ./factor/random.factor:! $Id: random.factor,v 1.6 2004/02/18 00:48:47 slava Exp $
 ./factor/FactorExternalizable.java: * $Id: FactorExternalizable.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/FactorJava.java: * $Id: FactorJava.java,v 1.7 2004/02/15 05:44:54 slava Exp $
+./factor/FactorJava.java: * $Id: FactorJava.java,v 1.18 2004/03/28 21:25:13 slava Exp $
-./factor/FactorDictionary.java: * $Id: FactorDictionary.java,v 1.8 2004/02/15 22:24:19 slava Exp $
+./factor/combinators.factor:! $Id: combinators.factor,v 1.12 2004/03/24 02:50:28 slava Exp $
-./factor/combinators.factor:! $Id: combinators.factor,v 1.4 2004/02/13 23:19:43 slava Exp $
+./factor/inspector.factor:! $Id: inspector.factor,v 1.3 2004/03/28 21:25:13 slava Exp $
 ./factor/FactorDataStack.java: * $Id: FactorDataStack.java,v 1.3 2004/02/15 22:24:19 slava Exp $
-./factor/continuations.factor:! $Id: continuations.factor,v 1.1 2004/01/25 19:55:39 slava Exp $
+./factor/continuations.factor:! $Id: continuations.factor,v 1.3 2004/03/11 05:49:37 slava Exp $
 ./factor/network.factor:! $Id: network.factor,v 1.2 2004/02/10 05:43:37 slava Exp $
 ./factor/FactorLib.java: * $Id: FactorLib.java,v 1.4 2004/02/15 22:24:19 slava Exp $
 ./factor/FactorRuntimeException.java: * $Id: FactorRuntimeException.java,v 1.1 2004/01/25 19:55:39 slava Exp $
@@ -16,53 +26,55 @@
 ./factor/FactorCallStack.java: * $Id: FactorCallStack.java,v 1.2 2004/02/15 22:24:19 slava Exp $
 ./factor/FactorStackException.java: * $Id: FactorStackException.java,v 1.1 2004/01/25 19:55:39 slava Exp $
 ./factor/FactorUndefinedWordException.java: * $Id: FactorUndefinedWordException.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/lists.factor:! $Id: lists.factor,v 1.7 2004/02/15 22:24:19 slava Exp $
+./factor/lists.factor:! $Id: lists.factor,v 1.17 2004/03/24 02:50:28 slava Exp $
 ./factor/FactorCallFrame.java: * $Id: FactorCallFrame.java,v 1.3 2004/02/05 04:47:05 slava Exp $
-./factor/examples/httpd.factor:! $Id: httpd.factor,v 1.3 2004/02/13 23:19:43 slava Exp $
+./factor/debugger.factor:! $Id: debugger.factor,v 1.6 2004/03/28 21:25:13 slava Exp $
-./factor/FactorNamespace.java: * $Id: FactorNamespace.java,v 1.4 2004/02/05 04:47:05 slava Exp $
+./factor/FactorNamespace.java: * $Id: FactorNamespace.java,v 1.7 2004/02/24 18:55:09 slava Exp $
 ./factor/PublicCloneable.java: * $Id: PublicCloneable.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/examples.factor:! $Id: examples.factor,v 1.1 2004/01/25 19:55:39 slava Exp $
+./factor/examples.factor:! $Id: examples.factor,v 1.2 2004/02/26 05:35:20 slava Exp $
-./factor/Cons.java: * $Id: Cons.java,v 1.4 2004/02/11 03:49:45 slava Exp $
+./factor/Cons.java: * $Id: Cons.java,v 1.8 2004/03/28 21:25:13 slava Exp $
-./factor/FactorCompoundDefinition.java:* $Id: FactorCompoundDefinition.java,v 1.9 2004/02/15 22:24:19 slava Exp $
+./factor/FactorCompoundDefinition.java:* $Id: FactorCompoundDefinition.java,v 1.21 2004/03/26 05:06:36 slava Exp $
 ./factor/FactorObject.java: * $Id: FactorObject.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/FactorParser.java: * $Id: FactorParser.java,v 1.3 2004/01/26 03:16:54 slava Exp $
+./factor/FactorParser.java: * $Id: FactorParser.java,v 1.6 2004/03/28 21:25:13 slava Exp $
-./factor/FactorMath.java: * $Id: FactorMath.java,v 1.3 2004/02/17 20:36:09 slava Exp $
+./factor/FactorMath.java: * $Id: FactorMath.java,v 1.4 2004/03/13 05:39:00 slava Exp $
-./factor/parser.factor:! $Id: parser.factor,v 1.2 2004/02/10 05:43:37 slava Exp $
+./factor/parser.factor:! $Id: parser.factor,v 1.6 2004/03/28 21:25:13 slava Exp $
-./factor/FactorMissingDefinition.java: * $Id: FactorMissingDefinition.java,v 1.7 2004/02/15 22:24:19 slava Exp $
+./factor/FactorMissingDefinition.java: * $Id: FactorMissingDefinition.java,v 1.8 2004/03/05 21:09:10 slava Exp $
-./factor/stream.factor:! $Id: stream.factor,v 1.3 2004/02/10 05:43:37 slava Exp $
+./factor/stream.factor:! $Id: stream.factor,v 1.6 2004/03/28 21:25:13 slava Exp $
-./factor/strings.factor:! $Id: strings.factor,v 1.9 2004/02/18 00:48:47 slava Exp $
+./factor/strings.factor:! $Id: strings.factor,v 1.18 2004/03/28 18:59:28 slava Exp $
-./factor/FactorInterpreter.java: * $Id: FactorInterpreter.java,v 1.6 2004/02/17 20:36:09 slava Exp $
+./factor/FactorInterpreter.java: * $Id: FactorInterpreter.java,v 1.14 2004/03/28 21:25:13 slava Exp $
 ./factor/FactorDomainException.java: * $Id: FactorDomainException.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/FactorWord.java: * $Id: FactorWord.java,v 1.7 2004/02/15 05:44:54 slava Exp $
+./factor/FactorWord.java: * $Id: FactorWord.java,v 1.14 2004/03/26 05:06:36 slava Exp $
-./factor/math.factor:! $Id: math.factor,v 1.5 2004/02/17 20:36:09 slava Exp $
+./factor/math.factor:! $Id: math.factor,v 1.11 2004/03/20 03:33:52 slava Exp $
-./factor/FactorWordDefinition.java: * $Id: FactorWordDefinition.java,v 1.14 2004/02/15 22:24:19 slava Exp $
+./factor/FactorWordDefinition.java: * $Id: FactorWordDefinition.java,v 1.24 2004/03/28 21:25:13 slava Exp $
 ./factor/primitives/CallstackSet.java: * $Id: CallstackSet.java,v 1.2 2004/02/15 22:24:19 slava Exp $
-./factor/primitives/JInvokeStatic.java: * $Id: JInvokeStatic.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/JInvokeStatic.java: * $Id: JInvokeStatic.java,v 1.4 2004/02/28 19:51:53 slava Exp $
 ./factor/primitives/Unwind.java: * $Id: Unwind.java,v 1.2 2004/02/15 22:24:20 slava Exp $
-./factor/primitives/JVarGetStatic.java: * $Id: JVarGetStatic.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/JVarGetStatic.java: * $Id: JVarGetStatic.java,v 1.4 2004/02/28 19:51:53 slava Exp $
 ./factor/primitives/Unstack.java: * $Id: Unstack.java,v 1.2 2004/02/15 22:24:20 slava Exp $
-./factor/primitives/JInvoke.java: * $Id: JInvoke.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/JInvoke.java: * $Id: JInvoke.java,v 1.4 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/Get.java: * $Id: Get.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/Get.java: * $Id: Get.java,v 1.4 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/Define.java: * $Id: Define.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/Define.java: * $Id: Define.java,v 1.5 2004/03/26 05:06:36 slava Exp $
 ./factor/primitives/Clear.java: * $Id: Clear.java,v 1.2 2004/02/15 22:24:20 slava Exp $
-./factor/primitives/Bind.java: * $Id: Bind.java,v 1.3 2004/02/17 20:36:09 slava Exp $
+./factor/primitives/Bind.java: * $Id: Bind.java,v 1.5 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/Choice.java: * $Id: Choice.java,v 1.3 2004/02/17 03:49:46 slava Exp $
+./factor/primitives/Choice.java: * $Id: Choice.java,v 1.6 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/JNew.java: * $Id: JNew.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/Execute.java: * $Id: Execute.java,v 1.1 2004/02/24 03:23:00 slava Exp $
-./factor/primitives/Call.java: * $Id: Call.java,v 1.2 2004/02/15 22:24:19 slava Exp $
+./factor/primitives/JNew.java: * $Id: JNew.java,v 1.4 2004/02/28 19:51:53 slava Exp $
+./factor/primitives/Call.java: * $Id: Call.java,v 1.4 2004/02/28 19:51:53 slava Exp $
 ./factor/primitives/CallstackGet.java: * $Id: CallstackGet.java,v 1.2 2004/02/15 22:24:19 slava Exp $
 ./factor/primitives/DatastackGet.java: * $Id: DatastackGet.java,v 1.2 2004/02/15 22:24:20 slava Exp $
-./factor/primitives/JVarSet.java: * $Id: JVarSet.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/JVarSet.java: * $Id: JVarSet.java,v 1.4 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/Set.java: * $Id: Set.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/Set.java: * $Id: Set.java,v 1.4 2004/02/28 19:51:53 slava Exp $
 ./factor/primitives/Restack.java: * $Id: Restack.java,v 1.2 2004/02/15 22:24:20 slava Exp $
 ./factor/primitives/DatastackSet.java: * $Id: DatastackSet.java,v 1.2 2004/02/15 22:24:20 slava Exp $
-./factor/primitives/JVarSetStatic.java: * $Id: JVarSetStatic.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/JVarSetStatic.java: * $Id: JVarSetStatic.java,v 1.4 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/JVarGet.java: * $Id: JVarGet.java,v 1.2 2004/02/15 22:24:20 slava Exp $
+./factor/primitives/JVarGet.java: * $Id: JVarGet.java,v 1.4 2004/02/28 19:51:53 slava Exp $
-./factor/interpreter.factor:! $Id: interpreter.factor,v 1.6 2004/02/10 05:43:37 slava Exp $
+./factor/httpd.factor:! $Id: httpd.factor,v 1.4 2004/03/24 02:50:28 slava Exp $
-./factor/miscellaneous.factor:! $Id: miscellaneous.factor,v 1.5 2004/02/15 22:24:19 slava Exp $
+./factor/interpreter.factor:! $Id: interpreter.factor,v 1.18 2004/03/28 21:25:13 slava Exp $
-./factor/FactorArrayStack.java: * $Id: FactorArrayStack.java,v 1.2 2004/01/26 03:16:54 slava Exp $
+./factor/miscellaneous.factor:! $Id: miscellaneous.factor,v 1.9 2004/03/28 21:25:13 slava Exp $
-./factor/boot.factor:! $Id: boot.factor,v 1.5 2004/02/18 00:48:47 slava Exp $
+./factor/FactorArrayStack.java: * $Id: FactorArrayStack.java,v 1.4 2004/03/28 21:25:13 slava Exp $
+./factor/boot.factor:! $Id: boot.factor,v 1.16 2004/03/26 05:06:36 slava Exp $
 ./factor/FactorParseException.java: * $Id: FactorParseException.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/namespaces.factor:! $Id: namespaces.factor,v 1.4 2004/02/10 05:43:37 slava Exp $
+./factor/namespaces.factor:! $Id: namespaces.factor,v 1.7 2004/03/16 23:30:54 slava Exp $
 ./factor/FactorException.java: * $Id: FactorException.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/FactorShuffleDefinition.java: * $Id: FactorShuffleDefinition.java,v 1.12 2004/02/15 22:24:19 slava Exp $
+./factor/FactorShuffleDefinition.java: * $Id: FactorShuffleDefinition.java,v 1.15 2004/03/05 21:09:10 slava Exp $
-./factor/dictionary.factor:! $Id: dictionary.factor,v 1.8 2004/02/10 05:43:37 slava Exp $
+./factor/dictionary.factor:! $Id: dictionary.factor,v 1.16 2004/03/28 18:59:28 slava Exp $

factor/Cons.java

@@ -119,6 +119,35 @@ public class Cons implements PublicCloneable, FactorExternalizable
 		return size;
 	} //}}}
 
+	//{{{ nappend() method
+	public static Cons nappend(Cons l1, Cons l2)
+	{
+		if(l1 == null)
+			return l2;
+		if(l2 == null)
+			return l1;
+		Cons last = l1;
+		while(last.cdr != null)
+			last = last.next();
+		last.cdr = l2;
+		return l1;
+	} //}}}
+
+	//{{{ assoc() method
+	public static Object assoc(Cons assoc, Object key)
+	{
+		if(assoc == null)
+			return null;
+		else
+		{
+			Cons first = (Cons)assoc.car;
+			if(FactorLib.equal(first.car,key))
+				return first.cdr;
+			else
+				return assoc(assoc.next(),key);
+		}
+	} //}}}
+
 	//{{{ isProperList() method
 	public boolean isProperList()
 	{
@@ -140,7 +169,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
 			if(iter.car == this)
 				buf.append("<circular reference>");
 			else
-				buf.append(FactorJava.factorTypeToString(iter.car));
+				buf.append(FactorParser.unparse(iter.car));
 			if(iter.cdr instanceof Cons)
 			{
 				buf.append(' ');
@@ -152,7 +181,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
 			else
 			{
 				buf.append(" , ");
-				buf.append(FactorJava.factorTypeToString(iter.cdr));
+				buf.append(FactorParser.unparse(iter.cdr));
 				iter = null;
 			}
 		}

factor/FactorArrayStack.java

@@ -140,21 +140,4 @@ public abstract class FactorArrayStack implements FactorExternalizable
 		}
 		return first;
 	} //}}}
-
-	//{{{ toString() method
-	public String toString()
-	{
-		StringBuffer buf = new StringBuffer();
-		for(int i = 0; i < top; i++)
-		{
-			if(i != 0)
-				buf.append('\n');
-			buf.append(i).append(": ");
-			if(stack[i] == this)
-				buf.append("THIS STACK");
-			else
-				buf.append(FactorJava.factorTypeToString(stack[i]));
-		}
-		return buf.toString();
-	} //}}}
 }

factor/FactorCompoundDefinition.java

@@ -34,7 +34,6 @@ import java.lang.reflect.*;
 import java.io.FileOutputStream;
 import java.util.*;
 import org.objectweb.asm.*;
-import org.objectweb.asm.util.*;
 
 /**
  * : name ... ;
@@ -60,22 +59,21 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws Exception
+		FactorCompiler compiler) throws Exception
 	{
-		if(recursiveCheck.contains(this))
+		RecursiveForm rec = recursiveCheck.get(word);
-			return null;
+		if(rec.active)
-
-		try
 		{
-			recursiveCheck.add(this);
+			StackEffect se = rec.baseCase;
+			if(se == null)
+				throw new FactorCompilerException("Indeterminate recursive call");
 
-			return StackEffect.getStackEffect(definition,
+			compiler.apply(StackEffect.decompose(rec.effect,se));
-				recursiveCheck,state);
 		}
-		finally
+		else
 		{
-			recursiveCheck.remove(this);
+			compiler.getStackEffect(definition,recursiveCheck);
 		}
 	} //}}}
 
@@ -100,45 +98,40 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 	 * Compile the given word, returning a new word definition.
 	 */
 	FactorWordDefinition compile(FactorInterpreter interp,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck) throws Exception
 	{
-		StackEffect effect = getStackEffect(
+		StackEffect effect = getStackEffect();
-			recursiveCheck,new LocalAllocator());
-		if(effect == null)
-			throw new FactorCompilerException("Cannot deduce stack effect of " + word);
-		if(effect.outD > 1)
-			throw new FactorCompilerException("Cannot compile word that returns more than 1 value");
 
-		/* StringBuffer buf = new StringBuffer();
+		if(effect.inR != 0 || effect.outR != 0)
-		for(int i = 0; i < recursiveCheck.size(); i++)
+			throw new FactorCompilerException("Compiled code cannot manipulate call stack frames");
-		{
+
-			buf.append(' ');
+		boolean multipleReturns = (effect.outD > 1);
-		}
-		buf.append("Compiling ").append(word);
-		System.err.println(buf); */
 
 		String className = getSanitizedName(word.name);
 
 		ClassWriter cw = new ClassWriter(false);
 		cw.visit(ACC_PUBLIC, className,
-			"factor/compiler/CompiledDefinition", null, null);
+			"factor/compiler/CompiledDefinition",
+			null, null);
 
 		compileConstructor(cw,className);
 
 		CompileResult result = compileEval(interp,cw,
-			className,effect,recursiveCheck);
+			className,effect,recursiveCheck,
+			multipleReturns);
 
-		compileToString(cw,effect);
+		// Generate fields for storing literals and
+		// word references
+		result.compiler.generateFields(cw);
 
-		// Generate fields for storing literals and word references
+		// gets the bytecode of the class, and loads it
-		result.allocator.generateFields(cw);
+		// dynamically
-
-		// gets the bytecode of the class, and loads it dynamically
 		byte[] code = cw.toByteArray();
 
-		if(interp.compileDump)
+		if(interp.dump)
 		{
-			FileOutputStream fos = new FileOutputStream(className + ".class");
+			FileOutputStream fos = new FileOutputStream(
+				className + ".class");
 			fos.write(code);
 			fos.close();
 		}
@@ -147,17 +140,21 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 			className.replace('/','.'),
 			code, 0, code.length);
 
-		result.allocator.setFields(compiledWordClass);
+		result.compiler.setFields(compiledWordClass);
 
-		Constructor constructor = compiledWordClass.getConstructor(
+		Constructor constructor = compiledWordClass
-			new Class[] { FactorWord.class, StackEffect.class });
+			.getConstructor(
+			new Class[] {
+			FactorWord.class, StackEffect.class, Cons.class
+			});
 
-		FactorWordDefinition compiledWord = (FactorWordDefinition)
+		FactorWordDefinition compiledWord
-			constructor.newInstance(new Object[] { word, effect });
+			= (FactorWordDefinition)
+			constructor.newInstance(
+			new Object[] { word, effect, definition });
 
 		// store disassembly for the 'asm' word.
-		compiledWord.getNamespace(interp).setVariable("asm",
+		word.asm = result.asm;
-			result.asm);
 
 		return compiledWord;
 	} //}}}
@@ -168,7 +165,9 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		// creates a MethodWriter for the constructor
 		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
 			"<init>",
-			"(Lfactor/FactorWord;Lfactor/compiler/StackEffect;)V",
+			"(Lfactor/FactorWord;"
+			+ "Lfactor/compiler/StackEffect;"
+			+ "Lfactor/Cons;)V",
 			null, null);
 		// pushes the 'this' variable
 		mw.visitVarInsn(ALOAD, 0);
@@ -176,34 +175,27 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		mw.visitVarInsn(ALOAD, 1);
 		// pushes the stack effect parameter
 		mw.visitVarInsn(ALOAD, 2);
+		// pushes the definition parameter
+		mw.visitVarInsn(ALOAD, 3);
 		// invokes the super class constructor
 		mw.visitMethodInsn(INVOKESPECIAL,
 			"factor/compiler/CompiledDefinition", "<init>",
-			"(Lfactor/FactorWord;Lfactor/compiler/StackEffect;)V");
+			"(Lfactor/FactorWord;"
+			+ "Lfactor/compiler/StackEffect;"
+			+ "Lfactor/Cons;)V");
 		mw.visitInsn(RETURN);
-		mw.visitMaxs(3, 3);
+		mw.visitMaxs(4, 4);
-	} //}}}
-
-	//{{{ compileToString() method
-	private void compileToString(ClassVisitor cw, StackEffect effect)
-	{
-		// creates a MethodWriter for the 'toString' method
-		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
-			"toString", "()Ljava/lang/String;", null, null);
-		mw.visitLdcInsn("( compiled: " + effect + " ) " + toString());
-		mw.visitInsn(ARETURN);
-		mw.visitMaxs(1, 1);
 	} //}}}
 
 	//{{{ compileEval() method
 	static class CompileResult
 	{
-		LocalAllocator allocator;
+		FactorCompiler compiler;
 		String asm;
 
-		CompileResult(LocalAllocator allocator, String asm)
+		CompileResult(FactorCompiler compiler, String asm)
 		{
-			this.allocator = allocator;
+			this.compiler = compiler;
 			this.asm = asm;
 		}
 	}
@@ -215,73 +207,34 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 	 */
 	protected CompileResult compileEval(FactorInterpreter interp,
 		ClassWriter cw, String className, StackEffect effect,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck, boolean multipleReturns)
+		throws Exception
 	{
 		// creates a MethodWriter for the 'eval' method
-		CodeVisitor _mw = cw.visitMethod(ACC_PUBLIC,
+		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
 			"eval", "(Lfactor/FactorInterpreter;)V",
 			null, null);
 
-		TraceCodeVisitor mw = new TraceCodeVisitor(_mw);
-
 		// eval() method calls core
 		mw.visitVarInsn(ALOAD,1);
 
 		compileDataStackToJVMStack(effect,mw);
 
-		String signature = effect.getCorePrototype();
+		mw.visitMethodInsn(INVOKESTATIC,className,"core",
-
+			effect.getCorePrototype());
-		mw.visitMethodInsn(INVOKESTATIC,
-			className,"core",signature);
 
 		compileJVMStackToDataStack(effect,mw);
 
 		mw.visitInsn(RETURN);
 		mw.visitMaxs(Math.max(4,2 + effect.inD),4);
 
-		String evalAsm = getDisassembly(mw);
-
 		// generate core
-		_mw = cw.visitMethod(ACC_PUBLIC | ACC_STATIC,
+		FactorCompiler compiler = new FactorCompiler(interp,word,
-			"core",signature,null,null);
-
-		mw = new TraceCodeVisitor(_mw);
-
-		LocalAllocator allocator = new LocalAllocator(interp,
 			className,1,effect.inD);
+		String asm = compiler.compile(definition,cw,className,
+			"core",effect,recursiveCheck);
 
-		int maxJVMStack = allocator.compile(definition,mw,
+		return new CompileResult(compiler,asm);
-			recursiveCheck);
-
-		if(effect.outD == 0)
-			mw.visitInsn(RETURN);
-		else
-		{
-			allocator.pop(mw);
-			mw.visitInsn(ARETURN);
-			maxJVMStack = Math.max(maxJVMStack,1);
-		}
-
-		mw.visitMaxs(maxJVMStack,allocator.maxLocals());
-
-		String coreAsm = getDisassembly(mw);
-
-		return new CompileResult(allocator,
-			"eval(Lfactor/FactorInterpreter;)V:\n" + evalAsm
-			+ "core" + signature + "\n" + coreAsm);
-	} //}}}
-
-	//{{{ getDisassembly() method
-	protected String getDisassembly(TraceCodeVisitor mw)
-	{
-		// Save the disassembly of the eval() method
-		StringBuffer buf = new StringBuffer();
-		Iterator bytecodes = mw.getText().iterator();
-		while(bytecodes.hasNext())
-		{
-			buf.append(bytecodes.next());
-		}
-		return buf.toString();
 	} //}}}
 
 	//{{{ compileDataStackToJVMStack() method
@@ -358,16 +311,37 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	public int compileImmediate(CodeVisitor mw, LocalAllocator allocator,
+	public int compileImmediate(CodeVisitor mw, FactorCompiler compiler,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck) throws Exception
 	{
-		return allocator.compile(definition,mw,recursiveCheck);
+		/* System.err.println("immediate call to " + word);
+		FactorDataStack savedDatastack = (FactorDataStack)
+			compiler.datastack.clone();
+		FactorCallStack savedCallstack = (FactorCallStack)
+			compiler.callstack.clone();
+		StackEffect savedEffect = compiler.getStackEffect();
+		compiler.effect = new StackEffect();
+
+		RecursiveState _recursiveCheck = new RecursiveState();
+		_recursiveCheck.add(word,null);
+		getStackEffect(_recursiveCheck,compiler);
+		_recursiveCheck.remove(word);
+		StackEffect effect = compiler.getStackEffect();
+
+		System.err.println("immediate effect is " + effect);
+
+		compiler.datastack = savedDatastack;
+		compiler.callstack = savedCallstack;
+		compiler.effect = savedEffect; */
+
+		return compiler.compile(definition,mw,recursiveCheck);
 	} //}}}
 
-	//{{{ toString() method
+	//{{{ toList() method
-	public String toString()
+	public Cons toList()
 	{
-		return definition.elementsToString();
+		return new Cons(word,new Cons(new FactorWord("\n"),
+			definition));
 	} //}}}
 
 	private static SimpleClassLoader loader = new SimpleClassLoader();

factor/FactorDictionary.java

@@ -1,165 +0,0 @@
-/* :folding=explicit:collapseFolds=1: */
-
-/*
- * $Id$
- *
- * Copyright (C) 2003, 2004 Slava Pestov.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- *    this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- *    this list of conditions and the following disclaimer in the documentation
- *    and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-package factor;
-
-import factor.primitives.*;
-import java.util.Iterator;
-import java.util.Map;
-import java.util.TreeMap;
-
-public class FactorDictionary
-{
-	public FactorWord last;
-
-	FactorWord datastackGet;
-	FactorWord datastackSet;
-	FactorWord clear;
-	FactorWord callstackGet;
-	FactorWord callstackSet;
-	FactorWord restack;
-	FactorWord unstack;
-	FactorWord unwind;
-	FactorWord jnew;
-	FactorWord jvarGet;
-	FactorWord jvarSet;
-	FactorWord jvarGetStatic;
-	FactorWord jvarSetStatic;
-	FactorWord jinvoke;
-	FactorWord jinvokeStatic;
-	FactorWord get;
-	FactorWord set;
-	FactorWord define;
-	FactorWord call;
-	FactorWord bind;
-	FactorWord choice;
-
-	private Map intern;
-
-	//{{{ init() method
-	public void init()
-	{
-		intern = new TreeMap();
-
-		// data stack primitives
-		datastackGet = intern("datastack$");
-		datastackGet.def = new DatastackGet(
-			datastackGet);
-		datastackSet = intern("datastack@");
-		datastackSet.def = new DatastackSet(
-			datastackSet);
-		clear = intern("clear");
-		clear.def = new Clear(clear);
-
-		// call stack primitives
-		callstackGet = intern("callstack$");
-		callstackGet.def = new CallstackGet(
-			callstackGet);
-		callstackSet = intern("callstack@");
-		callstackSet.def = new CallstackSet(
-			callstackSet);
-		restack = intern("restack");
-		restack.def = new Restack(restack);
-		unstack = intern("unstack");
-		unstack.def = new Unstack(unstack);
-		unwind = intern("unwind");
-		unwind.def = new Unwind(unwind);
-
-		// reflection primitives
-		jinvoke = intern("jinvoke");
-		jinvoke.def = new JInvoke(jinvoke);
-		jinvokeStatic = intern("jinvoke-static");
-		jinvokeStatic.def = new JInvokeStatic(
-			jinvokeStatic);
-		jnew = intern("jnew");
-		jnew.def = new JNew(jnew);
-		jvarGet = intern("jvar$");
-		jvarGet.def = new JVarGet(jvarGet);
-		jvarGetStatic = intern("jvar-static$");
-		jvarGetStatic.def = new JVarGetStatic(
-			jvarGetStatic);
-		jvarSet = intern("jvar@");
-		jvarSet.def = new JVarSet(jvarSet);
-		jvarSetStatic = intern("jvar-static@");
-		jvarSetStatic.def = new JVarSetStatic(
-			jvarSetStatic);
-
-		// namespaces
-		get = intern("$");
-		get.def = new Get(get);
-		set = intern("@");
-		set.def = new Set(set);
-
-		// definition
-		define = intern("define");
-		define.def = new Define(define);
-
-		// combinators
-		call = intern("call");
-		call.def = new Call(call);
-		bind = intern("bind");
-		bind.def = new Bind(bind);
-		choice = intern("?");
-		choice.def = new Choice(choice);
-	} //}}}
-
-	//{{{ intern() method
-	public FactorWord intern(String name)
-	{
-		FactorWord w = (FactorWord)intern.get(name);
-		if(w == null)
-		{
-			w = new FactorWord(name);
-			intern.put(name,w);
-		}
-		return w;
-	} //}}}
-
-	//{{{ toWordList() method
-	public Cons toWordList()
-	{
-		Cons first = null;
-		Cons last = null;
-		Iterator iter = intern.values().iterator();
-		while(iter.hasNext())
-		{
-			FactorWord word = (FactorWord)iter.next();
-			if(!(word.def instanceof FactorMissingDefinition))
-			{
-				Cons cons = new Cons(word,null);
-				if(first == null)
-					first = cons;
-				else
-					last.cdr = cons;
-				last = cons;
-			}
-		}
-		return first;
-	} //}}}
-}

factor/FactorInterpreter.java

@@ -3,7 +3,7 @@
 /*
  * $Id$
  *
- * Copyright (C) 2003 Slava Pestov.
+ * Copyright (C) 2003, 2004 Slava Pestov.
  *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions are met:
@@ -29,6 +29,7 @@
 
 package factor;
 
+import factor.primitives.*;
 import java.io.*;
 
 public class FactorInterpreter
@@ -41,53 +42,20 @@ public class FactorInterpreter
 	public boolean trace = false;
 	public boolean errorFlag = false;
 	public boolean compile = true;
-	public boolean compileDump = false;
+	public boolean dump = false;
 
 	public FactorCallFrame callframe;
 	public FactorCallStack callstack = new FactorCallStack();
 	public FactorDataStack datastack = new FactorDataStack();
-	public final FactorDictionary dict = new FactorDictionary();
+	public FactorNamespace dict;
+	public FactorWord last;
 	public FactorNamespace global;
 
 	//{{{ main() method
-	/**
-	 * Need to refactor this into Factor.
-	 */
 	public static void main(String[] args) throws Exception
 	{
 		FactorInterpreter interp = new FactorInterpreter();
-
 		interp.init(args,null);
-
-		/* if(virgin)
-		{
-			System.out.println("Mini-interpreter");
-			BufferedReader in = new BufferedReader(
-				new InputStreamReader(
-				System.in));
-			String line;
-			for(;;)
-			{
-				System.out.print("] ");
-				System.out.flush();
-				line = in.readLine();
-				if(line == null)
-					break;
-
-				FactorParser parser = new FactorParser(
-					"<mini>",new StringReader(line),
-					interp.dict);
-				Cons parsed = parser.parse();
-				interp.call(parsed);
-				interp.run();
-				System.out.println(interp.datastack);
-			}
-		}
-		else
-		{
-			interp.run();
-		} */
-
 		System.exit(0);
 	} //}}}
 
@@ -98,12 +66,81 @@ public class FactorInterpreter
 
 		callstack.top = 0;
 		datastack.top = 0;
-		dict.init();
+		initDictionary();
 		initNamespace(root);
 		topLevel();
 		runBootstrap();
 	} //}}}
 
+	//{{{ initDictionary() method
+	private void initDictionary() throws Exception
+	{
+		dict = new FactorNamespace(null,null);
+
+		// data stack primitives
+		FactorWord datastackGet = intern("datastack$");
+		datastackGet.def = new DatastackGet(
+			datastackGet);
+		FactorWord datastackSet = intern("datastack@");
+		datastackSet.def = new DatastackSet(
+			datastackSet);
+		FactorWord clear = intern("clear");
+		clear.def = new Clear(clear);
+
+		// call stack primitives
+		FactorWord callstackGet = intern("callstack$");
+		callstackGet.def = new CallstackGet(
+			callstackGet);
+		FactorWord callstackSet = intern("callstack@");
+		callstackSet.def = new CallstackSet(
+			callstackSet);
+		FactorWord restack = intern("restack");
+		restack.def = new Restack(restack);
+		FactorWord unstack = intern("unstack");
+		unstack.def = new Unstack(unstack);
+		FactorWord unwind = intern("unwind");
+		unwind.def = new Unwind(unwind);
+
+		// reflection primitives
+		FactorWord jinvoke = intern("jinvoke");
+		jinvoke.def = new JInvoke(jinvoke);
+		FactorWord jinvokeStatic = intern("jinvoke-static");
+		jinvokeStatic.def = new JInvokeStatic(
+			jinvokeStatic);
+		FactorWord jnew = intern("jnew");
+		jnew.def = new JNew(jnew);
+		FactorWord jvarGet = intern("jvar$");
+		jvarGet.def = new JVarGet(jvarGet);
+		FactorWord jvarGetStatic = intern("jvar-static$");
+		jvarGetStatic.def = new JVarGetStatic(
+			jvarGetStatic);
+		FactorWord jvarSet = intern("jvar@");
+		jvarSet.def = new JVarSet(jvarSet);
+		FactorWord jvarSetStatic = intern("jvar-static@");
+		jvarSetStatic.def = new JVarSetStatic(
+			jvarSetStatic);
+
+		// namespaces
+		FactorWord get = intern("$");
+		get.def = new Get(get);
+		FactorWord set = intern("@");
+		set.def = new Set(set);
+
+		// definition
+		FactorWord define = intern("define");
+		define.def = new Define(define);
+
+		// combinators
+		FactorWord execute = intern("execute");
+		execute.def = new Execute(execute);
+		FactorWord call = intern("call");
+		call.def = new Call(call);
+		FactorWord bind = intern("bind");
+		bind.def = new Bind(bind);
+		FactorWord choice = intern("?");
+		choice.def = new Choice(choice);
+	} //}}}
+
 	//{{{ initNamespace() method
 	private void initNamespace(Object root) throws Exception
 	{
@@ -111,9 +148,14 @@ public class FactorInterpreter
 
 		global.setVariable("interpreter",this);
 
-		String[] boundFields = { "compile", "compileDump",
+		global.setVariable("error-flag",
+			new FactorNamespace.VarBinding(
+				getClass().getField("errorFlag"),
+				this));
+
+		String[] boundFields = { "compile", "dump",
 			"interactive", "trace",
-			"dict", "errorFlag", "args" };
+			"dict", "args", "global", "last" };
 		for(int i = 0; i < boundFields.length; i++)
 		{
 			global.setVariable(boundFields[i],
@@ -132,8 +174,8 @@ public class FactorInterpreter
 			new InputStreamReader(
 			getClass().getResourceAsStream(
 			initFile)),
-			dict);
+			this);
-		call(dict.intern("[init]"),parser.parse());
+		call(intern("[init]"),parser.parse());
 		run();
 	} //}}}
 
@@ -175,7 +217,7 @@ public class FactorInterpreter
 
 				eval(ip.car);
 			}
-			catch(Exception e)
+			catch(Throwable e)
 			{
 				if(handleError(e))
 					return;
@@ -186,7 +228,7 @@ public class FactorInterpreter
 	} //}}}
 
 	//{{{ handleError() method
-	private boolean handleError(Exception e)
+	private boolean handleError(Throwable e)
 	{
 		/* if(throwErrors)
 		{
@@ -213,10 +255,10 @@ public class FactorInterpreter
 			datastack.push(FactorJava.unwrapException(e));
 			try
 			{
-				eval(dict.intern("break"));
+				eval(intern("break"));
 				return false;
 			}
-			catch(Exception e2)
+			catch(Throwable e2)
 			{
 				System.err.println("Exception when calling break:");
 				e.printStackTrace();
@@ -236,7 +278,7 @@ public class FactorInterpreter
 	 */
 	public final void call(Cons code)
 	{
-		call(dict.intern("call"),code);
+		call(intern("call"),code);
 	} //}}}
 
 	//{{{ call() method
@@ -302,14 +344,14 @@ public class FactorInterpreter
 	/**
 	 * Evaluates a word.
 	 */
-	private void eval(Object obj) throws Exception
+	public void eval(Object obj) throws Exception
 	{
 		if(trace)
 		{
 			StringBuffer buf = new StringBuffer();
 			for(int i = 0; i < callstack.top; i++)
 				buf.append(' ');
-			buf.append(FactorJava.factorTypeToString(obj));
+			buf.append(FactorParser.unparse(obj));
 			System.err.println(buf);
 		}
 
@@ -333,6 +375,25 @@ public class FactorInterpreter
 			datastack.push(obj);
 	} //}}}
 
+	//{{{ intern() method
+	public FactorWord intern(String name)
+	{
+		try
+		{
+			FactorWord w = (FactorWord)dict.getVariable(name);
+			if(w == null)
+			{
+				w = new FactorWord(name);
+				dict.setVariable(name,w);
+			}
+			return w;
+		}
+		catch(Exception e)
+		{
+			throw new RuntimeException(e);
+		}
+	} //}}}
+
 	//{{{ topLevel() method
 	/**
 	 * Returns the parser to the top level context.
@@ -342,7 +403,7 @@ public class FactorInterpreter
 		callstack.top = 0;
 		datastack.top = 0;
 		callframe = new FactorCallFrame(
-			dict.intern("[toplevel]"),
+			intern("[toplevel]"),
 			global,
 			null);
 	} //}}}

factor/FactorJava.java

@@ -29,7 +29,7 @@
 
 package factor;
 
-import factor.compiler.LocalAllocator;
+import factor.compiler.FactorCompiler;
 import java.lang.reflect.*;
 import java.util.Iterator;
 import java.util.LinkedList;
@@ -125,6 +125,18 @@ public class FactorJava implements Constants
 			return true;
 	} //}}}
 
+	//{{{ toByte() method
+	public static byte toByte(Object arg)
+		throws FactorDomainException
+	{
+		if(arg instanceof Number)
+			return ((Number)arg).byteValue();
+		else if(arg instanceof String)
+			return Byte.parseByte((String)arg);
+		else
+			throw new FactorDomainException(arg,byte.class);
+	} //}}}
+
 	//{{{ toChar() method
 	public static char toChar(Object arg)
 		throws FactorDomainException
@@ -232,18 +244,75 @@ public class FactorJava implements Constants
 		}
 	} //}}}
 
+	//{{{ toBooleanArray() method
+	public static boolean[] toBooleanArray(Object arg)
+		throws FactorDomainException
+	{
+		if(arg == null)
+			return new boolean[0];
+		else if(arg instanceof Cons)
+			arg = toArray(arg,Object[].class);
+
+		try
+		{
+			boolean[] returnValue = new boolean[
+				Array.getLength(arg)];
+			for(int i = 0; i < returnValue.length; i++)
+			{
+				returnValue[i] = toBoolean(
+					Array.get(arg,i));
+			}
+			return returnValue;
+		}
+		catch(IllegalArgumentException e)
+		{
+			throw new FactorDomainException(arg,boolean[].class);
+		}
+	} //}}}
+
+	//{{{ toByteArray() method
+	public static byte[] toByteArray(Object arg)
+		throws FactorDomainException
+	{
+		if(arg == null)
+			return new byte[0];
+		else if(arg instanceof Cons)
+			arg = toArray(arg,Object[].class);
+
+		try
+		{
+			byte[] returnValue = new byte[
+				Array.getLength(arg)];
+			for(int i = 0; i < returnValue.length; i++)
+			{
+				returnValue[i] = toByte(
+					Array.get(arg,i));
+			}
+			return returnValue;
+		}
+		catch(IllegalArgumentException e)
+		{
+			throw new FactorDomainException(arg,byte[].class);
+		}
+	} //}}}
+
 	//{{{ toArray() method
 	public static Object[] toArray(Object arg)
 		throws FactorDomainException
 	{
-		return toArray(arg,Object.class);
+		return toArray(arg,Object[].class);
 	} //}}}
 
 	//{{{ toArray() method
 	public static Object[] toArray(Object arg, Class clas)
 		throws FactorDomainException
 	{
-		if(arg instanceof Cons)
+		if(arg == null)
+		{
+			return (Object[])Array.newInstance(
+				clas.getComponentType(),0);
+		}
+		else if(arg instanceof Cons)
 		{
 			Cons list = (Cons)arg;
 			Object[] array = (Object[])
@@ -293,6 +362,10 @@ public class FactorJava implements Constants
 				? Boolean.TRUE
 				: Boolean.FALSE;
 		}
+		else if(clas == byte.class)
+		{
+			return new Byte(toByte(arg));
+		}
 		else if(clas == char.class)
 		{
 			return new Character(toChar(arg));
@@ -319,7 +392,11 @@ public class FactorJava implements Constants
 		}
 		else if(clas.isArray())
 		{
-			return toArray(arg,clas);
+			Class comp = clas.getComponentType();
+			if(!comp.isPrimitive())
+				return toArray(arg,clas);
+			else if(comp == boolean.class)
+				return toBooleanArray(arg);
 		}
 
 		if(arg != null && !clas.isInstance(arg))
@@ -343,25 +420,6 @@ public class FactorJava implements Constants
 			return arg;
 	} //}}}
 
-	//{{{ factorTypeToString() method
-	public static String factorTypeToString(Object obj)
-	{
-		// this is for string representations of lists and stacks
-		if(obj == null || obj.equals(Boolean.FALSE))
-			return "f";
-		else if(obj.equals(Boolean.TRUE))
-			return "t";
-		else if(obj instanceof String)
-			return '"' + obj.toString() + '"'; //XXX: escape
-		else if(obj instanceof Number
-			|| obj instanceof FactorExternalizable)
-			return obj.toString();
-		else if(obj instanceof Character)
-			return "#\\" + ((Character)obj).charValue();
-		else
-			return "( " + obj + " )";
-	} //}}}
-
 	//{{{ javaClassToVMClass() method
 	public static String javaClassToVMClass(Class clazz)
 	{
@@ -583,6 +641,29 @@ public class FactorJava implements Constants
 			return e;
 	} //}}}
 
+	//{{{ getConversionMethodName() method
+	/**
+	 * Returns method name for converting an object to the given type.
+	 * Only for primitives.
+	 */
+	public static String getConversionMethodName(Class type)
+	{
+		if(type == short.class)
+		{
+			// not yet done.
+			return null;
+		}
+		else if(type.isPrimitive())
+		{
+			String name = type.getName();
+			return "to"
+				+ Character.toUpperCase(name.charAt(0))
+				+ name.substring(1);
+		}
+		else
+			return null;
+	} //}}}
+
 	//{{{ generateFromConversion() method
 	/**
 	 * Unbox value at top of the stack.
@@ -600,18 +681,15 @@ public class FactorJava implements Constants
 			methodName = "toNumber";
 		else if(type == String.class)
 			methodName = "toString";
-		else if(type == boolean.class)
+		else if(type == short.class
-			methodName = "toBoolean";
+			|| type == byte.class
-		else if(type == char.class)
+			|| type == char.class)
-			methodName = "toChar";
+		{
-		else if(type == int.class)
+			// not yet done.
-			methodName = "toInt";
+			methodName = null;
-		else if(type == long.class)
+		}
-			methodName = "toLong";
+		else if(type.isPrimitive())
-		else if(type == float.class)
+			methodName = getConversionMethodName(type);
-			methodName = "toFloat";
-		else if(type == double.class)
-			methodName = "toDouble";
 		else if(type == Class.class)
 			methodName = "toClass";
 		else if(type == FactorNamespace.class)
@@ -620,7 +698,16 @@ public class FactorJava implements Constants
 			interpArg = true;
 		}
 		else if(type.isArray())
-			methodName = "toArray";
+		{
+			Class comp = type.getComponentType();
+			if(comp.isPrimitive())
+			{
+				methodName = getConversionMethodName(comp)
+					+ "Array";
+			}
+			else
+				methodName = "toArray";
+		}
 
 		if(methodName == null)
 		{

factor/FactorMath.java

@@ -278,8 +278,7 @@ public class FactorMath
 		if(min == max)
 			return min;
 
-		int nextInt = random.nextInt();
+		return min + random.nextInt(max - min + 1);
-		return min + Math.abs(nextInt % (max - min + 1));
 	} //}}}
 
 	//{{{ randomFloat() method

factor/FactorMissingDefinition.java

@@ -50,6 +50,13 @@ public class FactorMissingDefinition extends FactorWordDefinition
 		throw new FactorUndefinedWordException(word);
 	} //}}}
 
+	//{{{ toList() method
+	public Cons toList()
+	{
+		return new Cons(new FactorWord("( missing: " + word + " )"),
+			null);
+	} //}}}
+
 	//{{{ toString() method
 	public String toString()
 	{

factor/FactorNamespace.java

@@ -42,10 +42,10 @@ import java.util.List;
 /**
  * Manages the set of available words.
  */
-public class FactorNamespace implements PublicCloneable
+public class FactorNamespace implements PublicCloneable, FactorObject
 {
-	private static FactorWord NULL = new FactorWord("(represent-f)");
+	private static FactorWord NULL = new FactorWord("( represent-f )");
-	private static FactorWord CHECK_PARENT = new FactorWord("(check-parent)");
+	private static FactorWord CHECK_PARENT = new FactorWord("( check-parent )");
 
 	public Object obj;
 	private FactorNamespace parent;
@@ -105,6 +105,12 @@ public class FactorNamespace implements PublicCloneable
 		}
 	} //}}}
 
+	//{{{ getNamespace() method
+	public FactorNamespace getNamespace(FactorInterpreter interp)
+	{
+		return this;
+	} //}}}
+
 	//{{{ getParent() method
 	public FactorNamespace getParent()
 	{
@@ -200,20 +206,48 @@ public class FactorNamespace implements PublicCloneable
 		words.put(name,CHECK_PARENT);
 	} //}}}
 
+	//{{{ initAllFields() method
+	private void initAllFields()
+	{
+		if(obj != null)
+		{
+			try
+			{
+				Field[] fields = obj.getClass().getFields();
+				for(int i = 0; i < fields.length; i++)
+				{
+					Field f = fields[i];
+					if(Modifier.isStatic(f.getModifiers()))
+						continue;
+					words.put(f.getName(),
+						new VarBinding(f,obj));
+				}
+			}
+			catch(Exception e)
+			{
+			}
+		}
+	} //}}}
+
 	//{{{ toVarList() method
 	/**
 	 * Returns a list of variable and word names defined in this namespace.
 	 */
 	public Cons toVarList()
 	{
+		initAllFields();
+
 		Cons first = null;
 		Cons last = null;
 		Iterator iter = words.entrySet().iterator();
 		while(iter.hasNext())
 		{
 			Map.Entry entry = (Map.Entry)iter.next();
-			if(entry.getValue() == CHECK_PARENT)
+			Object value = entry.getValue();
+			if(value == CHECK_PARENT)
 				continue;
+			else if(value == NULL)
+				value = null;
 
 			String name = (String)entry.getKey();
 			Cons cons = new Cons(name,null);
@@ -235,18 +269,33 @@ public class FactorNamespace implements PublicCloneable
 	 */
 	public Cons toValueList()
 	{
+		initAllFields();
+
 		Cons first = null;
 		Cons last = null;
 		Iterator iter = words.entrySet().iterator();
 		while(iter.hasNext())
 		{
 			Map.Entry entry = (Map.Entry)iter.next();
-			if(entry.getValue() == CHECK_PARENT)
+			Object value = entry.getValue();
+			if(value == CHECK_PARENT)
 				continue;
+			else if(value == NULL)
+				value = null;
 
-			Cons cons = new Cons(
+			if(value instanceof VarBinding)
-				new Cons(entry.getKey(),
+			{
-				entry.getValue()),null);
+				try
+				{
+					value = ((VarBinding)value).get();
+				}
+				catch(Exception e)
+				{
+				}
+			}
+
+			Cons cons = new Cons(new Cons(entry.getKey(),value)
+				,null);
 			if(first == null)
 				first = last = cons;
 			else
@@ -291,11 +340,10 @@ public class FactorNamespace implements PublicCloneable
 	{
 		if(obj == null)
 		{
-			return "( Namespace #" + Integer.toString(hashCode(),16)
+			return "Namespace #" + Integer.toString(hashCode(),16);
-				+ " )";
 		}
 		else
-			return "( Namespace: " + obj + " #" + hashCode() + " )";
+			return "Namespace: " + obj + " #" + hashCode();
 	} //}}}
 
 	//{{{ clone() method

factor/FactorParser.java

@@ -52,32 +52,33 @@ public class FactorParser
 
 	private String filename;
 	private Reader in;
-	private FactorDictionary dict;
+	private FactorInterpreter interp;;
 	private StreamTokenizer st;
 
 	// sometimes one token is expanded into two words
 	private Object next;
 
 	//{{{ FactorParser constructor
-	public FactorParser(String filename, Reader in, FactorDictionary dict)
+	public FactorParser(String filename, Reader in,
+		FactorInterpreter interp)
 	{
 		this.filename = (filename == null ? "<eval>" : filename);
 		this.in = in;
-		this.dict = dict;
+		this.interp = interp;
 
-		DEF = dict.intern(":");
+		DEF = interp.intern(":");
-		INE = dict.intern(";");
+		INE = interp.intern(";");
 
-		SHU = dict.intern("~<<");
+		SHU = interp.intern("~<<");
-		F = dict.intern("--");
+		F = interp.intern("--");
-		FLE = dict.intern(">>~");
+		FLE = interp.intern(">>~");
 
-		DEFINE = dict.intern("define");
+		DEFINE = interp.intern("define");
 
-		BRA = dict.intern("[");
+		BRA = interp.intern("[");
-		KET = dict.intern("]");
+		KET = interp.intern("]");
 
-		COMMA = dict.intern(",");
+		COMMA = interp.intern(",");
 
 		st = new StreamTokenizer(in);
 		st.resetSyntax();
@@ -293,13 +294,13 @@ public class FactorParser
 				// $foo is expanded into "foo" $
 				if(st.sval.charAt(0) == '$')
 				{
-					next = dict.intern("$");
+					next = interp.intern("$");
 					return st.sval.substring(1);
 				}
 				// @foo is expanded into "foo" @
 				else if(st.sval.charAt(0) == '@')
 				{
-					next = dict.intern("@");
+					next = interp.intern("@");
 					return st.sval.substring(1);
 				}
 			}
@@ -308,7 +309,7 @@ public class FactorParser
 			if(st.sval.charAt(0) == '|')
 				return st.sval.substring(1);
 
-			return dict.intern(st.sval);
+			return interp.intern(st.sval);
 		case '"': case '\'':
 			return st.sval;
 		default:
@@ -363,7 +364,7 @@ public class FactorParser
 				int counter;
 				if(name.startsWith("r:"))
 				{
-					next = dict.intern(name.substring(2));
+					next = interp.intern(name.substring(2));
 					counter = (FactorShuffleDefinition
 						.FROM_R_MASK
 						| consumeR++);
@@ -378,7 +379,7 @@ public class FactorParser
 			}
 			else
 			{
-				error("Unexpected " + FactorJava.factorTypeToString(
+				error("Unexpected " + FactorParser.unparse(
 					next));
 			}
 		}
@@ -407,7 +408,7 @@ public class FactorParser
 				FactorWord w = ((FactorWord)_shuffle.car);
 				String name = w.name;
 				if(name.startsWith("r:"))
-					w = dict.intern(name.substring(2));
+					w = interp.intern(name.substring(2));
 
 				Integer _index = (Integer)consumeMap.get(w);
 				if(_index == null)
@@ -429,7 +430,7 @@ public class FactorParser
 			}
 			else
 			{
-				error("Unexpected " + FactorJava.factorTypeToString(
+				error("Unexpected " + FactorParser.unparse(
 					_shuffle.car));
 			}
 			_shuffle = _shuffle.next();
@@ -544,4 +545,52 @@ public class FactorParser
 	{
 		throw new FactorParseException(filename,st.lineno(),msg);
 	} //}}}
+
+	//{{{ getUnreadableString() method
+	public static String getUnreadableString(String str)
+	{
+		return "#<" + str + ">";
+	} //}}}
+
+	//{{{ unparse() method
+	public static String unparse(Object obj)
+	{
+		// this is for string representations of lists and stacks
+		if(obj == null || obj.equals(Boolean.FALSE))
+			return "f";
+		else if(obj.equals(Boolean.TRUE))
+			return "t";
+		else if(obj instanceof String)
+		{
+			StringBuffer buf = new StringBuffer("\"");
+			String str = (String)obj;
+			for(int i = 0; i < str.length(); i++)
+			{
+				char ch = str.charAt(i);
+				switch(ch)
+				{
+				case '\n':
+					buf.append("\\n");
+					break;
+				case '\t':
+					buf.append("\\t");
+					break;
+				case '"':
+					buf.append("\\\"");
+					break;
+				default:
+					buf.append(ch);
+				}
+			}
+			buf.append('"');
+			return buf.toString();
+		}
+		else if(obj instanceof Number
+			|| obj instanceof FactorExternalizable)
+			return obj.toString();
+		else if(obj instanceof Character)
+			return "#\\" + ((Character)obj).charValue();
+		else
+			return getUnreadableString(obj.toString());
+	} //}}}
 }

factor/FactorShuffleDefinition.java

@@ -30,7 +30,7 @@
 package factor;
 
 import factor.compiler.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 import org.objectweb.asm.util.*;
 
@@ -109,14 +109,12 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,consumeD);
 		state.ensure(state.callstack,consumeR);
 		eval(state.datastack,state.callstack);
-		return new StackEffect(consumeD,shuffleDlength,
-			consumeR,shuffleRlength);
 	} //}}}
 
 	//{{{ compile() method
@@ -124,7 +122,7 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 	 * Compile the given word, returning a new word definition.
 	 */
 	FactorWordDefinition compile(FactorInterpreter interp,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck) throws Exception
 	{
 		return this;
 	} //}}}
@@ -133,10 +131,10 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	public int compileCallTo(CodeVisitor mw, LocalAllocator allocator,
+	public int compileCallTo(CodeVisitor mw, FactorCompiler compiler,
-		Set recursiveCheck) throws FactorStackException
+		RecursiveState recursiveCheck) throws FactorStackException
 	{
-		eval(allocator.datastack,allocator.callstack);
+		eval(compiler.datastack,compiler.callstack);
 		return 0;
 	} //}}}
 
@@ -213,6 +211,13 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 		}
 	} //}}}
 
+	//{{{ toList() method
+	public Cons toList()
+	{
+		return new Cons(word,new Cons(
+			new FactorWord(toString()),null));
+	} //}}}
+
 	//{{{ toString() method
 	public String toString()
 	{

factor/FactorWord.java

@@ -29,14 +29,18 @@
 
 package factor;
 
-import factor.compiler.FactorCompilerException;
+import factor.compiler.*;
 import java.util.*;
 
 /**
  * An internalized symbol.
  */
-public class FactorWord implements FactorExternalizable
+public class FactorWord implements FactorExternalizable, FactorObject
 {
+	private static int gensymCount = 0;
+
+	private FactorNamespace namespace;
+
 	public final String name;
 
 	/**
@@ -45,14 +49,9 @@ public class FactorWord implements FactorExternalizable
 	public FactorWordDefinition def;
 
 	/**
-	 * Definition before compiling.
+	 * Contains a string if this is compiled.
 	 */
-	public FactorWordDefinition uncompiled;
+	public String asm;
-
-	/**
-	 * "define" pushes previous definitions onto this list, like a stack.
-	 */
-	public Cons history;
 
 	/**
 	 * Is this word referenced from a compiled word?
@@ -71,60 +70,69 @@ public class FactorWord implements FactorExternalizable
 		def = new FactorMissingDefinition(this);
 	} //}}}
 
+	//{{{ getNamespace() method
+	public FactorNamespace getNamespace(FactorInterpreter interp)
+		throws Exception
+	{
+		if(namespace == null)
+			namespace = new FactorNamespace(interp.global,this);
+
+		return namespace;
+	} //}}}
+
+	//{{{ gensym() method
+	/**
+	 * Returns an un-internalized word with a unique name.
+	 */
+	public static FactorWord gensym()
+	{
+		return new FactorWord("( GENSYM:" + (gensymCount++) + " )");
+	} //}}}
+
 	//{{{ define() method
 	public void define(FactorWordDefinition def)
 	{
+		asm = null;
+
 		if(compileRef)
 		{
 			System.err.println("WARNING: " + this
 				+ " is used in one or more compiled words; old definition will remain until full recompile");
 		}
 		else if(!(this.def instanceof FactorMissingDefinition))
-		{
 			System.err.println("WARNING: redefining " + this);
-			history = new Cons(this.def,history);
-		}
 
-		uncompiled = this.def = def;
+		this.def = def;
 	} //}}}
 
 	//{{{ compile() method
 	public void compile(FactorInterpreter interp)
 	{
-		compile(interp,new HashSet());
+		RecursiveState recursiveCheck = new RecursiveState();
+		recursiveCheck.add(this,null);
+		compile(interp,recursiveCheck);
+		recursiveCheck.remove(this);
 	} //}}}
 
 	//{{{ compile() method
-	public void compile(FactorInterpreter interp, Set recursiveCheck)
+	public void compile(FactorInterpreter interp, RecursiveState recursiveCheck)
 	{
-		if(def.compileFailed)
+		//if(def.compileFailed)
-			return;
+		//	return;
 
-		System.err.println("Compiling " + this);
+		//System.err.println("Compiling " + this);
-		if(recursiveCheck.contains(this))
-			System.err.println("WARNING: cannot compile recursive calls: " + this);
 
 		try
 		{
-			recursiveCheck.add(this);
-
 			def = def.compile(interp,recursiveCheck);
 		}
-		catch(FactorCompilerException e)
-		{
-			def.compileFailed = true;
-			System.err.println("WARNING: cannot compile " + this);
-			System.err.println(e.getMessage());
-		}
 		catch(Throwable t)
 		{
 			def.compileFailed = true;
-			System.err.println("WARNING: cannot compile " + this);
+			/*System.err.println("WARNING: cannot compile " + this
-			t.printStackTrace();
+				+ ": " + t.getMessage());
-		}
+			if(!(t instanceof FactorException))
-		finally
+				t.printStackTrace();*/
-		{
-			recursiveCheck.remove(this);
 		}
 	} //}}}
 

factor/FactorWordDefinition.java

@@ -30,16 +30,14 @@
 package factor;
 
 import factor.compiler.*;
-import java.util.HashSet;
+import java.util.*;
-import java.util.Set;
 import org.objectweb.asm.*;
 
 /**
  * A word definition.
  */
-public abstract class FactorWordDefinition implements FactorObject, Constants
+public abstract class FactorWordDefinition implements Constants
 {
-	private FactorNamespace namespace;
 	protected FactorWord word;
 
 	public boolean compileFailed;
@@ -52,31 +50,39 @@ public abstract class FactorWordDefinition implements FactorObject, Constants
 	public abstract void eval(FactorInterpreter interp)
 		throws Exception;
 
-	//{{{ getNamespace() method
+	//{{{ toList() method
-	public FactorNamespace getNamespace(FactorInterpreter interp) throws Exception
+	public Cons toList()
 	{
-		if(namespace == null)
+		return new Cons(new FactorWord(getClass().getName()),null);
-			namespace = new FactorNamespace(interp.global,this);
-
-		return namespace;
 	} //}}}
 
 	//{{{ getStackEffect() method
 	public final StackEffect getStackEffect() throws Exception
 	{
-		return getStackEffect(new HashSet(),new LocalAllocator());
+		return getStackEffect(new RecursiveState());
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public final StackEffect getStackEffect(RecursiveState recursiveCheck)
-		LocalAllocator state) throws Exception
+		throws Exception
 	{
-		return null;
+		FactorCompiler compiler = new FactorCompiler();
+		recursiveCheck.add(word,new StackEffect());
+		getStackEffect(recursiveCheck,compiler);
+		recursiveCheck.remove(word);
+		return compiler.getStackEffect();
+	} //}}}
+
+	//{{{ getStackEffect() method
+	public void getStackEffect(RecursiveState recursiveCheck,
+		FactorCompiler compiler) throws Exception
+	{
+		throw new FactorCompilerException("Cannot deduce stack effect of " + word);
 	} //}}}
 
 	//{{{ compile() method
 	FactorWordDefinition compile(FactorInterpreter interp,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck) throws Exception
 	{
 		return this;
 	} //}}}
@@ -85,44 +91,99 @@ public abstract class FactorWordDefinition implements FactorObject, Constants
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	public int compileCallTo(CodeVisitor mw, LocalAllocator allocator,
+	public int compileCallTo(CodeVisitor mw, FactorCompiler compiler,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck) throws Exception
 	{
-		StackEffect effect = getStackEffect();
+		// normal word
-		if(effect == null)
+		mw.visitVarInsn(ALOAD,0);
+
+		String defclass;
+		StackEffect effect;
+
+		RecursiveForm rec = recursiveCheck.get(word);
+		if(rec != null && rec.active && compiler.word == word)
 		{
-			// combinator; inline
+			// recursive call!
-			return compileImmediate(mw,allocator,recursiveCheck);
+			defclass = compiler.className;
+			effect = compiler.word.def.getStackEffect();
+		}
+		else if(this instanceof FactorCompoundDefinition)
+		{
+			throw new FactorCompilerException("You are an idiot!");
 		}
 		else
 		{
-			// normal word
+			defclass = getClass().getName()
-			mw.visitVarInsn(ALOAD,0);
+				.replace('.','/');
-
+			effect = getStackEffect();
-			allocator.generateArgs(mw,effect.inD,null);
-
-			String defclass = getClass().getName().replace('.','/');
-
-			String signature = effect.getCorePrototype();
-
-			mw.visitMethodInsn(INVOKESTATIC,defclass,"core",signature);
-
-			if(effect.outD > 1)
-				throw new FactorCompilerException("Cannot compile word with non-0/1-out factors");
-			if(effect.outD == 1)
-				allocator.push(mw);
-
-			return effect.inD + 1;
 		}
+
+		compiler.generateArgs(mw,effect.inD,null);
+
+		String signature = effect.getCorePrototype();
+
+		mw.visitMethodInsn(INVOKESTATIC,defclass,"core",signature);
+
+		if(effect.outD == 0)
+		{
+			// do nothing
+		}
+		else if(effect.outD == 1)
+		{
+			compiler.push(mw);
+		}
+		else
+		{
+			// transfer from data stack to JVM locals
+			FactorDataStack datastack = compiler.datastack;
+
+			// allocate the appropriate number of locals
+			compiler.produce(compiler.datastack,effect.outD);
+
+			// store the datastack instance somewhere
+			mw.visitVarInsn(ALOAD,0);
+			mw.visitFieldInsn(GETFIELD,
+				"factor/FactorInterpreter",
+				"datastack",
+				"Lfactor/FactorDataStack;");
+			int datastackLocal = compiler.allocate();
+			mw.visitVarInsn(ASTORE,datastackLocal);
+
+			// put all elements from the real datastack
+			// into locals
+			for(int i = 0; i < effect.outD; i++)
+			{
+				mw.visitVarInsn(ALOAD,datastackLocal);
+				mw.visitMethodInsn(INVOKEVIRTUAL,
+					"factor/FactorDataStack",
+					"pop",
+					"()Ljava/lang/Object;");
+
+				Result destination = (Result)
+					datastack.stack[
+					datastack.top - i - 1];
+
+				mw.visitVarInsn(ASTORE,destination.getLocal());
+			}
+
+		}
+
+		return effect.inD + 1;
 	} //}}}
 
 	//{{{ compileImmediate() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	public int compileImmediate(CodeVisitor mw, LocalAllocator allocator,
+	public int compileImmediate(CodeVisitor mw, FactorCompiler compiler,
-		Set recursiveCheck) throws Exception
+		RecursiveState recursiveCheck) throws Exception
 	{
 		throw new FactorCompilerException("Cannot compile " + word + " in immediate mode");
 	} //}}}
+
+	//{{{ toString() method
+	public String toString()
+	{
+		return getClass().getName() + ": " + word;
+	} //}}}
 }

factor/boot.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2003 Slava Pestov.
+! Copyright (C) 2003, 2004 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -53,11 +53,12 @@
 ~<< tuck            A B -- B A B       >>~
 ~<< 2tuck       A B C D -- C D A B C D >>~
 
-~<< rdrop   r:A --         >>~
+~<< rdrop   r:A --                 >>~
-~<< >r        A -- r:A     >>~
+~<< rover   r:A r:B -- r:A r:B r:A >>~
-~<< 2>r     A B -- r:A r:B >>~
+~<< >r        A -- r:A             >>~
-~<< r>      r:A -- A       >>~
+~<< 2>r     A B -- r:A r:B         >>~
-~<< 2r> r:A r:B -- A B     >>~
+~<< r>      r:A -- A               >>~
+~<< 2r> r:A r:B -- A B             >>~
 
 !!! Minimum amount of I/O words needed to be able to read other resources.
 !!! Remaining I/O operations are defined in io.factor and parser.factor.
@@ -73,8 +74,8 @@
     <ireader> <breader> ;
 
 : parse* (filename reader -- list)
-    $dict
+    $interpreter
-    [ |java.lang.String |java.io.Reader |factor.FactorDictionary ]
+    [ |java.lang.String |java.io.Reader |factor.FactorInterpreter ]
     |factor.FactorParser jnew
     [ ] |factor.FactorParser |parse jinvoke ;
 
@@ -87,8 +88,11 @@
 
 "/factor/combinators.factor"   runResource
 "/factor/continuations.factor" runResource
+"/factor/debugger.factor"      runResource
 "/factor/dictionary.factor"    runResource
 "/factor/examples.factor"      runResource
+"/factor/httpd.factor"         runResource
+"/factor/inspector.factor"     runResource
 "/factor/interpreter.factor"   runResource
 "/factor/lists.factor"         runResource
 "/factor/math.factor"          runResource
@@ -96,9 +100,13 @@
 "/factor/namespaces.factor"    runResource
 "/factor/network.factor"       runResource
 "/factor/parser.factor"        runResource
-"/factor/random.factor"        runResource
 "/factor/stream.factor"        runResource
+"/factor/prettyprint.factor"   runResource
+"/factor/random.factor"        runResource
 "/factor/strings.factor"       runResource
+"/factor/test/test.factor"     runResource
+
+t @user-init
 
 : cli-param ( param -- )
     dup "no-" str-head? dup [
@@ -113,7 +121,19 @@
 $args [ cli-arg ] each
 
 ! Compile all words now
-$compile [ compileAll ] when
+$compile [
+    compile-all
+] when
+
+$~ $/ ".factor-rc" cat3 @init-path
+
+$user-init [
+    $init-path dup exists? [ run-file ] [ drop ] ifte
+] when
 
 ! If we're run stand-alone, start the interpreter in the current tty.
-$interactive [ initialInterpreterLoop ] when
+$interactive [
+    [ @top-level-continuation ] callcc0
+
+    initial-interpreter-loop
+] when

factor/combinators.factor

@@ -25,7 +25,7 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-: apply2 (x y [ code ] --)
+: 2apply (x y [ code ] --)
     ! First applies the code to x, then to y.
     2dup 2>r
         nip call
@@ -46,12 +46,12 @@
     ! callstack.
     r:P r:T r:R1 r:R2 -- R1 r:P r:T r:R1 r:R2 >>~
 
-~<< binrecLeft
+~<< binrec-left
     ! Left recursion setup; put second value on callstack, put P, T, R1, R2
     ! on data stack (and leave them on the callstack too).
     Value2 r:P r:T r:R1 r:R2 -- P T R1 R2 r:Value2 r:P r:T r:R1 r:R2 >>~
 
-~<< binrecRight
+~<< binrec-right
     ! Right recursion setup; put second value back on datastack, put
     ! P, T, R1, R2 on data stack. All quotations except for R2 are
     ! discarded from the callstack, since they're not needed anymore.
@@ -67,8 +67,8 @@
         binrecR1 call
         ! R1 has now produced two values on top of the data stack.
         ! Recurse twice.
-        binrecLeft  binrec
+        binrec-left  binrec
-        binrecRight binrec
+        binrec-right binrec
         ! Now call R2.
         r> call
     ] ifte ;
@@ -85,7 +85,7 @@
     r>
     call ;
 
-: cond (list --)
+: cond ( x list -- )
     ! The list is of this form:
     ! [ [ condition 1 ] [ code 1 ]
     !   [ condition 2 ] [ code 2 ]
@@ -121,7 +121,7 @@
         call
     2r> ;
 
-: each ([ list ] [ code ] --)
+: each ( [ list ] [ code ] -- )
     ! Applies the code to each element of the list.
     over [
         [ uncons ] dip tuck [ call ] 2dip each
@@ -129,6 +129,21 @@
         2drop
     ] ifte ;
 
+~<< 2each{
+    A1 D1 A2 D2 C -- A1 A2 C r:D1 r:D2 r:C >>~
+
+~<< }2each
+    r:D1 r:D2 r:C -- D1 D2 C >>~
+
+: 2each ( [ list ] [ list ] [ code ] -- )
+    ! Push each pair of elements from the 2 lists in turn, then
+    ! execute the code.
+    over [
+        [ [ uncons ] 2apply ] dip 2each{ call }2each 2each
+    ] [
+        drop drop drop
+    ] ifte ;
+
 : expand (list -- list)
     ! Evaluates the list on a new stack, and pushes the reversed stack onto the
     ! original stack. For example, "[ 0 1 2 dup * + ] expand" will evaluate to
@@ -138,6 +153,11 @@
         call
     unstack ;
 
+: forever ( code -- )
+    ! The code is evaluated forever. Typically, a continuation
+    ! is used to escape the infinite loop.
+    dup dip forever ;
+
 : ifte (cond [if true] [if false] --)
     ? call ;
 
@@ -155,31 +175,44 @@
     ! and evaluate R2. This combinator is similar to the linrec combinator in
     ! Joy, except in Joy, P does not affect the stack.
     >r >r >r dup >r call [
-        r> drop r> call
+        rdrop r> call
-        r> drop r> drop
+        rdrop rdrop
     ] [
         r> r> r> dup >r swap >r swap >r call
         r> r> r> r> dup >r linrec
         r> call
     ] ifte ;
 
-: map ( [ items ] [ code ] -- [ mapping ] )
+: map ( [ items ] [ code ] -- [ mapping ])
     ! Applies the code to each item, returns a list that
     ! contains the result of each application.
     2list restack each unstack ;
 
-: push ([ a b c ... ] -- a b c ...)
+: 2map ( [ list ] [ list ] [ code ] -- [ mapping ] )
-    ! Pushes values onto the stack literally (even if they are words).
+    ! Applies the code to each pair of items, returns a list
-    [ uncons push ] when* ;
+    ! that contains the result of each application.
+    3list restack 2each unstack ;
 
-: subset (list code -- list)
+: subset ( list code -- list )
-    ! Applies code to each element of the given list, creating a new list
-    ! containing the elements where the code returned a non-null value.
     [ dupd call [ drop ] unless ] cons 2list
     restack
         each
     unstack ;
 
+: treerec ( list quot -- )
+    ! Apply quot to each element of the list; if an element is a
+    ! list, first quot is called with the list itself, then a
+    ! recursive call to listrec is made.
+    over [
+        [ uncons ] dip tuck [
+            over list? [
+                2dup [ treerec ] 2dip
+            ] when call
+        ] 2dip treerec
+    ] [
+        2drop
+    ] ifte ;
+
 : times (n [ code ] --)
     ! Evaluates code n times.
     [
@@ -202,6 +235,11 @@
 : unless (cond [if false] --)
     f swap ? call ;
 
+: unless* ( cond false -- )
+    ! If cond is f, pop it off the stack and evaluate false.
+    ! Otherwise, leave it on the stack.
+    over [ drop ] [ nip call ] ifte ;
+
 : when (cond [if true] --)
     f ? call ;
 
@@ -213,8 +251,7 @@
 : while ( [ P ] [ R ] -- ... )
     ! Evaluates P. If it leaves t on the stack, evaluate R, and recurse.
     >r dup >r call [
-        r> r> dup >r swap >r call
+        rover r> call r> r> while
-        r> r> while
     ] [
-        r> drop r> drop
+        rdrop rdrop
     ] ifte ;

factor/compiler/CompiledChoice.java

@@ -0,0 +1,316 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public class CompiledChoice extends FlowObject implements Constants
+{
+	FlowObject cond, t, f;
+
+	//{{{ CompiledChoice constructor
+	CompiledChoice(FlowObject cond, FlowObject t, FlowObject f,
+		FactorCompiler compiler, RecursiveState recursiveCheck)
+	{
+		super(compiler,recursiveCheck);
+		this.cond = cond;
+		this.t = t;
+		this.f = f;
+	} //}}}
+
+	//{{{ generate() method
+	public void generate(CodeVisitor mw)
+	{
+		// if null jump to F
+		// T
+		// jump END
+		// F: F
+		// END: ...
+		Label fl = new Label();
+		Label endl = new Label();
+
+		cond.generate(mw);
+		mw.visitJumpInsn(IFNULL,fl);
+
+		t.generate(mw);
+
+		mw.visitJumpInsn(GOTO,endl);
+		mw.visitLabel(fl);
+		f.generate(mw);
+		mw.visitLabel(endl);
+	} //}}}
+
+	//{{{ usingLocal() method
+	boolean usingLocal(int local)
+	{
+		return cond.usingLocal(local)
+			|| t.usingLocal(local)
+			|| f.usingLocal(local);
+	} //}}}
+
+	//{{{ getStackEffect() method
+	/**
+	 * Stack effect of executing this -- only used for lists
+	 * and conditionals!
+	 */
+	public void getStackEffect(RecursiveState recursiveCheck)
+		throws Exception
+	{
+		StackEffect onEntry = recursiveCheck.last().effect;
+
+		FactorDataStack datastackCopy = (FactorDataStack)
+			compiler.datastack.clone();
+		FactorCallStack callstackCopy = (FactorCallStack)
+			compiler.callstack.clone();
+		StackEffect effectCopy = (StackEffect)
+			compiler.getStackEffect();
+
+		StackEffect te = compiler.getStackEffectOrNull(
+			t,recursiveCheck,false);
+		//System.err.println("te=" + te);
+
+		/** Other branch. */
+		FactorDataStack obDatastack = compiler.datastack;
+		FactorCallStack obCallstack = compiler.callstack;
+		StackEffect obEffect = compiler.getStackEffect();
+
+		compiler.datastack = (FactorDataStack)
+			datastackCopy.clone();
+		compiler.callstack = (FactorCallStack)
+			callstackCopy.clone();
+		compiler.effect = (StackEffect)effectCopy.clone();
+
+		StackEffect fe = compiler.getStackEffectOrNull(
+			f,recursiveCheck,false);
+		//System.err.println("fe=" + fe);
+
+		//System.err.println("rec=" + rec);
+		if(fe != null && te == null)
+		{
+			RecursiveForm rec = t.getWord();
+			if(rec == null)
+				throw new FactorCompilerException("Unscoped quotation: " + t);
+			rec.baseCase = fe;
+			//System.err.println("base=" + fe);
+			compiler.datastack = (FactorDataStack)
+				datastackCopy.clone();
+			compiler.callstack = (FactorCallStack)
+				callstackCopy.clone();
+			compiler.effect = (StackEffect)
+				effectCopy.clone();
+			t.getStackEffect(recursiveCheck);
+			te = compiler.getStackEffect();
+			//te = StackEffect.decompose(onEntry,te);
+			//System.err.println("te=" + te);
+		}
+		else if(fe == null && te != null)
+		{
+			RecursiveForm rec = f.getWord();
+			if(rec == null)
+				throw new FactorCompilerException("Unscoped quotation: " + t);
+			//System.err.println("base=" + te);
+			rec.baseCase = te;
+			compiler.datastack = (FactorDataStack)
+				datastackCopy.clone();
+			compiler.callstack = (FactorCallStack)
+				callstackCopy.clone();
+			compiler.effect = (StackEffect)
+				effectCopy.clone();
+			f.getStackEffect(recursiveCheck);
+			fe = compiler.getStackEffect();
+			//fe = StackEffect.decompose(onEntry,te);
+			//System.err.println("fe=" + fe);
+		}
+
+		if(te == null || fe == null)
+			throw new FactorCompilerException("Indeterminate recursive choice");
+
+		// we can only balance out a conditional if
+		// both sides leave the same amount of elements
+		// on the stack.
+		// eg, 1/1 -vs- 2/2 is ok, 3/1 -vs- 4/2 is ok,
+		// but 1/2 -vs- 2/1 is not.
+		int balanceTD = te.outD - te.inD;
+		int balanceTR = te.outR - te.inR;
+		int balanceFD = fe.outD - fe.inD;
+		int balanceFR = fe.outR - fe.inR;
+		if(balanceTD != balanceFD || balanceTR != balanceFR)
+		{
+			throw new FactorCompilerException("Stack effect of " + t + " " + te + " is inconsistent with " + f + " " + fe + ", head is " + effectCopy);
+		}
+
+		// find how many elements of the t branch match with the f
+		// branch and don't discard those.
+		int highestEqual = 0;
+
+		for(highestEqual = 0; highestEqual < fe.outD; highestEqual++)
+		{
+			Object o1 = obDatastack.stack[
+				obDatastack.top - highestEqual - 1];
+			Object o2 = compiler.datastack.stack[
+				obDatastack.top - highestEqual - 1];
+			if(!o1.equals(o2))
+				break;
+		}
+
+		// replace results from the f branch with
+		// dummy values so that subsequent code
+		// doesn't assume these values always
+		// result from this
+		compiler.datastack.top -= fe.outD;
+		compiler.produce(compiler.datastack,fe.outD - highestEqual);
+		compiler.datastack.top += highestEqual;
+		compiler.callstack.top -= fe.outR;
+		compiler.produce(compiler.callstack,fe.outR);
+
+		compiler.effect = new StackEffect(
+			Math.max(te.inD,fe.inD),
+			Math.max(te.outD,fe.outD),
+			Math.max(te.inR,fe.inR),
+			Math.max(te.outR,fe.outR)
+		);
+	} //}}}
+
+	//{{{ compileCallTo() method
+	/**
+	 * Write code for evaluating this. Returns maximum JVM stack
+	 * usage.
+	 */
+	public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck)
+		throws Exception
+	{
+		// if null jump to F
+		// T
+		// jump END
+		// F: F
+		// END: ...
+		Label fl = new Label();
+		Label endl = new Label();
+
+		cond.generate(mw);
+
+		int maxJVMStack = 1;
+
+		/* if(t instanceof Null && f instanceof Null)
+		{
+			// nothing to do!
+			mw.visitInsn(POP);
+		}
+		else if(t instanceof Null)
+		{
+			mw.visitJumpInsn(IFNONNULL,endl);
+			maxJVMStack = Math.max(maxJVMStack,
+				f.compileCallTo(mw,recursiveCheck));
+			mw.visitLabel(endl);
+		}
+		else if(f instanceof Null)
+		{
+			mw.visitJumpInsn(IFNULL,endl);
+			maxJVMStack = Math.max(maxJVMStack,
+				t.compileCallTo(mw,recursiveCheck));
+			mw.visitLabel(endl);
+		}
+		else */
+		{
+			mw.visitJumpInsn(IFNULL,fl);
+
+			FactorDataStack datastackCopy
+				= (FactorDataStack)
+				compiler.datastack.clone();
+			FactorCallStack callstackCopy
+				= (FactorCallStack)
+				compiler.callstack.clone();
+
+			maxJVMStack = Math.max(maxJVMStack,
+				t.compileCallTo(mw,recursiveCheck));
+
+			maxJVMStack = Math.max(maxJVMStack,
+				normalizeStacks(mw));
+
+			compiler.datastack = datastackCopy;
+			compiler.callstack = callstackCopy;
+
+			mw.visitJumpInsn(GOTO,endl);
+			mw.visitLabel(fl);
+			maxJVMStack = Math.max(maxJVMStack,
+				f.compileCallTo(mw,recursiveCheck));
+
+			maxJVMStack = Math.max(maxJVMStack,
+				normalizeStacks(mw));
+
+			mw.visitLabel(endl);
+		}
+
+		return maxJVMStack;
+	} //}}}
+
+	//{{{ normalizeStacks() method
+	private int normalizeStacks(CodeVisitor mw)
+	{
+		int datastackTop = compiler.datastack.top;
+		compiler.datastack.top = 0;
+		int callstackTop = compiler.callstack.top;
+		compiler.callstack.top = 0;
+
+		normalizeStack(compiler.datastack,datastackTop,mw);
+		normalizeStack(compiler.callstack,callstackTop,mw);
+		return Math.max(datastackTop,callstackTop);
+	} //}}}
+
+	//{{{ normalizeStack() method
+	private void normalizeStack(FactorArrayStack stack, int top,
+		CodeVisitor mw)
+	{
+		for(int i = top - 1; i >= 0; i--)
+		{
+			FlowObject obj = (FlowObject)stack.stack[i];
+			obj.generate(mw);
+		}
+
+		for(int i = 0; i < top; i++)
+		{
+			int local = compiler.allocate();
+			stack.push(new Result(local,compiler,null));
+			mw.visitVarInsn(ASTORE,local);
+		}
+	} //}}}
+
+	//{{{ toString() method
+	public String toString()
+	{
+		return FactorParser.unparse(f)
+			+ " "
+			+ FactorParser.unparse(t)
+			+ " ? call";
+	} //}}}
+}

factor/compiler/CompiledDefinition.java

@@ -31,28 +31,39 @@ package factor.compiler;
 
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 /**
- * : name ... ;
+ * Compiled colon definition.
  */
 public abstract class CompiledDefinition
 	extends FactorWordDefinition
 {
 	private StackEffect effect;
+	private Cons definition;
 
 	//{{{ CompiledDefinition constructor
-	public CompiledDefinition(FactorWord word, StackEffect effect)
+	public CompiledDefinition(FactorWord word, StackEffect effect,
+		Cons definition)
 	{
 		super(word);
 		this.effect = effect;
+		this.definition = definition;
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state)
+		FactorCompiler compiler)
 	{
-		return effect;
+		compiler.apply(effect);
+	} //}}}
+
+	//{{{ toList() method
+	public Cons toList()
+	{
+		return new Cons(word,new Cons(effect,
+			new Cons(new FactorWord("\n"),
+			definition)));
 	} //}}}
 }

factor/compiler/CompiledList.java

@@ -0,0 +1,99 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public class CompiledList extends FlowObject implements Constants
+{
+	private Cons quotation;
+	private RecursiveState recursiveCheck;
+
+	CompiledList(Cons quotation, FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+	{
+		super(compiler,recursiveCheck);
+		this.quotation = quotation;
+		// clone it
+		this.recursiveCheck = new RecursiveState(
+			recursiveCheck);
+	}
+
+	public void generate(CodeVisitor mw)
+	{
+		mw.visitFieldInsn(GETSTATIC,compiler.className,
+			compiler.literal(quotation),
+			"Ljava/lang/Object;");
+	}
+
+	Object getLiteral()
+	{
+		return quotation;
+	}
+
+	/**
+	 * Stack effect of executing this -- only used for lists
+	 * and conditionals!
+	 */
+	public void getStackEffect(RecursiveState recursiveCheck)
+		throws Exception
+	{
+		// important: this.recursiveCheck due to
+		// lexically-scoped recursion issues
+		compiler.getStackEffect(quotation,this.recursiveCheck);
+	}
+
+	/**
+	 * Write code for evaluating this. Returns maximum JVM stack
+	 * usage.
+	 */
+	public int compileCallTo(CodeVisitor mw,
+		RecursiveState recursiveCheck)
+		throws Exception
+	{
+		// important: this.recursiveCheck due to
+		// lexically-scoped recursion issues
+		return compiler.compile(quotation,mw,this.recursiveCheck);
+	}
+
+	public boolean equals(Object o)
+	{
+		if(o instanceof CompiledList)
+		{
+			CompiledList c = (CompiledList)o;
+			return FactorLib.objectsEqual(c.quotation,quotation);
+		}
+		else
+			return false;
+	}
+}

factor/compiler/ConstantPoolString.java

@@ -0,0 +1,57 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public class ConstantPoolString extends FlowObject
+{
+	private String str;
+
+	ConstantPoolString(String str, FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+	{
+		super(compiler,recursiveCheck);
+		this.str = str;
+	}
+
+	public void generate(CodeVisitor mw)
+	{
+		mw.visitLdcInsn(str);
+	}
+
+	Object getLiteral()
+	{
+		return str;
+	}
+}

factor/compiler/FactorCompiler.java

@@ -0,0 +1,571 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+import org.objectweb.asm.util.*;
+
+public class FactorCompiler implements Constants
+{
+	private FactorInterpreter interp;
+
+	public final FactorWord word;
+	public final String className;
+
+	private int base;
+	private int max;
+
+	public FactorDataStack datastack;
+	public FactorCallStack callstack;
+
+	private int literalCount;
+
+	private Map literals = new HashMap();
+
+	public StackEffect effect = new StackEffect();
+
+	//{{{ FactorCompiler constructor
+	/**
+	 * For balancing.
+	 */
+	public FactorCompiler()
+	{
+		this(null,null,null,0,0);
+	} //}}}
+
+	//{{{ FactorCompiler constructor
+	/**
+	 * For compiling.
+	 */
+	public FactorCompiler(FactorInterpreter interp,
+		FactorWord word, String className,
+		int base, int allot)
+	{
+		this.interp = interp;
+
+		this.word = word;
+		this.className = className;
+
+		this.base = base;
+		datastack = new FactorDataStack();
+		callstack = new FactorCallStack();
+
+		for(int i = 0; i < allot; i++)
+		{
+			datastack.push(new Result(base + i,this,null));
+		}
+
+		max = base + allot;
+	} //}}}
+
+	//{{{ ensure() method
+	/**
+	 * Ensure stack has at least 'count' elements.
+	 * Eg, if count is 4 and stack is A B,
+	 * stack will become RESULT RESULT A B.
+	 * Used when deducing stack effects.
+	 */
+	public void ensure(FactorArrayStack stack, int count)
+	{
+		int top = stack.top;
+		if(top < count)
+		{
+			if(stack == datastack)
+				effect.inD += (count - top);
+			else if(stack == callstack)
+				effect.inR += (count - top);
+
+			stack.ensurePush(count - top);
+			System.arraycopy(stack.stack,0,stack.stack,
+				count - top,top);
+			for(int i = 0; i < count - top; i++)
+			{
+				stack.stack[i] = new Result(
+					allocate(),this,null);
+			}
+			stack.top = count;
+		}
+	} //}}}
+
+	//{{{ consume() method
+	public void consume(FactorArrayStack stack, int count)
+	{
+		ensure(stack,count);
+		stack.top -= count;
+	} //}}}
+
+	//{{{ produce() method
+	public void produce(FactorArrayStack stack, int count)
+	{
+		for(int i = 0; i < count; i++)
+			stack.push(new Result(allocate(),this,null));
+	} //}}}
+
+	//{{{ apply() method
+	public void apply(StackEffect se)
+	{
+		consume(datastack,se.inD);
+		produce(datastack,se.outD);
+		consume(callstack,se.inR);
+		produce(callstack,se.outR);
+	} //}}}
+
+	//{{{ getStackEffect() method
+	public StackEffect getStackEffect()
+	{
+		effect.outD = datastack.top;
+		effect.outR = callstack.top;
+		return (StackEffect)effect.clone();
+	} //}}}
+
+	//{{{ getStackEffect() method
+	public void getStackEffect(Cons definition,
+		RecursiveState recursiveCheck)
+		throws Exception
+	{
+		while(definition != null)
+		{
+			Object obj = definition.car;
+			if(obj instanceof FactorWord)
+			{
+				FactorWord word = (FactorWord)obj;
+				RecursiveForm rec = recursiveCheck.get(word);
+				if(rec == null)
+					recursiveCheck.add(word,getStackEffect());
+				else
+					rec.active = true;
+
+				word.def.getStackEffect(recursiveCheck,this);
+
+				if(rec == null)
+					recursiveCheck.remove(word);
+				else
+					rec.active = false;
+			}
+			else
+				pushLiteral(obj,recursiveCheck);
+
+			definition = definition.next();
+		}
+	} //}}}
+
+	//{{{ getDisassembly() method
+	protected String getDisassembly(TraceCodeVisitor mw)
+	{
+		// Save the disassembly of the eval() method
+		StringBuffer buf = new StringBuffer();
+		Iterator bytecodes = mw.getText().iterator();
+		while(bytecodes.hasNext())
+		{
+			buf.append(bytecodes.next());
+		}
+		return buf.toString();
+	} //}}}
+
+	//{{{ compile() method
+	/**
+	 * Compiles a method and returns the disassembly.
+	 */
+	public String compile(Cons definition, ClassWriter cw, String className,
+		String methodName, StackEffect effect,
+		RecursiveState recursiveCheck)
+		throws Exception
+	{
+		String signature = effect.getCorePrototype();
+
+		CodeVisitor _mw = cw.visitMethod(ACC_PUBLIC | ACC_STATIC,
+			methodName,signature,null,null);
+
+		TraceCodeVisitor mw = new TraceCodeVisitor(_mw);
+
+		int maxJVMStack = compile(definition,mw,
+			recursiveCheck);
+
+		// special case where return value is passed on
+		// JVM operand stack
+		if(effect.outD == 0)
+		{
+			mw.visitInsn(RETURN);
+		}
+		else if(effect.outD == 1)
+		{
+			pop(mw);
+			mw.visitInsn(ARETURN);
+			maxJVMStack = Math.max(maxJVMStack,1);
+		}
+		else
+		{
+			// store datastack in a local
+			mw.visitVarInsn(ALOAD,0);
+			mw.visitFieldInsn(GETFIELD,
+				"factor/FactorInterpreter",
+				"datastack",
+				"Lfactor/FactorDataStack;");
+			int datastackLocal = allocate();
+			mw.visitVarInsn(ASTORE,datastackLocal);
+
+			for(int i = 0; i < datastack.top; i++)
+			{
+				mw.visitVarInsn(ALOAD,datastackLocal);
+				((FlowObject)datastack.stack[i])
+					.generate(mw);
+				mw.visitMethodInsn(INVOKEVIRTUAL,
+					"factor/FactorDataStack",
+					"push",
+					"(Ljava/lang/Object;)V");
+			}
+
+			datastack.top = 0;
+
+			mw.visitInsn(RETURN);
+
+			maxJVMStack = Math.max(2,maxJVMStack);
+		}
+
+		mw.visitMaxs(maxJVMStack,max);
+
+		return getDisassembly(mw);
+	} //}}}
+
+	//{{{ compile() method
+	/**
+	 * Compiles a quotation and returns the maximum JVM stack depth.
+	 */
+	public int compile(Cons definition, CodeVisitor mw,
+		RecursiveState recursiveCheck) throws Exception
+	{
+		int maxJVMStack = 0;
+
+		while(definition != null)
+		{
+			Object obj = definition.car;
+			if(obj instanceof FactorWord)
+			{
+				maxJVMStack = Math.max(maxJVMStack,
+					compileWord((FactorWord)obj,mw,
+					recursiveCheck));
+			}
+			else
+				pushLiteral(obj,recursiveCheck);
+
+			definition = definition.next();
+		}
+
+		return maxJVMStack;
+	} //}}}
+
+	//{{{ compileWord() method
+	private int compileWord(FactorWord w, CodeVisitor mw,
+		RecursiveState recursiveCheck) throws Exception
+	{
+		RecursiveForm rec = recursiveCheck.get(w);
+
+		try
+		{
+			boolean recursiveCall;
+			if(rec == null)
+			{
+				recursiveCall = false;
+				recursiveCheck.add(w,null);
+			}
+			else
+			{
+				recursiveCall = true;
+				rec.active = true;
+			}
+
+			FactorWordDefinition d = w.def;
+
+			if(!recursiveCall)
+			{
+				StackEffect effect = getStackEffectOrNull(d);
+				if(effect == null)
+				{
+					return d.compileImmediate(mw,this,
+						recursiveCheck);
+				}
+				else if(d instanceof FactorCompoundDefinition)
+				{
+					w.compile(interp,recursiveCheck);
+					if(d == w.def)
+					{
+						throw new FactorCompilerException(word + " depends on " + w + " which cannot be compiled");
+					}
+					d = w.def;
+				}
+			}
+
+			w.compileRef = true;
+			return d.compileCallTo(mw,this,recursiveCheck);
+		}
+		finally
+		{
+			if(rec == null)
+				recursiveCheck.remove(w);
+			else
+				rec.active = false;
+		}
+	} //}}}
+
+	//{{{ push() method
+	/**
+	 * Generates code for pushing the top of the JVM stack onto the
+	 * data stack.
+	 */
+	public void push(CodeVisitor mw)
+	{
+		int local = allocate();
+		datastack.push(new Result(local,this,null));
+		if(mw != null)
+			mw.visitVarInsn(ASTORE,local);
+	} //}}}
+
+	//{{{ pushR() method
+	/**
+	 * Generates code for pushing the top of the JVM stack onto the
+	 * call stack.
+	 */
+	public void pushR(CodeVisitor mw)
+	{
+		int local = allocate();
+		callstack.push(new Result(local,this,null));
+		if(mw != null)
+			mw.visitVarInsn(ASTORE,local);
+	} //}}}
+
+	//{{{ pushLiteral() method
+	public void pushLiteral(Object literal, RecursiveState recursiveCheck)
+	{
+		if(literal == null)
+			datastack.push(new Null(this,recursiveCheck));
+		else if(literal instanceof Cons)
+		{
+			datastack.push(new CompiledList((Cons)literal,this,
+				recursiveCheck));
+		}
+		else if(literal instanceof String)
+		{
+			datastack.push(new ConstantPoolString((String)literal,
+				this,recursiveCheck));
+		}
+		else
+		{
+			datastack.push(new Literal(literal,this,
+				recursiveCheck));
+		}
+	} //}}}
+
+	//{{{ pushChoice() method
+	public void pushChoice(RecursiveState recursiveCheck)
+		throws FactorStackException
+	{
+		FlowObject f = (FlowObject)datastack.pop();
+		FlowObject t = (FlowObject)datastack.pop();
+		FlowObject cond = (FlowObject)datastack.pop();
+		datastack.push(new CompiledChoice(
+			cond,t,f,this,recursiveCheck));
+	} //}}}
+
+	//{{{ pop() method
+	/**
+	 * Generates code for popping the top of the data stack onto
+	 * the JVM stack.
+	 */
+	public void pop(CodeVisitor mw) throws FactorStackException
+	{
+		FlowObject obj = (FlowObject)datastack.pop();
+		if(mw != null)
+			obj.generate(mw);
+	} //}}}
+
+	//{{{ popR() method
+	/**
+	 * Generates code for popping the top of the call stack onto
+	 * the JVM stack.
+	 */
+	public void popR(CodeVisitor mw) throws FactorStackException
+	{
+		FlowObject obj = (FlowObject)callstack.pop();
+		if(mw != null)
+			obj.generate(mw);
+	} //}}}
+
+	//{{{ popLiteral() method
+	/**
+	 * Pops a literal off the datastack or throws an exception.
+	 */
+	public Object popLiteral() throws FactorException
+	{
+		FlowObject obj = (FlowObject)datastack.pop();
+		return obj.getLiteral();
+	} //}}}
+
+	//{{{ allocate() method
+	/**
+	 * Allocate a local variable.
+	 */
+	public int allocate()
+	{
+		// inefficient!
+		int i = base;
+		for(;;)
+		{
+			if(allocate(i,datastack) && allocate(i,callstack))
+			{
+				max = Math.max(max,i + 1);
+				return i;
+			}
+			else
+				i++;
+		}
+	} //}}}
+
+	//{{{ allocate() method
+	/**
+	 * Return true if not in use, false if in use.
+	 */
+	private boolean allocate(int local, FactorArrayStack stack)
+	{
+		for(int i = 0; i < stack.top; i++)
+		{
+			FlowObject obj = (FlowObject)stack.stack[i];
+			if(obj.usingLocal(local))
+				return false;
+		}
+		return true;
+	} //}}}
+
+	//{{{ literal() method
+	public String literal(Object obj)
+	{
+		Integer i = (Integer)literals.get(obj);
+		int literal;
+		if(i == null)
+		{
+			literal = literalCount++;
+			literals.put(obj,new Integer(literal));
+		}
+		else
+			literal = i.intValue();
+
+		return "literal_" + literal;
+	} //}}}
+
+	//{{{ generateArgs() method
+	/**
+	 * Generate instructions for copying arguments from the allocated
+	 * local variables to the JVM stack, doing type conversion in the
+	 * process.
+	 */
+	public void generateArgs(CodeVisitor mw, int num, Class[] args)
+		throws Exception
+	{
+		for(int i = 0; i < num; i++)
+		{
+			FlowObject obj = (FlowObject)datastack.stack[
+				datastack.top - num + i];
+			obj.generate(mw);
+			if(args != null)
+				FactorJava.generateFromConversion(mw,args[i]);
+		}
+
+		datastack.top -= num;
+	} //}}}
+
+	//{{{ generateFields() method
+	public void generateFields(ClassWriter cw)
+		throws Exception
+	{
+		for(int i = 0; i < literalCount; i++)
+		{
+			cw.visitField(ACC_PUBLIC | ACC_STATIC,"literal_" + i,
+				"Ljava/lang/Object;",null,null);
+		}
+	} //}}}
+
+	//{{{ setFields() method
+	public void setFields(Class def)
+		throws Exception
+	{
+		Iterator entries = literals.entrySet().iterator();
+		while(entries.hasNext())
+		{
+			Map.Entry entry = (Map.Entry)entries.next();
+			Object literal = entry.getKey();
+			int index = ((Integer)entry.getValue()).intValue();
+
+			Field f = def.getField("literal_" + index);
+			f.set(null,literal);
+		}
+	} //}}}
+
+	//{{{ getStackEffectOrNull() method
+	static StackEffect getStackEffectOrNull(FactorWordDefinition def)
+	{
+		try
+		{
+			return def.getStackEffect();
+		}
+		catch(Exception e)
+		{
+			//System.err.println("WARNING: " + e);
+			//System.err.println(def);
+			return null;
+		}
+	} //}}}
+
+	//{{{ getStackEffectOrNull() method
+	StackEffect getStackEffectOrNull(FlowObject obj,
+		RecursiveState recursiveCheck,
+		boolean decompose)
+	{
+		try
+		{
+			obj.getStackEffect(recursiveCheck);
+			StackEffect effect = getStackEffect();
+			if(decompose)
+			{
+				effect = StackEffect.decompose(
+					recursiveCheck.last().effect,
+					effect);
+			}
+			return effect;
+		}
+		catch(Exception e)
+		{
+			//System.err.println("WARNING: " + e);
+			//System.err.println(obj);
+			return null;
+		}
+	} //}}}
+}

factor/compiler/FlowObject.java

@@ -0,0 +1,102 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public abstract class FlowObject
+{
+	protected FactorCompiler compiler;
+	protected RecursiveForm word;
+
+	FlowObject(FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+	{
+		this.compiler = compiler;
+		if(recursiveCheck != null)
+			word = recursiveCheck.last();
+	}
+
+	public abstract void generate(CodeVisitor mw);
+
+	boolean usingLocal(int local)
+	{
+		return false;
+	}
+
+	Object getLiteral()
+		throws FactorCompilerException
+	{
+		throw new FactorCompilerException("Cannot compile unless literal on stack: " + this);
+	}
+
+	/**
+	 * Stack effect of evaluating this -- only used for lists
+	 * and conditionals!
+	 */
+	public void getStackEffect(RecursiveState recursiveCheck)
+		throws Exception
+	{
+		throw new FactorCompilerException("Not a quotation: " + this);
+	}
+
+	/**
+	 * Write code for evaluating this. Returns maximum JVM stack
+	 * usage.
+	 */
+	public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck)
+		throws Exception
+	{
+		throw new FactorCompilerException("Cannot compile call to non-literal quotation");
+	}
+
+	/**
+	 * Returns the word where this flow object originated from.
+	 */
+	public RecursiveForm getWord()
+	{
+		return word;
+	}
+
+	public String toString()
+	{
+		try
+		{
+			return FactorParser.unparse(getLiteral());
+		}
+		catch(Exception e)
+		{
+			throw new RuntimeException("Override toString() if your getLiteral() bombs!");
+		}
+	}
+}

factor/compiler/Literal.java

@@ -0,0 +1,69 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public class Literal extends FlowObject implements Constants
+{
+	private Object literal;
+
+	Literal(Object literal, FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+	{
+		super(compiler,recursiveCheck);
+		this.literal = literal;
+	}
+
+	public void generate(CodeVisitor mw)
+	{
+		mw.visitFieldInsn(GETSTATIC,compiler.className,
+			compiler.literal(literal),
+			"Ljava/lang/Object;");
+	}
+
+	Object getLiteral()
+	{
+		return literal;
+	}
+
+	/**
+	 * Write code for evaluating this. Returns maximum JVM stack
+	 * usage.
+	 */
+	public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck)
+		throws Exception
+	{
+		throw new FactorCompilerException("Not a quotation: " + literal);
+	}
+}

factor/compiler/LocalAllocator.java

@@ -1,677 +0,0 @@
-/* :folding=explicit:collapseFolds=1: */
-
-/*
- * $Id$
- *
- * Copyright (C) 2004 Slava Pestov.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- *    this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- *    this list of conditions and the following disclaimer in the documentation
- *    and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-package factor.compiler;
-
-import factor.*;
-import java.lang.reflect.*;
-import java.util.*;
-import org.objectweb.asm.*;
-
-public class LocalAllocator implements Constants
-{
-	private FactorInterpreter interp;
-
-	private String className;
-	private int base;
-	private int max;
-
-	public FactorDataStack datastack;
-	public FactorCallStack callstack;
-
-	private int literalCount;
-	private int wordCount;
-
-	private Map literals = new HashMap();
-	private Map words = new HashMap();
-
-	//{{{ LocalAllocator constructor
-	/**
-	 * For balancing.
-	 */
-	public LocalAllocator()
-	{
-		this(null,null,0,0);
-	} //}}}
-
-	//{{{ LocalAllocator constructor
-	/**
-	 * For compiling.
-	 */
-	public LocalAllocator(FactorInterpreter interp, String className,
-		int base, int allot)
-	{
-		this.interp = interp;
-		this.className = className;
-
-		this.base = base;
-		datastack = new FactorDataStack();
-		callstack = new FactorCallStack();
-
-		for(int i = 0; i < allot; i++)
-		{
-			datastack.push(new Result(base + i));
-		}
-
-		max = base + allot;
-
-	} //}}}
-
-	//{{{ ensure() method
-	/**
-	 * Ensure stack has at least 'count' elements.
-	 * Eg, if count is 4 and stack is A B,
-	 * stack will become RESULT RESULT A B.
-	 * Used when deducing stack effects.
-	 */
-	public void ensure(FactorArrayStack stack, int count)
-	{
-		int top = stack.top;
-		if(top < count)
-		{
-			stack.ensurePush(count - top);
-			System.arraycopy(stack.stack,0,stack.stack,
-				count - top,top);
-			for(int i = 0; i < count - top; i++)
-			{
-				stack.stack[i] = new Result(allocate());
-			}
-			stack.top = count;
-		}
-	} //}}}
-
-	//{{{ compile() method
-	/**
-	 * Compiles a quotation and returns the maximum JVM stack depth.
-	 */
-	public int compile(Cons definition, CodeVisitor mw,
-		Set recursiveCheck) throws Exception
-	{
-		int maxJVMStack = 0;
-
-		while(definition != null)
-		{
-			Object obj = definition.car;
-			if(obj instanceof FactorWord)
-			{
-				FactorWord w = (FactorWord)obj;
-
-				FactorWordDefinition d = w.def;
-				if(d instanceof FactorCompoundDefinition
-					&& d.getStackEffect(recursiveCheck,
-					new LocalAllocator()) != null)
-				{
-					// compile first.
-					w.compile(interp,recursiveCheck);
-					if(w.def == d)
-					{
-						// didn't compile
-						throw new FactorCompilerException(w + " cannot be compiled");
-					}
-				}
-
-				maxJVMStack = Math.max(maxJVMStack,
-					w.def.compileCallTo(mw,this,recursiveCheck));
-			}
-			else if(obj == null)
-			{
-				pushNull();
-			}
-			else if(obj instanceof String)
-			{
-				pushString((String)obj);
-			}
-			else
-			{
-				pushLiteral(obj);
-			}
-
-			definition = definition.next();
-		}
-
-		return maxJVMStack;
-	} //}}}
-
-	//{{{ push() method
-	/**
-	 * Generates code for pushing the top of the JVM stack onto the
-	 * data stack.
-	 */
-	public void push(CodeVisitor mw)
-	{
-		int local = allocate();
-		datastack.push(new Result(local));
-		if(mw != null)
-			mw.visitVarInsn(ASTORE,local);
-	} //}}}
-
-	//{{{ pushR() method
-	/**
-	 * Generates code for pushing the top of the JVM stack onto the
-	 * call stack.
-	 */
-	public void pushR(CodeVisitor mw)
-	{
-		int local = allocate();
-		callstack.push(new Result(local));
-		if(mw != null)
-			mw.visitVarInsn(ASTORE,local);
-	} //}}}
-
-	//{{{ pushLiteral() method
-	public void pushLiteral(Object literal)
-	{
-		datastack.push(new Literal(literal));
-	} //}}}
-
-	//{{{ pushString() method
-	public void pushString(String literal)
-	{
-		datastack.push(new ConstantPoolString(literal));
-	} //}}}
-
-	//{{{ pushNull() method
-	public void pushNull()
-	{
-		datastack.push(new Null());
-	} //}}}
-
-	//{{{ pushChoice() method
-	public void pushChoice() throws FactorStackException
-	{
-		FlowObject f = (FlowObject)datastack.pop();
-		FlowObject t = (FlowObject)datastack.pop();
-		FlowObject cond = (FlowObject)datastack.pop();
-		datastack.push(new Choice(cond,t,f));
-	} //}}}
-
-	//{{{ pop() method
-	/**
-	 * Generates code for popping the top of the data stack onto
-	 * the JVM stack.
-	 */
-	public void pop(CodeVisitor mw) throws FactorStackException
-	{
-		FlowObject obj = (FlowObject)datastack.pop();
-		if(mw != null)
-			obj.generate(mw);
-	} //}}}
-
-	//{{{ popR() method
-	/**
-	 * Generates code for popping the top of the call stack onto
-	 * the JVM stack.
-	 */
-	public void popR(CodeVisitor mw) throws FactorStackException
-	{
-		FlowObject obj = (FlowObject)callstack.pop();
-		if(mw != null)
-			obj.generate(mw);
-	} //}}}
-
-	//{{{ popLiteral() method
-	/**
-	 * Pops a literal off the datastack or throws an exception.
-	 */
-	public Object popLiteral() throws FactorException
-	{
-		FlowObject obj = (FlowObject)datastack.pop();
-		return obj.getLiteral();
-	} //}}}
-
-	//{{{ allocate() method
-	/**
-	 * Allocate a local variable.
-	 */
-	private int allocate()
-	{
-		// inefficient!
-		int limit = base + datastack.top + callstack.top;
-		for(int i = base; i <= limit; i++)
-		{
-			if(allocate(i,datastack) && allocate(i,callstack))
-			{
-				max = Math.max(max,i + 1);
-				return i;
-			}
-		}
-		// this is impossible
-		throw new RuntimeException("allocator failed");
-	} //}}}
-
-	//{{{ allocate() method
-	/**
-	 * Return true if not in use, false if in use.
-	 */
-	private boolean allocate(int local, FactorArrayStack stack)
-	{
-		for(int i = 0; i < stack.top; i++)
-		{
-			FlowObject obj = (FlowObject)stack.stack[i];
-			if(obj.usingLocal(local))
-				return false;
-		}
-		return true;
-	} //}}}
-
-	//{{{ maxLocals() method
-	public int maxLocals()
-	{
-		return max;
-	} //}}}
-
-	//{{{ literal() method
-	private String literal(Object obj)
-	{
-		Integer i = (Integer)literals.get(obj);
-		int literal;
-		if(i == null)
-		{
-			literal = literalCount++;
-			literals.put(obj,new Integer(literal));
-		}
-		else
-			literal = i.intValue();
-
-		return "literal_" + literal;
-	} //}}}
-
-	//{{{ generateArgs() method
-	/**
-	 * Generate instructions for copying arguments from the allocated
-	 * local variables to the JVM stack, doing type conversion in the
-	 * process.
-	 */
-	public void generateArgs(CodeVisitor mw, int num, Class[] args)
-		throws Exception
-	{
-		for(int i = 0; i < num; i++)
-		{
-			FlowObject obj = (FlowObject)datastack.stack[
-				datastack.top - num + i];
-			obj.generate(mw);
-			if(args != null)
-				FactorJava.generateFromConversion(mw,args[i]);
-		}
-
-		datastack.top -= num;
-	} //}}}
-
-	//{{{ generateFields() method
-	public void generateFields(ClassWriter cw)
-		throws Exception
-	{
-		for(int i = 0; i < literalCount; i++)
-		{
-			cw.visitField(ACC_PUBLIC | ACC_STATIC,"literal_" + i,
-				"Ljava/lang/Object;",null,null);
-		}
-
-		Iterator entries = words.entrySet().iterator();
-		while(entries.hasNext())
-		{
-			Map.Entry entry = (Map.Entry)entries.next();
-			FactorWord word = (FactorWord)entry.getKey();
-			int index = ((Integer)entry.getValue()).intValue();
-
-			cw.visitField(ACC_PUBLIC | ACC_STATIC,"word_" + index,
-				FactorJava.javaClassToVMClass(word.def.getClass()),
-				null,null);
-		}
-	} //}}}
-
-	//{{{ setFields() method
-	public void setFields(Class def)
-		throws Exception
-	{
-		Iterator entries = literals.entrySet().iterator();
-		while(entries.hasNext())
-		{
-			Map.Entry entry = (Map.Entry)entries.next();
-			Object literal = entry.getKey();
-			int index = ((Integer)entry.getValue()).intValue();
-
-			Field f = def.getField("literal_" + index);
-			f.set(null,literal);
-		}
-
-		entries = words.entrySet().iterator();
-		while(entries.hasNext())
-		{
-			Map.Entry entry = (Map.Entry)entries.next();
-			FactorWord word = (FactorWord)entry.getKey();
-			int index = ((Integer)entry.getValue()).intValue();
-
-			Field f = def.getField("word_" + index);
-			System.err.println(word.def.getClass() + " ==> " + "word_" + index);
-			f.set(null,word.def);
-		}
-	} //}}}
-
-	//{{{ FlowObject
-	public abstract class FlowObject
-	{
-		abstract void generate(CodeVisitor mw);
-
-		boolean usingLocal(int local)
-		{
-			return false;
-		}
-
-		Object getLiteral()
-			throws FactorCompilerException
-		{
-			throw new FactorCompilerException("Cannot compile unless literal on stack");
-		}
-
-		/**
-		 * Stack effect of evaluating this -- only used for lists
-		 * and conditionals!
-		 */
-		public StackEffect getStackEffect(Set recursiveCheck)
-			throws Exception
-		{
-
-			return null;
-		}
-
-		/**
-		 * Write code for evaluating this. Returns maximum JVM stack
-		 * usage.
-		 */
-		public int compileCallTo(CodeVisitor mw, Set recursiveCheck)
-			throws Exception
-		{
-			throw new FactorCompilerException("Cannot compile call to non-literal quotation");
-		}
-	} //}}}
-
-	//{{{ Result
-	class Result extends FlowObject
-	{
-		private int local;
-
-		Result(int local)
-		{
-			this.local = local;
-		}
-
-		void generate(CodeVisitor mw)
-		{
-			mw.visitVarInsn(ALOAD,local);
-		}
-
-		boolean usingLocal(int local)
-		{
-			return (this.local == local);
-		}
-	} //}}}
-
-	//{{{ Literal
-	class Literal extends FlowObject
-	{
-		private Object literal;
-
-		Literal(Object literal)
-		{
-			this.literal = literal;
-		}
-
-		void generate(CodeVisitor mw)
-		{
-			mw.visitFieldInsn(GETSTATIC,className,
-				literal(literal),"Ljava/lang/Object;");
-		}
-
-		Object getLiteral()
-		{
-			return literal;
-		}
-
-		/**
-		 * Stack effect of executing this -- only used for lists
-		 * and conditionals!
-		 */
-		public StackEffect getStackEffect(Set recursiveCheck)
-			throws Exception
-		{
-			if(literal instanceof Cons
-				|| literal == null)
-			{
-				return StackEffect.getStackEffect(
-					(Cons)literal,recursiveCheck,
-					LocalAllocator.this);
-			}
-			else
-				return null;
-		}
-
-		/**
-		 * Write code for evaluating this. Returns maximum JVM stack
-		 * usage.
-		 */
-		public int compileCallTo(CodeVisitor mw, Set recursiveCheck)
-			throws Exception
-		{
-			if(literal instanceof Cons || literal == null)
-				return compile((Cons)literal,mw,recursiveCheck);
-			else
-				throw new FactorCompilerException("Not a quotation: " + literal);
-		}
-	} //}}}
-
-	//{{{ ConstantPoolString
-	class ConstantPoolString extends FlowObject
-	{
-		private String str;
-
-		ConstantPoolString(String str)
-		{
-			this.str = str;
-		}
-
-		void generate(CodeVisitor mw)
-		{
-			mw.visitLdcInsn(str);
-		}
-
-		Object getLiteral()
-		{
-			return str;
-		}
-	} //}}}
-
-	//{{{ Null
-	class Null extends FlowObject
-	{
-		void generate(CodeVisitor mw)
-		{
-			mw.visitInsn(ACONST_NULL);
-		}
-
-		Object getLiteral()
-		{
-			return null;
-		}
-
-		/**
-		 * Stack effect of executing this -- only used for lists
-		 * and conditionals!
-		 */
-		public StackEffect getStackEffect(Set recursiveCheck)
-		{
-			return new StackEffect(0,0,0,0);
-		}
-
-		/**
-		 * Write code for evaluating this. Returns maximum JVM stack
-		 * usage.
-		 */
-		public int compileCallTo(CodeVisitor mw, Set recursiveCheck)
-			throws Exception
-		{
-			return 0;
-		}
-	} //}}}
-
-	//{{{ Choice
-	class Choice extends FlowObject
-	{
-		FlowObject cond, t, f;
-
-		Choice(FlowObject cond, FlowObject t, FlowObject f)
-		{
-			this.cond = cond;
-			this.t = t;
-			this.f = f;
-		}
-
-		void generate(CodeVisitor mw)
-		{
-			// if null jump to F
-			// T
-			// jump END
-			// F: F
-			// END: ...
-			Label fl = new Label();
-			Label endl = new Label();
-
-			cond.generate(mw);
-			mw.visitJumpInsn(IFNULL,fl);
-			t.generate(mw);
-			mw.visitJumpInsn(GOTO,endl);
-			mw.visitLabel(fl);
-			f.generate(mw);
-			mw.visitLabel(endl);
-		}
-
-		boolean usingLocal(int local)
-		{
-			return cond.usingLocal(local)
-				|| t.usingLocal(local)
-				|| f.usingLocal(local);
-		}
-
-		/**
-		 * Stack effect of executing this -- only used for lists
-		 * and conditionals!
-		 */
-		public StackEffect getStackEffect(Set recursiveCheck)
-			throws Exception
-		{
-			FactorDataStack datastackCopy = (FactorDataStack)
-				datastack.clone();
-			FactorCallStack callstackCopy = (FactorCallStack)
-				callstack.clone();
-
-			StackEffect te = t.getStackEffect(recursiveCheck);
-
-			datastack = datastackCopy;
-			callstack = callstackCopy;
-
-			StackEffect fe = f.getStackEffect(recursiveCheck);
-
-			if(te == null || fe == null)
-				return null;
-
-			// we can only balance out a conditional if
-			// both sides leave the same amount of elements
-			// on the stack.
-			// eg, 1/1 -vs- 2/2 is ok, 3/1 -vs- 4/2 is ok,
-			// but 1/2 -vs- 2/1 is not.
-			int balanceTD = te.outD - te.inD;
-			int balanceTR = te.outR - te.inR;
-			int balanceFD = fe.outD - fe.inD;
-			int balanceFR = fe.outR - fe.inR;
-			if(balanceTD == balanceFD
-				&& balanceTR == balanceFR)
-			{
-				// replace results from the f branch with
-				// dummy values so that subsequent code
-				// doesn't assume these values always
-				// result from this
-				datastack.top -= te.outD;
-				for(int i = 0; i < te.outD; i++)
-				{
-					push(null);
-				}
-				callstack.top -= te.outR;
-				for(int i = 0; i < te.outR; i++)
-				{
-					pushR(null);
-				}
-				return new StackEffect(
-					Math.max(te.inD,fe.inD),
-					Math.max(te.outD,fe.outD),
-					Math.max(te.inR,fe.inR),
-					Math.max(te.outR,fe.outR)
-				);
-			}
-			else
-				return null;
-		}
-
-		/**
-		 * Write code for evaluating this. Returns maximum JVM stack
-		 * usage.
-		 */
-		public int compileCallTo(CodeVisitor mw, Set recursiveCheck)
-			throws Exception
-		{
-			// if null jump to F
-			// T
-			// jump END
-			// F: F
-			// END: ...
-			Label fl = new Label();
-			Label endl = new Label();
-
-			cond.generate(mw);
-			mw.visitJumpInsn(IFNULL,fl);
-
-			FactorDataStack datastackCopy = (FactorDataStack)
-				datastack.clone();
-			FactorCallStack callstackCopy = (FactorCallStack)
-				callstack.clone();
-
-			int maxJVMStack = t.compileCallTo(mw,recursiveCheck);
-			mw.visitJumpInsn(GOTO,endl);
-			mw.visitLabel(fl);
-
-			datastack = datastackCopy;
-			callstack = callstackCopy;
-
-			maxJVMStack = Math.max(f.compileCallTo(
-				mw,recursiveCheck),maxJVMStack);
-			mw.visitLabel(endl);
-
-			return Math.max(maxJVMStack,1);
-		}
-	} //}}}
-}

factor/compiler/Null.java

@@ -0,0 +1,76 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public class Null extends FlowObject implements Constants
+{
+	Null(FactorCompiler compiler, RecursiveState recursiveCheck)
+	{
+		super(compiler,recursiveCheck);
+	}
+
+	public void generate(CodeVisitor mw)
+	{
+		mw.visitInsn(ACONST_NULL);
+	}
+
+	Object getLiteral()
+	{
+		return null;
+	}
+
+	/**
+	 * Stack effect of executing this -- only used for lists
+	 * and conditionals!
+	 */
+	public void getStackEffect(RecursiveState recursiveCheck)
+	{
+	}
+
+	/**
+	 * Write code for evaluating this. Returns maximum JVM stack
+	 * usage.
+	 */
+	public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck)
+		throws Exception
+	{
+		return 0;
+	}
+
+	public boolean equals(Object o)
+	{
+		return (o instanceof Null);
+	}
+}

factor/compiler/RecursiveForm.java

@@ -0,0 +1,53 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.FactorWord;
+
+public class RecursiveForm
+{
+	public final FactorWord word;
+	public StackEffect effect;
+	public StackEffect baseCase;
+	public boolean active;
+
+	public RecursiveForm(FactorWord word, StackEffect effect)
+	{
+		this.word = word;
+		this.effect = effect;
+	}
+
+	public String toString()
+	{
+		return word.toString() + (
+			baseCase == null
+			? "" : "-" + baseCase);
+	}
+}

factor/compiler/RecursiveState.java

@@ -0,0 +1,98 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+
+public class RecursiveState
+{
+	private Cons words;
+
+	//{{{ RecursiveState constructor
+	public RecursiveState()
+	{
+	} //}}}
+
+	//{{{ RecursiveState constructor
+	public RecursiveState(RecursiveState clone)
+	{
+		words = clone.words;
+	} //}}}
+
+	//{{{ add() method
+	public void add(FactorWord word, StackEffect effect)
+	{
+		//System.err.println(this + ": adding " + word);
+		//System.err.println(words);
+		if(get(word) != null)
+		{
+			//System.err.println("throwing exception");
+			throw new RuntimeException("Calling add() twice on " + word);
+		}
+		words = new Cons(new RecursiveForm(word,effect),words);
+	} //}}}
+
+	//{{{ remove() method
+	public void remove(FactorWord word)
+	{
+		//System.err.println(this + ": removing " + word);
+		if(last().word != word)
+			throw new RuntimeException("Unbalanced add()/remove()");
+		words = words.next();
+	} //}}}
+
+	//{{{ get() method
+	public RecursiveForm get(FactorWord word)
+	{
+		Cons iter = words;
+		while(iter != null)
+		{
+			RecursiveForm form = (RecursiveForm)iter.car;
+			//System.err.println(form.word + "==?" + word);
+			if(form.word == word)
+				return form;
+			iter = iter.next();
+		}
+
+		return null;
+	} //}}}
+
+	//{{{ last() method
+	public RecursiveForm last()
+	{
+		return (RecursiveForm)words.car;
+	} //}}}
+
+	//{{{ toString() method
+	public String toString()
+	{
+		return FactorParser.unparse(words);
+	} //}}}
+}

factor/compiler/Result.java

@@ -0,0 +1,67 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.compiler;
+
+import factor.*;
+import java.lang.reflect.*;
+import java.util.*;
+import org.objectweb.asm.*;
+
+public class Result extends FlowObject implements Constants
+{
+	private int local;
+
+	public Result(int local, FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+	{
+		super(compiler,recursiveCheck);
+		this.local = local;
+	}
+
+	public void generate(CodeVisitor mw)
+	{
+		mw.visitVarInsn(ALOAD,local);
+	}
+
+	public int getLocal()
+	{
+		return local;
+	}
+
+	boolean usingLocal(int local)
+	{
+		return (this.local == local);
+	}
+
+	public String toString()
+	{
+		return "( indeterminate )";
+	}
+}

factor/compiler/StackEffect.java

@@ -32,12 +32,16 @@ package factor.compiler;
 import factor.*;
 import java.util.*;
 
-public class StackEffect
+public class StackEffect implements PublicCloneable, FactorExternalizable
 {
-	public final int inD;
+	public int inD;
-	public final int outD;
+	public int outD;
-	public final int inR;
+	public int inR;
-	public final int outR;
+	public int outR;
+
+	//{{{ StackEffect constructor
+	public StackEffect() {}
+	//}}}
 
 	//{{{ StackEffect constructor
 	public StackEffect(int inD, int outD, int inR, int outR)
@@ -48,69 +52,57 @@ public class StackEffect
 		this.outR = outR;
 	} //}}}
 
-	//{{{ getStackEffect() method
+	//{{{ compose() method
-	public static StackEffect getStackEffect(Cons definition)
+	public static StackEffect compose(StackEffect first,
-		throws Exception
+		StackEffect second)
 	{
-		return getStackEffect(definition,new HashSet(),
+		if(first == null || second == null)
-			new LocalAllocator());
+			return null;
-	} //}}}
 
-	//{{{ getStackEffect() method
+		int inD  = first.inD;
-	public static StackEffect getStackEffect(Cons definition,
+		int inR  = first.inR;
-		Set recursiveCheck, LocalAllocator state)
+		int outD = first.outD;
-		throws Exception
+		int outR = first.outR;
-	{
-		int inD = 0;
-		int outD = 0;
-		int inR = 0;
-		int outR = 0;
 
-		Cons iter = definition;
+		if(second.inD <= outD)
-		while(iter != null)
+			outD -= second.inD;
+		else
 		{
-			Object obj = iter.car;
+			inD += (second.inD - outD);
-			if(obj instanceof FactorWord)
+			outD = 0;
-			{
-				StackEffect se = ((FactorWord)obj).def
-					.getStackEffect(
-					recursiveCheck,
-					state);
-
-				if(se == null)
-					return null;
-
-				if(se.inD <= outD)
-					outD -= se.inD;
-				else
-				{
-					inD += (se.inD - outD);
-					outD = 0;
-				}
-
-				if(se.inR <= outR)
-					outR -= se.inR;
-				else
-				{
-					inR += (se.inR - outR);
-					outR = 0;
-				}
-
-				outD += se.outD;
-				outR += se.outR;
-			}
-			else
-			{
-				outD++;
-				state.pushLiteral(obj);
-			}
-
-			iter = iter.next();
 		}
 
+		if(second.inR <= outR)
+			outR -= second.inR;
+		else
+		{
+			inR += (second.inR - outR);
+			outR = 0;
+		}
+
+		outD += second.outD;
+		outR += second.outR;
+
 		return new StackEffect(inD,outD,inR,outR);
 	} //}}}
 
+	//{{{ decompose() method
+	/**
+	 * Returns a stack effect E such that compose(first,E) == second.
+	 */
+	public static StackEffect decompose(StackEffect first,
+		StackEffect second)
+	{
+		if(second.inD < first.inD || second.inR < first.inR)
+			throw new IllegalArgumentException();
+
+		return new StackEffect(
+			first.outD + second.inD - first.inD,
+			second.outD,
+			first.outR + second.inR - first.inR,
+			second.outR);
+	} //}}}
+
 	//{{{ getCorePrototype() method
 	public String getCorePrototype()
 	{
@@ -122,7 +114,7 @@ public class StackEffect
 			signatureBuf.append("Ljava/lang/Object;");
 		}
 
-		if(outD == 0)
+		if(outD != 1)
 			signatureBuf.append(")V");
 		else
 			signatureBuf.append(")Ljava/lang/Object;");
@@ -145,24 +137,31 @@ public class StackEffect
 	//{{{ toString() method
 	public String toString()
 	{
-		StringBuffer buf = new StringBuffer();
+		StringBuffer buf = new StringBuffer("( ");
 		for(int i = 0; i < inD; i++)
 		{
-			buf.append("I ");
+			buf.append("X ");
 		}
 		for(int i = 0; i < inR; i++)
 		{
-			buf.append("r:I ");
+			buf.append("r:X ");
 		}
 		buf.append("--");
 		for(int i = 0; i < outD; i++)
 		{
-			buf.append(" O");
+			buf.append(" X");
 		}
 		for(int i = 0; i < outR; i++)
 		{
-			buf.append(" r:O");
+			buf.append(" r:X");
 		}
+		buf.append(" )");
 		return buf.toString();
 	} //}}}
+
+	//{{{ clone() method
+	public Object clone()
+	{
+		return new StackEffect(inD,outD,inR,outR);
+	} //}}}
 }

factor/continuations.factor

@@ -66,7 +66,7 @@
 : suspend (--)
     ! Suspend the current fiber.
     ! Not really implemented yet.
-    $initialInterpreterContinuation dup [
+    $top-level-continuation dup [
         call
     ] [
         clear unwind

factor/debugger.factor

@@ -0,0 +1,118 @@
+!:folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2003, 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+: exception? ( exception -- boolean )
+    "java.lang.Throwable" is ;
+
+: print-stack-trace ( exception -- )
+    [ ] "java.lang.Throwable" "printStackTrace" jinvoke ;
+
+: exception. ( exception -- )
+    ! If this is an Factor exception, just print the message, otherwise print
+    ! the entire exception as a string.
+    dup "factor.FactorException" is [
+        [ ] "java.lang.Throwable" "getMessage" jinvoke
+    ] [
+        >str
+    ] ifte print ;
+
+: break ( exception -- )
+    $global [
+        dup @error
+
+        ! Called when the interpreter catches an exception.
+        "break called." print
+        "" print
+        ":w prints the callstack." print
+        ":j prints the Java stack." print
+        ":r returns to top level." print
+        ":s returns to top level, retaining the data stack." print
+        ":g continues execution (but expect another error)." print
+        "" print
+        "ERROR: " write exception.
+
+        ! XXX: move this to the game core!
+        $console [
+            [ t @expanded ] bind
+        ] when*
+
+        callstack$ @error-callstack
+        [
+            @error-continuation
+            "    DEBUG. " interpreter-loop
+            ! If we end up here, the user just exited the err
+            ! interpreter. If we just call return-from-error
+            ! here, its like :g and this is probably not what
+            ! they wanted. So we :r instead.
+            :r
+        ] callcc0
+    ] bind ;
+
+: return-from-error ( -- )
+    "Returning from break." print
+    f @error-callstack
+    f @error-flag
+    f @error ;
+
+: :g ( -- )
+    ! Continues execution from the point of the error. Can be dangerous.
+    return-from-error
+    $error-continuation call ;
+
+: :r ( -- )
+    ! Returns to the top level.
+    return-from-error
+    !XXX
+    $initial-interpreter-continuation dup [
+        call
+    ] [
+        suspend
+    ] ifte ;
+
+: .s ( -- )
+    ! Prints the contents of the data stack
+    datastack$ describe ;
+
+: :s ( -- )
+    ! Returns to the top level, retaining the stack.
+    return-from-error
+    $initial-interpreter-callstack
+    callstack@ ;
+
+: :j ( -- )
+    ! Print the stack trace from the exception that caused the
+    ! last break.
+    $error dup exception? [
+        print-stack-trace
+    ] [
+        "Not an exception: " write .
+    ] ifte ;
+
+: :w ( -- )
+    ! Print the current callstack, or the callstack of the last
+    ! error inside an error context.
+    $error-callstack [ callstack$ ] unless* describe ;

factor/dictionary.factor

@@ -25,14 +25,22 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-: asm ( word -- assembly )
+: apropos ( substring -- )
+    ! Prints all word names that contain the given substring.
+    words [ 2dup str-contains [ . ] [ drop ] ifte ] each drop ;
+
+: asm ( word -- )
     ! Prints JVM bytecode disassembly of the given word.
-    worddef compiled? dup [
+    intern [ $asm ] bind dup [
         print
     ] [
         drop "Not a compiled word." print
     ] ifte ;
 
+: balance ( code -- effect )
+    ! Push stack effect of the given code quotation.
+    no-name effect ;
+
 : compile* ( word -- )
     $interpreter swap
     [ "factor.FactorInterpreter" ] "factor.FactorWord" "compile"
@@ -45,55 +53,88 @@
         intern compile*
     ] ifte ;
 
-: compileAll ( -- )
+: compile-all ( -- )
     "Compiling..." write
     words [ compile ] each
     " done" print ;
 
 : compiled? ( obj -- boolean )
-    [ $asm ] bind ;
+    "factor.compiler.CompiledDefinition" is ;
 
-: compound? (obj -- boolean)
+: compound? ( obj -- boolean )
     "factor.FactorCompoundDefinition" is ;
 
+: <compound> ( word def -- worddef )
+    [ "factor.FactorWord" "factor.Cons" ]
+    "factor.FactorCompoundDefinition"
+    jnew ;
+
+: effect ( word -- effect )
+    ! Push stack effect of the given word.
+    worddef [ ] "factor.FactorWordDefinition"
+    "getStackEffect" jinvoke ;
+
+: effect>list ( effect -- effect )
+    [
+        [ "factor.compiler.StackEffect" "inD" jvar$ ]
+        [ "factor.compiler.StackEffect" "outD" jvar$ ]
+        [ "factor.compiler.StackEffect" "inR" jvar$ ]
+        [ "factor.compiler.StackEffect" "outR" jvar$ ]
+    ] interleave unit cons cons cons ;
+
+: gensym ( -- word )
+    [ ] "factor.FactorWord" "gensym" jinvoke-static ;
+
+: <word> ( name -- word )
+    ! Creates a new uninternalized word.
+    [ "java.lang.String" ] "factor.FactorWord" jnew ;
+
+: intern* ( "word" -- word )
+    dup $ dup [
+        nip
+    ] [
+        drop dup $ tuck s@
+    ] ifte ;
+
+: intern ( "word" -- word )
+    ! Returns the top of the stack if it already been interned.
+    dup word? [ $dict [ intern* ] bind ] unless ;
+
 : missing>f ( word -- word/f )
     ! Is it the missing word placeholder? Then push f.
     dup undefined? [ drop f ] when ;
 
-: shuffle? (obj -- boolean)
+: no-name ( list -- word )
-    "factor.FactorShuffleDefinition" is ;
+    ! Generates an uninternalized word and gives it a compound
+    ! definition created from the given list.
+    [ gensym dup dup ] dip <compound> define ;
 
-: intern ("word" -- word)
+: shuffle? ( obj -- boolean )
-    ! Returns the top of the stack if it already been interned.
+    "factor.FactorShuffleDefinition" is ;
-    dup word? [
-        $dict [ "java.lang.String" ]
-        "factor.FactorDictionary" "intern"
-        jinvoke
-    ] unless ;
 
 : undefined? ( obj -- boolean )
     "factor.FactorMissingDefinition" is ;
 
-: word? (obj -- boolean)
+: word? ( obj -- boolean )
     "factor.FactorWord" is ;
 
 : word ( -- word )
     ! Pushes most recently defined word.
-    $dict "factor.FactorDictionary" "last" jvar$ ;
+    $global [ $last ] bind ;
 
 : worddef? (obj -- boolean)
     "factor.FactorWordDefinition" is ;
 
 : worddef ( word -- worddef )
-    intern
+    dup worddef? [ intern [ $def ] bind missing>f ] unless ;
-    "factor.FactorWord" "def" jvar$
-    missing>f ;
 
-: worddefUncompiled ( word -- worddef )
+: worddef>list ( worddef -- list )
-    intern
+    worddef
-    "factor.FactorWord" "uncompiled" jvar$
+    [ ] "factor.FactorWordDefinition" "toList" jinvoke ;
-    missing>f ;
 
-: words (-- list)
+: words ( -- list )
     ! Pushes a list of all defined words.
-    $dict [ ] "factor.FactorDictionary" "toWordList" jinvoke ;
+    $dict [ uvalues ] bind
+    [
+        cdr dup [ drop ] unless
+    ] map ;

factor/examples.factor

@@ -26,7 +26,6 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 : examples/httpd
-    "/factor/examples/httpd.factor" runResource
     "Enter a port number: " write
     read >fixnum
     "Enter document root (eg, /home/www/): " write
@@ -34,5 +33,4 @@
     httpd ;
 
 : examples/httpd*
-    "/factor/examples/httpd.factor" runResource
     8888 "/home/slava/ExampleHTTPD/" httpd ;

factor/examples/httpd.factor

@@ -1,151 +0,0 @@
-!:folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2003 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-! To make this a bit more useful:
-! - URL encoding
-! - log with date
-! - log user agent
-! - add a socket timeout
-! - if a directory is requested and URL does not end with /, redirect
-! - return more header fields, like Content-Length, Last-Modified, and so on
-! - HEAD request
-! - make httpdFiletype generic, specify file types in a list of comma pairs
-! - basic authentication, using httpdAuth function from a config file
-! - when string formatting is added, some code can be simplified
-! - use nio to handle multiple requests
-! - implement an LSP that does an "apropos" search
-
-: httpdGetPath ( request -- file )
-    dup ".*\\.\\.*" re-matches [
-        f
-    ] [
-        dup [ "GET (.*?)( HTTP.*|)" groups dup [ car ] when ] when
-    ] ifte ;
-
-: httpdResponse (stream msg contentType --)
-    [ "HTTP/1.0 " over fwrite ] 2dip
-    [ over fwriteln "Content-type: " over fwriteln ] dip
-    swap fwriteln ;
-
-: httpdError (stream error --)
-    "Error: " write dup print
-    2dup "text/html" httpdResponse
-    "\n<html><body><h1>" swap "</h1></body></html>" cat3 swap fwriteln ;
-
-: httpdFiletype (filename -- mime-type)
-    [
-        [ ".*\.gif"  re-matches ] [ drop "image/gif"                ]
-        [ ".*\.png"  re-matches ] [ drop "image/png"                ]
-        [ ".*\.html" re-matches ] [ drop "text/html"                ]
-        [ ".*\.txt"  re-matches ] [ drop "text/plain"               ]
-        [ ".*\.lsd"  re-matches ] [ drop "text/plain"               ]
-        [ t ]                     [ drop "application/octet-stream" ]
-    ] cond ;
-
-: httpdUriToPath (uri -- path)
-    $httpdDocRoot swap
-    dup "http://.*?(/.*)" groups [ car ] when*
-    cat2 ;
-
-: httpdPathToAbsolute (path -- absolute)
-    $httpdDocRoot swap cat2
-    "Serving " over cat2 print
-    dup directory? [ "/index.html" cat2 ] when ;
-
-: httpdServeFile (stream argument filename --)
-    nip
-    2dup "200 Document follows" swap httpdFiletype httpdResponse
-    [ "" over fwriteln ] dip
-    <filebr> swap fcopy ;
-
-: httpdListDirectory (stream directory -- string)
-    [ "<html><head><title>" over fwrite ] dip
-    2dup swap fwrite
-    [ "</title></head><body><h1>" over fwrite ] dip
-    2dup swap fwrite
-    [ "</h1><ul>" over fwrite ] dip
-    directory [
-        chars>entities
-        dup directory? [ "/" cat2 ] when
-        [ "<li><a href=\"" over fwrite ] dip
-        2dup swap fwrite
-        [ "\">" over fwrite ] dip
-        2dup swap fwrite
-        [ "</a></li>" over fwrite ] dip
-        drop
-    ] each
-    "</ul></body></html>" swap fwrite ;
-
-: httpdServeDirectory (stream argument directory --)
-    dup "/index.html" cat2 dup exists? [
-        nip httpdServeFile
-    ] [
-        drop nip
-        over "200 Document follows" "text/plain" httpdResponse
-        [ "" over fwriteln ] dip
-        httpdListDirectory
-    ] ifte ;
-
-: httpdServeScript (stream argument filename --)
-    <namespace> [ [ @argument @stdio ] dip runFile ] bind ;
-
-: httpdParseObjectName ( filename -- argument filename )
-    dup "(.*?)\\?(.*)" groups dup [ nip push ] when swap ;
-
-: httpdServeObject (stream filename --)
-    "Serving " write dup print
-    httpdParseObjectName
-    dup exists? [
-        dup directory? [
-            httpdServeDirectory
-        ] [
-            dup ".*\.lhtml" re-matches [
-                httpdServeScript
-            ] [
-                httpdServeFile
-            ] ifte
-        ] ifte
-    ] [
-        2drop "404 Not Found" httpdError
-    ] ifte ;
-
-: httpdRequest (stream request --)
-    httpdGetPath dup [
-        httpdUriToPath httpdServeObject
-    ] [
-        drop "400 Bad request" httpdError
-    ] ifte ;
-
-: httpdClient (socket --)
-    "Accepted connection from " write dup [ $socket ] bind .
-    [ dup freadln httpdRequest ] [ fclose ] cleave ;
-
-: httpdLoop (server --)
-    dup accept httpdClient $httpdQuit [ fclose ] [ httpdLoop ] ifte ;
-
-: httpd (port docroot --)
-    @httpdDocRoot <server> httpdLoop ;

factor/httpd.factor

@@ -0,0 +1,194 @@
+!:folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2003, 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+! To make this a bit more useful:
+! - URL encoding
+! - log with date
+! - log user agent
+! - add a socket timeout
+! - if a directory is requested and URL does not end with /, redirect
+! - return more header fields, like Content-Length, Last-Modified, and so on
+! - HEAD request
+! - basic authentication, using httpdAuth function from a config file
+! - when string formatting is added, some code can be simplified
+! - use nio to handle multiple requests
+! - implement an LSP that does an "apropos" search
+
+[
+    [  "html"   , "text/html"                ]
+    [  "txt"    , "text/plain"               ]
+                                             
+    [  "gif"    , "image/gif"                ]
+    [  "png"    , "image/png"                ]
+    [  "jpg"    , "image/jpeg"               ]
+    [  "jpeg"   , "image/jpeg"               ]
+                
+    [  "jar"    , "application/octet-stream" ]
+    [  "zip"    , "application/octet-stream" ]
+    [  "tgz"    , "application/octet-stream" ]
+    [  "tar.gz" , "application/octet-stream" ]
+    [  "gz"     , "application/octet-stream" ]
+] @httpd-extensions
+
+: group1 ( string regex -- string )
+    groups dup [ car ] when ;
+
+: httpd-response ( msg content-type -- response )
+    [ "HTTP/1.0 " swap "\nContent-Type: " ] dip "\n" cat5 ;
+
+: httpd-file-header ( filename -- header )
+    "200 Document follows" swap httpd-filetype httpd-response ;
+
+: httpd-serve-file ( stream filename -- )
+    2dup httpd-file-header swap fwriteln <filebr> swap fcopy ;
+
+: httpd-log-error ( error -- )
+    "Error: " swap cat2 print ;
+
+: httpd-error-body ( error -- body )
+    "\n<html><body><h1>" swap "</h1></body></html>" cat3 ;
+
+: httpd-error ( stream error -- )
+    dup httpd-log-error
+    [ "text/html" httpd-response ] [ httpd-error-body ] cleave
+    cat2
+    swap fwriteln ;
+
+: httpd-response-write ( stream msg content-type -- )
+    httpd-response swap fwriteln ;
+
+: httpd-file-extension ( filename -- extension )
+    ".*\\.(.*)" group1 ;
+
+: httpd-filetype ( filename -- mime-type )
+    httpd-file-extension $httpd-extensions assoc
+    [ "text/plain" ] unless* ;
+
+: httpd-url>path ( uri -- path )
+    dup "http://.*?(/.*)" group1 dup [
+        nip
+    ] [
+        drop
+    ] ifte
+    $httpd-doc-root swap cat2 ;
+
+: httpd-file>html ( filename -- ... )
+    "<li><a href=\"" swap
+    !dup directory? [ "/" cat2 ] when
+    chars>entities
+    "\">" over "</a></li>" ;
+
+: httpd-directory>html ( directory -- html )
+    directory [ httpd-file>html ] map cat ;
+
+: httpd-directory-header ( stream directory -- )
+    "200 Document follows" "text/html" httpd-response fwriteln ;
+
+: httpd-list-directory ( stream directory -- )
+    2dup httpd-directory-header [
+        "<html><head><title>" swap
+        "</title></head><body><h1>" over
+        "</h1><ul>" over
+        httpd-directory>html
+        "</ul></body></html>"
+    ] cons expand cat swap fwrite ;
+
+: httpd-serve-directory ( stream directory -- )
+    dup "/index.html" cat2 dup exists? [
+        nip httpd-serve-file
+    ] [
+        drop httpd-list-directory
+    ] ifte ;
+
+: httpd-serve-script ( stream argument filename -- )
+    <namespace> [ [ @argument @stdio ] dip runFile ] bind ;
+
+: httpd-parse-object-name ( filename -- argument filename )
+    dup "(.*?)\\?(.*)" groups dup [ nip call ] when swap ;
+
+: httpd-serve-static ( stream filename -- )
+    dup exists? [
+        dup directory? [
+            httpd-serve-directory
+        ] [
+            httpd-serve-file
+        ] ifte
+    ] [
+        drop "404 Not Found" httpd-error
+    ] ifte ;
+
+: httpd-serve-object ( stream argument filename -- )
+    dup ".*\\.lhtml" re-matches [
+        httpd-serve-script
+    ] [
+        nip httpd-serve-static
+    ] ifte ;
+
+: httpd-serve-log ( filename -- )
+    "Serving " swap cat2 print ;
+
+: httpd-get-request ( stream url -- )
+    httpd-url>path dup httpd-serve-log
+    httpd-parse-object-name httpd-serve-object ;
+
+: httpd-get-path ( request -- file )
+    "GET (.*?)( HTTP.*|)" group1 ;
+
+: httpd-get-secure-path ( path -- path )
+    dup [
+        httpd-get-path dup [
+            dup ".*\\.\\.*" re-matches [ drop f ] when
+        ] [
+            drop f
+        ] ifte
+    ] [
+        drop f
+    ] ifte ;
+
+: httpd-request ( stream request -- )
+    httpd-get-secure-path dup [
+        httpd-get-request
+    ] [
+        drop "400 Bad request" httpd-error
+    ] ifte ;
+
+: httpd-client-log ( socket -- )
+    "Accepted connection from " write [ $socket ] bind . ;
+
+: httpd-client ( socket -- )
+    dup httpd-client-log
+    dup freadln [ httpd-request ] when* ;
+
+: httpd-loop ( server -- )
+    [
+        $httpd-quit not
+    ] [
+        dup accept dup httpd-client fclose
+    ] while ;
+
+: httpd ( port docroot -- )
+    @httpd-doc-root <server> httpd-loop ;

factor/inspector.factor

@@ -0,0 +1,141 @@
+!:folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2003, 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+: max-str-length ( list -- len )
+    ! Returns the length of the longest string in the given
+    ! list.
+    0 swap [ str-length max ] each ;
+
+: pad-string ( len str -- str )
+    str-length - spaces ;
+
+: words. (--)
+    ! Print all defined words.
+    words [ . ] each ;
+
+: vars. ( -- )
+    ! Print a list of defined variables.
+    uvars [ print ] each ;
+
+: value/tty ( max [ name , value ] -- ... )
+    uncons [ dup [ pad-string ] dip ": " ] dip unparse "\n" ;
+
+: values/tty ( -- ... )
+    ! Apply 'expand' or 'str-expand' to this word.
+    uvars max-str-length
+    uvalues [ over [ value/tty ] dip ] each drop ;
+
+: value/html ( [ name , value ] -- ... )
+    uncons [
+        [ "<tr><th align=\"left\">" ] dip
+        "</th><td><a href=\"inspect.lhtml?" over "\">"
+    ] dip
+    unparse chars>entities
+    "</a></td></tr>" ;
+
+: values/html ( -- ... )
+    ! Apply 'expand' or 'str-expand' to this word.
+    uvalues [ value/html ] each ;
+
+: inspecting ( obj -- namespace )
+    dup has-namespace? [ <objnamespace> ] unless ;
+
+: describe* ( obj quot -- )
+    ! Print an informational header about the object, and print
+    ! all values in its object namespace.
+    swap inspecting [ str-expand ] bind print ;
+
+: describe ( obj -- )
+    [
+        [ worddef? ] [ see ]
+        [ stack?   ] [ stack>list print-numbered-list ]
+        [ string?  ] [ print ]
+        [ drop t   ] [
+            "OBJECT: " write dup .
+            [
+                "CLASS : " write dup class-of print
+                "--------" print
+                [ values/tty ] describe*
+            ] when*
+        ]
+    ] cond ;
+
+: describe/html ( obj -- )
+    [
+        [ worddef? ] [ see/html ]
+        [ string?  ] [
+            "<pre>" print chars>entities print "</pre>" print
+        ]
+        [ drop t   ] [
+            "<table><tr><th align=\"left\">OBJECT:</th><td>" print
+            dup unparse chars>entities write
+            "</td></tr>" print
+
+            [
+                "<tr><th align=\"left\">CLASS:</th><td>" write
+                dup class-of print
+                "</td></tr>" print
+                "<tr><td colspan=\"2\"><hr></td></tr>" print
+                [ values/html ] describe*
+            ] when*
+
+            "</table>" print
+        ]
+    ] cond ;
+
+: object-path ( list -- object )
+    ! An object path is a list of strings. Each string is a
+    ! variable name in the object namespace at that level.
+    ! Returns f if any of the objects are not set.
+    dup [
+        unswons $ dup [
+            ! Defined.
+            inspecting [ object-path ] bind
+        ] [
+            ! Undefined. Just return f.
+            2drop f
+        ] ifte
+    ] [
+        ! Current object.
+        drop $this [ $namespace ] unless*
+    ] ifte ;
+
+: inspect ( obj -- )
+    ! Display the inspector for the object, and start a new
+    ! REPL bound to the object's namespace.
+    inspecting dup describe
+    "--------" print
+    ! Start a REPL, only if the object is not the dictionary.
+    dup $dict = [
+        "Cannot enter into dictionary. Use 'see' word." print
+    ] [
+        "exit    - exit one level of inspector." print
+        "suspend - return to top level." print
+        dup [
+            "    " swap unparse " " cat3 interpreter-loop
+        ] bind
+    ] ifte ;

factor/interpreter.factor

@@ -25,136 +25,58 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-: exception? (exception -- boolean)
+0 @history-count
-    "java.lang.Throwable" is ;
 
-: printStackTrace (exception --)
+: exit (--)
-    [ ] "java.lang.Throwable" "printStackTrace" jinvoke ;
+    $global [ t @quit-flag ] bind ;
 
-: exception. (exception --)
+: print-banner ( -- )
-    ! If this is an Factor exception, just print the message, otherwise print
-    ! the entire exception as a string.
-    dup "factor.FactorException" is [
-        [ ] "java.lang.Throwable" "getMessage" jinvoke
-    ] [
-        >str
-    ] ifte print ;
-
-: break (exception --)
-    dup @error
-
-    ! Called when the interpreter catches an exception.
-    "break called." print
-    "" print
-    ":w prints the callstack." print
-    ":j prints the Java stack." print
-    ":r returns to top level." print
-    ":s returns to top level, retaining the data stack." print
-    ":g continues execution (but expect another error)." print
-    "" print
-    "ERROR: " write exception.
-    :w
-    callstack$ @errorCallStack
-    [
-        @errorContinuation
-        interpreterLoop
-        ! If we end up here, the user just exited the err interpreter.
-        ! If we just call returnFromError here, its like :g and this
-        ! is probably not what they wanted. So we :r instead.
-        :r
-    ] callcc0 ;
-
-: returnFromError (--)
-    "Returning from break." print
-    f @errorCallStack
-    f @errorFlag
-    f @error ;
-
-: :g (--)
-    ! Continues execution from the point of the error. Can be dangerous.
-    returnFromError
-    $errorContinuation call ;
-
-: :r (--)
-    ! Returns to the top level.
-    returnFromError
-    !XXX
-    $initialInterpreterContinuation dup [
-        call
-    ] [
-        suspend
-    ] ifte ;
-
-: :s (--)
-    ! Returns to the top level, retaining the stack.
-    returnFromError
-    $initialInterpreterCallStack callstack@ ;
-
-: :j (--)
-    ! Print the stack trace from the exception that caused the last break.
-    $error dup exception? [
-        printStackTrace
-    ] [
-        "Not an exception: " write .
-    ] ifte ;
-
-: :w (--)
-    ! Print the current callstack, or the callstack of the last error inside an
-    ! error context.
-    $errorCallStack dup [
-        drop callstack$
-    ] unless . ;
-
-: printPrompt (--)
-    $errorFlag "  err> " "  ok> " ? write ;
-
-: interpreterLoop (--)
-    printPrompt read [
-        eval
-        $quitFlag [ interpreterLoop ] unless
-    ] when* ;
-
-: initialInterpreterLoop (--)
-    ! Run the stand-alone interpreter
     "Factor " $version cat2 print
     "Copyright (C) 2003, 2004 Slava Pestov" print
     "Enter ``help'' for help." print
-    "Enter ``exit'' to exit." print
+    "Enter ``exit'' to exit." print ;
+
+: history+ ( cmd -- )
+    $history 2dup contains [ 2drop ] [ cons @history ] ifte
+    "history-count" succ@ ;
+
+: history ( -- )
+    "X redo    -- evaluate the expression with number X." print
+    "X re-edit -- edit the expression with number X." print
+    $history print-numbered-list ;
+
+: get-history ( index -- )
+    $history reverse swap get ;
+
+: redo ( index -- )
+    get-history [ . ] [ eval ] cleave ;
+
+: re-edit ( index -- )
+    get-history edit ;
+
+: print-prompt ( prompt -- )
+    write $history-count write "] " write ;
+
+: interpreter-loop ( prompt -- )
+    dup >r print-prompt read [
+        [ history+ ] [ eval ] cleave
+        $global [ $quit-flag ] bind [
+            rdrop
+            $global [ f @quit-flag ] bind
+        ] [
+            r> interpreter-loop
+        ] ifte
+    ] when* ;
+
+: initial-interpreter-loop (--)
+    ! Run the stand-alone interpreter
+    print-banner
     ! Used by :r
-    [ @initialInterpreterContinuation ] callcc0
+    [ @initial-interpreter-continuation ] callcc0
     ! Used by :s
     ! We use the slightly redundant 'call' to push the current callframe.
-    [ callstack$ @initialInterpreterCallStack ] call
+    [ callstack$ @initial-interpreter-callstack ] call
-    interpreterLoop ;
+    "    " interpreter-loop ;
-
-: words. (--)
-    ! Print all defined words.
-    words [ . ] each ;
-
-: see (word --)
-    dup worddefUncompiled [
-        (word -- worddef word)
-        dup [
-            worddefUncompiled dup shuffle? "~<< " ": " ? write
-        ] dip
-
-        (worddef word -- worddef)
-        write "\n    " write
-
-        dup >str write
-
-        shuffle? " >>~\n" " ;\n" ? write
-    ] [
-        "Not defined: " write print
-    ] ifte ;
-
-: vars. (--)
-    ! Print a list of defined variables.
-    vars [ . ] each ;
-
-: .s (--)
-    ! Prints the contents of the data stack
-    datastack$ . ;
 
 : stats ( -- )
     "Cons:     " write
@@ -167,28 +89,24 @@
 : gc ( -- )
     [ ] "java.lang.System" "gc" jinvoke-static ;
 
-: balance ( code -- effect )
-    ! Push stack effect of the given code quotation.
-    [ "factor.Cons" ] "factor.compiler.StackEffect"
-    "getStackEffect" jinvoke-static ;
-
 : help
+    "clear              -- clear datastack."
+    ".s                 -- print datastack."
+    ".                  -- print top of datastack."
     "" print
-    "= Dynamic, interpreted, stack-based scripting language" print
+    "values.            -- list all variables." print
-    "= Arbitrary precision math, ratio math" print
+    "inspect            -- list all variables bound on object at top of stack." print
-    "= First-class, higher-order, and anonymous functions" print
+    "$variable .        -- show value of variable." print
-    "= Prototype-based object system" print
-    "= Continuations" print
-    "= Tail call optimization" print
-    "= Rich set of primitives based on recursion" print
     "" print
-    "Some basic commands:" print
+    "words.             -- list all words." print
-    "clear       -- clear stack." print
+    "\"str\" apropos      -- list all words whose name contains str." print
-    ".s          -- print stack." print
+    "\"word\" see         -- show definition of word." print
-    ".           -- print top of stack." print
+    "" print
-    "vars.       -- list all variables." print
+    "[ expr ] balance . -- show stack effect of expression." print
-    "$variable . -- show value of variable." print
+    "" print
-    "words.      -- list all words." print
+    "history            -- list previously entered expresions." print
-    "\"word\" see  -- show definition of word." print
+    "X redo             -- redo expression number X from history list." print
-    "exit        -- exit the interpreter." print
+    "" print
+    "stats              -- interpreter statistics." print
+    "exit               -- exit the interpreter." print
     "" print ;

factor/lists.factor

@@ -25,9 +25,42 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+!
+! List manipulation primitives
+!
+: array>list ( array -- list )
+    [ [ "java.lang.Object" ] ] "factor.Cons" "fromArray"
+    jinvoke-static ;
+
+: car ([ car , cdr ] -- car)
+    |factor.Cons |car jvar$ ;
+
+: cdr ([ car , cdr ] -- cdr)
+    |factor.Cons |cdr jvar$ ;
+
+: cons (car cdr -- [ car , cdr ])
+    [ |java.lang.Object |java.lang.Object ] |factor.Cons jnew ;
+
+: cons? (list -- boolean)
+    |factor.Cons is ;
+
+: rplaca ( A [ B , C ] -- [ A , C ] )
+    ! Destructive!
+    "factor.Cons" "car" jvar@ ;
+
+: rplacd ( A [ B , C ] -- [ B , A ] )
+    ! Destructive!
+    "factor.Cons" "cdr" jvar@ ;
+
+!
+! List manipulation library
+!
 : 2list (a b -- [ a b ])
     unit cons ;
 
+: 3list ( a b c -- [ a b c ] )
+    2list cons ;
+
 : 2rlist (a b -- [ b a ])
     swap unit cons ;
 
@@ -41,10 +74,6 @@
     ! Adds the list to the end of the list stored in the given variable.
     dup [ $ swap append ] dip @ ;
 
-: array>list ( array -- list )
-    [ [ "java.lang.Object" ] ] "factor.Cons" "fromArray"
-    jinvoke-static ;
-
 : add@ (elem variable --)
     ! Adds the element to the end of the list stored in the given variable.
     dup [ $ swap add ] dip @ ;
@@ -63,11 +92,19 @@
         2drop f
     ] ifte ;
 
-: car ([ car , cdr ] -- car)
+: assoc$ (key alist -- value)
-    |factor.Cons |car jvar$ ;
+    ! Looks up the key in the given variable alist. A variable
-
+    ! alist is a list of comma pairs, the car of each pair is a
-: cdr ([ car , cdr ] -- cdr)
+    ! variable name, the cdr is the value.
-    |factor.Cons |cdr jvar$ ;
+    dup [
+        2dup car car $ = [
+            nip car cdr
+        ] [
+            cdr assoc$
+        ] ifte
+    ] [
+        2drop f
+    ] ifte ;
 
 : caar (list -- caar)
     car car ;
@@ -81,18 +118,24 @@
 : cddr (list -- cddr)
     cdr cdr ;
 
-: cloneList (list -- list)
+: clone-list-iter ( result list -- last [ ] )
-    ! Returns a new list where each element is a clone of the elements of
+    [
-    ! the given list.
+        dup cons?
-    dup [ [ ] "factor.Cons" "deepClone" jinvoke ] when ;
+    ] [
+        uncons [ unit tuck [ rplacd ] dip ] dip
+    ] while ;
 
-: cons (car cdr -- [ car , cdr ])
+: clone-list (list -- list)
-    [ |java.lang.Object |java.lang.Object ] |factor.Cons jnew ;
+    dup [
+        uncons [ unit dup ] dip clone-list-iter swap rplacd
+    ] when ;
 
-: contains (elem list -- boolean)
+: contains ( elem list -- remainder )
+    ! If the list contains elem, return the remainder of the
+    ! list, starting from the cell whose car is elem.
     dup [
         2dup car = [
-            2drop t
+            nip
         ] [
             cdr contains
         ] ifte
@@ -102,21 +145,17 @@
 
 : cons@ (x var --)
     ! Prepends x to the list stored in var.
-    dup [ $ cons ] dip @ ;
+    tuck $ cons s@ ;
 
 : count (n -- [ 1 2 3 ... n ])
     [ [ ] times* ] cons expand ;
 
-: swons@ (var x --)
-    ! Prepends x to the list stored in var.
-    over $ cons s@ ;
-
 : get (list n -- list[n])
     [ cdr ] times car ;
 
 : last* ( list -- last )
     ! Pushes last cons of the list.
-    [ dup cdr ] [ cdr ] while ;
+    [ dup cdr cons? ] [ cdr ] while ;
 
 : last ( list -- last )
     ! Pushes last element of the list.
@@ -125,37 +164,88 @@
 : length (list -- length)
     0 swap [ drop succ ] each ;
 
-: list (list[0] ... list[n] n -- list)
+: list? ( list -- boolean )
-    [ ] swap [ cons ] times ;
+    ! A list is either f, or a cons cell whose cdr is a list.
-
+    dup [
-: list? (list -- boolean)
+        dup cons? [
-    dup pair? [ cdr list? ] [ f ] ifte ;
+            cdr list?
+        ] [
+            drop f
+        ] ifte
+    ] [
+        drop t
+    ] ifte ;
 
 : nappend ( [ list1 ] [ list2 ] -- [ list1 list2 ] )
     ! Destructive on list1!
-    over [ last* rplacd ] when* ;
+    over [ over last* rplacd ] [ nip ] ifte ;
 
-: pair? (list -- boolean)
+~<< partition-iterI
-    |factor.Cons is ;
+    R1 R2 A D C -- A C r:R1 r:R2 r:A r:D r:C >>~
+
+~<< partition-iterT{
+    r:R1 r:R2 r:A r:D r:C -- A R1 r:R1 r:R2 r:D r:C >>~
+
+~<< }partition-iterT
+    R1 r:R1X r:R2 r:D r:C -- R1 R2 D C >>~
+
+~<< partition-iterF{
+    r:R1 r:R2 r:A r:D r:C -- A R2 r:R1 r:R2 r:D r:C >>~
+
+~<< }partition-iterF
+    R2 r:R1 r:R2X r:D r:C -- R1 R2 D C >>~
+
+: partition-iter ( ref ret1 ret2 list combinator -- ret1 ret2 )
+    over [
+        ! Note this ifte must be in tail position!
+        [ uncons ] dip partition-iterI [ dup ] 2dip call [
+            partition-iterT{ cons }partition-iterT partition-iter
+        ] [
+            partition-iterF{ cons }partition-iterF partition-iter
+        ] ifte
+    ] [
+        2drop
+    ] ifte ;
+
+: partition ( ref list combinator -- list1 list2 )
+    [ ] [ ] 2swap partition-iter rot drop ;
 
 : reverse (list -- list)
     [ ] swap [ swons ] each ;
 
-: rplaca ( A [ B , C ] -- [ A , C ] )
+: sort ( list comparator -- sorted )
-    ! Destructive!
+    over [
-    "factor.Cons" "car" jvar@ ;
+        ! Partition
-
+        dup [ [ uncons dupd ] dip partition ] dip
-: rplacd ( A [ B , C ] -- [ B , A ] )
+        ! Recurse
-    ! Destructive!
+        tuck sort [ sort ] dip
-    "factor.Cons" "cdr" jvar@ ;
+        ! Combine
+        swapd cons append
+    ] [
+        drop
+    ] ifte ;
 
 : swons (cdr car -- [ car , cdr ])
-    swap [ |java.lang.Object |java.lang.Object ]
+    swap cons ;
-    |factor.Cons jnew ;
+
+: swons@ (var x --)
+    ! Prepends x to the list stored in var.
+    over $ cons s@ ;
 
 : uncons ([ car , cdr ] -- car cdr)
     dup car swap cdr ;
 
+: unique ( elem list -- list )
+    ! Cons elem onto list if its not already there.
+    2dup contains [
+        nip
+    ] [
+        cons
+    ] ifte ;
+
+: unique@ ( elem var -- )
+    tuck $ unique s@ ;
+
 : unit (a -- [ a ])
     f cons ;
 

factor/math.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2003 Slava Pestov.
+! Copyright (C) 2003, 2004 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -28,9 +28,16 @@
 : 0= (x -- boolean)
     0 = ;
 
+: 0>f ( obj -- oj )
+    ! If 0 a the top of the stack, turn it into f.
+    dup 0 = [ drop f ] when ;
+
 : 1= (x -- boolean)
     1 = ;
 
+: number? (obj -- boolean)
+    "java.lang.Number" is ;
+
 : fixnum? (obj -- boolean)
     "java.lang.Integer" is ;
 
@@ -58,6 +65,9 @@
     [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "add"
     jinvoke-static ;
 
+: v+ ( A B -- A+B )
+    [ + ] 2map ;
+
 : +@ (num var --)
     dup [ $ + ] dip @ ;
 
@@ -65,6 +75,10 @@
     [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "subtract"
     jinvoke-static ;
 
+: v- ( A B -- A-B )
+    [ - ] 2map ;
+
+
 : -@ (num var --)
     dup [ $ swap - ] dip @ ;
 
@@ -72,6 +86,13 @@
     [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "multiply"
     jinvoke-static ;
 
+: v* ( A B -- A*B )
+    [ * ] 2map ;
+
+: v. ( A B -- A.B )
+    ! Dot product.
+    v* 0 swap [ + ] each ;
+
 : *@ (num var --)
     dup [ $ * ] dip @ ;
 
@@ -79,6 +100,9 @@
     [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "divide"
     jinvoke-static ;
 
+: v/ ( A B -- A/B )
+    [ / ] 2map ;
+
 : /@ (num var --)
     dup [ $ / ] dip @ ;
 
@@ -97,10 +121,20 @@
 : and (a b -- a&b)
     f ? ;
 
+: gcd ( a b -- c )
+    [ "java.lang.Number" "java.lang.Number" ]
+    "factor.FactorMath" "gcd" jinvoke-static ;
+
 : mag2 (x y -- mag)
     ! Returns the magnitude of the vector (x,y).
     sq swap sq + sqrt ;
 
+: max ( x y -- z )
+    2dup > -rot ? ;
+
+: min ( x y -- z )
+    2dup < -rot ? ;
+
 : neg (x -- -x)
     0 swap - ;
 
@@ -120,14 +154,11 @@
 : pred (n -- n-1)
     1 - ;
 
-: round ( x y -- x^y )
-    [ "double" "double" ] "java.lang.Math" "pow" jinvoke-static ;
-
 : succ (n -- nsucc)
     1 + ;
 
 : pred@ (var --)
-    dup $ 1 - s@ ;
+    dup $ pred s@ ;
 
 : or (a b -- a|b)
     t swap ? ;
@@ -135,6 +166,13 @@
 : recip (x -- 1/x)
     1 swap / ;
 
+: rem ( x y -- remainder )
+    [ "double" "double" ] "java.lang.Math" "IEEEremainder"
+    jinvoke-static ;
+
+: round ( x to -- y )
+    dupd rem - ;
+
 : sq (x -- x^2)
     dup * ;
 
@@ -142,7 +180,7 @@
     [ "double" ] "java.lang.Math" "sqrt" jinvoke-static ;
 
 : succ@ (var --)
-    dup $ 1 + s@ ;
+    dup $ succ s@ ;
 
 : deg2rad (degrees -- radians)
     $pi * 180 / ;

factor/miscellaneous.factor

@@ -30,6 +30,9 @@
     [ "java.lang.Object" "java.lang.Object" ]
     "factor.FactorLib" "equal" jinvoke-static ;
 
+: class-of ( obj -- class )
+    [ ] "java.lang.Object" "getClass" jinvoke ;
+
 : clone (obj -- obj)
     [ ] "factor.PublicCloneable" "clone" jinvoke ;
 
@@ -43,7 +46,7 @@
     "factor.FactorLib" "deepCloneArray"
     jinvoke-static ;
 
-: is (obj class -- boolean)
+: is ( obj class -- boolean )
     ! Like "instanceof" in Java.
     [ "java.lang.Object" ] "java.lang.Class" "isInstance"
     jinvoke ;
@@ -69,18 +72,22 @@
 : exit* (code --)
     [ |int ] |java.lang.System |exit jinvoke-static ;
 
-: exit (--)
-    0 exit* ;
-
 : millis (-- millis)
     ! Pushes the current time, in milliseconds.
     [ ] |java.lang.System |currentTimeMillis jinvoke-static
     >bignum ;
 
+: stack? ( obj -- ? )
+    "factor.FactorArrayStack" is ;
+
 : stack>list (stack -- list)
     ! Turns a callstack or datastack object into a list.
     [ ] "factor.FactorArrayStack" "toList" jinvoke ;
 
+: system-property ( name -- value )
+    [ "java.lang.String" ] "java.lang.System" "getProperty"
+    jinvoke-static ;
+
 : time (code --)
     ! Evaluates the given code and prints the time taken to execute it.
-    millis swap dip millis -- . ;
+    millis >r call millis r> - . ;

factor/namespaces.factor

@@ -28,13 +28,16 @@
 : s@ ( variable value -- )
     swap @ ;
 
-: lazy (var [ a ] -- value)
+: has-namespace? ( a -- boolean )
-    ! If the value of the variable is f, set the value to the result of
+    "factor.FactorObject" is ;
-    ! evaluating [ a ].
+
+: lazy ( var [ a ] -- value )
+    ! If the value of the variable is f, set the value to the
+    ! result of evaluating [ a ].
     over $ [ drop $ ] [ dip dupd @ ] ifte ;
 
-: namespace? (a -- boolean)
+: namespace? ( a -- boolean )
-    |factor.FactorNamespace is ;
+    "factor.FactorNamespace" is ;
 
 : <namespace> (-- namespace)
     $namespace [ |factor.FactorNamespace ] |factor.FactorNamespace
@@ -45,7 +48,7 @@
     [ "factor.FactorNamespace" "java.lang.Object" ]
     "factor.FactorNamespace" jnew ;
 
-: extend (object code -- object)
+: extend ( object code -- object )
     ! Used in code like this:
     ! : <subclass>
     !      <superclass> [
@@ -53,19 +56,27 @@
     !      ] extend ;
     over [ bind ] dip ;
 
-: import (class pairs --)
+: import ( class pairs -- )
-    ! Import some static variables from a Java class into the current namespace.
+    ! Import some static variables from a Java class into the
+    ! current namespace.
     $namespace [ |java.lang.String |factor.Cons ]
     |factor.FactorNamespace |importVars
     jinvoke ;
 
-: vars (-- list)
+: vars ( -- list )
     $namespace [ ] |factor.FactorNamespace |toVarList jinvoke ;
 
-: uvar? (name --)
+: values ( -- list )
-    [ "namespace" "parent" ] contains not ;
+    $namespace [ ] |factor.FactorNamespace |toValueList
+    jinvoke ;
 
-: uvars (-- list)
+: uvalues ( -- list )
-    ! Does not include "namespace" and "parent" variables; ie, all user-defined
+    values [ car uvar? ] subset ;
-    ! variables in given namespace.
+
+: uvar? ( name -- )
+    [ "namespace" "parent" "this" ] contains not ;
+
+: uvars ( -- list )
+    ! Does not include "namespace" and "parent" variables; ie,
+    ! all user-defined variables in given namespace.
     vars [ uvar? ] subset ;

factor/parser.factor

@@ -25,18 +25,31 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-: parse (string -- list)
+: parse ( string -- list )
     f swap <sreader> parse* ;
 
-: eval ("X" -- X)
+: compile-call ( [ X ] -- X )
-    parse call ;
+    no-name dup compile execute ;
 
-: runFile (path --)
+: eval ( "X" -- X )
+    parse $compile-toplevel [ compile-call ] [ call ] ifte ;
+
+: eval-compile ( "X" -- X )
+    parse no-name word compile word execute ;
+
+: runFile ( path -- )
     dup <freader> parse* call ;
 
-: unparse (X -- "X")
+: unparse ( X -- "X" )
-    [ |java.lang.Object ] |factor.FactorJava |factorTypeToString
+    [ |java.lang.Object ] |factor.FactorParser |unparse
     jinvoke-static ;
 
-: . (expr --)
+: . ( expr -- )
     unparse print ;
+
+: parse-number ( str -- number )
+    parse dup length 1 = [
+        car dup number? [ drop f ] unless
+    ] [
+        drop f
+    ] ifte ;

factor/prettyprint.factor

@@ -0,0 +1,176 @@
+!:folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2003, 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+4 @indent
+
+: <prettyprint-token> ( string -- token )
+    dup <namespace> [
+        @name
+        t @prettyprint-token
+    ] extend tuck s@ ;
+
+: prettyprint-token? ( token -- token? )
+    dup has-namespace? [
+        [ $prettyprint-token ] bind
+    ] [
+        drop f
+    ] ifte ;
+
+: prettyprint-indent ( indent -- indent )
+    dup spaces write ;
+
+: prettyprint-newline/space ( indent ? -- indent )
+    [ "\n" write prettyprint-indent ] [ " " write ] ifte ;
+
+: prettyprint-indent-params ( indent obj -- indent ? ? name )
+    [
+        $indent+ [ $indent + ] when
+        $indent- [ $indent - ] when
+        $-indent [ $indent - t ] [ f ] ifte
+        $newline
+        $name
+    ] bind ;
+
+: prettyprint-token ( indent obj -- indent )
+    prettyprint-indent-params
+    [
+        [
+            "\n" write
+            prettyprint-indent
+        ] when
+    ] 2dip
+    write prettyprint-newline/space ;
+
+: prettyprint-unparsed ( indent unparse -- indent )
+    dup "\n" = [
+        drop "\n" write prettyprint-indent
+    ] [
+        write " " write
+    ] ifte ;
+
+: [prettyprint-tty] ( indent obj -- indent )
+    dup prettyprint-token? [
+        prettyprint-token
+    ] [
+        unparse prettyprint-unparsed
+    ] ifte ;
+
+: prettyprint-html-unparse ( obj -- unparse )
+    dup unparse dup "\n" = [
+        nip
+    ] [
+        swap word? [
+            "<a href=\"see.lhtml?" swap "\">" over "</a>" cat5
+        ] [
+            chars>entities
+        ] ifte
+    ] ifte ;
+
+: [prettyprint-html] ( indent obj -- indent )
+    dup prettyprint-token? [
+        prettyprint-token
+    ] [
+        prettyprint-html-unparse prettyprint-unparsed
+    ] ifte ;
+
+: prettyprint-list* ( quot list -- )
+    ! Pretty-print a list, without [ and ].
+    [
+        over [
+            prettyprint*
+        ] dip
+    ] each
+    ! Drop the quotation
+    drop ;
+
+: prettyprint-list ( quot list before after -- )
+    ! Apply the quotation to 'before', call prettyprint* on
+    ! 'list', and apply the quotation to 'after'.
+    swapd [
+        [
+            swap dup [
+                call
+            ] dip
+        ] dip
+        swap dup [
+            swap prettyprint-list*
+        ] dip
+    ] dip
+    swap call ;
+
+: prettyprint* ( quot obj -- )
+    [
+        [ not       ] [ swap call ]
+        [ list?     ] [ $[ $] prettyprint-list ]
+        [ compound? ] [ worddef>list $: $; prettyprint-list ]
+        [ compiled? ] [ worddef>list $: $; prettyprint-list ]
+        [ shuffle?  ] [ worddef>list $~<< $>>~ prettyprint-list ]
+        [ drop t    ] [ swap call ]
+    ] cond ;
+
+: prettyprint-tty ( list -- )
+    0 [ [prettyprint-tty] ] rot prettyprint* drop ;
+
+: prettyprint-html ( list -- )
+    0 [ [prettyprint-html] ] rot prettyprint* drop ;
+
+: see ( word -- )
+    worddef prettyprint-tty ;
+
+: see/html ( word -- )
+    "<pre>" print
+    worddef prettyprint-html
+    "</pre>" print ;
+
+!!!
+
+"["   <prettyprint-token> [
+    t @indent+
+    t @newline
+] bind
+
+"]"   <prettyprint-token> [
+    t @-indent
+] bind
+
+":"   <prettyprint-token> [
+    t @indent+
+] bind
+
+";"   <prettyprint-token> [
+    t @indent-
+    t @newline
+] bind
+
+"~<<" <prettyprint-token> [
+    t @indent+
+] bind
+
+">>~" <prettyprint-token> [
+    t @indent-
+    t @newline
+] bind

factor/primitives/Bind.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class Bind extends FactorWordDefinition
@@ -55,40 +55,26 @@ public class Bind extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws Exception
+		FactorCompiler state) throws Exception
 	{
 		state.ensure(state.datastack,2);
-		LocalAllocator.FlowObject quot
+		FlowObject quot = (FlowObject)state.datastack.pop();
-			= (LocalAllocator.FlowObject)
-			state.datastack.pop();
 		state.pop(null);
-		StackEffect effect = quot.getStackEffect(recursiveCheck);
+		quot.getStackEffect(recursiveCheck);
-		if(effect != null)
-		{
-			// add 2 to inD since we consume the
-			// quotation and the object
-			return new StackEffect(effect.inD + 2,
-				effect.outD,
-				effect.inR,
-				effect.outR);
-		}
-		else
-			return null;
 	} //}}}
 
-	//{{{ compileCallTo() method
+	//{{{ compileImmediate() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	public int compileCallTo(
+	public int compileImmediate(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		LocalAllocator.FlowObject quot = (LocalAllocator.FlowObject)
+		FlowObject quot = (FlowObject)compiler.datastack.pop();
-			allocator.datastack.pop();
 
 		// store namespace on callstack
 		mw.visitVarInsn(ALOAD,0);
@@ -101,11 +87,11 @@ public class Bind extends FactorWordDefinition
 			"factor/FactorCallFrame",
 			"namespace",
 			"Lfactor/FactorNamespace;");
-		allocator.pushR(mw);
+		compiler.pushR(mw);
 
 		// set new namespace
 		mw.visitInsn(DUP);
-		allocator.pop(mw);
+		compiler.pop(mw);
 		FactorJava.generateFromConversion(mw,FactorNamespace.class);
 		mw.visitFieldInsn(PUTFIELD,
 			"factor/FactorCallFrame",
@@ -115,7 +101,7 @@ public class Bind extends FactorWordDefinition
 		int maxJVMStack = quot.compileCallTo(mw,recursiveCheck);
 
 		// restore namespace from callstack
-		allocator.popR(mw);
+		compiler.popR(mw);
 		mw.visitFieldInsn(PUTFIELD,
 			"factor/FactorCallFrame",
 			"namespace",

factor/primitives/Call.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class Call extends FactorWordDefinition
@@ -52,39 +52,25 @@ public class Call extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws Exception
+		FactorCompiler state) throws Exception
 	{
 		state.ensure(state.datastack,1);
-		LocalAllocator.FlowObject quot
+		FlowObject quot = (FlowObject)state.datastack.pop();
-			= (LocalAllocator.FlowObject)
+		quot.getStackEffect(recursiveCheck);
-			state.datastack.pop();
-		StackEffect effect = quot.getStackEffect(recursiveCheck);
-		if(effect != null)
-		{
-			// add 1 to inD since we consume the
-			// quotation
-			return new StackEffect(effect.inD + 1,
-				effect.outD,
-				effect.inR,
-				effect.outR);
-		}
-		else
-			return null;
 	} //}}}
 
-	//{{{ compileCallTo() method
+	//{{{ compileImmediate() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	public int compileCallTo(
+	public int compileImmediate(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		LocalAllocator.FlowObject quot = (LocalAllocator.FlowObject)
+		FlowObject quot = (FlowObject)compiler.datastack.pop();
-			allocator.datastack.pop();
 		return quot.compileCallTo(mw,recursiveCheck);
 	} //}}}
 }

factor/primitives/Choice.java

@@ -60,26 +60,25 @@ public class Choice extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(java.util.Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,3);
-		state.pushChoice();
+		state.pushChoice(recursiveCheck);
-		return new StackEffect(3,1,0,0);
 	} //}}}
 
 	//{{{ compileCallTo() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 */
-	/* public int compileCallTo(
+	public int compileCallTo(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		java.util.Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		allocator.pushChoice();
+		compiler.pushChoice(recursiveCheck);
 
 		return 0;
-	} */ //}}}
+	} //}}}
 }

factor/primitives/Define.java

@@ -31,7 +31,7 @@ package factor.primitives;
 
 import factor.compiler.*;
 import factor.*;
-import java.util.Set;
+import java.util.Map;
 
 public class Define extends FactorWordDefinition
 {
@@ -46,32 +46,38 @@ public class Define extends FactorWordDefinition
 		throws Exception
 	{
 		FactorDataStack datastack = interp.datastack;
-		FactorDictionary dict = interp.dict;
+		Object def = datastack.pop();
-		// handle old define syntax
+		Object name = datastack.pop();
-		Object obj = datastack.pop();
+		core(interp,name,def);
+	} //}}}
 
-		FactorWord newWord = interp.dict.intern(
+	//{{{ core() method
-			(String)datastack.pop(String.class));
+	public static void core(FactorInterpreter interp,
+		Object name, Object def) throws Exception
+	{
+		// name: either a string or a word
+		FactorWord newWord;
+		if(name instanceof FactorWord)
+			newWord = (FactorWord)name;
+		else
+			newWord = interp.intern((String)name);
 
-		if(obj instanceof Cons)
+		if(def instanceof Cons)
 		{
-			obj = new FactorCompoundDefinition(
+			def = new FactorCompoundDefinition(
-				newWord,(Cons)obj);
+				newWord,(Cons)def);
 		}
 
-		FactorWordDefinition def = (FactorWordDefinition)obj;
+		newWord.define((FactorWordDefinition)def);
-
+		interp.last = newWord;
-		newWord.define(def);
-		dict.last = newWord;
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,2);
 		state.pop(null);
 		state.pop(null);
-		return new StackEffect(2,0,0,0);
 	} //}}}
 }

factor/primitives/Execute.java

@@ -0,0 +1,52 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2003, 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.primitives;
+
+import factor.compiler.*;
+import factor.*;
+import java.lang.reflect.*;
+import java.util.Set;
+import org.objectweb.asm.*;
+
+public class Execute extends FactorWordDefinition
+{
+	//{{{ Execute constructor
+	public Execute(FactorWord word)
+	{
+		super(word);
+	} //}}}
+
+	//{{{ eval() method
+	public void eval(FactorInterpreter interp)
+		throws Exception
+	{
+		interp.eval(interp.datastack.pop());
+	} //}}}
+}

factor/primitives/Get.java

@@ -31,7 +31,7 @@ package factor.primitives;
 
 import factor.compiler.*;
 import factor.*;
-import java.util.Set;
+import java.util.Map;
 
 public class Get extends FactorWordDefinition
 {
@@ -58,12 +58,11 @@ public class Get extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,1);
 		state.pop(null);
 		state.push(null);
-		return new StackEffect(1,1,0,0);
 	} //}}}
 }

factor/primitives/JInvoke.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JInvoke extends FactorWordDefinition
@@ -57,8 +57,8 @@ public class JInvoke extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws Exception
+		FactorCompiler state) throws Exception
 	{
 		state.ensure(state.datastack,4);
 		Object clazz = state.popLiteral();
@@ -75,31 +75,31 @@ public class JInvoke extends FactorWordDefinition
 				(String)name,
 				(Cons)args);
 
-			boolean returnValue = method.getReturnType() == Void.TYPE;
+			boolean returnValue = (method.getReturnType() != Void.TYPE);
+
+			int params = method.getParameterTypes().length;
+			state.consume(state.datastack,params);
 			if(returnValue)
 				state.push(null);
-			return new StackEffect(
-				4 + method.getParameterTypes().length,
-				returnValue ? 0 : 1,0,0);
 		}
 		else
-			return null;
+			throw new FactorCompilerException("Cannot deduce stack effect of " + word + " with non-literal arguments");
 	} //}}}
 
-	//{{{ compileCallTo() method
+	//{{{ compileImmediate() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 * XXX: does not use factor type system conversions.
 	 */
-	public int compileCallTo(
+	public int compileImmediate(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _method = allocator.popLiteral();
+		Object _method = compiler.popLiteral();
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
-		Object _args = allocator.popLiteral();
+		Object _args = compiler.popLiteral();
 		if(_method instanceof String &&
 			_clazz instanceof String &&
 			(_args == null || _args instanceof Cons))
@@ -116,10 +116,10 @@ public class JInvoke extends FactorWordDefinition
 
 			FactorJava.generateToConversionPre(mw,returnType);
 
-			allocator.pop(mw);
+			compiler.pop(mw);
 			FactorJava.generateFromConversion(mw,cls);
 
-			allocator.generateArgs(mw,args.length,args);
+			compiler.generateArgs(mw,args.length,args);
 
 			int opcode;
 			if(cls.isInterface())
@@ -135,7 +135,7 @@ public class JInvoke extends FactorWordDefinition
 			if(returnType != Void.TYPE)
 			{
 				FactorJava.generateToConversion(mw,returnType);
-				allocator.push(mw);
+				compiler.push(mw);
 			}
 
 			return 4 + args.length;

factor/primitives/JInvokeStatic.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JInvokeStatic extends FactorWordDefinition
@@ -56,8 +56,8 @@ public class JInvokeStatic extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws Exception
+		FactorCompiler state) throws Exception
 	{
 		state.ensure(state.datastack,3);
 		Object clazz = state.popLiteral();
@@ -73,31 +73,31 @@ public class JInvokeStatic extends FactorWordDefinition
 				(String)name,
 				(Cons)args);
 
-			boolean returnValue = method.getReturnType() == Void.TYPE;
+			boolean returnValue = (method.getReturnType() != Void.TYPE);
+			int params = method.getParameterTypes().length;
+
+			state.consume(state.datastack,params);
 			if(returnValue)
 				state.push(null);
-			return new StackEffect(
-				3 + method.getParameterTypes().length,
-				returnValue ? 0 : 1,0,0);
 		}
 		else
-			return null;
+			throw new FactorCompilerException("Cannot deduce stack effect of " + word + " with non-literal arguments");;
 	} //}}}
 
-	//{{{ compileCallTo() method
+	//{{{ compileImmediate() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 * XXX: does not use factor type system conversions.
 	 */
-	public int compileCallTo(
+	public int compileImmediate(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _method = allocator.popLiteral();
+		Object _method = compiler.popLiteral();
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
-		Object _args = allocator.popLiteral();
+		Object _args = compiler.popLiteral();
 		if(_method instanceof String &&
 			_clazz instanceof String &&
 			(_args == null || _args instanceof Cons))
@@ -114,7 +114,7 @@ public class JInvokeStatic extends FactorWordDefinition
 
 			FactorJava.generateToConversionPre(mw,returnType);
 
-			allocator.generateArgs(mw,args.length,args);
+			compiler.generateArgs(mw,args.length,args);
 
 			mw.visitMethodInsn(INVOKESTATIC,
 				clazz,
@@ -125,7 +125,7 @@ public class JInvokeStatic extends FactorWordDefinition
 			if(returnType != Void.TYPE)
 			{
 				FactorJava.generateToConversion(mw,returnType);
-				allocator.push(mw);
+				compiler.push(mw);
 			}
 
 			return 4 + args.length;

factor/primitives/JNew.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JNew extends FactorWordDefinition
@@ -59,8 +59,8 @@ public class JNew extends FactorWordDefinition
 	/**
 	 * XXX: does not use factor type system conversions.
 	 */
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws Exception
+		FactorCompiler state) throws Exception
 	{
 		state.ensure(state.datastack,2);
 
@@ -74,28 +74,27 @@ public class JNew extends FactorWordDefinition
 				(String)clazz,
 				(Cons)args);
 
+			int params = constructor.getParameterTypes().length;
+			state.consume(state.datastack,params);
 			state.push(null);
-			return new StackEffect(
-				2 + constructor.getParameterTypes()
-				.length,1,0,0);
 		}
 		else
-			return null;
+			throw new FactorCompilerException("Cannot deduce stack effect of " + word + " with non-literal arguments");;
 	} //}}}
 
-	//{{{ compileCallTo() method
+	//{{{ compileImmediate() method
 	/**
 	 * Compile a call to this word. Returns maximum JVM stack use.
 	 * XXX: does not use factor type system conversions.
 	 */
-	public int compileCallTo(
+	public int compileImmediate(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
-		Object _args = allocator.popLiteral();
+		Object _args = compiler.popLiteral();
 		if(_clazz instanceof String &&
 			(_args == null || _args instanceof Cons))
 		{
@@ -107,7 +106,7 @@ public class JNew extends FactorWordDefinition
 			mw.visitTypeInsn(NEW,clazz);
 			mw.visitInsn(DUP);
 
-			allocator.generateArgs(mw,args.length,args);
+			compiler.generateArgs(mw,args.length,args);
 
 			mw.visitMethodInsn(INVOKESPECIAL,
 				clazz,
@@ -115,7 +114,7 @@ public class JNew extends FactorWordDefinition
 				FactorJava.javaSignatureToVMSignature(
 				args,void.class));
 
-			allocator.push(mw);
+			compiler.push(mw);
 
 			return 3 + args.length;
 		}

factor/primitives/JVarGet.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JVarGet extends FactorWordDefinition
@@ -57,15 +57,14 @@ public class JVarGet extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,3);
 		state.pop(null);
 		state.pop(null);
 		state.pop(null);
 		state.push(null);
-		return new StackEffect(3,1,0,0);
 	} //}}}
 
 	//{{{ compileCallTo() method
@@ -75,12 +74,12 @@ public class JVarGet extends FactorWordDefinition
 	 */
 	public int compileCallTo(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _field = allocator.popLiteral();
+		Object _field = compiler.popLiteral();
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
 		if(_clazz instanceof String &&
 			_field instanceof String)
 		{
@@ -92,7 +91,7 @@ public class JVarGet extends FactorWordDefinition
 
 			FactorJava.generateToConversionPre(mw,fld.getType());
 
-			allocator.pop(mw);
+			compiler.pop(mw);
 			FactorJava.generateFromConversion(mw,cls);
 
 			mw.visitFieldInsn(GETFIELD,clazz,field,
@@ -100,7 +99,7 @@ public class JVarGet extends FactorWordDefinition
 
 			FactorJava.generateToConversion(mw,fld.getType());
 
-			allocator.push(mw);
+			compiler.push(mw);
 
 			return 2;
 		}

factor/primitives/JVarGetStatic.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JVarGetStatic extends FactorWordDefinition
@@ -56,14 +56,13 @@ public class JVarGetStatic extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,2);
 		state.pop(null);
 		state.pop(null);
 		state.push(null);
-		return new StackEffect(2,1,0,0);
 	} //}}}
 
 	//{{{ compileCallTo() method
@@ -73,12 +72,12 @@ public class JVarGetStatic extends FactorWordDefinition
 	 */
 	public int compileCallTo(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _field = allocator.popLiteral();
+		Object _field = compiler.popLiteral();
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
 		if(_clazz instanceof String &&
 			_field instanceof String)
 		{
@@ -95,7 +94,7 @@ public class JVarGetStatic extends FactorWordDefinition
 
 			FactorJava.generateToConversion(mw,fld.getType());
 
-			allocator.push(mw);
+			compiler.push(mw);
 
 			return 2;
 		}

factor/primitives/JVarSet.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JVarSet extends FactorWordDefinition
@@ -58,15 +58,14 @@ public class JVarSet extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,4);
 		state.pop(null);
 		state.pop(null);
 		state.pop(null);
 		state.pop(null);
-		return new StackEffect(4,0,0,0);
 	} //}}}
 
 	//{{{ compileCallTo() method
@@ -76,12 +75,12 @@ public class JVarSet extends FactorWordDefinition
 	 */
 	public int compileCallTo(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _field = allocator.popLiteral();
+		Object _field = compiler.popLiteral();
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
 		if(_clazz instanceof String &&
 			_field instanceof String)
 		{
@@ -91,10 +90,10 @@ public class JVarSet extends FactorWordDefinition
 			clazz = clazz.replace('.','/');
 			Field fld = cls.getField(field);
 
-			allocator.pop(mw);
+			compiler.pop(mw);
 			FactorJava.generateFromConversion(mw,cls);
 
-			allocator.pop(mw);
+			compiler.pop(mw);
 			FactorJava.generateFromConversion(mw,fld.getType());
 
 			mw.visitFieldInsn(PUTFIELD,

factor/primitives/JVarSetStatic.java

@@ -32,7 +32,7 @@ package factor.primitives;
 import factor.compiler.*;
 import factor.*;
 import java.lang.reflect.*;
-import java.util.Set;
+import java.util.Map;
 import org.objectweb.asm.*;
 
 public class JVarSetStatic extends FactorWordDefinition
@@ -56,14 +56,13 @@ public class JVarSetStatic extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,3);
 		state.pop(null);
 		state.pop(null);
 		state.pop(null);
-		return new StackEffect(3,0,0,0);
 	} //}}}
 
 	//{{{ compileCallTo() method
@@ -73,12 +72,12 @@ public class JVarSetStatic extends FactorWordDefinition
 	 */
 	public int compileCallTo(
 		CodeVisitor mw,
-		LocalAllocator allocator,
+		FactorCompiler compiler,
-		Set recursiveCheck)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
-		Object _field = allocator.popLiteral();
+		Object _field = compiler.popLiteral();
-		Object _clazz = allocator.popLiteral();
+		Object _clazz = compiler.popLiteral();
 		if(_clazz instanceof String &&
 			_field instanceof String)
 		{
@@ -88,7 +87,7 @@ public class JVarSetStatic extends FactorWordDefinition
 			clazz = clazz.replace('.','/');
 			Field fld = cls.getField(field);
 
-			allocator.pop(mw);
+			compiler.pop(mw);
 			FactorJava.generateFromConversion(mw,fld.getType());
 
 			mw.visitFieldInsn(PUTSTATIC,

factor/primitives/Set.java

@@ -31,6 +31,7 @@ package factor.primitives;
 
 import factor.compiler.*;
 import factor.*;
+import java.util.Map;
 
 public class Set extends FactorWordDefinition
 {
@@ -59,12 +60,11 @@ public class Set extends FactorWordDefinition
 	} //}}}
 
 	//{{{ getStackEffect() method
-	public StackEffect getStackEffect(java.util.Set recursiveCheck,
+	public void getStackEffect(RecursiveState recursiveCheck,
-		LocalAllocator state) throws FactorStackException
+		FactorCompiler state) throws FactorStackException
 	{
 		state.ensure(state.datastack,2);
 		state.pop(null);
 		state.pop(null);
-		return new StackEffect(2,0,0,0);
 	} //}}}
 }

factor/stream.factor

@@ -25,6 +25,9 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+"user.home" system-property @~
+"file.separator" system-property @/
+
 : <stream> ( -- stream )
     ! Create a stream object. A stream is a namespace with the
     ! following entries:
@@ -42,6 +45,8 @@
         [ "freadln not implemented." break ] @freadln
         ( string -- )
         [ "fwrite not implemented."  break ] @fwrite
+        ( string -- )
+        [ "fedit not implemented."   break ] @fedit
         ( -- )
         [ ] @fflush
         ( -- )
@@ -165,6 +170,12 @@
 : fwrite ( string stream -- )
     [ $fwrite call ] bind ;
 
+: fedit ( string stream -- )
+    [ $fedit call ] bind ;
+
+: edit ( string -- )
+    $stdio fedit ;
+
 : fclose ( stream -- )
     [ $fclose call ] bind ;
 
@@ -175,14 +186,8 @@
     [ "java.io.InputStream" "java.io.OutputStream" ]
     "factor.FactorLib" "copy" jinvoke-static ;
 
-"java.lang.System" "in"  jvar-static$ <ireader> <breader> @stdin
+: <freader> ( file -- freader )
-"java.lang.System" "out" jvar-static$ <owriter> @stdout
+    [ |java.lang.String ] |java.io.FileReader jnew <breader> ;
-$stdin $stdout <charstream> @stdio
-
-!(file -- freader)
-|<freader> [
-    [ |java.lang.String ] |java.io.FileReader jnew <breader>
-] define
 
 : <file> (path -- file)
     dup "java.io.File" is not [
@@ -206,10 +211,8 @@ $stdin $stdout <charstream> @stdio
     [ "java.io.File" ] "java.io.File" "renameTo"
     jinvoke ;
 
-!(string -- reader)
+: <sreader> (string -- reader)
-|<sreader> [
+    [ |java.lang.String ] |java.io.StringReader jnew ;
-    [ |java.lang.String ] |java.io.StringReader jnew
-] define
 
 : close (stream --)
     dup "java.io.Reader" is [
@@ -222,18 +225,18 @@ $stdin $stdout <charstream> @stdio
     [ [ "java.lang.String" ] ] "factor.FactorLib" "exec"
     jinvoke-static ;
 
-!(stream -- string)
+: print-numbered-list* ( number list -- )
-|read* [
+    ! Print each element of the list with a number.
-    [ ] |java.io.BufferedReader |readLine jinvoke
+    dup [
-] define
+        uncons [ over pred ] dip print-numbered-list*
+        ": " swap cat3 print
+    ] [
+        2drop
+    ] ifte ;
 
-: print* (string stream --)
+: print-numbered-list ( list -- )
-    tuck write*
+    dup length pred swap print-numbered-list* ;
-    "\n" swap write* ;
 
-!(string stream --)
+"java.lang.System" "in"  jvar-static$ <ireader> <breader> @stdin
-|write* [
+"java.lang.System" "out" jvar-static$ <owriter> @stdout
-    tuck
+$stdin $stdout <charstream> @stdio
-    [ |java.lang.String ] |java.io.Writer |write jinvoke
-    [ ] |java.io.Writer |flush jinvoke
-] define

factor/strings.factor

@@ -35,10 +35,6 @@
 !    [ #\" , """ ]
 ] @entities
 
-: >str ( obj -- string )
-    ! Returns the Java string representation of this object.
-    [ ] "java.lang.Object" "toString" jinvoke ;
-
 : >bytes ( string -- array )
     ! Converts a string to an array of ASCII bytes. An exception
     ! is thrown if the string contains non-ASCII characters.
@@ -46,6 +42,19 @@
     [ "java.lang.String" ] "java.lang.String" "getBytes"
     jinvoke ;
 
+: >lower ( str -- str )
+    [ ] "java.lang.String" "toLowerCase" jinvoke ;
+
+: >str ( obj -- string )
+    ! Returns the Java string representation of this object.
+    [ ] "java.lang.Object" "toString" jinvoke ;
+
+: >title ( str -- str )
+    1 str/ [ >upper ] dip >lower cat2 ;
+
+: >upper ( str -- str )
+    [ ] "java.lang.String" "toUpperCase" jinvoke ;
+
 : <sbuf> ( -- StringBuffer )
     [ ] "java.lang.StringBuffer" jnew ;
 
@@ -67,12 +76,15 @@
 : cat4 ( "a" "b" "c" "d" -- "abcd" )
     [ ] cons cons cons cons cat ;
 
+: cat5 ( "a" "b" "c" "d" "e" -- "abcde" )
+    [ ] cons cons cons cons cons cat ;
+
 : char? ( obj -- boolean )
     "java.lang.Character" is ;
 
 : chars>entities ( str -- str )
     ! Convert <, >, &, ' and " to HTML entities.
-    [ dup $entities assoc dup [ nip ] [ drop ] ifte ] strmap ;
+    [ dup $entities assoc dup rot ? ] str-map ;
 
 : group ( index match -- )
     [ "int" ] "java.util.regex.Matcher" "group"
@@ -151,6 +163,10 @@
         jinvoke-static
     ] when ;
 
+: spaces ( len -- str )
+    ! Returns a string containing the given number of spaces.
+    <sbuf> swap [ " " swap sbuf-append ] times >str ;
+
 : split ( string split -- list )
     2dup index-of dup -1 = [
         2drop unit
@@ -158,16 +174,27 @@
         swap [ str// ] dip split cons
     ] ifte ;
 
+: string? ( obj -- ? )
+    "java.lang.String" is ;
+
+: str->=< ( str1 str2 -- n )
+    swap [ "java.lang.String" ] "java.lang.String" "compareTo"
+    jinvoke ;
+
+: str-lexi> ( str1 str2 -- ? )
+    ! Returns if the first string lexicographically follows str2
+    str->=< 0 > ;
+
 : str/ ( str index -- str str )
     ! Returns 2 strings, that when concatenated yield the
     ! original string.
-    2dup strtail [ str-head ] dip ;
+    2dup str-tail [ str-head ] dip ;
 
 : str// ( str index -- str str )
     ! Returns 2 strings, that when concatenated yield the
     ! original string, without the character at the given
     ! index.
-    2dup succ strtail [ str-head ] dip ;
+    2dup succ str-tail [ str-head ] dip ;
 
 : str-each ( str [ code ] -- )
     ! Execute the code, with each character of the string pushed
@@ -205,12 +232,15 @@
 
 : str-length> ( str str -- boolean )
     ! Compare string lengths.
-    [ str-length ] apply2 > ;
+    [ str-length ] 2apply > ;
 
 : str-map ( str [ code ] -- [ mapping ] )
     2list restack str-each unstack cat ;
 
-: strtail ( str index -- str )
+: str-contains ( substr str -- ? )
+    swap index-of -1 = not ;
+
+: str-tail ( str index -- str )
     ! Returns a new string, from the given index until the end
     ! of the string.
     over str-length rot substring ;

factor/test/combinators.factor

@@ -0,0 +1,6 @@
+! Tests the combinators.
+
+"Checking combinators." print
+
+[   ] [ 3 ] [ [ ] cond ] test-word
+[ t ] [ 4 ] [ [ [ 1 = ] [ ] [ 4 = ] [ drop t ] [ 2 = ] [ ] ] cond ] test-word

factor/test/compiler.factor

@@ -0,0 +1,55 @@
+! Compiler tests
+
+"Checking compiler." print
+
+[ 1 2 3 ] [ 4 5 6 ] [ t [ drop drop drop 1 2 3 ] when ] test-word
+[ 4 5 6 ] [ 4 5 6 ] [ f [ drop drop drop 1 2 3 ] when ] test-word
+
+[ t ] [ t ] [ [ t ] [ f ] rot [ drop call ] [ nip call ] ifte ] test-word
+[ f ] [ f ] [ [ t ] [ f ] rot [ drop call ] [ nip call ] ifte ] test-word
+[ 4 ] [ 2 ] [ t [ 2 ] [ 3 ] ifte + ] test-word
+[ 5 ] [ 2 ] [ f [ 2 ] [ 3 ] ifte + ] test-word
+
+: stack-frame-test ( x -- x )
+    >r t [ r> ] [ rdrop 11 ] ifte ;
+
+[ 10          ] [ 10         ] [ stack-frame-test ] test-word
+
+: balance>list ( quotation -- list )
+    balance effect>list ;
+
+[ [ 1 1 0 0 ] ] [ [ sq     ] ] [ balance>list ] test-word
+[ [ 2 1 0 0 ] ] [ [ mag2   ] ] [ balance>list ] test-word
+[ [ 2 1 0 0 ] ] [ [ append ] ] [ balance>list ] test-word
+[ [ 1 1 0 0 ] ] [ [ fac    ] ] [ balance>list ] test-word
+[ [ 1 1 0 0 ] ] [ [ fib    ] ] [ balance>list ] test-word
+
+[ [ 1 1 0 0 ] ] [ [ dup [ sq ] when ] ] [ balance>list ] test-word
+
+: test-null-rec ( -- )
+    [ [ 0 0 0 0 ] ] [ [ null-rec ] ] [ balance>list ] test-word ;
+
+: null-rec ( -- )
+    t [ null-rec ] when ; compile-maybe test-null-rec
+
+: null-rec ( -- )
+    t [ null-rec ] unless ; compile-maybe test-null-rec
+
+: null-rec ( -- )
+    t [ drop null-rec ] when* ; compile-maybe test-null-rec
+
+!: null-rec ( -- )
+!    t [ t null-rec ] unless* drop ; compile-maybe test-null-rec
+
+[ f 1 2 3 ] [ [ [ 2 , 1 ] ] 3 ] [ [ unswons unswons ] dip ] test-word
+
+[ [ 2 1 0 0 ] ] [ [ >r [ ] [ ] ? call r> ] ] [ balance>list ] test-word
+
+: nested-rec ( -- )
+    t [ nested-rec ] when ; compile-maybe
+
+: nested-rec-test ( -- )
+    5 nested-rec drop ; compile-maybe
+
+[ [ 0 0 0 0 ] ] [ [ nested-rec-test ] ] [ balance>list ] test-word
+"All compiler checks passed." print

factor/test/dictionary.factor

@@ -0,0 +1,37 @@
+! Tests the dictionary words.
+
+"Checking dictionary words." print
+
+! Just make sure this works.
+
+! OUTPUT          INPUT               WORD
+[             ] [ "httpd"         ] [ apropos           ] test-word
+[ t           ] [ "ifte"          ] [ worddef compound? ] test-word
+[ t           ] [ "dup"           ] [ worddef shuffle?  ] test-word
+[ f           ] [ "ifte"          ] [ worddef shuffle?  ] test-word
+[ f           ] [ "dup"           ] [ worddef compound? ] test-word
+
+! Test word iternalization.
+
+: gensym-test ( -- ? )
+    f 10 [ gensym gensym = and ] times ;
+
+[ f           ] [                 ] [ gensym-test       ] test-word
+
+: intern-test ( 1 2 -- ? )
+    [ intern ] 2apply = ;
+
+[ t           ] [ "a" "a"         ] [ intern-test       ] test-word
+[ f           ] [ "a" "A"         ] [ intern-test       ] test-word
+[ f           ] [ "a" "B"         ] [ intern-test       ] test-word
+[ f           ] [ "a" "a"      ] [ <word> swap intern = ] test-word
+
+: worddef>list-test ( -- ? )
+    [ dup * ] dup no-name worddef>list cdr cdr = ;
+
+[ t           ] [                 ] [ worddef>list-test ] test-word
+
+: words-test ( -- ? )
+    t words [ word? and ] each ;
+
+[ t           ] [                 ] [ words-test        ] test-word

factor/test/list.factor

@@ -0,0 +1,153 @@
+! Tests the list words.
+
+"Checking list words." print
+
+! OUTPUT          INPUT               WORD
+[ [ 1 2 ]     ] [ 1 2             ] [ 2list             ] test-word
+[ [ 1 2 3 ]   ] [ 1 2 3           ] [ 3list             ] test-word
+[ [ 2 1 ]     ] [ 1 2             ] [ 2rlist            ] test-word
+
+[ [ ]         ] [ [ ]   [ ]       ] [ append            ] test-word
+[ [ 1 ]       ] [ [ 1 ] [ ]       ] [ append            ] test-word
+[ [ 2 ]       ] [ [ ] [ 2 ]       ] [ append            ] test-word
+[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] ] [ append            ] test-word
+
+[ [ 1 2 3 4 ] ] [ [ 3 4 ] [ 1 2 ] ] [ @x "x" append@ $x ] test-word
+
+[ [ ]         ] [ [ ]             ] [ array>list        ] test-word
+[ [ 1 2 3 ]   ] [ [ 1 2 3 ]       ] [ array>list        ] test-word
+
+[ [ 1 2 3 4 ] ] [ 4 [ 1 2 3 ]     ] [ @x "x" add@ $x    ] test-word
+
+[
+    [ "monkey" , 1       ]
+    [ "banana" , 2       ]
+    [ "Java"   , 3       ]
+    [ t        , "true"  ]
+    [ f        , "false" ]
+    [ [ 1 2 ]  , [ 2 1 ] ]
+] @assoc
+
+[ f           ] [ "monkey" f      ] [ assoc             ] test-word
+[ f           ] [ "donkey" $assoc ] [ assoc             ] test-word
+[ 1           ] [ "monkey" $assoc ] [ assoc             ] test-word
+[ "false"     ] [ f        $assoc ] [ assoc             ] test-word
+[ [ 2 1 ]     ] [ [ 1 2 ]  $assoc ] [ assoc             ] test-word
+
+f @monkey
+t @donkey
+[ 1 2 ] @lisp
+
+[
+    [ "monkey" , 1       ]
+    [ "donkey" , 2       ]
+    [ "lisp"   , [ 2 1 ] ]
+] @assoc
+
+[ 1           ] [ f        $assoc ] [ assoc$            ] test-word
+[ [ 2 1 ]     ] [ [ 1 2 ]  $assoc ] [ assoc$            ] test-word
+
+[ 1           ] [ [ 1 , 2 ]       ] [ car               ] test-word
+[ 2           ] [ [ 1 , 2 ]       ] [ cdr               ] test-word
+
+[ [ ]         ] [ [ ]             ] [ clone-list        ] test-word
+[ [ 1 2 , 3 ] ] [ [ 1 2 , 3 ]     ] [ clone-list        ] test-word
+[ [ 1 2 3 4 ] ] [ [ 1 2 3 4 ]     ] [ clone-list        ] test-word
+
+: clone-list-actually-clones? ( list1 list2 -- )
+    [ clone-list ] dip ! we don't want to mutate literals
+    [ dup clone-list ] dip nappend = not ;
+
+[ t ] [ [ 1 2 ] [ 3 4 ] ] [ clone-list-actually-clones? ] test-word
+
+[ [ 1 , 2 ]   ] [ 1 2             ] [ cons              ] test-word
+[ [ 1 ]       ] [ 1 f             ] [ cons              ] test-word
+
+[ f           ] [ 3 [ ]           ] [ contains          ] test-word
+[ f           ] [ 3 [ 1 2 ]       ] [ contains          ] test-word
+[ [ 1 2 ]     ] [ 1 [ 1 2 ]       ] [ contains          ] test-word
+[ [ 2 ]       ] [ 2 [ 1 2 ]       ] [ contains          ] test-word
+
+[ [ 1 ]       ] [ 1 f             ] [ @x "x" cons@ $x   ] test-word
+[ [ 1 , 2 ]   ] [ 1 2             ] [ @x "x" cons@ $x   ] test-word
+[ [ 1 2 ]     ] [ 1 [ 2 ]         ] [ @x "x" cons@ $x   ] test-word
+
+[ [ ]         ] [ 0               ] [ count             ] test-word
+[ [ ]         ] [ -10             ] [ count             ] test-word
+[ [ ]         ] [ $-inf           ] [ count             ] test-word
+[ [ 0 1 2 ]   ] [ $e              ] [ count             ] test-word
+[ [ 0 1 2 3 ] ] [ 4               ] [ count             ] test-word
+
+[ 1           ] [ [ 1 2 ] -1      ] [ get               ] test-word
+[ 1           ] [ [ 1 2 ] 0       ] [ get               ] test-word
+[ 2           ] [ [ 1 2 ] 1       ] [ get               ] test-word
+
+[ [ 3 ]       ] [ [ 3 ]           ] [ last*             ] test-word
+[ [ 3 ]       ] [ [ 1 2 3 ]       ] [ last*             ] test-word
+[ [ 3 , 4 ]   ] [ [ 1 2 3 , 4 ]   ] [ last*             ] test-word
+
+[ 3           ] [ [ 3 ]           ] [ last              ] test-word
+[ 3           ] [ [ 1 2 3 ]       ] [ last              ] test-word
+[ 3           ] [ [ 1 2 3 , 4 ]   ] [ last              ] test-word
+
+[ 0           ] [ [ ]             ] [ length            ] test-word
+[ 3           ] [ [ 1 2 3 ]       ] [ length            ] test-word
+
+! CMU CL bombs on (length '(1 2 3 . 4))
+![ 3           ] [ [ 1 2 3 , 4 ]   ] [ length            ] test-word
+
+[ t           ] [ f               ] [ list?             ] test-word
+[ f           ] [ t               ] [ list?             ] test-word
+[ t           ] [ [ 1 2 ]         ] [ list?             ] test-word
+[ f           ] [ [ 1 , 2 ]       ] [ list?             ] test-word
+
+: clone-and-nappend ( list list -- list )
+    [ clone-list ] 2apply nappend ;
+
+[ [ ]         ] [ [ ]   [ ]       ] [ clone-and-nappend ] test-word
+[ [ 1 ]       ] [ [ 1 ] [ ]       ] [ clone-and-nappend ] test-word
+[ [ 2 ]       ] [ [ ] [ 2 ]       ] [ clone-and-nappend ] test-word
+[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] ] [ clone-and-nappend ] test-word
+
+[ 1 2 3 ] clone-list @x [ 4 5 6 ] clone-list @y
+
+[ [ 4 5 6 ]   ] [ $x $y           ] [ nappend drop $y   ] test-word
+
+[ 1 2 3 ] clone-list @x [ 4 5 6 ] clone-list @y
+
+[ [ 1 2 3 4 5 6 ] ] [ $x $y       ] [ nappend drop $x   ] test-word
+
+[ f           ] [ f               ] [ cons?             ] test-word
+[ f           ] [ t               ] [ cons?             ] test-word
+[ t           ] [ [ t , f ]       ] [ cons?             ] test-word
+
+[ [ ]         ] [ [ ]             ] [ reverse           ] test-word
+[ [ 1 ]       ] [ [ 1 ]           ] [ reverse           ] test-word
+[ [ 3 2 1 ]   ] [ [ 1 2 3 ]       ] [ reverse           ] test-word
+
+[ a , b ] clone-list @x
+[ [ 1 , b ]   ] [ 1 $x            ] [ rplaca $x         ] test-word
+                                                     
+[ a , b ] clone-list @x                                         
+[ [ a , 2 ]   ] [ 2 $x            ] [ rplacd $x         ] test-word
+                                                     
+[ [ 1 , 2 ]   ] [ 2 1             ] [ swons             ] test-word
+[ [ 1 ]       ] [ f 1             ] [ swons             ] test-word
+
+[ [ 1 ]       ] [ 1 f         ] [ @x "x" swap swons@ $x ] test-word
+[ [ 1 , 2 ]   ] [ 1 2         ] [ @x "x" swap swons@ $x ] test-word
+[ [ 1 2 ]     ] [ 1 [ 2 ]     ] [ @x "x" swap swons@ $x ] test-word
+
+[ 1 2         ] [ [ 1 , 2 ]   ] [ uncons                ] test-word
+[ 1 [ 2 ]     ] [ [ 1 2 ]     ] [ uncons                ] test-word
+
+[ [ 1 2 3 ]   ] [ 1 [ 2 3 ]   ] [ unique                ] test-word
+[ [ 1 2 3 ]   ] [ 1 [ 1 2 3 ] ] [ unique                ] test-word
+[ [ 1 2 3 ]   ] [ 2 [ 1 2 3 ] ] [ unique                ] test-word
+
+[ [ [ [ ] ] ] ] [ [ ]         ] [ unit unit             ] test-word
+
+[ 1 2         ] [ [ 2 , 1 ]   ] [ unswons               ] test-word
+[ [ 2 ] 1     ] [ [ 1 2 ]     ] [ unswons               ] test-word
+
+"List checks passed." print

factor/test/miscellaneous.factor

@@ -0,0 +1,22 @@
+! Miscellaneous tests.
+
+"Miscellaneous tests." print
+
+: test-last ( -- )
+    nop ;
+word >str @last-word-test
+
+[ "test-last" ] [ ] [ $last-word-test ] test-word
+[ f ] [ 5 ] [ compound? ] test-word
+[ f ] [ 5 ] [ compiled? ] test-word
+[ f ] [ 5 ] [ shuffle?  ] test-word
+
+! These stress-test a lot of code.
+"prettyprint*" see
+"prettyprint*" see/html
+$global describe
+$global describe/html
+
+[ t ] [ ] [ [ "global" "stdio" ] object-path $stdio = ] test-word
+
+"Miscellaneous passed." print

factor/test/random.factor

@@ -0,0 +1,13 @@
+! Random tests
+
+"Checking random number generation." print
+
+[
+    [ 10 , t ]
+    [ 20 , f ]
+    [ 30 , "monkey" ]
+] @random-pairs
+
+[ f ] [ $random-pairs ] [ random-element* [ t f "monkey" ] contains not ] test-word
+
+"Random number checks complete." print

factor/test/stack.factor

@@ -0,0 +1,36 @@
+! Test the built-in stack words.
+
+"Checking stack words." print
+
+! OUTPUT          INPUT           WORD
+[             ] [ 1           ] [ drop     ] test-word
+[             ] [ 1 2         ] [ 2drop    ] test-word
+[ 1 1         ] [ 1           ] [ dup      ] test-word
+[ 1 2 1 2     ] [ 1 2         ] [ 2dup     ] test-word
+[ 1 1 2       ] [ 1 2         ] [ dupd     ] test-word
+[ 1 2 1 2 3 4 ] [ 1 2 3 4     ] [ 2dupd    ] test-word
+[ 2           ] [ 1 2         ] [ nip      ] test-word
+[ 3 4         ] [ 1 2 3 4     ] [ 2nip     ] test-word
+[             ] [             ] [ nop      ] test-word
+[ 1 2 1       ] [ 1 2         ] [ over     ] test-word
+[ 1 2 3 4 1 2 ] [ 1 2 3 4     ] [ 2over    ] test-word
+[ 1 2 3 1     ] [ 1 2 3       ] [ pick     ] test-word
+[ 2 3 1       ] [ 1 2 3       ] [ rot      ] test-word
+[ 3 4 5 6 1 2 ] [ 1 2 3 4 5 6 ] [ 2rot     ] test-word
+[ 3 1 2       ] [ 1 2 3       ] [ -rot     ] test-word
+[ 5 6 1 2 3 4 ] [ 1 2 3 4 5 6 ] [ 2-rot    ] test-word
+[ 2 1         ] [ 1 2         ] [ swap     ] test-word
+[ 3 4 1 2     ] [ 1 2 3 4     ] [ 2swap    ] test-word
+[ 2 1 3       ] [ 1 2 3       ] [ swapd    ] test-word
+[ 3 4 1 2 5 6 ] [ 1 2 3 4 5 6 ] [ 2swapd   ] test-word
+[ 3 2 1       ] [ 1 2 3       ] [ transp   ] test-word
+[ 5 6 3 4 1 2 ] [ 1 2 3 4 5 6 ] [ 2transp  ] test-word
+[ 2 1 2       ] [ 1 2         ] [ tuck     ] test-word
+[ 3 4 1 2 3 4 ] [ 1 2 3 4     ] [ 2tuck    ] test-word
+
+[             ] [ 1           ] [ >r rdrop             ] test-word
+[ 2 1 2       ] [ 1 2         ] [ >r >r rover r> r> r> ] test-word
+[ 2 1         ] [ 1 2         ] [ 2>r r> r>            ] test-word
+[ 2 1         ] [ 1 2         ] [ >r >r 2r>            ] test-word
+
+"Stack checks passed." print

factor/test/test.factor

@@ -0,0 +1,40 @@
+! Factor test suite.
+
+! Some of these words should be moved to the standard library.
+
+: assert ( t -- )
+    [ "Assertion failed!" break ] unless ;
+
+: assert= ( x y -- )
+    = assert ;
+
+: compile-maybe ( -- )
+    $compile [ word compile ] when ;
+
+: compile-no-name ( list -- )
+    no-name compile-maybe ;
+
+~<< 3dup A B C -- A B C A B C >>~
+
+: test-word ( output word input )
+    3dup 3list .
+    append compile-no-name unit expand assert= ;
+
+: test ( name -- )
+    ! Run the given test.
+    "/factor/test/" swap ".factor" cat3 runResource ;
+
+: all-tests ( -- )
+    "Running Factor test suite..." print
+    [
+        "combinators"
+        "compiler"
+        "dictionary"
+        "list"
+        "miscellaneous"
+        "random"
+        "stack"
+    ] [
+        test
+    ] each
+    "All tests passed." print ;

version.factor

@@ -1 +1 @@
-"0.36" @version
+"0.53" @version