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

.cvskeywords

@@ -1,80 +1,110 @@
-./factor/compiler/CompiledList.java: * $Id: CompiledList.java,v 1.5 2004/03/07 22:51:00 slava Exp $
-./factor/compiler/StackEffect.java: * $Id: StackEffect.java,v 1.12 2004/03/05 21:09:10 slava Exp $
+./factor/compiler/CompiledList.java: * $Id: CompiledList.java,v 1.7 2004/04/12 20:57:12 slava Exp $
+./factor/compiler/StackEffect.java: * $Id: StackEffect.java,v 1.14 2004/04/12 20:57:12 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.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/CompiledDefinition.java:* $Id: CompiledDefinition.java,v 1.11 2004/04/19 02:13:52 slava Exp $
+./factor/compiler/Result.java: * $Id: Result.java,v 1.2 2004/04/11 20:37:03 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/compiler/Null.java: * $Id: Null.java,v 1.3 2004/04/12 20:57:12 slava Exp $
+./factor/compiler/RecursiveState.java: * $Id: RecursiveState.java,v 1.7 2004/04/17 21:11:38 slava Exp $
+./factor/compiler/CompiledListResult.java: * $Id: CompiledListResult.java,v 1.1 2004/04/12 20:57:12 slava Exp $
+./factor/compiler/FactorCompiler.java: * $Id: FactorCompiler.java,v 1.20 2004/05/07 21:07:53 slava Exp $
+./factor/compiler/RecursiveForm.java: * $Id: RecursiveForm.java,v 1.8 2004/04/17 21:11:38 slava Exp $
+./factor/compiler/CompiledChoice.java: * $Id: CompiledChoice.java,v 1.11 2004/04/15 19:59:16 slava Exp $
+./factor/compiler/AuxiliaryQuotation.java: * $Id: AuxiliaryQuotation.java,v 1.2 2004/04/12 20:57:12 slava Exp $
+./factor/compiler/FlowObject.java: * $Id: FlowObject.java,v 1.4 2004/04/11 20:37:03 slava Exp $
+./factor/prettyprint.factor:! $Id: prettyprint.factor,v 1.8 2004/04/29 22:41:08 slava Exp $
+./factor/FactorPrimitiveDefinition.java: * $Id: FactorMissingDefinition.java,v 1.8 2004/03/05 21:09:10 slava Exp $
+./factor/random.factor:! $Id: random.factor,v 1.7 2004/04/22 01:50:10 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.18 2004/03/28 21:25:13 slava Exp $
-./factor/combinators.factor:! $Id: combinators.factor,v 1.12 2004/03/24 02:50:28 slava Exp $
-./factor/inspector.factor:! $Id: inspector.factor,v 1.3 2004/03/28 21:25:13 slava Exp $
+./factor/FactorJava.java: * $Id: FactorJava.java,v 1.19 2004/04/12 20:57:12 slava Exp $
+./factor/combinators.factor:! $Id: combinators.factor,v 1.17 2004/04/22 01:50:09 slava Exp $
+./factor/inspector.factor:! $Id: inspector.factor,v 1.7 2004/04/22 01:50:09 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.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/continuations.factor:! $Id: continuations.factor,v 1.4 2004/04/12 20:57:12 slava Exp $
+./factor/network.factor:! $Id: network.factor,v 1.5 2004/04/19 02:13:52 slava Exp $
+./factor/FactorDocComment.java: * $Id: FactorDocComment.java,v 1.3 2004/04/15 23:00:29 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 $
-./factor/FactorRatio.java: * $Id: FactorRatio.java,v 1.1 2004/01/25 19:55:39 slava Exp $
-./factor/FactorCallStack.java: * $Id: FactorCallStack.java,v 1.2 2004/02/15 22:24:19 slava Exp $
+./factor/ReadTable.java: * $Id: ReadTable.java,v 1.1 2004/03/30 20:51:40 slava Exp $
+./factor/FactorRatio.java: * $Id: FactorRatio.java,v 1.2 2004/04/23 02:08:59 slava Exp $
+./factor/FactorReader.java: * $Id: FactorReader.java,v 1.9 2004/05/09 21:33:34 slava Exp $
+./factor/FactorCallStack.java: * $Id: FactorCallStack.java,v 1.3 2004/04/14 20:35:51 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.17 2004/03/24 02:50:28 slava Exp $
+./factor/lists.factor:! $Id: lists.factor,v 1.26 2004/05/09 07:13:20 slava Exp $
 ./factor/FactorCallFrame.java: * $Id: FactorCallFrame.java,v 1.3 2004/02/05 04:47:05 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.7 2004/02/24 18:55:09 slava Exp $
+./factor/FactorParsingDefinition.java: * $Id: FactorWordDefinition.java,v 1.24 2004/03/28 21:25:13 slava Exp $
+./factor/debugger.factor:! $Id: debugger.factor,v 1.7 2004/03/30 20:51:40 slava Exp $
+./factor/presentation.factor:! $Id: presentation.factor,v 1.2 2004/04/14 00:29:33 slava Exp $
+./factor/FactorNamespace.java: * $Id: FactorNamespace.java,v 1.8 2004/03/30 20:51:40 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.2 2004/02/26 05:35:20 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.21 2004/03/26 05:06:36 slava Exp $
+./factor/Cons.java: * $Id: Cons.java,v 1.9 2004/04/11 20:37:03 slava Exp $
+./factor/FactorCompoundDefinition.java:* $Id: FactorCompoundDefinition.java,v 1.30 2004/04/29 22:41:08 slava Exp $
+./factor/stack.factor:! $Id: prettyprint.factor,v 1.6 2004/04/14 00:29:33 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.6 2004/03/28 21:25:13 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.6 2004/03/28 21:25:13 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.6 2004/03/28 21:25:13 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.14 2004/03/28 21:25:13 slava Exp $
+./factor/parser/StringLiteral.java: * $Id: StringLiteral.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/Def.java: * $Id: Def.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/F.java: * $Id: F.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/Shu.java: * $Id: Shu.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/CharLiteral.java: * $Id: CharLiteral.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/LineComment.java: * $Id: LineComment.java,v 1.4 2004/04/12 20:57:12 slava Exp $
+./factor/parser/T.java: * $Id: T.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/StackComment.java: * $Id: StackComment.java,v 1.4 2004/04/12 20:57:12 slava Exp $
+./factor/parser/Comma.java: * $Id: Comma.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/Dispatch.java: * $Id: Dispatch.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/Fle.java: * $Id: Fle.java,v 1.4 2004/04/15 22:16:11 slava Exp $
+./factor/parser/Ket.java: * $Id: Ket.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/Ine.java: * $Id: Ine.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/parser/Unreadable.java: * $Id: Unreadable.java,v 1.1 2004/04/11 20:37:03 slava Exp $
+./factor/parser/Prefix.java: * $Id: Prefix.java,v 1.4 2004/04/29 22:41:08 slava Exp $
+./factor/parser/Bra.java: * $Id: Bra.java,v 1.2 2004/04/03 22:53:12 slava Exp $
+./factor/compiler.factor:! $Id: compiler.factor,v 1.6 2004/04/29 22:41:08 slava Exp $
+./factor/FactorMath.java: * $Id: FactorMath.java,v 1.6 2004/05/08 20:39:45 slava Exp $
+./factor/listener/EvalListener.java: * $Id: EvalListener.java,v 1.1 2004/04/14 00:29:33 slava Exp $
+./factor/listener/FactorListener.java: * $Id: FactorListener.java,v 1.2 2004/04/28 03:08:11 slava Exp $
+./factor/listener/listener.factor:! $Id: listener.factor,v 1.2 2004/04/28 03:08:11 slava Exp $
+./factor/listener/FactorDesktop.java: * $Id: FactorDesktop.java,v 1.2 2004/04/28 03:08:11 slava Exp $
+./factor/format.factor:! $Id: format.factor,v 1.2 2004/05/03 01:42:58 slava Exp $
+./factor/parser.factor:! $Id: parser.factor,v 1.10 2004/04/19 02:13:52 slava Exp $
+./factor/stream.factor:! $Id: stream.factor,v 1.12 2004/04/19 02:13:52 slava Exp $
+./factor/strings.factor:! $Id: strings.factor,v 1.26 2004/04/23 02:08:59 slava Exp $
+./factor/FactorInterpreter.java: * $Id: FactorInterpreter.java,v 1.25 2004/05/07 21:07:53 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.14 2004/03/26 05:06:36 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.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.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.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.4 2004/02/28 19:51:53 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.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.5 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/Choice.java: * $Id: Choice.java,v 1.6 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/Execute.java: * $Id: Execute.java,v 1.1 2004/02/24 03:23:00 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.4 2004/02/28 19:51:53 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.4 2004/02/28 19:51:53 slava Exp $
-./factor/primitives/JVarGet.java: * $Id: JVarGet.java,v 1.4 2004/02/28 19:51:53 slava Exp $
-./factor/httpd.factor:! $Id: httpd.factor,v 1.4 2004/03/24 02:50:28 slava Exp $
-./factor/interpreter.factor:! $Id: interpreter.factor,v 1.18 2004/03/28 21:25:13 slava Exp $
-./factor/miscellaneous.factor:! $Id: miscellaneous.factor,v 1.9 2004/03/28 21:25:13 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.7 2004/03/16 23:30:54 slava Exp $
+./factor/FactorWord.java: * $Id: FactorWord.java,v 1.22 2004/04/29 22:41:08 slava Exp $
+./factor/math.factor:! $Id: math.factor,v 1.18 2004/05/08 20:39:45 slava Exp $
+./factor/FactorWordDefinition.java: * $Id: FactorWordDefinition.java,v 1.34 2004/04/29 22:41:08 slava Exp $
+./factor/primitives/CallstackSet.java: * $Id: CallstackSet.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JInvokeStatic.java: * $Id: JInvokeStatic.java,v 1.6 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Unwind.java: * $Id: Unwind.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JVarGetStatic.java: * $Id: JVarGetStatic.java,v 1.5 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Unstack.java: * $Id: Unstack.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JInvoke.java: * $Id: JInvoke.java,v 1.6 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Define.java: * $Id: Define.java,v 1.7 2004/04/19 02:13:52 slava Exp $
+./factor/primitives/Clear.java: * $Id: Clear.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Bind.java: * $Id: Bind.java,v 1.6 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Choice.java: * $Id: Choice.java,v 1.7 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/InterpreterGet.java: * $Id: InterpreterGet.java,v 1.2 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Execute.java: * $Id: Execute.java,v 1.2 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JNew.java: * $Id: JNew.java,v 1.6 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Call.java: * $Id: Call.java,v 1.5 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/CallstackGet.java: * $Id: CallstackGet.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/DatastackGet.java: * $Id: DatastackGet.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JVarSet.java: * $Id: JVarSet.java,v 1.5 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/Restack.java: * $Id: Restack.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/DatastackSet.java: * $Id: DatastackSet.java,v 1.3 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JVarSetStatic.java: * $Id: JVarSetStatic.java,v 1.5 2004/04/15 19:59:16 slava Exp $
+./factor/primitives/JVarGet.java: * $Id: JVarGet.java,v 1.5 2004/04/15 19:59:16 slava Exp $
+./factor/httpd.factor:! $Id: httpd.factor,v 1.7 2004/04/19 02:13:51 slava Exp $
+./factor/interpreter.factor:! $Id: interpreter.factor,v 1.24 2004/05/09 06:06:02 slava Exp $
+./factor/trace.factor:! $Id: trace.factor,v 1.3 2004/04/12 20:57:12 slava Exp $
+./factor/miscellaneous.factor:! $Id: miscellaneous.factor,v 1.12 2004/04/19 02:13:52 slava Exp $
+./factor/FactorScanner.java: * $Id: FactorScanner.java,v 1.5 2004/05/09 21:33:34 slava Exp $
+./factor/FactorArrayStack.java: * $Id: FactorArrayStack.java,v 1.5 2004/04/12 20:57:12 slava Exp $
+./factor/boot.factor:! $Id: boot.factor,v 1.30 2004/05/02 21:03:45 slava Exp $
+./factor/FactorParseException.java: * $Id: FactorParseException.java,v 1.2 2004/04/03 19:19:51 slava Exp $
+./factor/namespaces.factor:! $Id: namespaces.factor,v 1.14 2004/04/29 22:41:08 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.15 2004/03/05 21:09:10 slava Exp $
-./factor/dictionary.factor:! $Id: dictionary.factor,v 1.16 2004/03/28 18:59:28 slava Exp $
+./factor/FactorShuffleDefinition.java: * $Id: FactorShuffleDefinition.java,v 1.18 2004/04/29 22:41:08 slava Exp $
+./factor/dictionary.factor:! $Id: dictionary.factor,v 1.27 2004/04/29 22:41:08 slava Exp $

META-INF/MANIFEST.MF

@@ -1,5 +1,5 @@
 Manifest-Version: 1.0
-Created-By: 1.4.2-p6-slava_18_jan_2004_13_00 (Sun Microsystems Inc.)
 Ant-Version: Apache Ant 1.5.4 
+Created-By: 1.4.2-p6-slava_18_jan_2004_13_00 (Sun Microsystems Inc.)
 Main-Class: factor.FactorInterpreter
 

compile-file.factor

@@ -0,0 +1,24 @@
+: words-not-primitives ( -- list )
+    words [ worddef primitive? not ] subset ;
+
+: dump-image ( -- )
+    compile-all
+    words-not-primitives [
+        dup worddef dup compiled? [
+            swap >str .
+            class-of .
+            "define" print
+        ] [
+            drop see
+        ] ifte
+    ] each ;
+
+: dump-image-file ( file -- )
+    <namespace> [
+        <filecw> @stdio
+        dump-image
+        $stdio fclose
+    ] bind ;
+
+: dump-boot-image ( -- )
+    "factor/boot.fasl" dump-image-file ;

factor/Cons.java

@@ -169,7 +169,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
 			if(iter.car == this)
 				buf.append("<circular reference>");
 			else
-				buf.append(FactorParser.unparse(iter.car));
+				buf.append(FactorReader.unparseObject(iter.car));
 			if(iter.cdr instanceof Cons)
 			{
 				buf.append(' ');
@@ -181,7 +181,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
 			else
 			{
 				buf.append(" , ");
-				buf.append(FactorParser.unparse(iter.cdr));
+				buf.append(FactorReader.unparseObject(iter.cdr));
 				iter = null;
 			}
 		}
@@ -266,7 +266,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
 	} //}}}
 
 	//{{{ deepClone() method
-	public Object deepClone()
+	public Cons deepClone()
 	{
 		Object ccar;
 		if(car instanceof PublicCloneable)

factor/FactorArrayStack.java

@@ -41,11 +41,14 @@ public abstract class FactorArrayStack implements FactorExternalizable
 	//{{{ FactorArrayStack constructor
 	public FactorArrayStack()
 	{
+		stack = new Object[10];
 	} //}}}
 
 	//{{{ FactorArrayStack constructor
 	public FactorArrayStack(Cons list)
 	{
+		this();
+
 		if(list != null)
 		{
 			ensurePush(list.length());
@@ -114,9 +117,6 @@ public abstract class FactorArrayStack implements FactorExternalizable
 	//{{{ ensurePush() method
 	public void ensurePush(int amount)
 	{
-		if(stack == null)
-			stack = new Object[64];
-
 		if(top + amount > stack.length)
 		{
 			Object[] newStack = new Object[stack.length * 2 + 1];

factor/FactorCallStack.java

@@ -64,8 +64,15 @@ public class FactorCallStack extends FactorArrayStack implements PublicCloneable
 			return new FactorCallStack();
 		else
 		{
-			return new FactorCallStack(
-				FactorLib.deepCloneArray(stack),top);
+			Object[] newStack = new Object[stack.length];
+			for(int i = 0; i < top; i++)
+			{
+				Object obj = stack[i];
+				if(obj instanceof FactorCallFrame)
+					obj = ((FactorCallFrame)obj).clone();
+				newStack[i] = obj;
+			}
+			return new FactorCallStack(newStack,top);
 		}
 	} //}}}
 }

factor/FactorCompoundDefinition.java

@@ -42,20 +42,30 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 {
 	private static int compileCount;
 
-	public Cons definition;
+	public final Cons definition;
+	private Cons endOfDocs;
 
 	//{{{ FactorCompiledDefinition constructor
 	public FactorCompoundDefinition(FactorWord word, Cons definition)
 	{
 		super(word);
 		this.definition = definition;
+		if(definition == null)
+			endOfDocs = null;
+		else
+		{
+			endOfDocs = definition;
+			while(endOfDocs != null
+				&& endOfDocs.car instanceof FactorDocComment)
+				endOfDocs = endOfDocs.next();
+		}
 	} //}}}
 
 	//{{{ eval() method
 	public void eval(FactorInterpreter interp)
 		throws Exception
 	{
-		interp.call(word,definition);
+		interp.call(word,endOfDocs);
 	} //}}}
 
 	//{{{ getStackEffect() method
@@ -65,31 +75,22 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		RecursiveForm rec = recursiveCheck.get(word);
 		if(rec.active)
 		{
-			StackEffect se = rec.baseCase;
-			if(se == null)
+			if(rec.baseCase == null)
 				throw new FactorCompilerException("Indeterminate recursive call");
 
-			compiler.apply(StackEffect.decompose(rec.effect,se));
+			compiler.apply(StackEffect.decompose(rec.effect,rec.baseCase));
 		}
 		else
 		{
-			compiler.getStackEffect(definition,recursiveCheck);
+			compiler.getStackEffect(endOfDocs,recursiveCheck);
 		}
 	} //}}}
 
-	//{{{ getSanitizedName() method
-	private String getSanitizedName(String name)
+	//{{{ getClassName() method
+	private static String getClassName(String name)
 	{
-		StringBuffer sanitizedName = new StringBuffer();
-		for(int i = 0; i < name.length(); i++)
-		{
-			char ch = name.charAt(i);
-			if(!Character.isJavaIdentifierStart(ch))
-				sanitizedName.append("_");
-			else
-				sanitizedName.append(ch);
-		}
-		return "factor/compiler/gen/" + sanitizedName
+		return "factor/compiler/gen/"
+			+ FactorJava.getSanitizedName(name)
 			+ "_" + (compileCount++);
 	} //}}}
 
@@ -105,9 +106,7 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		if(effect.inR != 0 || effect.outR != 0)
 			throw new FactorCompilerException("Compiled code cannot manipulate call stack frames");
 
-		boolean multipleReturns = (effect.outD > 1);
-
-		String className = getSanitizedName(word.name);
+		String className = getClassName(word.name);
 
 		ClassWriter cw = new ClassWriter(false);
 		cw.visit(ACC_PUBLIC, className,
@@ -117,13 +116,19 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		compileConstructor(cw,className);
 
 		CompileResult result = compileEval(interp,cw,
-			className,effect,recursiveCheck,
-			multipleReturns);
+			className,effect,recursiveCheck);
+
+		// Generate auxiliary methods
+		String auxAsm = result.compiler.generateAuxiliary(cw);
 
 		// Generate fields for storing literals and
 		// word references
 		result.compiler.generateFields(cw);
 
+		compileToList(interp,result.compiler,cw);
+
+		compileGetStackEffect(cw,effect);
+
 		// gets the bytecode of the class, and loads it
 		// dynamically
 		byte[] code = cw.toByteArray();
@@ -136,27 +141,14 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 			fos.close();
 		}
 
+		// store disassembly for the 'asm' word.
+		word.asm = result.asm + auxAsm;
+
 		Class compiledWordClass = loader._defineClass(
 			className.replace('/','.'),
 			code, 0, code.length);
 
-		result.compiler.setFields(compiledWordClass);
-
-		Constructor constructor = compiledWordClass
-			.getConstructor(
-			new Class[] {
-			FactorWord.class, StackEffect.class, Cons.class
-			});
-
-		FactorWordDefinition compiledWord
-			= (FactorWordDefinition)
-			constructor.newInstance(
-			new Object[] { word, effect, definition });
-
-		// store disassembly for the 'asm' word.
-		word.asm = result.asm;
-
-		return compiledWord;
+		return CompiledDefinition.create(interp,word,compiledWordClass);
 	} //}}}
 
 	//{{{ compileConstructor() method
@@ -165,26 +157,59 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		// creates a MethodWriter for the constructor
 		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
 			"<init>",
-			"(Lfactor/FactorWord;"
-			+ "Lfactor/compiler/StackEffect;"
-			+ "Lfactor/Cons;)V",
+			"(Lfactor/FactorWord;)V",
 			null, null);
 		// pushes the 'this' variable
 		mw.visitVarInsn(ALOAD, 0);
 		// pushes the word parameter
 		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;"
-			+ "Lfactor/Cons;)V");
+			"(Lfactor/FactorWord;)V");
 		mw.visitInsn(RETURN);
-		mw.visitMaxs(4, 4);
+		mw.visitMaxs(2, 2);
+	} //}}}
+
+	//{{{ compileToList() method
+	private void compileToList(FactorInterpreter interp,
+		FactorCompiler compiler, ClassVisitor cw)
+	{
+		// creates a MethodWriter for the toList() method
+		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
+			"toList",
+			"(Lfactor/FactorInterpreter;)Lfactor/Cons;",
+			null, null);
+		// push unparsed string representation of this word and parse it
+		compiler.generateParse(mw,toList(interp),1);
+		mw.visitTypeInsn(CHECKCAST,"factor/Cons");
+		mw.visitInsn(ARETURN);
+		mw.visitMaxs(2, 2);
+	} //}}}
+
+	//{{{ compileGetStackEffect() method
+	private void compileGetStackEffect(ClassVisitor cw, StackEffect effect)
+	{
+		// creates a MethodWriter for the getStackEffect() method
+		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
+			"getStackEffect",
+			"(Lfactor/compiler/RecursiveState;"
+			+ "Lfactor/compiler/FactorCompiler;)V",
+			null, null);
+
+		mw.visitVarInsn(ALOAD,2);
+		mw.visitTypeInsn(NEW,"factor/compiler/StackEffect");
+		mw.visitInsn(DUP);
+		mw.visitLdcInsn(new Integer(effect.inD));
+		mw.visitLdcInsn(new Integer(effect.outD));
+		mw.visitLdcInsn(new Integer(effect.inR));
+		mw.visitLdcInsn(new Integer(effect.outR));
+		mw.visitMethodInsn(INVOKESPECIAL,"factor/compiler/StackEffect",
+			"<init>","(IIII)V");
+		mw.visitMethodInsn(INVOKEVIRTUAL,"factor/compiler/FactorCompiler",
+			"apply","(Lfactor/compiler/StackEffect;)V");
+		mw.visitInsn(RETURN);
+		mw.visitMaxs(7, 3);
 	} //}}}
 
 	//{{{ compileEval() method
@@ -207,7 +232,7 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 	 */
 	protected CompileResult compileEval(FactorInterpreter interp,
 		ClassWriter cw, String className, StackEffect effect,
-		RecursiveState recursiveCheck, boolean multipleReturns)
+		RecursiveState recursiveCheck)
 		throws Exception
 	{
 		// creates a MethodWriter for the 'eval' method
@@ -230,9 +255,10 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 
 		// generate core
 		FactorCompiler compiler = new FactorCompiler(interp,word,
-			className,1,effect.inD);
-		String asm = compiler.compile(definition,cw,className,
-			"core",effect,recursiveCheck);
+			className);
+		compiler.init(1,effect.inD,effect.inR,"core");
+		String asm = compiler.compileCore(endOfDocs,cw,effect,
+			recursiveCheck);
 
 		return new CompileResult(compiler,asm);
 	} //}}}
@@ -307,41 +333,10 @@ public class FactorCompoundDefinition extends FactorWordDefinition
 		}
 	} //}}}
 
