From 1e20343a58b30fd468de8c6b66519e2335700ad9 Mon Sep 17 00:00:00 2001 From: nomennescio Date: Fri, 18 Oct 2019 15:04:33 +0200 Subject: [PATCH] Imported https://downloads.factorcode.org/releases/0.58/Factor-0.58.jar --- .cvskeywords | 160 +- META-INF/MANIFEST.MF | 2 +- compile-file.factor | 24 + factor/Cons.java | 6 +- factor/FactorArrayStack.java | 6 +- factor/FactorCallStack.java | 11 +- factor/FactorCompoundDefinition.java | 171 +- factor/FactorDocComment.java | 59 + factor/FactorInterpreter.java | 178 +- factor/FactorJava.java | 15 + factor/FactorMath.java | 47 + factor/FactorNamespace.java | 100 +- factor/FactorParseException.java | 2 +- factor/FactorParser.java | 596 ----- factor/FactorParsingDefinition.java | 54 + ...on.java => FactorPrimitiveDefinition.java} | 28 +- factor/FactorRatio.java | 15 +- factor/FactorReader.java | 370 +++ factor/FactorScanner.java | 381 +++ factor/FactorShuffleDefinition.java | 15 +- factor/FactorWord.java | 33 +- factor/FactorWordDefinition.java | 185 +- factor/ReadTable.java | 85 + factor/boot.factor | 212 +- factor/boot.fasl | 2064 +++++++++++++++++ factor/combinators.factor | 255 +- factor/compiler.factor | 102 + factor/compiler/AuxiliaryQuotation.java | 126 + factor/compiler/CompiledChoice.java | 68 +- factor/compiler/CompiledDefinition.java | 37 +- factor/compiler/CompiledList.java | 10 +- factor/compiler/CompiledListResult.java | 63 + factor/compiler/FactorCompiler.java | 498 +++- factor/compiler/FlowObject.java | 4 +- factor/compiler/Null.java | 7 +- factor/compiler/RecursiveForm.java | 67 +- factor/compiler/RecursiveState.java | 23 +- factor/compiler/Result.java | 2 +- factor/compiler/StackEffect.java | 32 +- factor/continuations.factor | 56 +- factor/debugger.factor | 2 +- factor/dictionary.factor | 91 +- factor/format.factor | 38 + factor/httpd.factor | 158 +- factor/inspector.factor | 109 +- factor/interpreter.factor | 43 +- factor/irc.factor | 155 ++ factor/listener/EvalListener.java | 38 + factor/listener/FactorDesktop.java | 156 ++ factor/listener/FactorListener.java | 259 +++ factor/listener/listener.factor | 99 + factor/lists.factor | 275 ++- factor/math.factor | 127 +- factor/miscellaneous.factor | 17 +- factor/namespaces.factor | 68 +- factor/network.factor | 18 +- factor/parser.factor | 24 +- factor/parser/Bra.java | 45 + factor/parser/CharLiteral.java | 49 + factor/parser/Comma.java | 49 + factor/parser/Def.java | 46 + factor/parser/Dispatch.java | 56 + factor/parser/F.java | 46 + factor/parser/Fle.java | 190 ++ factor/parser/Ine.java | 62 + factor/parser/Ket.java | 49 + .../Set.java => parser/LineComment.java} | 48 +- factor/parser/Prefix.java | 57 + factor/parser/Shu.java | 46 + factor/parser/StackComment.java | 49 + factor/parser/StringLiteral.java | 49 + factor/parser/T.java | 46 + factor/parser/Unreadable.java | 48 + factor/presentation.factor | 85 + factor/prettyprint.factor | 200 +- factor/primitives/Bind.java | 2 +- factor/primitives/Call.java | 2 +- factor/primitives/CallstackGet.java | 2 +- factor/primitives/CallstackSet.java | 2 +- factor/primitives/Choice.java | 2 +- factor/primitives/Clear.java | 2 +- factor/primitives/DatastackGet.java | 2 +- factor/primitives/DatastackSet.java | 2 +- factor/primitives/Define.java | 9 +- factor/primitives/Execute.java | 2 +- .../{Get.java => InterpreterGet.java} | 38 +- factor/primitives/JInvoke.java | 4 +- factor/primitives/JInvokeStatic.java | 4 +- factor/primitives/JNew.java | 4 +- factor/primitives/JVarGet.java | 2 +- factor/primitives/JVarGetStatic.java | 2 +- factor/primitives/JVarSet.java | 2 +- factor/primitives/JVarSetStatic.java | 2 +- factor/primitives/Restack.java | 2 +- factor/primitives/Unstack.java | 2 +- factor/primitives/Unwind.java | 2 +- factor/random.factor | 2 +- factor/stack.factor | 65 + factor/stream.factor | 156 +- factor/strings.factor | 110 +- factor/test/auxiliary.factor | 58 + factor/test/combinators.factor | 2 + factor/test/compiler.factor | 41 +- factor/test/dictionary.factor | 27 +- factor/test/list.factor | 74 +- factor/test/math.factor | 12 + factor/test/miscellaneous.factor | 51 +- factor/test/namespaces.factor | 24 + factor/test/reader.factor | 94 + factor/test/reboot.factor | 23 + factor/test/stack.factor | 4 + factor/test/string.factor | 23 + factor/test/tail.factor | 47 + factor/test/test.factor | 24 +- factor/trace.factor | 70 + version.factor | 2 +- 116 files changed, 7969 insertions(+), 2097 deletions(-) create mode 100644 compile-file.factor create mode 100644 factor/FactorDocComment.java delete mode 100644 factor/FactorParser.java create mode 100644 factor/FactorParsingDefinition.java rename factor/{FactorMissingDefinition.java => FactorPrimitiveDefinition.java} (71%) create mode 100644 factor/FactorReader.java create mode 100644 factor/FactorScanner.java create mode 100644 factor/ReadTable.java create mode 100644 factor/boot.fasl create mode 100644 factor/compiler.factor create mode 100644 factor/compiler/AuxiliaryQuotation.java create mode 100644 factor/compiler/CompiledListResult.java create mode 100644 factor/format.factor create mode 100644 factor/irc.factor create mode 100644 factor/listener/EvalListener.java create mode 100644 factor/listener/FactorDesktop.java create mode 100644 factor/listener/FactorListener.java create mode 100644 factor/listener/listener.factor create mode 100644 factor/parser/Bra.java create mode 100644 factor/parser/CharLiteral.java create mode 100644 factor/parser/Comma.java create mode 100644 factor/parser/Def.java create mode 100644 factor/parser/Dispatch.java create mode 100644 factor/parser/F.java create mode 100644 factor/parser/Fle.java create mode 100644 factor/parser/Ine.java create mode 100644 factor/parser/Ket.java rename factor/{primitives/Set.java => parser/LineComment.java} (60%) create mode 100644 factor/parser/Prefix.java create mode 100644 factor/parser/Shu.java create mode 100644 factor/parser/StackComment.java create mode 100644 factor/parser/StringLiteral.java create mode 100644 factor/parser/T.java create mode 100644 factor/parser/Unreadable.java create mode 100644 factor/presentation.factor rename factor/primitives/{Get.java => InterpreterGet.java} (75%) create mode 100644 factor/stack.factor create mode 100644 factor/test/auxiliary.factor create mode 100644 factor/test/math.factor create mode 100644 factor/test/namespaces.factor create mode 100644 factor/test/reader.factor create mode 100644 factor/test/reboot.factor create mode 100644 factor/test/string.factor create mode 100644 factor/test/tail.factor create mode 100644 factor/trace.factor diff --git a/.cvskeywords b/.cvskeywords index 3bc2010c96..dede7a2875 100644 --- a/.cvskeywords +++ b/.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 $ diff --git a/META-INF/MANIFEST.MF b/META-INF/MANIFEST.MF index 5aef12b0a0..3dbc5bed3d 100644 --- a/META-INF/MANIFEST.MF +++ b/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 diff --git a/compile-file.factor b/compile-file.factor new file mode 100644 index 0000000000..3d6ac38825 --- /dev/null +++ b/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 -- ) + [ + @stdio + dump-image + $stdio fclose + ] bind ; + +: dump-boot-image ( -- ) + "factor/boot.fasl" dump-image-file ; diff --git a/factor/Cons.java b/factor/Cons.java index 1e2120f44b..e717817b55 100644 --- a/factor/Cons.java +++ b/factor/Cons.java @@ -169,7 +169,7 @@ public class Cons implements PublicCloneable, FactorExternalizable if(iter.car == this) buf.append(""); 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) diff --git a/factor/FactorArrayStack.java b/factor/FactorArrayStack.java index f795320776..1f8878dab5 100644 --- a/factor/FactorArrayStack.java +++ b/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]; diff --git a/factor/FactorCallStack.java b/factor/FactorCallStack.java index 0b216806b1..2e795bb2a7 100644 --- a/factor/FactorCallStack.java +++ b/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); } } //}}} } diff --git a/factor/FactorCompoundDefinition.java b/factor/FactorCompoundDefinition.java index b4cbc4e688..0d3fc24c8c 100644 --- a/factor/FactorCompoundDefinition.java +++ b/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, "", - "(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", "", - "(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", + "","(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(); diff --git a/factor/FactorDocComment.java b/factor/FactorDocComment.java new file mode 100644 index 0000000000..db5bd839f4 --- /dev/null +++ b/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; + } +} diff --git a/factor/FactorInterpreter.java b/factor/FactorInterpreter.java index fe97260ace..11f31e1da8 100644 --- a/factor/FactorInterpreter.java +++ b/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("#"),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); } } //}}} diff --git a/factor/FactorJava.java b/factor/FactorJava.java index 4ef2f3b812..a616a47991 100644 --- a/factor/FactorJava.java +++ b/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 diff --git a/factor/FactorMath.java b/factor/FactorMath.java index ced82b0ce8..174906934d 100644 --- a/factor/FactorMath.java +++ b/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() { diff --git a/factor/FactorNamespace.java b/factor/FactorNamespace.java index 47afd5f65b..c42af7ea65 100644 --- a/factor/FactorNamespace.java +++ b/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(); diff --git a/factor/FactorParseException.java b/factor/FactorParseException.java index 4be4c53473..d475e9f3ac 100644 --- a/factor/FactorParseException.java +++ b/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); } } diff --git a/factor/FactorParser.java b/factor/FactorParser.java deleted file mode 100644 index e36a978e80..0000000000 --- a/factor/FactorParser.java +++ /dev/null @@ -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 ? "" : 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()); - } //}}} -} diff --git a/factor/FactorParsingDefinition.java b/factor/FactorParsingDefinition.java new file mode 100644 index 0000000000..e6bb4231c6 --- /dev/null +++ b/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; + } //}}} +} diff --git a/factor/FactorMissingDefinition.java b/factor/FactorPrimitiveDefinition.java similarity index 71% rename from factor/FactorMissingDefinition.java rename to factor/FactorPrimitiveDefinition.java index 0eec3a9062..0be22dbb6c 100644 --- a/factor/FactorMissingDefinition.java +++ b/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"; - } //}}} } diff --git a/factor/FactorRatio.java b/factor/FactorRatio.java index edfe6e0e0f..b77a7bd22b 100644 --- a/factor/FactorRatio.java +++ b/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() { diff --git a/factor/FactorReader.java b/factor/FactorReader.java new file mode 100644 index 0000000000..f331b7c8d4 --- /dev/null +++ b/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("#"); + 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; + } + } //}}} +} diff --git a/factor/FactorScanner.java b/factor/FactorScanner.java new file mode 100644 index 0000000000..fefb73444a --- /dev/null +++ b/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); + } //}}} +} diff --git a/factor/FactorShuffleDefinition.java b/factor/FactorShuffleDefinition.java index 85094f1aea..a31844a320 100644 --- a/factor/FactorShuffleDefinition.java +++ b/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)); } diff --git a/factor/FactorWord.java b/factor/FactorWord.java index 72f611fa01..5362b8139a 100644 --- a/factor/FactorWord.java +++ b/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("#"); } //}}} //{{{ 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); } //}}} } diff --git a/factor/FactorWordDefinition.java b/factor/FactorWordDefinition.java index 1683fcedd8..d8d25e6e3d 100644 --- a/factor/FactorWordDefinition.java +++ b/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 diff --git a/factor/ReadTable.java b/factor/ReadTable.java new file mode 100644 index 0000000000..7cbdeb9812 --- /dev/null +++ b/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; + } //}}} +} diff --git a/factor/boot.factor b/factor/boot.factor index 21682847d6..6158337b8b 100644 --- a/factor/boot.factor +++ b/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 >>~ +: ( 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. -: (reader -- breader) - [ |java.io.Reader ] |java.io.BufferedReader jnew ; +: ( inputstream -- breader ) + #! Wrap a InputStream in an InputStreamReader. + [ "java.io.InputStream" ] "java.io.InputStreamReader" jnew ; -: (inputstream -- breader) - [ |java.io.InputStream ] |java.io.InputStreamReader jnew ; - -: (path -- inputstream) - |factor.FactorInterpreter - [ |java.lang.String ] |java.lang.Class |getResourceAsStream jinvoke +: ( path -- inputstream ) + #! Create a Reader for reading the specified resource from + #! the classpath. + "factor.FactorInterpreter" + [ "java.lang.String" ] + "java.lang.Class" "getResourceAsStream" jinvoke ; -: 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 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 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$ @stdin +"java.lang.System" "out" jvar-static$ @stdout +$stdin $stdout @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 diff --git a/factor/boot.fasl b/factor/boot.fasl new file mode 100644 index 0000000000..66c21e0ab0 --- /dev/null +++ b/factor/boot.fasl @@ -0,0 +1,2064 @@ +! This is an automatically-generated fastload image. +"$" +"factor.compiler.gen.$_0" +define +inline +"*" +"factor.compiler.gen.__3" +define +inline +"*@" +"factor.compiler.gen.___4" +define +"+" +"factor.compiler.gen.__7" +define +inline +"+@" +"factor.compiler.gen.___8" +define +"-" +"factor.compiler.gen.__9" +define +inline +"-@" +"factor.compiler.gen.___10" +define +~<< -rot A B C -- C A B >>~ +: . ( expr -- ) + unparse. terpri ; +: .s ( -- ) + datastack$ describe ; +"/" +"factor.compiler.gen.__11" +define +inline +"/@" +"factor.compiler.gen.___12" +define +"0=" +"factor.compiler.gen.___13" +define +inline +"0>f" +"factor.compiler.gen.__f_15" +define +"1=" +"factor.compiler.gen.___16" +define +inline +~<< 2-rot A B C D E F -- E F A B C D >>~ +"2=" +"factor.compiler.gen.___17" +define +~<< 2>r A B -- r:A r:B >>~ +"2^" +"factor.compiler.gen.___19" +define +: 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 ; +: 2dip ( a b [ c ] -- c a b ) + #! 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> ; +~<< 2drop A B -- >>~ +~<< 2dup A B -- A B A B >>~ +~<< 2dupd A B C D -- A B A B C D >>~ +: 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 ; +~<< 2each{ A B C D E -- A C E r:B r:D r:E >>~ +"2list" +"factor.compiler.gen._list_22" +define +: 2map ( [ list ] [ list ] [ code ] -- [ mapping ] ) + #! 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 ; +~<< 2nip A B C D -- C D >>~ +~<< 2over A B C D -- A B C D A B >>~ +~<< 2r> r:A r:B -- A B >>~ +"2rlist" +"factor.compiler.gen._rlist_25" +define +~<< 2rot A B C D E F -- C D E F A B >>~ +~<< 2swap A B C D -- C D A B >>~ +~<< 2swapd A B C D E F -- C D A B E F >>~ +~<< 2transp A B C D E F -- E F C D A B >>~ +~<< 2tuck A B C D -- C D A B C D >>~ +~<< 3dup A B C -- A B C A B C >>~ +"3list" +"factor.compiler.gen._list_26" +define +: :g ( -- ) + return-from-error "error-continuation" $ call ; +: :j ( -- ) + "error" $ dup exception? [ + print-stack-trace + ] [ + "Not an exception: " write . + ] ifte ; +: :r ( -- ) + return-from-error "initial-interpreter-continuation" $ dup [ + call + ] [ + suspend + ] ifte ; +: :s ( -- ) + return-from-error "initial-interpreter-callstack" $ callstack@ ; +: :w ( -- ) + "error-callstack" $ [ + callstack$ + ] unless* describe ; +"<" +"factor.compiler.gen.__27" +define +inline +"<=" +"factor.compiler.gen.___28" +define +inline +"" +"factor.compiler.gen._breader__29" +define +"" +"factor.compiler.gen._bwriter__30" +define +"" +"factor.compiler.gen._byte_stream__31" +define +"/fclose" +"factor.compiler.gen._byte_stream__fclose_34" +define +"/fflush" +"factor.compiler.gen._byte_stream__fflush_35" +define +"/freadln" +"factor.compiler.gen._byte_stream__freadln_36" +define +"/fwrite" +"factor.compiler.gen._byte_stream__fwrite_37" +define +"" +"factor.compiler.gen._char_stream__39" +define +"/fclose" +"factor.compiler.gen._char_stream__fclose_40" +define +"/fflush" +"factor.compiler.gen._char_stream__fflush_41" +define +"/freadln" +"factor.compiler.gen._char_stream__freadln_42" +define +"/fwrite" +"factor.compiler.gen._char_stream__fwrite_43" +define +"" +"factor.compiler.gen._client__44" +define +"" +"factor.compiler.gen._compound__50" +define +"" +"factor.compiler.gen._extend_stream__51" +define +"" +"factor.compiler.gen._file__52" +define +"" +"factor.compiler.gen._filebr__55" +define +"" +"factor.compiler.gen._filebw__56" +define +"" +"factor.compiler.gen._filecr__57" +define +"" +"factor.compiler.gen._filecw__58" +define +"" +"factor.compiler.gen._freader__59" +define +"" +"factor.compiler.gen._html_stream__60" +define +: /fwrite-attr ( string attrs stream -- ) + [ + html-attr-string + ] dip fwrite ; +"" +"factor.compiler.gen._irc_stream__61" +define +"" +"factor.compiler.gen._ireader__63" +define +"" +"factor.compiler.gen._listener_stream__64" +define +"/fedit" +"factor.compiler.gen._listener_stream__fedit_65" +define +: /freadln ( -- line ) + [ + "listener" $ [ + "factor.Cons" + ] "factor.listener.FactorListener" "readLine" jinvoke suspend + ] callcc1 ; +"/fwrite-attr" +"factor.compiler.gen._listener_stream__fwrite_attr_66" +define +"" +"factor.compiler.gen._matcher__74" +define +"" +"factor.compiler.gen._namespace__33" +define +"" +"factor.compiler.gen._objnamespace__75" +define +"" +"factor.compiler.gen._owriter__76" +define +"" +"factor.compiler.gen._regex__77" +define +"" +"factor.compiler.gen._rreader__78" +define +"" +"factor.compiler.gen._sbuf__62" +define +"" +"factor.compiler.gen._server__79" +define +"" +"factor.compiler.gen._socketstream__45" +define +"" +"factor.compiler.gen._sreader__80" +define +"" +"factor.compiler.gen._stream__32" +define +"" +"factor.compiler.gen._string_output_stream__81" +define +"" +"factor.compiler.gen._word__82" +define +"=" +"factor.compiler.gen.__14" +define +"=-or-contains" +"factor.compiler.gen.__or_contains_83" +define +">" +"factor.compiler.gen.__20" +define +inline +">=" +"factor.compiler.gen.___86" +define +inline +">=<" +"factor.compiler.gen.____87" +define +">bignum" +"factor.compiler.gen._bignum_88" +define +inline +">bytes" +"factor.compiler.gen._bytes_38" +define +">fixnum" +"factor.compiler.gen._fixnum_89" +define +inline +">lower" +"factor.compiler.gen._lower_90" +define +~<< >r A -- r:A >>~ +">realnum" +"factor.compiler.gen._realnum_91" +define +inline +">str" +"factor.compiler.gen._str_73" +define +">title" +"factor.compiler.gen._title_92" +define +">upper" +"factor.compiler.gen._upper_98" +define +"@" +"factor.compiler.gen.__5" +define +inline +: TRACED ( -- ) + ; +: [re-matches] ( matcher code -- boolean ) + [ + dup re-matches* + ] dip [ + drop f + ] ifte ; +"[trace+]" +"factor.compiler.gen._trace___100" +define +"[trace-]" +"factor.compiler.gen._trace___104" +define +"accept" +"factor.compiler.gen.accept_105" +define +"add" +"factor.compiler.gen.add_106" +define +"add@" +"factor.compiler.gen.add__107" +define +: all-tests ( -- ) + "Running Factor test suite..." print [ + "auxiliary" "combinators" "compiler" "dictionary" "list" "math" "miscellaneous" "namespaces" "random" "reader" "stack" "string" "tail" "reboot" + ] [ + test + ] each "All tests passed." print ; +"and" +"factor.compiler.gen.and_18" +define +inline +"append" +"factor.compiler.gen.append_46" +define +"append@" +"factor.compiler.gen.append__108" +define +: apropos ( substring -- ) + words [ + 2dup str-contains [ + . + ] [ + drop + ] ifte + ] each drop ; +"array>list" +"factor.compiler.gen.array_list_109" +define +: asm ( word -- ) + #! Prints JVM bytecode disassembly of a compiled word. + intern [ + "asm" $ + ] bind dup [ + print + ] [ + drop "Not a compiled word." print + ] ifte ; +: assert ( t -- ) + [ + "Assertion failed!" break + ] unless ; +: assert= ( x y -- ) + = assert ; +"assoc" +"factor.compiler.gen.assoc_67" +define +"assoc$" +"factor.compiler.gen.assoc$_110" +define +"balance" +"factor.compiler.gen.balance_111" +define +: balance>list ( quotation -- list ) + balance effect>list ; +"bignum?" +"factor.compiler.gen.bignum__117" +define +inline +: break ( exception -- ) + global [ + dup "error" @ "break called." print "" print ":w prints the callstack." print ":j prints the Java stack." print ":r returns to top level." print ":s returns to top level, retaining the data stack." print ":g continues execution (but expect another error)." print "" print "ERROR: " write exception. "console" $ [ + [ + t "expanded" @ + ] bind + ] when* callstack$ "error-callstack" @ [ + "error-continuation" @ " DEBUG. " interpreter-loop :r + ] callcc0 + ] bind ; +: break-if-not-integer ( x -- ) + integer? [ + "Not a rational: " swap cat2 error + ] unless ; +"caar" +"factor.compiler.gen.caar_118" +define +inline +"cadr" +"factor.compiler.gen.cadr_119" +define +inline +: 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. + datastack$ callstack$ [ + f 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. + datastack$ callstack$ [ + [ + f + ] continue + ] cons cons swap call ; +: callcc1 ( [ code ] -- ) + #! 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 ; +"callframe" +"factor.compiler.gen.callframe_2" +define +inline +"car" +"factor.compiler.gen.car_48" +define +inline +"car+" +"factor.compiler.gen.car__120" +define +"cat" +"factor.compiler.gen.cat_121" +define +"cat2" +"factor.compiler.gen.cat__71" +define +"cat3" +"factor.compiler.gen.cat__122" +define +"cat4" +"factor.compiler.gen.cat__123" +define +"cat5" +"factor.compiler.gen.cat__124" +define +"cdar" +"factor.compiler.gen.cdar_125" +define +inline +"cddr" +"factor.compiler.gen.cddr_126" +define +inline +"cdr" +"factor.compiler.gen.cdr_49" +define +inline +"chance" +"factor.compiler.gen.chance_127" +define +"char?" +"factor.compiler.gen.char__129" +define +: chars>entities ( str -- str ) + #! Convert <, >, &, ' and " to HTML entities. + [ + dup html-entities assoc dup rot ? + ] str-map ; +"class-of" +"factor.compiler.gen.class_of_137" +define +: cleave ( x [ code1 ] [ code2 ] -- ) + #! Executes each quotation, with x on top of the stack. + #! + #! If the quotation compiles, this combinator compiles. + >r over >r call r> r> call ; +"cli-arg" +"factor.compiler.gen.cli_arg_138" +define +"cli-param" +"factor.compiler.gen.cli_param_142" +define +"clone" +"factor.compiler.gen.clone_143" +define +"clone-list" +"factor.compiler.gen.clone_list_144" +define +"clone-list-iter" +"factor.compiler.gen.clone_list_iter_145" +define +"cloneArray" +"factor.compiler.gen.cloneArray_146" +define +"close" +"factor.compiler.gen.close_147" +define +"comment?" +"factor.compiler.gen.comment__148" +define +: compare ( x y [ if x < y ] [ if x = y ] [ if x > y ] -- ) + >=< call ; +"compile" +"factor.compiler.gen.compile_149" +define +"compile*" +"factor.compiler.gen.compile__151" +define +"compile-all" +"factor.compiler.gen.compile_all_152" +define +: compile-call ( [ X ] -- X ) + no-name dup compile execute ; +"compile-maybe" +"factor.compiler.gen.compile_maybe_157" +define +"compile-no-name" +"factor.compiler.gen.compile_no_name_160" +define +"compiled?" +"factor.compiler.gen.compiled__150" +define +"compound-or-compiled?" +"factor.compiler.gen.compound_or_compiled__161" +define +"compound>list" +"factor.compiler.gen.compound_list_164" +define +"compound?" +"factor.compiler.gen.compound__162" +define +: 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. + #! + #! 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 + ] [ + cdr cond + ] ifte + ] [ + 2drop + ] ifte ; +"cons" +"factor.compiler.gen.cons_24" +define +inline +"cons?" +"factor.compiler.gen.cons__84" +define +inline +"cons@" +"factor.compiler.gen.cons__167" +define +"contains" +"factor.compiler.gen.contains_168" +define +: continue ( datastack callstack push -- ) + #! Do not call this directly. Used by callcc. + 2dip callstack@ swap >r datastack@ drop r> call ; +: count ( n -- [ 1 2 3 ... n ] ) + #! If n <= 0, pushes the empty list. + [ + f times* + ] cons expand ; +: decimal-places ( num count -- str ) + #! Trims the number to a count of decimal places. + swap decimal-split [ + rot decimal-tail cat2 + ] when* ; +"decimal-split" +"factor.compiler.gen.decimal_split_169" +define +"decimal-tail" +"factor.compiler.gen.decimal_tail_172" +define +"deepCloneArray" +"factor.compiler.gen.deepCloneArray_174" +define +"defined-word?" +"factor.compiler.gen.defined_word__175" +define +"deg2rad" +"factor.compiler.gen.deg_rad_176" +define +: denominator ( x/y -- x ) + dup ratio? [ + "factor.FactorRatio" "denominator" jvar$ + ] [ + break-if-not-integer 1 + ] ifte ; +: describe ( obj -- ) + [ + [ + worddef? + ] [ + see + ] [ + stack? + ] [ + stack>list print-numbered-list + ] [ + string? + ] [ + print + ] [ + drop t + ] [ + "OBJECT: " write dup . [ + "CLASS : " write dup class-of print "--------" print inspecting vars-values. + ] when* + ] + ] cond ; +: describe-object-path ( string -- ) + [ + dup "object-path" @ global-object-path describe + ] bind ; +: 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> ; +"directory" +"factor.compiler.gen.directory_177" +define +"directory?" +"factor.compiler.gen.directory__178" +define +: do-not-test-word ( output input word -- ) + #! Flag for tests that are known not to work. + drop drop drop ; +~<< drop A -- >>~ +: dump-boot-image ( -- ) + t "dump" @ compile-all "factor/boot.fasl" dump-image-file "Now, restart Factor without the -no-fasl switch." print f "dump" @ ; +: 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 -- ) + [ + "stdio" @ dump-image "stdio" $ fclose + ] bind ; +~<< dup A -- A A >>~ +~<< dupd A B -- A A B >>~ +: 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 [ + >r uncons r> tuck 2>r call 2r> each + ] [ + 2drop + ] ifte ; +: edit ( string -- ) + "stdio" $ fedit ; +"effect" +"factor.compiler.gen.effect_114" +define +: 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 ; +"ends-with-newline?" +"factor.compiler.gen.ends_with_newline__180" +define +"error" +"factor.compiler.gen.error_183" +define +: eval ( "X" -- X ) + parse "compile-toplevel" $ [ + compile-call + ] [ + call + ] ifte ; +: examples/httpd "Enter a port number: " write read >fixnum "Enter document root (eg, /home/www/): " write read httpd ; +: examples/httpd* 8888 "/home/slava/ExampleHTTPD/" httpd ; +: exception. ( exception -- ) + dup "factor.FactorException" is [ + f "java.lang.Throwable" "getMessage" jinvoke + ] [ + >str + ] ifte print ; +"exception?" +"factor.compiler.gen.exception__184" +define +"exec" +"factor.compiler.gen.exec_185" +define +"exists?" +"factor.compiler.gen.exists__186" +define +"exit" +"factor.compiler.gen.exit_187" +define +"exit*" +"factor.compiler.gen.exit__188" +define +: 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 ; +: extend ( object code -- object ) + over [ + bind + ] dip ; +"fac" +"factor.compiler.gen.fac_189" +define +: fclose ( stream -- ) + [ + "fclose" $ call + ] bind ; +"fcopy" +"factor.compiler.gen.fcopy_190" +define +: fedit ( string stream -- ) + [ + "fedit" $ call + ] bind ; +: fflush ( stream -- ) + [ + "fflush" $ call + ] bind ; +"fib" +"factor.compiler.gen.fib_191" +define +"first" +"factor.compiler.gen.first_192" +define +"fixnum?" +"factor.compiler.gen.fixnum__193" +define +inline +: flush ( -- ) + "stdio" $ fflush ; +: forever ( code -- ) + #! 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 ; +: freadln ( stream -- string ) + [ + "freadln" $ call + ] bind ; +"frename" +"factor.compiler.gen.frename_194" +define +: fwrite ( string stream -- ) + [ + "fwrite" $ call + ] bind ; +: 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 ; +: fwriteln ( string stream -- ) + [ + "fwriteln" $ call + ] bind ; +: gc ( -- ) + f "java.lang.System" "gc" jinvoke-static ; +"gcd" +"factor.compiler.gen.gcd_196" +define +"gensym" +"factor.compiler.gen.gensym_113" +define +"get" +"factor.compiler.gen.get_197" +define +"get-history" +"factor.compiler.gen.get_history_198" +define +"global" +"factor.compiler.gen.global_159" +define +inline +: global-object-path ( string -- object ) + #! An object path based from the global namespace. + "'" split global [ + object-path + ] bind ; +"group" +"factor.compiler.gen.group_208" +define +"group-count" +"factor.compiler.gen.group_count_209" +define +: group1 ( string regex -- string ) + groups dup [ + car + ] when ; +: groups ( input regex -- list ) + groups* ; +: groups* ( matcher -- list ) + [ + [ + dup group-count [ + succ over group swap + ] times* drop + ] cons expand + ] [re-matches] ; +: groups/t ( string re -- groups ) + dup t = [ + nip + ] [ + groups + ] ifte ; +"harmonic" +"factor.compiler.gen.harmonic_210" +define +"has-namespace?" +"factor.compiler.gen.has_namespace__206" +define +inline +: help "clear -- clear datastack." ".s -- print datastack." ". -- print top of datastack." "" print "global describe -- list all global variables." print "describe -- describe object at top of stack." print "" print "words. -- list all words." 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 expressions." print "X redo -- redo expression number X from history list." print "" print "stats -- interpreter statistics." print "exit -- exit the interpreter." print "" print ; +: history ( -- ) + "X redo -- evaluate the expression with number X." print "X re-edit -- edit the expression with number X." print "history" $ print-numbered-list ; +"history#" +"factor.compiler.gen.history__212" +define +"history+" +"factor.compiler.gen.history__214" +define +: html-attr-string ( string attrs -- string ) + "link" swap assoc dup string? [ + html-link-string + ] [ + drop + ] ifte ; +: html-entities ( -- alist ) + [ + [ #\< , "<" ] [ #\> , ">" ] [ #\& , "&" ] [ #\' , "'" ] [ #\" , """ ] + ] ; +: html-link-string ( string link -- string ) + "link "\">" cat3 swap chars>entities "" cat3 ; +: httpd ( port docroot -- ) + "httpd-doc-root" @ httpd-loop ; +: httpd-client ( socket -- ) + [ + "stdio" $ "log" @ "stdio" @ httpd-client-log readln [ + httpd-request + ] when* + ] bind ; +: httpd-client-log ( -- ) + "Accepted connection from " write "client" $ [ + "socket" $ + ] bind . ; +: httpd-directory-header ( directory -- ) + "200 Document follows" "text/html" httpd-response writeln ; +: httpd-directory>html ( directory -- html ) + directory [ + httpd-file>html + ] map cat ; +: httpd-error ( error -- ) + dup httpd-log-error [ + "text/html" httpd-response + ] [ + httpd-error-body + ] cleave cat2 writeln ; +"httpd-error-body" +"factor.compiler.gen.httpd_error_body_225" +define +: 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" ] + ] ; +: httpd-file-extension ( filename -- extension ) + ".*\\.(.*)" group1 ; +: httpd-file-header ( filename -- header ) + "200 Document follows" swap httpd-filetype httpd-response ; +: httpd-file>html ( filename -- ... ) + "
  • entities "\">" over "
    • " ; +: httpd-filetype ( filename -- mime-type ) + httpd-file-extension httpd-extensions assoc [ + "text/plain" + ] unless* ; +: httpd-get-path ( request -- file ) + "GET (.*?)( HTTP.*|)" group1 ; +: httpd-get-request ( url -- ) + httpd-url>path [ + httpd-serve-log + ] [ + httpd-parse-object-name httpd-serve-object + ] cleave ; +: httpd-get-secure-path ( path -- path ) + dup [ + httpd-get-path dup [ + dup ".*\\.\\.*" re-matches [ + drop f + ] when + ] [ + drop f + ] ifte + ] [ + drop f + ] ifte ; +: httpd-list-directory ( directory -- ) + dup httpd-directory-header [ + "" swap "

    " over "

      " over httpd-directory>html "
    " + ] cons expand cat write ; +: httpd-log-error ( error -- ) + "Error: " swap cat2 "log" $ fwriteln ; +: httpd-loop ( server -- ) + [ + "httpd-quit" $ not + ] [ + dup accept dup httpd-client fclose + ] while ; +: httpd-parse-object-name ( filename -- argument filename ) + dup "(.*?)\\?(.*)" groups dup [ + nip call + ] when swap ; +: httpd-request ( request -- ) + httpd-get-secure-path dup [ + httpd-get-request + ] [ + drop "400 Bad request" httpd-error + ] ifte ; +"httpd-response" +"factor.compiler.gen.httpd_response_230" +define +: httpd-response-write ( msg content-type -- ) + httpd-response writeln ; +: httpd-serve-directory ( directory -- ) + dup "/index.html" cat2 dup exists? [ + nip httpd-serve-file + ] [ + drop httpd-list-directory + ] ifte ; +: httpd-serve-file ( filename -- ) + dup httpd-file-header writeln "client" $ fcopy ; +: httpd-serve-log ( filename -- ) + "Serving " write "log" $ fwriteln ; +: httpd-serve-object ( argument filename -- ) + dup ".*\\.lhtml" re-matches [ + httpd-serve-script + ] [ + nip httpd-serve-static + ] ifte ; +: httpd-serve-script ( argument filename -- ) + [ + swap "argument" @ run-file + ] bind ; +: httpd-serve-static ( filename -- ) + dup exists? [ + dup directory? [ + httpd-serve-directory + ] [ + httpd-serve-file + ] ifte + ] [ + drop "404 Not Found" httpd-error + ] ifte ; +: httpd-url>path ( uri -- path ) + dup "http://.*?(/.*)" group1 dup [ + nip + ] [ + drop + ] ifte "httpd-doc-root" $ swap cat2 ; +: httpd-write ( line -- ) + "client" $ fwrite ; +: 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 ; +"import" +"factor.compiler.gen.import_231" +define +"index-of" +"factor.compiler.gen.index_of_170" +define +"index-of*" +"factor.compiler.gen.index_of__171" +define +: initial-interpreter-loop ( -- ) + #! Run the stand-alone interpreter + print-banner [ + "initial-interpreter-continuation" @ + ] callcc0 [ + callstack$ "initial-interpreter-callstack" @ + ] call " " interpreter-loop ; +: 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 [ + transp over >r >r call r> cons r> + ] each drop nreverse ; +"inline" +"factor.compiler.gen.inline_232" +define +: inspect ( obj -- ) + #! Display the inspector for the object, and start a new + #! REPL bound to the object's namespace. + dup describe "--------" print "exit - exit one level of inspector." print "suspend - return to top level." print dup inspecting [ + " " swap unparse " " cat3 interpreter-loop + ] bind ; +"inspecting" +"factor.compiler.gen.inspecting_205" +define +"integer?" +"factor.compiler.gen.integer__233" +define +inline +: 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 ; +"intern" +"factor.compiler.gen.intern_101" +define +"intern*" +"factor.compiler.gen.intern__103" +define +: interpreter-loop ( prompt -- ) + dup >r print-prompt read dup [ + [ + history+ + ] [ + eval + ] cleave global [ + "quit-flag" $ + ] bind [ + rdrop global [ + f "quit-flag" @ + ] bind + ] [ + r> interpreter-loop + ] ifte + ] [ + rdrop + ] ifte ; +: irc ( channels -- ) + irc-register dup [ + irc-join + ] each [ + "Hello everybody" swap irc-message + ] each irc-loop ; +: irc-action ( message recepients -- ) + "ACTION " write write " :" write print ; +: irc-eval ( line -- ) + [ + safe-eval + ] keep-datastack drop ; +: irc-fact ( key -- ) + dup "facts" $ [ + $ + ] bind dup [ + swap write " is " write print + ] [ + 2drop + ] ifte ; +"irc-fact+" +"factor.compiler.gen.irc_fact__234" +define +"irc-fact-" +"factor.compiler.gen.irc_fact__235" +define +: irc-facts ( -- ) + "facts" $ [ + vars-values + ] bind [ + cdr + ] subset . ; +: irc-handle-join ( [ joined channel ] -- ) + uncons car [ + dup "nick" $ = [ + "Hi " swap cat2 print + ] unless + ] with-irc-stream ; +: irc-handle-privmsg ( [ recepient message ] -- ) + uncons car swap [ + [ + [ + "eval (.+)" car irc-eval + ] [ + "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-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-join ( channel -- ) + "JOIN " write print ; +: irc-loop ( -- ) + read [ + irc-input irc-loop + ] when* ; +: irc-message ( message recepients -- ) + "PRIVMSG " write write " :" write print ; +: irc-register ( -- ) + "USER " write "user" $ write " " write "host" $ write " " write "server" $ write " " write "realname" $ write " " print "NICK " write "nick" $ print ; +: irc-test "factorbot" "user" @ "emu" "host" @ "irc.freenode.net" "server" @ "Factor" "realname" @ "factorbot" "nick" @ "facts" @ "irc.freenode.net" 6667 [ + "stdio" @ [ + "#jedit" + ] irc + ] bind ; +"is" +"factor.compiler.gen.is_53" +define +"join" +"factor.compiler.gen.join_236" +define +: keep-datastack ( quot -- ) + datastack$ [ + call + ] dip datastack@ drop ; +"last" +"factor.compiler.gen.last_237" +define +"last*" +"factor.compiler.gen.last__238" +define +: lazy ( var [ a ] -- value ) + over $ [ + drop $ + ] [ + dip dupd @ + ] ifte ; +"length" +"factor.compiler.gen.length_213" +define +"list?" +"factor.compiler.gen.list__239" +define +"logand" +"factor.compiler.gen.logand_240" +define +inline +"mag2" +"factor.compiler.gen.mag__241" +define +: 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 ; +"max" +"factor.compiler.gen.max_244" +define +"max-str-length" +"factor.compiler.gen.max_str_length_245" +define +"millis" +"factor.compiler.gen.millis_246" +define +"min" +"factor.compiler.gen.min_173" +define +: must-compile ( word -- ) + "compile" $ [ + "Checking if " write dup " was compiled" print dup compile worddef compiled? assert + ] [ + drop + ] ifte ; +"namespace" +"factor.compiler.gen.namespace_1" +define +inline +"namespace?" +"factor.compiler.gen.namespace__247" +define +inline +"nappend" +"factor.compiler.gen.nappend_248" +define +"neg" +"factor.compiler.gen.neg_249" +define +inline +"neg@" +"factor.compiler.gen.neg__250" +define +"new-listener" +"factor.compiler.gen.new_listener_251" +define +: new-listener-hook ( listener -- ) + #! Called when user opens a new listener in the desktop. + [ + "stdio" @ initial-interpreter-loop + ] bind ; +"next" +"factor.compiler.gen.next_252" +define +~<< nip A B -- B >>~ +"no-name" +"factor.compiler.gen.no_name_112" +define +~<< nop -- >>~ +"not" +"factor.compiler.gen.not_54" +define +inline +"not=" +"factor.compiler.gen.not__253" +define +"not@" +"factor.compiler.gen.not__254" +define +"nreverse" +"factor.compiler.gen.nreverse_131" +define +"nreverse-iter" +"factor.compiler.gen.nreverse_iter_132" +define +"num-sort" +"factor.compiler.gen.num_sort_255" +define +"number?" +"factor.compiler.gen.number__256" +define +inline +: numerator ( x/y -- x ) + dup ratio? [ + "factor.FactorRatio" "numerator" jvar$ + ] [ + dup break-if-not-integer + ] ifte ; +"obj>listener-link" +"factor.compiler.gen.obj_listener_link_68" +define +: object-path ( list -- object ) + #! An object path is a list of strings. Each string is a + #! variable name in the object namespace at that level. + #! Returns f if any of the objects are not set. + dup [ + unswons $ dup [ + inspecting [ + object-path + ] bind + ] [ + 2drop f + ] ifte + ] [ + drop this + ] ifte ; +: object-path>link ( objpath -- string ) + chars>entities "inspect.lhtml?" swap cat2 ; +"or" +"factor.compiler.gen.or_163" +define +inline +~<< over A B -- A B A >>~ +"pad-string" +"factor.compiler.gen.pad_string_261" +define +"parent" +"factor.compiler.gen.parent_263" +define +"parse" +"factor.compiler.gen.parse_264" +define +"parse*" +"factor.compiler.gen.parse__265" +define +"parse-file" +"factor.compiler.gen.parse_file_266" +define +"parse-number" +"factor.compiler.gen.parse_number_267" +define +"parse-resource" +"factor.compiler.gen.parse_resource_268" +define +: 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 -- ? ) + f f 2swap partition-iter rot drop ; +: partition-iter ( ref ret1 ret2 list combinator -- ref ret1 ret2 ) + #! Helper word for 'partition'. + over [ + >r uncons r> partition-iterI 2>r dup 2r> call [ + partition-iterT{ cons }partition-iterT partition-iter + ] [ + partition-iterF{ cons }partition-iterF partition-iter + ] ifte + ] [ + 2drop + ] ifte ; +~<< partition-iterF{ r:A r:B r:C r:D r:E -- C B r:A r:B r:D r:E >>~ +~<< partition-iterI A B C D E -- C E r:A r:B r:C r:D r:E >>~ +~<< partition-iterT{ r:A r:B r:C r:D r:E -- C A r:A r:B r:D r:E >>~ +~<< pick A B C -- A B C A >>~ +"pow" +"factor.compiler.gen.pow_269" +define +inline +"pred" +"factor.compiler.gen.pred_21" +define +inline +"pred@" +"factor.compiler.gen.pred__270" +define +: prettyprint ( list -- ) + 0 swap prettyprint* drop ; +: prettyprint* ( indent obj -- indent ) + [ + [ + 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-: ( indent -- indent ) + ":" write prettyprint-space tab-size + ; +: prettyprint-:; ( indent list -- indent ) + swap prettyprint-: swap prettyprint-list prettyprint-; ; +: prettyprint-; ( indent -- indent ) + ";" write tab-size - ; +: prettyprint->>~ ( indent -- indent ) + ">>~" write tab-size - dup prettyprint-newline ; +: prettyprint-[ ( indent -- indent ) + "[" write tab-size + dup prettyprint-newline ; +: prettyprint-[] ( indent list -- indent ) + swap prettyprint-[ swap prettyprint-list prettyprint-] ; +: prettyprint-] ( indent -- indent ) + tab-size - dup prettyprint-newline "]" write prettyprint-space ; +: prettyprint-indent ( indent -- ) + #! Print the given number of spaces. + spaces write ; +: prettyprint-inline ( worddef -- ) + word-of-worddef [ + "inline" $ + ] bind [ + " inline" write + ] when ; +: prettyprint-list ( indent list -- indent ) + #! Pretty-print a list, without [ and ]. + [ + prettyprint* + ] each ; +: prettyprint-newline ( indent -- ) + "\n" write prettyprint-indent ; +: prettyprint-object ( indent obj -- indent ) + dup word-or-comment? [ + dup >str ends-with-newline? [ + write dup prettyprint-indent + ] [ + unparse. " " write + ] ifte + ] [ + unparse. " " write + ] ifte ; +: prettyprint-space ( -- ) + " " write ; +: prettyprint-~<< ( indent -- indent ) + "~<<" write prettyprint-space tab-size + ; +: prettyprint-~<<>>~ ( indent list -- indent ) + swap prettyprint-~<< swap prettyprint-list prettyprint->>~ ; +"primitive?" +"factor.compiler.gen.primitive__271" +define +: print ( string -- ) + "stdio" $ [ + fwriteln + ] [ + fflush + ] cleave ; +: print-banner ( -- ) + "Factor " version cat2 print "Copyright (C) 2003, 2004 Slava Pestov" print "Enter ``help'' for help." print "Enter ``exit'' to exit." print ; +: print-numbered-list ( list -- ) + dup length pred swap print-numbered-list* ; +: print-numbered-list* ( number list -- ) + dup [ + uncons [ + over pred + ] dip print-numbered-list* ": " swap cat3 print + ] [ + 2drop + ] ifte ; +: print-prompt ( prompt -- ) + write history# write "] " write flush ; +"print-stack-trace" +"factor.compiler.gen.print_stack_trace_272" +define +~<< r> r:A -- A >>~ +"rad2deg" +"factor.compiler.gen.rad_deg_273" +define +"random-angle" +"factor.compiler.gen.random_angle_274" +define +"random-boolean" +"factor.compiler.gen.random_boolean_275" +define +"random-digit" +"factor.compiler.gen.random_digit_276" +define +"random-element" +"factor.compiler.gen.random_element_277" +define +"random-element*" +"factor.compiler.gen.random_element__278" +define +"random-element-iter" +"factor.compiler.gen.random_element_iter_279" +define +"random-float" +"factor.compiler.gen.random_float_280" +define +"random-int" +"factor.compiler.gen.random_int_128" +define +"random-probability" +"factor.compiler.gen.random_probability_281" +define +"random-subset" +"factor.compiler.gen.random_subset_282" +define +"random-subset*" +"factor.compiler.gen.random_subset__283" +define +"random-symmetric-int" +"factor.compiler.gen.random_symmetric_int_284" +define +"ratio?" +"factor.compiler.gen.ratio__285" +define +inline +~<< rdrop r:A -- >>~ +: re-cond ( string alist -- ) + dup [ + unswons [ + over + ] dip uncons [ + groups/t + ] dip over [ + 2nip call + ] [ + 2drop re-cond + ] ifte + ] [ + 2drop + ] ifte ; +: re-edit ( index -- ) + get-history edit ; +"re-matches" +"factor.compiler.gen.re_matches_286" +define +"re-matches*" +"factor.compiler.gen.re_matches__287" +define +"re-replace" +"factor.compiler.gen.re_replace_288" +define +"re-replace*" +"factor.compiler.gen.re_replace__289" +define +"re-split" +"factor.compiler.gen.re_split_290" +define +: read ( -- string ) + "stdio" $ freadln ; +"realnum?" +"factor.compiler.gen.realnum__291" +define +inline +"recip" +"factor.compiler.gen.recip_211" +define +: redo ( index -- ) + get-history [ + . + ] [ + eval + ] cleave ; +"relative>absolute-object-path" +"factor.compiler.gen.relative_absolute_object_path_292" +define +"rem" +"factor.compiler.gen.rem_293" +define +inline +"remove" +"factor.compiler.gen.remove_294" +define +"remove@" +"factor.compiler.gen.remove__295" +define +: return-from-error ( -- ) + "Returning from break." print f "error-callstack" @ f "error-flag" @ f "error" @ ; +"reverse" +"factor.compiler.gen.reverse_199" +define +~<< rot A B C -- B C A >>~ +"round" +"factor.compiler.gen.round_296" +define +~<< rover r:A r:B -- r:A r:B r:A >>~ +"rplaca" +"factor.compiler.gen.rplaca_297" +define +inline +"rplacd" +"factor.compiler.gen.rplacd_133" +define +inline +: run-file ( path -- ) + parse-file call ; +: run-resource ( path -- ) + #! Reads and runs a source file from a resource path. + parse-resource call ; +"running-desktop?" +"factor.compiler.gen.running_desktop__298" +define +"s@" +"factor.compiler.gen.s__6" +define +inline +: safe-call ( quot -- ) + dup safe? [ + call + ] [ + "Contains prohibited words" print + ] ifte ; +: safe-eval ( str -- ) + parse safe-call ; +"safe-word?" +"factor.compiler.gen.safe_word__299" +define +"safe?" +"factor.compiler.gen.safe__300" +define +"sbuf-append" +"factor.compiler.gen.sbuf_append_72" +define +: see ( word -- ) + worddef prettyprint ; +"shuffle?" +"factor.compiler.gen.shuffle__301" +define +: 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 [ + dup >r >r uncons dupd r> partition r> tuck sort >r sort r> swapd cons nappend + ] [ + drop + ] ifte ; +"spaces" +"factor.compiler.gen.spaces_262" +define +"split" +"factor.compiler.gen.split_202" +define +"sq" +"factor.compiler.gen.sq_242" +define +inline +"sqrt" +"factor.compiler.gen.sqrt_243" +define +inline +"stack>list" +"factor.compiler.gen.stack_list_302" +define +"stack?" +"factor.compiler.gen.stack__303" +define +: stats ( -- ) + "Cons: " write "factor.Cons" "COUNT" jvar-static$ . "Words: " write words length . "Compiled: " write words [ + worddef compiled? + ] subset length . ; +"str->=<" +"factor.compiler.gen.str_____304" +define +"str-contains" +"factor.compiler.gen.str_contains_305" +define +: str-each ( str [ code ] -- ) + over str-length [ + -rot 2dup [ + [ + str-get + ] dip call + ] 2dip + ] times* 2drop ; +: str-expand ( [ code ] -- str ) + expand cat ; +"str-get" +"factor.compiler.gen.str_get_135" +define +"str-head" +"factor.compiler.gen.str_head_97" +define +"str-head?" +"factor.compiler.gen.str_head__139" +define +"str-headcut" +"factor.compiler.gen.str_headcut_141" +define +"str-length" +"factor.compiler.gen.str_length_95" +define +"str-length<" +"factor.compiler.gen.str_length__140" +define +"str-lexi>" +"factor.compiler.gen.str_lexi__306" +define +: str-map ( str code -- str ) + f transp [ + transp over >r >r call r> cons r> + ] str-each drop nreverse cat ; +"str-sort" +"factor.compiler.gen.str_sort_307" +define +"str-tail" +"factor.compiler.gen.str_tail_94" +define +"str-tail?" +"factor.compiler.gen.str_tail__181" +define +"str-tailcut" +"factor.compiler.gen.str_tailcut_182" +define +"str/" +"factor.compiler.gen.str__93" +define +"str//" +"factor.compiler.gen.str___203" +define +"stream>str" +"factor.compiler.gen.stream_str_308" +define +"string?" +"factor.compiler.gen.string__69" +define +: 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 ; +: subset-add ( car pred accum -- accum ) + >r over >r call r> r> rot [ + cons + ] [ + nip + ] ifte ; +: subset-iter ( accum list pred -- accum ) + over [ + >r unswons r> 2swap pick 2>r subset-add 2r> subset-iter + ] [ + 2drop + ] ifte ; +"substring" +"factor.compiler.gen.substring_96" +define +"succ" +"factor.compiler.gen.succ_134" +define +inline +"succ@" +"factor.compiler.gen.succ__309" +define +: suspend ( -- ) + "top-level-continuation" $ dup [ + call + ] [ + clear unwind + ] ifte ; +~<< swap A B -- B A >>~ +~<< swapd A B C -- B A C >>~ +"swons" +"factor.compiler.gen.swons_200" +define +inline +"swons@" +"factor.compiler.gen.swons__310" +define +"system-property" +"factor.compiler.gen.system_property_311" +define +: tab-size #! Change this to suit your tastes. + 4 ; +: terpri ( -- ) + #! Print a newline to standard output. + "\n" write ; +: test ( name -- ) + "/factor/test/" swap ".factor" cat3 run-resource ; +: test-word ( output input word -- ) + 3dup 3list . append compile-no-name unit expand assert= ; +"this" +"factor.compiler.gen.this_207" +define +inline +: time ( code -- ) + millis >r call millis r> - . ; +: times ( n [ code ] -- ) + #! Evaluate a quotation n times. + #! + #! In order to compile, the code must produce as many values + #! as it consumes. + [ + over 0 > + ] [ + tuck >r pred >r call r> r> + ] while 2drop ; +: times* ( n [ code ] -- ) + #! 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 < + ] [ + >r 2dup succ >r >r swap call r> r> r> + ] while drop drop drop ; +: trace+ ( word stack? -- ) + over traced? [ + "Already traced." print 2drop + ] [ + over worddef dup compound? [ + compound>list [ + dupd [trace+] + ] dip append define + ] [ + "Cannot trace non-compound definition." print + ] ifte + ] ifte ; +: trace- ( word -- ) + dup traced? [ + dup worddef compound>list [trace-] define + ] [ + drop "Not traced." print + ] ifte ; +"traced?" +"factor.compiler.gen.traced__313" +define +~<< transp A B C -- C B A >>~ +"tree-contains" +"factor.compiler.gen.tree_contains_85" +define +~<< tuck A B -- B A B >>~ +"uncons" +"factor.compiler.gen.uncons_47" +define +inline +"unique" +"factor.compiler.gen.unique_314" +define +"unique@" +"factor.compiler.gen.unique__315" +define +"unit" +"factor.compiler.gen.unit_23" +define +inline +: 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 [ 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 ; +"unparse" +"factor.compiler.gen.unparse_70" +define +: unparse. ( X -- "X" ) + dup defined-word? [ + "link" over word-link >str cons unit write-attr + ] [ + unparse write + ] ifte ; +"unswons" +"factor.compiler.gen.unswons_156" +define +inline +: usages. ( word -- ) + intern words [ + 2dup = [ + drop + ] [ + 2dup worddef>list tree-contains [ + . + ] [ + drop + ] ifte + ] ifte + ] each drop ; +: v* ( A B -- A*B ) + [ + * + ] 2map ; +: v+ ( A B -- A+B ) + [ + + + ] 2map ; +: v- ( A B -- A-B ) + [ + - + ] 2map ; +: v. ( A B -- A.B ) + v* 0 swap [ + + + ] each ; +: v/ ( A B -- A/B ) + [ + / + ] 2map ; +: value. ( max [ name , value ] -- ) + dup [ + car tuck pad-string write write + ] dip ": " write var. terpri ; +"values" +"factor.compiler.gen.values_154" +define +: var. ( [ name , value ] -- ) + uncons unparse swap relative>absolute-object-path "link" swap cons unit write-attr ; +"vars" +"factor.compiler.gen.vars_316" +define +"vars-values" +"factor.compiler.gen.vars_values_155" +define +: 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 ; +: vars. ( -- ) + vars [ + print + ] each ; +: version "0.58" ; +: 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 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 ] -- ) + #! 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 + ] [ + rdrop rdrop + ] ifte ; +: with-irc-stream ( recepient quot -- ) + [ + [ + "stdio" $ swap "stdio" @ + ] dip call + ] bind ; +"word" +"factor.compiler.gen.word_158" +define +"word-link" +"factor.compiler.gen.word_link_318" +define +"word-of-worddef" +"factor.compiler.gen.word_of_worddef_166" +define +"word-or-comment?" +"factor.compiler.gen.word_or_comment__319" +define +"word?" +"factor.compiler.gen.word__102" +define +"worddef" +"factor.compiler.gen.worddef_115" +define +"worddef>list" +"factor.compiler.gen.worddef_list_165" +define +"worddef?" +"factor.compiler.gen.worddef__116" +define +"words" +"factor.compiler.gen.words_153" +define +"words-not-primitives" +"factor.compiler.gen.words_not_primitives_320" +define +: words. ( -- ) + words [ + . + ] each ; +: write ( string -- ) + "stdio" $ fwrite ; +: write-attr ( attrs stream -- ) + #! Write an attributed string to standard output. + "stdio" $ fwrite-attr ; +~<< }2each r:A r:B r:C -- A B C >>~ +~<< }partition-iterF A r:B r:C r:D r:E -- B A D E >>~ +~<< }partition-iterT A r:B r:C r:D r:E -- A C D E >>~ diff --git a/factor/combinators.factor b/factor/combinators.factor index 46fde32177..84bb594736 100644 --- a/factor/combinators.factor +++ b/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 ] [ diff --git a/factor/compiler.factor b/factor/compiler.factor new file mode 100644 index 0000000000..3f10fe27bc --- /dev/null +++ b/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 -- ) + [ + @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 ; diff --git a/factor/compiler/AuxiliaryQuotation.java b/factor/compiler/AuxiliaryQuotation.java new file mode 100644 index 0000000000..67cba4fc22 --- /dev/null +++ b/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; + } //}}} +} diff --git a/factor/compiler/CompiledChoice.java b/factor/compiler/CompiledChoice.java index 260b9d096a..4443ab4408 100644 --- a/factor/compiler/CompiledChoice.java +++ b/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"; } //}}} } diff --git a/factor/compiler/CompiledDefinition.java b/factor/compiler/CompiledDefinition.java index ecd7a8c798..0025d61b56 100644 --- a/factor/compiler/CompiledDefinition.java +++ b/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 }); } //}}} } diff --git a/factor/compiler/CompiledList.java b/factor/compiler/CompiledList.java index 7ea6cc03da..a0ddbdb88f 100644 --- a/factor/compiler/CompiledList.java +++ b/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; } diff --git a/factor/compiler/CompiledListResult.java b/factor/compiler/CompiledListResult.java new file mode 100644 index 0000000000..91e9428de1 --- /dev/null +++ b/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); + } +} diff --git a/factor/compiler/FactorCompiler.java b/factor/compiler/FactorCompiler.java index 7eee12459f..fd867784cf 100644 --- a/factor/compiler/FactorCompiler.java +++ b/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 diff --git a/factor/compiler/FlowObject.java b/factor/compiler/FlowObject.java index 90f3c8b111..626bdb868e 100644 --- a/factor/compiler/FlowObject.java +++ b/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) { diff --git a/factor/compiler/Null.java b/factor/compiler/Null.java index d213bc89a1..3ed322d1aa 100644 --- a/factor/compiler/Null.java +++ b/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; } } diff --git a/factor/compiler/RecursiveForm.java b/factor/compiler/RecursiveForm.java index c12ce3e20d..25f604ace8 100644 --- a/factor/compiler/RecursiveForm.java +++ b/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); } } diff --git a/factor/compiler/RecursiveState.java b/factor/compiler/RecursiveState.java index 642a51f606..2bc6ecea46 100644 --- a/factor/compiler/RecursiveState.java +++ b/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); } //}}} } diff --git a/factor/compiler/Result.java b/factor/compiler/Result.java index bf2b01676a..249f735f85 100644 --- a/factor/compiler/Result.java +++ b/factor/compiler/Result.java @@ -62,6 +62,6 @@ public class Result extends FlowObject implements Constants public String toString() { - return "( indeterminate )"; + return "indeterminate:" + local; } } diff --git a/factor/compiler/StackEffect.java b/factor/compiler/StackEffect.java index 2b4376a893..dcdd44c793 100644 --- a/factor/compiler/StackEffect.java +++ b/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;"); diff --git a/factor/continuations.factor b/factor/continuations.factor index 184d064abd..e8772c5ff1 100644 --- a/factor/continuations.factor +++ b/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 ; diff --git a/factor/debugger.factor b/factor/debugger.factor index 078363d8bb..f86841076c 100644 --- a/factor/debugger.factor +++ b/factor/debugger.factor @@ -41,7 +41,7 @@ ] ifte print ; : break ( exception -- ) - $global [ + global [ dup @error ! Called when the interpreter catches an exception. diff --git a/factor/dictionary.factor b/factor/dictionary.factor index 7cdc3ab5b3..6d91c80328 100644 --- a/factor/dictionary.factor +++ b/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 ; : ( 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 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 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 ; diff --git a/factor/format.factor b/factor/format.factor new file mode 100644 index 0000000000..895dc60b61 --- /dev/null +++ b/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* ; diff --git a/factor/httpd.factor b/factor/httpd.factor index 1ba1f0cae3..53673360b0 100644 --- a/factor/httpd.factor +++ b/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 swap fcopy ; - -: httpd-log-error ( error -- ) - "Error: " swap cat2 print ; - -: httpd-error-body ( error -- body ) - "\n

    " swap "

    " 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

    " swap "

    " 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 $client fcopy ; + +: httpd-filetype ( filename -- mime-type ) + httpd-file-extension httpd-extensions assoc + [ "text/plain" ] unless* ; + +!!! Serving directories. : httpd-file>html ( filename -- ... ) "
  • 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 [ "" swap "

    " over "

      " over httpd-directory>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 -- ) - [ [ @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 -- ) + [ 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* ; + [ + $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 httpd-loop ; diff --git a/factor/inspector.factor b/factor/inspector.factor index 6cc96e56a9..3b421bddf0 100644 --- a/factor/inspector.factor +++ b/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 [ - [ "" ] dip - "    " - ] dip - unparse chars>entities - "" ; - -: values/html ( -- ... ) - ! Apply 'expand' or 'str-expand' to this word. - uvalues [ value/html ] each ; - : inspecting ( obj -- namespace ) dup has-namespace? [ ] 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? ] [ - "
    " print chars>entities print "
    " print - ] - [ drop t ] [ - "" print - - [ - "" print - "" print - [ values/html ] describe* - ] when* - - "
    OBJECT:" print - dup unparse chars>entities write - "
    CLASS:" write - dup class-of print - "
    " 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 -- ) + [ + 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 ; diff --git a/factor/interpreter.factor b/factor/interpreter.factor index d40c6ec6fc..c2269206bc 100644 --- a/factor/interpreter.factor +++ b/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 diff --git a/factor/irc.factor b/factor/irc.factor new file mode 100644 index 0000000000..4471f06e0f --- /dev/null +++ b/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 ; + +: ( stream recepient -- stream ) + [ + @recepient + @stdio + @buf + [ + dup $buf sbuf-append drop + ends-with-newline? [ + $buf >str + @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 -- ) + [ + [ $stdio swap @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 + @facts + "irc.freenode.net" 6667 + [ @stdio [ "#jedit" ] irc ] bind ; + +!! "factor/irc.factor" run-file diff --git a/factor/listener/EvalListener.java b/factor/listener/EvalListener.java new file mode 100644 index 0000000000..2db9c49a7c --- /dev/null +++ b/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); +} diff --git a/factor/listener/FactorDesktop.java b/factor/listener/FactorDesktop.java new file mode 100644 index 0000000000..efdd0c50aa --- /dev/null +++ b/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); + } + } //}}} +} diff --git a/factor/listener/FactorListener.java b/factor/listener/FactorListener.java new file mode 100644 index 0000000000..0743e3608e --- /dev/null +++ b/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(); + } + } + } //}}} +} diff --git a/factor/listener/listener.factor b/factor/listener/listener.factor new file mode 100644 index 0000000000..6a38a9b31d --- /dev/null +++ b/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 ) + #! Creates a stream for reading/writing to the given + #! listener instance. + [ + @listener + ( -- string ) + [ /freadln ] @freadln + ( string -- ) + [ f /fwrite-attr ] @fwrite + ( string attrs -- ) + [ /fwrite-attr ] @fwrite-attr + ( string -- ) + [ /fedit ] @fedit + ( -- ) + [ ] @fflush + ( -- ) + [ ] @fclose + ( string -- ) + [ this fwrite "\n" this fwrite ] @fwriteln + ] extend ; + +: /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 ; + +: /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 ; + +: /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. + [ + @stdio + initial-interpreter-loop + ] bind ; + +: new-listener ( -- ) + #! Opens a new listener. + this [ ] "factor.listener.FactorDesktop" "newListener" + jinvoke ; + +: running-desktop? ( -- ) + this "factor.listener.FactorDesktop" is ; diff --git a/factor/lists.factor b/factor/lists.factor index 71d4eb9b82..1b9ff2a9d2 100644 --- a/factor/lists.factor +++ b/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 diff --git a/factor/math.factor b/factor/math.factor index 5954548d52..ad1fb4c93e 100644 --- a/factor/math.factor +++ b/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 diff --git a/factor/miscellaneous.factor b/factor/miscellaneous.factor index 5ff8a6d603..ab05ba4cb3 100644 --- a/factor/miscellaneous.factor +++ b/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 ; diff --git a/factor/namespaces.factor b/factor/namespaces.factor index 740341f6d3..032f37298c 100644 --- a/factor/namespaces.factor +++ b/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 [ |factor.FactorNamespace ] |factor.FactorNamespace - jnew ; +: ( -- namespace ) + namespace + [ "factor.FactorNamespace" ] "factor.FactorNamespace" jnew ; : ( 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 ; diff --git a/factor/network.factor b/factor/network.factor index 9343ce1727..8aa7b48d1e 100644 --- a/factor/network.factor +++ b/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. +: ( server port -- stream ) + #! Open a TCP/IP socket to a port on the given server. + [ "java.lang.String" "int" ] "java.net.Socket" jnew + ; + : ( 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 [ @socket @@ -39,15 +45,15 @@ ] extend ; : ( 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 - [ + [ @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 ; diff --git a/factor/parser.factor b/factor/parser.factor index 15f918de9d..1dfc71b522 100644 --- a/factor/parser.factor +++ b/factor/parser.factor @@ -28,28 +28,18 @@ : parse ( string -- list ) f swap parse* ; +: parse-file ( file -- list ) + dup 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 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 ; diff --git a/factor/parser/Bra.java b/factor/parser/Bra.java new file mode 100644 index 0000000000..d30a00967b --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/CharLiteral.java b/factor/parser/CharLiteral.java new file mode 100644 index 0000000000..7e1108af68 --- /dev/null +++ b/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())); + } +} diff --git a/factor/parser/Comma.java b/factor/parser/Comma.java new file mode 100644 index 0000000000..8e616c5502 --- /dev/null +++ b/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(); + } +} diff --git a/factor/parser/Def.java b/factor/parser/Def.java new file mode 100644 index 0000000000..1f2d9956fa --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/Dispatch.java b/factor/parser/Dispatch.java new file mode 100644 index 0000000000..3bf9b00d29 --- /dev/null +++ b/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); + } + } +} diff --git a/factor/parser/F.java b/factor/parser/F.java new file mode 100644 index 0000000000..9962bc5fb8 --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/Fle.java b/factor/parser/Fle.java new file mode 100644 index 0000000000..63d5d40965 --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/Ine.java b/factor/parser/Ine.java new file mode 100644 index 0000000000..c42752c438 --- /dev/null +++ b/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")); + } +} diff --git a/factor/parser/Ket.java b/factor/parser/Ket.java new file mode 100644 index 0000000000..c03cb8191b --- /dev/null +++ b/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)); + } +} diff --git a/factor/primitives/Set.java b/factor/parser/LineComment.java similarity index 60% rename from factor/primitives/Set.java rename to factor/parser/LineComment.java index 1510813121..35ac1651f5 100644 --- a/factor/primitives/Set.java +++ b/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)); + } } diff --git a/factor/parser/Prefix.java b/factor/parser/Prefix.java new file mode 100644 index 0000000000..0bc6328e6d --- /dev/null +++ b/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); + } + } +} diff --git a/factor/parser/Shu.java b/factor/parser/Shu.java new file mode 100644 index 0000000000..4b58850360 --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/StackComment.java b/factor/parser/StackComment.java new file mode 100644 index 0000000000..b5bb516d82 --- /dev/null +++ b/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)); + } +} diff --git a/factor/parser/StringLiteral.java b/factor/parser/StringLiteral.java new file mode 100644 index 0000000000..e618d52235 --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/T.java b/factor/parser/T.java new file mode 100644 index 0000000000..185cf5a2be --- /dev/null +++ b/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); + } +} diff --git a/factor/parser/Unreadable.java b/factor/parser/Unreadable.java new file mode 100644 index 0000000000..d95f94ab42 --- /dev/null +++ b/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"); + } +} diff --git a/factor/presentation.factor b/factor/presentation.factor new file mode 100644 index 0000000000..ae89719493 --- /dev/null +++ b/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 ; + +: ( 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. + [ + [ chars>entities $stream fwrite ] @fwrite + [ chars>entities $stream fwriteln ] @fwriteln + [ $stream /fwrite-attr ] @fwrite-attr + ] extend ; + +: object-path>link ( objpath -- string ) + chars>entities "inspect.lhtml?" swap cat2 ; + +: html-link-string ( string link -- string ) + "link "\">" cat3 + swap chars>entities + "" cat3 ; + +: html-attr-string ( string attrs -- string ) + "link" swap assoc dup string? [ + html-link-string + ] [ + drop + ] ifte ; + +: /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 ; diff --git a/factor/prettyprint.factor b/factor/prettyprint.factor index 68cbefa833..5db6325744 100644 --- a/factor/prettyprint.factor +++ b/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 ; -: ( string -- token ) - dup [ - @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? [ - "" over "" 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 -- ) - "
    " print
-    worddef prettyprint-html
-    "
    " print ; - -!!! - -"[" [ - t @indent+ - t @newline -] bind - -"]" [ - t @-indent -] bind - -":" [ - t @indent+ -] bind - -";" [ - t @indent- - t @newline -] bind - -"~<<" [ - t @indent+ -] bind - -">>~" [ - t @indent- - t @newline -] bind + worddef prettyprint ; diff --git a/factor/primitives/Bind.java b/factor/primitives/Bind.java index 8357b48a30..d7dcf2ecb8 100644 --- a/factor/primitives/Bind.java +++ b/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) diff --git a/factor/primitives/Call.java b/factor/primitives/Call.java index efd89b5d75..bf7d0ca0c9 100644 --- a/factor/primitives/Call.java +++ b/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) diff --git a/factor/primitives/CallstackGet.java b/factor/primitives/CallstackGet.java index 9d7c2b5cb0..f2b7a3bb04 100644 --- a/factor/primitives/CallstackGet.java +++ b/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) diff --git a/factor/primitives/CallstackSet.java b/factor/primitives/CallstackSet.java index e9685a0455..f19bb4a45f 100644 --- a/factor/primitives/CallstackSet.java +++ b/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) diff --git a/factor/primitives/Choice.java b/factor/primitives/Choice.java index fc74913747..15e51fd7c2 100644 --- a/factor/primitives/Choice.java +++ b/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) diff --git a/factor/primitives/Clear.java b/factor/primitives/Clear.java index 4ce20906eb..50bca39b56 100644 --- a/factor/primitives/Clear.java +++ b/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) diff --git a/factor/primitives/DatastackGet.java b/factor/primitives/DatastackGet.java index a0c3c25165..91bb75c5f4 100644 --- a/factor/primitives/DatastackGet.java +++ b/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) diff --git a/factor/primitives/DatastackSet.java b/factor/primitives/DatastackSet.java index 6521842f64..907bd9f982 100644 --- a/factor/primitives/DatastackSet.java +++ b/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) diff --git a/factor/primitives/Define.java b/factor/primitives/Define.java index 865394eba8..feb2517743 100644 --- a/factor/primitives/Define.java +++ b/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; diff --git a/factor/primitives/Execute.java b/factor/primitives/Execute.java index 841c5c1f8a..6b062b2e38 100644 --- a/factor/primitives/Execute.java +++ b/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) diff --git a/factor/primitives/Get.java b/factor/primitives/InterpreterGet.java similarity index 75% rename from factor/primitives/Get.java rename to factor/primitives/InterpreterGet.java index 2c7fb78562..b93cb9044b 100644 --- a/factor/primitives/Get.java +++ b/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; + } //}}} } diff --git a/factor/primitives/JInvoke.java b/factor/primitives/JInvoke.java index cb6905e995..40477860be 100644 --- a/factor/primitives/JInvoke.java +++ b/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()) diff --git a/factor/primitives/JInvokeStatic.java b/factor/primitives/JInvokeStatic.java index 5dc721ceb4..60e44da9dc 100644 --- a/factor/primitives/JInvokeStatic.java +++ b/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, diff --git a/factor/primitives/JNew.java b/factor/primitives/JNew.java index 16399e6492..30ecd4384f 100644 --- a/factor/primitives/JNew.java +++ b/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, diff --git a/factor/primitives/JVarGet.java b/factor/primitives/JVarGet.java index 4be8233d9c..12db32a6bf 100644 --- a/factor/primitives/JVarGet.java +++ b/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) diff --git a/factor/primitives/JVarGetStatic.java b/factor/primitives/JVarGetStatic.java index 9ccbc984e9..b1b6fbf860 100644 --- a/factor/primitives/JVarGetStatic.java +++ b/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) diff --git a/factor/primitives/JVarSet.java b/factor/primitives/JVarSet.java index 092621ec72..396be8228f 100644 --- a/factor/primitives/JVarSet.java +++ b/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) diff --git a/factor/primitives/JVarSetStatic.java b/factor/primitives/JVarSetStatic.java index 46e078d38a..135c2f3499 100644 --- a/factor/primitives/JVarSetStatic.java +++ b/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) diff --git a/factor/primitives/Restack.java b/factor/primitives/Restack.java index 346b06393c..237b779b33 100644 --- a/factor/primitives/Restack.java +++ b/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) diff --git a/factor/primitives/Unstack.java b/factor/primitives/Unstack.java index 4986620ddc..e0e82cd2cd 100644 --- a/factor/primitives/Unstack.java +++ b/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) diff --git a/factor/primitives/Unwind.java b/factor/primitives/Unwind.java index 02ee87a919..da76fb9bcb 100644 --- a/factor/primitives/Unwind.java +++ b/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) diff --git a/factor/random.factor b/factor/random.factor index 294ee077a9..f8973c285a 100644 --- a/factor/random.factor +++ b/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. diff --git a/factor/stack.factor b/factor/stack.factor new file mode 100644 index 0000000000..65a5916a20 --- /dev/null +++ b/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 ; diff --git a/factor/stream.factor b/factor/stream.factor index 0d8ff860f7..14d625e1c7 100644 --- a/factor/stream.factor +++ b/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 ) - ! 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. [ ( -- 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 ; + +: ( 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. -: /freadln ( -- string ) +: /freadln ( -- string ) $in [ "java.io.InputStream" ] "factor.FactorLib" "readLine" jinvoke-static ; -: /fwrite ( string -- ) +: /fwrite ( string -- ) >bytes $out [ [ "byte" ] ] "java.io.OutputStream" "write" jinvoke ; -: /fflush ( -- ) +: /fflush ( -- ) $out [ ] "java.io.OutputStream" "flush" jinvoke ; -: /fclose ( -- ) - $in [ ] "java.io.InputStream" "close" jinvoke - $out [ ] "java.io.OutputStream" "close" jinvoke ; +: /fclose ( -- ) + $in [ [ ] "java.io.InputStream" "close" jinvoke ] when* + $out [ [ ] "java.io.OutputStream" "close" jinvoke ] when* ; -: ( in out -- stream ) - ! Creates a new stream for reading from the - ! java.io.InputStream in, and writing to the - ! java.io.OutputStream out. +: ( in out -- stream ) + #! Creates a new stream for reading from the + #! java.io.InputStream in, and writing to the + #! java.io.OutputStream out. [ @out @in ( -- string ) - [ /freadln ] @freadln + [ /freadln ] @freadln ( string -- ) - [ /fwrite ] @fwrite + [ /fwrite ] @fwrite ( -- ) - [ /fflush ] @fflush + [ /fflush ] @fflush ( -- ) - [ /fclose ] @fclose + [ /fclose ] @fclose ] extend ; -: /freadln ( -- string ) +: /freadln ( -- string ) $in [ ] "java.io.BufferedReader" "readLine" jinvoke ; -: /fwrite ( string -- ) +: /fwrite ( string -- ) $out [ "java.lang.String" ] "java.io.Writer" "write" jinvoke ; -: /fflush ( -- ) +: /fflush ( -- ) $out [ ] "java.io.Writer" "flush" jinvoke ; -: /fclose ( -- ) - $in [ ] "java.io.Reader" "close" jinvoke - $out [ ] "java.io.Writer" "close" jinvoke ; +: /fclose ( -- ) + $in [ [ ] "java.io.Reader" "close" jinvoke ] when* + $out [ [ ] "java.io.Writer" "close" jinvoke ] when* ; -: ( in out -- stream ) - ! Creates a new stream for reading from the - ! java.io.BufferedReader in, and writing to the - ! java.io.Reader out. +: ( in out -- stream ) + #! Creates a new stream for reading from the + #! java.io.BufferedReader in, and writing to the + #! java.io.Reader out. [ @out @in ( -- string ) - [ /freadln ] @freadln + [ /freadln ] @freadln ( string -- ) - [ /fwrite ] @fwrite + [ /fwrite ] @fwrite ( -- ) - [ /fflush ] @fflush + [ /fflush ] @fflush ( -- ) - [ /fclose ] @fclose + [ /fclose ] @fclose ] extend ; +: ( -- stream ) + #! Creates a new stream for writing to a string buffer. + [ + @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 ; + : ( path -- stream ) - [ |java.lang.String ] |java.io.FileReader jnew + [ "java.lang.String" ] "java.io.FileReader" jnew f - ; + ; : ( path -- stream ) - f - [ |java.lang.String ] |java.io.FileWriter jnew - ; + [ "java.lang.String" ] "java.io.FileWriter" jnew + f swap + ; : ( path -- stream ) - [ |java.lang.String ] |java.io.FileInputStream jnew + [ "java.lang.String" ] "java.io.FileInputStream" jnew f - ; + ; : ( path -- stream ) - f - [ |java.lang.String ] |java.io.FileOutputStream jnew - ; + [ "java.lang.String" ] "java.io.FileOutputStream" jnew + f swap + ; : (writer -- bwriter) - [ |java.io.Writer ] |java.io.BufferedWriter jnew ; + [ "java.io.Writer" ] "java.io.BufferedWriter" jnew ; : (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 ; : ( file -- freader ) - [ |java.lang.String ] |java.io.FileReader jnew ; + [ "java.lang.String" ] "java.io.FileReader" jnew ; : (path -- file) dup "java.io.File" is not [ @@ -204,7 +234,7 @@ [ ] "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. swap @@ -212,7 +242,7 @@ jinvoke ; : (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$ @stdin -"java.lang.System" "out" jvar-static$ @stdout -$stdin $stdout @stdio +: terpri ( -- ) + #! Print a newline to standard output. + "\n" write ; diff --git a/factor/strings.factor b/factor/strings.factor index c47d699e3d..fbe0053e42 100644 --- a/factor/strings.factor +++ b/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 -[ - [ #\< , "<" ] - [ #\> , ">" ] - [ #\& , "&" ] -! Bad parser! -! [ #\' , "'" ] -! [ #\" , """ ] -] @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 ) + [ + [ #\< , "<" ] + [ #\> , ">" ] + [ #\& , "&" ] + [ #\' , "'" ] + [ #\" , """ ] + ] ; + : 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-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 ; diff --git a/factor/test/auxiliary.factor b/factor/test/auxiliary.factor new file mode 100644 index 0000000000..d099f74cdd --- /dev/null +++ b/factor/test/auxiliary.factor @@ -0,0 +1,58 @@ +"Check compiler's auxiliary quotation code." print + +: [call] call ; +: [[call]] [call] ; + +: [nop] [ nop ] call ; word must-compile +: [[nop]] [ nop ] [call] ; word must-compile +: [[[nop]]] [ nop ] [[call]] ; word must-compile + +[ ] [ ] [ [nop] ] test-word +[ ] [ ] [ [[nop]] ] test-word +[ ] [ ] [ [[[nop]]] ] test-word + +: ?call t [ call ] [ drop ] ifte ; +: ?nop [ nop ] ?call ; word must-compile + +: ??call t [ call ] [ ?call ] ifte ; +: ??nop [ nop ] ??call ; word must-compile + +: ???call t [ call ] [ ???call ] ifte ; +: ???nop [ nop ] ???call ; word must-compile + +[ ] [ ] [ ?nop ] test-word +[ ] [ ] [ ??nop ] test-word +[ ] [ ] [ ???nop ] test-word + +: while-test [ f ] [ ] while ; word must-compile + +[ ] [ ] [ while-test ] test-word + +: [while] + [ over call ] [ dup 2dip ] while 2drop ; + +: [while-test] [ f ] [ ] [while] ; word must-compile + +[ ] [ ] [ [while-test] ] test-word + +: times-test-1 [ nop ] times ; word must-compile +: times-test-2 [ succ ] times ; word must-compile +: times-test-3 0 10 [ succ ] times ; word must-compile + +[ ] [ 10 ] [ times-test-1 ] test-word +[ 10 ] [ 0 10 ] [ times-test-2 ] test-word +[ 10 ] [ ] [ times-test-3 ] test-word + +: nested-ifte [ [ 1 ] [ 2 ] ifte ] [ [ 3 ] [ 4 ] ifte ] ifte ; + compile-maybe + +[ 1 ] [ t t ] [ nested-ifte ] test-word +[ 2 ] [ f t ] [ nested-ifte ] test-word +[ 3 ] [ t f ] [ nested-ifte ] test-word +[ 4 ] [ f f ] [ nested-ifte ] test-word + +: flow-erasure [ 2 2 + ] [ ] dip call ; word must-compile + +[ 4 ] [ ] [ flow-erasure ] test-word + +"Auxiliary quotation checks done." print diff --git a/factor/test/combinators.factor b/factor/test/combinators.factor index 58ad7f9196..d4bbcf9b88 100644 --- a/factor/test/combinators.factor +++ b/factor/test/combinators.factor @@ -4,3 +4,5 @@ [ ] [ 3 ] [ [ ] cond ] test-word [ t ] [ 4 ] [ [ [ 1 = ] [ ] [ 4 = ] [ drop t ] [ 2 = ] [ ] ] cond ] test-word + +[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] ] [ subset ] test-word diff --git a/factor/test/compiler.factor b/factor/test/compiler.factor index a63cf73702..f43fad3600 100644 --- a/factor/test/compiler.factor +++ b/factor/test/compiler.factor @@ -11,18 +11,14 @@ [ 5 ] [ 2 ] [ f [ 2 ] [ 3 ] ifte + ] test-word : stack-frame-test ( x -- x ) - >r t [ r> ] [ rdrop 11 ] ifte ; + >r t [ r> ] [ rdrop 11 ] ifte ; word must-compile [ 10 ] [ 10 ] [ stack-frame-test ] test-word -: balance>list ( quotation -- list ) - balance effect>list ; - -[ [ 1 1 0 0 ] ] [ [ sq ] ] [ balance>list ] test-word -[ [ 2 1 0 0 ] ] [ [ mag2 ] ] [ balance>list ] test-word -[ [ 2 1 0 0 ] ] [ [ append ] ] [ balance>list ] test-word -[ [ 1 1 0 0 ] ] [ [ fac ] ] [ balance>list ] test-word -[ [ 1 1 0 0 ] ] [ [ fib ] ] [ balance>list ] test-word +[ [ 1 1 0 0 ] ] [ [ sq ] ] [ balance>list ] test-word +[ [ 2 1 0 0 ] ] [ [ mag2 ] ] [ balance>list ] test-word +[ [ 1 1 0 0 ] ] [ [ fac ] ] [ balance>list ] test-word +[ [ 1 1 0 0 ] ] [ [ fib ] ] [ balance>list ] test-word [ [ 1 1 0 0 ] ] [ [ dup [ sq ] when ] ] [ balance>list ] test-word @@ -30,13 +26,13 @@ [ [ 0 0 0 0 ] ] [ [ null-rec ] ] [ balance>list ] test-word ; : null-rec ( -- ) - t [ null-rec ] when ; compile-maybe test-null-rec + t [ null-rec ] when ; word must-compile test-null-rec : null-rec ( -- ) - t [ null-rec ] unless ; compile-maybe test-null-rec + t [ null-rec ] unless ; word must-compile test-null-rec : null-rec ( -- ) - t [ drop null-rec ] when* ; compile-maybe test-null-rec + t [ drop null-rec ] when* ; word must-compile test-null-rec !: null-rec ( -- ) ! t [ t null-rec ] unless* drop ; compile-maybe test-null-rec @@ -46,10 +42,27 @@ [ [ 2 1 0 0 ] ] [ [ >r [ ] [ ] ? call r> ] ] [ balance>list ] test-word : nested-rec ( -- ) - t [ nested-rec ] when ; compile-maybe + t [ nested-rec ] when ; word must-compile : nested-rec-test ( -- ) - 5 nested-rec drop ; compile-maybe + 5 nested-rec drop ; word must-compile [ [ 0 0 0 0 ] ] [ [ nested-rec-test ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ relative>absolute-object-path ] ] [ balance>list ] test-word + +! We had a problem with JVM stack overflow... + +: null-inject [ ] inject ; word must-compile + +! And a problem with stack normalization after ifte if both +! datastack and callstack were in use... + +: inject-test [ dup [ ] when ] inject ; word must-compile + +[ [ 1 2 3 ] ] [ [ 1 2 3 ] ] [ inject-test ] test-word + +: nested-test-iter f [ nested-test-iter ] when ; +: nested-test f nested-test-iter drop ; word must-compile + "All compiler checks passed." print diff --git a/factor/test/dictionary.factor b/factor/test/dictionary.factor index 4de526e5a6..f4afc3d9cc 100644 --- a/factor/test/dictionary.factor +++ b/factor/test/dictionary.factor @@ -11,7 +11,7 @@ [ f ] [ "ifte" ] [ worddef shuffle? ] test-word [ f ] [ "dup" ] [ worddef compound? ] test-word -! Test word iternalization. +! Test word internalization. : gensym-test ( -- ? ) f 10 [ gensym gensym = and ] times ; @@ -21,13 +21,14 @@ : intern-test ( 1 2 -- ? ) [ intern ] 2apply = ; +[ f ] [ "quux" ] [ intern f = ] test-word [ t ] [ "a" "a" ] [ intern-test ] test-word [ f ] [ "a" "A" ] [ intern-test ] test-word [ f ] [ "a" "B" ] [ intern-test ] test-word [ f ] [ "a" "a" ] [ swap intern = ] test-word : worddef>list-test ( -- ? ) - [ dup * ] dup no-name worddef>list cdr cdr = ; + [ dup * ] dup no-name worddef>list cdr = ; [ t ] [ ] [ worddef>list-test ] test-word @@ -35,3 +36,25 @@ t words [ word? and ] each ; [ t ] [ ] [ words-test ] test-word + +! At one time we had a bug in FactorShuffleDefinition.toList() +~<< test-shuffle-1 A r:B -- A r:B >>~ + +[ "[ test-shuffle-1 A r:B -- A r:B ]" ] +[ "test-shuffle-1" ] +[ worddef>list >str ] +test-word + +~<< test-shuffle-2 A B -- r:A r:B >>~ + +[ "[ test-shuffle-2 A B -- r:A r:B ]" ] +[ "test-shuffle-2" ] +[ worddef>list >str ] +test-word + +~<< test-shuffle-3 A r:B r:C r:D r:E -- A C D E >>~ + +[ "[ test-shuffle-3 A r:B r:C r:D r:E -- A C D E ]" ] +[ "test-shuffle-3" ] +[ worddef>list >str ] +test-word diff --git a/factor/test/list.factor b/factor/test/list.factor index 6db6192fe0..7180667d92 100644 --- a/factor/test/list.factor +++ b/factor/test/list.factor @@ -3,20 +3,27 @@ "Checking list words." print ! OUTPUT INPUT WORD +[ [ 2 1 0 0 ] ] [ [ 2list ] ] [ balance>list ] test-word [ [ 1 2 ] ] [ 1 2 ] [ 2list ] test-word +[ [ 3 1 0 0 ] ] [ [ 3list ] ] [ balance>list ] test-word [ [ 1 2 3 ] ] [ 1 2 3 ] [ 3list ] test-word +[ [ 2 1 0 0 ] ] [ [ 2rlist ] ] [ balance>list ] test-word [ [ 2 1 ] ] [ 1 2 ] [ 2rlist ] test-word +[ [ 2 1 0 0 ] ] [ [ append ] ] [ balance>list ] test-word [ [ ] ] [ [ ] [ ] ] [ append ] test-word [ [ 1 ] ] [ [ 1 ] [ ] ] [ append ] test-word [ [ 2 ] ] [ [ ] [ 2 ] ] [ append ] test-word [ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] ] [ append ] test-word +[ [ 2 0 0 0 ] ] [ [ append@ ] ] [ balance>list ] test-word [ [ 1 2 3 4 ] ] [ [ 3 4 ] [ 1 2 ] ] [ @x "x" append@ $x ] test-word +[ [ 1 1 0 0 ] ] [ [ array>list ] ] [ balance>list ] test-word [ [ ] ] [ [ ] ] [ array>list ] test-word [ [ 1 2 3 ] ] [ [ 1 2 3 ] ] [ array>list ] test-word +[ [ 2 0 0 0 ] ] [ [ add@ ] ] [ balance>list ] test-word [ [ 1 2 3 4 ] ] [ 4 [ 1 2 3 ] ] [ @x "x" add@ $x ] test-word [ @@ -28,6 +35,7 @@ [ [ 1 2 ] , [ 2 1 ] ] ] @assoc +[ [ 2 1 0 0 ] ] [ [ assoc ] ] [ balance>list ] test-word [ f ] [ "monkey" f ] [ assoc ] test-word [ f ] [ "donkey" $assoc ] [ assoc ] test-word [ 1 ] [ "monkey" $assoc ] [ assoc ] test-word @@ -44,12 +52,16 @@ t @donkey [ "lisp" , [ 2 1 ] ] ] @assoc +[ [ 2 1 0 0 ] ] [ [ assoc$ ] ] [ balance>list ] test-word [ 1 ] [ f $assoc ] [ assoc$ ] test-word [ [ 2 1 ] ] [ [ 1 2 ] $assoc ] [ assoc$ ] test-word +[ [ 1 1 0 0 ] ] [ [ car ] ] [ balance>list ] test-word [ 1 ] [ [ 1 , 2 ] ] [ car ] test-word +[ [ 1 1 0 0 ] ] [ [ cdr ] ] [ balance>list ] test-word [ 2 ] [ [ 1 , 2 ] ] [ cdr ] test-word +[ [ 1 1 0 0 ] ] [ [ clone-list ] ] [ balance>list ] test-word [ [ ] ] [ [ ] ] [ clone-list ] test-word [ [ 1 2 , 3 ] ] [ [ 1 2 , 3 ] ] [ clone-list ] test-word [ [ 1 2 3 4 ] ] [ [ 1 2 3 4 ] ] [ clone-list ] test-word @@ -60,42 +72,52 @@ t @donkey [ t ] [ [ 1 2 ] [ 3 4 ] ] [ clone-list-actually-clones? ] test-word +[ [ 2 1 0 0 ] ] [ [ cons ] ] [ balance>list ] test-word [ [ 1 , 2 ] ] [ 1 2 ] [ cons ] test-word [ [ 1 ] ] [ 1 f ] [ cons ] test-word +[ [ 2 1 0 0 ] ] [ [ contains ] ] [ balance>list ] test-word [ f ] [ 3 [ ] ] [ contains ] test-word [ f ] [ 3 [ 1 2 ] ] [ contains ] test-word [ [ 1 2 ] ] [ 1 [ 1 2 ] ] [ contains ] test-word [ [ 2 ] ] [ 2 [ 1 2 ] ] [ contains ] test-word +[ [ 2 , 3 ] ] [ 3 [ 1 2 , 3 ] ] [ contains ] do-not-test-word +[ [ 2 0 0 0 ] ] [ [ cons@ ] ] [ balance>list ] test-word [ [ 1 ] ] [ 1 f ] [ @x "x" cons@ $x ] test-word [ [ 1 , 2 ] ] [ 1 2 ] [ @x "x" cons@ $x ] test-word [ [ 1 2 ] ] [ 1 [ 2 ] ] [ @x "x" cons@ $x ] test-word +[ [ 1 1 0 0 ] ] [ [ count ] ] [ balance>list ] do-not-test-word [ [ ] ] [ 0 ] [ count ] test-word [ [ ] ] [ -10 ] [ count ] test-word [ [ ] ] [ $-inf ] [ count ] test-word [ [ 0 1 2 ] ] [ $e ] [ count ] test-word [ [ 0 1 2 3 ] ] [ 4 ] [ count ] test-word +[ [ 2 1 0 0 ] ] [ [ get ] ] [ balance>list ] test-word [ 1 ] [ [ 1 2 ] -1 ] [ get ] test-word [ 1 ] [ [ 1 2 ] 0 ] [ get ] test-word [ 2 ] [ [ 1 2 ] 1 ] [ get ] test-word +[ [ 1 1 0 0 ] ] [ [ last* ] ] [ balance>list ] test-word [ [ 3 ] ] [ [ 3 ] ] [ last* ] test-word [ [ 3 ] ] [ [ 1 2 3 ] ] [ last* ] test-word [ [ 3 , 4 ] ] [ [ 1 2 3 , 4 ] ] [ last* ] test-word +[ [ 1 1 0 0 ] ] [ [ last ] ] [ balance>list ] test-word [ 3 ] [ [ 3 ] ] [ last ] test-word [ 3 ] [ [ 1 2 3 ] ] [ last ] test-word [ 3 ] [ [ 1 2 3 , 4 ] ] [ last ] test-word +[ [ 1 1 0 0 ] ] [ [ length ] ] [ balance>list ] test-word [ 0 ] [ [ ] ] [ length ] test-word [ 3 ] [ [ 1 2 3 ] ] [ length ] test-word ! CMU CL bombs on (length '(1 2 3 . 4)) ![ 3 ] [ [ 1 2 3 , 4 ] ] [ length ] test-word +[ [ 1 1 0 0 ] ] [ [ list? ] ] [ balance>list ] test-word [ t ] [ f ] [ list? ] test-word [ f ] [ t ] [ list? ] test-word [ t ] [ [ 1 2 ] ] [ list? ] test-word @@ -109,44 +131,92 @@ t @donkey [ [ 2 ] ] [ [ ] [ 2 ] ] [ clone-and-nappend ] test-word [ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] ] [ clone-and-nappend ] test-word +: clone-and-nreverse ( list -- list ) + clone-list nreverse ; + +[ [ 1 1 0 0 ] ] [ [ nreverse ] ] [ balance>list ] test-word +[ [ ] ] [ [ ] ] [ clone-and-nreverse ] test-word +[ [ 1 ] ] [ [ 1 ] ] [ clone-and-nreverse ] test-word +[ [ 3 2 1 ] ] [ [ 1 2 3 ] ] [ clone-and-nreverse ] test-word + [ 1 2 3 ] clone-list @x [ 4 5 6 ] clone-list @y +[ [ 2 1 0 0 ] ] [ [ nappend ] ] [ balance>list ] test-word [ [ 4 5 6 ] ] [ $x $y ] [ nappend drop $y ] test-word [ 1 2 3 ] clone-list @x [ 4 5 6 ] clone-list @y [ [ 1 2 3 4 5 6 ] ] [ $x $y ] [ nappend drop $x ] test-word +[ 2 ] [ 1 [ 1 2 3 ] ] [ next ] test-word +[ 1 ] [ 3 [ 1 2 3 ] ] [ next ] test-word +[ 1 ] [ 4 [ 1 2 3 ] ] [ next ] test-word + +[ [ 1 1 0 0 ] ] [ [ cons? ] ] [ balance>list ] test-word [ f ] [ f ] [ cons? ] test-word [ f ] [ t ] [ cons? ] test-word [ t ] [ [ t , f ] ] [ cons? ] test-word +[ [ 2 1 0 0 ] ] [ [ remove ] ] [ balance>list ] test-word +[ [ ] ] [ 1 [ ] ] [ remove ] test-word +[ [ ] ] [ 1 [ 1 ] ] [ remove ] test-word +[ [ 3 1 1 ] ] [ 2 [ 3 2 1 2 1 ] ] [ remove ] test-word + +[ [ 1 1 0 0 ] ] [ [ reverse ] ] [ balance>list ] test-word [ [ ] ] [ [ ] ] [ reverse ] test-word [ [ 1 ] ] [ [ 1 ] ] [ reverse ] test-word [ [ 3 2 1 ] ] [ [ 1 2 3 ] ] [ reverse ] test-word +[ [ 2 0 0 0 ] ] [ [ rplaca ] ] [ balance>list ] test-word [ a , b ] clone-list @x [ [ 1 , b ] ] [ 1 $x ] [ rplaca $x ] test-word - + +[ [ 2 0 0 0 ] ] [ [ rplacd ] ] [ balance>list ] test-word [ a , b ] clone-list @x [ [ a , 2 ] ] [ 2 $x ] [ rplacd $x ] test-word - + +[ [ 2 2 0 0 ] ] [ [ [ < ] partition ] ] [ balance>list ] test-word +[ [ -5 3 1 ] [ -2 4 4 -2 ] ] +[ 2 [ 1 -2 3 4 -5 4 -2 ] ] +[ [ swap / ratio? ] partition ] test-word + +[ [ 2 2 0 0 ] ] [ [ [ nip string? ] partition ] ] [ balance>list ] test-word +[ [ "d" "c" ] [ b a ] ] +[ f [ a b "c" "d" ] ] +[ [ nip string? ] partition ] test-word + +[ [ 1 1 0 0 ] ] [ [ num-sort ] ] [ balance>list ] test-word +[ [ 1 1 0 0 ] ] [ [ str-sort ] ] [ balance>list ] test-word + +[ [ 2 1 0 0 ] ] [ [ swons ] ] [ balance>list ] test-word [ [ 1 , 2 ] ] [ 2 1 ] [ swons ] test-word [ [ 1 ] ] [ f 1 ] [ swons ] test-word +[ [ 2 0 0 0 ] ] [ [ swons@ ] ] [ balance>list ] test-word [ [ 1 ] ] [ 1 f ] [ @x "x" swap swons@ $x ] test-word [ [ 1 , 2 ] ] [ 1 2 ] [ @x "x" swap swons@ $x ] test-word [ [ 1 2 ] ] [ 1 [ 2 ] ] [ @x "x" swap swons@ $x ] test-word +[ [ 2 1 0 0 ] ] [ [ tree-contains ] ] [ balance>list ] test-word +[ f ] [ 3 [ ] ] [ tree-contains ] test-word +[ f ] [ 3 [ 1 [ 3 ] 2 ] ] [ tree-contains not ] test-word +[ f ] [ 1 [ [ [ 1 ] ] 2 ] ] [ tree-contains not ] test-word +[ f ] [ 2 [ 1 2 ] ] [ tree-contains not ] test-word +[ f ] [ 3 [ 1 2 , 3 ] ] [ tree-contains not ] test-word + +[ [ 1 2 0 0 ] ] [ [ uncons ] ] [ balance>list ] test-word [ 1 2 ] [ [ 1 , 2 ] ] [ uncons ] test-word [ 1 [ 2 ] ] [ [ 1 2 ] ] [ uncons ] test-word +[ [ 2 1 0 0 ] ] [ [ unique ] ] [ balance>list ] test-word [ [ 1 2 3 ] ] [ 1 [ 2 3 ] ] [ unique ] test-word [ [ 1 2 3 ] ] [ 1 [ 1 2 3 ] ] [ unique ] test-word [ [ 1 2 3 ] ] [ 2 [ 1 2 3 ] ] [ unique ] test-word +[ [ 1 1 0 0 ] ] [ [ unit ] ] [ balance>list ] test-word [ [ [ [ ] ] ] ] [ [ ] ] [ unit unit ] test-word +[ [ 1 2 0 0 ] ] [ [ unswons ] ] [ balance>list ] test-word [ 1 2 ] [ [ 2 , 1 ] ] [ unswons ] test-word [ [ 2 ] 1 ] [ [ 1 2 ] ] [ unswons ] test-word diff --git a/factor/test/math.factor b/factor/test/math.factor new file mode 100644 index 0000000000..2c72d50d03 --- /dev/null +++ b/factor/test/math.factor @@ -0,0 +1,12 @@ +"Testing math words." print + +[ t ] [ 10 3 ] [ / ratio? ] test-word +[ f ] [ 10 2 ] [ / ratio? ] test-word +[ 10 ] [ 10 ] [ numerator ] test-word +[ 1 ] [ 10 ] [ denominator ] test-word +[ 12 ] [ -12 -13 ] [ / numerator ] test-word +[ 13 ] [ -12 -13 ] [ / denominator ] test-word +[ 1 ] [ -1 -1 ] [ / numerator ] test-word +[ 1 ] [ -1 -1 ] [ / denominator ] test-word + +"Math tests done." print diff --git a/factor/test/miscellaneous.factor b/factor/test/miscellaneous.factor index 553dd7ba8b..cb21aa16f1 100644 --- a/factor/test/miscellaneous.factor +++ b/factor/test/miscellaneous.factor @@ -2,6 +2,44 @@ "Miscellaneous tests." print +[ [ 2 1 0 0 ] ] [ [ = ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ class-of ] ] [ balance>list ] test-word + +[ "java.lang.Integer" ] [ 5 ] [ class-of ] test-word +[ "java.lang.Float" ] [ 5.0 ] [ class-of ] test-word + +[ [ 1 1 0 0 ] ] [ [ clone ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ cloneArray ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ comment? ] ] [ balance>list ] test-word + +: doc-test ( -- ) ; + +[ t ] [ "doc-test" ] [ worddef>list cdr car comment? ] test-word + +[ [ 1 1 0 0 ] ] [ [ deepCloneArray ] ] [ balance>list ] test-word + +[ [ 2 1 0 0 ] ] [ [ is ] ] [ balance>list ] test-word +[ t ] [ "java.lang.Integer" ] [ 0 100 random-int swap is ] test-word +[ t ] [ "java.lang.Object" ] [ [ a ] swap is ] test-word +[ f ] [ "java.lang.Object" ] [ f swap is ] test-word + +[ [ 2 1 0 0 ] ] [ [ not= ] ] [ balance>list ] test-word + +[ [ 4 1 0 0 ] ] [ [ 2= ] ] [ balance>list ] test-word + +[ [ 5 1 0 0 ] ] [ [ >=< ] ] [ balance>list ] test-word + +[ [ 1 0 0 0 ] ] [ [ error ] ] [ balance>list ] test-word + +[ [ 1 0 0 0 ] ] [ [ exit* ] ] [ balance>list ] test-word + +[ [ 0 1 0 0 ] ] [ [ millis ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ system-property ] ] [ balance>list ] test-word + : test-last ( -- ) nop ; word >str @last-word-test @@ -11,12 +49,13 @@ word >str @last-word-test [ f ] [ 5 ] [ compiled? ] test-word [ f ] [ 5 ] [ shuffle? ] test-word -! These stress-test a lot of code. -"prettyprint*" see -"prettyprint*" see/html -$global describe -$global describe/html +[ t ] [ ] [ + [ "global" "dict" "test-word" "def" ] object-path + #=test-word worddef = +] test-word -[ t ] [ ] [ [ "global" "stdio" ] object-path $stdio = ] test-word +! Make sure callstack$ only clones callframes, and not +! everything on the callstack. +[ ] [ ] [ f unit dup dup rplacd >r callstack$ r> 2drop ] test-word "Miscellaneous passed." print diff --git a/factor/test/namespaces.factor b/factor/test/namespaces.factor new file mode 100644 index 0000000000..f1f50e43ce --- /dev/null +++ b/factor/test/namespaces.factor @@ -0,0 +1,24 @@ +! Namespace tests. + +"Namespace tests." print + + @test-namespace + +: test-namespace ( -- ) + dup [ namespace = ] bind ; + +: test-this-1 ( -- ) + dup [ this = ] bind ; + +: test-this-2 ( -- ) + interpreter dup [ this = ] bind ; + +[ t ] [ ] [ test-namespace ] test-word +[ t ] [ ] [ test-this-1 ] test-word +[ t ] [ ] [ test-this-2 ] test-word + +! These stress-test a lot of code. +global describe +$dict describe + +"Namespace tests passed." print diff --git a/factor/test/reader.factor b/factor/test/reader.factor new file mode 100644 index 0000000000..dfac1bdb23 --- /dev/null +++ b/factor/test/reader.factor @@ -0,0 +1,94 @@ +[ [ one [ two [ three ] four ] five ] ] +[ "one [ two [ three ] four ] five" ] +[ parse ] +test-word + +[ [ 1 [ 2 [ 3 ] 4 ] 5 ] ] +[ "1\n[\n2\n[\n3\n]\n4\n]\n5" ] +[ parse ] +test-word + +[ [ t t f f ] ] +[ "t t f f" ] +[ parse ] +test-word + +[ [ "hello world" ] ] +[ "\"hello world\"" ] +[ parse ] +test-word + +[ [ "\n\r\t\\" ] ] +[ "\"\\n\\r\\t\\\\\"" ] +[ parse ] +test-word + +[ [ "hello\nworld" x y z ] ] +[ "\"hello\\nworld\" x y z" ] +[ parse ] +test-word + +[ "hello world" ] +[ ": hello \"hello world\" ;" ] +[ parse call hello ] +test-word + +[ 1 2 ] +[ "~<< my-swap a b -- b a >>~" ] +[ parse call 2 1 my-swap ] +test-word + +[ ] +[ "! This is a comment, people." ] +[ parse call ] +test-word + +[ ] +[ "( This is a comment, people. )" ] +[ parse call ] +test-word + +[ [ "test" $ ] ] +[ "$test" ] +[ parse ] +test-word + +[ [ "test" @ ] ] +[ "@test" ] +[ parse ] +test-word + +[ [ $ 100 ] ] +[ "$ 100" ] +[ parse ] +test-word + +[ [ slava @ jedit . org ] ] +[ "slava @ jedit . org" ] +[ parse ] +test-word + +[ [ [ a , b ] ] ] +[ "[ a , b ]" ] +[ parse ] +test-word + +[ [ $ ] ] +[ "$" ] +[ parse ] +test-word + +[ f ] +[ f ] +[ parse-number ] +test-word + +[ 123456789123456789123456789 ] +[ "123456789123456789123456789" ] +[ parse-number ] +test-word + +[ "\"hello\\\\backslash\"" ] +[ "hello\\backslash" ] +[ unparse ] +test-word diff --git a/factor/test/reboot.factor b/factor/test/reboot.factor new file mode 100644 index 0000000000..16c5b2c999 --- /dev/null +++ b/factor/test/reboot.factor @@ -0,0 +1,23 @@ +"Reboot test." print + +$reboot-test [ + t @reboot-test + + [ + @stdio + + words [ worddef primitive? not ] subset [ see ] each + + $stdio stream>str dup parse + ] bind + + call + + $compile [ compile-all ] when + + all-tests + + f @reboot-test +] unless + +"Reboot test done." print diff --git a/factor/test/stack.factor b/factor/test/stack.factor index 8034c593ae..25428a210f 100644 --- a/factor/test/stack.factor +++ b/factor/test/stack.factor @@ -33,4 +33,8 @@ [ 2 1 ] [ 1 2 ] [ 2>r r> r> ] test-word [ 2 1 ] [ 1 2 ] [ >r >r 2r> ] test-word +[ [ 1 1 0 0 ] ] [ [ stack? ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ stack>list ] ] [ balance>list ] test-word + "Stack checks passed." print diff --git a/factor/test/string.factor b/factor/test/string.factor new file mode 100644 index 0000000000..900cd86687 --- /dev/null +++ b/factor/test/string.factor @@ -0,0 +1,23 @@ +"Testing string words." print + +[ [ 1 1 0 0 ] ] [ [ spaces ] ] [ balance>list ] test-word +[ " " ] [ 9 ] [ spaces ] test-word +[ "" ] [ 0 ] [ spaces ] test-word + +: strstream-test ( -- ) + @strstream + "Hello " $strstream fwrite + "world." $strstream fwrite + $strstream stream>str ; + +[ "Hello world." ] [ ] [ strstream-test ] test-word + +[ [ 1 1 0 0 ] ] [ [ cat ] ] [ balance>list ] test-word +[ "abc" ] [ [ "a" "b" "c" ] ] [ cat ] test-word + +[ [ 1 1 0 0 ] ] [ [ chars>entities ] ] [ balance>list ] test-word +[ + "<html>&'sgml'" +] [ "&'sgml'" ] [ chars>entities ] test-word + +"String tests done." print diff --git a/factor/test/tail.factor b/factor/test/tail.factor new file mode 100644 index 0000000000..c87bd1c244 --- /dev/null +++ b/factor/test/tail.factor @@ -0,0 +1,47 @@ +! Test tail recursive compilation. + +"Checking tail call optimization." print + +! Make sure we're doing *some* form of tail call optimization. +! Without it, this will overflow the stack. + +: tail-call-0 1000 [ ] times ; compile-maybe tail-call-0 + +: tail-call-1 ( -- ) + t [ ] [ tail-call-1 ] ifte ; compile-maybe + +[ ] [ ] [ tail-call-1 ] test-word + +: tail-call-2 ( list -- f ) + [ dup cons? ] [ uncons nip ] while ; compile-maybe + +[ f ] [ [ 1 2 3 ] ] [ tail-call-2 ] test-word + +: tail-call-3 ( x y -- z ) + [ dup succ ] dip swap 6 = [ + + + ] [ + swap tail-call-3 + ] ifte ; compile-maybe + +[ 15 ] [ 10 5 ] [ tail-call-3 ] test-word + +: tail-call-4 ( element tree -- ? ) + dup [ + 2dup car = [ + nip + ] [ + cdr dup cons? [ + tail-call-4 + ] [ + ! don't bomb on dotted pairs + = + ] ifte + ] ifte + ] [ + 2drop f + ] ifte ; compile-maybe + +3 [ 1 2 [ 3 4 ] 5 6 ] tail-call-4 . + +"Tail call optimization checks done." print diff --git a/factor/test/test.factor b/factor/test/test.factor index f8ee842611..ef19f00822 100644 --- a/factor/test/test.factor +++ b/factor/test/test.factor @@ -14,26 +14,44 @@ : compile-no-name ( list -- ) no-name compile-maybe ; -~<< 3dup A B C -- A B C A B C >>~ +: must-compile ( word -- ) + $compile [ + "Checking if " write dup " was compiled" print + dup compile + worddef compiled? assert + ] [ + drop + ] ifte ; -: test-word ( output word input ) +: test-word ( output input word -- ) 3dup 3list . append compile-no-name unit expand assert= ; +: do-not-test-word ( output input word -- ) + #! Flag for tests that are known not to work. + drop drop drop ; + : test ( name -- ) ! Run the given test. - "/factor/test/" swap ".factor" cat3 runResource ; + "/factor/test/" swap ".factor" cat3 run-resource ; : all-tests ( -- ) "Running Factor test suite..." print [ + "auxiliary" "combinators" "compiler" "dictionary" "list" + "math" "miscellaneous" + "namespaces" "random" + "reader" "stack" + "string" + "tail" + "reboot" ] [ test ] each diff --git a/factor/trace.factor b/factor/trace.factor new file mode 100644 index 0000000000..3af86ad8bf --- /dev/null +++ b/factor/trace.factor @@ -0,0 +1,70 @@ +!: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. + +! TODO: tracing non-compound words using a gensym. +! TODO: broken with doc comments. + +: TRACED ( -- ) + ! Marker word. Words that are traced have this as their + ! first factor. + ; + +: compound>list ( worddef -- list ) + worddef>list cdr cdr ; + +: [trace+] ( word stack? -- def ) + [ #=TRACED swap "Trace: " swap cat2 #=print 3list ] dip + [ .s ] [ ] ? append ; + +: traced? ( word -- ? ) + worddef dup compound? [ + compound>list car #=TRACED = + ] [ + drop f + ] ifte ; + +: trace+ ( word stack? -- ) + over traced? [ + "Already traced." print + 2drop + ] [ + over worddef dup compound? [ + compound>list [ dupd [trace+] ] dip append define + ] [ + "Cannot trace non-compound definition." print + ] ifte + ] ifte ; + +: [trace-] ( def -- def ) + cdr cdr cdr ; + +: trace- ( word -- ) + dup traced? [ + dup worddef compound>list [trace-] define + ] [ + drop "Not traced." print + ] ifte ; diff --git a/version.factor b/version.factor index af9e4a66d1..c814006ec5 100644 --- a/version.factor +++ b/version.factor @@ -1 +1 @@ -"0.53" @version +: version "0.58" ;