-	//{{{ compileImmediate() method
-	/**
-	 * Compile a call to this word. Returns maximum JVM stack use.
-	 */
-	public int compileImmediate(CodeVisitor mw, FactorCompiler compiler,
-		RecursiveState recursiveCheck) throws Exception
-	{
-		/* 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);
-	} //}}}
-
 	//{{{ toList() method
-	public Cons toList()
+	public Cons toList(FactorInterpreter interp)
 	{
-		return new Cons(word,new Cons(new FactorWord("\n"),
-			definition));
+		return definition;
 	} //}}}
 
 	private static SimpleClassLoader loader = new SimpleClassLoader();

factor/FactorDocComment.java

@@ -0,0 +1,59 @@
+/* :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;
+
+import java.io.IOException;
+
+public class FactorDocComment implements FactorExternalizable
+{
+	private String msg;
+	private boolean stack;
+
+	public FactorDocComment(String msg, boolean stack)
+	{
+		if(stack)
+			msg = msg.trim();
+		this.msg = msg;
+		this.stack = stack;
+	}
+
+	public String toString()
+	{
+		if(stack)
+			return "( " + msg + " )\n";
+		else
+			return "#!" + msg + "\n";
+	}
+
+	public boolean isStackComment()
+	{
+		return stack;
+	}
+}

factor/FactorInterpreter.java

@@ -29,10 +29,11 @@
 
 package factor;
 
+import factor.parser.*;
 import factor.primitives.*;
 import java.io.*;
 
-public class FactorInterpreter
+public class FactorInterpreter implements FactorObject
 {
 	// command line arguments are stored here.
 	public Cons args;
@@ -41,8 +42,10 @@ public class FactorInterpreter
 	public boolean interactive = true;
 	public boolean trace = false;
 	public boolean errorFlag = false;
-	public boolean compile = true;
+	public Throwable error;
 	public boolean dump = false;
+	public boolean verboseCompile = true;
+	public boolean fasl = true;
 
 	public FactorCallFrame callframe;
 	public FactorCallStack callstack = new FactorCallStack();
@@ -50,18 +53,23 @@ public class FactorInterpreter
 	public FactorNamespace dict;
 	public FactorWord last;
 	public FactorNamespace global;
+	private FactorNamespace interpNamespace;
+	private Cons compiledExceptions;
 
 	//{{{ main() method
 	public static void main(String[] args) throws Exception
 	{
 		FactorInterpreter interp = new FactorInterpreter();
 		interp.init(args,null);
-		System.exit(0);
 	} //}}}
 
 	//{{{ init() method
 	public void init(String[] args, Object root) throws Exception
 	{
+		// this must be set before boot.factor is finished loading.
+		if(args.length > 0 && args[0].equals("-no-fasl"))
+			fasl = false;
+
 		this.args = Cons.fromArray(args);
 
 		callstack.top = 0;
@@ -75,25 +83,69 @@ public class FactorInterpreter
 	//{{{ initDictionary() method
 	private void initDictionary() throws Exception
 	{
-		dict = new FactorNamespace(null,null);
+		dict = FactorNamespace.createConstrainedNamespace(
+			FactorWord.class);
+
+		// parsing words
+		FactorWord lineComment = intern("!");
+		lineComment.parsing = new LineComment(lineComment,false);
+		FactorWord stackComment = intern("(");
+		stackComment.parsing = new StackComment(stackComment);
+		FactorWord str = intern("\"");
+		str.parsing = new StringLiteral(str);
+		FactorWord t = intern("t");
+		t.parsing = new T(t);
+		FactorWord f = intern("f");
+		f.parsing = new F(f);
+		FactorWord bra = intern("[");
+		bra.parsing = new Bra(bra);
+		FactorWord ket = intern("]");
+		ket.parsing = new Ket(bra,ket);
+		FactorWord comma = intern(",");
+		comma.parsing = new Comma(comma);
+		FactorWord def = intern(":");
+		def.parsing = new Def(def);
+		def.getNamespace(this).setVariable("doc-comments",Boolean.TRUE);
+		FactorWord ine = intern(";");
+		ine.parsing = new Ine(def,ine);
+		FactorWord shu = intern("~<<");
+		shu.getNamespace(this).setVariable("doc-comments",Boolean.TRUE);
+		shu.parsing = new Shu(shu);
+		FactorWord fle = intern(">>~");
+		fle.parsing = new Fle(shu,fle);
+		FactorWord get = intern("$");
+		get.parsing = new Prefix(get,get);
+		FactorWord set = intern("@");
+		set.parsing = new Prefix(set,set);
+
+		// #X
+		FactorWord dispatch = intern("#");
+		dispatch.parsing = new Dispatch(dispatch);
+		FactorWord chr = intern("#\\");
+		chr.parsing = new CharLiteral(chr);
+		FactorWord intern = intern("#=");
+		intern.parsing = new Prefix(intern,intern("intern"));
+		FactorWord docComment = intern("#!");
+		docComment.parsing = new LineComment(docComment,true);
+		FactorWord unreadable = intern("#<");
+		unreadable.parsing = new Unreadable(unreadable);
+
+		FactorWord interpreterGet = intern("interpreter");
+		interpreterGet.def = new InterpreterGet(interpreterGet);
 
 		// data stack primitives
 		FactorWord datastackGet = intern("datastack$");
-		datastackGet.def = new DatastackGet(
-			datastackGet);
+		datastackGet.def = new DatastackGet(datastackGet);
 		FactorWord datastackSet = intern("datastack@");
-		datastackSet.def = new DatastackSet(
-			datastackSet);
+		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);
+		callstackGet.def = new CallstackGet(callstackGet);
 		FactorWord callstackSet = intern("callstack@");
-		callstackSet.def = new CallstackSet(
-			callstackSet);
+		callstackSet.def = new CallstackSet(callstackSet);
 		FactorWord restack = intern("restack");
 		restack.def = new Restack(restack);
 		FactorWord unstack = intern("unstack");
@@ -105,26 +157,17 @@ public class FactorInterpreter
 		FactorWord jinvoke = intern("jinvoke");
 		jinvoke.def = new JInvoke(jinvoke);
 		FactorWord jinvokeStatic = intern("jinvoke-static");
-		jinvokeStatic.def = new JInvokeStatic(
-			jinvokeStatic);
+		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);
+		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);
+		jvarSetStatic.def = new JVarSetStatic(jvarSetStatic);
 
 		// definition
 		FactorWord define = intern("define");
@@ -153,9 +196,14 @@ public class FactorInterpreter
 				getClass().getField("errorFlag"),
 				this));
 
-		String[] boundFields = { "compile", "dump",
+		global.setVariable("verbose-compile",
+			new FactorNamespace.VarBinding(
+				getClass().getField("verboseCompile"),
+				this));
+
+		String[] boundFields = { "dump",
 			"interactive", "trace",
-			"dict", "args", "global", "last" };
+			"dict", "args", "global", "last", "fasl" };
 		for(int i = 0; i < boundFields.length; i++)
 		{
 			global.setVariable(boundFields[i],
@@ -165,11 +213,22 @@ public class FactorInterpreter
 		}
 	} //}}}
 
+	//{{{ getNamespace() method
+	public FactorNamespace getNamespace(FactorInterpreter interp)
+		throws Exception
+	{
+		if(interpNamespace == null)
+			interpNamespace = new FactorNamespace(
+				interp.global,this);
+
+		return interpNamespace;
+	} //}}}
+
 	//{{{ runBootstrap() method
 	private void runBootstrap() throws Exception
 	{
 		final String initFile = "boot.factor";
-		FactorParser parser = new FactorParser(
+		FactorReader parser = new FactorReader(
 			initFile,
 			new InputStreamReader(
 			getClass().getResourceAsStream(
@@ -239,11 +298,12 @@ public class FactorInterpreter
 			System.err.println("Exception inside"
 				+ " error handler:");
 			e.printStackTrace();
-			System.err.println(
-				"Original exception:");
-			e.printStackTrace();
+			System.err.println("Original exception:");
+			error.printStackTrace();
+			System.err.println("Factor datastack:");
+			System.err.println(datastack.toList());
 			System.err.println("Factor callstack:");
-			System.err.println(callstack);
+			System.err.println(callstack.toList());
 
 			topLevel();
 
@@ -252,7 +312,8 @@ public class FactorInterpreter
 		else
 		{
 			errorFlag = true;
-			datastack.push(FactorJava.unwrapException(e));
+			error = FactorJava.unwrapException(e);
+			datastack.push(error);
 			try
 			{
 				eval(intern("break"));
@@ -272,6 +333,21 @@ public class FactorInterpreter
 		}
 	} //}}}
 
+	//{{{ compiledException() method
+	/**
+	 * Called by compiled words to give the user a meaningful call stack
+	 * trace in the case of an exception.
+	 */
+	public void compiledException(FactorWord word, Throwable t)
+	{
+		// XXX: change callframe.namespace to something more meaningful
+		FactorCallFrame compiledCallframe = new FactorCallFrame(
+			word,callframe.namespace,
+			new Cons(new FactorWord("#<compiled>"),null));
+		compiledExceptions = new Cons(compiledCallframe,
+			this.compiledExceptions);
+	} //}}}
+
 	//{{{ call() method
 	/**
 	 * Pushes the given list of code onto the callstack.
@@ -306,13 +382,12 @@ public class FactorInterpreter
 		{
 			if(trace)
 				System.err.println("-- TAIL CALL --");
-			newcf = getRecycledCallFrame(callstack.top);
+			newcf = new FactorCallFrame();
 			newcf.collapsed = true;
 		}
-		// try to get a recycled callframe from the stack
 		else
 		{
-			newcf = getRecycledCallFrame(callstack.top + 1);
+			newcf = new FactorCallFrame();
 			newcf.collapsed = false;
 			if(callframe != null)
 				callstack.push(callframe);
@@ -325,21 +400,6 @@ public class FactorInterpreter
 		callframe = newcf;
 	} //}}}
 
-	//{{{ getRecycledCallFrame() method
-	private FactorCallFrame getRecycledCallFrame(int next)
-	{
-		/* if(callstack.stack != null && next < callstack.stack.length)
-		{
-			Object o = callstack.stack[next];
-			if(o instanceof FactorCallFrame)
-				return (FactorCallFrame)o;
-			else
-				return new FactorCallFrame();
-		}
-		else */
-			return new FactorCallFrame();
-	} //}}}
-
 	//{{{ eval() method
 	/**
 	 * Evaluates a word.
@@ -351,7 +411,7 @@ public class FactorInterpreter
 			StringBuffer buf = new StringBuffer();
 			for(int i = 0; i < callstack.top; i++)
 				buf.append(' ');
-			buf.append(FactorParser.unparse(obj));
+			buf.append(FactorReader.unparseObject(obj));
 			System.err.println(buf);
 		}
 
@@ -359,7 +419,14 @@ public class FactorInterpreter
 		{
 			try
 			{
-				((FactorWord)obj).def.eval(this);
+				FactorWordDefinition d = ((FactorWord)obj).def;
+				if(d == null)
+				{
+					throw new FactorUndefinedWordException(
+						(FactorWord)obj);
+				}
+				else
+					d.eval(this);
 			}
 			catch(Exception e)
 			{
@@ -368,6 +435,12 @@ public class FactorInterpreter
 					(FactorWord)obj,
 					callframe.namespace,
 					null);
+				while(compiledExceptions != null)
+				{
+					callstack.push(compiledExceptions.car);
+					compiledExceptions = compiledExceptions
+						.next();
+				}
 				throw e;
 			}
 		}
@@ -390,6 +463,7 @@ public class FactorInterpreter
 		}
 		catch(Exception e)
 		{
+			System.err.println("Cannot internalize: " + name);
 			throw new RuntimeException(e);
 		}
 	} //}}}

factor/FactorJava.java

@@ -45,6 +45,21 @@ public class FactorJava implements Constants
 {
 	public static final Class[] EMPTY_ARRAY = new Class[0];
 
+	//{{{ getSanitizedName() method
+	public static String getSanitizedName(String name)
+	{
+		StringBuffer sanitizedName = new StringBuffer();
+		for(int i = 0; i < name.length(); i++)
+		{
+			char ch = name.charAt(i);
+			if(!Character.isJavaIdentifierStart(ch))
+				sanitizedName.append("_");
+			else
+				sanitizedName.append(ch);
+		}
+		return sanitizedName.toString();
+	} //}}}
+
 	//{{{ classNameToClassList() method
 	public static Class[] classNameToClassList(Cons classes)
 		throws Exception

factor/FactorMath.java

@@ -88,6 +88,40 @@ public class FactorMath
 			+ ((Number)y).doubleValue());
 	} //}}}
 
+	//{{{ and() method
+	public static Number and(Number x, Number y)
+	{
+		if(x instanceof BigInteger)
+		{
+			if(y instanceof BigInteger)
+				return ((BigInteger)x).and((BigInteger)y);
+			else
+			{
+				return ((BigInteger)x).and(BigInteger.valueOf(
+					y.longValue()));
+			}
+		}
+		else
+		{
+			if(y instanceof BigInteger)
+			{
+				return ((BigInteger)y).and(BigInteger.valueOf(
+					x.longValue()));
+			}
+			else
+			{
+				long and = x.longValue() & y.longValue();
+				if(and > Integer.MAX_VALUE
+					|| and < Integer.MIN_VALUE)
+				{
+					return BigInteger.valueOf(and);
+				}
+				else
+					return new Integer((int)and);
+			}
+		}
+	} //}}}
+
 	//{{{ _divide() method
 	/**
 	 * Truncating division.
@@ -260,6 +294,19 @@ public class FactorMath
 			* ((Number)y).doubleValue());
 	} //}}}
 
+	//{{{ neg() method
+	public static Number neg(Number x)
+	{
+		if(x instanceof Integer)
+			return new Integer(-((Integer)x).intValue());
+		else if(x instanceof BigInteger)
+			return ((BigInteger)x).negate();
+		else if(x instanceof FactorRatio)
+			return ((FactorRatio)x).neg();
+		else
+			return new Double(-((Double)x).doubleValue());
+	} //}}}
+
 	//{{{ randomAngle() method
 	public static float randomAngle()
 	{

factor/FactorNamespace.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:
@@ -36,11 +36,12 @@ import java.lang.reflect.Modifier;
 import java.util.TreeMap;
 import java.util.Iterator;
 import java.util.Map;
-import java.util.LinkedList;
-import java.util.List;
 
 /**
- * Manages the set of available words.
+ * A namespace is a list of name/value bindings. A namespace can optionally
+ * have a parent, and a bound object, in which case every public field of the
+ * object will be accessible through the namespace. Additionally, static fields
+ * from arbitrary classes can be imported into the namespace.
  */
 public class FactorNamespace implements PublicCloneable, FactorObject
 {
@@ -50,6 +51,19 @@ public class FactorNamespace implements PublicCloneable, FactorObject
 	public Object obj;
 	private FactorNamespace parent;
 	private Map words;
+	private Class constraint;
+
+	//{{{ createConstrainedNamespace() method
+	/**
+	 * Used for dictionary.
+	 */
+	public static FactorNamespace createConstrainedNamespace(
+		Class constraint) throws Exception
+	{
+		FactorNamespace namespace = new FactorNamespace(null,null,null);
+		namespace.constraint = constraint;
+		return namespace;
+	} //}}}
 
 	//{{{ FactorNamespace constructor
 	public FactorNamespace(FactorNamespace parent) throws Exception
@@ -88,21 +102,7 @@ public class FactorNamespace implements PublicCloneable, FactorObject
 			}
 		}
 
-		try
-		{
-			setVariable("namespace",this);
-			setVariable("parent",parent);
-		}
-		catch(Exception e)
-		{
-			e.printStackTrace();
-		}
-
-		if(obj != null)
-		{
-			this.obj = obj;
-			setVariable("this",obj);
-		}
+		this.obj = obj;
 	} //}}}
 
 	//{{{ getNamespace() method
@@ -117,6 +117,15 @@ public class FactorNamespace implements PublicCloneable, FactorObject
 		return parent;
 	} //}}}
 
+	//{{{ getThis() method
+	/**
+	 * Returns the object bound to this namespace, or null.
+	 */
+	public Object getThis()
+	{
+		return obj;
+	} //}}}
+
 	//{{{ importVars() method
 	/**
 	 * Defines a variable bound to a Java field.
@@ -180,7 +189,20 @@ public class FactorNamespace implements PublicCloneable, FactorObject
 		else if(value == null)
 			words.put(name,NULL);
 		else
+		{
+			if(constraint != null)
+			{
+				if(!constraint.isAssignableFrom(
+					value.getClass()))
+				{
+					throw new FactorRuntimeException(
+						"Can only store "
+						+ constraint
+						+ " in " + this);
+				}
+			}
 			words.put(name,value);
+		}
 	} //}}}
 
 	//{{{ lazyFieldInit() method
@@ -229,45 +251,11 @@ public class FactorNamespace implements PublicCloneable, FactorObject
 		}
 	} //}}}
 
-	//{{{ toVarList() method
+	//{{{ toVarValueList() method
 	/**
-	 * Returns a list of variable and word names defined in this namespace.
+	 * Returns a list of pairs of variable names, and their values.
 	 */
-	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();
-			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);
-			if(first == null)
-				first = last = cons;
-			else
-			{
-				last.cdr = cons;
-				last = cons;
-			}
-		}
-
-		return first;
-	} //}}}
-
-	//{{{ toValueList() method
-	/**
-	 * Returns a list of pairs of variable and word names, and their values.
-	 */
-	public Cons toValueList()
+	public Cons toVarValueList()
 	{
 		initAllFields();
 

factor/FactorParseException.java

@@ -33,6 +33,6 @@ public class FactorParseException extends FactorException
 {
 	public FactorParseException(String filename, int lineno, String str)
 	{
-		super(filename + ":" + lineno + ":" + str);
+		super(filename + ":" + lineno + ": " + str);
 	}
 }

factor/FactorParser.java

@@ -1,596 +0,0 @@
-/* :folding=explicit: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.
- */
-
-package factor;
-
-import java.io.*;
-import java.util.HashMap;
-
-public class FactorParser
-{
-	private static final Object EOF = new Object();
-
-	private FactorWord DEF;
-	private FactorWord INE;
-
-	private FactorWord SHU;
-	private FactorWord F;
-	private FactorWord FLE;
-
-	private FactorWord DEFINE;
-
-	private FactorWord BRA;
-	private FactorWord KET;
-
-	private FactorWord COMMA;
-
-	private String filename;
-	private Reader in;
-	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,
-		FactorInterpreter interp)
-	{
-		this.filename = (filename == null ? "<eval>" : filename);
-		this.in = in;
-		this.interp = interp;
-
-		DEF = interp.intern(":");
-		INE = interp.intern(";");
-
-		SHU = interp.intern("~<<");
-		F = interp.intern("--");
-		FLE = interp.intern(">>~");
-
-		DEFINE = interp.intern("define");
-
-		BRA = interp.intern("[");
-		KET = interp.intern("]");
-
-		COMMA = interp.intern(",");
-
-		st = new StreamTokenizer(in);
-		st.resetSyntax();
-		st.whitespaceChars(0,' ');
-		/* all printable ASCII characters */
-		st.wordChars('#','~');
-		st.wordChars('0','9');
-		st.commentChar('!');
-		st.quoteChar('"');
-		st.commentChar('(');
-		st.eolIsSignificant(false);
-	} //}}}
-
-	//{{{ isParsingWord() method
-	private boolean isParsingWord(Object word)
-	{
-		return word == DEF
-			|| word == INE
-			|| word == SHU
-			|| word == FLE
-			|| word == BRA
-			|| word == KET
-			|| word == COMMA;
-	} //}}}
-
-	//{{{ parse() method
-	/**
-	 * Reads the file being parsed, and returns a list of all tokens that
-	 * were read in. This list can be evaluated to run the file.
-	 */
-	public Cons parse() throws IOException, FactorParseException
-	{
-		Cons first = null;
-		Cons last = null;
-
-		try
-		{
-			for(;;)
-			{
-				Object next = next();
-				if(next == EOF)
-					return first;
-				/* : foo bar baz ; is equivalent to
-				   "foo" [ bar baz ] define */
-				else if(next == DEF)
-				{
-					Object obj = next();
-					if(!(obj instanceof FactorWord)
-						|| isParsingWord(obj))
-					{
-						error("Expected word name after " + next);
-					}
-
-					FactorWord word = (FactorWord)obj;
-
-					FactorWordDefinition def
-						= readDef(word);
-
-					Cons l = new Cons(DEFINE,null);
-					Cons cons = new Cons(
-						word.name,
-						new Cons(def,l));
-					if(first == null)
-						first = cons;
-					else
-						last.cdr = cons;
-					last = l;
-				}
-				else if(next == SHU)
-				{
-					Object obj = next();
-					if(!(obj instanceof FactorWord)
-						|| isParsingWord(obj))
-					{
-						error("Expected word name after " + next);
-					}
-
-					FactorWord word = (FactorWord)obj;
-
-					FactorWordDefinition def
-						= readShuffle(word);
-
-					Cons l = new Cons(DEFINE,null);
-					Cons cons = new Cons(
-						word.name,
-						new Cons(def,l));
-					if(first == null)
-						first = cons;
-					else
-						last.cdr = cons;
-					last = l;
-				}
-				else if(next == BRA)
-				{
-					Cons cons = new Cons(
-						readList(),null);
-					if(first == null)
-						first = cons;
-					else
-						last.cdr = cons;
-					last = cons;
-				}
-				else if(isParsingWord(next))
-				{
-					error("Unexpected " + next);
-				}
-				else
-				{
-					Cons cons = new Cons(next,null);
-					if(first == null)
-						first = cons;
-					else
-						last.cdr = cons;
-					last = cons;
-				}
-			}
-		}
-		finally
-		{
-			try
-			{
-				in.close();
-			}
-			catch(IOException io)
-			{
-			}
-		}
-	} //}}}
-
-	//{{{ next() method
-	private Object next() throws IOException, FactorParseException
-	{
-		if(next != null)
-		{
-			Object _next = next;
-			next = null;
-			return _next;
-		}
-
-		int type = st.nextToken();
-		switch(type)
-		{
-		case StreamTokenizer.TT_EOF:
-			return EOF;
-		case StreamTokenizer.TT_WORD:
-			boolean number = true;
-			boolean floating = false;
-			boolean exponent = false;
-
-			for(int i = 0; i < st.sval.length(); i++)
-			{
-				char ch = st.sval.charAt(i);
-				if(ch == '-')
-				{
-					if((i != 0 && Character.toLowerCase(
-						st.sval.charAt(i - 1))
-						!= 'e') || st.sval.length() == 1)
-					{
-						number = false;
-						break;
-					}
-				}
-				else if((ch == 'e' || ch == 'E')
-					&& st.sval.length() != 1)
-				{
-					if(exponent)
-					{
-						number = false;
-						break;
-					}
-					else
-						exponent = true;
-				}
-				else if(ch == '.' && st.sval.length() != 1)
-				{
-					if(floating)
-					{
-						number = false;
-						break;
-					}
-					else
-						floating = true;
-				}
-				else if(!Character.isDigit(ch))
-				{
-					number = false;
-					break;
-				}
-			}
-
-			if(number)
-			{
-				if(floating || exponent)
-					return new Float(st.sval);
-				else
-					return new Integer(st.sval);
-			}
-
-			if(st.sval.length() == 1)
-			{
-				switch(st.sval.charAt(0))
-				{
-				case 'f':
-					return null;
-				case 't':
-					return Boolean.TRUE;
-				}
-			}
-			else if(st.sval.startsWith("#\\"))
-				return toChar(st.sval.substring(2));
-			else
-			{
-				// $foo is expanded into "foo" $
-				if(st.sval.charAt(0) == '$')
-				{
-					next = interp.intern("$");
-					return st.sval.substring(1);
-				}
-				// @foo is expanded into "foo" @
-				else if(st.sval.charAt(0) == '@')
-				{
-					next = interp.intern("@");
-					return st.sval.substring(1);
-				}
-			}
-
-			// |foo is the same as "foo"
-			if(st.sval.charAt(0) == '|')
-				return st.sval.substring(1);
-
-			return interp.intern(st.sval);
-		case '"': case '\'':
-			return st.sval;
-		default:
-			throw new FactorParseException(filename,
-				st.lineno(),"Unknown error: " + type);
-		}
-	} //}}}
-
-	//{{{ toChar() method
-	private Character toChar(String spec) throws FactorParseException
-	{
-		if(spec.length() != 1)
-			error("Not a character literal: #\\" + spec);
-		return new Character(spec.charAt(0));
-	} //}}}
-
-	//{{{ readDef() method
-	/**
-	 * Read list until ;.
-	 */
-	private FactorWordDefinition readDef(FactorWord word)
-		throws IOException, FactorParseException
-	{
-		return new FactorCompoundDefinition(word,readList(INE,false));
-	} //}}}
-
-	//{{{ readShuffle() method
-	/**
-	 * Shuffle notation looks like this:
-	 * ~<< a b -- b a >>~
-	 * On the left is inputs, on the right is their arrangement on the
-	 * stack.
-	 */
-	private FactorWordDefinition readShuffle(FactorWord word)
-		throws IOException, FactorParseException
-	{
-		// 0 in consume map is last consumed, n is first consumed.
-		HashMap consumeMap = new HashMap();
-		int consumeD = 0;
-		int consumeR = 0;
-
-		for(;;)
-		{
-			Object next = next();
-			if(next == EOF)
-				error("Unexpected EOF");
-			if(next == F)
-				break;
-			else if(next instanceof FactorWord)
-			{
-				String name = ((FactorWord)next).name;
-				int counter;
-				if(name.startsWith("r:"))
-				{
-					next = interp.intern(name.substring(2));
-					counter = (FactorShuffleDefinition
-						.FROM_R_MASK
-						| consumeR++);
-				}
-				else
-					counter = consumeD++;
-
-				Object existing = consumeMap.put(next,
-					new Integer(counter));
-				if(existing != null)
-					error("Appears twice in shuffle LHS: " + next);
-			}
-			else
-			{
-				error("Unexpected " + FactorParser.unparse(
-					next));
-			}
-		}
-
-		Cons _shuffle = readList(FLE,false);
-
-		int consume = consumeMap.size();
-
-		if(_shuffle == null)
-		{
-			return new FactorShuffleDefinition(word,
-				consumeD,consumeR,
-				null,0,null,0);
-		}
-
-		int[] shuffle = new int[_shuffle.length()];
-
-		int shuffleDlength = 0;
-		int shuffleRlength = 0;
-
-		int i = 0;
-		while(_shuffle != null)
-		{
-			if(_shuffle.car instanceof FactorWord)
-			{
-				FactorWord w = ((FactorWord)_shuffle.car);
-				String name = w.name;
-				if(name.startsWith("r:"))
-					w = interp.intern(name.substring(2));
-
-				Integer _index = (Integer)consumeMap.get(w);
-				if(_index == null)
-					error("Does not appear in shuffle LHS: " + _shuffle.car);
-				int index = _index.intValue();
-
-				if(name.startsWith("r:"))
-				{
-					shuffleRlength++;
-					shuffle[i++] = (index
-						| FactorShuffleDefinition
-						.TO_R_MASK);
-				}
-				else
-				{
-					shuffleDlength++;
-					shuffle[i++] = index;
-				}
-			}
-			else
-			{
-				error("Unexpected " + FactorParser.unparse(
-					_shuffle.car));
-			}
-			_shuffle = _shuffle.next();
-		}
-
-		int[] shuffleD = new int[shuffleDlength];
-		int[] shuffleR = new int[shuffleRlength];
-		int j = 0, k = 0;
-		for(i = 0; i < shuffle.length; i++)
-		{
-			int index = shuffle[i];
-			if((index & FactorShuffleDefinition.TO_R_MASK)
-				== FactorShuffleDefinition.TO_R_MASK)
-			{
-				index = (index
-					& ~FactorShuffleDefinition.TO_R_MASK);
-				shuffleR[j++] = index;
-			}
-			else
-				shuffleD[k++] = index;
-		}
-
-		return new FactorShuffleDefinition(word,consumeD,consumeR,
-			shuffleD,shuffleDlength,shuffleR,shuffleRlength);
-	} //}}}
-
-	//{{{ readList() method
-	/**
-	 * Read list until ].
-	 */
-	private Cons readList()
-		throws IOException, FactorParseException
-	{
-		return readList(KET,true);
-	} //}}}
-
-	//{{{ readList() method
-	/**
-	 * Read list until a given word.
-	 */
-	private Cons readList(FactorWord until, boolean allowCommaPair)
-		throws IOException, FactorParseException
-	{
-		Cons first = null;
-		Cons last = null;
-
-		for(;;)
-		{
-			Object next = next();
-			if(next == until)
-				return first;
-			else if(next == EOF)
-			{
-				error("Unexpected EOF");
-			}
-			// read a dotted pair
-			else if(allowCommaPair && next == COMMA)
-			{
-				if(first == null)
-				{
-					error("Expected at least 1 word before  " + next);
-				}
-
-				next = next();
-				if(next == BRA)
-				{
-					last.cdr = readList();
-					next = next();
-					if(next == EOF)
-						error("Unexpected EOF");
-					else if(next != KET)
-						error("Expected 1 word after ,");
-					return first;
-				}
-				else if(next != EOF && !isParsingWord(next))
-				{
-					last.cdr = next;
-					next = next();
-					if(next == until)
-						return first;
-				}
-
-				error("Expected 1 word after ,");
-			}
-			else if(next == BRA)
-			{
-				Cons list = readList();
-				if(first == null)
-					first = last = new Cons(list,null);
-				else
-				{
-					Cons nextList = new Cons(list,null);
-					last.cdr = nextList;
-					last = nextList;
-				}
-			}
-			else if(isParsingWord(next))
-				error("Unexpected " + next);
-			else if(first == null)
-				first = last = new Cons(next,null);
-			else
-			{
-				Cons nextList = new Cons(next,null);
-				last.cdr = nextList;
-				last = nextList;
-			}
-		}
-	} //}}}
-
-	//{{{ error() method
-	private void error(String msg) throws FactorParseException
-	{
-		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/FactorParsingDefinition.java

@@ -0,0 +1,54 @@
+/* :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;
+
+import java.io.IOException;
+
+/**
+ * A parsing word definition.
+ */
+public abstract class FactorParsingDefinition
+{
+	protected FactorWord word;
+
+	public FactorParsingDefinition(FactorWord word)
+	{
+		this.word = word;
+	}
+
+	public abstract void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException;
+
+	//{{{ toString() method
+	public String toString()
+	{
+		return getClass().getName() + ": " + word;
+	} //}}}
+}

factor/FactorPrimitiveDefinition.java

@@ -33,33 +33,13 @@ import factor.compiler.*;
 import java.util.Set;
 
 /**
- * A placeholder for an undefined word.
+ * All primitive words extend this.
  */
-public class FactorMissingDefinition extends FactorWordDefinition
+public abstract class FactorPrimitiveDefinition extends FactorWordDefinition
 {
-	//{{{ FactorMissingDefinition constructor
-	public FactorMissingDefinition(FactorWord word)
+	//{{{ FactorPrimitiveDefinition constructor
+	public FactorPrimitiveDefinition(FactorWord word)
 	{
 		super(word);
 	} //}}}
-
-	//{{{ eval() method
-	public void eval(FactorInterpreter interp)
-		throws FactorUndefinedWordException
-	{
-		throw new FactorUndefinedWordException(word);
-	} //}}}
-
-	//{{{ toList() method
-	public Cons toList()
-	{
-		return new Cons(new FactorWord("( missing: " + word + " )"),
-			null);
-	} //}}}
-
-	//{{{ toString() method
-	public String toString()
-	{
-		return "undefined";
-	} //}}}
 }

factor/FactorRatio.java

@@ -222,13 +222,14 @@ public class FactorRatio extends Number implements FactorExternalizable
 	//{{{ reduce() method
 	public static Number reduce(Number numerator, Number denominator)
 	{
-		/* if(FactorMath.sgn(denominator) == 0)
-			signal(new DivisionByZero()); */
-		/* if(FactorMath.sgn(denominator) == -1)
+		if(FactorMath.sgn(denominator) == 0)
+			throw new ArithmeticException("/ by zero");
+		if(FactorMath.sgn(denominator) == -1)
 		{
 			numerator = FactorMath.neg(numerator);
 			denominator = FactorMath.neg(denominator);
-		} */
+		}
+
 		Number gcd = FactorMath.gcd(numerator,denominator);
 		if(!FactorMath.is1(gcd))
 		{
@@ -242,6 +243,12 @@ public class FactorRatio extends Number implements FactorExternalizable
 			return new FactorRatio(numerator,denominator);
 	} //}}}
 
+	//{{{ neg() method
+	public FactorRatio neg()
+	{
+		return new FactorRatio(FactorMath.neg(numerator),denominator);
+	} //}}}
+
 	//{{{ intValue() method
 	public int intValue()
 	{

factor/FactorReader.java

@@ -0,0 +1,370 @@
+/* :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;
+
+import java.io.*;
+
+/**
+ * Use a FactorScanner to read words, and dispatch to parsing words in order
+ * to build a parse tree.
+ */
+public class FactorReader
+{
+	private FactorInterpreter interp;
+	private FactorScanner scanner;
+	private Cons states;
+
+	/**
+	 * Top level of parse tree.
+	 */
+	private FactorWord toplevel = new FactorWord("#<EOF>");
+	private boolean alwaysDocComments;
+
+	//{{{ parseObject() method
+	/**
+	 * Parse the given string. It must be a single literal object.
+	 * The object is returned.
+	 */
+	public static Object parseObject(String input, FactorInterpreter interp)
+		throws FactorParseException
+	{
+		try
+		{
+			FactorReader parser = new FactorReader(
+				"parseObject()",new StringReader(input),
+				interp,true);
+			Cons parsed = parser.parse();
+			if(parsed.cdr != null)
+			{
+				// not a single literal
+				throw new FactorParseException("parseObject()",
+					1,"Not a literal: " + input);
+			}
+			return parsed.car;
+		}
+		catch(IOException io)
+		{
+			// can't happen!
+			throw new FactorParseException("parseObject()",1,
+				io.toString());
+		}
+	} //}}}
+
+	//{{{ getUnreadableString() method
+	public static String getUnreadableString(String str)
+	{
+		return "#<" + str + ">";
+	} //}}}
+
+	//{{{ charsToEscapes() method
+	public static String charsToEscapes(String str)
+	{
+		StringBuffer buf = new StringBuffer();
+		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;
+			case '\\':
+				buf.append("\\\\");
+				break;
+			case '\0':
+				buf.append("\\0");
+				break;
+			default:
+				buf.append(ch);
+			}
+		}
+		return buf.toString();
+	} //}}}
+
+	//{{{ unparseObject() method
+	public static String unparseObject(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 '"' + charsToEscapes((String)obj) + '"';
+		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());
+	} //}}}
+
+	//{{{ FactorReader constructor
+	public FactorReader(String filename, Reader in,
+		FactorInterpreter interp)
+	{
+		this(filename,in,interp,false);
+	} //}}}
+
+	//{{{ FactorReader constructor
+	public FactorReader(String filename, Reader in,
+		FactorInterpreter interp, boolean alwaysDocComments)
+	{
+		this.interp = interp;
+
+		this.alwaysDocComments = alwaysDocComments;
+
+		ReadTable readtable = new ReadTable();
+
+		readtable.setCharacterType('\t',ReadTable.WHITESPACE);
+		readtable.setCharacterType('\n',ReadTable.WHITESPACE);
+		readtable.setCharacterType((char)12,ReadTable.WHITESPACE); // ^L
+		readtable.setCharacterType('\r',ReadTable.WHITESPACE);
+		readtable.setCharacterType(' ',ReadTable.WHITESPACE);
+
+		readtable.setCharacterType('!',ReadTable.CONSTITUENT);
+		readtable.setCharacterType('"',ReadTable.DISPATCH);
+		readtable.setCharacterType('#',ReadTable.DISPATCH);
+		readtable.setCharacterType('$',ReadTable.DISPATCH);
+		readtable.setCharacterRange('%','?',ReadTable.CONSTITUENT);
+		readtable.setCharacterType('@',ReadTable.DISPATCH);
+		readtable.setCharacterRange('A','[',ReadTable.CONSTITUENT);
+		readtable.setCharacterType('\\',ReadTable.SINGLE_ESCAPE);
+		readtable.setCharacterRange(']','{',ReadTable.CONSTITUENT);
+		readtable.setCharacterType('|',ReadTable.DISPATCH);
+		readtable.setCharacterRange('}','~',ReadTable.CONSTITUENT);
+
+		// XXX:
+		readtable.setCharacterType('!',ReadTable.DISPATCH);
+		readtable.setCharacterType('(',ReadTable.DISPATCH);
+
+		scanner = new FactorScanner(interp,filename,in,readtable);
+
+		pushState(toplevel);
+	} //}}}
+
+	//{{{ getScanner() method
+	public FactorScanner getScanner()
+	{
+		return scanner;
+	} //}}}
+
+	//{{{ parse() method
+	/**
+	 * Keeps parsing the input stream until EOF, and returns the
+	 * parse tree.
+	 */
+	public Cons parse() throws IOException, FactorParseException
+	{
+		for(;;)
+		{
+			if(next())
+			{
+				// eof.
+				return popState(toplevel,toplevel);
+			}
+		}
+	} //}}}
+
+	//{{{ next() method
+	/**
+	 * Read the next word and take some kind of action.
+	 * Returns true if EOF, false otherwise.
+	 */
+	private boolean next() throws IOException, FactorParseException
+	{
+		Object next = scanner.next(true,true);
+		if(next == FactorScanner.EOF)
+			return true;
+
+		if(next instanceof FactorWord)
+		{
+			FactorWord word = (FactorWord)next;
+			if(word.parsing != null)
+			{
+				word.parsing.eval(interp,this);
+				return false;
+			}
+		}
+
+		append(next);
+		return false;
+	} //}}}
+
+	//{{{ pushExclusiveState() method
+	/**
+	 * An exclusive state can only happen at the top level.
+	 * For example, : ... ; definitions cannot be nested so they
+	 * are exclusive.
+	 */
+	public void pushExclusiveState(FactorWord start)
+		throws FactorParseException
+	{
+		if(getCurrentState().start != toplevel)
+			scanner.error(start + " cannot be nested");
+		pushState(start);
+	} //}}}
+
+	//{{{ pushState() method
+	/**
+	 * Push a parser state, for example reading of a list.
+	 */
+	public void pushState(FactorWord start)
+	{
+		states = new Cons(new ParseState(start),states);
+	} //}}}
+
+	//{{{ popState() method
+	/**
+	 * Pop a parser state, throw exception if it doesn't match the
+	 * parameter.
+	 */
+	public Cons popState(FactorWord start, FactorWord end)
+		throws FactorParseException
+	{
+		ParseState state = getCurrentState();
+		if(state.start != start)
+		{
+			scanner.error(end + " does not close " + state.start);
+		}
+		states = states.next();
+		return state.first;
+	} //}}}
+
+	//{{{ getCurrentState() method
+	public ParseState getCurrentState()
+	{
+		return (ParseState)states.car;
+	} //}}}
+
+	//{{{ append() method
+	/**
+	 * Append the given object to the current parse tree node.
+	 */
+	public void append(Object obj) throws FactorParseException
+	{
+		getCurrentState().append(obj);
+	} //}}}
+
+	//{{{ comma() method
+	/**
+	 * Sets the current parser state's cdr to the given object.
+	 */
+	public void comma() throws FactorParseException
+	{
+		getCurrentState().comma();
+	} //}}}
+
+	//{{{ error() method
+	public void error(String msg) throws FactorParseException
+	{
+		scanner.error(msg);
+	} //}}}
+
+	//{{{ ParseState class
+	public class ParseState
+	{
+		public FactorWord start;
+		public Cons first;
+		public Cons last;
+		private boolean comma;
+		private boolean docComment;
+
+		ParseState(FactorWord start)
+		{
+			this.start = start;
+			try
+			{
+				this.docComment
+					= (start.getNamespace(interp)
+					.getVariable("doc-comments")
+					!= null);
+			}
+			catch(Exception e)
+			{
+				throw new RuntimeException(e);
+			}
+		}
+
+		void append(Object obj) throws FactorParseException
+		{
+			boolean docComment = (this.docComment
+				|| alwaysDocComments);
+			// In a doc comment context, first object is always
+			// a word, then followed by doc comments, then followed
+			// by code.
+			if(docComment && !(obj instanceof FactorDocComment)
+				&& first != null)
+			{
+				this.docComment = false;
+			}
+			else if(!docComment && obj instanceof FactorDocComment)
+			{
+				//scanner.error("Documentation comment not allowed here");
+				return;
+			}
+
+			if(comma)
+			{
+				if(last.cdr != null)
+					scanner.error("Only one token allowed after ,");
+				last.cdr = obj;
+			}
+			else
+			{
+				Cons next = new Cons(obj,null);
+				if(first == null)
+					first = next;
+				else
+					last.cdr = next;
+				last = next;
+			}
+		}
+
+		void comma() throws FactorParseException
+		{
+			if(last.cdr != null)
+			{
+				// We already read [ a , b
+				// no more can be appended to this state.
+				scanner.error("Only one token allowed after ,");
+			}
+
+			comma = true;
+		}
+	} //}}}
+}

factor/FactorScanner.java

@@ -0,0 +1,381 @@
+/* :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;
+
+import java.io.*;
+import java.math.BigInteger;
+
+/**
+ * Splits an input stream into words.
+ */
+public class FactorScanner
+{
+	/**
+	 * Special object returned on EOF.
+	 */
+	public static final Object EOF = new Object();
+
+	private FactorInterpreter interp;
+	private String filename;
+	private PushbackReader in;
+	private StringBuffer buf;
+	private ReadTable readtable;
+	private int lineNo = 1;
+	private boolean lastCR;
+
+	//{{{ FactorScanner constructor
+	public FactorScanner(FactorInterpreter interp, String filename,
+		Reader in, ReadTable readtable)
+	{
+		this.interp = interp;
+		this.filename = filename;
+		this.in = new PushbackReader(in,1);
+		this.readtable = readtable;
+		buf = new StringBuffer();
+	} //}}}
+
+	//{{{ next() method
+	/**
+	 * @param readNumbers If true, will return either a Number or a
+	 * FactorWord. Otherwise, only FactorWords are returned.
+	 * @param start If true, dispatches will be handled by their parsing
+	 * word, otherwise dispatches are ignored.
+	 */
+	public Object next(boolean readNumbers, boolean start)
+		throws IOException, FactorParseException
+	{
+		for(;;)
+		{
+			int ch = in.read();
+			if(ch == -1)
+			{
+				if(buf.length() == 0)
+					return EOF;
+				else
+					return word(readNumbers);
+			}
+			else if(ch == '\n')
+			{
+				if(!lastCR)
+					lineNo++;
+				if(buf.length() != 0)
+					return word(readNumbers);
+				else
+					continue;
+			}
+			else if(ch == '\r')
+			{
+				lineNo++;
+				lastCR = true;
+				if(buf.length() != 0)
+					return word(readNumbers);
+				else
+					continue;
+			}
+			else
+				lastCR = false;
+
+			int type = readtable.getCharacterType((char)ch);
+
+			switch(type)
+			{
+			case ReadTable.INVALID:
+				error("Invalid character in input: " + (int)ch);
+				break;
+			case ReadTable.WHITESPACE:
+				if(buf.length() != 0)
+					return word(readNumbers);
+				break;
+			case ReadTable.DISPATCH:
+				// note that s" is read as the word s", no
+				// dispatch on "
+				if(buf.length() == 0 && start)
+				{
+					buf.append((char)ch);
+					return word(readNumbers);
+				}
+			case ReadTable.CONSTITUENT:
+				buf.append((char)ch);
+				break;
+			case ReadTable.SINGLE_ESCAPE:
+				buf.append(escape(readNonEOF()));
+				break;
+			}
+		}
+	} //}}}
+
+	//{{{ readUntil() method
+	public String readUntil(char start, char end,
+		boolean lineBreaksAllowed,
+		boolean escapesAllowed)
+		throws IOException, FactorParseException
+	{
+		buf.setLength(0);
+
+		for(;;)
+		{
+			int ch = in.read();
+			if(ch == -1)
+				error("Expected " + end + " before EOF");
+			else if((ch == '\r' || ch == '\n')
+				&& !lineBreaksAllowed)
+			{
+				error("Expected " + end + " before EOL");
+			}
+			else if(ch == '\n')
+			{
+				if(!lastCR)
+					buf.append('\n');
+				continue;
+			}
+			else if(ch == '\r')
+			{
+				buf.append('\n');
+				lastCR = true;
+				continue;
+			}
+			else if(ch == end)
+				break;
+			else
+				lastCR = false;
+
+			int type = readtable.getCharacterType((char)ch);
+
+			if(type == ReadTable.SINGLE_ESCAPE)
+				buf.append(escape(readNonEOF()));
+			else
+				buf.append((char)ch);
+		}
+
+		String returnValue = buf.toString();
+		buf.setLength(0);
+		return returnValue;
+	} //}}}
+
+	//{{{ readUntilEOL() method
+	public String readUntilEOL() throws IOException
+	{
+		buf.setLength(0);
+
+		for(;;)
+		{
+			int ch = in.read();
+			if(ch == -1)
+				break;
+			else if(ch == '\n')
+			{
+				if(!lastCR)
+					lineNo++;
+				break;
+			}
+			else if(ch == '\r')
+			{
+				lineNo++;
+				lastCR = true;
+				break;
+			}
+			else
+				buf.append((char)ch);
+		}
+
+		String returnValue = buf.toString();
+		buf.setLength(0);
+		return returnValue;
+	} //}}}
+
+	//{{{ readNonEOF() method
+	public char readNonEOF() throws FactorParseException, IOException
+	{
+		int next = in.read();
+		if(next == -1)
+		{
+			error("Unexpected EOF");
+			// can't happen
+			return '\0';
+		}
+		else
+			return (char)next;
+	} //}}}
+
+	//{{{ readNonEOFEscaped() method
+	public char readNonEOFEscaped() throws FactorParseException, IOException
+	{
+		int next = in.read();
+		if(next == -1)
+		{
+			error("Unexpected EOF");
+			// can't happen
+			return '\0';
+		}
+		else if(readtable.getCharacterType((char)next)
+			== ReadTable.SINGLE_ESCAPE)
+		{
+			return escape(readNonEOF());
+		}
+		else
+			return (char)next;
+	} //}}}
+
+	//{{{ atEndOfWord() method
+	public boolean atEndOfWord() throws IOException
+	{
+		int next = in.read();
+		if(next == -1)
+			return true;
+		else
+		{
+			in.unread(next);
+			int type = readtable.getCharacterType((char)next);
+			return type == ReadTable.WHITESPACE;
+		}
+	} //}}}
+
+	//{{{ escape() method
+	private char escape(char ch) throws FactorParseException
+	{
+		switch(ch)
+		{
+		case 'n':
+			return '\n';
+		case 'r':
+			return '\r';
+		case 't':
+			return '\t';
+		case '\\':
+			return '\\';
+		case '"':
+			return '"';
+		case ' ':
+			return ' ';
+		case '0':
+			return '\0';
+		default:
+			error("Unknown escape: " + ch);
+			// can't happen
+			return '\0';
+		}
+	} //}}}
+
+	//{{{ word() method
+	private Object word(boolean readNumbers)
+	{
+		String name = buf.toString();
+		buf.setLength(0);
+		if(readNumbers)
+		{
+			Number n = parseNumber(name);
+			if(n != null)
+				return n;
+		}
+
+		return interp.intern(name);
+	} //}}}
+
+	//{{{ parseNumber() method
+	/**
+	 * If the given string is a number, convert it to a Number instance,
+	 * otherwise return null.
+	 */
+	public static Number parseNumber(String word)
+	{
+		if(word == null)
+			return null;
+
+		boolean number = true;
+		boolean floating = false;
+		boolean exponent = false;
+
+		for(int i = 0; i < word.length(); i++)
+		{
+			char ch = word.charAt(i);
+			if(ch == '-')
+			{
+				if((i != 0 && Character.toLowerCase(
+					word.charAt(i - 1))
+					!= 'e') || word.length() == 1)
+				{
+					number = false;
+					break;
+				}
+			}
+			else if((ch == 'e' || ch == 'E')
+				&& word.length() != 1)
+			{
+				if(exponent)
+				{
+					number = false;
+					break;
+				}
+				else
+					exponent = true;
+			}
+			else if(ch == '.' && word.length() != 1)
+			{
+				if(floating)
+				{
+					number = false;
+					break;
+				}
+				else
+					floating = true;
+			}
+			else if(!Character.isDigit(ch))
+			{
+				number = false;
+				break;
+			}
+		}
+
+		if(number)
+		{
+			if(floating || exponent)
+				return new Float(word);
+			else
+			{
+				try
+				{
+					return new Integer(word);
+				}
+				catch(NumberFormatException e)
+				{
+					return new BigInteger(word);
+				}
+			}
+		}
+
+		return null;
+	} //}}}
+
+	//{{{ error() method
+	public void error(String msg) throws FactorParseException
+	{
+		throw new FactorParseException(filename,lineNo,msg);
+	} //}}}
+}

factor/FactorShuffleDefinition.java

@@ -134,6 +134,8 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 	public int compileCallTo(CodeVisitor mw, FactorCompiler compiler,
 		RecursiveState recursiveCheck) throws FactorStackException
 	{
+		compiler.ensure(compiler.datastack,consumeD);
+		compiler.ensure(compiler.callstack,consumeR);
 		eval(compiler.datastack,compiler.callstack);
 		return 0;
 	} //}}}
@@ -212,10 +214,9 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 	} //}}}
 
 	//{{{ toList() method
-	public Cons toList()
+	public Cons toList(FactorInterpreter interp)
 	{
-		return new Cons(word,new Cons(
-			new FactorWord(toString()),null));
+		return new Cons(new FactorWord(toString()),null);
 	} //}}}
 
 	//{{{ toString() method
@@ -232,7 +233,7 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 		for(int i = 0; i < consumeR; i++)
 		{
 			buf.append("r:");
-			buf.append((char)('A' + i));
+			buf.append((char)('A' + consumeD + i));
 			buf.append(' ');
 		}
 
@@ -244,7 +245,10 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 			{
 				int index = shuffleD[i];
 				if((index & FROM_R_MASK) == FROM_R_MASK)
+				{
 					index &= ~FROM_R_MASK;
+					index += consumeD;
+				}
 				buf.append(' ');
 				buf.append((char)('A' + index));
 			}
@@ -256,7 +260,10 @@ public class FactorShuffleDefinition extends FactorWordDefinition
 			{
 				int index = shuffleR[i];
 				if((index & FROM_R_MASK) == FROM_R_MASK)
+				{
 					index &= ~FROM_R_MASK;
+					index += consumeD;
+				}
 				buf.append(" r:");
 				buf.append((char)('A' + index));
 			}

factor/FactorWord.java

@@ -44,10 +44,15 @@ public class FactorWord implements FactorExternalizable, FactorObject
 	public final String name;
 
 	/**
-	 * Always non-null.
+	 * Interpreted/compiled word definition.
 	 */
 	public FactorWordDefinition def;
 
+	/**
+	 * Parsing word definition.
+	 */
+	public FactorParsingDefinition parsing;
+
 	/**
 	 * Contains a string if this is compiled.
 	 */
@@ -58,6 +63,11 @@ public class FactorWord implements FactorExternalizable, FactorObject
 	 */
 	public boolean compileRef;
 
+	/**
+	 * Should this word be inlined when compiling?
+	 */
+	public boolean inline;
+
 	//{{{ FactorWord constructor
 	/**
 	 * Do not use this constructor unless you're writing a packages
@@ -67,7 +77,6 @@ public class FactorWord implements FactorExternalizable, FactorObject
 	public FactorWord(String name)
 	{
 		this.name = name;
-		def = new FactorMissingDefinition(this);
 	} //}}}
 
 	//{{{ getNamespace() method
@@ -86,7 +95,7 @@ public class FactorWord implements FactorExternalizable, FactorObject
 	 */
 	public static FactorWord gensym()
 	{
-		return new FactorWord("( GENSYM:" + (gensymCount++) + " )");
+		return new FactorWord("#<GENSYM:" + (gensymCount++) + ">");
 	} //}}}
 
 	//{{{ define() method
@@ -99,7 +108,7 @@ public class FactorWord implements FactorExternalizable, FactorObject
 			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))
+		else if(this.def != null)
 			System.err.println("WARNING: redefining " + this);
 
 		this.def = def;
@@ -109,7 +118,7 @@ public class FactorWord implements FactorExternalizable, FactorObject
 	public void compile(FactorInterpreter interp)
 	{
 		RecursiveState recursiveCheck = new RecursiveState();
-		recursiveCheck.add(this,null);
+		recursiveCheck.add(this,new StackEffect(),null,null);
 		compile(interp,recursiveCheck);
 		recursiveCheck.remove(this);
 	} //}}}
@@ -120,7 +129,8 @@ public class FactorWord implements FactorExternalizable, FactorObject
 		//if(def.compileFailed)
 		//	return;
 
-		//System.err.println("Compiling " + this);
+		if(interp.verboseCompile)
+			System.err.println("Compiling " + this);
 
 		try
 		{
@@ -129,16 +139,17 @@ public class FactorWord implements FactorExternalizable, FactorObject
 		catch(Throwable t)
 		{
 			def.compileFailed = true;
-			/*System.err.println("WARNING: cannot compile " + this
-				+ ": " + t.getMessage());
-			if(!(t instanceof FactorException))
-				t.printStackTrace();*/
+			if(interp.verboseCompile)
+			{
+				System.err.println("WARNING: cannot compile " + this);
+				t.printStackTrace();
+			}
 		}
 	} //}}}
 
 	//{{{ toString() method
 	public String toString()
 	{
-		return name;
+		return FactorReader.charsToEscapes(name);
 	} //}}}
 }

factor/FactorWordDefinition.java

@@ -38,7 +38,7 @@ import org.objectweb.asm.*;
  */
 public abstract class FactorWordDefinition implements Constants
 {
-	protected FactorWord word;
+	public final FactorWord word;
 
 	public boolean compileFailed;
 
@@ -51,7 +51,7 @@ public abstract class FactorWordDefinition implements Constants
 		throws Exception;
 
 	//{{{ toList() method
-	public Cons toList()
+	public Cons toList(FactorInterpreter interp)
 	{
 		return new Cons(new FactorWord(getClass().getName()),null);
 	} //}}}
@@ -67,7 +67,7 @@ public abstract class FactorWordDefinition implements Constants
 		throws Exception
 	{
 		FactorCompiler compiler = new FactorCompiler();
-		recursiveCheck.add(word,new StackEffect());
+		recursiveCheck.add(word,new StackEffect(),null,null);
 		getStackEffect(recursiveCheck,compiler);
 		recursiveCheck.remove(word);
 		return compiler.getStackEffect();
@@ -95,80 +95,64 @@ public abstract class FactorWordDefinition implements Constants
 		RecursiveState recursiveCheck) throws Exception
 	{
 		// normal word
-		mw.visitVarInsn(ALOAD,0);
-
 		String defclass;
+		String defmethod;
 		StackEffect effect;
 
 		RecursiveForm rec = recursiveCheck.get(word);
-		if(rec != null && rec.active && compiler.word == word)
+		if(rec != null && rec.active)
 		{
-			// recursive call!
-			defclass = compiler.className;
-			effect = compiler.word.def.getStackEffect();
+			effect = StackEffect.decompose(rec.effect,rec.baseCase);
+
+			// are we recursing back on a form inside the current
+			// method?
+			RecursiveForm last = recursiveCheck.last();
+			if(rec.tail
+				&& last.className.equals(rec.className)
+				&& last.method.equals(rec.method))
+			{
+				// GOTO instad of INVOKEVIRTUAL; ie a loop!
+				int max = compiler.normalizeStacks(mw);
+				mw.visitJumpInsn(GOTO,rec.label);
+				compiler.apply(effect);
+				return max;
+			}
+
+			/* recursive method call! */
+			defclass = rec.className;
+			defmethod = rec.method;
 		}
+		// not a recursive call but we're still not compiled
+		// its a bug in the compiler.
 		else if(this instanceof FactorCompoundDefinition)
 		{
 			throw new FactorCompilerException("You are an idiot!");
 		}
+		// inlining?
+		else if(word.inline)
+		{
+			return compileImmediate(mw,compiler,recursiveCheck);
+		}
+		/* ordinary method call! */
 		else
 		{
 			defclass = getClass().getName()
 				.replace('.','/');
+			defmethod = "core";
 			effect = getStackEffect();
 		}
 
-		compiler.generateArgs(mw,effect.inD,null);
+		mw.visitVarInsn(ALOAD,0);
+
+		compiler.generateArgs(mw,effect.inD,effect.inR,null);
 
 		String signature = effect.getCorePrototype();
 
-		mw.visitMethodInsn(INVOKESTATIC,defclass,"core",signature);
+		mw.visitMethodInsn(INVOKESTATIC,defclass,defmethod,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;
+		compiler.generateReturn(mw,effect.outD,effect.outR);
 
-			// 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;
+		return effect.inD + effect.inR + 1;
 	} //}}}
 
 	//{{{ compileImmediate() method
@@ -178,7 +162,96 @@ public abstract class FactorWordDefinition implements Constants
 	public int compileImmediate(CodeVisitor mw, FactorCompiler compiler,
 		RecursiveState recursiveCheck) throws Exception
 	{
-		throw new FactorCompilerException("Cannot compile " + word + " in immediate mode");
+		Cons definition = toList(compiler.getInterpreter());
+
+		if(definition == null)
+			return 0;
+
+		Cons endOfDocs = definition;
+		while(endOfDocs != null
+			&& endOfDocs.car instanceof FactorDocComment)
+			endOfDocs = endOfDocs.next();
+
+		// determine stack effect of this instantiation, and if its
+		// recursive.
+
+		FactorDataStack savedDatastack = (FactorDataStack)
+			compiler.datastack.clone();
+		FactorCallStack savedCallstack = (FactorCallStack)
+			compiler.callstack.clone();
+		StackEffect savedEffect = compiler.getStackEffect();
+
+		RecursiveState _recursiveCheck = (RecursiveState)
+			recursiveCheck.clone();
+		_recursiveCheck.last().effect = compiler.getStackEffect();
+		getStackEffect(_recursiveCheck,compiler);
+
+		boolean recursive = (_recursiveCheck.last().baseCase != null);
+
+		StackEffect effect = compiler.getStackEffect();
+
+		StackEffect immediateEffect = StackEffect.decompose(
+			savedEffect,compiler.getStackEffect());
+
+		// restore previous state.
+
+		FactorDataStack afterDatastack = (FactorDataStack)
+			compiler.datastack.clone();
+		FactorCallStack afterCallstack = (FactorCallStack)
+			compiler.callstack.clone();
+
+		compiler.datastack = (FactorDataStack)savedDatastack.clone();
+		compiler.callstack = (FactorCallStack)savedCallstack.clone();
+		compiler.effect = savedEffect;
+
+		if(!recursive)
+		{
+			// not recursive; inline.
+			mw.visitLabel(recursiveCheck.last().label);
+			return compiler.compile(endOfDocs,mw,recursiveCheck);
+		}
+		else
+		{
+			// recursive; must generate auxiliary method.
+			String method = compiler.auxiliary(word.name,
+				endOfDocs,immediateEffect,recursiveCheck);
+
+			mw.visitVarInsn(ALOAD,0);
+
+			compiler.generateArgs(mw,immediateEffect.inD,
+				immediateEffect.inR,null);
+
+			String signature = immediateEffect.getCorePrototype();
+
+			mw.visitMethodInsn(INVOKESTATIC,compiler.className,
+				method,signature);
+
+			compiler.generateReturn(mw,
+				immediateEffect.outD,
+				immediateEffect.outR);
+
+			mergeStacks(savedDatastack,afterDatastack,compiler.datastack);
+			mergeStacks(savedCallstack,afterCallstack,compiler.callstack);
+
+			return immediateEffect.inD + immediateEffect.inR + 1;
+		}
+	} //}}}
+
+	//{{{ mergeStacks() method
+	private void mergeStacks(FactorArrayStack s1, FactorArrayStack s2,
+		FactorArrayStack into)
+	{
+		for(int i = 0; i < s2.top; i++)
+		{
+			if(s1.top <= i)
+				break;
+
+			if(FactorLib.objectsEqual(s1.stack[i],
+				s2.stack[i]))
+			{
+				into.stack[i] = s1.stack[i];
+			}
+		}
 	} //}}}
 
 	//{{{ toString() method

factor/ReadTable.java

@@ -0,0 +1,85 @@
+/* :folding=explicit: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.
+ */
+
+package factor;
+
+/**
+ * Specifies how an input stream is to be split into words.
+ */
+public class ReadTable
+{
+	/**
+	 * Invalid character.
+	 */
+	public static final int INVALID = 0;
+
+	/**
+	 * Word break character.
+	 */
+	public static final int WHITESPACE = 1;
+
+	/**
+	 * Word character. Entire words are read at once.
+	 */
+	public static final int CONSTITUENT = 2;
+
+	/**
+	 * A single character to dispatch on.
+	 */
+	public static final int DISPATCH = 3;
+
+	/**
+	 * Escape the next character.
+	 */
+	public static final int SINGLE_ESCAPE = 4;
+
+	private int[] chars = new int[256];
+
+	//{{{ getCharacterType() method
+	public int getCharacterType(char ch)
+	{
+		if(ch >= 256)
+			return INVALID;
+		else
+			return chars[ch];
+	} //}}}
+
+	//{{{ setCharacterType() method
+	public void setCharacterType(char ch, int type)
+	{
+		chars[ch] = type;
+	} //}}}
+
+	//{{{ setCharacterRange() method
+	public void setCharacterRange(char ch1, char ch2, int type)
+	{
+		for(int i = ch1; i <= ch2; i++)
+			chars[i] = type;
+	} //}}}
+}

factor/boot.factor

@@ -25,90 +25,147 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-!!! The stack operators are defined using shuffle notation. This saves several
-!!! hundred lines of code!
+! Minimum amount of words needed to be able to read other
+! resources.
 
-~<< drop              A --             >>~
-~<< 2drop           A B --             >>~
-~<< dup               A -- A A         >>~
-~<< 2dup            A B -- A B A B     >>~
-~<< dupd            A B -- A A B       >>~
-~<< 2dupd       A B C D -- A B A B C D >>~
-~<< nip             A B -- B           >>~
-~<< 2nip        A B C D -- C D         >>~
-~<< nop                 --             >>~ ! Does nothing!
-~<< over            A B -- A B A       >>~
-~<< 2over       A B C D -- A B C D A B >>~
-~<< pick          A B C -- A B C A     >>~ ! Not the Forth pick!
-~<< rot           A B C -- B C A       >>~
-~<< 2rot    A B C D E F -- C D E F A B >>~
-~<< -rot          A B C -- C A B       >>~
-~<< 2-rot   A B C D E F -- E F A B C D >>~
-~<< swap            A B -- B A         >>~
-~<< 2swap       A B C D -- C D A B     >>~
-~<< swapd         A B C -- B A C       >>~
-~<< 2swapd  A B C D E F -- C D A B E F >>~
-~<< transp        A B C -- C B A       >>~    
-~<< 2transp A B C D E F -- E F C D A B >>~
-~<< tuck            A B -- B A B       >>~
-~<< 2tuck       A B C D -- C D A B C D >>~
+~<< dup A -- A A >>~
 
-~<< rdrop   r:A --                 >>~
-~<< rover   r:A r:B -- r:A r:B r:A >>~
-~<< >r        A -- r:A             >>~
-~<< 2>r     A B -- r:A r:B         >>~
-~<< r>      r:A -- A               >>~
-~<< 2r> r:A r:B -- A B             >>~
+: <breader> ( reader -- breader )
+    #! Wrap a Reader in a BufferedReader.
+    [ "java.io.Reader" ] "java.io.BufferedReader" jnew ;
 
-!!! 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.
-: <breader> (reader -- breader)
-    [ |java.io.Reader ] |java.io.BufferedReader jnew ;
+: <ireader> ( inputstream -- breader )
+    #! Wrap a InputStream in an InputStreamReader.
+    [ "java.io.InputStream" ] "java.io.InputStreamReader" jnew ;
 
-: <ireader> (inputstream -- breader)
-    [ |java.io.InputStream ] |java.io.InputStreamReader jnew ;
-
-: <rreader> (path -- inputstream)
-    |factor.FactorInterpreter
-    [ |java.lang.String ] |java.lang.Class |getResourceAsStream jinvoke
+: <rreader> ( path -- inputstream )
+    #! Create a Reader for reading the specified resource from
+    #! the classpath.
+    "factor.FactorInterpreter"
+    [ "java.lang.String" ]
+    "java.lang.Class" "getResourceAsStream" jinvoke
     <ireader> <breader> ;
 
-: parse* (filename reader -- list)
-    $interpreter
-    [ |java.lang.String |java.io.Reader |factor.FactorInterpreter ]
-    |factor.FactorParser jnew
-    [ ] |factor.FactorParser |parse jinvoke ;
+: parse* ( filename reader -- list )
+    #! Reads until end-of-file from the reader, building a parse
+    #! tree. The filename is used for error reporting.
+    interpreter
+    [
+        "java.lang.String"
+        "java.io.Reader"
+        "factor.FactorInterpreter"
+    ]
+    "factor.FactorReader" jnew
+    [ ] "factor.FactorReader" "parse" jinvoke ;
+
+: parse-resource ( resource -- list )
+    dup <rreader> parse* ;
+
+: run-resource ( path -- )
+    #! Reads and runs a source file from a resource path.
+    parse-resource call ;
+
+: ifte ( cond [ if true ] [ if false ] -- )
+    #! Two-way branching. The condition is a generalized
+    #! boolean; a value of f is taken to be false, any other
+    #! value is taken to be true. The condition is popped off
+    #! before either branch is taken.
+    #!
+    #! In order to compile, the two branches must have the same
+    #! stack effect difference.
+    ? call ;
+
+: callframe ( -- callframe )
+    ! Push the current callframe.
+    interpreter "factor.FactorInterpreter" "callframe" jvar$ ;
+
+: global ( -- namespace )
+    interpreter "factor.FactorInterpreter" "global" jvar$ ;
+
+: namespace ( -- namespace )
+    ! Push the current namespace.
+    callframe "factor.FactorCallFrame" "namespace" jvar$ ;
+
+: $ ( variable -- value )
+    #! Pushes the value of a variable in the current namespace.
+    namespace [ "java.lang.String" ] "factor.FactorNamespace"
+    "getVariable" jinvoke ;
+
+: word ( -- word )
+    ! Pushes most recently defined word.
+    global [ $last ] bind ;
+
+: inline ( -- )
+    #! Marks the most recently defined word to be inlined.
+    t word "factor.FactorWord" "inline" jvar@ ;
 
-: runResource (path --)
-    dup <rreader> parse* call ;
 !!!
 
-!!! Load the standard library.
-"/version.factor" runResource
+! Load the standard library.
 
-"/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
-"/factor/miscellaneous.factor" runResource
-"/factor/namespaces.factor"    runResource
-"/factor/network.factor"       runResource
-"/factor/parser.factor"        runResource
-"/factor/stream.factor"        runResource
-"/factor/prettyprint.factor"   runResource
-"/factor/random.factor"        runResource
-"/factor/strings.factor"       runResource
-"/factor/test/test.factor"     runResource
+$fasl [
+    "/factor/boot.fasl" run-resource
+    t @compile
+] [
+    "/factor/combinators.factor"       run-resource
+    "/factor/compiler.factor"          run-resource
+    "/factor/continuations.factor"     run-resource
+    "/factor/debugger.factor"          run-resource
+    "/factor/dictionary.factor"        run-resource
+    "/factor/examples.factor"          run-resource
+    "/factor/format.factor"            run-resource
+    "/factor/httpd.factor"             run-resource
+    "/factor/inspector.factor"         run-resource
+    "/factor/interpreter.factor"       run-resource
+    "/factor/irc.factor"               run-resource
+    "/factor/lists.factor"             run-resource
+    "/factor/math.factor"              run-resource
+    "/factor/miscellaneous.factor"     run-resource
+    "/factor/namespaces.factor"        run-resource
+    "/factor/network.factor"           run-resource
+    "/factor/parser.factor"            run-resource
+    "/factor/presentation.factor"      run-resource
+    "/factor/prettyprint.factor"       run-resource
+    "/factor/random.factor"            run-resource
+    "/factor/stack.factor"             run-resource
+    "/factor/stream.factor"            run-resource
+    "/factor/strings.factor"           run-resource
+    "/factor/trace.factor"             run-resource
+    "/factor/listener/listener.factor" run-resource
+    "/factor/test/test.factor"         run-resource
+
+    ! Inline some words defined before 'inline' was defined
+    #=callframe [ t @inline ] bind
+    #=global    [ t @inline ] bind
+    #=namespace [ t @inline ] bind
+    #=$         [ t @inline ] bind
+] ifte
+
+"/version.factor" run-resource
+
+! Initialize constants.
+
+"java.lang.System" "in"  jvar-static$ <ireader> <breader> @stdin
+"java.lang.System" "out" jvar-static$ <owriter> @stdout
+$stdin $stdout <char-stream> @stdio
+
+2.7182818284590452354 @e
+3.14159265358979323846 @pi
+
+1.0 0.0 / @inf
+-1.0 0.0 / @-inf
+
+"user.home" system-property @~
+"file.separator" system-property @/
 
 t @user-init
 
+! Parse command line arguments.
+
 : cli-param ( param -- )
+    #! Handle a command-line argument starting with '-' by
+    #! setting that variable to t, or if the argument is
+    #! prefixed with 'no-', setting the variable to f.
     dup "no-" str-head? dup [
         f s@ drop
     ] [
@@ -116,22 +173,29 @@ t @user-init
     ] ifte ;
 
 : cli-arg ( argument -- boolean )
+    #! Handle a command-line argument.
     "-" str-head? [ cli-param ] when* ;
 
 $args [ cli-arg ] each
 
-! Compile all words now
-$compile [
-    compile-all
+! Auto-dump if specified in command line
+$fasl not $auto-dump and [
+    t @compile
+    dump-boot-image
+    "Auto dump complete" print
+    f @interactive
 ] when
 
+! Run user init file if it exists
+
 $~ $/ ".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.
+! If we're run stand-alone, start the interpreter in the current
+! terminal.
 $interactive [
     [ @top-level-continuation ] callcc0
 

factor/combinators.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:
@@ -25,59 +25,22 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-: 2apply (x y [ code ] --)
-    ! First applies the code to x, then to y.
+: 2apply ( x y [ code ] -- )
+    #! First applies the code to x, then to y.
+    #!
+    #! If the quotation compiles, this combinator compiles.
     2dup 2>r
         nip call
     2r>
     call ;
 
-~<< binrecP
-    ! Put P on top of the data stack, save everything on callstack.
-    P T R1 R2 -- P r:P r:T r:R1 r:R2 >>~
-
-~<< binrecT
-    ! Put T on top of the data stack, discard all saved objects from
-    ! callstack.
-    r:P r:T r:R1 r:R2 -- T >>~
-
-~<< binrecR1
-    ! Put R1 on top of the data stack, retaining all saved objects on the
-    ! callstack.
-    r:P r:T r:R1 r:R2 -- R1 r:P r:T r:R1 r:R2 >>~
-
-~<< 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 >>~
-
-~<< 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.
-    r:Value2 r:P r:T r:R1 r:R2 -- Value2 P T R1 R2 r:R2 >>~
-
-: binrec ( [ P ] [ T ] [ R1 ] [ R2 ] -- ... )
-    ! Evaluate P. If it evaluates to t, evaluate T. Otherwise, evaluate R1,
-    ! which is expected to produce two values, recurse on each value, and
-    ! evaluate R2.
-    binrecP call [
-        binrecT call
-    ] [
-        binrecR1 call
-        ! R1 has now produced two values on top of the data stack.
-        ! Recurse twice.
-        binrec-left  binrec
-        binrec-right binrec
-        ! Now call R2.
-        r> call
-    ] ifte ;
-
-: compare (x y [if x < y] [if x = y] [if x > y] --)
+: compare ( x y [ if x < y ] [ if x = y ] [ if x > y ] -- )
     >=< call ;
 
 : cleave (x [ code1 ] [ code2 ] --)
-    ! Executes each quotation, with x on top of the stack.
+    #! Executes each quotation, with x on top of the stack.
+    #!
+    #! If the quotation compiles, this combinator compiles.
     >r
         over >r
             call
@@ -86,15 +49,24 @@
     call ;
 
 : cond ( x list -- )
-    ! The list is of this form:
-    ! [ [ condition 1 ] [ code 1 ]
-    !   [ condition 2 ] [ code 2 ]
-    !   ... ]
-    ! Each condition is evaluated in turn. If it returns true,
-    ! the code is evaluated. If it returns false, the next
-    ! condition is checked. Before evaluating each condition,
-    ! the top of the stack is duplicated. After the last
-    ! condition is evaluated, the top of the stack is popped.
+    #! The list is of this form:
+    #!
+    #! [ [ condition 1 ] [ code 1 ]
+    #!   [ condition 2 ] [ code 2 ]
+    #!   ... ]
+    #!
+    #! Each condition is evaluated in turn. If it returns true,
+    #! the code is evaluated. If it returns false, the next
+    #! condition is checked.
+    #!
+    #! Before evaluating each condition, the top of the stack is
+    #! duplicated. After the last condition is evaluated, the
+    #! top of the stack is popped.
+    #!
+    #! So each condition and code block must have stack effect:
+    #! ( X -- )
+    #!
+    #! This combinator will not compile.
     dup [
         uncons [ over [ call ] dip ] dip rot [
             car call
@@ -105,26 +77,32 @@
         2drop
     ] ifte ;
 
-: dip (a [ b ] -- b a)
-    ! Calls b as if b was not even present on the stack -- b has no way of
-    ! knowing that a even exists.
+: dip ( a [ b ] -- b a )
+    #! Call b as if b was not present on the stack.
+    #!
+    #! If the quotation compiles, this combinator compiles.
     swap
     >r
         call
     r> ;
 
 : 2dip (a b [ c ] -- c a b)
-    ! Calls c as if a and b were not even present on the stack -- c has no way
-    ! of knowing that a and b even exist.
+    #! Call c as if a and b were not present on the stack.
+    #!
+    #! If the quotation compiles, this combinator compiles.
     -rot
     2>r
         call
     2r> ;
 
-: each ( [ list ] [ code ] -- )
-    ! Applies the code to each element of the list.
+: each ( [ list ] [ quotation ] -- )
+    #! Push each element of a proper list in turn, and apply a
+    #! quotation to each element.
+    #!
+    #! In order to compile, the quotation must consume one more
+    #! value than it produces.
     over [
-        [ uncons ] dip tuck [ call ] 2dip each
+        >r uncons r> tuck 2>r call 2r> each
     ] [
         2drop
     ] ifte ;
@@ -135,86 +113,95 @@
 ~<< }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.
+: 2each ( [ list ] [ list ] [ quotation ] -- )
+    #! Push each pair of elements from 2 proper lists in turn,
+    #! applying a quotation each time.
     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
-    ! [ 0 5 ].
+: expand ( list -- list )
+    #! Evaluates a quotation on a new stack, and pushes the
+    #! reversed stack onto the original stack.
+    #!
+    #! This combinator will not compile.
     unit
     restack
         call
     unstack ;
 
 : forever ( code -- )
-    ! The code is evaluated forever. Typically, a continuation
-    ! is used to escape the infinite loop.
+    #! The code is evaluated in an infinite loop. Typically, a
+    #! continuation is used to escape the infinite loop.
+    #!
+    #! This combinator will not compile.
     dup dip forever ;
 
-: ifte (cond [if true] [if false] --)
-    ? call ;
+: inject ( list code -- list )
+    #! Applies the code to each item, returns a list that
+    #! contains the result of each application.
+    #!
+    #! In order to compile, the quotation must consume as many
+    #! values as it produces.
+    f transp [
+        ( accum code elem -- accum code )
+        transp over >r >r call r> cons r>
+    ] each drop nreverse ;
 
-: interleave ( X list -- ... )
-    ! Evaluate each element of the list with X on top of the
-    ! stack.
+: interleave ( X list -- )
+    #! Evaluate each element of the list with X on top of the
+    #! stack. When done, X is popped off the stack.
+    #!
+    #! To avoid unexpected results, each element of the list
+    #! must have stack effect ( X -- ).
+    #!
+    #! This combinator will not compile.
     dup [
         over [ unswons dip ] dip swap interleave
     ] [
         2drop
     ] ifte ;
 
-: linrec ( [ P ] [ T ] [ R1 ] [ R2 ] -- )
-    ! Evaluate P, if it pushes t, evaluate T. Otherwise, evaluate R1, recurse,
-    ! 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 [
-        rdrop r> call
-        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 ])
-    ! Applies the code to each item, returns a list that
-    ! contains the result of each application.
+: map ( [ items ] [ code ] -- [ mapping ] )
+    #! Applies the code to each item, returns a list that
+    #! contains the result of each application.
+    #!
+    #! This combinator will not compile.
     2list restack each unstack ;
 
 : 2map ( [ list ] [ list ] [ code ] -- [ mapping ] )
-    ! Applies the code to each pair of items, returns a list
-    ! that contains the result of each application.
+    #! Applies the code to each pair of items, returns a list
+    #! that contains the result of each application.
+    #!
+    #! This combinator will not compile.
     3list restack 2each unstack ;
 
-: subset ( list code -- list )
-    [ dupd call [ drop ] unless ] cons 2list
-    restack
-        each
-    unstack ;
+: subset-add ( car pred accum -- accum )
+    >r over >r call r> r> rot [ cons ] [ nip ] ifte ;
 
-: 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.
+: subset-iter ( accum list pred -- accum )
     over [
-        [ uncons ] dip tuck [
-            over list? [
-                2dup [ treerec ] 2dip
-            ] when call
-        ] 2dip treerec
-    ] [
+        >r unswons r> 2swap pick 2>r subset-add 2r> subset-iter
+	] [
         2drop
     ] ifte ;
 
+: subset ( list pred -- list )
+    #! Applies a quotation to each element of a list; all
+    #! elements for which the quotation returned a value other
+    #! than f are collected in a new list.
+    #!
+    #! In order to compile, the quotation must consume as many
+    #! values as it produces.
+    f -rot subset-iter nreverse ;
+
 : times (n [ code ] --)
-    ! Evaluates code n times.
+    #! Evaluate a quotation n times.
+    #!
+    #! In order to compile, the code must produce as many values
+    #! as it consumes.
     [
         over 0 >
     ] [
@@ -222,8 +209,11 @@
     ] while 2drop ;
 
 : times* (n [ code ] --)
-    ! Evaluates code n times, each time the index is pushed onto the stack.
-    ! The index ranges from 0 to n-1.
+    #! Evaluate a quotation n times, pushing the index at each
+    #! iteration. The index ranges from 0 to n-1.
+    #!
+    #! In order to compile, the code must consume one more value
+    #! than it produces.
     0 rot
     [
         2dup <
@@ -232,24 +222,45 @@
     ] while
     drop drop drop ;
 
-: unless (cond [if false] --)
+: unless ( cond [ if false ] -- )
+    #! Execute a quotation only when the condition is f. The
+    #! condition is popped off the stack.
+    #!
+    #! In order to compile, the quotation must consume as many
+    #! values as it produces.
     f swap ? call ;
 
-: unless* ( cond false -- )
-    ! If cond is f, pop it off the stack and evaluate false.
-    ! Otherwise, leave it on the stack.
+    : unless* ( cond [ if false ] -- )
+    #! If cond is f, pop it off the stack and evaluate the
+    #! quotation. Otherwise, leave cond on the stack.
+    #!
+    #! In order to compile, the quotation must consume one less
+    #! value than it produces.
     over [ drop ] [ nip call ] ifte ;
 
-: when (cond [if true] --)
+: when ( cond [ if true ] -- )
+    #! Execute a quotation only when the condition is not f. The
+    #! condition is popped off the stack.
+    #!
+    #! In order to compile, the quotation must consume as many
+    #! values as it produces.
     f ? call ;
 
 : when* (cond [ code ] --)
-    ! If the condition is true, it is left on the stack, and the code is
-    ! evaluated. Otherwise, the condition is popped off the stack.
+    #! If the condition is true, it is left on the stack, and
+    #! the quotation is evaluated. Otherwise, the condition is
+    #! popped off the stack.
+    #!
+    #! In order to compile, the quotation must consume one more
+    #! value than it produces.
     dupd [ drop ] ifte ;
 
-: while ( [ P ] [ R ] -- ... )
-    ! Evaluates P. If it leaves t on the stack, evaluate R, and recurse.
+: while ( [ P ] [ R ] -- )
+    #! Evaluate P. If it leaves t on the stack, evaluate R, and
+    #! recurse.
+    #!
+    #! In order to compile, the stack effect of P * ( X -- ) * R
+    #! must consume as many values as it produces.
     >r dup >r call [
         rover r> call r> r> while
     ] [

factor/compiler.factor

@@ -0,0 +1,102 @@
+!: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.
+
+: asm ( word -- )
+    #! Prints JVM bytecode disassembly of a compiled word.
+    intern [ $asm ] bind dup [
+        print
+    ] [
+        drop "Not a compiled word." print
+    ] ifte ;
+
+: balance ( code -- effect )
+    #! Push stack effect of a quotation.
+    no-name effect ;
+
+: balance>list ( quotation -- list )
+    balance effect>list ;
+
+: compile* ( word -- )
+    interpreter swap
+    [ "factor.FactorInterpreter" ] "factor.FactorWord" "compile"
+    jinvoke ;
+
+: compile ( word -- )
+    #! Compile a word.
+    dup worddef compiled? [
+        drop
+    ] [
+        intern compile*
+    ] ifte ;
+
+: compile-all ( -- )
+    #! Compile all words.
+    words [ compile ] each ;
+
+: words-not-primitives ( -- list )
+    words [ worddef primitive? not ] subset ;
+
+: dump-image ( -- )
+    "! This is an automatically-generated fastload image." print
+    words-not-primitives [
+        dup worddef dup compiled? [
+            swap >str .
+            dup class-of .
+            "define" print
+            word-of-worddef [ $inline ] bind
+            [ "inline" print ] when
+        ] [
+            drop see
+        ] ifte
+    ] each ;
+
+: dump-image-file ( file -- )
+    <namespace> [
+        <filecw> @stdio
+        dump-image
+        $stdio fclose
+    ] bind ;
+
+: dump-boot-image ( -- )
+    t @dump
+    compile-all
+    "factor/boot.fasl" dump-image-file
+    "Now, restart Factor without the -no-fasl switch." print
+    f @dump ;
+
+: effect ( word -- effect )
+    #! Push stack effect of a 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 ;

factor/compiler/AuxiliaryQuotation.java

@@ -0,0 +1,126 @@
+/* :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 org.objectweb.asm.*;
+
+class AuxiliaryQuotation
+{
+	private String method;
+	private FactorDataStack datastack;
+	private FactorCallStack callstack;
+	private Cons code;
+	private StackEffect effect;
+	private RecursiveState recursiveCheck;
+
+	//{{{ mungeFlowObject() method
+	private FlowObject mungeFlowObject(int base, int index, FlowObject flow,
+		FactorCompiler compiler, RecursiveState recursiveCheck)
+		throws Exception
+	{
+		if(flow instanceof CompiledList)
+		{
+			return new CompiledListResult(index + base,
+				(Cons)flow.getLiteral(),compiler,
+				((CompiledList)flow).recursiveCheck);
+		}
+		else if(flow instanceof Null)
+		{
+			return new CompiledListResult(index + base,
+				(Cons)flow.getLiteral(),
+				compiler,recursiveCheck);
+		}
+		else
+		{
+			return new Result(index + base,compiler,recursiveCheck);
+		}
+	} //}}}
+
+	//{{{ AuxiliaryQuotation constructor
+	AuxiliaryQuotation(String method,
+		FactorDataStack datastack,
+        	FactorCallStack callstack,
+        	Cons code,
+        	StackEffect effect,
+		FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+		throws Exception
+	{
+		this.method = method;
+		this.datastack = datastack;
+		this.callstack = callstack;
+		this.code = code;
+		this.effect = effect;
+		this.recursiveCheck = new RecursiveState(recursiveCheck);
+
+		System.arraycopy(datastack.stack,datastack.top - effect.inD,
+			datastack.stack,0,effect.inD);
+		for(int i = 0; i < effect.inD; i++)
+		{
+			int index = datastack.top - effect.inD + i;
+			FlowObject flow = (FlowObject)datastack.stack[index];
+			datastack.stack[index] = mungeFlowObject(1,index,flow,
+				compiler,recursiveCheck);
+		}
+
+		System.arraycopy(callstack.stack,callstack.top - effect.inR,
+			callstack.stack,0,effect.inD);
+		for(int i = 0; i < effect.inR; i++)
+		{
+			int index = callstack.top - effect.inR + i;
+			FlowObject flow = (FlowObject)callstack.stack[index];
+			callstack.stack[index] = mungeFlowObject(1 + effect.inD,
+				index,flow,compiler,recursiveCheck);
+		}
+	} //}}}
+
+	//{{{ compile() method
+	String compile(FactorCompiler compiler, ClassWriter cw,
+		FactorWord word)
+		throws Exception
+	{
+		// generate core
+		compiler.init(1,effect.inD,effect.inR,method);
+		compiler.datastack = datastack;
+		compiler.callstack = callstack;
+		//compiler.produce(compiler.datastack,effect.inD);
+		// important: this.recursiveCheck due to
+		// lexically-scoped recursion issues
+		return compiler.compile(code,cw,method,effect,
+			new RecursiveState(this.recursiveCheck));
+	} //}}}
+
+	//{{{ toString() method
+	public String toString()
+	{
+		return method + effect;
+	} //}}}
+}

factor/compiler/CompiledChoice.java

@@ -86,8 +86,6 @@ public class CompiledChoice extends FlowObject implements Constants
 	public void getStackEffect(RecursiveState recursiveCheck)
 		throws Exception
 	{
-		StackEffect onEntry = recursiveCheck.last().effect;
-
 		FactorDataStack datastackCopy = (FactorDataStack)
 			compiler.datastack.clone();
 		FactorCallStack callstackCopy = (FactorCallStack)
@@ -97,7 +95,6 @@ public class CompiledChoice extends FlowObject implements Constants
 
 		StackEffect te = compiler.getStackEffectOrNull(
 			t,recursiveCheck,false);
-		//System.err.println("te=" + te);
 
 		/** Other branch. */
 		FactorDataStack obDatastack = compiler.datastack;
@@ -112,9 +109,7 @@ public class CompiledChoice extends FlowObject implements Constants
 
 		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();
@@ -131,7 +126,6 @@ public class CompiledChoice extends FlowObject implements Constants
 			t.getStackEffect(recursiveCheck);
 			te = compiler.getStackEffect();
 			//te = StackEffect.decompose(onEntry,te);
-			//System.err.println("te=" + te);
 		}
 		else if(fe == null && te != null)
 		{
@@ -149,7 +143,6 @@ public class CompiledChoice extends FlowObject implements Constants
 			f.getStackEffect(recursiveCheck);
 			fe = compiler.getStackEffect();
 			//fe = StackEffect.decompose(onEntry,te);
-			//System.err.println("fe=" + fe);
 		}
 
 		if(te == null || fe == null)
@@ -173,7 +166,7 @@ public class CompiledChoice extends FlowObject implements Constants
 		// branch and don't discard those.
 		int highestEqual = 0;
 
-		for(highestEqual = 0; highestEqual < fe.outD; highestEqual++)
+		/* for(highestEqual = 0; highestEqual < fe.outD; highestEqual++)
 		{
 			Object o1 = obDatastack.stack[
 				obDatastack.top - highestEqual - 1];
@@ -181,24 +174,20 @@ public class CompiledChoice extends FlowObject implements Constants
 				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)
-		);
+		int outD = Math.max(te.outD,fe.outD);
+		int outR = Math.max(te.outR,fe.outR);
+
+		compiler.consume(compiler.datastack,outD);
+		compiler.produce(compiler.datastack,outD);
+		compiler.consume(compiler.callstack,outR);
+		compiler.produce(compiler.callstack,outR);
 	} //}}}
 
 	//{{{ compileCallTo() method
@@ -255,7 +244,7 @@ public class CompiledChoice extends FlowObject implements Constants
 				t.compileCallTo(mw,recursiveCheck));
 
 			maxJVMStack = Math.max(maxJVMStack,
-				normalizeStacks(mw));
+				compiler.normalizeStacks(mw));
 
 			compiler.datastack = datastackCopy;
 			compiler.callstack = callstackCopy;
@@ -266,7 +255,7 @@ public class CompiledChoice extends FlowObject implements Constants
 				f.compileCallTo(mw,recursiveCheck));
 
 			maxJVMStack = Math.max(maxJVMStack,
-				normalizeStacks(mw));
+				compiler.normalizeStacks(mw));
 
 			mw.visitLabel(endl);
 		}
@@ -274,43 +263,12 @@ public class CompiledChoice extends FlowObject implements Constants
 		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)
+		return FactorReader.unparseObject(f)
 			+ " "
-			+ FactorParser.unparse(t)
+			+ FactorReader.unparseObject(t)
 			+ " ? call";
 	} //}}}
 }

factor/compiler/CompiledDefinition.java

@@ -40,30 +40,31 @@ import org.objectweb.asm.*;
 public abstract class CompiledDefinition
 	extends FactorWordDefinition
 {
-	private StackEffect effect;
-	private Cons definition;
-
 	//{{{ CompiledDefinition constructor
-	public CompiledDefinition(FactorWord word, StackEffect effect,
-		Cons definition)
+	public CompiledDefinition(FactorWord word)
 	{
 		super(word);
-		this.effect = effect;
-		this.definition = definition;
 	} //}}}
 
-	//{{{ getStackEffect() method
-	public void getStackEffect(RecursiveState recursiveCheck,
-		FactorCompiler compiler)
+	//{{{ create() method
+	public static CompiledDefinition create(FactorInterpreter interp,
+		FactorWord word, Class compiledWordClass)
+		throws Exception
 	{
-		compiler.apply(effect);
-	} //}}}
+		Method setFields = compiledWordClass.getMethod(
+			"setFields",
+			new Class[] {
+			FactorInterpreter.class
+			});
+		setFields.invoke(null,new Object[] { interp });
 
-	//{{{ toList() method
-	public Cons toList()
-	{
-		return new Cons(word,new Cons(effect,
-			new Cons(new FactorWord("\n"),
-			definition)));
+		Constructor constructor = compiledWordClass
+			.getConstructor(
+			new Class[] {
+			FactorWord.class
+			});
+
+		return (CompiledDefinition)constructor.newInstance(
+			new Object[] { word });
 	} //}}}
 }

factor/compiler/CompiledList.java

@@ -37,7 +37,7 @@ import org.objectweb.asm.*;
 public class CompiledList extends FlowObject implements Constants
 {
 	private Cons quotation;
-	private RecursiveState recursiveCheck;
+	protected RecursiveState recursiveCheck;
 
 	CompiledList(Cons quotation, FactorCompiler compiler,
 		RecursiveState recursiveCheck)
@@ -70,7 +70,8 @@ public class CompiledList extends FlowObject implements Constants
 	{
 		// important: this.recursiveCheck due to
 		// lexically-scoped recursion issues
-		compiler.getStackEffect(quotation,this.recursiveCheck);
+		compiler.getStackEffect(quotation,new RecursiveState(
+			this.recursiveCheck));
 	}
 
 	/**
@@ -83,7 +84,8 @@ public class CompiledList extends FlowObject implements Constants
 	{
 		// important: this.recursiveCheck due to
 		// lexically-scoped recursion issues
-		return compiler.compile(quotation,mw,this.recursiveCheck);
+		return compiler.compile(quotation,mw,new RecursiveState(
+			this.recursiveCheck));
 	}
 
 	public boolean equals(Object o)
@@ -93,6 +95,8 @@ public class CompiledList extends FlowObject implements Constants
 			CompiledList c = (CompiledList)o;
 			return FactorLib.objectsEqual(c.quotation,quotation);
 		}
+		else if(o instanceof Null)
+			return quotation == null;
 		else
 			return false;
 	}

factor/compiler/CompiledListResult.java

@@ -0,0 +1,63 @@
+/* :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 CompiledListResult extends CompiledList implements Constants
+{
+	private int local;
+
+	CompiledListResult(int local, Cons quotation,
+		FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+	{
+		super(quotation,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);
+	}
+}

factor/compiler/FactorCompiler.java

@@ -41,18 +41,24 @@ public class FactorCompiler implements Constants
 
 	public final FactorWord word;
 	public final String className;
+	public String method;
 
 	private int base;
 	private int max;
+	private int allotD;
+	private int allotR;
 
 	public FactorDataStack datastack;
 	public FactorCallStack callstack;
 
 	private int literalCount;
 
-	private Map literals = new HashMap();
+	private Map literals;
 
-	public StackEffect effect = new StackEffect();
+	public StackEffect effect;
+
+	private Cons aux;
+	private int auxCount;
 
 	//{{{ FactorCompiler constructor
 	/**
@@ -60,7 +66,8 @@ public class FactorCompiler implements Constants
 	 */
 	public FactorCompiler()
 	{
-		this(null,null,null,0,0);
+		this(null,null,null);
+		init(0,0,0,null);
 	} //}}}
 
 	//{{{ FactorCompiler constructor
@@ -68,24 +75,55 @@ public class FactorCompiler implements Constants
 	 * For compiling.
 	 */
 	public FactorCompiler(FactorInterpreter interp,
-		FactorWord word, String className,
-		int base, int allot)
+		FactorWord word, String className)
 	{
 		this.interp = interp;
 
 		this.word = word;
 		this.className = className;
 
-		this.base = base;
+		literals = new HashMap();
+
 		datastack = new FactorDataStack();
 		callstack = new FactorCallStack();
+	} //}}}
 
-		for(int i = 0; i < allot; i++)
-		{
+	//{{{ getInterpreter() method
+	public FactorInterpreter getInterpreter()
+	{
+		return interp;
+	} //}}}
+
+	//{{{ init() method
+	public void init(int base, int allotD, int allotR, String method)
+	{
+		effect = new StackEffect();
+
+		this.base = base;
+
+		datastack.top = 0;
+		callstack.top = 0;
+
+		for(int i = 0; i < allotD; i++)
 			datastack.push(new Result(base + i,this,null));
-		}
 
-		max = base + allot;
+		for(int i = 0; i < allotR; i++)
+			datastack.push(new Result(base + allotD + i,this,null));
+
+		max = base + allotD + allotR;
+
+		this.allotD = allotD;
+		this.allotR = allotR;
+		effect.inD = allotD;
+		effect.inR = allotR;
+
+		this.method = method;
+	} //}}}
+
+	//{{{ getAllotedEffect() method
+	public StackEffect getAllotedEffect()
+	{
+		return new StackEffect(allotD,allotR,0,0);
 	} //}}}
 
 	//{{{ ensure() method
@@ -110,8 +148,9 @@ public class FactorCompiler implements Constants
 				count - top,top);
 			for(int i = 0; i < count - top; i++)
 			{
+				int local = allocate();
 				stack.stack[i] = new Result(
-					allocate(),this,null);
+					local,this,null);
 			}
 			stack.top = count;
 		}
@@ -128,7 +167,10 @@ public class FactorCompiler implements Constants
 	public void produce(FactorArrayStack stack, int count)
 	{
 		for(int i = 0; i < count; i++)
-			stack.push(new Result(allocate(),this,null));
+		{
+			int local = allocate();
+			stack.push(new Result(local,this,null));
+		}
 	} //}}}
 
 	//{{{ apply() method
@@ -157,21 +199,7 @@ public class FactorCompiler implements Constants
 		{
 			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;
-			}
+				getStackEffectOfWord((FactorWord)obj,recursiveCheck);
 			else
 				pushLiteral(obj,recursiveCheck);
 
@@ -179,6 +207,29 @@ public class FactorCompiler implements Constants
 		}
 	} //}}}
 
+	//{{{ getStackEffectOfWord() method
+	private void getStackEffectOfWord(FactorWord word,
+		RecursiveState recursiveCheck)
+		throws Exception
+	{
+		RecursiveForm rec = recursiveCheck.get(word);
+		if(rec == null)
+		{
+			recursiveCheck.add(word,getStackEffect(),null,null);
+		}
+		else
+			rec.active = true;
+
+		word.def.getStackEffect(recursiveCheck,this);
+
+		if(rec == null)
+		{
+			recursiveCheck.remove(word);
+		}
+		else
+			rec.active = false;
+	} //}}}
+
 	//{{{ getDisassembly() method
 	protected String getDisassembly(TraceCodeVisitor mw)
 	{
@@ -192,11 +243,26 @@ public class FactorCompiler implements Constants
 		return buf.toString();
 	} //}}}
 
+	//{{{ compileCore() method
+	public String compileCore(Cons definition, ClassWriter cw,
+		StackEffect effect, RecursiveState recursiveCheck)
+		throws Exception
+	{
+		RecursiveForm last = recursiveCheck.last();
+		last.method = "core";
+		last.className = className;
+
+		String asm = compile(definition,cw,"core",
+			effect,recursiveCheck);
+
+		return asm;
+	} //}}}
+
 	//{{{ compile() method
 	/**
 	 * Compiles a method and returns the disassembly.
 	 */
-	public String compile(Cons definition, ClassWriter cw, String className,
+	public String compile(Cons definition, ClassWriter cw,
 		String methodName, StackEffect effect,
 		RecursiveState recursiveCheck)
 		throws Exception
@@ -208,18 +274,28 @@ public class FactorCompiler implements Constants
 
 		TraceCodeVisitor mw = new TraceCodeVisitor(_mw);
 
+		Label start = recursiveCheck.last().label;
+
+		mw.visitLabel(start);
+
 		int maxJVMStack = compile(definition,mw,
 			recursiveCheck);
 
+		Label end = new Label();
+
 		// special case where return value is passed on
 		// JVM operand stack
-		if(effect.outD == 0)
+
+		// note: in each branch, must visit end label before RETURN!
+		if(effect.outD == 0 && effect.outR == 0)
 		{
+			mw.visitLabel(end);
 			mw.visitInsn(RETURN);
 		}
-		else if(effect.outD == 1)
+		else if(effect.outD == 1 && effect.outR == 0)
 		{
 			pop(mw);
+			mw.visitLabel(end);
 			mw.visitInsn(ARETURN);
 			maxJVMStack = Math.max(maxJVMStack,1);
 		}
@@ -247,13 +323,58 @@ public class FactorCompiler implements Constants
 
 			datastack.top = 0;
 
+			// store callstack in a local
+			mw.visitVarInsn(ALOAD,0);
+			mw.visitFieldInsn(GETFIELD,
+				"factor/FactorInterpreter",
+				"callstack",
+				"Lfactor/FactorCallStack;");
+			int callstackLocal = allocate();
+			mw.visitVarInsn(ASTORE,callstackLocal);
+
+			for(int i = 0; i < callstack.top; i++)
+			{
+				mw.visitVarInsn(ALOAD,callstackLocal);
+				((FlowObject)callstack.stack[i])
+					.generate(mw);
+				mw.visitMethodInsn(INVOKEVIRTUAL,
+					"factor/FactorCallStack",
+					"push",
+					"(Ljava/lang/Object;)V");
+			}
+
+			callstack.top = 0;
+
+			mw.visitLabel(end);
 			mw.visitInsn(RETURN);
 
 			maxJVMStack = Math.max(2,maxJVMStack);
 		}
 
+		// Now compile exception handler.
+
+		Label target = new Label();
+		mw.visitLabel(target);
+
+		mw.visitVarInsn(ASTORE,1);
+		mw.visitVarInsn(ALOAD,0);
+		mw.visitFieldInsn(GETSTATIC,className,literal(
+			recursiveCheck.last().word),
+			"Ljava/lang/Object;");
+		mw.visitTypeInsn(CHECKCAST,"factor/FactorWord");
+		mw.visitVarInsn(ALOAD,1);
+
+		mw.visitMethodInsn(INVOKEVIRTUAL,"factor/FactorInterpreter",
+			"compiledException",
+			"(Lfactor/FactorWord;Ljava/lang/Throwable;)V");
+
+		mw.visitVarInsn(ALOAD,1);
+		mw.visitInsn(ATHROW);
+
+		maxJVMStack = Math.max(maxJVMStack,3);
 		mw.visitMaxs(maxJVMStack,max);
 
+		mw.visitTryCatchBlock(start,end,target,"java/lang/Throwable");
 		return getDisassembly(mw);
 	} //}}}
 
@@ -271,9 +392,42 @@ public class FactorCompiler implements Constants
 			Object obj = definition.car;
 			if(obj instanceof FactorWord)
 			{
-				maxJVMStack = Math.max(maxJVMStack,
-					compileWord((FactorWord)obj,mw,
-					recursiveCheck));
+				FactorWord w = (FactorWord)obj;
+
+				RecursiveForm rec = recursiveCheck.get(w);
+
+				try
+				{
+					boolean recursiveCall;
+					if(rec == null)
+					{
+						recursiveCall = false;
+						recursiveCheck.add(w,
+							new StackEffect()/* getStackEffect() */,
+							className,"core");
+						recursiveCheck.last().tail = false;
+					}
+					else
+					{
+						recursiveCall = true;
+						rec.active = true;
+						rec.tail = (definition.cdr == null);
+					}
+
+					maxJVMStack = Math.max(maxJVMStack,
+						compileWord((FactorWord)obj,mw,
+						recursiveCheck,recursiveCall));
+				}
+				finally
+				{
+					if(rec == null)
+						recursiveCheck.remove(w);
+					else
+					{
+						rec.active = false;
+						rec.tail = false;
+					}
+				}
 			}
 			else
 				pushLiteral(obj,recursiveCheck);
@@ -286,55 +440,32 @@ public class FactorCompiler implements Constants
 
 	//{{{ compileWord() method
 	private int compileWord(FactorWord w, CodeVisitor mw,
-		RecursiveState recursiveCheck) throws Exception
+		RecursiveState recursiveCheck,
+		boolean recursiveCall) throws Exception
 	{
-		RecursiveForm rec = recursiveCheck.get(w);
+		FactorWordDefinition d = w.def;
 
-		try
+		if(!recursiveCall)
 		{
-			boolean recursiveCall;
-			if(rec == null)
+			StackEffect effect = getStackEffectOrNull(d);
+			if(effect == null)
 			{
-				recursiveCall = false;
-				recursiveCheck.add(w,null);
+				return d.compileImmediate(mw,this,
+					recursiveCheck);
 			}
-			else
+			else if(d instanceof FactorCompoundDefinition)
 			{
-				recursiveCall = true;
-				rec.active = true;
-			}
-
-			FactorWordDefinition d = w.def;
-
-			if(!recursiveCall)
-			{
-				StackEffect effect = getStackEffectOrNull(d);
-				if(effect == null)
+				w.compile(interp,recursiveCheck);
+				if(d == w.def)
 				{
-					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;
+					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;
-		}
+		w.compileRef = true;
+		return d.compileCallTo(mw,this,recursiveCheck);
 	} //}}}
 
 	//{{{ push() method
@@ -481,25 +612,209 @@ public class FactorCompiler implements Constants
 		return "literal_" + literal;
 	} //}}}
 
+	//{{{ auxiliary() method
+	public String auxiliary(String word, Cons code, StackEffect effect,
+		RecursiveState recursiveCheck) throws Exception
+	{
+		FactorDataStack savedDatastack = (FactorDataStack)
+			datastack.clone();
+		FactorCallStack savedCallstack = (FactorCallStack)
+			callstack.clone();
+
+		String method = "aux_" + FactorJava.getSanitizedName(word) + "_"
+			+ (auxCount++);
+
+		recursiveCheck.last().method = method;
+		aux = new Cons(new AuxiliaryQuotation(
+			method,savedDatastack,savedCallstack,
+			code,effect,this,recursiveCheck),aux);
+
+		return method;
+	} //}}}
+
+	//{{{ generateAuxiliary() method
+	public String generateAuxiliary(ClassWriter cw)
+		throws Exception
+	{
+		StringBuffer asm = new StringBuffer();
+		while(aux != null)
+		{
+			AuxiliaryQuotation q = (AuxiliaryQuotation)aux.car;
+			aux = aux.next();
+			asm.append(q);
+			asm.append('\n');
+			asm.append(q.compile(this,cw,word));
+		}
+		return asm.toString();
+	} //}}}
+
+	//{{{ normalizeStacks() method
+	public int normalizeStacks(CodeVisitor mw)
+	{
+		int datastackTop = datastack.top;
+		datastack.top = 0;
+		int callstackTop = callstack.top;
+		callstack.top = 0;
+
+		localsToStack(callstack,callstackTop,mw);
+		localsToStack(datastack,datastackTop,mw);
+		stackToLocals(datastack,datastackTop,mw);
+		stackToLocals(callstack,callstackTop,mw);
+
+		return datastackTop + callstackTop;
+	} //}}}
+
+	//{{{ localsToStack() method
+	private void localsToStack(FactorArrayStack stack, int top,
+		CodeVisitor mw)
+	{
+		for(int i = top - 1; i >= 0; i--)
+		{
+			FlowObject obj = (FlowObject)stack.stack[i];
+			obj.generate(mw);
+		}
+	} //}}}
+
+	//{{{ stackToLocals() method
+	private void stackToLocals(FactorArrayStack stack, int top,
+		CodeVisitor mw)
+	{
+		for(int i = 0; i < top; i++)
+		{
+			int local = allocate();
+			stack.push(new Result(local,this,null));
+			mw.visitVarInsn(ASTORE,local);
+		}
+	} //}}}
+
+	//{{{ 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 = allocate();
+			stack.push(new Result(local,this,null));
+			mw.visitVarInsn(ASTORE,local);
+		}
+	} //}}}
+
 	//{{{ 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)
+	public void generateArgs(CodeVisitor mw, int inD, int inR, Class[] args)
 		throws Exception
 	{
-		for(int i = 0; i < num; i++)
+		for(int i = 0; i < inD; i++)
 		{
 			FlowObject obj = (FlowObject)datastack.stack[
-				datastack.top - num + i];
+				datastack.top - inD + i];
 			obj.generate(mw);
 			if(args != null)
 				FactorJava.generateFromConversion(mw,args[i]);
 		}
 
-		datastack.top -= num;
+		datastack.top -= inD;
+
+		for(int i = 0; i < inR; i++)
+		{
+			FlowObject obj = (FlowObject)callstack.stack[
+				callstack.top - inR + i];
+			obj.generate(mw);
+			if(args != null)
+				FactorJava.generateFromConversion(mw,args[i]);
+		}
+
+		callstack.top -= inR;
+	} //}}}
+
+	//{{{ generateReturn() method
+	public void generateReturn(CodeVisitor mw, int outD, int outR)
+	{
+		if(outD == 0 && outR == 0)
+		{
+			// do nothing
+		}
+		else if(outD == 1 && outR == 0)
+		{
+			push(mw);
+		}
+		else
+		{
+			// transfer from data stack to JVM locals
+
+			// allocate the appropriate number of locals
+
+			if(outD != 0)
+			{
+				produce(datastack,outD);
+
+				// store the datastack instance somewhere
+				mw.visitVarInsn(ALOAD,0);
+				mw.visitFieldInsn(GETFIELD,
+					"factor/FactorInterpreter",
+					"datastack",
+					"Lfactor/FactorDataStack;");
+				int datastackLocal = allocate();
+				mw.visitVarInsn(ASTORE,datastackLocal);
+	
+				// put all elements from the real datastack
+				// into locals
+				for(int i = 0; i < 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());
+				}
+			}
+
+			if(outR != 0)
+			{
+				produce(callstack,outR);
+
+				mw.visitVarInsn(ALOAD,0);
+				mw.visitFieldInsn(GETFIELD,
+					"factor/FactorInterpreter",
+					"callstack",
+					"Lfactor/FactorCallStack;");
+				int callstackLocal = allocate();
+				mw.visitVarInsn(ASTORE,callstackLocal);
+
+				// put all elements from the real callstack
+				// into locals
+				for(int i = 0; i < outR; i++)
+				{
+					mw.visitVarInsn(ALOAD,callstackLocal);
+					mw.visitMethodInsn(INVOKEVIRTUAL,
+						"factor/FactorCallStack",
+						"pop",
+						"()Ljava/lang/Object;");
+	
+					Result destination = (Result)
+						callstack.stack[
+						callstack.top - i - 1];
+	
+					mw.visitVarInsn(ASTORE,destination.getLocal());
+				}
+			}
+		}
 	} //}}}
 
 	//{{{ generateFields() method
@@ -511,12 +826,10 @@ public class FactorCompiler implements Constants
 			cw.visitField(ACC_PUBLIC | ACC_STATIC,"literal_" + i,
 				"Ljava/lang/Object;",null,null);
 		}
-	} //}}}
 
-	//{{{ setFields() method
-	public void setFields(Class def)
-		throws Exception
-	{
+		CodeVisitor mw = cw.visitMethod(ACC_PUBLIC | ACC_STATIC,
+			"setFields","(Lfactor/FactorInterpreter;)V",null,null);
+
 		Iterator entries = literals.entrySet().iterator();
 		while(entries.hasNext())
 		{
@@ -524,9 +837,28 @@ public class FactorCompiler implements Constants
 			Object literal = entry.getKey();
 			int index = ((Integer)entry.getValue()).intValue();
 
-			Field f = def.getField("literal_" + index);
-			f.set(null,literal);
+			generateParse(mw,literal,0);
+			mw.visitFieldInsn(PUTSTATIC,
+				className,
+				"literal_" + index,
+				"Ljava/lang/Object;");
 		}
+
+		mw.visitInsn(RETURN);
+
+		mw.visitMaxs(2,1);
+	} //}}}
+
+	//{{{ generateParse() method
+	public void generateParse(CodeVisitor mw, Object obj, int interpLocal)
+	{
+		mw.visitLdcInsn(FactorReader.unparseObject(obj));
+		mw.visitVarInsn(ALOAD,interpLocal);
+		mw.visitMethodInsn(INVOKESTATIC,
+			"factor/FactorReader",
+			"parseObject",
+			"(Ljava/lang/String;Lfactor/FactorInterpreter;)"
+			+ "Ljava/lang/Object;");
 	} //}}}
 
 	//{{{ getStackEffectOrNull() method

factor/compiler/FlowObject.java

@@ -34,7 +34,7 @@ import java.lang.reflect.*;
 import java.util.*;
 import org.objectweb.asm.*;
 
-public abstract class FlowObject
+public abstract class FlowObject implements FactorExternalizable
 {
 	protected FactorCompiler compiler;
 	protected RecursiveForm word;
@@ -92,7 +92,7 @@ public abstract class FlowObject
 	{
 		try
 		{
-			return FactorParser.unparse(getLiteral());
+			return FactorReader.unparseObject(getLiteral());
 		}
 		catch(Exception e)
 		{

factor/compiler/Null.java

@@ -71,6 +71,11 @@ public class Null extends FlowObject implements Constants
 
 	public boolean equals(Object o)
 	{
-		return (o instanceof Null);
+		if(o instanceof Null)
+			return true;
+		else if(o instanceof CompiledList)
+			return ((CompiledList)o).getLiteral() == null;
+		else
+			return false;
 	}
 }

factor/compiler/RecursiveForm.java

@@ -29,25 +29,80 @@
 
 package factor.compiler;
 
-import factor.FactorWord;
+import factor.*;
+import org.objectweb.asm.Label;
 
-public class RecursiveForm
+public class RecursiveForm implements PublicCloneable
 {
+	/**
+	 * Word represented by this form.
+	 */
 	public final FactorWord word;
+
+	/**
+	 * The effect on entry into this form.
+	 * (?) only for immediates
+	 */
 	public StackEffect effect;
+
+	/**
+	 * Base case of recursive form. This is left-composed with the
+	 * effect above.
+	 */
 	public StackEffect baseCase;
+
+	/**
+	 * Is the word being compiled right now?
+	 */
 	public boolean active;
 
-	public RecursiveForm(FactorWord word, StackEffect effect)
+	/**
+	 * Name of class to call to recurse.
+	 */
+	public String className;
+
+	/**
+	 * Name of method to call to recurse.
+	 */
+	public String method;
+
+	/**
+	 * Are we compiling the last factor in the word right now?
+	 */
+	public boolean tail;
+
+	/**
+	 * A label to jump to the beginning of the definition.
+	 */
+	public Label label = new Label();
+
+	public RecursiveForm(FactorWord word, StackEffect effect,
+		String className, String method)
 	{
 		this.word = word;
 		this.effect = effect;
+		this.className = className;
+		this.method = method;
+	}
+
+	public RecursiveForm(RecursiveForm form)
+	{
+		this.word = form.word;
+		this.effect = form.effect;
+		this.baseCase = form.baseCase;
+		this.effect = form.effect;
+		this.className = form.className;
+		this.method = form.method;
 	}
 
 	public String toString()
 	{
-		return word.toString() + (
-			baseCase == null
-			? "" : "-" + baseCase);
+		return word.toString() + "-" + baseCase + "-" + effect + "-"
+			+ active + "-" + className + "." + method;
+	}
+
+	public Object clone()
+	{
+		return new RecursiveForm(this);
 	}
 }

factor/compiler/RecursiveState.java

@@ -31,7 +31,7 @@ package factor.compiler;
 
 import factor.*;
 
-public class RecursiveState
+public class RecursiveState implements PublicCloneable
 {
 	private Cons words;
 
@@ -43,20 +43,23 @@ public class RecursiveState
 	//{{{ RecursiveState constructor
 	public RecursiveState(RecursiveState clone)
 	{
-		words = clone.words;
+		if(clone.words != null)
+			words = clone.words;
 	} //}}}
 
 	//{{{ add() method
-	public void add(FactorWord word, StackEffect effect)
+	public void add(FactorWord word, StackEffect effect,
+		String className, String method)
 	{
-		//System.err.println(this + ": adding " + word);
-		//System.err.println(words);
+		//System.err.println(this + ": adding " + word + "," + effect);
 		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);
+		words = new Cons(new RecursiveForm(
+			word,effect,className,method),
+			words);
 	} //}}}
 
 	//{{{ remove() method
@@ -93,6 +96,12 @@ public class RecursiveState
 	//{{{ toString() method
 	public String toString()
 	{
-		return FactorParser.unparse(words);
+		return FactorReader.unparseObject(words);
+	} //}}}
+
+	//{{{ clone() method
+	public Object clone()
+	{
+		return new RecursiveState(this);
 	} //}}}
 }

factor/compiler/Result.java

@@ -62,6 +62,6 @@ public class Result extends FlowObject implements Constants
 
 	public String toString()
 	{
-		return "( indeterminate )";
+		return "indeterminate:" + local;
 	}
 }

factor/compiler/StackEffect.java

@@ -59,29 +59,11 @@ public class StackEffect implements PublicCloneable, FactorExternalizable
 		if(first == null || second == null)
 			return null;
 
-		int inD  = first.inD;
-		int inR  = first.inR;
-		int outD = first.outD;
-		int outR = first.outR;
+		int inD = first.inD + Math.max(0,second.inD - first.outD);
+		int outD = second.outD + Math.max(0,first.outD - second.inD);
 
-		if(second.inD <= outD)
-			outD -= second.inD;
-		else
-		{
-			inD += (second.inD - outD);
-			outD = 0;
-		}
-
-		if(second.inR <= outR)
-			outR -= second.inR;
-		else
-		{
-			inR += (second.inR - outR);
-			outR = 0;
-		}
-
-		outD += second.outD;
-		outR += second.outR;
+		int inR = first.inR + Math.max(0,second.inR - first.outR);
+		int outR = second.outR + Math.max(0,first.outR - second.inR);
 
 		return new StackEffect(inD,outD,inR,outR);
 	} //}}}
@@ -109,12 +91,10 @@ public class StackEffect implements PublicCloneable, FactorExternalizable
 		StringBuffer signatureBuf = new StringBuffer(
 			"(Lfactor/FactorInterpreter;");
 
-		for(int i = 0; i < inD; i++)
-		{
+		for(int i = 0; i < inD + inR; i++)
 			signatureBuf.append("Ljava/lang/Object;");
-		}
 
-		if(outD != 1)
+		if(outD + outR != 1)
 			signatureBuf.append(")V");
 		else
 			signatureBuf.append(")Ljava/lang/Object;");

factor/continuations.factor

@@ -26,40 +26,58 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 : continue (datastack callstack push --)
-    ! Do not call this directly. Used by callcc.
+    #! Do not call this directly. Used by callcc.
     ! Use a trick to carry the push parameter onto the new data stack.
     2dip
-    callstack@ (push` datastack)
-    swap (datastack push`)
-    >r (datastack)
-    datastack@ (... [ code ])
-    drop (...)
-    r> (... push`)
+    callstack@ ! push` datastack
+    swap ! datastack push`
+    >r ! datastack
+    datastack@ ! ... [ code ]
+    drop ! ...
+    r> ! ... push`
     call ;
 
-: callcc ([ code ] --)
-    ! Calls the code with a special object on the top of the stack. This object,
-    ! when called, restores execution state to just after the callcc call that
-    ! generated this object, and pushes each element of the list at the top of
-    ! the caller's data stack onto the original data stack.
+: callcc ( [ code ] -- )
+    #! Calls the code with a special quotation at the top of the
+    #! stack. The quotation has stack effect:
+    #!
+    #! ( list -- ... )
+    #!
+    #! When called, the quotation restores execution state to
+    #! the point after the callcc call, and pushes each element
+    #! of the list onto the original data stack.
 
-    ! We do a cdr since we don't want the [ code ] to be at the top of the
-    ! stack when execution is restored. Also note that $callstack's car is the
-    ! parent callframe, not the current callframe -- the current callframe is in
+    ! Slightly outdated implementation note:
+
+    ! We do a cdr since we don't want the [ code ] to be at the
+    ! top of the stack when execution is restored. Also note
+    ! that $callstack's car is the parent callframe, not the
+    ! current callframe -- the current callframe is in
     ! $callframe.
     datastack$ callstack$ [ [ ] continue ] cons cons
     swap call ;
 
 : callcc0 ([ code ] --)
+    #! Calls the code with a special quotation at the top of the
+    #! stack. The quotation has stack effect:
+    #!
+    #! ( -- ... )
+    #!
+    #! When called, the quotation restores execution state to
+    #! the point after the callcc0 call.
     ! Like callcc except no data is pushed onto the original datastack.
     datastack$ callstack$ [ [ f ] continue ] cons cons
     swap call ;
 
 : callcc1 ([ code ] --)
-    ! Like callcc except the continuation that is pushed onto the stack before
-    ! executing the given code takes the top of the caller's data stack and
-    ! pushes it onto the original datastack, instead of prepending it to the
-    ! original datastack as a list.
+    #! Calls the code with a special quotation at the top of the
+    #! stack. The quotation has stack effect:
+    #!
+    #! ( X -- ... )
+    #!
+    #! When called, the quotation restores execution state to
+    #! the point after the callcc1 call, and places X at the top
+    #! of the original datastack.
     datastack$ callstack$ [ [ unit ] continue ] cons cons
     swap call ;
 

factor/debugger.factor

@@ -41,7 +41,7 @@
     ] ifte print ;
 
 : break ( exception -- )
-    $global [
+    global [
         dup @error
 
         ! Called when the interpreter catches an exception.

factor/dictionary.factor

@@ -29,39 +29,10 @@
     ! 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.
-    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"
-    jinvoke ;
-
-: compile ( word -- )
-    dup worddef compiled? [
-        drop
-    ] [
-        intern compile*
-    ] ifte ;
-
-: compile-all ( -- )
-    "Compiling..." write
-    words [ compile ] each
-    " done" print ;
-
-: compiled? ( obj -- boolean )
+: compiled? ( worddef -- boolean )
     "factor.compiler.CompiledDefinition" is ;
 
-: compound? ( obj -- boolean )
+: compound? ( worddef -- boolean )
     "factor.FactorCompoundDefinition" is ;
 
 : <compound> ( word def -- worddef )
@@ -69,19 +40,6 @@
     "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 ;
 
@@ -93,48 +51,55 @@
     dup $ dup [
         nip
     ] [
-        drop dup $ tuck s@
+        drop dup <word> 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 ;
-
 : no-name ( list -- word )
     ! Generates an uninternalized word and gives it a compound
     ! definition created from the given list.
     [ gensym dup dup ] dip <compound> define ;
 
-: shuffle? ( obj -- boolean )
-    "factor.FactorShuffleDefinition" is ;
+: primitive? ( worddef -- boolean )
+    "factor.FactorPrimitiveDefinition" is ;
 
-: undefined? ( obj -- boolean )
-    "factor.FactorMissingDefinition" is ;
+: shuffle? ( worddef -- boolean )
+    "factor.FactorShuffleDefinition" is ;
 
 : word? ( obj -- boolean )
     "factor.FactorWord" is ;
 
-: word ( -- word )
-    ! Pushes most recently defined word.
-    $global [ $last ] bind ;
+: word-of-worddef ( worddef -- word )
+    "factor.FactorWordDefinition" "word" jvar$ ;
 
 : worddef? (obj -- boolean)
     "factor.FactorWordDefinition" is ;
 
 : worddef ( word -- worddef )
-    dup worddef? [ intern [ $def ] bind missing>f ] unless ;
+    dup worddef? [ intern dup [ [ $def ] bind ] when ] unless ;
 
 : worddef>list ( worddef -- list )
-    worddef
-    [ ] "factor.FactorWordDefinition" "toList" jinvoke ;
+    worddef dup word-of-worddef swap interpreter swap
+    [ "factor.FactorInterpreter" ] "factor.FactorWordDefinition"
+    "toList" jinvoke cons ;
 
 : words ( -- list )
     ! Pushes a list of all defined words.
-    $dict [ uvalues ] bind
-    [
-        cdr dup [ drop ] unless
-    ] map ;
+    $dict [ values ] bind [ worddef ] subset ;
+
+: words. (--)
+    ! Print all defined words.
+    words [ . ] each ;
+
+: usages. ( word -- )
+    intern
+    words [
+        2dup = [
+            drop
+        ] [
+            2dup worddef>list tree-contains [ . ] [ drop ] ifte
+        ] ifte
+    ] each drop ;

factor/format.factor

@@ -0,0 +1,38 @@
+!:folding=indent:collapseFolds=0:
+
+! $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.
+
+: decimal-split ( str -- str str )
+    #! Split a string before and after the decimal point.
+    dup "." index-of dup -1 = [ drop f ] [ str/ ] ifte ;
+
+: decimal-tail ( str count -- str )
+    #! Given a decimal, trims all but a count of decimal places.
+    succ over str-length min str-head ;
+
+: decimal-places ( num count -- str )
+    #! Trims the number to a count of decimal places.
+    swap decimal-split [ rot decimal-tail cat2 ] when* ;

factor/httpd.factor

@@ -38,55 +38,58 @@
 ! - 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
+: httpd-extensions ( -- alist )
+    [
+        [  "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" ]
+    ] ;
 
+!!! Support words.
 : 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-write ( line -- )
+    $client fwrite ;
+
+: httpd-log-error ( error -- )
+    "Error: " swap cat2 $log fwriteln ;
+
+: httpd-serve-log ( filename -- )
+    "Serving " write $log fwriteln ;
+
+: httpd-client-log ( -- )
+    "Accepted connection from " write
+    $client [ $socket ] bind . ;
+
+!!! Protocol words.
+: httpd-response ( msg content-type -- response )
+    [ "HTTP/1.0 " swap "\nContent-Type: " ] dip "\n" cat5 ;
+
+: httpd-response-write ( msg content-type -- )
+    httpd-response writeln ;
+
+: httpd-error-body ( error -- body )
+    "\n<html><body><h1>" swap "</h1></body></html>" cat3 ;
+
+: httpd-error ( error -- )
+    dup httpd-log-error
+    [ "text/html" httpd-response ] [ httpd-error-body ] cleave
+    cat2
+    writeln ;
 
 : httpd-url>path ( uri -- path )
     dup "http://.*?(/.*)" group1 dup [
@@ -96,6 +99,21 @@
     ] ifte
     $httpd-doc-root swap cat2 ;
 
+: httpd-parse-object-name ( filename -- argument filename )
+    dup "(.*?)\\?(.*)" groups dup [ nip call ] when swap ;
+
+!!! Serving files.
+: httpd-file-header ( filename -- header )
+    "200 Document follows" swap httpd-filetype httpd-response ;
+
+: httpd-serve-file ( filename -- )
+    dup httpd-file-header writeln <filebr> $client fcopy ;
+
+: httpd-filetype ( filename -- mime-type )
+    httpd-file-extension httpd-extensions assoc
+    [ "text/plain" ] unless* ;
+
+!!! Serving directories.
 : httpd-file>html ( filename -- ... )
     "<li><a href=\"" swap
     !dup directory? [ "/" cat2 ] when
@@ -105,32 +123,28 @@
 : 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-directory-header ( directory -- )
+    "200 Document follows" "text/html"
+    httpd-response writeln ;
 
-: httpd-list-directory ( stream directory -- )
-    2dup httpd-directory-header [
+: httpd-list-directory ( directory -- )
+    dup 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 ;
+    ] cons expand cat write ;
 
-: httpd-serve-directory ( stream directory -- )
+: httpd-serve-directory ( 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 -- )
+!!! Serving objects.
+: httpd-serve-static ( filename -- )
     dup exists? [
         dup directory? [
             httpd-serve-directory
@@ -141,19 +155,24 @@
         drop "404 Not Found" httpd-error
     ] ifte ;
 
-: httpd-serve-object ( stream argument filename -- )
+: httpd-serve-script ( argument filename -- )
+    <namespace> [ swap @argument run-file ] bind ;
+
+: httpd-serve-object ( 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 ;
+!!! GET request.
+: httpd-get-request ( url -- )
+    httpd-url>path
+    [
+        httpd-serve-log
+    ] [
+        httpd-parse-object-name httpd-serve-object
+    ] cleave ;
 
 : httpd-get-path ( request -- file )
     "GET (.*?)( HTTP.*|)" group1 ;
@@ -169,19 +188,21 @@
         drop f
     ] ifte ;
 
-: httpd-request ( stream request -- )
+!!! Main loop.
+: httpd-request ( 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* ;
+    <namespace> [
+        $stdio @log
+        @stdio
+        httpd-client-log
+        readln [ httpd-request ] when*
+    ] bind ;
 
 : httpd-loop ( server -- )
     [
@@ -190,5 +211,6 @@
         dup accept dup httpd-client fclose
     ] while ;
 
+!!! Main entry point.
 : httpd ( port docroot -- )
     @httpd-doc-root <server> httpd-loop ;

factor/inspector.factor

@@ -25,50 +25,9 @@
 ! 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 ]
@@ -79,38 +38,15 @@
             [
                 "CLASS : " write dup class-of print
                 "--------" print
-                [ values/tty ] describe*
+                inspecting vars-values.
             ] 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.
+    #! 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.
@@ -121,21 +57,30 @@
         ] ifte
     ] [
         ! Current object.
-        drop $this [ $namespace ] unless*
+        drop this
     ] ifte ;
 
+: global-object-path ( string -- object )
+    #! An object path based from the global namespace.
+    "'" split global [ object-path ] bind ;
+
+: relative>absolute-object-path ( string -- string )
+    $object-path [ "'" rot cat3 ] when* ;
+
+: describe-object-path ( string -- )
+    <namespace> [
+        dup @object-path
+        global-object-path describe
+    ] bind ;
+
 : inspect ( obj -- )
-    ! Display the inspector for the object, and start a new
-    ! REPL bound to the object's namespace.
-    inspecting dup describe
+    #! Display the inspector for the object, and start a new
+    #! REPL bound to the object's namespace.
+    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 ;
+    ! Start a REPL.
+    "exit    - exit one level of inspector." print
+    "suspend - return to top level." print
+    dup inspecting [
+        "    " swap unparse " " cat3 interpreter-loop
+    ] bind ;

factor/interpreter.factor

@@ -25,20 +25,20 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-0 @history-count
-
 : exit (--)
-    $global [ t @quit-flag ] bind ;
+    global [ t @quit-flag ] bind ;
 
 : print-banner ( -- )
-    "Factor " $version cat2 print
+    "Factor " version cat2 print
     "Copyright (C) 2003, 2004 Slava Pestov" print
     "Enter ``help'' for help." print
     "Enter ``exit'' to exit." print ;
 
 : history+ ( cmd -- )
-    $history 2dup contains [ 2drop ] [ cons @history ] ifte
-    "history-count" succ@ ;
+    global [ "history" cons@ ] bind ;
+
+: history# ( -- number )
+    global [ $history length ] bind ;
 
 : history ( -- )
     "X redo    -- evaluate the expression with number X." print
@@ -55,26 +55,29 @@
     get-history edit ;
 
 : print-prompt ( prompt -- )
-    write $history-count write "] " write ;
+    write history# write "] " write flush ;
 
 : interpreter-loop ( prompt -- )
-    dup >r print-prompt read [
+    dup >r print-prompt read dup [
         [ history+ ] [ eval ] cleave
-        $global [ $quit-flag ] bind [
+        global [ $quit-flag ] bind [
             rdrop
-            $global [ f @quit-flag ] bind
+            global [ f @quit-flag ] bind
         ] [
             r> interpreter-loop
         ] ifte
-    ] when* ;
+    ] [
+        rdrop
+    ] ifte ;
 
-: initial-interpreter-loop (--)
-    ! Run the stand-alone interpreter
+: initial-interpreter-loop ( -- )
+    #! Run the stand-alone interpreter
     print-banner
     ! Used by :r
     [ @initial-interpreter-continuation ] callcc0
     ! Used by :s
-    ! We use the slightly redundant 'call' to push the current callframe.
+    ! We use the slightly redundant 'call' to push the current
+    ! callframe.
     [ callstack$ @initial-interpreter-callstack ] call
     "    " interpreter-loop ;
 
@@ -94,17 +97,17 @@
     ".s                 -- print datastack."
     ".                  -- print top of datastack."
     "" print
-    "values.            -- list all variables." print
-    "inspect            -- list all variables bound on object at top of stack." print
-    "$variable .        -- show value of variable." print
+    "global describe    -- list all global variables." print
+    "describe           -- describe object at top of stack." print
     "" print
     "words.             -- list all words." print
-    "\"str\" apropos      -- list all words whose name contains str." print
-    "\"word\" see         -- show definition of word." print
+    "\"word\" see         -- show definition of \"word\"." print
+    "\"str\" apropos      -- list all words whose name contains \"str\"." print
+    "\"word\" usages.     -- list all words that call \"word\"." print
     "" print
     "[ expr ] balance . -- show stack effect of expression." print
     "" print
-    "history            -- list previously entered expresions." print
+    "history            -- list previously entered expressions." print
     "X redo             -- redo expression number X from history list." print
     "" print
     "stats              -- interpreter statistics." print

factor/irc.factor

@@ -0,0 +1,155 @@
+: safe-word? ( word -- ? ) [ + - * / >realnum v+ v- v* v. v/ gcd
+and mag2 max min neg not pow pred succ or recip rem round sq
+sqrt deg2rad rad2deg fib fac harmonic . print car cdr cons
+rplaca rplacd 2list 3list 2rlist append add assoc clone-list
+contains count get last* last length list? nappend partition
+reverse sort num-sort str-sort swons tree-contains uncons unique
+unit unswons 2^ $ describe drop 2drop 2dup dupd dup nip 2nip nop
+over 2over pick rot 2rot -rot 2-rot swap 2swap swapd 2swapd
+transp 2transp tuck 2tuck ] contains ;
+
+: safe? ( code -- ? )
+    t swap [
+        dup word? [
+            safe-word? and
+        ] [
+            drop
+        ] ifte
+    ] each ;
+
+: safe-call ( quot -- )
+    dup safe? [
+        call
+    ] [
+        "Contains prohibited words" print
+    ] ifte ;
+
+: safe-eval ( str -- )
+    parse safe-call ;
+
+: irc-register ( -- )
+    "USER " write
+    $user write " " write
+    $host write " " write
+    $server write " " write
+    $realname write " " print
+
+    "NICK " write
+    $nick print ;
+
+: irc-join ( channel -- )
+    "JOIN " write print ;
+
+: irc-message ( message recepients -- )
+    "PRIVMSG " write write " :" write print ;
+
+: irc-action ( message recepients -- )
+    "ACTION " write write " :" write print ;
+
+: keep-datastack ( quot -- )
+    datastack$ [ call ] dip datastack@ drop ;
+
+: <irc-stream> ( stream recepient -- stream )
+    <stream> [
+        @recepient
+        @stdio
+        <sbuf> @buf
+        [
+            dup $buf sbuf-append drop
+            ends-with-newline? [
+                $buf >str
+                <sbuf> @buf
+                "\n" split [ $recepient irc-message ] each
+            ] when
+        ] @fwrite
+    ] extend ;
+
+: irc-eval ( line -- )
+    [ safe-eval ] keep-datastack drop ;
+
+: irc-fact+ ( key value -- )
+    $facts [ s@ ] bind ;
+
+: irc-fact- ( key -- )
+    $facts [ f s@ ] bind ;
+
+: irc-fact ( key -- )
+    dup $facts [ $ ] bind dup [
+        swap write " is " write print
+    ] [
+        2drop
+    ] ifte ;
+
+: irc-facts ( -- )
+    $facts [ vars-values ] bind [ cdr ] subset . ;
+
+: groups/t ( string re -- groups )
+    dup t = [
+        nip
+    ] [
+        groups
+    ] ifte ;
+
+: with-irc-stream ( recepient quot -- )
+    <namespace> [
+        [ $stdio swap <irc-stream> @stdio ] dip
+        call
+    ] bind ;
+
+: irc-handle-privmsg ( [ recepient message ] -- )
+    uncons car swap
+    [
+        [
+            ! These two are disabled for now.
+            [ "eval (.+)"      , [ car irc-eval         ] ]
+            ! [ "join (.+)"      , [ car irc-join         ] ]
+            [ "see (.+)"       , [ car see terpri       ] ]
+            [ "(facts)"        , [ drop irc-facts       ] ]
+            [ "(.+?) is (.+)" , [ uncons car irc-fact+ ] ]
+            [ "forget (.+)"  , [ car irc-fact-        ] ]
+            [ "insult (.+)"    , [ car " sucks" cat2 print ] ]
+            [ "(.+)"         , [ car irc-fact         ] ]
+            [ t                , [ drop                 ] ]
+        ] re-cond
+    ] with-irc-stream ;
+
+: irc-handle-join ( [ joined channel ] -- )
+    uncons car
+    [
+        dup $nick = [
+            "Hi " swap cat2 print
+        ] unless
+    ] with-irc-stream ;
+
+: irc-input ( line -- )
+    #! Handle a line of IRC input.
+    dup
+    ":.+?!.+? PRIVMSG (.+)?:(.+)" groups [
+        irc-handle-privmsg
+    ] when*
+    dup ":(.+)!.+ JOIN :(.+)" groups [
+        irc-handle-join
+    ] when*
+
+    global [ print ] bind ;
+
+: irc-loop ( -- )
+    read [ irc-input irc-loop ] when* ;
+
+: irc ( channels -- )
+    irc-register
+    dup [ irc-join ] each
+    [ "Hello everybody" swap irc-message ] each
+    irc-loop ;
+
+: irc-test
+    "factorbot" @user
+    "emu" @host
+    "irc.freenode.net" @server
+    "Factor" @realname
+    "factorbot" @nick
+    <namespace> @facts
+    "irc.freenode.net" 6667 <client>
+    <namespace> [ @stdio [ "#jedit" ] irc ] bind ;
+
+!! "factor/irc.factor" run-file

factor/listener/EvalListener.java

@@ -0,0 +1,38 @@
+/* :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.listener;
+
+import factor.Cons;
+import java.util.EventListener;
+
+public interface EvalListener extends EventListener
+{
+	public void eval(Cons code);
+}

factor/listener/FactorDesktop.java

@@ -0,0 +1,156 @@
+/* :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.listener;
+
+import factor.*;
+import java.awt.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.text.html.*;
+
+public class FactorDesktop extends JFrame implements FactorObject
+{
+	private JTabbedPane tabs;
+	private FactorInterpreter interp;
+	private FactorNamespace namespace;
+
+	//{{{ main() method
+	public static void main(String[] args)
+	{
+		new FactorDesktop(args);
+	} //}}}
+
+	//{{{ FactorDesktop constructor
+	public FactorDesktop(String[] args)
+	{
+		super("Factor");
+		tabs = new JTabbedPane();
+
+		getContentPane().add(BorderLayout.CENTER,tabs);
+
+		try
+		{
+			interp = new FactorInterpreter();
+			interp.interactive = false;
+			interp.init(args,this);
+		}
+		catch(Exception e)
+		{
+			System.err.println("Failed to initialize interpreter:");
+			e.printStackTrace();
+		}
+
+		newListener();
+
+		setSize(640,480);
+		setDefaultCloseOperation(EXIT_ON_CLOSE);
+		show();
+	} //}}}
+
+	//{{{ getNamespace() method
+	public FactorNamespace getNamespace(FactorInterpreter interp)
+		throws Exception
+	{
+		if(namespace == null)
+			namespace = new FactorNamespace(interp.global,this);
+		return namespace;
+	} //}}}
+
+	//{{{ newListener() method
+	public FactorListener newListener()
+	{
+		FactorListener listener = new FactorListener();
+		listener.addEvalListener(new EvalHandler());
+
+		try
+		{
+			interp.call(new Cons(listener,
+				new Cons(interp.intern("new-listener-hook"),
+				null)));
+			interp.run();
+		}
+		catch(Exception e)
+		{
+			System.err.println("Failed to initialize listener:");
+			e.printStackTrace();
+		}
+
+		tabs.addTab("Listener",new JScrollPane(listener));
+		return listener;
+	} //}}}
+
+	//{{{ getInterpreter() method
+	public FactorInterpreter getInterpreter()
+	{
+		return interp;
+	} //}}}
+
+	//{{{ eval() method
+	public void eval(Cons cmd)
+	{
+		try
+		{
+			interp.call(cmd);
+			interp.run();
+		}
+		catch(Exception e)
+		{
+			System.err.println("Failed to eval " + cmd + ":");
+			e.printStackTrace();
+		}
+	} //}}}
+
+	//{{{ EvalHandler class
+	class EvalHandler implements EvalListener
+	{
+		public void eval(Cons cmd)
+		{
+			FactorDesktop.this.eval(cmd);
+		}
+	} //}}}
+
+	//{{{ EvalAction class
+	class EvalAction extends AbstractAction
+	{
+		private Cons code;
+
+		public EvalAction(String label, Cons code)
+		{
+			super(label);
+			this.code = code;
+		}
+
+		public void actionPerformed(ActionEvent evt)
+		{
+			FactorDesktop.this.eval(code);
+		}
+	} //}}}
+}

factor/listener/FactorListener.java

@@ -0,0 +1,259 @@
+/* :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.listener;
+
+import factor.*;
+import java.awt.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.event.*;
+import javax.swing.text.*;
+
+public class FactorListener extends JTextPane
+{
+	private static final Cursor MoveCursor
+		= Cursor.getPredefinedCursor
+		(Cursor.HAND_CURSOR);
+	private static final Cursor DefaultCursor
+		= Cursor.getPredefinedCursor
+		(Cursor.TEXT_CURSOR);
+	private static final Cursor WaitCursor
+		= Cursor.getPredefinedCursor
+		(Cursor.WAIT_CURSOR);
+
+	private static final Object Link = new Object();
+
+	private SimpleAttributeSet def;
+	private SimpleAttributeSet link;
+	private SimpleAttributeSet input;
+	private EventListenerList listenerList;
+
+	private Cons readLineContinuation;
+	private int cmdStart = -1;
+
+	//{{{ FactorListener constructor
+	public FactorListener()
+	{
+		//setEditorKit(new HTMLEditorKit());
+		//setEditable(false);
+		MouseHandler mouse = new MouseHandler();
+		addMouseListener(mouse);
+		addMouseMotionListener(mouse);
+
+		def = new SimpleAttributeSet();
+		def.addAttribute(StyleConstants.FontFamily,"Monospaced");
+
+		link = new SimpleAttributeSet(def);
+		link.addAttribute(StyleConstants.Foreground,Color.blue);
+		link.addAttribute(StyleConstants.Underline,Boolean.TRUE);
+
+		input = new SimpleAttributeSet(def);
+		input.addAttribute(StyleConstants.Bold,Boolean.TRUE);
+
+		listenerList = new EventListenerList();
+
+		getInputMap().put(KeyStroke.getKeyStroke('\n'),
+			new EnterAction());
+	} //}}}
+
+	//{{{ insertLink() method
+	public void insertLink(String text, String target)
+		throws BadLocationException
+	{
+		SimpleAttributeSet thisLink = new SimpleAttributeSet(link);
+		thisLink.addAttribute(Link, target);
+
+		insertWithAttrs(text,thisLink);
+	} //}}}
+
+	//{{{ insertText() method
+	public void insertText(String text)
+		throws BadLocationException
+	{
+		insertWithAttrs(text,def);
+	} //}}}
+
+	//{{{ insertInput() method
+	public void insertInput(String text)
+		throws BadLocationException
+	{
+		insertWithAttrs(text,input);
+	} //}}}
+
+	//{{{ insertWithAttrs() method
+	private void insertWithAttrs(String text, AttributeSet attrs)
+		throws BadLocationException
+	{
+		StyledDocument doc = (StyledDocument)getDocument();
+		int offset1 = doc.getLength();
+		doc.insertString(offset1,text,null);
+		int offset2 = offset1 + text.length();
+		doc.setCharacterAttributes(offset1,offset2,attrs,false);
+		setCaretPosition(offset2);
+	} //}}}
+
+	//{{{ readLine() method
+	public void readLine(Cons continuation)
+	{
+		setCursor(DefaultCursor);
+		this.readLineContinuation = continuation;
+		cmdStart = getDocument().getLength();
+		setCaretPosition(cmdStart);
+		setCharacterAttributes(input,false);
+	} //}}}
+
+	//{{{ getLine() method
+	private String getLine() throws BadLocationException
+	{
+		StyledDocument doc = (StyledDocument)getDocument();
+		int length = doc.getLength();
+		if(cmdStart > length)
+			return "";
+		else
+			return doc.getText(cmdStart,length - cmdStart);
+	} //}}}
+
+	//{{{ editLine() method
+	public void editLine(String text) throws BadLocationException
+	{
+		cmdStart = getDocument().getLength();
+		insertInput(text);
+	} //}}}
+
+	//{{{ addEvalListener() method
+	public void addEvalListener(EvalListener l)
+	{
+		listenerList.add(EvalListener.class,l);
+	} //}}}
+
+	//{{{ removeEvalListener() method
+	public void removeEvalListener(EvalListener l)
+	{
+		listenerList.remove(EvalListener.class,l);
+	} //}}}
+
+	//{{{ fireEvalEvent() method
+	private void fireEvalEvent(String code)
+	{
+		setCursor(WaitCursor);
+
+		Cons quot = new Cons(code,readLineContinuation);
+		//readLineContinuation = null;
+
+		Object[] listeners = listenerList.getListenerList();
+		for(int i = 0; i < listeners.length; i++)
+		{
+			if(listeners[i] == EvalListener.class)
+			{
+				EvalListener l = (EvalListener)listeners[i+1];
+				l.eval(quot);
+			}
+		}
+	} //}}}
+
+	//{{{ getLinkAt() method
+	private String getLinkAt(int pos)
+	{
+		StyledDocument doc = (StyledDocument)getDocument();
+		Element e = doc.getCharacterElement(pos);
+		AttributeSet a = e.getAttributes();
+		if(a == null)
+			return null;
+		else
+			return (String)a.getAttribute(Link);
+	} //}}}
+
+	//{{{ activateLink() method
+	private void activateLink(int pos)
+	{
+		String eval = getLinkAt(pos);
+		if(eval == null)
+			return;
+
+		try
+		{
+			insertInput(eval + "\n");
+		}
+		catch(BadLocationException ble)
+		{
+			ble.printStackTrace();
+		}
+		fireEvalEvent(eval);
+	} //}}}
+
+	//{{{ MouseHandler class
+	class MouseHandler extends MouseInputAdapter
+	{
+		public void mouseClicked(MouseEvent e)
+		{
+			JEditorPane editor = (JEditorPane) e.getSource();
+
+			Point pt = new Point(e.getX(), e.getY());
+			int pos = editor.viewToModel(pt);
+			if(pos >= 0)
+				activateLink(pos);
+		}
+
+		public void mouseMoved(MouseEvent e)
+		{
+			JEditorPane editor = (JEditorPane) e.getSource();
+
+			Point pt = new Point(e.getX(), e.getY());
+			int pos = editor.viewToModel(pt);
+			if(pos >= 0)
+			{
+				Cursor cursor;
+				if(getLinkAt(pos) != null)
+					cursor = MoveCursor;
+				else
+					cursor = DefaultCursor;
+
+				if(getCursor() != cursor)
+					setCursor(cursor);
+			}
+		}
+	} //}}}
+
+	//{{{ EnterAction class
+	class EnterAction extends AbstractAction
+	{
+		public void actionPerformed(ActionEvent evt)
+		{
+			try
+			{
+				fireEvalEvent(getLine());
+			}
+			catch(BadLocationException e)
+			{
+				e.printStackTrace();
+			}
+		}
+	} //}}}
+}

factor/listener/listener.factor

@@ -0,0 +1,99 @@
+!: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.
+
+: <listener-stream> ( listener -- stream )
+    #! Creates a stream for reading/writing to the given
+    #! listener instance.
+    <stream> [
+        @listener
+        ( -- string )
+        [ <listener-stream>/freadln ] @freadln
+        ( string -- )
+        [ f <listener-stream>/fwrite-attr ] @fwrite
+        ( string attrs -- )
+        [ <listener-stream>/fwrite-attr ] @fwrite-attr
+        ( string -- )
+        [ <listener-stream>/fedit ] @fedit
+        ( -- )
+        [ ] @fflush
+        ( -- )
+        [ ] @fclose
+        ( string -- )
+        [ this fwrite "\n" this fwrite ] @fwriteln
+    ] extend ;
+
+: <listener-stream>/freadln ( -- line )
+    [
+        $listener
+        [ "factor.Cons" ]
+        "factor.listener.FactorListener"
+        "readLine" jinvoke
+        suspend
+    ] callcc1 ;
+
+: obj>listener-link ( obj -- link )
+    #! Listener links are quotations.
+    dup string? [
+        ! Inspector link.
+        unparse " describe-object-path" cat2
+    ] when ;
+
+: <listener-stream>/fwrite-attr ( string attrs -- )
+    "link" swap assoc dup [
+        obj>listener-link
+        $listener
+        [ "java.lang.String" "java.lang.String" ]
+        "factor.listener.FactorListener"
+        "insertLink" jinvoke
+    ] [
+        drop
+        $listener
+        [ "java.lang.String" ]
+        "factor.listener.FactorListener"
+        "insertText" jinvoke
+    ] ifte ;
+
+: <listener-stream>/fedit ( string -- )
+    $listener
+    [ "java.lang.String" ]
+    "factor.listener.FactorListener"
+    "editLine" jinvoke ;
+
+: new-listener-hook ( listener -- )
+    #! Called when user opens a new listener in the desktop.
+    <namespace> [
+        <listener-stream> @stdio
+        initial-interpreter-loop
+    ] bind ;
+
+: new-listener ( -- )
+    #! Opens a new listener.
+    this [ ] "factor.listener.FactorDesktop" "newListener"
+    jinvoke ;
+
+: running-desktop? ( -- )
+    this "factor.listener.FactorDesktop" is ;

factor/lists.factor

@@ -29,59 +29,79 @@
 ! List manipulation primitives
 !
 : array>list ( array -- list )
+    #! Convert an array into a proper list.
     [ [ "java.lang.Object" ] ] "factor.Cons" "fromArray"
     jinvoke-static ;
 
-: car ([ car , cdr ] -- car)
-    |factor.Cons |car jvar$ ;
+: car ( [ car , cdr ] -- car )
+    #! Push the head of a list.
+    "factor.Cons" "car" jvar$ ; inline
 
 : cdr ([ car , cdr ] -- cdr)
-    |factor.Cons |cdr jvar$ ;
+    #! Push the tail of a list. In a proper list, the tail is
+    #! always a cons cell or f; in an improper list, the tail
+    #! can be anything.
+    "factor.Cons" "cdr" jvar$ ; inline
 
-: cons (car cdr -- [ car , cdr ])
-    [ |java.lang.Object |java.lang.Object ] |factor.Cons jnew ;
+: cons ( car cdr -- [ car , cdr ] )
+    #! Push a new cons cell. If the cdr is f or a proper list,
+    #! has the effect of prepending the car to the cdr.
+    [ "java.lang.Object" "java.lang.Object" ] "factor.Cons" jnew
+    ; inline
 
-: cons? (list -- boolean)
-    |factor.Cons is ;
+: cons? ( list -- boolean )
+    #! Test for cons cell type.
+    "factor.Cons" is ; inline
 
-: rplaca ( A [ B , C ] -- [ A , C ] )
-    ! Destructive!
-    "factor.Cons" "car" jvar@ ;
+: rplaca ( A [ B , C ] -- )
+    #! DESTRUCTIVE. Replace the head of a list.
+    "factor.Cons" "car" jvar@ ; inline
 
-: rplacd ( A [ B , C ] -- [ B , A ] )
-    ! Destructive!
-    "factor.Cons" "cdr" jvar@ ;
+: rplacd ( A [ B , C ] -- )
+    #! DESTRUCTIVE. Replace the tail of a list.
+    "factor.Cons" "cdr" jvar@ ; inline
 
 !
 ! List manipulation library
 !
-: 2list (a b -- [ a b ])
+: 2list ( a b -- [ a b ] )
+    #! Construct a proper list of 2 elements.
     unit cons ;
 
 : 3list ( a b c -- [ a b c ] )
+    #! Construct a proper list of 3 elements.
     2list cons ;
 
 : 2rlist (a b -- [ b a ])
+    #! Construct a proper list of 2 elements in reverse stack order.
     swap unit cons ;
 
 : append ( [ list1 ] [ list2 ] -- [ list1 list2 ] )
+    #! Append two lists. The first list must be proper. A new
+    #! list is constructed by copying the first list and setting
+    #! its tail to the second.
     over [ [ uncons ] dip append cons ] [ nip ] ifte ;
 
-: add ([ list1 ] elem -- [ list1 elem ])
+: add ( [ list1 ] elem -- [ list1 elem ] )
+    #! Push a new proper list with an element added to the end.
     unit append ;
 
-: append@ ([ list ] variable --)
-    ! Adds the list to the end of the list stored in the given variable.
+: append@ ( [ list ] variable -- )
+    #! Append a proper list stored in a variable with another
+    #! list, storing the result back in the variable.
+    #! given variable using 'append'.
     dup [ $ swap append ] dip @ ;
 
-: add@ (elem variable --)
-    ! Adds the element to the end of the list stored in the given variable.
+: add@ ( elem variable -- )
+    #! Add an element at the end of a proper list stored in a
+    #! variable, storing the result back in the variable.
     dup [ $ swap add ] dip @ ;
 
-: assoc (key alist -- value)
-    ! Looks up the key in the given alist. An alist is a list of comma pairs,
-    ! the car of each pair is a key, the cdr is the value. For example:
-    ! [ [ 1 , "one" ] [ 2 , "two" ] [ 3 , "three" ] ]
+: assoc ( key alist -- value )
+    #! Looks up the key in an alist. An alist is a proper list
+    #! of comma pairs, the car of each pair is a key, the cdr is
+    #! the value. For example:
+    #! [ [ 1 , "one" ] [ 2 , "two" ] [ 3 , "three" ] ]
     dup [
         2dup car car = [
             nip car cdr
@@ -92,10 +112,14 @@
         2drop f
     ] ifte ;
 
-: assoc$ (key alist -- value)
-    ! 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
-    ! variable name, the cdr is the value.
+: assoc$ ( key alist -- value )
+    #! Looks up the key in a variable alist. A variable alist is
+    #! a proper list of comma pairs, the car of each pair is a
+    #! variable name, the cdr is the value. For example:
+    #!   $green
+    #!   [ [ "red" , 1 ] [ "green" , 2 ] [ "blue" , 3 ] ] .
+    #! 2
+    #! Raises an error if the list is not a proper list.
     dup [
         2dup car car $ = [
             nip car cdr
@@ -106,33 +130,36 @@
         2drop f
     ] ifte ;
 
-: caar (list -- caar)
-    car car ;
+: caar ( list -- caar )
+    car car ; inline
 
-: cdar (list -- cadr)
-    cdr car ;
+: cdar ( list -- cadr )
+    cdr car ; inline
 
-: cadr (list -- cdar)
-    car cdr ;
+: cadr ( list -- cdar )
+    car cdr ; inline
 
-: cddr (list -- cddr)
-    cdr cdr ;
+: cddr ( list -- cddr )
+    cdr cdr ; inline
 
 : clone-list-iter ( result list -- last [ ] )
+    #! DESTRUCTIVE. Helper word for 'clone-list'.
     [
         dup cons?
     ] [
         uncons [ unit tuck [ rplacd ] dip ] dip
     ] while ;
 
-: clone-list (list -- list)
+: clone-list ( list -- list )
+    #! Push a shallow copy of a list.
     dup [
         uncons [ unit dup ] dip clone-list-iter swap rplacd
     ] when ;
 
-: contains ( elem list -- remainder )
-    ! If the list contains elem, return the remainder of the
-    ! list, starting from the cell whose car is elem.
+: contains ( element list -- remainder )
+    #! If the proper list contains the element, push the
+    #! remainder of the list, starting from the cell whose car
+    #! is elem. Otherwise push f.
     dup [
         2dup car = [
             nip
@@ -143,29 +170,48 @@
         2drop f
     ] ifte ;
 
-: cons@ (x var --)
-    ! Prepends x to the list stored in var.
+: cons@ ( x var -- )
+    #! Prepend x to the list stored in var.
     tuck $ cons s@ ;
 
-: count (n -- [ 1 2 3 ... n ])
+: count ( n -- [ 1 2 3 ... n ] )
+    #! If n <= 0, pushes the empty list.
     [ [ ] times* ] cons expand ;
 
-: get (list n -- list[n])
+: get ( list n -- list[n] )
+    #! Gets the nth element of a proper list by successively
+    #! iterating down the cdr pointer.
+    #! Supplying n <= 0 pushes the first element of the list.
+    #! Supplying an argument beyond the end of the list raises
+    #! an error.
     [ cdr ] times car ;
 
 : last* ( list -- last )
-    ! Pushes last cons of the list.
+    #! Pushes last cons of a list.
+    #! For example, given a proper list, pushes a cons cell
+    #! whose car is the last element of the list, and whose cdr
+    #! is f.
     [ dup cdr cons? ] [ cdr ] while ;
 
 : last ( list -- last )
-    ! Pushes last element of the list.
+    #! Pushes last element of a list. Since this pushes the
+    #! car of the last cons cell, the list may be an improper
+    #! list.
     last* car ;
 
-: length (list -- length)
+: length ( list -- length )
+    #! Pushes the length of the given proper list.
     0 swap [ drop succ ] each ;
 
 : list? ( list -- boolean )
-    ! A list is either f, or a cons cell whose cdr is a list.
+    #! Proper list test. A proper list is either f, or a cons
+    #! cell whose cdr is a proper list.
+    #!   [ ] list? .
+    #! t
+    #!   [ 1 2 ] list? .
+    #! t
+    #!   [ 1 , 2 ] list? .
+    #! f
     dup [
         dup cons? [
             cdr list?
@@ -177,9 +223,38 @@
     ] ifte ;
 
 : nappend ( [ list1 ] [ list2 ] -- [ list1 list2 ] )
-    ! Destructive on list1!
+    #! DESTRUCTIVE. Append two lists. The last node of the first
+    #! list is destructively modified to point to the second
+    #! list, unless the first line is f, in which case the
+    #! second list is returned.
     over [ over last* rplacd ] [ nip ] ifte ;
 
+: first ( list -- obj )
+    #! Push the head of the list, or f if the list is empty.
+    dup [ car ] when ;
+
+: next ( obj list -- obj )
+    #! Push the next object in the list after an object. Wraps
+    #! around to beginning of list if object is at the end.
+    tuck contains dup [
+        ! Is there another entry in the list?
+        cdr dup [
+            nip car
+        ] [
+            ! No. Pick first
+            drop first
+        ] ifte
+    ] [
+        drop first
+    ] ifte ;
+
+: nreverse-iter ( list cons -- list cons )
+    [ dup dup cdr 2swap rplacd nreverse-iter ] when* ;
+
+: nreverse ( list -- list )
+    #! DESTRUCTIVE. Reverse the given list, without consing.
+    f swap nreverse-iter ;
+
 ~<< partition-iterI
     R1 R2 A D C -- A C r:R1 r:R2 r:A r:D r:C >>~
 
@@ -195,10 +270,11 @@
 ~<< }partition-iterF
     R2 r:R1 r:R2X r:D r:C -- R1 R2 D C >>~
 
-: partition-iter ( ref ret1 ret2 list combinator -- ret1 ret2 )
+: partition-iter ( ref ret1 ret2 list combinator -- ref ret1 ret2 )
+    #! Helper word for 'partition'.
     over [
         ! Note this ifte must be in tail position!
-        [ uncons ] dip partition-iterI [ dup ] 2dip call [
+        >r uncons r> partition-iterI 2>r dup 2r> call [
             partition-iterT{ cons }partition-iterT partition-iter
         ] [
             partition-iterF{ cons }partition-iterF partition-iter
@@ -208,35 +284,100 @@
     ] ifte ;
 
 : partition ( ref list combinator -- list1 list2 )
+    #! Compare each element in a proper list against a
+    #! reference element using a combinator. The combinator's
+    #! return value determines if the element is prepended to
+    #! the first or second list.
+    #! The combinator must have stack effect:
+    #! ( ref element -- ? )
     [ ] [ ] 2swap partition-iter rot drop ;
 
-: reverse (list -- list)
+: reverse ( list -- list )
+    #! Push a new list that is the reverse of a proper list.
     [ ] swap [ swons ] each ;
 
+: remove ( obj list -- list )
+    #! Remove all occurrences of the object from the list.
+    dup [
+        2dup car = [
+            cdr remove
+        ] [
+            uncons swapd remove cons
+        ] ifte
+    ] [
+        nip
+    ] ifte ;
+
+: remove@ ( obj var -- )
+    #! Remove all occurrences of the object from the list
+    #! stored in the variable.
+    tuck $ remove s@ ;
+
 : sort ( list comparator -- sorted )
+    #! Sort the elements in a proper list using a comparator.
+    #! The comparator must have stack effect:
+    #! ( x y -- ? )
+    #! To sort elements in descending order, return t if x < y.
+    #! To sort elements in ascending order, return t if x > y.
     over [
         ! Partition
-        dup [ [ uncons dupd ] dip partition ] dip
+        dup >r >r uncons dupd r> partition r>
         ! Recurse
-        tuck sort [ sort ] dip
+        tuck sort >r sort r>
         ! Combine
-        swapd cons append
+        swapd cons nappend
     ] [
         drop
     ] ifte ;
 
-: swons (cdr car -- [ car , cdr ])
-    swap cons ;
+: num-sort ( list -- sorted )
+    #! Sorts the list into ascending numerical order.
+    [ > ] sort ;
 
-: swons@ (var x --)
-    ! Prepends x to the list stored in var.
+: str-sort ( list -- sorted )
+    #! Sorts the list into ascending lexicographical string
+    #! order.
+    [ str-lexi> ] sort ;
+
+: swons ( cdr car -- [ car , cdr ] )
+    #! Push a new cons cell. If the cdr is f or a proper list,
+    #! has the effect of prepending the car to the cdr.
+    swap cons ; inline
+
+: swons@ ( var x -- )
+    #! Prepend x to the list stored in var.
     over $ cons s@ ;
 
-: uncons ([ car , cdr ] -- car cdr)
-    dup car swap cdr ;
+: =-or-contains ( element obj -- ? )
+    dup cons? [
+        tree-contains
+    ] [
+        =
+    ] ifte ;
+
+: tree-contains ( element tree -- ? )
+    dup [
+        2dup car =-or-contains [
+            nip
+        ] [
+            cdr dup cons? [
+                tree-contains
+            ] [
+                ! don't bomb on dotted pairs
+                =-or-contains
+            ] ifte
+        ] ifte
+    ] [
+        2drop f
+    ] ifte ;
+
+: uncons ( [ car , cdr ] -- car cdr )
+    #! Push both the head and tail of a list.
+    dup car swap cdr ; inline
 
 : unique ( elem list -- list )
-    ! Cons elem onto list if its not already there.
+    #! Prepend an element to a proper list if it is not
+    #! already contained in the list.
     2dup contains [
         nip
     ] [
@@ -244,10 +385,14 @@
     ] ifte ;
 
 : unique@ ( elem var -- )
+    #! Prepend an element to the proper list stored in a
+    #! variable if it is not already contained in the list.
     tuck $ unique s@ ;
 
-: unit (a -- [ a ])
-    f cons ;
+: unit ( a -- [ a ] )
+    #! Construct a proper list of one element.
+    f cons ; inline
 
-: unswons ([ car , cdr ] -- cdr car)
-    dup cdr swap car ;
+: unswons ( [ car , cdr ] -- cdr car )
+    #! Push both the head and tail of a list.
+    dup cdr swap car ; inline

factor/math.factor

@@ -26,44 +26,52 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 : 0= (x -- boolean)
-    0 = ;
+    0 = ; inline
 
-: 0>f ( obj -- oj )
+: 0>f ( obj -- obj )
     ! If 0 a the top of the stack, turn it into f.
     dup 0 = [ drop f ] when ;
 
 : 1= (x -- boolean)
-    1 = ;
+    1 = ; inline
+
+: 2^ ( x -- 2^x )
+    1 swap [ 2 * ] times ;
 
 : number? (obj -- boolean)
-    "java.lang.Number" is ;
+    "java.lang.Number" is ; inline
 
 : fixnum? (obj -- boolean)
-    "java.lang.Integer" is ;
+    "java.lang.Integer" is ; inline
 
 : >fixnum (num -- fixnum)
-    [ ] "java.lang.Number" "intValue" jinvoke ;
+    [ ] "java.lang.Number" "intValue" jinvoke ; inline
 
 : bignum? (obj -- boolean)
-    "java.math.BigInteger" is ;
+    "java.math.BigInteger" is ; inline
 
 : >bignum (num -- bignum)
     [ ] "java.lang.Number" "longValue" jinvoke
-    [ "long" ] "java.math.BigInteger" "valueOf" jinvoke-static ;
+    [ "long" ] "java.math.BigInteger" "valueOf" jinvoke-static
+    ; inline
+
+: integer? ( obj -- ? )
+    dup fixnum? swap bignum? or ; inline
 
 : realnum? (obj -- boolean)
     dup  "java.lang.Float"  is
-    swap "java.lang.Double" is or ;
+    swap "java.lang.Double" is or ; inline
 
 : >realnum (num -- realnum)
-    [ ] "java.lang.Number" "doubleValue" jinvoke ;
+    [ ] "java.lang.Number" "doubleValue" jinvoke ; inline
 
 : ratio? (obj -- boolean)
-    "factor.FactorRatio" is ;
+    "factor.FactorRatio" is ; inline
 
 : + (a b -- a+b)
-    [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "add"
-    jinvoke-static ;
+    [ "java.lang.Number" "java.lang.Number" ]
+    "factor.FactorMath" "add"
+    jinvoke-static ; inline
 
 : v+ ( A B -- A+B )
     [ + ] 2map ;
@@ -72,19 +80,20 @@
     dup [ $ + ] dip @ ;
 
 : - (a b -- a-b)
-    [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "subtract"
-    jinvoke-static ;
+    [ "java.lang.Number" "java.lang.Number" ]
+    "factor.FactorMath" "subtract"
+    jinvoke-static ; inline
 
 : v- ( A B -- A-B )
     [ - ] 2map ;
 
-
 : -@ (num var --)
     dup [ $ swap - ] dip @ ;
 
 : * (a b -- a*b)
-    [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "multiply"
-    jinvoke-static ;
+    [ "java.lang.Number" "java.lang.Number" ]
+    "factor.FactorMath" "multiply"
+    jinvoke-static ; inline
 
 : v* ( A B -- A*B )
     [ * ] 2map ;
@@ -97,8 +106,9 @@
     dup [ $ * ] dip @ ;
 
 : / (a b -- a/b)
-    [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "divide"
-    jinvoke-static ;
+    [ "java.lang.Number" "java.lang.Number" ]
+    "factor.FactorMath" "divide"
+    jinvoke-static ; inline
 
 : v/ ( A B -- A/B )
     [ / ] 2map ;
@@ -107,27 +117,49 @@
     dup [ $ / ] dip @ ;
 
 : > (a b -- boolean)
-    [ "float" "float" ] "factor.FactorMath" "greater" jinvoke-static ;
+    [ "float" "float" ] "factor.FactorMath" "greater"
+    jinvoke-static ; inline
 
 : >= (a b -- boolean)
-    [ "float" "float" ] "factor.FactorMath" "greaterEqual" jinvoke-static ;
+    [ "float" "float" ] "factor.FactorMath" "greaterEqual"
+    jinvoke-static ; inline
 
 : < (a b -- boolean)
-    [ "float" "float" ] "factor.FactorMath" "less" jinvoke-static ;
+    [ "float" "float" ] "factor.FactorMath" "less"
+    jinvoke-static ; inline
 
 : <= (a b -- boolean)
-    [ "float" "float" ] "factor.FactorMath" "lessEqual" jinvoke-static ;
+    [ "float" "float" ] "factor.FactorMath" "lessEqual"
+    jinvoke-static ; inline
 
 : and (a b -- a&b)
-    f ? ;
+    f ? ; inline
+
+: break-if-not-integer ( x -- )
+    integer? [
+        "Not a rational: " swap cat2 error
+    ] unless ;
+
+: denominator ( x/y -- x )
+    dup ratio? [
+        "factor.FactorRatio" "denominator" jvar$
+    ] [
+        break-if-not-integer 1
+    ] ifte ;
 
 : 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 ;
+: logand ( x y -- x&y )
+    #! Bitwise and.
+    [ "java.lang.Number" "java.lang.Number" ]
+    "factor.FactorMath" "and"
+    jinvoke-static ; inline
+
+: mag2 ( x y -- mag )
+    #! Returns the magnitude of the vector (x,y).
+    [ sq ] 2apply + sqrt ;
 
 : max ( x y -- z )
     2dup > -rot ? ;
@@ -136,48 +168,57 @@
     2dup < -rot ? ;
 
 : neg (x -- -x)
-    0 swap - ;
+    [ "java.lang.Number" ] "factor.FactorMath" "neg"
+    jinvoke-static ; inline
 
 : neg@ (var --)
     dup $ 0 swap - s@ ;
 
 : not (a -- a)
     ! Pushes f is the object is not f, t if the object is f.
-    f t ? ;
+    f t ? ; inline
 
 : not@ (boolean -- boolean)
     dup $ not s@ ;
 
+: numerator ( x/y -- x )
+    dup ratio? [
+        "factor.FactorRatio" "numerator" jvar$
+    ] [
+        dup break-if-not-integer
+    ] ifte ;
+
 : pow ( x y -- x^y )
-    [ "double" "double" ] "java.lang.Math" "pow" jinvoke-static ;
+    [ "double" "double" ] "java.lang.Math" "pow" jinvoke-static
+    ; inline
 
 : pred (n -- n-1)
-    1 - ;
+    1 - ; inline
 
 : succ (n -- nsucc)
-    1 + ;
+    1 + ; inline
 
 : pred@ (var --)
     dup $ pred s@ ;
 
 : or (a b -- a|b)
-    t swap ? ;
+    t swap ? ; inline
 
 : recip (x -- 1/x)
     1 swap / ;
 
 : rem ( x y -- remainder )
     [ "double" "double" ] "java.lang.Math" "IEEEremainder"
-    jinvoke-static ;
+    jinvoke-static ; inline
 
 : round ( x to -- y )
     dupd rem - ;
 
 : sq (x -- x^2)
-    dup * ;
+    dup * ; inline
 
 : sqrt (x -- sqrt x)
-    [ "double" ] "java.lang.Math" "sqrt" jinvoke-static ;
+    [ "double" ] "java.lang.Math" "sqrt" jinvoke-static ; inline
 
 : succ@ (var --)
     dup $ succ s@ ;
@@ -190,7 +231,11 @@
 
 : fib (n -- nth fibonacci number)
     ! This is the naive implementation, for benchmarking purposes.
-    [ dup 1 <= ] [ ] [ pred dup pred ] [ + ] binrec ;
+    dup 1 <= [
+        drop 1
+    ] [
+        pred dup fib swap pred fib +
+    ] ifte ;
 
 : fac (n -- n!)
     ! This is the naive implementation, for benchmarking purposes.
@@ -198,9 +243,3 @@
 
 : harmonic (n -- 1 + 1/2 + 1/3 + ... + 1/n)
     0 swap [ succ recip + ] times* ;
-
-2.7182818284590452354 @e
-3.14159265358979323846 @pi
-
-1.0 0.0 / @inf
--1.0 0.0 / @-inf

factor/miscellaneous.factor

@@ -31,7 +31,8 @@
     "factor.FactorLib" "equal" jinvoke-static ;
 
 : class-of ( obj -- class )
-    [ ] "java.lang.Object" "getClass" jinvoke ;
+    [ ] "java.lang.Object" "getClass" jinvoke
+    [ ] "java.lang.Class" "getName" jinvoke ;
 
 : clone (obj -- obj)
     [ ] "factor.PublicCloneable" "clone" jinvoke ;
@@ -41,6 +42,9 @@
     "factor.FactorLib" "cloneArray"
     jinvoke-static ;
 
+: comment? ( obj -- ? )
+    "factor.FactorDocComment" is ;
+
 : deepCloneArray (obj -- obj)
     [ [ "java.lang.Object" ] ]
     "factor.FactorLib" "deepCloneArray"
@@ -70,20 +74,13 @@
     [ "java.lang.String" ] "factor.FactorLib" "error" jinvoke-static ;
 
 : exit* (code --)
-    [ |int ] |java.lang.System |exit jinvoke-static ;
+    [ "int" ] "java.lang.System" "exit" jinvoke-static ;
 
 : millis (-- millis)
     ! Pushes the current time, in milliseconds.
-    [ ] |java.lang.System |currentTimeMillis jinvoke-static
+    [ ] "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 ;

factor/namespaces.factor

@@ -26,10 +26,16 @@
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 : s@ ( variable value -- )
-    swap @ ;
+    #! Sets the value of a variable in the current namespace.
+    namespace [ "java.lang.String" "java.lang.Object" ]
+    "factor.FactorNamespace"
+    "setVariable" jinvoke ; inline
+
+: @ ( value variable -- )
+    swap s@ ; inline
 
 : has-namespace? ( a -- boolean )
-    "factor.FactorObject" is ;
+    "factor.FactorObject" is ; inline
 
 : lazy ( var [ a ] -- value )
     ! If the value of the variable is f, set the value to the
@@ -37,14 +43,14 @@
     over $ [ drop $ ] [ dip dupd @ ] ifte ;
 
 : namespace? ( a -- boolean )
-    "factor.FactorNamespace" is ;
+    "factor.FactorNamespace" is ; inline
 
-: <namespace> (-- namespace)
-    $namespace [ |factor.FactorNamespace ] |factor.FactorNamespace
-    jnew ;
+: <namespace> ( -- namespace )
+    namespace
+    [ "factor.FactorNamespace" ] "factor.FactorNamespace" jnew ;
 
 : <objnamespace> ( object -- namespace )
-    $namespace swap
+    namespace swap
     [ "factor.FactorNamespace" "java.lang.Object" ]
     "factor.FactorNamespace" jnew ;
 
@@ -59,24 +65,46 @@
 : import ( class pairs -- )
     ! Import some static variables from a Java class into the
     ! current namespace.
-    $namespace [ |java.lang.String |factor.Cons ]
-    |factor.FactorNamespace |importVars
+    namespace [ "java.lang.String" "factor.Cons" ]
+    "factor.FactorNamespace" "importVars"
     jinvoke ;
 
+: parent ( -- namespace )
+    ! Push the parent of the current namespace.
+    namespace [ ] "factor.FactorNamespace" "getParent" jinvoke ;
+
+: this ( -- object )
+    ! Returns the object bound to the current namespace, or if
+    ! no object is bound, the namespace itself.
+    namespace dup
+    [ ] "factor.FactorNamespace" "getThis" jinvoke dup rot ?
+    ; inline
+
 : vars ( -- list )
-    $namespace [ ] |factor.FactorNamespace |toVarList jinvoke ;
+    vars-values [ car ] inject ;
 
-: values ( -- list )
-    $namespace [ ] |factor.FactorNamespace |toValueList
+: vars-values ( -- list )
+    namespace [ ] "factor.FactorNamespace" "toVarValueList"
     jinvoke ;
 
-: uvalues ( -- list )
-    values [ car uvar? ] subset ;
+: values ( -- list )
+    vars-values [ cdr ] inject ;
 
-: uvar? ( name -- )
-    [ "namespace" "parent" "this" ] contains not ;
+: vars. ( -- )
+    ! Print a list of defined variables.
+    vars [ print ] each ;
 
-: uvars ( -- list )
-    ! Does not include "namespace" and "parent" variables; ie,
-    ! all user-defined variables in given namespace.
-    vars [ uvar? ] subset ;
+: var. ( [ name , value ] -- )
+    uncons unparse swap relative>absolute-object-path
+    "link" swap cons unit write-attr ;
+
+: value. ( max [ name , value ] -- )
+    dup [ car tuck pad-string write write ] dip
+    ": " write
+    var. terpri ;
+
+: vars-values. ( namespace -- )
+    #! Prints all name/value pairs defined in the current
+    #! namespace to standard output.
+    [ vars max-str-length vars-values ] bind
+    [ dupd value. ] each drop ;

factor/network.factor

@@ -25,9 +25,15 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+: <client> ( server port -- stream )
+    #! Open a TCP/IP socket to a port on the given server.
+    [ "java.lang.String" "int" ] "java.net.Socket" jnew
+    <socketstream> ;
+
 : <server> ( port -- stream )
-    ! Starts listening on localhost:port. Returns a stream that you can close
-    ! with fclose. No other stream operations are supported.
+    #! Starts listening on localhost:port. Returns a stream that
+    #! you can close with fclose. No other stream operations are
+    #! supported.
     [ "int" ] "java.net.ServerSocket" jnew
     <stream> [
         @socket
@@ -39,15 +45,15 @@
     ] extend ;
 
 : <socketstream> ( socket -- stream )
-    ! Wraps a socket inside a bytestream.
+    #! Wraps a socket inside a byte-stream.
     dup
     [ [ ] "java.net.Socket" "getInputStream"  jinvoke ]
     [ [ ] "java.net.Socket" "getOutputStream" jinvoke ]
     cleave
-    <bytestream> [
+    <byte-stream> [
         @socket
 
-        ! We "extend" bytestream's fclose.
+        ! We "extend" byte-stream's fclose.
         ( -- )
         $fclose [
             $socket [ ] "java.net.Socket" "close" jinvoke
@@ -55,6 +61,6 @@
     ] extend ;
 
 : accept ( server -- client )
-    ! Accept a connection from a server socket.
+    #! Accept a connection from a server socket.
     [ $socket ] bind
     [ ] "java.net.ServerSocket" "accept" jinvoke <socketstream> ;

factor/parser.factor

@@ -28,28 +28,18 @@
 : parse ( string -- list )
     f swap <sreader> parse* ;
 
+: parse-file ( file -- list )
+    dup <freader> parse* ;
+
 : compile-call ( [ X ] -- X )
     no-name dup compile execute ;
 
 : 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" )
-    [ |java.lang.Object ] |factor.FactorParser |unparse
-    jinvoke-static ;
-
-: . ( expr -- )
-    unparse print ;
+: run-file ( path -- )
+    parse-file call ;
 
 : parse-number ( str -- number )
-    parse dup length 1 = [
-        car dup number? [ drop f ] unless
-    ] [
-        drop f
-    ] ifte ;
+    [ "java.lang.String" ] "factor.FactorScanner" "parseNumber"
+    jinvoke-static ;

factor/parser/Bra.java

@@ -0,0 +1,45 @@
+/* :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.parser;
+
+import factor.*;
+
+public class Bra extends FactorParsingDefinition
+{
+	public Bra(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+	{
+		reader.pushState(word);
+	}
+}

factor/parser/CharLiteral.java

@@ -0,0 +1,49 @@
+/* :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.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class CharLiteral extends FactorParsingDefinition
+{
+	public CharLiteral(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException
+	{
+		reader.append(new Character(
+			reader.getScanner()
+			.readNonEOFEscaped()));
+	}
+}

factor/parser/Comma.java

@@ -0,0 +1,49 @@
+/* :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.parser;
+
+import factor.*;
+
+public class Comma extends FactorParsingDefinition
+{
+	public Comma(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		FactorReader.ParseState state = reader.getCurrentState();
+		if(state.start != interp.intern("["))
+			reader.error(", only allowed inside [ ... ]");
+		reader.comma();
+	}
+}

factor/parser/Def.java

@@ -0,0 +1,46 @@
+/* :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.parser;
+
+import factor.*;
+
+public class Def extends FactorParsingDefinition
+{
+	public Def(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		reader.pushExclusiveState(word);
+	}
+}

factor/parser/Dispatch.java

@@ -0,0 +1,56 @@
+/* :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.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class Dispatch extends FactorParsingDefinition
+{
+	public Dispatch(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException
+	{
+		char next = reader.getScanner().readNonEOF();
+		String dispatch = word.name + next;
+		FactorWord dispatchWord = interp.intern(dispatch);
+		if(dispatchWord.parsing != null)
+			dispatchWord.parsing.eval(interp,reader);
+		else
+		{
+			reader.error("Unknown dispatch: "
+				+ dispatch);
+		}
+	}
+}

factor/parser/F.java

@@ -0,0 +1,46 @@
+/* :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.parser;
+
+import factor.*;
+
+public class F extends FactorParsingDefinition
+{
+	public F(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		reader.append(null);
+	}
+}

factor/parser/Fle.java

@@ -0,0 +1,190 @@
+/* :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.parser;
+
+import factor.*;
+import java.util.*;
+
+public class Fle extends FactorParsingDefinition
+{
+	private FactorWord start;
+
+	public Fle(FactorWord start, FactorWord end)
+	{
+		super(end);
+		this.start = start;
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		Cons definition = reader.popState(start,word);
+		if(definition == null)
+			reader.error("Missing word name");
+		if(!(definition.car instanceof FactorWord))
+		{
+			reader.error("Not a word name: "
+				+ definition.car);
+		}
+
+		FactorWord w = (FactorWord)definition.car;
+		reader.append(w.name);
+		reader.append(createShuffle(
+			interp,reader,w,definition.next()));
+		reader.append(interp.intern("define"));
+	}
+
+	private FactorShuffleDefinition createShuffle(
+		FactorInterpreter interp, FactorReader reader,
+		FactorWord word, Cons definition)
+		throws FactorParseException
+	{
+		FactorWord f = interp.intern("--");
+
+		// 0 in consume map is last consumed, n is first consumed.
+		HashMap consumeMap = new HashMap();
+		int consumeD = 0;
+		int consumeR = 0;
+
+		while(definition != null)
+		{
+			Object next = definition.car;
+			if(next == f)
+			{
+				definition = definition.next();
+				break;
+			}
+			else if(next instanceof FactorWord)
+			{
+				String name = ((FactorWord)next).name;
+				int counter;
+				if(name.startsWith("r:"))
+				{
+					next = interp.intern(name.substring(2));
+					counter = (FactorShuffleDefinition
+						.FROM_R_MASK
+						| consumeR++);
+				}
+				else
+					counter = consumeD++;
+
+				Object existing = consumeMap.put(next,
+					new Integer(counter));
+				if(existing != null)
+					reader.error(
+						word + ": appears twice in shuffle LHS: "
+						+ next);
+			}
+			else if(!(next instanceof FactorDocComment))
+			{
+				reader.error(word + ": unexpected "
+					+ FactorReader.unparseObject(
+					next));
+			}
+			definition = definition.next();
+		}
+
+		int consume = consumeMap.size();
+
+		if(definition == null)
+		{
+			return new FactorShuffleDefinition(word,
+				consumeD,consumeR,
+				null,0,null,0);
+		}
+
+		int[] shuffle = new int[definition.length()];
+
+		int shuffleDlength = 0;
+		int shuffleRlength = 0;
+
+		int i = 0;
+		while(definition != null)
+		{
+			if(definition.car instanceof FactorWord)
+			{
+				FactorWord w = ((FactorWord)definition.car);
+				String name = w.name;
+				if(name.startsWith("r:"))
+					w = interp.intern(name.substring(2));
+
+				Integer _index = (Integer)consumeMap.get(w);
+				if(_index == null)
+				{
+					reader.error(word +
+						": does not appear in shuffle LHS: "
+						+ definition.car);
+				}
+
+				int index = _index.intValue();
+
+				if(name.startsWith("r:"))
+				{
+					shuffleRlength++;
+					shuffle[i++] = (index
+						| FactorShuffleDefinition
+						.TO_R_MASK);
+				}
+				else
+				{
+					shuffleDlength++;
+					shuffle[i++] = index;
+				}
+			}
+			else if(!(definition.car instanceof FactorDocComment))
+			{
+				reader.error(word + ": unexpected "
+					+ FactorReader.unparseObject(
+					definition.car));
+			}
+			definition = definition.next();
+		}
+
+		int[] shuffleD = new int[shuffleDlength];
+		int[] shuffleR = new int[shuffleRlength];
+		int j = 0, k = 0;
+		for(i = 0; i < shuffle.length; i++)
+		{
+			int index = shuffle[i];
+			if((index & FactorShuffleDefinition.TO_R_MASK)
+				== FactorShuffleDefinition.TO_R_MASK)
+			{
+				index = (index
+					& ~FactorShuffleDefinition.TO_R_MASK);
+				shuffleR[j++] = index;
+			}
+			else
+				shuffleD[k++] = index;
+		}
+
+		return new FactorShuffleDefinition(word,consumeD,consumeR,
+			shuffleD,shuffleDlength,shuffleR,shuffleRlength);
+	}
+}

factor/parser/Ine.java

@@ -0,0 +1,62 @@
+/* :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.parser;
+
+import factor.*;
+
+public class Ine extends FactorParsingDefinition
+{
+	private FactorWord start;
+
+	public Ine(FactorWord start, FactorWord end)
+	{
+		super(end);
+		this.start = start;
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		Cons definition = reader.popState(start,word);
+		if(definition == null)
+			reader.error("Missing word name");
+		if(!(definition.car instanceof FactorWord))
+		{
+			reader.error("Not a word name: "
+				+ definition.car);
+		}
+
+		FactorWord w = (FactorWord)definition.car;
+		reader.append(w.name);
+		reader.append(new FactorCompoundDefinition(
+			w,definition.next()));
+		reader.append(interp.intern("define"));
+	}
+}

factor/parser/Ket.java

@@ -0,0 +1,49 @@
+/* :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.parser;
+
+import factor.*;
+
+public class Ket extends FactorParsingDefinition
+{
+	private FactorWord start;
+
+	public Ket(FactorWord start, FactorWord end)
+	{
+		super(end);
+		this.start = start;
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		reader.append(reader.popState(start,word));
+	}
+}

factor/parser/LineComment.java

@@ -3,7 +3,7 @@
 /*
  * $Id$
  *
- * Copyright (C) 2003, 2004 Slava Pestov.
+ * 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:
@@ -27,44 +27,26 @@
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-package factor.primitives;
+package factor.parser;
 
-import factor.compiler.*;
 import factor.*;
-import java.util.Map;
+import java.io.IOException;
 
-public class Set extends FactorWordDefinition
+public class LineComment extends FactorParsingDefinition
 {
-	//{{{ Set constructor
-	public Set(FactorWord word)
+	private boolean doc;
+
+	public LineComment(FactorWord word, boolean doc)
 	{
 		super(word);
-	} //}}}
+		this.doc = doc;
+	}
 
-	//{{{ eval() method
-	public void eval(FactorInterpreter interp)
-		throws Exception
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException
 	{
-		FactorDataStack datastack = interp.datastack;
-		Object name = datastack.pop();
-		Object value = datastack.pop();
-		core(interp,value,name);
-	} //}}}
-
-	//{{{ core() method
-	public static void core(FactorInterpreter interp,
-		Object value, Object name) throws Exception
-	{
-		interp.callframe.namespace.setVariable(
-			FactorJava.toString(name),value);
-	} //}}}
-
-	//{{{ getStackEffect() method
-	public void getStackEffect(RecursiveState recursiveCheck,
-		FactorCompiler state) throws FactorStackException
-	{
-		state.ensure(state.datastack,2);
-		state.pop(null);
-		state.pop(null);
-	} //}}}
+		String comment = reader.getScanner().readUntilEOL();
+		if(doc)
+			reader.append(new FactorDocComment(comment,false));
+	}
 }

factor/parser/Prefix.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.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class Prefix extends FactorParsingDefinition
+{
+	private FactorWord expansion;
+
+	public Prefix(FactorWord word, FactorWord expansion)
+	{
+		super(word);
+		this.expansion = expansion;
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException, IOException
+	{
+		if(reader.getScanner().atEndOfWord())
+			reader.append(word);
+		else
+		{
+			Object next = reader.getScanner().next(false,false);
+			reader.append(((FactorWord)next).name);
+			reader.append(expansion);
+		}
+	}
+}

factor/parser/Shu.java

@@ -0,0 +1,46 @@
+/* :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.parser;
+
+import factor.*;
+
+public class Shu extends FactorParsingDefinition
+{
+	public Shu(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		reader.pushExclusiveState(word);
+	}
+}

factor/parser/StackComment.java

@@ -0,0 +1,49 @@
+/* :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.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class StackComment extends FactorParsingDefinition
+{
+	public StackComment(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException
+	{
+		String comment = reader.getScanner().readUntil(
+			'(',')',false,false);
+		reader.append(new FactorDocComment(comment,true));
+	}
+}

factor/parser/StringLiteral.java

@@ -0,0 +1,49 @@
+/* :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.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class StringLiteral extends FactorParsingDefinition
+{
+	public StringLiteral(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException
+	{
+		String literal = reader.getScanner().readUntil(
+			'"','"',false,true);
+		reader.append(literal);
+	}
+}

factor/parser/T.java

@@ -0,0 +1,46 @@
+/* :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.parser;
+
+import factor.*;
+
+public class T extends FactorParsingDefinition
+{
+	public T(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws FactorParseException
+	{
+		reader.append(Boolean.TRUE);
+	}
+}

factor/parser/Unreadable.java

@@ -0,0 +1,48 @@
+/* :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.parser;
+
+import factor.*;
+import java.io.IOException;
+
+public class Unreadable extends FactorParsingDefinition
+{
+	public Unreadable(FactorWord word)
+	{
+		super(word);
+	}
+
+	public void eval(FactorInterpreter interp, FactorReader reader)
+		throws IOException, FactorParseException
+	{
+		reader.getScanner().error("Objects prefixed with " + word
+			+ " are unreadable");
+	}
+}

factor/presentation.factor

@@ -0,0 +1,85 @@
+!:folding=indent: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.
+
+: fwrite-attr ( string attrs stream -- )
+    #! Write an attributed string to the given stream.
+    #! The attributes are an alist; supported keys depend
+    #! on the type of stream.
+    [ $fwrite-attr [ drop $fwrite ] unless* call ] bind ;
+
+: write-attr ( attrs stream -- )
+    #! Write an attributed string to standard output.
+    $stdio fwrite-attr ;
+
+: <html-stream> ( stream -- stream )
+    #! Wraps the given stream in an HTML stream. An HTML stream
+    #! converts special characters to entities when being
+    #! written, and supports writing attributed strings with
+    #! the 'link' attribute.
+    <extend-stream> [
+        [ chars>entities $stream fwrite ] @fwrite
+        [ chars>entities $stream fwriteln ] @fwriteln
+        [ $stream <html-stream>/fwrite-attr ] @fwrite-attr
+    ] extend ;
+
+: object-path>link ( objpath -- string )
+    chars>entities "inspect.lhtml?" swap cat2 ;
+
+: html-link-string ( string link -- string )
+    "<a href=\"" swap object-path>link "\">" cat3
+    swap chars>entities
+    "</a>" cat3 ;
+
+: html-attr-string ( string attrs -- string )
+    "link" swap assoc dup string? [
+        html-link-string
+    ] [
+        drop
+    ] ifte ;
+
+: <html-stream>/fwrite-attr ( string attrs stream -- )
+    [ html-attr-string ] dip fwrite ;
+
+: unparse ( X -- "X" )
+    [ "java.lang.Object" ] "factor.FactorReader" "unparseObject"
+    jinvoke-static ;
+
+: word-link ( word -- link )
+    "dict'" swap "'def" cat3 ;
+
+: defined-word? ( obj -- ? )
+    dup word? [ worddef ] [ drop f ] ifte ;
+
+: unparse. ( X -- "X" )
+    dup defined-word? [
+        "link" over word-link >str cons unit write-attr
+    ] [
+        unparse write
+    ] ifte ;
+
+: . ( expr -- )
+    unparse. terpri ;

factor/prettyprint.factor

@@ -25,152 +25,96 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-4 @indent
+: tab-size
+    #! Change this to suit your tastes.
+    4 ;
 
-: <prettyprint-token> ( string -- token )
-    dup <namespace> [
-        @name
-        t @prettyprint-token
-    ] extend tuck s@ ;
+: prettyprint-indent ( indent -- )
+    #! Print the given number of spaces.
+    spaces write ;
 
-: prettyprint-token? ( token -- token? )
-    dup has-namespace? [
-        [ $prettyprint-token ] bind
-    ] [
-        drop f
-    ] ifte ;
+: prettyprint-newline ( indent -- )
+    "\n" write prettyprint-indent ;
 
-: prettyprint-indent ( indent -- indent )
-    dup spaces write ;
+: prettyprint-space ( -- )
+    " " write ;
 
-: prettyprint-newline/space ( indent ? -- indent )
-    [ "\n" write prettyprint-indent ] [ " " write ] ifte ;
+: prettyprint-[ ( indent -- indent )
+    "[" write
+    tab-size + dup prettyprint-newline ;
 
-: prettyprint-indent-params ( indent obj -- indent ? ? name )
-    [
-        $indent+ [ $indent + ] when
-        $indent- [ $indent - ] when
-        $-indent [ $indent - t ] [ f ] ifte
-        $newline
-        $name
-    ] bind ;
+: prettyprint-] ( indent -- indent )
+    tab-size - dup prettyprint-newline
+    "]" write
+    prettyprint-space ;
 
-: prettyprint-token ( indent obj -- indent )
-    prettyprint-indent-params
-    [
-        [
-            "\n" write
-            prettyprint-indent
-        ] when
-    ] 2dip
-    write prettyprint-newline/space ;
+: prettyprint-[] ( indent list -- indent )
+    swap prettyprint-[ swap prettyprint-list prettyprint-] ;
 
-: prettyprint-unparsed ( indent unparse -- indent )
-    dup "\n" = [
-        drop "\n" write prettyprint-indent
-    ] [
-        write " " write
-    ] ifte ;
+: prettyprint-: ( indent -- indent )
+    ":" write prettyprint-space
+    tab-size + ;
 
-: [prettyprint-tty] ( indent obj -- indent )
-    dup prettyprint-token? [
-        prettyprint-token
-    ] [
-        unparse prettyprint-unparsed
-    ] ifte ;
+: prettyprint-; ( indent -- indent )
+    ";" write
+    tab-size - ;
 
-: prettyprint-html-unparse ( obj -- unparse )
-    dup unparse dup "\n" = [
-        nip
-    ] [
-        swap word? [
-            "<a href=\"see.lhtml?" swap "\">" over "</a>" cat5
+: prettyprint-inline ( worddef -- )
+    word-of-worddef [ $inline ] bind [
+        " inline" write
+    ] when ;
+
+: prettyprint-:; ( indent list -- indent )
+    swap prettyprint-: swap prettyprint-list prettyprint-; ;
+
+: prettyprint-~<< ( indent -- indent )
+    "~<<" write prettyprint-space
+    tab-size + ;
+
+: prettyprint->>~ ( indent -- indent )
+    ">>~" write
+    tab-size - dup prettyprint-newline ;
+
+: prettyprint-~<<>>~ ( indent list -- indent )
+    swap prettyprint-~<< swap prettyprint-list prettyprint->>~ ;
+
+: word-or-comment? ( obj -- ? )
+    [ word? ] [ comment? ] cleave or ;
+
+: prettyprint-object ( indent obj -- indent )
+    dup word-or-comment? [
+        dup >str ends-with-newline? [
+            write dup prettyprint-indent
         ] [
-            chars>entities
+            unparse. " " write
         ] ifte
-    ] ifte ;
-
-: [prettyprint-html] ( indent obj -- indent )
-    dup prettyprint-token? [
-        prettyprint-token
     ] [
-        prettyprint-html-unparse prettyprint-unparsed
+        unparse. " " write
     ] ifte ;
 
-: prettyprint-list* ( quot list -- )
-    ! Pretty-print a list, without [ and ].
-    [
-        over [
-            prettyprint*
-        ] dip
-    ] each
-    ! Drop the quotation
-    drop ;
+: prettyprint-list ( indent list -- indent )
+    #! Pretty-print a list, without [ and ].
+    [ prettyprint* ] each ;
 
-: 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 ;
+: compound-or-compiled? ( worddef -- ? )
+    dup compiled? swap compound? or ;
 
-: prettyprint* ( quot obj -- )
+: prettyprint* ( indent obj -- indent )
     [
-        [ 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 ]
+        [ not       ] [ prettyprint-object ]
+        [ list?     ] [ prettyprint-[] ]
+        [ compound-or-compiled? ] [
+            tuck worddef>list
+            prettyprint-:;
+            swap prettyprint-inline
+            dup prettyprint-newline
+        ]
+        [ shuffle?  ] [ worddef>list prettyprint-~<<>>~ ]
+        [ drop t    ] [ prettyprint-object ]
     ] cond ;
 
-: prettyprint-tty ( list -- )
-    0 [ [prettyprint-tty] ] rot prettyprint* drop ;
-
-: prettyprint-html ( list -- )
-    0 [ [prettyprint-html] ] rot prettyprint* drop ;
+: prettyprint ( list -- )
+    0 swap 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
+    worddef prettyprint ;

factor/primitives/Bind.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class Bind extends FactorWordDefinition
+public class Bind extends FactorPrimitiveDefinition
 {
 	//{{{ Bind constructor
 	public Bind(FactorWord word)

factor/primitives/Call.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class Call extends FactorWordDefinition
+public class Call extends FactorPrimitiveDefinition
 {
 	//{{{ Call constructor
 	public Call(FactorWord word)

factor/primitives/CallstackGet.java

@@ -34,7 +34,7 @@ import factor.*;
 import java.util.Set;
 import org.objectweb.asm.*;
 
-public class CallstackGet extends FactorWordDefinition
+public class CallstackGet extends FactorPrimitiveDefinition
 {
 	//{{{ CallstackGet constructor
 	public CallstackGet(FactorWord word)

factor/primitives/CallstackSet.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class CallstackSet extends FactorWordDefinition
+public class CallstackSet extends FactorPrimitiveDefinition
 {
 	//{{{ CallstackSet constructor
 	public CallstackSet(FactorWord word)

factor/primitives/Choice.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import org.objectweb.asm.*;
 
-public class Choice extends FactorWordDefinition
+public class Choice extends FactorPrimitiveDefinition
 {
 	//{{{ Choice constructor
 	public Choice(FactorWord word)

factor/primitives/Clear.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class Clear extends FactorWordDefinition
+public class Clear extends FactorPrimitiveDefinition
 {
 	//{{{ Clear constructor
 	public Clear(FactorWord word)

factor/primitives/DatastackGet.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class DatastackGet extends FactorWordDefinition
+public class DatastackGet extends FactorPrimitiveDefinition
 {
 	//{{{ DatastackGet constructor
 	public DatastackGet(FactorWord word)

factor/primitives/DatastackSet.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class DatastackSet extends FactorWordDefinition
+public class DatastackSet extends FactorPrimitiveDefinition
 {
 	//{{{ DatastackSet constructor
 	public DatastackSet(FactorWord word)

factor/primitives/Define.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Map;
 
-public class Define extends FactorWordDefinition
+public class Define extends FactorPrimitiveDefinition
 {
 	//{{{ Define constructor
 	public Define(FactorWord word)
@@ -64,9 +64,16 @@ public class Define extends FactorWordDefinition
 
 		if(def instanceof Cons)
 		{
+			// old-style compound definition.
 			def = new FactorCompoundDefinition(
 				newWord,(Cons)def);
 		}
+		else if(def instanceof String)
+		{
+			// a class name...
+			def = CompiledDefinition.create(interp,newWord,
+				Class.forName((String)def));
+		}
 
 		newWord.define((FactorWordDefinition)def);
 		interp.last = newWord;

factor/primitives/Execute.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Set;
 import org.objectweb.asm.*;
 
-public class Execute extends FactorWordDefinition
+public class Execute extends FactorPrimitiveDefinition
 {
 	//{{{ Execute constructor
 	public Execute(FactorWord word)

factor/primitives/InterpreterGet.java

@@ -31,12 +31,13 @@ package factor.primitives;
 
 import factor.compiler.*;
 import factor.*;
-import java.util.Map;
+import java.util.Set;
+import org.objectweb.asm.*;
 
-public class Get extends FactorWordDefinition
+public class InterpreterGet extends FactorPrimitiveDefinition
 {
-	//{{{ Get constructor
-	public Get(FactorWord word)
+	//{{{ InterpreterGet constructor
+	public InterpreterGet(FactorWord word)
 	{
 		super(word);
 	} //}}}
@@ -45,24 +46,29 @@ public class Get extends FactorWordDefinition
 	public void eval(FactorInterpreter interp)
 		throws Exception
 	{
-		FactorDataStack datastack = interp.datastack;
-		datastack.push(core(interp,datastack.pop()));
-	} //}}}
-
-	//{{{ core() method
-	public static Object core(FactorInterpreter interp,
-		Object name) throws Exception
-	{
-		return interp.callframe.namespace.getVariable(
-			FactorJava.toString(name));
+		interp.datastack.push(interp);
 	} //}}}
 
 	//{{{ getStackEffect() method
 	public void getStackEffect(RecursiveState recursiveCheck,
 		FactorCompiler state) throws FactorStackException
 	{
-		state.ensure(state.datastack,1);
-		state.pop(null);
 		state.push(null);
 	} //}}}
+
+	//{{{ compileCallTo() method
+	/**
+	 * Compile a call to this word. Returns maximum JVM stack use.
+	 * XXX: does not use factor type system conversions.
+	 */
+	public int compileCallTo(
+		CodeVisitor mw,
+		FactorCompiler compiler,
+		RecursiveState recursiveCheck)
+		throws Exception
+	{
+		mw.visitVarInsn(ALOAD,0);
+		compiler.push(mw);
+		return 1;
+	} //}}}
 }

factor/primitives/JInvoke.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JInvoke extends FactorWordDefinition
+public class JInvoke extends FactorPrimitiveDefinition
 {
 	//{{{ JInvoke constructor
 	public JInvoke(FactorWord word)
@@ -119,7 +119,7 @@ public class JInvoke extends FactorWordDefinition
 			compiler.pop(mw);
 			FactorJava.generateFromConversion(mw,cls);
 
-			compiler.generateArgs(mw,args.length,args);
+			compiler.generateArgs(mw,args.length,0,args);
 
 			int opcode;
 			if(cls.isInterface())

factor/primitives/JInvokeStatic.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JInvokeStatic extends FactorWordDefinition
+public class JInvokeStatic extends FactorPrimitiveDefinition
 {
 	//{{{ JInvokeStatic constructor
 	public JInvokeStatic(FactorWord word)
@@ -114,7 +114,7 @@ public class JInvokeStatic extends FactorWordDefinition
 
 			FactorJava.generateToConversionPre(mw,returnType);
 
-			compiler.generateArgs(mw,args.length,args);
+			compiler.generateArgs(mw,args.length,0,args);
 
 			mw.visitMethodInsn(INVOKESTATIC,
 				clazz,

factor/primitives/JNew.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JNew extends FactorWordDefinition
+public class JNew extends FactorPrimitiveDefinition
 {
 	//{{{ JNew constructor
 	public JNew(FactorWord word)
@@ -106,7 +106,7 @@ public class JNew extends FactorWordDefinition
 			mw.visitTypeInsn(NEW,clazz);
 			mw.visitInsn(DUP);
 
-			compiler.generateArgs(mw,args.length,args);
+			compiler.generateArgs(mw,args.length,0,args);
 
 			mw.visitMethodInsn(INVOKESPECIAL,
 				clazz,

factor/primitives/JVarGet.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JVarGet extends FactorWordDefinition
+public class JVarGet extends FactorPrimitiveDefinition
 {
 	//{{{ JVarGet constructor
 	public JVarGet(FactorWord word)

factor/primitives/JVarGetStatic.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JVarGetStatic extends FactorWordDefinition
+public class JVarGetStatic extends FactorPrimitiveDefinition
 {
 	//{{{ JVarGetStatic constructor
 	public JVarGetStatic(FactorWord word)

factor/primitives/JVarSet.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JVarSet extends FactorWordDefinition
+public class JVarSet extends FactorPrimitiveDefinition
 {
 	//{{{ JVarSet constructor
 	public JVarSet(FactorWord word)

factor/primitives/JVarSetStatic.java

@@ -35,7 +35,7 @@ import java.lang.reflect.*;
 import java.util.Map;
 import org.objectweb.asm.*;
 
-public class JVarSetStatic extends FactorWordDefinition
+public class JVarSetStatic extends FactorPrimitiveDefinition
 {
 	//{{{ JVarSetStatic constructor
 	public JVarSetStatic(FactorWord word)

factor/primitives/Restack.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class Restack extends FactorWordDefinition
+public class Restack extends FactorPrimitiveDefinition
 {
 	//{{{ Restack constructor
 	public Restack(FactorWord word)

factor/primitives/Unstack.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class Unstack extends FactorWordDefinition
+public class Unstack extends FactorPrimitiveDefinition
 {
 	//{{{ Unstack constructor
 	public Unstack(FactorWord word)

factor/primitives/Unwind.java

@@ -33,7 +33,7 @@ import factor.compiler.*;
 import factor.*;
 import java.util.Set;
 
-public class Unwind extends FactorWordDefinition
+public class Unwind extends FactorPrimitiveDefinition
 {
 	//{{{ Unwind constructor
 	public Unwind(FactorWord word)

factor/random.factor

@@ -61,7 +61,7 @@
     ! Returns a random subset of the given list. Each item is
     ! chosen with a 50%
     ! probability.
-    [ random-boolean [ drop ] when ] map ;
+    [ drop random-boolean ] subset ;
 
 : car+ ( list -- sum )
     ! Adds the car of each element of the given list.

factor/stack.factor

@@ -0,0 +1,65 @@
+!: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.
+
+~<< drop              A --             >>~
+~<< 2drop           A B --             >>~
+~<< 2dup            A B -- A B A B     >>~
+~<< 3dup          A B C -- A B C A B C >>~
+~<< dupd            A B -- A A B       >>~
+~<< 2dupd       A B C D -- A B A B C D >>~
+~<< nip             A B -- B           >>~
+~<< 2nip        A B C D -- C D         >>~
+~<< nop                 --             >>~ ! Does nothing!
+~<< over            A B -- A B A       >>~
+~<< 2over       A B C D -- A B C D A B >>~
+~<< pick          A B C -- A B C A     >>~ ! Not the Forth pick!
+~<< rot           A B C -- B C A       >>~
+~<< 2rot    A B C D E F -- C D E F A B >>~
+~<< -rot          A B C -- C A B       >>~
+~<< 2-rot   A B C D E F -- E F A B C D >>~
+~<< swap            A B -- B A         >>~
+~<< 2swap       A B C D -- C D A B     >>~
+~<< swapd         A B C -- B A C       >>~
+~<< 2swapd  A B C D E F -- C D A B E F >>~
+~<< transp        A B C -- C B A       >>~
+~<< 2transp A B C D E F -- E F C D A B >>~
+~<< tuck            A B -- B A B       >>~
+~<< 2tuck       A B C D -- C D A B C D >>~
+
+~<< rdrop   r:A --                 >>~
+~<< rover   r:A r:B -- r:A r:B r:A >>~
+~<< >r        A -- r:A             >>~
+~<< 2>r     A B -- r:A r:B         >>~
+~<< r>      r:A -- A               >>~
+~<< 2r> r:A r:B -- A B             >>~
+
+: stack? ( obj -- ? )
+    "factor.FactorArrayStack" is ;
+
+: stack>list (stack -- list)
+    #! Turns a callstack or datastack object into a list.
+    [ ] "factor.FactorArrayStack" "toList" jinvoke ;

factor/stream.factor

@@ -25,21 +25,18 @@
 ! 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:
-    ! - fflush
-    ! - freadln -- you must provide an implementation!
-    ! - fwriteln
-    ! - fwrite -- you must provide an implementation!
-    ! - fclose
-    ! Note that you must extend this object and provide your own
-    ! implementations of all entries except for fwriteln, which
-    ! is defined to fwrite the string followed by the newline by
-    ! default.
+    #! Create a stream object. A stream is a namespace with the
+    #! following entries:
+    #! - fflush
+    #! - freadln -- you must provide an implementation!
+    #! - fwriteln
+    #! - fwrite -- you must provide an implementation!
+    #! - fclose
+    #! Note that you must extend this object and provide your own
+    #! implementations of all entries except for fwriteln, which
+    #! is defined to fwrite the string followed by the newline by
+    #! default.
     <namespace> [
         ( -- string )
         [ "freadln not implemented." break ] @freadln
@@ -52,108 +49,138 @@
         ( -- )
         [ ] @fclose
         ( string -- )
-        [ $namespace fwrite "\n" $namespace fwrite ] @fwriteln
+        [ this fwrite "\n" this fwrite ] @fwriteln
+    ] extend ;
+
+: <extend-stream> ( stream -- stream )
+    <stream> [
+        @stream
+        ( -- string )
+        [ $stream freadln ] @freadln
+        ( string -- )
+        [ $stream fwrite ] @fwrite
+        ( string -- )
+        [ $stream fedit ] @fedit
+        ( -- )
+        [ $stream fflush ] @fflush
+        ( -- )
+        [ $stream fclose ] @fclose
+        ( string -- )
+        [ $stream fwriteln ] @fwriteln
     ] extend ;
 
 ! These are in separate words so that they can be compiled.
 ! Do not call them directly.
 
-: <bytestream>/freadln ( -- string )
+: <byte-stream>/freadln ( -- string )
     $in [ "java.io.InputStream" ] "factor.FactorLib" "readLine"
     jinvoke-static ;
 
-: <bytestream>/fwrite ( string -- )
+: <byte-stream>/fwrite ( string -- )
     >bytes
     $out [ [ "byte" ] ]
     "java.io.OutputStream" "write" jinvoke ;
 
-: <bytestream>/fflush ( -- )
+: <byte-stream>/fflush ( -- )
     $out [ ] "java.io.OutputStream" "flush" jinvoke ;
 
-: <bytestream>/fclose ( -- )
-    $in  [ ] "java.io.InputStream"  "close" jinvoke
-    $out [ ] "java.io.OutputStream" "close" jinvoke ;
+: <byte-stream>/fclose ( -- )
+    $in  [ [ ] "java.io.InputStream"  "close" jinvoke ] when* 
+    $out [ [ ] "java.io.OutputStream" "close" jinvoke ] when* ;
 
-: <bytestream> ( in out -- stream )
-    ! Creates a new stream for reading from the
-    ! java.io.InputStream in, and writing to the
-    ! java.io.OutputStream out.
+: <byte-stream> ( in out -- stream )
+    #! Creates a new stream for reading from the
+    #! java.io.InputStream in, and writing to the
+    #! java.io.OutputStream out.
     <stream> [
         @out
         @in
         ( -- string )
-        [ <bytestream>/freadln ] @freadln
+        [ <byte-stream>/freadln ] @freadln
         ( string -- )
-        [ <bytestream>/fwrite  ] @fwrite
+        [ <byte-stream>/fwrite  ] @fwrite
         ( -- )
-        [ <bytestream>/fflush  ] @fflush
+        [ <byte-stream>/fflush  ] @fflush
         ( -- )
-        [ <bytestream>/fclose  ] @fclose
+        [ <byte-stream>/fclose  ] @fclose
     ] extend ;
 
-: <charstream>/freadln ( -- string )
+: <char-stream>/freadln ( -- string )
     $in [ ] "java.io.BufferedReader" "readLine"
     jinvoke ;
 
-: <charstream>/fwrite ( string -- )
+: <char-stream>/fwrite ( string -- )
     $out [ "java.lang.String" ] "java.io.Writer" "write"
     jinvoke ;
 
-: <charstream>/fflush ( -- )
+: <char-stream>/fflush ( -- )
     $out [ ] "java.io.Writer" "flush" jinvoke ;
 
-: <charstream>/fclose ( -- )
-    $in  [ ] "java.io.Reader" "close" jinvoke
-    $out [ ] "java.io.Writer" "close" jinvoke ;
+: <char-stream>/fclose ( -- )
+    $in  [ [ ] "java.io.Reader" "close" jinvoke ] when* 
+    $out [ [ ] "java.io.Writer" "close" jinvoke ] when* ;
 
-: <charstream> ( in out -- stream )
-    ! Creates a new stream for reading from the
-    ! java.io.BufferedReader in, and writing to the
-    ! java.io.Reader out.
+: <char-stream> ( in out -- stream )
+    #! Creates a new stream for reading from the
+    #! java.io.BufferedReader in, and writing to the
+    #! java.io.Reader out.
     <stream> [
         @out
         @in
         ( -- string )
-        [ <charstream>/freadln ] @freadln
+        [ <char-stream>/freadln ] @freadln
         ( string -- )
-        [ <charstream>/fwrite  ] @fwrite
+        [ <char-stream>/fwrite  ] @fwrite
         ( -- )
-        [ <charstream>/fflush  ] @fflush
+        [ <char-stream>/fflush  ] @fflush
         ( -- )
-        [ <charstream>/fclose  ] @fclose
+        [ <char-stream>/fclose  ] @fclose
     ] extend ;
 
+: <string-output-stream> ( -- stream )
+    #! Creates a new stream for writing to a string buffer.
+    <stream> [
+        <sbuf> @buf
+        ( string -- )
+        [ $buf sbuf-append drop ] @fwrite
+    ] extend ;
+
+: stream>str ( stream -- string )
+    #! Returns the string written to the given string output
+    #! stream.
+    [ $buf ] bind >str ;
+
 : <filecr> ( path -- stream )
-    [ |java.lang.String ] |java.io.FileReader jnew <breader>
+    [ "java.lang.String" ] "java.io.FileReader" jnew <breader>
     f
-    <charstream> ;
+    <char-stream> ;
 
 : <filecw> ( path -- stream )
-    f
-    [ |java.lang.String ] |java.io.FileWriter jnew <bwriter>
-    <charstream> ;
+    [ "java.lang.String" ] "java.io.FileWriter" jnew <bwriter>
+    f swap
+    <char-stream> ;
 
 : <filebr> ( path -- stream )
-    [ |java.lang.String ] |java.io.FileInputStream jnew
+    [ "java.lang.String" ] "java.io.FileInputStream" jnew
     f
-    <bytestream> ;
+    <byte-stream> ;
 
 : <filebw> ( path -- stream )
-    f
-    [ |java.lang.String ] |java.io.FileOutputStream jnew
-    <bytestream> ;
+    [ "java.lang.String" ] "java.io.FileOutputStream" jnew
+    f swap
+    <byte-stream> ;
 
 : <bwriter> (writer -- bwriter)
-    [ |java.io.Writer ] |java.io.BufferedWriter jnew ;
+    [ "java.io.Writer" ] "java.io.BufferedWriter" jnew ;
 
 : <owriter> (outputstream -- owriter)
-    [ |java.io.OutputStream ] |java.io.OutputStreamWriter jnew ;
+    [ "java.io.OutputStream" ] "java.io.OutputStreamWriter" jnew ;
 
 : read ( -- string )
     $stdio freadln ;
 
 : write ( string -- )
-    $stdio [ fwrite ] [ fflush ] cleave ;
+    $stdio fwrite ;
 
 : print ( string -- )
     $stdio [ fwriteln ] [ fflush ] cleave ;
@@ -161,6 +188,9 @@
 : fflush ( stream -- )
     [ $fflush call ] bind ;
 
+: flush ( -- )
+    $stdio fflush ;
+
 : freadln ( stream -- string )
     [ $freadln call ] bind ;
 
@@ -180,14 +210,14 @@
     [ $fclose call ] bind ;
 
 : fcopy ( from to -- )
-    ! Copy the contents of the bytestream 'from' to the bytestream 'to'.
+    ! Copy the contents of the byte-stream 'from' to the byte-stream 'to'.
     [ [ $in ] bind ] dip
     [ $out ] bind
     [ "java.io.InputStream" "java.io.OutputStream" ]
     "factor.FactorLib" "copy" jinvoke-static ;
 
 : <freader> ( file -- freader )
-    [ |java.lang.String ] |java.io.FileReader jnew <breader> ;
+    [ "java.lang.String" ] "java.io.FileReader" jnew <breader> ;
 
 : <file> (path -- file)
     dup "java.io.File" is not [
@@ -204,7 +234,7 @@
     <file> [ ] "java.io.File" "list" jinvoke
     array>list ;
 
-: rename ( from to -- )
+: frename ( from to -- )
     ! Rename file 'from' to 'to'. These can be paths or
     ! java.io.File instances.
     <file> swap <file>
@@ -212,7 +242,7 @@
     jinvoke ;
 
 : <sreader> (string -- reader)
-    [ |java.lang.String ] |java.io.StringReader jnew ;
+    [ "java.lang.String" ] "java.io.StringReader" jnew ;
 
 : close (stream --)
     dup "java.io.Reader" is [
@@ -237,6 +267,6 @@
 : print-numbered-list ( list -- )
     dup length pred swap print-numbered-list* ;
 
-"java.lang.System" "in"  jvar-static$ <ireader> <breader> @stdin
-"java.lang.System" "out" jvar-static$ <owriter> @stdout
-$stdin $stdout <charstream> @stdio
+: terpri ( -- )
+    #! Print a newline to standard output.
+    "\n" write ;

factor/strings.factor

@@ -25,16 +25,6 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-! Used by chars>entities
-[
-    [ #\< , "&lt;"   ]
-    [ #\> , "&gt;"   ]
-    [ #\& , "&amp;"  ]
-! Bad parser!
-!    [ #\' , "&apos;" ]
-!    [ #\" , "&quot;" ]
-] @entities
-
 : >bytes ( string -- array )
     ! Converts a string to an array of ASCII bytes. An exception
     ! is thrown if the string contains non-ASCII characters.
@@ -82,9 +72,22 @@
 : char? ( obj -- boolean )
     "java.lang.Character" is ;
 
+: ends-with-newline? ( string -- string )
+    #! Test if the string ends with a newline or not.
+    "\n" str-tail? ;
+
+: html-entities ( -- alist )
+    [
+        [ #\< , "&lt;"   ]
+        [ #\> , "&gt;"   ]
+        [ #\& , "&amp;"  ]
+        [ #\' , "&apos;" ]
+        [ #\" , "&quot;" ]
+    ] ;
+
 : chars>entities ( str -- str )
-    ! Convert <, >, &, ' and " to HTML entities.
-    [ dup $entities assoc dup rot ? ] str-map ;
+    #! Convert <, >, &, ' and " to HTML entities.
+    [ dup html-entities assoc dup rot ? ] str-map ;
 
 : group ( index match -- )
     [ "int" ] "java.util.regex.Matcher" "group"
@@ -123,6 +126,20 @@
 : index-of ( string substring -- index )
     0 -rot index-of* ;
 
+: join ( list separator -- string )
+    #! Returns a new string where each element of the list is
+    #! separated by the separator.
+    swap dup [
+        uncons
+        [ <sbuf> sbuf-append ] dip
+        [
+            [ dupd sbuf-append ] dip
+            swap sbuf-append
+        ] each >str nip
+    ] [
+        2drop ""
+    ] ifte ;
+
 : [re-matches] ( matcher code -- boolean )
     ! If the matcher's re-matches* function returns true,
     ! evaluate the code with the matcher at the top of the
@@ -135,6 +152,19 @@
     "java.util.regex.Pattern" "matcher"
     jinvoke ;
 
+: re-cond ( string alist -- )
+    dup [
+        unswons [ over ] dip ( string tail string head )
+        uncons [ groups/t ] dip ( string tail groups code )
+        over [
+            2nip call
+        ] [
+            2drop re-cond
+        ] ifte
+    ] [
+        2drop
+    ] ifte ;
+
 : re-matches* ( matcher -- boolean )
     [ ] "java.util.regex.Matcher" "matches"
     jinvoke ;
@@ -169,7 +199,11 @@
 
 : split ( string split -- list )
     2dup index-of dup -1 = [
-        2drop unit
+        2drop dup str-length 0 = [
+            drop f
+        ] [
+            unit
+        ] ifte
     ] [
         swap [ str// ] dip split cons
     ] ifte ;
@@ -210,41 +244,65 @@
     [ "int" ] "java.lang.String" "charAt" jinvoke ;
 
 : str-head ( str index -- str )
-    ! Returns a new string, from the beginning of the string
-    ! until the given index.
+    #! Returns a new string, from the beginning of the string
+    #! until the given index.
     0 transp substring ;
 
 : str-headcut ( str begin -- str str )
     str-length str/ ;
 
 : str-head? ( str begin -- str )
-    ! If the string starts with begin, return the rest of the
-    ! string after begin. Otherwise, return f.
-    2dup str-length> [
+    #! If the string starts with begin, return the rest of the
+    #! string after begin. Otherwise, return f.
+    2dup str-length< [
+        2drop f
+    ] [
         tuck str-headcut
         [ = ] dip f ?
-    ] [
-        2drop f
     ] ifte ;
 
 : str-length ( str -- length )
     [ ] "java.lang.String" "length" jinvoke ;
 
-: str-length> ( str str -- boolean )
+: str-length< ( str str -- boolean )
     ! Compare string lengths.
-    [ str-length ] 2apply > ;
+    [ str-length ] 2apply < ;
 
-: str-map ( str [ code ] -- [ mapping ] )
-    2list restack str-each unstack cat ;
+: str-map ( str code -- str )
+    f transp [
+        ( accum code elem -- accum code )
+        transp over >r >r call r> cons r>
+    ] str-each drop nreverse cat ;
 
 : 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.
+    #! Returns a new string, from the given index until the end
+    #! of the string.
     over str-length rot substring ;
 
+: str-tailcut ( str end -- str str )
+    str-length [ dup str-length ] dip - str/ ;
+
+: str-tail? ( str end -- str )
+    #! If the string ends with end, return the start of the
+    #! string before end. Otherwise, return f.
+    2dup str-length< [
+        2drop f
+    ] [
+        tuck str-tailcut swap
+        [ = ] dip f ?
+    ] ifte ;
+
 : substring ( start end str -- str )
     [ "int" "int" ] "java.lang.String" "substring"
     jinvoke ;
+
+: 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 ;