diff --git a/.cvskeywords b/.cvskeywords index 249011c861..3bc2010c96 100644 --- a/.cvskeywords +++ b/.cvskeywords @@ -1,14 +1,24 @@ -./factor/compiler/StackEffect.java: * $Id: StackEffect.java,v 1.6 2004/02/15 22:24:19 slava Exp $ -./factor/compiler/LocalAllocator.java: * $Id: LocalAllocator.java,v 1.9 2004/02/17 20:36:09 slava Exp $ +./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/Literal.java: * $Id: Literal.java,v 1.1 2004/02/28 19:51:53 slava Exp $ ./factor/compiler/FactorCompilerException.java: * $Id: FactorCompilerException.java,v 1.1 2004/01/27 19:55:40 slava Exp $ -./factor/compiler/CompiledDefinition.java:* $Id: CompiledDefinition.java,v 1.4 2004/02/15 22:24:19 slava Exp $ +./factor/compiler/CompiledDefinition.java:* $Id: CompiledDefinition.java,v 1.8 2004/03/07 22:51:00 slava Exp $ +./factor/compiler/Result.java: * $Id: Result.java,v 1.1 2004/02/28 19:51:53 slava Exp $ +./factor/compiler/ConstantPoolString.java: * $Id: ConstantPoolString.java,v 1.1 2004/02/28 19:51:53 slava Exp $ +./factor/compiler/Null.java: * $Id: Null.java,v 1.2 2004/03/01 02:37:01 slava Exp $ +./factor/compiler/RecursiveState.java: * $Id: RecursiveState.java,v 1.5 2004/03/28 21:25:13 slava Exp $ +./factor/compiler/FactorCompiler.java: * $Id: FactorCompiler.java,v 1.11 2004/03/24 02:50:28 slava Exp $ +./factor/compiler/RecursiveForm.java: * $Id: RecursiveForm.java,v 1.5 2004/03/04 23:33:42 slava Exp $ +./factor/compiler/CompiledChoice.java: * $Id: CompiledChoice.java,v 1.7 2004/03/28 21:25:13 slava Exp $ +./factor/compiler/FlowObject.java: * $Id: FlowObject.java,v 1.3 2004/03/28 21:25:13 slava Exp $ +./factor/prettyprint.factor:! $Id: prettyprint.factor,v 1.3 2004/03/26 05:06:36 slava Exp $ ./factor/random.factor:! $Id: random.factor,v 1.6 2004/02/18 00:48:47 slava Exp $ ./factor/FactorExternalizable.java: * $Id: FactorExternalizable.java,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/FactorJava.java: * $Id: FactorJava.java,v 1.7 2004/02/15 05:44:54 slava Exp $ -./factor/FactorDictionary.java: * $Id: FactorDictionary.java,v 1.8 2004/02/15 22:24:19 slava Exp $ -./factor/combinators.factor:! $Id: combinators.factor,v 1.4 2004/02/13 23:19:43 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/FactorDataStack.java: * $Id: FactorDataStack.java,v 1.3 2004/02/15 22:24:19 slava Exp $ -./factor/continuations.factor:! $Id: continuations.factor,v 1.1 2004/01/25 19:55:39 slava Exp $ +./factor/continuations.factor:! $Id: continuations.factor,v 1.3 2004/03/11 05:49:37 slava Exp $ ./factor/network.factor:! $Id: network.factor,v 1.2 2004/02/10 05:43:37 slava Exp $ ./factor/FactorLib.java: * $Id: FactorLib.java,v 1.4 2004/02/15 22:24:19 slava Exp $ ./factor/FactorRuntimeException.java: * $Id: FactorRuntimeException.java,v 1.1 2004/01/25 19:55:39 slava Exp $ @@ -16,53 +26,55 @@ ./factor/FactorCallStack.java: * $Id: FactorCallStack.java,v 1.2 2004/02/15 22:24:19 slava Exp $ ./factor/FactorStackException.java: * $Id: FactorStackException.java,v 1.1 2004/01/25 19:55:39 slava Exp $ ./factor/FactorUndefinedWordException.java: * $Id: FactorUndefinedWordException.java,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/lists.factor:! $Id: lists.factor,v 1.7 2004/02/15 22:24:19 slava Exp $ +./factor/lists.factor:! $Id: lists.factor,v 1.17 2004/03/24 02:50:28 slava Exp $ ./factor/FactorCallFrame.java: * $Id: FactorCallFrame.java,v 1.3 2004/02/05 04:47:05 slava Exp $ -./factor/examples/httpd.factor:! $Id: httpd.factor,v 1.3 2004/02/13 23:19:43 slava Exp $ -./factor/FactorNamespace.java: * $Id: FactorNamespace.java,v 1.4 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/PublicCloneable.java: * $Id: PublicCloneable.java,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/examples.factor:! $Id: examples.factor,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/Cons.java: * $Id: Cons.java,v 1.4 2004/02/11 03:49:45 slava Exp $ -./factor/FactorCompoundDefinition.java:* $Id: FactorCompoundDefinition.java,v 1.9 2004/02/15 22:24:19 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/FactorObject.java: * $Id: FactorObject.java,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/FactorParser.java: * $Id: FactorParser.java,v 1.3 2004/01/26 03:16:54 slava Exp $ -./factor/FactorMath.java: * $Id: FactorMath.java,v 1.3 2004/02/17 20:36:09 slava Exp $ -./factor/parser.factor:! $Id: parser.factor,v 1.2 2004/02/10 05:43:37 slava Exp $ -./factor/FactorMissingDefinition.java: * $Id: FactorMissingDefinition.java,v 1.7 2004/02/15 22:24:19 slava Exp $ -./factor/stream.factor:! $Id: stream.factor,v 1.3 2004/02/10 05:43:37 slava Exp $ -./factor/strings.factor:! $Id: strings.factor,v 1.9 2004/02/18 00:48:47 slava Exp $ -./factor/FactorInterpreter.java: * $Id: FactorInterpreter.java,v 1.6 2004/02/17 20:36:09 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/FactorDomainException.java: * $Id: FactorDomainException.java,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/FactorWord.java: * $Id: FactorWord.java,v 1.7 2004/02/15 05:44:54 slava Exp $ -./factor/math.factor:! $Id: math.factor,v 1.5 2004/02/17 20:36:09 slava Exp $ -./factor/FactorWordDefinition.java: * $Id: FactorWordDefinition.java,v 1.14 2004/02/15 22:24:19 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.2 2004/02/15 22:24:20 slava Exp $ +./factor/primitives/JInvokeStatic.java: * $Id: JInvokeStatic.java,v 1.4 2004/02/28 19:51:53 slava Exp $ ./factor/primitives/Unwind.java: * $Id: Unwind.java,v 1.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/JVarGetStatic.java: * $Id: JVarGetStatic.java,v 1.2 2004/02/15 22:24:20 slava Exp $ +./factor/primitives/JVarGetStatic.java: * $Id: JVarGetStatic.java,v 1.4 2004/02/28 19:51:53 slava Exp $ ./factor/primitives/Unstack.java: * $Id: Unstack.java,v 1.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/JInvoke.java: * $Id: JInvoke.java,v 1.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/Get.java: * $Id: Get.java,v 1.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/Define.java: * $Id: Define.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.3 2004/02/17 20:36:09 slava Exp $ -./factor/primitives/Choice.java: * $Id: Choice.java,v 1.3 2004/02/17 03:49:46 slava Exp $ -./factor/primitives/JNew.java: * $Id: JNew.java,v 1.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/Call.java: * $Id: Call.java,v 1.2 2004/02/15 22:24:19 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.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/Set.java: * $Id: Set.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.2 2004/02/15 22:24:20 slava Exp $ -./factor/primitives/JVarGet.java: * $Id: JVarGet.java,v 1.2 2004/02/15 22:24:20 slava Exp $ -./factor/interpreter.factor:! $Id: interpreter.factor,v 1.6 2004/02/10 05:43:37 slava Exp $ -./factor/miscellaneous.factor:! $Id: miscellaneous.factor,v 1.5 2004/02/15 22:24:19 slava Exp $ -./factor/FactorArrayStack.java: * $Id: FactorArrayStack.java,v 1.2 2004/01/26 03:16:54 slava Exp $ -./factor/boot.factor:! $Id: boot.factor,v 1.5 2004/02/18 00:48:47 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.4 2004/02/10 05:43:37 slava Exp $ +./factor/namespaces.factor:! $Id: namespaces.factor,v 1.7 2004/03/16 23:30:54 slava Exp $ ./factor/FactorException.java: * $Id: FactorException.java,v 1.1 2004/01/25 19:55:39 slava Exp $ -./factor/FactorShuffleDefinition.java: * $Id: FactorShuffleDefinition.java,v 1.12 2004/02/15 22:24:19 slava Exp $ -./factor/dictionary.factor:! $Id: dictionary.factor,v 1.8 2004/02/10 05:43:37 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 $ diff --git a/factor/Cons.java b/factor/Cons.java index a1c0744f9c..1e2120f44b 100644 --- a/factor/Cons.java +++ b/factor/Cons.java @@ -119,6 +119,35 @@ public class Cons implements PublicCloneable, FactorExternalizable return size; } //}}} + //{{{ nappend() method + public static Cons nappend(Cons l1, Cons l2) + { + if(l1 == null) + return l2; + if(l2 == null) + return l1; + Cons last = l1; + while(last.cdr != null) + last = last.next(); + last.cdr = l2; + return l1; + } //}}} + + //{{{ assoc() method + public static Object assoc(Cons assoc, Object key) + { + if(assoc == null) + return null; + else + { + Cons first = (Cons)assoc.car; + if(FactorLib.equal(first.car,key)) + return first.cdr; + else + return assoc(assoc.next(),key); + } + } //}}} + //{{{ isProperList() method public boolean isProperList() { @@ -140,7 +169,7 @@ public class Cons implements PublicCloneable, FactorExternalizable if(iter.car == this) buf.append(""); else - buf.append(FactorJava.factorTypeToString(iter.car)); + buf.append(FactorParser.unparse(iter.car)); if(iter.cdr instanceof Cons) { buf.append(' '); @@ -152,7 +181,7 @@ public class Cons implements PublicCloneable, FactorExternalizable else { buf.append(" , "); - buf.append(FactorJava.factorTypeToString(iter.cdr)); + buf.append(FactorParser.unparse(iter.cdr)); iter = null; } } diff --git a/factor/FactorArrayStack.java b/factor/FactorArrayStack.java index 256ee40ea4..f795320776 100644 --- a/factor/FactorArrayStack.java +++ b/factor/FactorArrayStack.java @@ -140,21 +140,4 @@ public abstract class FactorArrayStack implements FactorExternalizable } return first; } //}}} - - //{{{ toString() method - public String toString() - { - StringBuffer buf = new StringBuffer(); - for(int i = 0; i < top; i++) - { - if(i != 0) - buf.append('\n'); - buf.append(i).append(": "); - if(stack[i] == this) - buf.append("THIS STACK"); - else - buf.append(FactorJava.factorTypeToString(stack[i])); - } - return buf.toString(); - } //}}} } diff --git a/factor/FactorCompoundDefinition.java b/factor/FactorCompoundDefinition.java index 94dd4a0cb3..b4cbc4e688 100644 --- a/factor/FactorCompoundDefinition.java +++ b/factor/FactorCompoundDefinition.java @@ -34,7 +34,6 @@ import java.lang.reflect.*; import java.io.FileOutputStream; import java.util.*; import org.objectweb.asm.*; -import org.objectweb.asm.util.*; /** * : name ... ; @@ -60,22 +59,21 @@ public class FactorCompoundDefinition extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler compiler) throws Exception { - if(recursiveCheck.contains(this)) - return null; - - try + RecursiveForm rec = recursiveCheck.get(word); + if(rec.active) { - recursiveCheck.add(this); + StackEffect se = rec.baseCase; + if(se == null) + throw new FactorCompilerException("Indeterminate recursive call"); - return StackEffect.getStackEffect(definition, - recursiveCheck,state); + compiler.apply(StackEffect.decompose(rec.effect,se)); } - finally + else { - recursiveCheck.remove(this); + compiler.getStackEffect(definition,recursiveCheck); } } //}}} @@ -100,45 +98,40 @@ public class FactorCompoundDefinition extends FactorWordDefinition * Compile the given word, returning a new word definition. */ FactorWordDefinition compile(FactorInterpreter interp, - Set recursiveCheck) throws Exception + RecursiveState recursiveCheck) throws Exception { - StackEffect effect = getStackEffect( - recursiveCheck,new LocalAllocator()); - if(effect == null) - throw new FactorCompilerException("Cannot deduce stack effect of " + word); - if(effect.outD > 1) - throw new FactorCompilerException("Cannot compile word that returns more than 1 value"); + StackEffect effect = getStackEffect(); - /* StringBuffer buf = new StringBuffer(); - for(int i = 0; i < recursiveCheck.size(); i++) - { - buf.append(' '); - } - buf.append("Compiling ").append(word); - System.err.println(buf); */ + 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); ClassWriter cw = new ClassWriter(false); cw.visit(ACC_PUBLIC, className, - "factor/compiler/CompiledDefinition", null, null); + "factor/compiler/CompiledDefinition", + null, null); compileConstructor(cw,className); CompileResult result = compileEval(interp,cw, - className,effect,recursiveCheck); + className,effect,recursiveCheck, + multipleReturns); - compileToString(cw,effect); + // Generate fields for storing literals and + // word references + result.compiler.generateFields(cw); - // Generate fields for storing literals and word references - result.allocator.generateFields(cw); - - // gets the bytecode of the class, and loads it dynamically + // gets the bytecode of the class, and loads it + // dynamically byte[] code = cw.toByteArray(); - if(interp.compileDump) + if(interp.dump) { - FileOutputStream fos = new FileOutputStream(className + ".class"); + FileOutputStream fos = new FileOutputStream( + className + ".class"); fos.write(code); fos.close(); } @@ -147,17 +140,21 @@ public class FactorCompoundDefinition extends FactorWordDefinition className.replace('/','.'), code, 0, code.length); - result.allocator.setFields(compiledWordClass); + result.compiler.setFields(compiledWordClass); - Constructor constructor = compiledWordClass.getConstructor( - new Class[] { FactorWord.class, StackEffect.class }); + Constructor constructor = compiledWordClass + .getConstructor( + new Class[] { + FactorWord.class, StackEffect.class, Cons.class + }); - FactorWordDefinition compiledWord = (FactorWordDefinition) - constructor.newInstance(new Object[] { word, effect }); + FactorWordDefinition compiledWord + = (FactorWordDefinition) + constructor.newInstance( + new Object[] { word, effect, definition }); // store disassembly for the 'asm' word. - compiledWord.getNamespace(interp).setVariable("asm", - result.asm); + word.asm = result.asm; return compiledWord; } //}}} @@ -168,7 +165,9 @@ public class FactorCompoundDefinition extends FactorWordDefinition // creates a MethodWriter for the constructor CodeVisitor mw = cw.visitMethod(ACC_PUBLIC, "", - "(Lfactor/FactorWord;Lfactor/compiler/StackEffect;)V", + "(Lfactor/FactorWord;" + + "Lfactor/compiler/StackEffect;" + + "Lfactor/Cons;)V", null, null); // pushes the 'this' variable mw.visitVarInsn(ALOAD, 0); @@ -176,34 +175,27 @@ public class FactorCompoundDefinition extends FactorWordDefinition mw.visitVarInsn(ALOAD, 1); // pushes the stack effect parameter mw.visitVarInsn(ALOAD, 2); + // pushes the definition parameter + mw.visitVarInsn(ALOAD, 3); // invokes the super class constructor mw.visitMethodInsn(INVOKESPECIAL, "factor/compiler/CompiledDefinition", "", - "(Lfactor/FactorWord;Lfactor/compiler/StackEffect;)V"); + "(Lfactor/FactorWord;" + + "Lfactor/compiler/StackEffect;" + + "Lfactor/Cons;)V"); mw.visitInsn(RETURN); - mw.visitMaxs(3, 3); - } //}}} - - //{{{ compileToString() method - private void compileToString(ClassVisitor cw, StackEffect effect) - { - // creates a MethodWriter for the 'toString' method - CodeVisitor mw = cw.visitMethod(ACC_PUBLIC, - "toString", "()Ljava/lang/String;", null, null); - mw.visitLdcInsn("( compiled: " + effect + " ) " + toString()); - mw.visitInsn(ARETURN); - mw.visitMaxs(1, 1); + mw.visitMaxs(4, 4); } //}}} //{{{ compileEval() method static class CompileResult { - LocalAllocator allocator; + FactorCompiler compiler; String asm; - CompileResult(LocalAllocator allocator, String asm) + CompileResult(FactorCompiler compiler, String asm) { - this.allocator = allocator; + this.compiler = compiler; this.asm = asm; } } @@ -215,73 +207,34 @@ public class FactorCompoundDefinition extends FactorWordDefinition */ protected CompileResult compileEval(FactorInterpreter interp, ClassWriter cw, String className, StackEffect effect, - Set recursiveCheck) throws Exception + RecursiveState recursiveCheck, boolean multipleReturns) + throws Exception { // creates a MethodWriter for the 'eval' method - CodeVisitor _mw = cw.visitMethod(ACC_PUBLIC, + CodeVisitor mw = cw.visitMethod(ACC_PUBLIC, "eval", "(Lfactor/FactorInterpreter;)V", null, null); - TraceCodeVisitor mw = new TraceCodeVisitor(_mw); - // eval() method calls core mw.visitVarInsn(ALOAD,1); compileDataStackToJVMStack(effect,mw); - String signature = effect.getCorePrototype(); - - mw.visitMethodInsn(INVOKESTATIC, - className,"core",signature); + mw.visitMethodInsn(INVOKESTATIC,className,"core", + effect.getCorePrototype()); compileJVMStackToDataStack(effect,mw); mw.visitInsn(RETURN); mw.visitMaxs(Math.max(4,2 + effect.inD),4); - String evalAsm = getDisassembly(mw); - // generate core - _mw = cw.visitMethod(ACC_PUBLIC | ACC_STATIC, - "core",signature,null,null); - - mw = new TraceCodeVisitor(_mw); - - LocalAllocator allocator = new LocalAllocator(interp, + FactorCompiler compiler = new FactorCompiler(interp,word, className,1,effect.inD); + String asm = compiler.compile(definition,cw,className, + "core",effect,recursiveCheck); - int maxJVMStack = allocator.compile(definition,mw, - recursiveCheck); - - if(effect.outD == 0) - mw.visitInsn(RETURN); - else - { - allocator.pop(mw); - mw.visitInsn(ARETURN); - maxJVMStack = Math.max(maxJVMStack,1); - } - - mw.visitMaxs(maxJVMStack,allocator.maxLocals()); - - String coreAsm = getDisassembly(mw); - - return new CompileResult(allocator, - "eval(Lfactor/FactorInterpreter;)V:\n" + evalAsm - + "core" + signature + "\n" + coreAsm); - } //}}} - - //{{{ getDisassembly() method - protected String getDisassembly(TraceCodeVisitor mw) - { - // Save the disassembly of the eval() method - StringBuffer buf = new StringBuffer(); - Iterator bytecodes = mw.getText().iterator(); - while(bytecodes.hasNext()) - { - buf.append(bytecodes.next()); - } - return buf.toString(); + return new CompileResult(compiler,asm); } //}}} //{{{ compileDataStackToJVMStack() method @@ -358,16 +311,37 @@ public class FactorCompoundDefinition extends FactorWordDefinition /** * Compile a call to this word. Returns maximum JVM stack use. */ - public int compileImmediate(CodeVisitor mw, LocalAllocator allocator, - Set recursiveCheck) throws Exception + public int compileImmediate(CodeVisitor mw, FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - return allocator.compile(definition,mw,recursiveCheck); + /* System.err.println("immediate call to " + word); + FactorDataStack savedDatastack = (FactorDataStack) + compiler.datastack.clone(); + FactorCallStack savedCallstack = (FactorCallStack) + compiler.callstack.clone(); + StackEffect savedEffect = compiler.getStackEffect(); + compiler.effect = new StackEffect(); + + RecursiveState _recursiveCheck = new RecursiveState(); + _recursiveCheck.add(word,null); + getStackEffect(_recursiveCheck,compiler); + _recursiveCheck.remove(word); + StackEffect effect = compiler.getStackEffect(); + + System.err.println("immediate effect is " + effect); + + compiler.datastack = savedDatastack; + compiler.callstack = savedCallstack; + compiler.effect = savedEffect; */ + + return compiler.compile(definition,mw,recursiveCheck); } //}}} - //{{{ toString() method - public String toString() + //{{{ toList() method + public Cons toList() { - return definition.elementsToString(); + return new Cons(word,new Cons(new FactorWord("\n"), + definition)); } //}}} private static SimpleClassLoader loader = new SimpleClassLoader(); diff --git a/factor/FactorDictionary.java b/factor/FactorDictionary.java deleted file mode 100644 index 0cdd0764c6..0000000000 --- a/factor/FactorDictionary.java +++ /dev/null @@ -1,165 +0,0 @@ -/* :folding=explicit:collapseFolds=1: */ - -/* - * $Id$ - * - * Copyright (C) 2003, 2004 Slava Pestov. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, - * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND - * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE - * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ - -package factor; - -import factor.primitives.*; -import java.util.Iterator; -import java.util.Map; -import java.util.TreeMap; - -public class FactorDictionary -{ - public FactorWord last; - - FactorWord datastackGet; - FactorWord datastackSet; - FactorWord clear; - FactorWord callstackGet; - FactorWord callstackSet; - FactorWord restack; - FactorWord unstack; - FactorWord unwind; - FactorWord jnew; - FactorWord jvarGet; - FactorWord jvarSet; - FactorWord jvarGetStatic; - FactorWord jvarSetStatic; - FactorWord jinvoke; - FactorWord jinvokeStatic; - FactorWord get; - FactorWord set; - FactorWord define; - FactorWord call; - FactorWord bind; - FactorWord choice; - - private Map intern; - - //{{{ init() method - public void init() - { - intern = new TreeMap(); - - // data stack primitives - datastackGet = intern("datastack$"); - datastackGet.def = new DatastackGet( - datastackGet); - datastackSet = intern("datastack@"); - datastackSet.def = new DatastackSet( - datastackSet); - clear = intern("clear"); - clear.def = new Clear(clear); - - // call stack primitives - callstackGet = intern("callstack$"); - callstackGet.def = new CallstackGet( - callstackGet); - callstackSet = intern("callstack@"); - callstackSet.def = new CallstackSet( - callstackSet); - restack = intern("restack"); - restack.def = new Restack(restack); - unstack = intern("unstack"); - unstack.def = new Unstack(unstack); - unwind = intern("unwind"); - unwind.def = new Unwind(unwind); - - // reflection primitives - jinvoke = intern("jinvoke"); - jinvoke.def = new JInvoke(jinvoke); - jinvokeStatic = intern("jinvoke-static"); - jinvokeStatic.def = new JInvokeStatic( - jinvokeStatic); - jnew = intern("jnew"); - jnew.def = new JNew(jnew); - jvarGet = intern("jvar$"); - jvarGet.def = new JVarGet(jvarGet); - jvarGetStatic = intern("jvar-static$"); - jvarGetStatic.def = new JVarGetStatic( - jvarGetStatic); - jvarSet = intern("jvar@"); - jvarSet.def = new JVarSet(jvarSet); - jvarSetStatic = intern("jvar-static@"); - jvarSetStatic.def = new JVarSetStatic( - jvarSetStatic); - - // namespaces - get = intern("$"); - get.def = new Get(get); - set = intern("@"); - set.def = new Set(set); - - // definition - define = intern("define"); - define.def = new Define(define); - - // combinators - call = intern("call"); - call.def = new Call(call); - bind = intern("bind"); - bind.def = new Bind(bind); - choice = intern("?"); - choice.def = new Choice(choice); - } //}}} - - //{{{ intern() method - public FactorWord intern(String name) - { - FactorWord w = (FactorWord)intern.get(name); - if(w == null) - { - w = new FactorWord(name); - intern.put(name,w); - } - return w; - } //}}} - - //{{{ toWordList() method - public Cons toWordList() - { - Cons first = null; - Cons last = null; - Iterator iter = intern.values().iterator(); - while(iter.hasNext()) - { - FactorWord word = (FactorWord)iter.next(); - if(!(word.def instanceof FactorMissingDefinition)) - { - Cons cons = new Cons(word,null); - if(first == null) - first = cons; - else - last.cdr = cons; - last = cons; - } - } - return first; - } //}}} -} diff --git a/factor/FactorInterpreter.java b/factor/FactorInterpreter.java index 16764a1b4c..fe97260ace 100644 --- a/factor/FactorInterpreter.java +++ b/factor/FactorInterpreter.java @@ -3,7 +3,7 @@ /* * $Id$ * - * Copyright (C) 2003 Slava Pestov. + * Copyright (C) 2003, 2004 Slava Pestov. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: @@ -29,6 +29,7 @@ package factor; +import factor.primitives.*; import java.io.*; public class FactorInterpreter @@ -41,53 +42,20 @@ public class FactorInterpreter public boolean trace = false; public boolean errorFlag = false; public boolean compile = true; - public boolean compileDump = false; + public boolean dump = false; public FactorCallFrame callframe; public FactorCallStack callstack = new FactorCallStack(); public FactorDataStack datastack = new FactorDataStack(); - public final FactorDictionary dict = new FactorDictionary(); + public FactorNamespace dict; + public FactorWord last; public FactorNamespace global; //{{{ main() method - /** - * Need to refactor this into Factor. - */ public static void main(String[] args) throws Exception { FactorInterpreter interp = new FactorInterpreter(); - interp.init(args,null); - - /* if(virgin) - { - System.out.println("Mini-interpreter"); - BufferedReader in = new BufferedReader( - new InputStreamReader( - System.in)); - String line; - for(;;) - { - System.out.print("] "); - System.out.flush(); - line = in.readLine(); - if(line == null) - break; - - FactorParser parser = new FactorParser( - "",new StringReader(line), - interp.dict); - Cons parsed = parser.parse(); - interp.call(parsed); - interp.run(); - System.out.println(interp.datastack); - } - } - else - { - interp.run(); - } */ - System.exit(0); } //}}} @@ -98,12 +66,81 @@ public class FactorInterpreter callstack.top = 0; datastack.top = 0; - dict.init(); + initDictionary(); initNamespace(root); topLevel(); runBootstrap(); } //}}} + //{{{ initDictionary() method + private void initDictionary() throws Exception + { + dict = new FactorNamespace(null,null); + + // data stack primitives + FactorWord datastackGet = intern("datastack$"); + datastackGet.def = new DatastackGet( + datastackGet); + FactorWord datastackSet = intern("datastack@"); + datastackSet.def = new DatastackSet( + datastackSet); + FactorWord clear = intern("clear"); + clear.def = new Clear(clear); + + // call stack primitives + FactorWord callstackGet = intern("callstack$"); + callstackGet.def = new CallstackGet( + callstackGet); + FactorWord callstackSet = intern("callstack@"); + callstackSet.def = new CallstackSet( + callstackSet); + FactorWord restack = intern("restack"); + restack.def = new Restack(restack); + FactorWord unstack = intern("unstack"); + unstack.def = new Unstack(unstack); + FactorWord unwind = intern("unwind"); + unwind.def = new Unwind(unwind); + + // reflection primitives + FactorWord jinvoke = intern("jinvoke"); + jinvoke.def = new JInvoke(jinvoke); + FactorWord jinvokeStatic = intern("jinvoke-static"); + jinvokeStatic.def = new JInvokeStatic( + jinvokeStatic); + FactorWord jnew = intern("jnew"); + jnew.def = new JNew(jnew); + FactorWord jvarGet = intern("jvar$"); + jvarGet.def = new JVarGet(jvarGet); + FactorWord jvarGetStatic = intern("jvar-static$"); + jvarGetStatic.def = new JVarGetStatic( + jvarGetStatic); + FactorWord jvarSet = intern("jvar@"); + jvarSet.def = new JVarSet(jvarSet); + FactorWord jvarSetStatic = intern("jvar-static@"); + jvarSetStatic.def = new JVarSetStatic( + jvarSetStatic); + + // namespaces + FactorWord get = intern("$"); + get.def = new Get(get); + FactorWord set = intern("@"); + set.def = new Set(set); + + // definition + FactorWord define = intern("define"); + define.def = new Define(define); + + // combinators + FactorWord execute = intern("execute"); + execute.def = new Execute(execute); + FactorWord call = intern("call"); + call.def = new Call(call); + FactorWord bind = intern("bind"); + bind.def = new Bind(bind); + FactorWord choice = intern("?"); + choice.def = new Choice(choice); + } //}}} + //{{{ initNamespace() method private void initNamespace(Object root) throws Exception { @@ -111,9 +148,14 @@ public class FactorInterpreter global.setVariable("interpreter",this); - String[] boundFields = { "compile", "compileDump", + global.setVariable("error-flag", + new FactorNamespace.VarBinding( + getClass().getField("errorFlag"), + this)); + + String[] boundFields = { "compile", "dump", "interactive", "trace", - "dict", "errorFlag", "args" }; + "dict", "args", "global", "last" }; for(int i = 0; i < boundFields.length; i++) { global.setVariable(boundFields[i], @@ -132,8 +174,8 @@ public class FactorInterpreter new InputStreamReader( getClass().getResourceAsStream( initFile)), - dict); - call(dict.intern("[init]"),parser.parse()); + this); + call(intern("[init]"),parser.parse()); run(); } //}}} @@ -175,7 +217,7 @@ public class FactorInterpreter eval(ip.car); } - catch(Exception e) + catch(Throwable e) { if(handleError(e)) return; @@ -186,7 +228,7 @@ public class FactorInterpreter } //}}} //{{{ handleError() method - private boolean handleError(Exception e) + private boolean handleError(Throwable e) { /* if(throwErrors) { @@ -213,10 +255,10 @@ public class FactorInterpreter datastack.push(FactorJava.unwrapException(e)); try { - eval(dict.intern("break")); + eval(intern("break")); return false; } - catch(Exception e2) + catch(Throwable e2) { System.err.println("Exception when calling break:"); e.printStackTrace(); @@ -236,7 +278,7 @@ public class FactorInterpreter */ public final void call(Cons code) { - call(dict.intern("call"),code); + call(intern("call"),code); } //}}} //{{{ call() method @@ -302,14 +344,14 @@ public class FactorInterpreter /** * Evaluates a word. */ - private void eval(Object obj) throws Exception + public void eval(Object obj) throws Exception { if(trace) { StringBuffer buf = new StringBuffer(); for(int i = 0; i < callstack.top; i++) buf.append(' '); - buf.append(FactorJava.factorTypeToString(obj)); + buf.append(FactorParser.unparse(obj)); System.err.println(buf); } @@ -333,6 +375,25 @@ public class FactorInterpreter datastack.push(obj); } //}}} + //{{{ intern() method + public FactorWord intern(String name) + { + try + { + FactorWord w = (FactorWord)dict.getVariable(name); + if(w == null) + { + w = new FactorWord(name); + dict.setVariable(name,w); + } + return w; + } + catch(Exception e) + { + throw new RuntimeException(e); + } + } //}}} + //{{{ topLevel() method /** * Returns the parser to the top level context. @@ -342,7 +403,7 @@ public class FactorInterpreter callstack.top = 0; datastack.top = 0; callframe = new FactorCallFrame( - dict.intern("[toplevel]"), + intern("[toplevel]"), global, null); } //}}} diff --git a/factor/FactorJava.java b/factor/FactorJava.java index 0ae6178563..4ef2f3b812 100644 --- a/factor/FactorJava.java +++ b/factor/FactorJava.java @@ -29,7 +29,7 @@ package factor; -import factor.compiler.LocalAllocator; +import factor.compiler.FactorCompiler; import java.lang.reflect.*; import java.util.Iterator; import java.util.LinkedList; @@ -125,6 +125,18 @@ public class FactorJava implements Constants return true; } //}}} + //{{{ toByte() method + public static byte toByte(Object arg) + throws FactorDomainException + { + if(arg instanceof Number) + return ((Number)arg).byteValue(); + else if(arg instanceof String) + return Byte.parseByte((String)arg); + else + throw new FactorDomainException(arg,byte.class); + } //}}} + //{{{ toChar() method public static char toChar(Object arg) throws FactorDomainException @@ -232,18 +244,75 @@ public class FactorJava implements Constants } } //}}} + //{{{ toBooleanArray() method + public static boolean[] toBooleanArray(Object arg) + throws FactorDomainException + { + if(arg == null) + return new boolean[0]; + else if(arg instanceof Cons) + arg = toArray(arg,Object[].class); + + try + { + boolean[] returnValue = new boolean[ + Array.getLength(arg)]; + for(int i = 0; i < returnValue.length; i++) + { + returnValue[i] = toBoolean( + Array.get(arg,i)); + } + return returnValue; + } + catch(IllegalArgumentException e) + { + throw new FactorDomainException(arg,boolean[].class); + } + } //}}} + + //{{{ toByteArray() method + public static byte[] toByteArray(Object arg) + throws FactorDomainException + { + if(arg == null) + return new byte[0]; + else if(arg instanceof Cons) + arg = toArray(arg,Object[].class); + + try + { + byte[] returnValue = new byte[ + Array.getLength(arg)]; + for(int i = 0; i < returnValue.length; i++) + { + returnValue[i] = toByte( + Array.get(arg,i)); + } + return returnValue; + } + catch(IllegalArgumentException e) + { + throw new FactorDomainException(arg,byte[].class); + } + } //}}} + //{{{ toArray() method public static Object[] toArray(Object arg) throws FactorDomainException { - return toArray(arg,Object.class); + return toArray(arg,Object[].class); } //}}} //{{{ toArray() method public static Object[] toArray(Object arg, Class clas) throws FactorDomainException { - if(arg instanceof Cons) + if(arg == null) + { + return (Object[])Array.newInstance( + clas.getComponentType(),0); + } + else if(arg instanceof Cons) { Cons list = (Cons)arg; Object[] array = (Object[]) @@ -293,6 +362,10 @@ public class FactorJava implements Constants ? Boolean.TRUE : Boolean.FALSE; } + else if(clas == byte.class) + { + return new Byte(toByte(arg)); + } else if(clas == char.class) { return new Character(toChar(arg)); @@ -319,7 +392,11 @@ public class FactorJava implements Constants } else if(clas.isArray()) { - return toArray(arg,clas); + Class comp = clas.getComponentType(); + if(!comp.isPrimitive()) + return toArray(arg,clas); + else if(comp == boolean.class) + return toBooleanArray(arg); } if(arg != null && !clas.isInstance(arg)) @@ -343,25 +420,6 @@ public class FactorJava implements Constants return arg; } //}}} - //{{{ factorTypeToString() method - public static String factorTypeToString(Object obj) - { - // this is for string representations of lists and stacks - if(obj == null || obj.equals(Boolean.FALSE)) - return "f"; - else if(obj.equals(Boolean.TRUE)) - return "t"; - else if(obj instanceof String) - return '"' + obj.toString() + '"'; //XXX: escape - else if(obj instanceof Number - || obj instanceof FactorExternalizable) - return obj.toString(); - else if(obj instanceof Character) - return "#\\" + ((Character)obj).charValue(); - else - return "( " + obj + " )"; - } //}}} - //{{{ javaClassToVMClass() method public static String javaClassToVMClass(Class clazz) { @@ -583,6 +641,29 @@ public class FactorJava implements Constants return e; } //}}} + //{{{ getConversionMethodName() method + /** + * Returns method name for converting an object to the given type. + * Only for primitives. + */ + public static String getConversionMethodName(Class type) + { + if(type == short.class) + { + // not yet done. + return null; + } + else if(type.isPrimitive()) + { + String name = type.getName(); + return "to" + + Character.toUpperCase(name.charAt(0)) + + name.substring(1); + } + else + return null; + } //}}} + //{{{ generateFromConversion() method /** * Unbox value at top of the stack. @@ -600,18 +681,15 @@ public class FactorJava implements Constants methodName = "toNumber"; else if(type == String.class) methodName = "toString"; - else if(type == boolean.class) - methodName = "toBoolean"; - else if(type == char.class) - methodName = "toChar"; - else if(type == int.class) - methodName = "toInt"; - else if(type == long.class) - methodName = "toLong"; - else if(type == float.class) - methodName = "toFloat"; - else if(type == double.class) - methodName = "toDouble"; + else if(type == short.class + || type == byte.class + || type == char.class) + { + // not yet done. + methodName = null; + } + else if(type.isPrimitive()) + methodName = getConversionMethodName(type); else if(type == Class.class) methodName = "toClass"; else if(type == FactorNamespace.class) @@ -620,7 +698,16 @@ public class FactorJava implements Constants interpArg = true; } else if(type.isArray()) - methodName = "toArray"; + { + Class comp = type.getComponentType(); + if(comp.isPrimitive()) + { + methodName = getConversionMethodName(comp) + + "Array"; + } + else + methodName = "toArray"; + } if(methodName == null) { diff --git a/factor/FactorMath.java b/factor/FactorMath.java index bcf9574ed7..ced82b0ce8 100644 --- a/factor/FactorMath.java +++ b/factor/FactorMath.java @@ -278,8 +278,7 @@ public class FactorMath if(min == max) return min; - int nextInt = random.nextInt(); - return min + Math.abs(nextInt % (max - min + 1)); + return min + random.nextInt(max - min + 1); } //}}} //{{{ randomFloat() method diff --git a/factor/FactorMissingDefinition.java b/factor/FactorMissingDefinition.java index c75d204183..0eec3a9062 100644 --- a/factor/FactorMissingDefinition.java +++ b/factor/FactorMissingDefinition.java @@ -50,6 +50,13 @@ public class FactorMissingDefinition extends FactorWordDefinition throw new FactorUndefinedWordException(word); } //}}} + //{{{ toList() method + public Cons toList() + { + return new Cons(new FactorWord("( missing: " + word + " )"), + null); + } //}}} + //{{{ toString() method public String toString() { diff --git a/factor/FactorNamespace.java b/factor/FactorNamespace.java index 15726eded2..47afd5f65b 100644 --- a/factor/FactorNamespace.java +++ b/factor/FactorNamespace.java @@ -42,10 +42,10 @@ import java.util.List; /** * Manages the set of available words. */ -public class FactorNamespace implements PublicCloneable +public class FactorNamespace implements PublicCloneable, FactorObject { - private static FactorWord NULL = new FactorWord("(represent-f)"); - private static FactorWord CHECK_PARENT = new FactorWord("(check-parent)"); + private static FactorWord NULL = new FactorWord("( represent-f )"); + private static FactorWord CHECK_PARENT = new FactorWord("( check-parent )"); public Object obj; private FactorNamespace parent; @@ -105,6 +105,12 @@ public class FactorNamespace implements PublicCloneable } } //}}} + //{{{ getNamespace() method + public FactorNamespace getNamespace(FactorInterpreter interp) + { + return this; + } //}}} + //{{{ getParent() method public FactorNamespace getParent() { @@ -200,20 +206,48 @@ public class FactorNamespace implements PublicCloneable words.put(name,CHECK_PARENT); } //}}} + //{{{ initAllFields() method + private void initAllFields() + { + if(obj != null) + { + try + { + Field[] fields = obj.getClass().getFields(); + for(int i = 0; i < fields.length; i++) + { + Field f = fields[i]; + if(Modifier.isStatic(f.getModifiers())) + continue; + words.put(f.getName(), + new VarBinding(f,obj)); + } + } + catch(Exception e) + { + } + } + } //}}} + //{{{ toVarList() method /** * Returns a list of variable and word names defined in this namespace. */ public Cons toVarList() { + initAllFields(); + Cons first = null; Cons last = null; Iterator iter = words.entrySet().iterator(); while(iter.hasNext()) { Map.Entry entry = (Map.Entry)iter.next(); - if(entry.getValue() == CHECK_PARENT) + Object value = entry.getValue(); + if(value == CHECK_PARENT) continue; + else if(value == NULL) + value = null; String name = (String)entry.getKey(); Cons cons = new Cons(name,null); @@ -235,18 +269,33 @@ public class FactorNamespace implements PublicCloneable */ public Cons toValueList() { + initAllFields(); + Cons first = null; Cons last = null; Iterator iter = words.entrySet().iterator(); while(iter.hasNext()) { Map.Entry entry = (Map.Entry)iter.next(); - if(entry.getValue() == CHECK_PARENT) + Object value = entry.getValue(); + if(value == CHECK_PARENT) continue; + else if(value == NULL) + value = null; - Cons cons = new Cons( - new Cons(entry.getKey(), - entry.getValue()),null); + if(value instanceof VarBinding) + { + try + { + value = ((VarBinding)value).get(); + } + catch(Exception e) + { + } + } + + Cons cons = new Cons(new Cons(entry.getKey(),value) + ,null); if(first == null) first = last = cons; else @@ -291,11 +340,10 @@ public class FactorNamespace implements PublicCloneable { if(obj == null) { - return "( Namespace #" + Integer.toString(hashCode(),16) - + " )"; + return "Namespace #" + Integer.toString(hashCode(),16); } else - return "( Namespace: " + obj + " #" + hashCode() + " )"; + return "Namespace: " + obj + " #" + hashCode(); } //}}} //{{{ clone() method diff --git a/factor/FactorParser.java b/factor/FactorParser.java index c083b297d1..e36a978e80 100644 --- a/factor/FactorParser.java +++ b/factor/FactorParser.java @@ -52,32 +52,33 @@ public class FactorParser private String filename; private Reader in; - private FactorDictionary dict; + private FactorInterpreter interp;; private StreamTokenizer st; // sometimes one token is expanded into two words private Object next; //{{{ FactorParser constructor - public FactorParser(String filename, Reader in, FactorDictionary dict) + public FactorParser(String filename, Reader in, + FactorInterpreter interp) { this.filename = (filename == null ? "" : filename); this.in = in; - this.dict = dict; + this.interp = interp; - DEF = dict.intern(":"); - INE = dict.intern(";"); + DEF = interp.intern(":"); + INE = interp.intern(";"); - SHU = dict.intern("~<<"); - F = dict.intern("--"); - FLE = dict.intern(">>~"); + SHU = interp.intern("~<<"); + F = interp.intern("--"); + FLE = interp.intern(">>~"); - DEFINE = dict.intern("define"); + DEFINE = interp.intern("define"); - BRA = dict.intern("["); - KET = dict.intern("]"); + BRA = interp.intern("["); + KET = interp.intern("]"); - COMMA = dict.intern(","); + COMMA = interp.intern(","); st = new StreamTokenizer(in); st.resetSyntax(); @@ -293,13 +294,13 @@ public class FactorParser // $foo is expanded into "foo" $ if(st.sval.charAt(0) == '$') { - next = dict.intern("$"); + next = interp.intern("$"); return st.sval.substring(1); } // @foo is expanded into "foo" @ else if(st.sval.charAt(0) == '@') { - next = dict.intern("@"); + next = interp.intern("@"); return st.sval.substring(1); } } @@ -308,7 +309,7 @@ public class FactorParser if(st.sval.charAt(0) == '|') return st.sval.substring(1); - return dict.intern(st.sval); + return interp.intern(st.sval); case '"': case '\'': return st.sval; default: @@ -363,7 +364,7 @@ public class FactorParser int counter; if(name.startsWith("r:")) { - next = dict.intern(name.substring(2)); + next = interp.intern(name.substring(2)); counter = (FactorShuffleDefinition .FROM_R_MASK | consumeR++); @@ -378,7 +379,7 @@ public class FactorParser } else { - error("Unexpected " + FactorJava.factorTypeToString( + error("Unexpected " + FactorParser.unparse( next)); } } @@ -407,7 +408,7 @@ public class FactorParser FactorWord w = ((FactorWord)_shuffle.car); String name = w.name; if(name.startsWith("r:")) - w = dict.intern(name.substring(2)); + w = interp.intern(name.substring(2)); Integer _index = (Integer)consumeMap.get(w); if(_index == null) @@ -429,7 +430,7 @@ public class FactorParser } else { - error("Unexpected " + FactorJava.factorTypeToString( + error("Unexpected " + FactorParser.unparse( _shuffle.car)); } _shuffle = _shuffle.next(); @@ -544,4 +545,52 @@ public class FactorParser { throw new FactorParseException(filename,st.lineno(),msg); } //}}} + + //{{{ getUnreadableString() method + public static String getUnreadableString(String str) + { + return "#<" + str + ">"; + } //}}} + + //{{{ unparse() method + public static String unparse(Object obj) + { + // this is for string representations of lists and stacks + if(obj == null || obj.equals(Boolean.FALSE)) + return "f"; + else if(obj.equals(Boolean.TRUE)) + return "t"; + else if(obj instanceof String) + { + StringBuffer buf = new StringBuffer("\""); + String str = (String)obj; + for(int i = 0; i < str.length(); i++) + { + char ch = str.charAt(i); + switch(ch) + { + case '\n': + buf.append("\\n"); + break; + case '\t': + buf.append("\\t"); + break; + case '"': + buf.append("\\\""); + break; + default: + buf.append(ch); + } + } + buf.append('"'); + return buf.toString(); + } + else if(obj instanceof Number + || obj instanceof FactorExternalizable) + return obj.toString(); + else if(obj instanceof Character) + return "#\\" + ((Character)obj).charValue(); + else + return getUnreadableString(obj.toString()); + } //}}} } diff --git a/factor/FactorShuffleDefinition.java b/factor/FactorShuffleDefinition.java index d75f4371ca..85094f1aea 100644 --- a/factor/FactorShuffleDefinition.java +++ b/factor/FactorShuffleDefinition.java @@ -30,7 +30,7 @@ package factor; import factor.compiler.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; import org.objectweb.asm.util.*; @@ -109,14 +109,12 @@ public class FactorShuffleDefinition extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,consumeD); state.ensure(state.callstack,consumeR); eval(state.datastack,state.callstack); - return new StackEffect(consumeD,shuffleDlength, - consumeR,shuffleRlength); } //}}} //{{{ compile() method @@ -124,7 +122,7 @@ public class FactorShuffleDefinition extends FactorWordDefinition * Compile the given word, returning a new word definition. */ FactorWordDefinition compile(FactorInterpreter interp, - Set recursiveCheck) throws Exception + RecursiveState recursiveCheck) throws Exception { return this; } //}}} @@ -133,10 +131,10 @@ public class FactorShuffleDefinition extends FactorWordDefinition /** * Compile a call to this word. Returns maximum JVM stack use. */ - public int compileCallTo(CodeVisitor mw, LocalAllocator allocator, - Set recursiveCheck) throws FactorStackException + public int compileCallTo(CodeVisitor mw, FactorCompiler compiler, + RecursiveState recursiveCheck) throws FactorStackException { - eval(allocator.datastack,allocator.callstack); + eval(compiler.datastack,compiler.callstack); return 0; } //}}} @@ -213,6 +211,13 @@ public class FactorShuffleDefinition extends FactorWordDefinition } } //}}} + //{{{ toList() method + public Cons toList() + { + return new Cons(word,new Cons( + new FactorWord(toString()),null)); + } //}}} + //{{{ toString() method public String toString() { diff --git a/factor/FactorWord.java b/factor/FactorWord.java index 26f2073c4a..72f611fa01 100644 --- a/factor/FactorWord.java +++ b/factor/FactorWord.java @@ -29,14 +29,18 @@ package factor; -import factor.compiler.FactorCompilerException; +import factor.compiler.*; import java.util.*; /** * An internalized symbol. */ -public class FactorWord implements FactorExternalizable +public class FactorWord implements FactorExternalizable, FactorObject { + private static int gensymCount = 0; + + private FactorNamespace namespace; + public final String name; /** @@ -45,14 +49,9 @@ public class FactorWord implements FactorExternalizable public FactorWordDefinition def; /** - * Definition before compiling. + * Contains a string if this is compiled. */ - public FactorWordDefinition uncompiled; - - /** - * "define" pushes previous definitions onto this list, like a stack. - */ - public Cons history; + public String asm; /** * Is this word referenced from a compiled word? @@ -71,60 +70,69 @@ public class FactorWord implements FactorExternalizable def = new FactorMissingDefinition(this); } //}}} + //{{{ getNamespace() method + public FactorNamespace getNamespace(FactorInterpreter interp) + throws Exception + { + if(namespace == null) + namespace = new FactorNamespace(interp.global,this); + + return namespace; + } //}}} + + //{{{ gensym() method + /** + * Returns an un-internalized word with a unique name. + */ + public static FactorWord gensym() + { + return new FactorWord("( GENSYM:" + (gensymCount++) + " )"); + } //}}} + //{{{ define() method public void define(FactorWordDefinition def) { + asm = null; + if(compileRef) { System.err.println("WARNING: " + this + " is used in one or more compiled words; old definition will remain until full recompile"); } else if(!(this.def instanceof FactorMissingDefinition)) - { System.err.println("WARNING: redefining " + this); - history = new Cons(this.def,history); - } - uncompiled = this.def = def; + this.def = def; } //}}} //{{{ compile() method public void compile(FactorInterpreter interp) { - compile(interp,new HashSet()); + RecursiveState recursiveCheck = new RecursiveState(); + recursiveCheck.add(this,null); + compile(interp,recursiveCheck); + recursiveCheck.remove(this); } //}}} //{{{ compile() method - public void compile(FactorInterpreter interp, Set recursiveCheck) + public void compile(FactorInterpreter interp, RecursiveState recursiveCheck) { - if(def.compileFailed) - return; + //if(def.compileFailed) + // return; - System.err.println("Compiling " + this); - if(recursiveCheck.contains(this)) - System.err.println("WARNING: cannot compile recursive calls: " + this); + //System.err.println("Compiling " + this); try { - recursiveCheck.add(this); - def = def.compile(interp,recursiveCheck); } - catch(FactorCompilerException e) - { - def.compileFailed = true; - System.err.println("WARNING: cannot compile " + this); - System.err.println(e.getMessage()); - } catch(Throwable t) { def.compileFailed = true; - System.err.println("WARNING: cannot compile " + this); - t.printStackTrace(); - } - finally - { - recursiveCheck.remove(this); + /*System.err.println("WARNING: cannot compile " + this + + ": " + t.getMessage()); + if(!(t instanceof FactorException)) + t.printStackTrace();*/ } } //}}} diff --git a/factor/FactorWordDefinition.java b/factor/FactorWordDefinition.java index 1196ed4247..1683fcedd8 100644 --- a/factor/FactorWordDefinition.java +++ b/factor/FactorWordDefinition.java @@ -30,16 +30,14 @@ package factor; import factor.compiler.*; -import java.util.HashSet; -import java.util.Set; +import java.util.*; import org.objectweb.asm.*; /** * A word definition. */ -public abstract class FactorWordDefinition implements FactorObject, Constants +public abstract class FactorWordDefinition implements Constants { - private FactorNamespace namespace; protected FactorWord word; public boolean compileFailed; @@ -52,31 +50,39 @@ public abstract class FactorWordDefinition implements FactorObject, Constants public abstract void eval(FactorInterpreter interp) throws Exception; - //{{{ getNamespace() method - public FactorNamespace getNamespace(FactorInterpreter interp) throws Exception + //{{{ toList() method + public Cons toList() { - if(namespace == null) - namespace = new FactorNamespace(interp.global,this); - - return namespace; + return new Cons(new FactorWord(getClass().getName()),null); } //}}} //{{{ getStackEffect() method public final StackEffect getStackEffect() throws Exception { - return getStackEffect(new HashSet(),new LocalAllocator()); + return getStackEffect(new RecursiveState()); } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public final StackEffect getStackEffect(RecursiveState recursiveCheck) + throws Exception { - return null; + FactorCompiler compiler = new FactorCompiler(); + recursiveCheck.add(word,new StackEffect()); + getStackEffect(recursiveCheck,compiler); + recursiveCheck.remove(word); + return compiler.getStackEffect(); + } //}}} + + //{{{ getStackEffect() method + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler compiler) throws Exception + { + throw new FactorCompilerException("Cannot deduce stack effect of " + word); } //}}} //{{{ compile() method FactorWordDefinition compile(FactorInterpreter interp, - Set recursiveCheck) throws Exception + RecursiveState recursiveCheck) throws Exception { return this; } //}}} @@ -85,44 +91,99 @@ public abstract class FactorWordDefinition implements FactorObject, Constants /** * Compile a call to this word. Returns maximum JVM stack use. */ - public int compileCallTo(CodeVisitor mw, LocalAllocator allocator, - Set recursiveCheck) throws Exception + public int compileCallTo(CodeVisitor mw, FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - StackEffect effect = getStackEffect(); - if(effect == null) + // normal word + mw.visitVarInsn(ALOAD,0); + + String defclass; + StackEffect effect; + + RecursiveForm rec = recursiveCheck.get(word); + if(rec != null && rec.active && compiler.word == word) { - // combinator; inline - return compileImmediate(mw,allocator,recursiveCheck); + // recursive call! + defclass = compiler.className; + effect = compiler.word.def.getStackEffect(); + } + else if(this instanceof FactorCompoundDefinition) + { + throw new FactorCompilerException("You are an idiot!"); } else { - // normal word - mw.visitVarInsn(ALOAD,0); - - allocator.generateArgs(mw,effect.inD,null); - - String defclass = getClass().getName().replace('.','/'); - - String signature = effect.getCorePrototype(); - - mw.visitMethodInsn(INVOKESTATIC,defclass,"core",signature); - - if(effect.outD > 1) - throw new FactorCompilerException("Cannot compile word with non-0/1-out factors"); - if(effect.outD == 1) - allocator.push(mw); - - return effect.inD + 1; + defclass = getClass().getName() + .replace('.','/'); + effect = getStackEffect(); } + + compiler.generateArgs(mw,effect.inD,null); + + String signature = effect.getCorePrototype(); + + mw.visitMethodInsn(INVOKESTATIC,defclass,"core",signature); + + if(effect.outD == 0) + { + // do nothing + } + else if(effect.outD == 1) + { + compiler.push(mw); + } + else + { + // transfer from data stack to JVM locals + FactorDataStack datastack = compiler.datastack; + + // allocate the appropriate number of locals + compiler.produce(compiler.datastack,effect.outD); + + // store the datastack instance somewhere + mw.visitVarInsn(ALOAD,0); + mw.visitFieldInsn(GETFIELD, + "factor/FactorInterpreter", + "datastack", + "Lfactor/FactorDataStack;"); + int datastackLocal = compiler.allocate(); + mw.visitVarInsn(ASTORE,datastackLocal); + + // put all elements from the real datastack + // into locals + for(int i = 0; i < effect.outD; i++) + { + mw.visitVarInsn(ALOAD,datastackLocal); + mw.visitMethodInsn(INVOKEVIRTUAL, + "factor/FactorDataStack", + "pop", + "()Ljava/lang/Object;"); + + Result destination = (Result) + datastack.stack[ + datastack.top - i - 1]; + + mw.visitVarInsn(ASTORE,destination.getLocal()); + } + + } + + return effect.inD + 1; } //}}} //{{{ compileImmediate() method /** * Compile a call to this word. Returns maximum JVM stack use. */ - public int compileImmediate(CodeVisitor mw, LocalAllocator allocator, - Set recursiveCheck) throws Exception + public int compileImmediate(CodeVisitor mw, FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { throw new FactorCompilerException("Cannot compile " + word + " in immediate mode"); } //}}} + + //{{{ toString() method + public String toString() + { + return getClass().getName() + ": " + word; + } //}}} } diff --git a/factor/boot.factor b/factor/boot.factor index ba4aa28c84..21682847d6 100644 --- a/factor/boot.factor +++ b/factor/boot.factor @@ -2,7 +2,7 @@ ! $Id$ ! -! Copyright (C) 2003 Slava Pestov. +! Copyright (C) 2003, 2004 Slava Pestov. ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: @@ -53,11 +53,12 @@ ~<< tuck A B -- B A B >>~ ~<< 2tuck A B C D -- C D A B C D >>~ -~<< rdrop r:A -- >>~ -~<< >r A -- r:A >>~ -~<< 2>r A B -- r:A r:B >>~ -~<< r> r:A -- A >>~ -~<< 2r> r:A r:B -- A B >>~ +~<< 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 >>~ !!! Minimum amount of I/O words needed to be able to read other resources. !!! Remaining I/O operations are defined in io.factor and parser.factor. @@ -73,8 +74,8 @@ ; : parse* (filename reader -- list) - $dict - [ |java.lang.String |java.io.Reader |factor.FactorDictionary ] + $interpreter + [ |java.lang.String |java.io.Reader |factor.FactorInterpreter ] |factor.FactorParser jnew [ ] |factor.FactorParser |parse jinvoke ; @@ -87,8 +88,11 @@ "/factor/combinators.factor" runResource "/factor/continuations.factor" runResource +"/factor/debugger.factor" runResource "/factor/dictionary.factor" runResource "/factor/examples.factor" runResource +"/factor/httpd.factor" runResource +"/factor/inspector.factor" runResource "/factor/interpreter.factor" runResource "/factor/lists.factor" runResource "/factor/math.factor" runResource @@ -96,9 +100,13 @@ "/factor/namespaces.factor" runResource "/factor/network.factor" runResource "/factor/parser.factor" runResource -"/factor/random.factor" runResource "/factor/stream.factor" runResource +"/factor/prettyprint.factor" runResource +"/factor/random.factor" runResource "/factor/strings.factor" runResource +"/factor/test/test.factor" runResource + +t @user-init : cli-param ( param -- ) dup "no-" str-head? dup [ @@ -113,7 +121,19 @@ $args [ cli-arg ] each ! Compile all words now -$compile [ compileAll ] when +$compile [ + compile-all +] when + +$~ $/ ".factor-rc" cat3 @init-path + +$user-init [ + $init-path dup exists? [ run-file ] [ drop ] ifte +] when ! If we're run stand-alone, start the interpreter in the current tty. -$interactive [ initialInterpreterLoop ] when +$interactive [ + [ @top-level-continuation ] callcc0 + + initial-interpreter-loop +] when diff --git a/factor/combinators.factor b/factor/combinators.factor index 4d3e7bbc6b..46fde32177 100644 --- a/factor/combinators.factor +++ b/factor/combinators.factor @@ -25,7 +25,7 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -: apply2 (x y [ code ] --) +: 2apply (x y [ code ] --) ! First applies the code to x, then to y. 2dup 2>r nip call @@ -46,12 +46,12 @@ ! callstack. r:P r:T r:R1 r:R2 -- R1 r:P r:T r:R1 r:R2 >>~ -~<< binrecLeft +~<< binrec-left ! Left recursion setup; put second value on callstack, put P, T, R1, R2 ! on data stack (and leave them on the callstack too). Value2 r:P r:T r:R1 r:R2 -- P T R1 R2 r:Value2 r:P r:T r:R1 r:R2 >>~ -~<< binrecRight +~<< binrec-right ! Right recursion setup; put second value back on datastack, put ! P, T, R1, R2 on data stack. All quotations except for R2 are ! discarded from the callstack, since they're not needed anymore. @@ -67,8 +67,8 @@ binrecR1 call ! R1 has now produced two values on top of the data stack. ! Recurse twice. - binrecLeft binrec - binrecRight binrec + binrec-left binrec + binrec-right binrec ! Now call R2. r> call ] ifte ; @@ -85,7 +85,7 @@ r> call ; -: cond (list --) +: cond ( x list -- ) ! The list is of this form: ! [ [ condition 1 ] [ code 1 ] ! [ condition 2 ] [ code 2 ] @@ -121,7 +121,7 @@ call 2r> ; -: each ([ list ] [ code ] --) +: each ( [ list ] [ code ] -- ) ! Applies the code to each element of the list. over [ [ uncons ] dip tuck [ call ] 2dip each @@ -129,6 +129,21 @@ 2drop ] ifte ; +~<< 2each{ + A1 D1 A2 D2 C -- A1 A2 C r:D1 r:D2 r:C >>~ + +~<< }2each + r:D1 r:D2 r:C -- D1 D2 C >>~ + +: 2each ( [ list ] [ list ] [ code ] -- ) + ! Push each pair of elements from the 2 lists in turn, then + ! execute the code. + over [ + [ [ uncons ] 2apply ] dip 2each{ call }2each 2each + ] [ + drop drop drop + ] ifte ; + : expand (list -- list) ! Evaluates the list on a new stack, and pushes the reversed stack onto the ! original stack. For example, "[ 0 1 2 dup * + ] expand" will evaluate to @@ -138,6 +153,11 @@ call unstack ; +: forever ( code -- ) + ! The code is evaluated forever. Typically, a continuation + ! is used to escape the infinite loop. + dup dip forever ; + : ifte (cond [if true] [if false] --) ? call ; @@ -155,31 +175,44 @@ ! and evaluate R2. This combinator is similar to the linrec combinator in ! Joy, except in Joy, P does not affect the stack. >r >r >r dup >r call [ - r> drop r> call - r> drop r> drop + 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 ] ) +: map ( [ items ] [ code ] -- [ mapping ]) ! Applies the code to each item, returns a list that ! contains the result of each application. 2list restack each unstack ; -: push ([ a b c ... ] -- a b c ...) - ! Pushes values onto the stack literally (even if they are words). - [ uncons push ] when* ; +: 2map ( [ list ] [ list ] [ code ] -- [ mapping ] ) + ! Applies the code to each pair of items, returns a list + ! that contains the result of each application. + 3list restack 2each unstack ; -: subset (list code -- list) - ! Applies code to each element of the given list, creating a new list - ! containing the elements where the code returned a non-null value. +: subset ( list code -- list ) [ dupd call [ drop ] unless ] cons 2list restack each unstack ; +: treerec ( list quot -- ) + ! Apply quot to each element of the list; if an element is a + ! list, first quot is called with the list itself, then a + ! recursive call to listrec is made. + over [ + [ uncons ] dip tuck [ + over list? [ + 2dup [ treerec ] 2dip + ] when call + ] 2dip treerec + ] [ + 2drop + ] ifte ; + : times (n [ code ] --) ! Evaluates code n times. [ @@ -202,6 +235,11 @@ : unless (cond [if false] --) f swap ? call ; +: unless* ( cond false -- ) + ! If cond is f, pop it off the stack and evaluate false. + ! Otherwise, leave it on the stack. + over [ drop ] [ nip call ] ifte ; + : when (cond [if true] --) f ? call ; @@ -213,8 +251,7 @@ : while ( [ P ] [ R ] -- ... ) ! Evaluates P. If it leaves t on the stack, evaluate R, and recurse. >r dup >r call [ - r> r> dup >r swap >r call - r> r> while + rover r> call r> r> while ] [ - r> drop r> drop + rdrop rdrop ] ifte ; diff --git a/factor/compiler/CompiledChoice.java b/factor/compiler/CompiledChoice.java new file mode 100644 index 0000000000..260b9d096a --- /dev/null +++ b/factor/compiler/CompiledChoice.java @@ -0,0 +1,316 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public class CompiledChoice extends FlowObject implements Constants +{ + FlowObject cond, t, f; + + //{{{ CompiledChoice constructor + CompiledChoice(FlowObject cond, FlowObject t, FlowObject f, + FactorCompiler compiler, RecursiveState recursiveCheck) + { + super(compiler,recursiveCheck); + this.cond = cond; + this.t = t; + this.f = f; + } //}}} + + //{{{ generate() method + public void generate(CodeVisitor mw) + { + // if null jump to F + // T + // jump END + // F: F + // END: ... + Label fl = new Label(); + Label endl = new Label(); + + cond.generate(mw); + mw.visitJumpInsn(IFNULL,fl); + + t.generate(mw); + + mw.visitJumpInsn(GOTO,endl); + mw.visitLabel(fl); + f.generate(mw); + mw.visitLabel(endl); + } //}}} + + //{{{ usingLocal() method + boolean usingLocal(int local) + { + return cond.usingLocal(local) + || t.usingLocal(local) + || f.usingLocal(local); + } //}}} + + //{{{ getStackEffect() method + /** + * Stack effect of executing this -- only used for lists + * and conditionals! + */ + public void getStackEffect(RecursiveState recursiveCheck) + throws Exception + { + StackEffect onEntry = recursiveCheck.last().effect; + + FactorDataStack datastackCopy = (FactorDataStack) + compiler.datastack.clone(); + FactorCallStack callstackCopy = (FactorCallStack) + compiler.callstack.clone(); + StackEffect effectCopy = (StackEffect) + compiler.getStackEffect(); + + StackEffect te = compiler.getStackEffectOrNull( + t,recursiveCheck,false); + //System.err.println("te=" + te); + + /** Other branch. */ + FactorDataStack obDatastack = compiler.datastack; + FactorCallStack obCallstack = compiler.callstack; + StackEffect obEffect = compiler.getStackEffect(); + + compiler.datastack = (FactorDataStack) + datastackCopy.clone(); + compiler.callstack = (FactorCallStack) + callstackCopy.clone(); + compiler.effect = (StackEffect)effectCopy.clone(); + + StackEffect fe = compiler.getStackEffectOrNull( + f,recursiveCheck,false); + //System.err.println("fe=" + fe); + + //System.err.println("rec=" + rec); + if(fe != null && te == null) + { + RecursiveForm rec = t.getWord(); + if(rec == null) + throw new FactorCompilerException("Unscoped quotation: " + t); + rec.baseCase = fe; + //System.err.println("base=" + fe); + compiler.datastack = (FactorDataStack) + datastackCopy.clone(); + compiler.callstack = (FactorCallStack) + callstackCopy.clone(); + compiler.effect = (StackEffect) + effectCopy.clone(); + t.getStackEffect(recursiveCheck); + te = compiler.getStackEffect(); + //te = StackEffect.decompose(onEntry,te); + //System.err.println("te=" + te); + } + else if(fe == null && te != null) + { + RecursiveForm rec = f.getWord(); + if(rec == null) + throw new FactorCompilerException("Unscoped quotation: " + t); + //System.err.println("base=" + te); + rec.baseCase = te; + compiler.datastack = (FactorDataStack) + datastackCopy.clone(); + compiler.callstack = (FactorCallStack) + callstackCopy.clone(); + compiler.effect = (StackEffect) + effectCopy.clone(); + f.getStackEffect(recursiveCheck); + fe = compiler.getStackEffect(); + //fe = StackEffect.decompose(onEntry,te); + //System.err.println("fe=" + fe); + } + + if(te == null || fe == null) + throw new FactorCompilerException("Indeterminate recursive choice"); + + // we can only balance out a conditional if + // both sides leave the same amount of elements + // on the stack. + // eg, 1/1 -vs- 2/2 is ok, 3/1 -vs- 4/2 is ok, + // but 1/2 -vs- 2/1 is not. + int balanceTD = te.outD - te.inD; + int balanceTR = te.outR - te.inR; + int balanceFD = fe.outD - fe.inD; + int balanceFR = fe.outR - fe.inR; + if(balanceTD != balanceFD || balanceTR != balanceFR) + { + throw new FactorCompilerException("Stack effect of " + t + " " + te + " is inconsistent with " + f + " " + fe + ", head is " + effectCopy); + } + + // find how many elements of the t branch match with the f + // branch and don't discard those. + int highestEqual = 0; + + for(highestEqual = 0; highestEqual < fe.outD; highestEqual++) + { + Object o1 = obDatastack.stack[ + obDatastack.top - highestEqual - 1]; + Object o2 = compiler.datastack.stack[ + obDatastack.top - highestEqual - 1]; + if(!o1.equals(o2)) + break; + } + + // replace results from the f branch with + // dummy values so that subsequent code + // doesn't assume these values always + // result from this + compiler.datastack.top -= fe.outD; + compiler.produce(compiler.datastack,fe.outD - highestEqual); + compiler.datastack.top += highestEqual; + compiler.callstack.top -= fe.outR; + compiler.produce(compiler.callstack,fe.outR); + + compiler.effect = new StackEffect( + Math.max(te.inD,fe.inD), + Math.max(te.outD,fe.outD), + Math.max(te.inR,fe.inR), + Math.max(te.outR,fe.outR) + ); + } //}}} + + //{{{ compileCallTo() method + /** + * Write code for evaluating this. Returns maximum JVM stack + * usage. + */ + public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck) + throws Exception + { + // if null jump to F + // T + // jump END + // F: F + // END: ... + Label fl = new Label(); + Label endl = new Label(); + + cond.generate(mw); + + int maxJVMStack = 1; + + /* if(t instanceof Null && f instanceof Null) + { + // nothing to do! + mw.visitInsn(POP); + } + else if(t instanceof Null) + { + mw.visitJumpInsn(IFNONNULL,endl); + maxJVMStack = Math.max(maxJVMStack, + f.compileCallTo(mw,recursiveCheck)); + mw.visitLabel(endl); + } + else if(f instanceof Null) + { + mw.visitJumpInsn(IFNULL,endl); + maxJVMStack = Math.max(maxJVMStack, + t.compileCallTo(mw,recursiveCheck)); + mw.visitLabel(endl); + } + else */ + { + mw.visitJumpInsn(IFNULL,fl); + + FactorDataStack datastackCopy + = (FactorDataStack) + compiler.datastack.clone(); + FactorCallStack callstackCopy + = (FactorCallStack) + compiler.callstack.clone(); + + maxJVMStack = Math.max(maxJVMStack, + t.compileCallTo(mw,recursiveCheck)); + + maxJVMStack = Math.max(maxJVMStack, + normalizeStacks(mw)); + + compiler.datastack = datastackCopy; + compiler.callstack = callstackCopy; + + mw.visitJumpInsn(GOTO,endl); + mw.visitLabel(fl); + maxJVMStack = Math.max(maxJVMStack, + f.compileCallTo(mw,recursiveCheck)); + + maxJVMStack = Math.max(maxJVMStack, + normalizeStacks(mw)); + + mw.visitLabel(endl); + } + + return maxJVMStack; + } //}}} + + //{{{ normalizeStacks() method + private int normalizeStacks(CodeVisitor mw) + { + int datastackTop = compiler.datastack.top; + compiler.datastack.top = 0; + int callstackTop = compiler.callstack.top; + compiler.callstack.top = 0; + + normalizeStack(compiler.datastack,datastackTop,mw); + normalizeStack(compiler.callstack,callstackTop,mw); + return Math.max(datastackTop,callstackTop); + } //}}} + + //{{{ normalizeStack() method + private void normalizeStack(FactorArrayStack stack, int top, + CodeVisitor mw) + { + for(int i = top - 1; i >= 0; i--) + { + FlowObject obj = (FlowObject)stack.stack[i]; + obj.generate(mw); + } + + for(int i = 0; i < top; i++) + { + int local = compiler.allocate(); + stack.push(new Result(local,compiler,null)); + mw.visitVarInsn(ASTORE,local); + } + } //}}} + + //{{{ toString() method + public String toString() + { + return FactorParser.unparse(f) + + " " + + FactorParser.unparse(t) + + " ? call"; + } //}}} +} diff --git a/factor/compiler/CompiledDefinition.java b/factor/compiler/CompiledDefinition.java index 00f27a9598..ecd7a8c798 100644 --- a/factor/compiler/CompiledDefinition.java +++ b/factor/compiler/CompiledDefinition.java @@ -31,28 +31,39 @@ package factor.compiler; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; /** - * : name ... ; + * Compiled colon definition. */ public abstract class CompiledDefinition extends FactorWordDefinition { private StackEffect effect; + private Cons definition; //{{{ CompiledDefinition constructor - public CompiledDefinition(FactorWord word, StackEffect effect) + public CompiledDefinition(FactorWord word, StackEffect effect, + Cons definition) { super(word); this.effect = effect; + this.definition = definition; } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler compiler) { - return effect; + compiler.apply(effect); + } //}}} + + //{{{ toList() method + public Cons toList() + { + return new Cons(word,new Cons(effect, + new Cons(new FactorWord("\n"), + definition))); } //}}} } diff --git a/factor/compiler/CompiledList.java b/factor/compiler/CompiledList.java new file mode 100644 index 0000000000..7ea6cc03da --- /dev/null +++ b/factor/compiler/CompiledList.java @@ -0,0 +1,99 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public class CompiledList extends FlowObject implements Constants +{ + private Cons quotation; + private RecursiveState recursiveCheck; + + CompiledList(Cons quotation, FactorCompiler compiler, + RecursiveState recursiveCheck) + { + super(compiler,recursiveCheck); + this.quotation = quotation; + // clone it + this.recursiveCheck = new RecursiveState( + recursiveCheck); + } + + public void generate(CodeVisitor mw) + { + mw.visitFieldInsn(GETSTATIC,compiler.className, + compiler.literal(quotation), + "Ljava/lang/Object;"); + } + + Object getLiteral() + { + return quotation; + } + + /** + * Stack effect of executing this -- only used for lists + * and conditionals! + */ + public void getStackEffect(RecursiveState recursiveCheck) + throws Exception + { + // important: this.recursiveCheck due to + // lexically-scoped recursion issues + compiler.getStackEffect(quotation,this.recursiveCheck); + } + + /** + * Write code for evaluating this. Returns maximum JVM stack + * usage. + */ + public int compileCallTo(CodeVisitor mw, + RecursiveState recursiveCheck) + throws Exception + { + // important: this.recursiveCheck due to + // lexically-scoped recursion issues + return compiler.compile(quotation,mw,this.recursiveCheck); + } + + public boolean equals(Object o) + { + if(o instanceof CompiledList) + { + CompiledList c = (CompiledList)o; + return FactorLib.objectsEqual(c.quotation,quotation); + } + else + return false; + } +} diff --git a/factor/compiler/ConstantPoolString.java b/factor/compiler/ConstantPoolString.java new file mode 100644 index 0000000000..91bc03defe --- /dev/null +++ b/factor/compiler/ConstantPoolString.java @@ -0,0 +1,57 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public class ConstantPoolString extends FlowObject +{ + private String str; + + ConstantPoolString(String str, FactorCompiler compiler, + RecursiveState recursiveCheck) + { + super(compiler,recursiveCheck); + this.str = str; + } + + public void generate(CodeVisitor mw) + { + mw.visitLdcInsn(str); + } + + Object getLiteral() + { + return str; + } +} diff --git a/factor/compiler/FactorCompiler.java b/factor/compiler/FactorCompiler.java new file mode 100644 index 0000000000..7eee12459f --- /dev/null +++ b/factor/compiler/FactorCompiler.java @@ -0,0 +1,571 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; +import org.objectweb.asm.util.*; + +public class FactorCompiler implements Constants +{ + private FactorInterpreter interp; + + public final FactorWord word; + public final String className; + + private int base; + private int max; + + public FactorDataStack datastack; + public FactorCallStack callstack; + + private int literalCount; + + private Map literals = new HashMap(); + + public StackEffect effect = new StackEffect(); + + //{{{ FactorCompiler constructor + /** + * For balancing. + */ + public FactorCompiler() + { + this(null,null,null,0,0); + } //}}} + + //{{{ FactorCompiler constructor + /** + * For compiling. + */ + public FactorCompiler(FactorInterpreter interp, + FactorWord word, String className, + int base, int allot) + { + this.interp = interp; + + this.word = word; + this.className = className; + + this.base = base; + datastack = new FactorDataStack(); + callstack = new FactorCallStack(); + + for(int i = 0; i < allot; i++) + { + datastack.push(new Result(base + i,this,null)); + } + + max = base + allot; + } //}}} + + //{{{ ensure() method + /** + * Ensure stack has at least 'count' elements. + * Eg, if count is 4 and stack is A B, + * stack will become RESULT RESULT A B. + * Used when deducing stack effects. + */ + public void ensure(FactorArrayStack stack, int count) + { + int top = stack.top; + if(top < count) + { + if(stack == datastack) + effect.inD += (count - top); + else if(stack == callstack) + effect.inR += (count - top); + + stack.ensurePush(count - top); + System.arraycopy(stack.stack,0,stack.stack, + count - top,top); + for(int i = 0; i < count - top; i++) + { + stack.stack[i] = new Result( + allocate(),this,null); + } + stack.top = count; + } + } //}}} + + //{{{ consume() method + public void consume(FactorArrayStack stack, int count) + { + ensure(stack,count); + stack.top -= count; + } //}}} + + //{{{ produce() method + public void produce(FactorArrayStack stack, int count) + { + for(int i = 0; i < count; i++) + stack.push(new Result(allocate(),this,null)); + } //}}} + + //{{{ apply() method + public void apply(StackEffect se) + { + consume(datastack,se.inD); + produce(datastack,se.outD); + consume(callstack,se.inR); + produce(callstack,se.outR); + } //}}} + + //{{{ getStackEffect() method + public StackEffect getStackEffect() + { + effect.outD = datastack.top; + effect.outR = callstack.top; + return (StackEffect)effect.clone(); + } //}}} + + //{{{ getStackEffect() method + public void getStackEffect(Cons definition, + RecursiveState recursiveCheck) + throws Exception + { + while(definition != null) + { + Object obj = definition.car; + if(obj instanceof FactorWord) + { + FactorWord word = (FactorWord)obj; + RecursiveForm rec = recursiveCheck.get(word); + if(rec == null) + recursiveCheck.add(word,getStackEffect()); + else + rec.active = true; + + word.def.getStackEffect(recursiveCheck,this); + + if(rec == null) + recursiveCheck.remove(word); + else + rec.active = false; + } + else + pushLiteral(obj,recursiveCheck); + + definition = definition.next(); + } + } //}}} + + //{{{ getDisassembly() method + protected String getDisassembly(TraceCodeVisitor mw) + { + // Save the disassembly of the eval() method + StringBuffer buf = new StringBuffer(); + Iterator bytecodes = mw.getText().iterator(); + while(bytecodes.hasNext()) + { + buf.append(bytecodes.next()); + } + return buf.toString(); + } //}}} + + //{{{ compile() method + /** + * Compiles a method and returns the disassembly. + */ + public String compile(Cons definition, ClassWriter cw, String className, + String methodName, StackEffect effect, + RecursiveState recursiveCheck) + throws Exception + { + String signature = effect.getCorePrototype(); + + CodeVisitor _mw = cw.visitMethod(ACC_PUBLIC | ACC_STATIC, + methodName,signature,null,null); + + TraceCodeVisitor mw = new TraceCodeVisitor(_mw); + + int maxJVMStack = compile(definition,mw, + recursiveCheck); + + // special case where return value is passed on + // JVM operand stack + if(effect.outD == 0) + { + mw.visitInsn(RETURN); + } + else if(effect.outD == 1) + { + pop(mw); + mw.visitInsn(ARETURN); + maxJVMStack = Math.max(maxJVMStack,1); + } + else + { + // store datastack in a local + mw.visitVarInsn(ALOAD,0); + mw.visitFieldInsn(GETFIELD, + "factor/FactorInterpreter", + "datastack", + "Lfactor/FactorDataStack;"); + int datastackLocal = allocate(); + mw.visitVarInsn(ASTORE,datastackLocal); + + for(int i = 0; i < datastack.top; i++) + { + mw.visitVarInsn(ALOAD,datastackLocal); + ((FlowObject)datastack.stack[i]) + .generate(mw); + mw.visitMethodInsn(INVOKEVIRTUAL, + "factor/FactorDataStack", + "push", + "(Ljava/lang/Object;)V"); + } + + datastack.top = 0; + + mw.visitInsn(RETURN); + + maxJVMStack = Math.max(2,maxJVMStack); + } + + mw.visitMaxs(maxJVMStack,max); + + return getDisassembly(mw); + } //}}} + + //{{{ compile() method + /** + * Compiles a quotation and returns the maximum JVM stack depth. + */ + public int compile(Cons definition, CodeVisitor mw, + RecursiveState recursiveCheck) throws Exception + { + int maxJVMStack = 0; + + while(definition != null) + { + Object obj = definition.car; + if(obj instanceof FactorWord) + { + maxJVMStack = Math.max(maxJVMStack, + compileWord((FactorWord)obj,mw, + recursiveCheck)); + } + else + pushLiteral(obj,recursiveCheck); + + definition = definition.next(); + } + + return maxJVMStack; + } //}}} + + //{{{ compileWord() method + private int compileWord(FactorWord w, CodeVisitor mw, + RecursiveState recursiveCheck) throws Exception + { + RecursiveForm rec = recursiveCheck.get(w); + + try + { + boolean recursiveCall; + if(rec == null) + { + recursiveCall = false; + recursiveCheck.add(w,null); + } + else + { + recursiveCall = true; + rec.active = true; + } + + FactorWordDefinition d = w.def; + + if(!recursiveCall) + { + StackEffect effect = getStackEffectOrNull(d); + if(effect == null) + { + return d.compileImmediate(mw,this, + recursiveCheck); + } + else if(d instanceof FactorCompoundDefinition) + { + w.compile(interp,recursiveCheck); + if(d == w.def) + { + throw new FactorCompilerException(word + " depends on " + w + " which cannot be compiled"); + } + d = w.def; + } + } + + w.compileRef = true; + return d.compileCallTo(mw,this,recursiveCheck); + } + finally + { + if(rec == null) + recursiveCheck.remove(w); + else + rec.active = false; + } + } //}}} + + //{{{ push() method + /** + * Generates code for pushing the top of the JVM stack onto the + * data stack. + */ + public void push(CodeVisitor mw) + { + int local = allocate(); + datastack.push(new Result(local,this,null)); + if(mw != null) + mw.visitVarInsn(ASTORE,local); + } //}}} + + //{{{ pushR() method + /** + * Generates code for pushing the top of the JVM stack onto the + * call stack. + */ + public void pushR(CodeVisitor mw) + { + int local = allocate(); + callstack.push(new Result(local,this,null)); + if(mw != null) + mw.visitVarInsn(ASTORE,local); + } //}}} + + //{{{ pushLiteral() method + public void pushLiteral(Object literal, RecursiveState recursiveCheck) + { + if(literal == null) + datastack.push(new Null(this,recursiveCheck)); + else if(literal instanceof Cons) + { + datastack.push(new CompiledList((Cons)literal,this, + recursiveCheck)); + } + else if(literal instanceof String) + { + datastack.push(new ConstantPoolString((String)literal, + this,recursiveCheck)); + } + else + { + datastack.push(new Literal(literal,this, + recursiveCheck)); + } + } //}}} + + //{{{ pushChoice() method + public void pushChoice(RecursiveState recursiveCheck) + throws FactorStackException + { + FlowObject f = (FlowObject)datastack.pop(); + FlowObject t = (FlowObject)datastack.pop(); + FlowObject cond = (FlowObject)datastack.pop(); + datastack.push(new CompiledChoice( + cond,t,f,this,recursiveCheck)); + } //}}} + + //{{{ pop() method + /** + * Generates code for popping the top of the data stack onto + * the JVM stack. + */ + public void pop(CodeVisitor mw) throws FactorStackException + { + FlowObject obj = (FlowObject)datastack.pop(); + if(mw != null) + obj.generate(mw); + } //}}} + + //{{{ popR() method + /** + * Generates code for popping the top of the call stack onto + * the JVM stack. + */ + public void popR(CodeVisitor mw) throws FactorStackException + { + FlowObject obj = (FlowObject)callstack.pop(); + if(mw != null) + obj.generate(mw); + } //}}} + + //{{{ popLiteral() method + /** + * Pops a literal off the datastack or throws an exception. + */ + public Object popLiteral() throws FactorException + { + FlowObject obj = (FlowObject)datastack.pop(); + return obj.getLiteral(); + } //}}} + + //{{{ allocate() method + /** + * Allocate a local variable. + */ + public int allocate() + { + // inefficient! + int i = base; + for(;;) + { + if(allocate(i,datastack) && allocate(i,callstack)) + { + max = Math.max(max,i + 1); + return i; + } + else + i++; + } + } //}}} + + //{{{ allocate() method + /** + * Return true if not in use, false if in use. + */ + private boolean allocate(int local, FactorArrayStack stack) + { + for(int i = 0; i < stack.top; i++) + { + FlowObject obj = (FlowObject)stack.stack[i]; + if(obj.usingLocal(local)) + return false; + } + return true; + } //}}} + + //{{{ literal() method + public String literal(Object obj) + { + Integer i = (Integer)literals.get(obj); + int literal; + if(i == null) + { + literal = literalCount++; + literals.put(obj,new Integer(literal)); + } + else + literal = i.intValue(); + + return "literal_" + literal; + } //}}} + + //{{{ generateArgs() method + /** + * Generate instructions for copying arguments from the allocated + * local variables to the JVM stack, doing type conversion in the + * process. + */ + public void generateArgs(CodeVisitor mw, int num, Class[] args) + throws Exception + { + for(int i = 0; i < num; i++) + { + FlowObject obj = (FlowObject)datastack.stack[ + datastack.top - num + i]; + obj.generate(mw); + if(args != null) + FactorJava.generateFromConversion(mw,args[i]); + } + + datastack.top -= num; + } //}}} + + //{{{ generateFields() method + public void generateFields(ClassWriter cw) + throws Exception + { + for(int i = 0; i < literalCount; i++) + { + cw.visitField(ACC_PUBLIC | ACC_STATIC,"literal_" + i, + "Ljava/lang/Object;",null,null); + } + } //}}} + + //{{{ setFields() method + public void setFields(Class def) + throws Exception + { + Iterator entries = literals.entrySet().iterator(); + while(entries.hasNext()) + { + Map.Entry entry = (Map.Entry)entries.next(); + Object literal = entry.getKey(); + int index = ((Integer)entry.getValue()).intValue(); + + Field f = def.getField("literal_" + index); + f.set(null,literal); + } + } //}}} + + //{{{ getStackEffectOrNull() method + static StackEffect getStackEffectOrNull(FactorWordDefinition def) + { + try + { + return def.getStackEffect(); + } + catch(Exception e) + { + //System.err.println("WARNING: " + e); + //System.err.println(def); + return null; + } + } //}}} + + //{{{ getStackEffectOrNull() method + StackEffect getStackEffectOrNull(FlowObject obj, + RecursiveState recursiveCheck, + boolean decompose) + { + try + { + obj.getStackEffect(recursiveCheck); + StackEffect effect = getStackEffect(); + if(decompose) + { + effect = StackEffect.decompose( + recursiveCheck.last().effect, + effect); + } + return effect; + } + catch(Exception e) + { + //System.err.println("WARNING: " + e); + //System.err.println(obj); + return null; + } + } //}}} +} diff --git a/factor/compiler/FlowObject.java b/factor/compiler/FlowObject.java new file mode 100644 index 0000000000..90f3c8b111 --- /dev/null +++ b/factor/compiler/FlowObject.java @@ -0,0 +1,102 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public abstract class FlowObject +{ + protected FactorCompiler compiler; + protected RecursiveForm word; + + FlowObject(FactorCompiler compiler, + RecursiveState recursiveCheck) + { + this.compiler = compiler; + if(recursiveCheck != null) + word = recursiveCheck.last(); + } + + public abstract void generate(CodeVisitor mw); + + boolean usingLocal(int local) + { + return false; + } + + Object getLiteral() + throws FactorCompilerException + { + throw new FactorCompilerException("Cannot compile unless literal on stack: " + this); + } + + /** + * Stack effect of evaluating this -- only used for lists + * and conditionals! + */ + public void getStackEffect(RecursiveState recursiveCheck) + throws Exception + { + throw new FactorCompilerException("Not a quotation: " + this); + } + + /** + * Write code for evaluating this. Returns maximum JVM stack + * usage. + */ + public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck) + throws Exception + { + throw new FactorCompilerException("Cannot compile call to non-literal quotation"); + } + + /** + * Returns the word where this flow object originated from. + */ + public RecursiveForm getWord() + { + return word; + } + + public String toString() + { + try + { + return FactorParser.unparse(getLiteral()); + } + catch(Exception e) + { + throw new RuntimeException("Override toString() if your getLiteral() bombs!"); + } + } +} diff --git a/factor/compiler/Literal.java b/factor/compiler/Literal.java new file mode 100644 index 0000000000..833743ba66 --- /dev/null +++ b/factor/compiler/Literal.java @@ -0,0 +1,69 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public class Literal extends FlowObject implements Constants +{ + private Object literal; + + Literal(Object literal, FactorCompiler compiler, + RecursiveState recursiveCheck) + { + super(compiler,recursiveCheck); + this.literal = literal; + } + + public void generate(CodeVisitor mw) + { + mw.visitFieldInsn(GETSTATIC,compiler.className, + compiler.literal(literal), + "Ljava/lang/Object;"); + } + + Object getLiteral() + { + return literal; + } + + /** + * Write code for evaluating this. Returns maximum JVM stack + * usage. + */ + public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck) + throws Exception + { + throw new FactorCompilerException("Not a quotation: " + literal); + } +} diff --git a/factor/compiler/LocalAllocator.java b/factor/compiler/LocalAllocator.java deleted file mode 100644 index 5684afddfa..0000000000 --- a/factor/compiler/LocalAllocator.java +++ /dev/null @@ -1,677 +0,0 @@ -/* :folding=explicit:collapseFolds=1: */ - -/* - * $Id$ - * - * Copyright (C) 2004 Slava Pestov. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, - * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND - * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE - * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ - -package factor.compiler; - -import factor.*; -import java.lang.reflect.*; -import java.util.*; -import org.objectweb.asm.*; - -public class LocalAllocator implements Constants -{ - private FactorInterpreter interp; - - private String className; - private int base; - private int max; - - public FactorDataStack datastack; - public FactorCallStack callstack; - - private int literalCount; - private int wordCount; - - private Map literals = new HashMap(); - private Map words = new HashMap(); - - //{{{ LocalAllocator constructor - /** - * For balancing. - */ - public LocalAllocator() - { - this(null,null,0,0); - } //}}} - - //{{{ LocalAllocator constructor - /** - * For compiling. - */ - public LocalAllocator(FactorInterpreter interp, String className, - int base, int allot) - { - this.interp = interp; - this.className = className; - - this.base = base; - datastack = new FactorDataStack(); - callstack = new FactorCallStack(); - - for(int i = 0; i < allot; i++) - { - datastack.push(new Result(base + i)); - } - - max = base + allot; - - } //}}} - - //{{{ ensure() method - /** - * Ensure stack has at least 'count' elements. - * Eg, if count is 4 and stack is A B, - * stack will become RESULT RESULT A B. - * Used when deducing stack effects. - */ - public void ensure(FactorArrayStack stack, int count) - { - int top = stack.top; - if(top < count) - { - stack.ensurePush(count - top); - System.arraycopy(stack.stack,0,stack.stack, - count - top,top); - for(int i = 0; i < count - top; i++) - { - stack.stack[i] = new Result(allocate()); - } - stack.top = count; - } - } //}}} - - //{{{ compile() method - /** - * Compiles a quotation and returns the maximum JVM stack depth. - */ - public int compile(Cons definition, CodeVisitor mw, - Set recursiveCheck) throws Exception - { - int maxJVMStack = 0; - - while(definition != null) - { - Object obj = definition.car; - if(obj instanceof FactorWord) - { - FactorWord w = (FactorWord)obj; - - FactorWordDefinition d = w.def; - if(d instanceof FactorCompoundDefinition - && d.getStackEffect(recursiveCheck, - new LocalAllocator()) != null) - { - // compile first. - w.compile(interp,recursiveCheck); - if(w.def == d) - { - // didn't compile - throw new FactorCompilerException(w + " cannot be compiled"); - } - } - - maxJVMStack = Math.max(maxJVMStack, - w.def.compileCallTo(mw,this,recursiveCheck)); - } - else if(obj == null) - { - pushNull(); - } - else if(obj instanceof String) - { - pushString((String)obj); - } - else - { - pushLiteral(obj); - } - - definition = definition.next(); - } - - return maxJVMStack; - } //}}} - - //{{{ push() method - /** - * Generates code for pushing the top of the JVM stack onto the - * data stack. - */ - public void push(CodeVisitor mw) - { - int local = allocate(); - datastack.push(new Result(local)); - if(mw != null) - mw.visitVarInsn(ASTORE,local); - } //}}} - - //{{{ pushR() method - /** - * Generates code for pushing the top of the JVM stack onto the - * call stack. - */ - public void pushR(CodeVisitor mw) - { - int local = allocate(); - callstack.push(new Result(local)); - if(mw != null) - mw.visitVarInsn(ASTORE,local); - } //}}} - - //{{{ pushLiteral() method - public void pushLiteral(Object literal) - { - datastack.push(new Literal(literal)); - } //}}} - - //{{{ pushString() method - public void pushString(String literal) - { - datastack.push(new ConstantPoolString(literal)); - } //}}} - - //{{{ pushNull() method - public void pushNull() - { - datastack.push(new Null()); - } //}}} - - //{{{ pushChoice() method - public void pushChoice() throws FactorStackException - { - FlowObject f = (FlowObject)datastack.pop(); - FlowObject t = (FlowObject)datastack.pop(); - FlowObject cond = (FlowObject)datastack.pop(); - datastack.push(new Choice(cond,t,f)); - } //}}} - - //{{{ pop() method - /** - * Generates code for popping the top of the data stack onto - * the JVM stack. - */ - public void pop(CodeVisitor mw) throws FactorStackException - { - FlowObject obj = (FlowObject)datastack.pop(); - if(mw != null) - obj.generate(mw); - } //}}} - - //{{{ popR() method - /** - * Generates code for popping the top of the call stack onto - * the JVM stack. - */ - public void popR(CodeVisitor mw) throws FactorStackException - { - FlowObject obj = (FlowObject)callstack.pop(); - if(mw != null) - obj.generate(mw); - } //}}} - - //{{{ popLiteral() method - /** - * Pops a literal off the datastack or throws an exception. - */ - public Object popLiteral() throws FactorException - { - FlowObject obj = (FlowObject)datastack.pop(); - return obj.getLiteral(); - } //}}} - - //{{{ allocate() method - /** - * Allocate a local variable. - */ - private int allocate() - { - // inefficient! - int limit = base + datastack.top + callstack.top; - for(int i = base; i <= limit; i++) - { - if(allocate(i,datastack) && allocate(i,callstack)) - { - max = Math.max(max,i + 1); - return i; - } - } - // this is impossible - throw new RuntimeException("allocator failed"); - } //}}} - - //{{{ allocate() method - /** - * Return true if not in use, false if in use. - */ - private boolean allocate(int local, FactorArrayStack stack) - { - for(int i = 0; i < stack.top; i++) - { - FlowObject obj = (FlowObject)stack.stack[i]; - if(obj.usingLocal(local)) - return false; - } - return true; - } //}}} - - //{{{ maxLocals() method - public int maxLocals() - { - return max; - } //}}} - - //{{{ literal() method - private String literal(Object obj) - { - Integer i = (Integer)literals.get(obj); - int literal; - if(i == null) - { - literal = literalCount++; - literals.put(obj,new Integer(literal)); - } - else - literal = i.intValue(); - - return "literal_" + literal; - } //}}} - - //{{{ generateArgs() method - /** - * Generate instructions for copying arguments from the allocated - * local variables to the JVM stack, doing type conversion in the - * process. - */ - public void generateArgs(CodeVisitor mw, int num, Class[] args) - throws Exception - { - for(int i = 0; i < num; i++) - { - FlowObject obj = (FlowObject)datastack.stack[ - datastack.top - num + i]; - obj.generate(mw); - if(args != null) - FactorJava.generateFromConversion(mw,args[i]); - } - - datastack.top -= num; - } //}}} - - //{{{ generateFields() method - public void generateFields(ClassWriter cw) - throws Exception - { - for(int i = 0; i < literalCount; i++) - { - cw.visitField(ACC_PUBLIC | ACC_STATIC,"literal_" + i, - "Ljava/lang/Object;",null,null); - } - - Iterator entries = words.entrySet().iterator(); - while(entries.hasNext()) - { - Map.Entry entry = (Map.Entry)entries.next(); - FactorWord word = (FactorWord)entry.getKey(); - int index = ((Integer)entry.getValue()).intValue(); - - cw.visitField(ACC_PUBLIC | ACC_STATIC,"word_" + index, - FactorJava.javaClassToVMClass(word.def.getClass()), - null,null); - } - } //}}} - - //{{{ setFields() method - public void setFields(Class def) - throws Exception - { - Iterator entries = literals.entrySet().iterator(); - while(entries.hasNext()) - { - Map.Entry entry = (Map.Entry)entries.next(); - Object literal = entry.getKey(); - int index = ((Integer)entry.getValue()).intValue(); - - Field f = def.getField("literal_" + index); - f.set(null,literal); - } - - entries = words.entrySet().iterator(); - while(entries.hasNext()) - { - Map.Entry entry = (Map.Entry)entries.next(); - FactorWord word = (FactorWord)entry.getKey(); - int index = ((Integer)entry.getValue()).intValue(); - - Field f = def.getField("word_" + index); - System.err.println(word.def.getClass() + " ==> " + "word_" + index); - f.set(null,word.def); - } - } //}}} - - //{{{ FlowObject - public abstract class FlowObject - { - abstract void generate(CodeVisitor mw); - - boolean usingLocal(int local) - { - return false; - } - - Object getLiteral() - throws FactorCompilerException - { - throw new FactorCompilerException("Cannot compile unless literal on stack"); - } - - /** - * Stack effect of evaluating this -- only used for lists - * and conditionals! - */ - public StackEffect getStackEffect(Set recursiveCheck) - throws Exception - { - - return null; - } - - /** - * Write code for evaluating this. Returns maximum JVM stack - * usage. - */ - public int compileCallTo(CodeVisitor mw, Set recursiveCheck) - throws Exception - { - throw new FactorCompilerException("Cannot compile call to non-literal quotation"); - } - } //}}} - - //{{{ Result - class Result extends FlowObject - { - private int local; - - Result(int local) - { - this.local = local; - } - - void generate(CodeVisitor mw) - { - mw.visitVarInsn(ALOAD,local); - } - - boolean usingLocal(int local) - { - return (this.local == local); - } - } //}}} - - //{{{ Literal - class Literal extends FlowObject - { - private Object literal; - - Literal(Object literal) - { - this.literal = literal; - } - - void generate(CodeVisitor mw) - { - mw.visitFieldInsn(GETSTATIC,className, - literal(literal),"Ljava/lang/Object;"); - } - - Object getLiteral() - { - return literal; - } - - /** - * Stack effect of executing this -- only used for lists - * and conditionals! - */ - public StackEffect getStackEffect(Set recursiveCheck) - throws Exception - { - if(literal instanceof Cons - || literal == null) - { - return StackEffect.getStackEffect( - (Cons)literal,recursiveCheck, - LocalAllocator.this); - } - else - return null; - } - - /** - * Write code for evaluating this. Returns maximum JVM stack - * usage. - */ - public int compileCallTo(CodeVisitor mw, Set recursiveCheck) - throws Exception - { - if(literal instanceof Cons || literal == null) - return compile((Cons)literal,mw,recursiveCheck); - else - throw new FactorCompilerException("Not a quotation: " + literal); - } - } //}}} - - //{{{ ConstantPoolString - class ConstantPoolString extends FlowObject - { - private String str; - - ConstantPoolString(String str) - { - this.str = str; - } - - void generate(CodeVisitor mw) - { - mw.visitLdcInsn(str); - } - - Object getLiteral() - { - return str; - } - } //}}} - - //{{{ Null - class Null extends FlowObject - { - void generate(CodeVisitor mw) - { - mw.visitInsn(ACONST_NULL); - } - - Object getLiteral() - { - return null; - } - - /** - * Stack effect of executing this -- only used for lists - * and conditionals! - */ - public StackEffect getStackEffect(Set recursiveCheck) - { - return new StackEffect(0,0,0,0); - } - - /** - * Write code for evaluating this. Returns maximum JVM stack - * usage. - */ - public int compileCallTo(CodeVisitor mw, Set recursiveCheck) - throws Exception - { - return 0; - } - } //}}} - - //{{{ Choice - class Choice extends FlowObject - { - FlowObject cond, t, f; - - Choice(FlowObject cond, FlowObject t, FlowObject f) - { - this.cond = cond; - this.t = t; - this.f = f; - } - - void generate(CodeVisitor mw) - { - // if null jump to F - // T - // jump END - // F: F - // END: ... - Label fl = new Label(); - Label endl = new Label(); - - cond.generate(mw); - mw.visitJumpInsn(IFNULL,fl); - t.generate(mw); - mw.visitJumpInsn(GOTO,endl); - mw.visitLabel(fl); - f.generate(mw); - mw.visitLabel(endl); - } - - boolean usingLocal(int local) - { - return cond.usingLocal(local) - || t.usingLocal(local) - || f.usingLocal(local); - } - - /** - * Stack effect of executing this -- only used for lists - * and conditionals! - */ - public StackEffect getStackEffect(Set recursiveCheck) - throws Exception - { - FactorDataStack datastackCopy = (FactorDataStack) - datastack.clone(); - FactorCallStack callstackCopy = (FactorCallStack) - callstack.clone(); - - StackEffect te = t.getStackEffect(recursiveCheck); - - datastack = datastackCopy; - callstack = callstackCopy; - - StackEffect fe = f.getStackEffect(recursiveCheck); - - if(te == null || fe == null) - return null; - - // we can only balance out a conditional if - // both sides leave the same amount of elements - // on the stack. - // eg, 1/1 -vs- 2/2 is ok, 3/1 -vs- 4/2 is ok, - // but 1/2 -vs- 2/1 is not. - int balanceTD = te.outD - te.inD; - int balanceTR = te.outR - te.inR; - int balanceFD = fe.outD - fe.inD; - int balanceFR = fe.outR - fe.inR; - if(balanceTD == balanceFD - && balanceTR == balanceFR) - { - // replace results from the f branch with - // dummy values so that subsequent code - // doesn't assume these values always - // result from this - datastack.top -= te.outD; - for(int i = 0; i < te.outD; i++) - { - push(null); - } - callstack.top -= te.outR; - for(int i = 0; i < te.outR; i++) - { - pushR(null); - } - return new StackEffect( - Math.max(te.inD,fe.inD), - Math.max(te.outD,fe.outD), - Math.max(te.inR,fe.inR), - Math.max(te.outR,fe.outR) - ); - } - else - return null; - } - - /** - * Write code for evaluating this. Returns maximum JVM stack - * usage. - */ - public int compileCallTo(CodeVisitor mw, Set recursiveCheck) - throws Exception - { - // if null jump to F - // T - // jump END - // F: F - // END: ... - Label fl = new Label(); - Label endl = new Label(); - - cond.generate(mw); - mw.visitJumpInsn(IFNULL,fl); - - FactorDataStack datastackCopy = (FactorDataStack) - datastack.clone(); - FactorCallStack callstackCopy = (FactorCallStack) - callstack.clone(); - - int maxJVMStack = t.compileCallTo(mw,recursiveCheck); - mw.visitJumpInsn(GOTO,endl); - mw.visitLabel(fl); - - datastack = datastackCopy; - callstack = callstackCopy; - - maxJVMStack = Math.max(f.compileCallTo( - mw,recursiveCheck),maxJVMStack); - mw.visitLabel(endl); - - return Math.max(maxJVMStack,1); - } - } //}}} -} diff --git a/factor/compiler/Null.java b/factor/compiler/Null.java new file mode 100644 index 0000000000..d213bc89a1 --- /dev/null +++ b/factor/compiler/Null.java @@ -0,0 +1,76 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public class Null extends FlowObject implements Constants +{ + Null(FactorCompiler compiler, RecursiveState recursiveCheck) + { + super(compiler,recursiveCheck); + } + + public void generate(CodeVisitor mw) + { + mw.visitInsn(ACONST_NULL); + } + + Object getLiteral() + { + return null; + } + + /** + * Stack effect of executing this -- only used for lists + * and conditionals! + */ + public void getStackEffect(RecursiveState recursiveCheck) + { + } + + /** + * Write code for evaluating this. Returns maximum JVM stack + * usage. + */ + public int compileCallTo(CodeVisitor mw, RecursiveState recursiveCheck) + throws Exception + { + return 0; + } + + public boolean equals(Object o) + { + return (o instanceof Null); + } +} diff --git a/factor/compiler/RecursiveForm.java b/factor/compiler/RecursiveForm.java new file mode 100644 index 0000000000..c12ce3e20d --- /dev/null +++ b/factor/compiler/RecursiveForm.java @@ -0,0 +1,53 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.FactorWord; + +public class RecursiveForm +{ + public final FactorWord word; + public StackEffect effect; + public StackEffect baseCase; + public boolean active; + + public RecursiveForm(FactorWord word, StackEffect effect) + { + this.word = word; + this.effect = effect; + } + + public String toString() + { + return word.toString() + ( + baseCase == null + ? "" : "-" + baseCase); + } +} diff --git a/factor/compiler/RecursiveState.java b/factor/compiler/RecursiveState.java new file mode 100644 index 0000000000..642a51f606 --- /dev/null +++ b/factor/compiler/RecursiveState.java @@ -0,0 +1,98 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; + +public class RecursiveState +{ + private Cons words; + + //{{{ RecursiveState constructor + public RecursiveState() + { + } //}}} + + //{{{ RecursiveState constructor + public RecursiveState(RecursiveState clone) + { + words = clone.words; + } //}}} + + //{{{ add() method + public void add(FactorWord word, StackEffect effect) + { + //System.err.println(this + ": adding " + word); + //System.err.println(words); + if(get(word) != null) + { + //System.err.println("throwing exception"); + throw new RuntimeException("Calling add() twice on " + word); + } + words = new Cons(new RecursiveForm(word,effect),words); + } //}}} + + //{{{ remove() method + public void remove(FactorWord word) + { + //System.err.println(this + ": removing " + word); + if(last().word != word) + throw new RuntimeException("Unbalanced add()/remove()"); + words = words.next(); + } //}}} + + //{{{ get() method + public RecursiveForm get(FactorWord word) + { + Cons iter = words; + while(iter != null) + { + RecursiveForm form = (RecursiveForm)iter.car; + //System.err.println(form.word + "==?" + word); + if(form.word == word) + return form; + iter = iter.next(); + } + + return null; + } //}}} + + //{{{ last() method + public RecursiveForm last() + { + return (RecursiveForm)words.car; + } //}}} + + //{{{ toString() method + public String toString() + { + return FactorParser.unparse(words); + } //}}} +} diff --git a/factor/compiler/Result.java b/factor/compiler/Result.java new file mode 100644 index 0000000000..bf2b01676a --- /dev/null +++ b/factor/compiler/Result.java @@ -0,0 +1,67 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.compiler; + +import factor.*; +import java.lang.reflect.*; +import java.util.*; +import org.objectweb.asm.*; + +public class Result extends FlowObject implements Constants +{ + private int local; + + public Result(int local, FactorCompiler compiler, + RecursiveState recursiveCheck) + { + super(compiler,recursiveCheck); + this.local = local; + } + + public void generate(CodeVisitor mw) + { + mw.visitVarInsn(ALOAD,local); + } + + public int getLocal() + { + return local; + } + + boolean usingLocal(int local) + { + return (this.local == local); + } + + public String toString() + { + return "( indeterminate )"; + } +} diff --git a/factor/compiler/StackEffect.java b/factor/compiler/StackEffect.java index e447957e10..2b4376a893 100644 --- a/factor/compiler/StackEffect.java +++ b/factor/compiler/StackEffect.java @@ -32,12 +32,16 @@ package factor.compiler; import factor.*; import java.util.*; -public class StackEffect +public class StackEffect implements PublicCloneable, FactorExternalizable { - public final int inD; - public final int outD; - public final int inR; - public final int outR; + public int inD; + public int outD; + public int inR; + public int outR; + + //{{{ StackEffect constructor + public StackEffect() {} + //}}} //{{{ StackEffect constructor public StackEffect(int inD, int outD, int inR, int outR) @@ -48,69 +52,57 @@ public class StackEffect this.outR = outR; } //}}} - //{{{ getStackEffect() method - public static StackEffect getStackEffect(Cons definition) - throws Exception + //{{{ compose() method + public static StackEffect compose(StackEffect first, + StackEffect second) { - return getStackEffect(definition,new HashSet(), - new LocalAllocator()); - } //}}} + if(first == null || second == null) + return null; - //{{{ getStackEffect() method - public static StackEffect getStackEffect(Cons definition, - Set recursiveCheck, LocalAllocator state) - throws Exception - { - int inD = 0; - int outD = 0; - int inR = 0; - int outR = 0; + int inD = first.inD; + int inR = first.inR; + int outD = first.outD; + int outR = first.outR; - Cons iter = definition; - while(iter != null) + if(second.inD <= outD) + outD -= second.inD; + else { - Object obj = iter.car; - if(obj instanceof FactorWord) - { - StackEffect se = ((FactorWord)obj).def - .getStackEffect( - recursiveCheck, - state); - - if(se == null) - return null; - - if(se.inD <= outD) - outD -= se.inD; - else - { - inD += (se.inD - outD); - outD = 0; - } - - if(se.inR <= outR) - outR -= se.inR; - else - { - inR += (se.inR - outR); - outR = 0; - } - - outD += se.outD; - outR += se.outR; - } - else - { - outD++; - state.pushLiteral(obj); - } - - iter = iter.next(); + 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; + return new StackEffect(inD,outD,inR,outR); } //}}} + //{{{ decompose() method + /** + * Returns a stack effect E such that compose(first,E) == second. + */ + public static StackEffect decompose(StackEffect first, + StackEffect second) + { + if(second.inD < first.inD || second.inR < first.inR) + throw new IllegalArgumentException(); + + return new StackEffect( + first.outD + second.inD - first.inD, + second.outD, + first.outR + second.inR - first.inR, + second.outR); + } //}}} + //{{{ getCorePrototype() method public String getCorePrototype() { @@ -122,7 +114,7 @@ public class StackEffect signatureBuf.append("Ljava/lang/Object;"); } - if(outD == 0) + if(outD != 1) signatureBuf.append(")V"); else signatureBuf.append(")Ljava/lang/Object;"); @@ -145,24 +137,31 @@ public class StackEffect //{{{ toString() method public String toString() { - StringBuffer buf = new StringBuffer(); + StringBuffer buf = new StringBuffer("( "); for(int i = 0; i < inD; i++) { - buf.append("I "); + buf.append("X "); } for(int i = 0; i < inR; i++) { - buf.append("r:I "); + buf.append("r:X "); } buf.append("--"); for(int i = 0; i < outD; i++) { - buf.append(" O"); + buf.append(" X"); } for(int i = 0; i < outR; i++) { - buf.append(" r:O"); + buf.append(" r:X"); } + buf.append(" )"); return buf.toString(); } //}}} + + //{{{ clone() method + public Object clone() + { + return new StackEffect(inD,outD,inR,outR); + } //}}} } diff --git a/factor/continuations.factor b/factor/continuations.factor index af08fc053f..184d064abd 100644 --- a/factor/continuations.factor +++ b/factor/continuations.factor @@ -66,7 +66,7 @@ : suspend (--) ! Suspend the current fiber. ! Not really implemented yet. - $initialInterpreterContinuation dup [ + $top-level-continuation dup [ call ] [ clear unwind diff --git a/factor/debugger.factor b/factor/debugger.factor new file mode 100644 index 0000000000..078363d8bb --- /dev/null +++ b/factor/debugger.factor @@ -0,0 +1,118 @@ +!:folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2003, 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +: exception? ( exception -- boolean ) + "java.lang.Throwable" is ; + +: print-stack-trace ( exception -- ) + [ ] "java.lang.Throwable" "printStackTrace" jinvoke ; + +: exception. ( exception -- ) + ! If this is an Factor exception, just print the message, otherwise print + ! the entire exception as a string. + dup "factor.FactorException" is [ + [ ] "java.lang.Throwable" "getMessage" jinvoke + ] [ + >str + ] ifte print ; + +: break ( exception -- ) + $global [ + dup @error + + ! Called when the interpreter catches an exception. + "break called." print + "" print + ":w prints the callstack." print + ":j prints the Java stack." print + ":r returns to top level." print + ":s returns to top level, retaining the data stack." print + ":g continues execution (but expect another error)." print + "" print + "ERROR: " write exception. + + ! XXX: move this to the game core! + $console [ + [ t @expanded ] bind + ] when* + + callstack$ @error-callstack + [ + @error-continuation + " DEBUG. " interpreter-loop + ! If we end up here, the user just exited the err + ! interpreter. If we just call return-from-error + ! here, its like :g and this is probably not what + ! they wanted. So we :r instead. + :r + ] callcc0 + ] bind ; + +: return-from-error ( -- ) + "Returning from break." print + f @error-callstack + f @error-flag + f @error ; + +: :g ( -- ) + ! Continues execution from the point of the error. Can be dangerous. + return-from-error + $error-continuation call ; + +: :r ( -- ) + ! Returns to the top level. + return-from-error + !XXX + $initial-interpreter-continuation dup [ + call + ] [ + suspend + ] ifte ; + +: .s ( -- ) + ! Prints the contents of the data stack + datastack$ describe ; + +: :s ( -- ) + ! Returns to the top level, retaining the stack. + return-from-error + $initial-interpreter-callstack + callstack@ ; + +: :j ( -- ) + ! Print the stack trace from the exception that caused the + ! last break. + $error dup exception? [ + print-stack-trace + ] [ + "Not an exception: " write . + ] ifte ; + +: :w ( -- ) + ! Print the current callstack, or the callstack of the last + ! error inside an error context. + $error-callstack [ callstack$ ] unless* describe ; diff --git a/factor/dictionary.factor b/factor/dictionary.factor index c4efe64c64..7cdc3ab5b3 100644 --- a/factor/dictionary.factor +++ b/factor/dictionary.factor @@ -25,14 +25,22 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -: asm ( word -- assembly ) +: apropos ( substring -- ) + ! Prints all word names that contain the given substring. + words [ 2dup str-contains [ . ] [ drop ] ifte ] each drop ; + +: asm ( word -- ) ! Prints JVM bytecode disassembly of the given word. - worddef compiled? dup [ + intern [ $asm ] bind dup [ print ] [ drop "Not a compiled word." print ] ifte ; +: balance ( code -- effect ) + ! Push stack effect of the given code quotation. + no-name effect ; + : compile* ( word -- ) $interpreter swap [ "factor.FactorInterpreter" ] "factor.FactorWord" "compile" @@ -45,55 +53,88 @@ intern compile* ] ifte ; -: compileAll ( -- ) +: compile-all ( -- ) "Compiling..." write words [ compile ] each " done" print ; : compiled? ( obj -- boolean ) - [ $asm ] bind ; + "factor.compiler.CompiledDefinition" is ; -: compound? (obj -- boolean) +: compound? ( obj -- boolean ) "factor.FactorCompoundDefinition" is ; +: ( word def -- worddef ) + [ "factor.FactorWord" "factor.Cons" ] + "factor.FactorCompoundDefinition" + jnew ; + +: effect ( word -- effect ) + ! Push stack effect of the given word. + worddef [ ] "factor.FactorWordDefinition" + "getStackEffect" jinvoke ; + +: effect>list ( effect -- effect ) + [ + [ "factor.compiler.StackEffect" "inD" jvar$ ] + [ "factor.compiler.StackEffect" "outD" jvar$ ] + [ "factor.compiler.StackEffect" "inR" jvar$ ] + [ "factor.compiler.StackEffect" "outR" jvar$ ] + ] interleave unit cons cons cons ; + +: gensym ( -- word ) + [ ] "factor.FactorWord" "gensym" jinvoke-static ; + +: ( name -- word ) + ! Creates a new uninternalized word. + [ "java.lang.String" ] "factor.FactorWord" jnew ; + +: intern* ( "word" -- word ) + dup $ dup [ + nip + ] [ + drop dup $ tuck s@ + ] ifte ; + +: intern ( "word" -- word ) + ! Returns the top of the stack if it already been interned. + dup word? [ $dict [ intern* ] bind ] unless ; + : missing>f ( word -- word/f ) ! Is it the missing word placeholder? Then push f. dup undefined? [ drop f ] when ; -: shuffle? (obj -- boolean) - "factor.FactorShuffleDefinition" is ; +: no-name ( list -- word ) + ! Generates an uninternalized word and gives it a compound + ! definition created from the given list. + [ gensym dup dup ] dip define ; -: intern ("word" -- word) - ! Returns the top of the stack if it already been interned. - dup word? [ - $dict [ "java.lang.String" ] - "factor.FactorDictionary" "intern" - jinvoke - ] unless ; +: shuffle? ( obj -- boolean ) + "factor.FactorShuffleDefinition" is ; : undefined? ( obj -- boolean ) "factor.FactorMissingDefinition" is ; -: word? (obj -- boolean) +: word? ( obj -- boolean ) "factor.FactorWord" is ; : word ( -- word ) ! Pushes most recently defined word. - $dict "factor.FactorDictionary" "last" jvar$ ; + $global [ $last ] bind ; : worddef? (obj -- boolean) "factor.FactorWordDefinition" is ; : worddef ( word -- worddef ) - intern - "factor.FactorWord" "def" jvar$ - missing>f ; + dup worddef? [ intern [ $def ] bind missing>f ] unless ; -: worddefUncompiled ( word -- worddef ) - intern - "factor.FactorWord" "uncompiled" jvar$ - missing>f ; +: worddef>list ( worddef -- list ) + worddef + [ ] "factor.FactorWordDefinition" "toList" jinvoke ; -: words (-- list) +: words ( -- list ) ! Pushes a list of all defined words. - $dict [ ] "factor.FactorDictionary" "toWordList" jinvoke ; + $dict [ uvalues ] bind + [ + cdr dup [ drop ] unless + ] map ; diff --git a/factor/examples.factor b/factor/examples.factor index 50b3d97e0a..883e0e5fe5 100644 --- a/factor/examples.factor +++ b/factor/examples.factor @@ -26,7 +26,6 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. : examples/httpd - "/factor/examples/httpd.factor" runResource "Enter a port number: " write read >fixnum "Enter document root (eg, /home/www/): " write @@ -34,5 +33,4 @@ httpd ; : examples/httpd* - "/factor/examples/httpd.factor" runResource 8888 "/home/slava/ExampleHTTPD/" httpd ; diff --git a/factor/examples/httpd.factor b/factor/examples/httpd.factor deleted file mode 100644 index 243c8642a4..0000000000 --- a/factor/examples/httpd.factor +++ /dev/null @@ -1,151 +0,0 @@ -!:folding=indent:collapseFolds=1: - -! $Id$ -! -! Copyright (C) 2003 Slava Pestov. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -! To make this a bit more useful: -! - URL encoding -! - log with date -! - log user agent -! - add a socket timeout -! - if a directory is requested and URL does not end with /, redirect -! - return more header fields, like Content-Length, Last-Modified, and so on -! - HEAD request -! - make httpdFiletype generic, specify file types in a list of comma pairs -! - basic authentication, using httpdAuth function from a config file -! - when string formatting is added, some code can be simplified -! - use nio to handle multiple requests -! - implement an LSP that does an "apropos" search - -: httpdGetPath ( request -- file ) - dup ".*\\.\\.*" re-matches [ - f - ] [ - dup [ "GET (.*?)( HTTP.*|)" groups dup [ car ] when ] when - ] ifte ; - -: httpdResponse (stream msg contentType --) - [ "HTTP/1.0 " over fwrite ] 2dip - [ over fwriteln "Content-type: " over fwriteln ] dip - swap fwriteln ; - -: httpdError (stream error --) - "Error: " write dup print - 2dup "text/html" httpdResponse - "\n

" swap "

" cat3 swap fwriteln ; - -: httpdFiletype (filename -- mime-type) - [ - [ ".*\.gif" re-matches ] [ drop "image/gif" ] - [ ".*\.png" re-matches ] [ drop "image/png" ] - [ ".*\.html" re-matches ] [ drop "text/html" ] - [ ".*\.txt" re-matches ] [ drop "text/plain" ] - [ ".*\.lsd" re-matches ] [ drop "text/plain" ] - [ t ] [ drop "application/octet-stream" ] - ] cond ; - -: httpdUriToPath (uri -- path) - $httpdDocRoot swap - dup "http://.*?(/.*)" groups [ car ] when* - cat2 ; - -: httpdPathToAbsolute (path -- absolute) - $httpdDocRoot swap cat2 - "Serving " over cat2 print - dup directory? [ "/index.html" cat2 ] when ; - -: httpdServeFile (stream argument filename --) - nip - 2dup "200 Document follows" swap httpdFiletype httpdResponse - [ "" over fwriteln ] dip - swap fcopy ; - -: httpdListDirectory (stream directory -- string) - [ "" over fwrite ] dip - 2dup swap fwrite - [ "

" over fwrite ] dip - 2dup swap fwrite - [ "

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

    " over + "

      " over + httpd-directory>html + "
    " + ] cons expand cat swap fwrite ; + +: httpd-serve-directory ( stream directory -- ) + dup "/index.html" cat2 dup exists? [ + nip httpd-serve-file + ] [ + drop httpd-list-directory + ] ifte ; + +: httpd-serve-script ( stream argument filename -- ) + [ [ @argument @stdio ] dip runFile ] bind ; + +: httpd-parse-object-name ( filename -- argument filename ) + dup "(.*?)\\?(.*)" groups dup [ nip call ] when swap ; + +: httpd-serve-static ( stream filename -- ) + dup exists? [ + dup directory? [ + httpd-serve-directory + ] [ + httpd-serve-file + ] ifte + ] [ + drop "404 Not Found" httpd-error + ] ifte ; + +: httpd-serve-object ( stream argument filename -- ) + dup ".*\\.lhtml" re-matches [ + httpd-serve-script + ] [ + nip httpd-serve-static + ] ifte ; + +: httpd-serve-log ( filename -- ) + "Serving " swap cat2 print ; + +: httpd-get-request ( stream url -- ) + httpd-url>path dup httpd-serve-log + httpd-parse-object-name httpd-serve-object ; + +: httpd-get-path ( request -- file ) + "GET (.*?)( HTTP.*|)" group1 ; + +: httpd-get-secure-path ( path -- path ) + dup [ + httpd-get-path dup [ + dup ".*\\.\\.*" re-matches [ drop f ] when + ] [ + drop f + ] ifte + ] [ + drop f + ] ifte ; + +: httpd-request ( stream request -- ) + httpd-get-secure-path dup [ + httpd-get-request + ] [ + drop "400 Bad request" httpd-error + ] ifte ; + +: httpd-client-log ( socket -- ) + "Accepted connection from " write [ $socket ] bind . ; + +: httpd-client ( socket -- ) + dup httpd-client-log + dup freadln [ httpd-request ] when* ; + +: httpd-loop ( server -- ) + [ + $httpd-quit not + ] [ + dup accept dup httpd-client fclose + ] while ; + +: httpd ( port docroot -- ) + @httpd-doc-root httpd-loop ; diff --git a/factor/inspector.factor b/factor/inspector.factor new file mode 100644 index 0000000000..6cc96e56a9 --- /dev/null +++ b/factor/inspector.factor @@ -0,0 +1,141 @@ +!:folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2003, 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +: max-str-length ( list -- len ) + ! Returns the length of the longest string in the given + ! list. + 0 swap [ str-length max ] each ; + +: pad-string ( len str -- str ) + str-length - spaces ; + +: words. (--) + ! Print all defined words. + words [ . ] each ; + +: vars. ( -- ) + ! Print a list of defined variables. + uvars [ print ] each ; + +: value/tty ( max [ name , value ] -- ... ) + uncons [ dup [ pad-string ] dip ": " ] dip unparse "\n" ; + +: values/tty ( -- ... ) + ! Apply 'expand' or 'str-expand' to this word. + uvars max-str-length + uvalues [ over [ value/tty ] dip ] each drop ; + +: value/html ( [ name , value ] -- ... ) + uncons [ + [ "" ] 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 ] + [ stack? ] [ stack>list print-numbered-list ] + [ string? ] [ print ] + [ drop t ] [ + "OBJECT: " write dup . + [ + "CLASS : " write dup class-of print + "--------" print + [ values/tty ] describe* + ] when* + ] + ] cond ; + +: describe/html ( obj -- ) + [ + [ worddef? ] [ see/html ] + [ string? ] [ + "
    " 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. + dup [ + unswons $ dup [ + ! Defined. + inspecting [ object-path ] bind + ] [ + ! Undefined. Just return f. + 2drop f + ] ifte + ] [ + ! Current object. + drop $this [ $namespace ] unless* + ] ifte ; + +: inspect ( obj -- ) + ! Display the inspector for the object, and start a new + ! REPL bound to the object's namespace. + inspecting dup describe + "--------" print + ! Start a REPL, only if the object is not the dictionary. + dup $dict = [ + "Cannot enter into dictionary. Use 'see' word." print + ] [ + "exit - exit one level of inspector." print + "suspend - return to top level." print + dup [ + " " swap unparse " " cat3 interpreter-loop + ] bind + ] ifte ; diff --git a/factor/interpreter.factor b/factor/interpreter.factor index cb5787c7b5..d40c6ec6fc 100644 --- a/factor/interpreter.factor +++ b/factor/interpreter.factor @@ -25,136 +25,58 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -: exception? (exception -- boolean) - "java.lang.Throwable" is ; +0 @history-count -: printStackTrace (exception --) - [ ] "java.lang.Throwable" "printStackTrace" jinvoke ; +: exit (--) + $global [ t @quit-flag ] bind ; -: exception. (exception --) - ! If this is an Factor exception, just print the message, otherwise print - ! the entire exception as a string. - dup "factor.FactorException" is [ - [ ] "java.lang.Throwable" "getMessage" jinvoke - ] [ - >str - ] ifte print ; - -: break (exception --) - dup @error - - ! Called when the interpreter catches an exception. - "break called." print - "" print - ":w prints the callstack." print - ":j prints the Java stack." print - ":r returns to top level." print - ":s returns to top level, retaining the data stack." print - ":g continues execution (but expect another error)." print - "" print - "ERROR: " write exception. - :w - callstack$ @errorCallStack - [ - @errorContinuation - interpreterLoop - ! If we end up here, the user just exited the err interpreter. - ! If we just call returnFromError here, its like :g and this - ! is probably not what they wanted. So we :r instead. - :r - ] callcc0 ; - -: returnFromError (--) - "Returning from break." print - f @errorCallStack - f @errorFlag - f @error ; - -: :g (--) - ! Continues execution from the point of the error. Can be dangerous. - returnFromError - $errorContinuation call ; - -: :r (--) - ! Returns to the top level. - returnFromError - !XXX - $initialInterpreterContinuation dup [ - call - ] [ - suspend - ] ifte ; - -: :s (--) - ! Returns to the top level, retaining the stack. - returnFromError - $initialInterpreterCallStack callstack@ ; - -: :j (--) - ! Print the stack trace from the exception that caused the last break. - $error dup exception? [ - printStackTrace - ] [ - "Not an exception: " write . - ] ifte ; - -: :w (--) - ! Print the current callstack, or the callstack of the last error inside an - ! error context. - $errorCallStack dup [ - drop callstack$ - ] unless . ; - -: printPrompt (--) - $errorFlag " err> " " ok> " ? write ; - -: interpreterLoop (--) - printPrompt read [ - eval - $quitFlag [ interpreterLoop ] unless - ] when* ; - -: initialInterpreterLoop (--) - ! Run the stand-alone interpreter +: print-banner ( -- ) "Factor " $version cat2 print "Copyright (C) 2003, 2004 Slava Pestov" print "Enter ``help'' for help." print - "Enter ``exit'' to exit." print + "Enter ``exit'' to exit." print ; + +: history+ ( cmd -- ) + $history 2dup contains [ 2drop ] [ cons @history ] ifte + "history-count" succ@ ; + +: history ( -- ) + "X redo -- evaluate the expression with number X." print + "X re-edit -- edit the expression with number X." print + $history print-numbered-list ; + +: get-history ( index -- ) + $history reverse swap get ; + +: redo ( index -- ) + get-history [ . ] [ eval ] cleave ; + +: re-edit ( index -- ) + get-history edit ; + +: print-prompt ( prompt -- ) + write $history-count write "] " write ; + +: interpreter-loop ( prompt -- ) + dup >r print-prompt read [ + [ history+ ] [ eval ] cleave + $global [ $quit-flag ] bind [ + rdrop + $global [ f @quit-flag ] bind + ] [ + r> interpreter-loop + ] ifte + ] when* ; + +: initial-interpreter-loop (--) + ! Run the stand-alone interpreter + print-banner ! Used by :r - [ @initialInterpreterContinuation ] callcc0 + [ @initial-interpreter-continuation ] callcc0 ! Used by :s ! We use the slightly redundant 'call' to push the current callframe. - [ callstack$ @initialInterpreterCallStack ] call - interpreterLoop ; - -: words. (--) - ! Print all defined words. - words [ . ] each ; - -: see (word --) - dup worddefUncompiled [ - (word -- worddef word) - dup [ - worddefUncompiled dup shuffle? "~<< " ": " ? write - ] dip - - (worddef word -- worddef) - write "\n " write - - dup >str write - - shuffle? " >>~\n" " ;\n" ? write - ] [ - "Not defined: " write print - ] ifte ; - -: vars. (--) - ! Print a list of defined variables. - vars [ . ] each ; - -: .s (--) - ! Prints the contents of the data stack - datastack$ . ; + [ callstack$ @initial-interpreter-callstack ] call + " " interpreter-loop ; : stats ( -- ) "Cons: " write @@ -167,28 +89,24 @@ : gc ( -- ) [ ] "java.lang.System" "gc" jinvoke-static ; -: balance ( code -- effect ) - ! Push stack effect of the given code quotation. - [ "factor.Cons" ] "factor.compiler.StackEffect" - "getStackEffect" jinvoke-static ; - : help + "clear -- clear datastack." + ".s -- print datastack." + ". -- print top of datastack." "" print - "= Dynamic, interpreted, stack-based scripting language" print - "= Arbitrary precision math, ratio math" print - "= First-class, higher-order, and anonymous functions" print - "= Prototype-based object system" print - "= Continuations" print - "= Tail call optimization" print - "= Rich set of primitives based on recursion" print + "values. -- list all variables." print + "inspect -- list all variables bound on object at top of stack." print + "$variable . -- show value of variable." print "" print - "Some basic commands:" print - "clear -- clear stack." print - ".s -- print stack." print - ". -- print top of stack." print - "vars. -- list all variables." print - "$variable . -- show value of variable." print - "words. -- list all words." print - "\"word\" see -- show definition of word." print - "exit -- exit the interpreter." print + "words. -- list all words." print + "\"str\" apropos -- list all words whose name contains str." print + "\"word\" see -- show definition of word." print + "" print + "[ expr ] balance . -- show stack effect of expression." print + "" print + "history -- list previously entered expresions." print + "X redo -- redo expression number X from history list." print + "" print + "stats -- interpreter statistics." print + "exit -- exit the interpreter." print "" print ; diff --git a/factor/lists.factor b/factor/lists.factor index 654bdd4943..71d4eb9b82 100644 --- a/factor/lists.factor +++ b/factor/lists.factor @@ -25,9 +25,42 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! List manipulation primitives +! +: array>list ( array -- list ) + [ [ "java.lang.Object" ] ] "factor.Cons" "fromArray" + jinvoke-static ; + +: car ([ car , cdr ] -- car) + |factor.Cons |car jvar$ ; + +: cdr ([ car , cdr ] -- cdr) + |factor.Cons |cdr jvar$ ; + +: cons (car cdr -- [ car , cdr ]) + [ |java.lang.Object |java.lang.Object ] |factor.Cons jnew ; + +: cons? (list -- boolean) + |factor.Cons is ; + +: rplaca ( A [ B , C ] -- [ A , C ] ) + ! Destructive! + "factor.Cons" "car" jvar@ ; + +: rplacd ( A [ B , C ] -- [ B , A ] ) + ! Destructive! + "factor.Cons" "cdr" jvar@ ; + +! +! List manipulation library +! : 2list (a b -- [ a b ]) unit cons ; +: 3list ( a b c -- [ a b c ] ) + 2list cons ; + : 2rlist (a b -- [ b a ]) swap unit cons ; @@ -41,10 +74,6 @@ ! Adds the list to the end of the list stored in the given variable. dup [ $ swap append ] dip @ ; -: array>list ( array -- list ) - [ [ "java.lang.Object" ] ] "factor.Cons" "fromArray" - jinvoke-static ; - : add@ (elem variable --) ! Adds the element to the end of the list stored in the given variable. dup [ $ swap add ] dip @ ; @@ -63,11 +92,19 @@ 2drop f ] ifte ; -: car ([ car , cdr ] -- car) - |factor.Cons |car jvar$ ; - -: cdr ([ car , cdr ] -- cdr) - |factor.Cons |cdr jvar$ ; +: 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. + dup [ + 2dup car car $ = [ + nip car cdr + ] [ + cdr assoc$ + ] ifte + ] [ + 2drop f + ] ifte ; : caar (list -- caar) car car ; @@ -81,18 +118,24 @@ : cddr (list -- cddr) cdr cdr ; -: cloneList (list -- list) - ! Returns a new list where each element is a clone of the elements of - ! the given list. - dup [ [ ] "factor.Cons" "deepClone" jinvoke ] when ; +: clone-list-iter ( result list -- last [ ] ) + [ + dup cons? + ] [ + uncons [ unit tuck [ rplacd ] dip ] dip + ] while ; -: cons (car cdr -- [ car , cdr ]) - [ |java.lang.Object |java.lang.Object ] |factor.Cons jnew ; +: clone-list (list -- list) + dup [ + uncons [ unit dup ] dip clone-list-iter swap rplacd + ] when ; -: contains (elem list -- boolean) +: contains ( elem list -- remainder ) + ! If the list contains elem, return the remainder of the + ! list, starting from the cell whose car is elem. dup [ 2dup car = [ - 2drop t + nip ] [ cdr contains ] ifte @@ -102,21 +145,17 @@ : cons@ (x var --) ! Prepends x to the list stored in var. - dup [ $ cons ] dip @ ; + tuck $ cons s@ ; : count (n -- [ 1 2 3 ... n ]) [ [ ] times* ] cons expand ; -: swons@ (var x --) - ! Prepends x to the list stored in var. - over $ cons s@ ; - : get (list n -- list[n]) [ cdr ] times car ; : last* ( list -- last ) ! Pushes last cons of the list. - [ dup cdr ] [ cdr ] while ; + [ dup cdr cons? ] [ cdr ] while ; : last ( list -- last ) ! Pushes last element of the list. @@ -125,37 +164,88 @@ : length (list -- length) 0 swap [ drop succ ] each ; -: list (list[0] ... list[n] n -- list) - [ ] swap [ cons ] times ; - -: list? (list -- boolean) - dup pair? [ cdr list? ] [ f ] ifte ; +: list? ( list -- boolean ) + ! A list is either f, or a cons cell whose cdr is a list. + dup [ + dup cons? [ + cdr list? + ] [ + drop f + ] ifte + ] [ + drop t + ] ifte ; : nappend ( [ list1 ] [ list2 ] -- [ list1 list2 ] ) ! Destructive on list1! - over [ last* rplacd ] when* ; + over [ over last* rplacd ] [ nip ] ifte ; -: pair? (list -- boolean) - |factor.Cons is ; +~<< partition-iterI + R1 R2 A D C -- A C r:R1 r:R2 r:A r:D r:C >>~ + +~<< partition-iterT{ + r:R1 r:R2 r:A r:D r:C -- A R1 r:R1 r:R2 r:D r:C >>~ + +~<< }partition-iterT + R1 r:R1X r:R2 r:D r:C -- R1 R2 D C >>~ + +~<< partition-iterF{ + r:R1 r:R2 r:A r:D r:C -- A R2 r:R1 r:R2 r:D r:C >>~ + +~<< }partition-iterF + R2 r:R1 r:R2X r:D r:C -- R1 R2 D C >>~ + +: partition-iter ( ref ret1 ret2 list combinator -- ret1 ret2 ) + over [ + ! Note this ifte must be in tail position! + [ uncons ] dip partition-iterI [ dup ] 2dip call [ + partition-iterT{ cons }partition-iterT partition-iter + ] [ + partition-iterF{ cons }partition-iterF partition-iter + ] ifte + ] [ + 2drop + ] ifte ; + +: partition ( ref list combinator -- list1 list2 ) + [ ] [ ] 2swap partition-iter rot drop ; : reverse (list -- list) [ ] swap [ swons ] each ; -: rplaca ( A [ B , C ] -- [ A , C ] ) - ! Destructive! - "factor.Cons" "car" jvar@ ; - -: rplacd ( A [ B , C ] -- [ B , A ] ) - ! Destructive! - "factor.Cons" "cdr" jvar@ ; +: sort ( list comparator -- sorted ) + over [ + ! Partition + dup [ [ uncons dupd ] dip partition ] dip + ! Recurse + tuck sort [ sort ] dip + ! Combine + swapd cons append + ] [ + drop + ] ifte ; : swons (cdr car -- [ car , cdr ]) - swap [ |java.lang.Object |java.lang.Object ] - |factor.Cons jnew ; + swap cons ; + +: swons@ (var x --) + ! Prepends x to the list stored in var. + over $ cons s@ ; : uncons ([ car , cdr ] -- car cdr) dup car swap cdr ; +: unique ( elem list -- list ) + ! Cons elem onto list if its not already there. + 2dup contains [ + nip + ] [ + cons + ] ifte ; + +: unique@ ( elem var -- ) + tuck $ unique s@ ; + : unit (a -- [ a ]) f cons ; diff --git a/factor/math.factor b/factor/math.factor index 9ef76bf4ee..5954548d52 100644 --- a/factor/math.factor +++ b/factor/math.factor @@ -2,7 +2,7 @@ ! $Id$ ! -! Copyright (C) 2003 Slava Pestov. +! Copyright (C) 2003, 2004 Slava Pestov. ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: @@ -28,9 +28,16 @@ : 0= (x -- boolean) 0 = ; +: 0>f ( obj -- oj ) + ! If 0 a the top of the stack, turn it into f. + dup 0 = [ drop f ] when ; + : 1= (x -- boolean) 1 = ; +: number? (obj -- boolean) + "java.lang.Number" is ; + : fixnum? (obj -- boolean) "java.lang.Integer" is ; @@ -58,6 +65,9 @@ [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "add" jinvoke-static ; +: v+ ( A B -- A+B ) + [ + ] 2map ; + : +@ (num var --) dup [ $ + ] dip @ ; @@ -65,6 +75,10 @@ [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "subtract" jinvoke-static ; +: v- ( A B -- A-B ) + [ - ] 2map ; + + : -@ (num var --) dup [ $ swap - ] dip @ ; @@ -72,6 +86,13 @@ [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "multiply" jinvoke-static ; +: v* ( A B -- A*B ) + [ * ] 2map ; + +: v. ( A B -- A.B ) + ! Dot product. + v* 0 swap [ + ] each ; + : *@ (num var --) dup [ $ * ] dip @ ; @@ -79,6 +100,9 @@ [ "java.lang.Number" "java.lang.Number" ] "factor.FactorMath" "divide" jinvoke-static ; +: v/ ( A B -- A/B ) + [ / ] 2map ; + : /@ (num var --) dup [ $ / ] dip @ ; @@ -97,10 +121,20 @@ : and (a b -- a&b) f ? ; +: gcd ( a b -- c ) + [ "java.lang.Number" "java.lang.Number" ] + "factor.FactorMath" "gcd" jinvoke-static ; + : mag2 (x y -- mag) ! Returns the magnitude of the vector (x,y). sq swap sq + sqrt ; +: max ( x y -- z ) + 2dup > -rot ? ; + +: min ( x y -- z ) + 2dup < -rot ? ; + : neg (x -- -x) 0 swap - ; @@ -120,14 +154,11 @@ : pred (n -- n-1) 1 - ; -: round ( x y -- x^y ) - [ "double" "double" ] "java.lang.Math" "pow" jinvoke-static ; - : succ (n -- nsucc) 1 + ; : pred@ (var --) - dup $ 1 - s@ ; + dup $ pred s@ ; : or (a b -- a|b) t swap ? ; @@ -135,6 +166,13 @@ : recip (x -- 1/x) 1 swap / ; +: rem ( x y -- remainder ) + [ "double" "double" ] "java.lang.Math" "IEEEremainder" + jinvoke-static ; + +: round ( x to -- y ) + dupd rem - ; + : sq (x -- x^2) dup * ; @@ -142,7 +180,7 @@ [ "double" ] "java.lang.Math" "sqrt" jinvoke-static ; : succ@ (var --) - dup $ 1 + s@ ; + dup $ succ s@ ; : deg2rad (degrees -- radians) $pi * 180 / ; diff --git a/factor/miscellaneous.factor b/factor/miscellaneous.factor index 0ff2bec289..5ff8a6d603 100644 --- a/factor/miscellaneous.factor +++ b/factor/miscellaneous.factor @@ -30,6 +30,9 @@ [ "java.lang.Object" "java.lang.Object" ] "factor.FactorLib" "equal" jinvoke-static ; +: class-of ( obj -- class ) + [ ] "java.lang.Object" "getClass" jinvoke ; + : clone (obj -- obj) [ ] "factor.PublicCloneable" "clone" jinvoke ; @@ -43,7 +46,7 @@ "factor.FactorLib" "deepCloneArray" jinvoke-static ; -: is (obj class -- boolean) +: is ( obj class -- boolean ) ! Like "instanceof" in Java. [ "java.lang.Object" ] "java.lang.Class" "isInstance" jinvoke ; @@ -69,18 +72,22 @@ : exit* (code --) [ |int ] |java.lang.System |exit jinvoke-static ; -: exit (--) - 0 exit* ; - : millis (-- millis) ! Pushes the current time, in milliseconds. [ ] |java.lang.System |currentTimeMillis jinvoke-static >bignum ; +: stack? ( obj -- ? ) + "factor.FactorArrayStack" is ; + : stack>list (stack -- list) ! Turns a callstack or datastack object into a list. [ ] "factor.FactorArrayStack" "toList" jinvoke ; +: system-property ( name -- value ) + [ "java.lang.String" ] "java.lang.System" "getProperty" + jinvoke-static ; + : time (code --) ! Evaluates the given code and prints the time taken to execute it. - millis swap dip millis -- . ; + millis >r call millis r> - . ; diff --git a/factor/namespaces.factor b/factor/namespaces.factor index d02fedbf52..740341f6d3 100644 --- a/factor/namespaces.factor +++ b/factor/namespaces.factor @@ -28,13 +28,16 @@ : s@ ( variable value -- ) swap @ ; -: lazy (var [ a ] -- value) - ! If the value of the variable is f, set the value to the result of - ! evaluating [ a ]. +: has-namespace? ( a -- boolean ) + "factor.FactorObject" is ; + +: lazy ( var [ a ] -- value ) + ! If the value of the variable is f, set the value to the + ! result of evaluating [ a ]. over $ [ drop $ ] [ dip dupd @ ] ifte ; -: namespace? (a -- boolean) - |factor.FactorNamespace is ; +: namespace? ( a -- boolean ) + "factor.FactorNamespace" is ; : (-- namespace) $namespace [ |factor.FactorNamespace ] |factor.FactorNamespace @@ -45,7 +48,7 @@ [ "factor.FactorNamespace" "java.lang.Object" ] "factor.FactorNamespace" jnew ; -: extend (object code -- object) +: extend ( object code -- object ) ! Used in code like this: ! : ! [ @@ -53,19 +56,27 @@ ! ] extend ; over [ bind ] dip ; -: import (class pairs --) - ! Import some static variables from a Java class into the current namespace. +: import ( class pairs -- ) + ! Import some static variables from a Java class into the + ! current namespace. $namespace [ |java.lang.String |factor.Cons ] |factor.FactorNamespace |importVars jinvoke ; -: vars (-- list) +: vars ( -- list ) $namespace [ ] |factor.FactorNamespace |toVarList jinvoke ; -: uvar? (name --) - [ "namespace" "parent" ] contains not ; +: values ( -- list ) + $namespace [ ] |factor.FactorNamespace |toValueList + jinvoke ; -: uvars (-- list) - ! Does not include "namespace" and "parent" variables; ie, all user-defined - ! variables in given namespace. +: uvalues ( -- list ) + values [ car uvar? ] subset ; + +: uvar? ( name -- ) + [ "namespace" "parent" "this" ] contains not ; + +: uvars ( -- list ) + ! Does not include "namespace" and "parent" variables; ie, + ! all user-defined variables in given namespace. vars [ uvar? ] subset ; diff --git a/factor/parser.factor b/factor/parser.factor index ae9df840f0..15f918de9d 100644 --- a/factor/parser.factor +++ b/factor/parser.factor @@ -25,18 +25,31 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -: parse (string -- list) +: parse ( string -- list ) f swap parse* ; -: eval ("X" -- X) - parse call ; +: compile-call ( [ X ] -- X ) + no-name dup compile execute ; -: runFile (path --) +: eval ( "X" -- X ) + parse $compile-toplevel [ compile-call ] [ call ] ifte ; + +: eval-compile ( "X" -- X ) + parse no-name word compile word execute ; + +: runFile ( path -- ) dup parse* call ; -: unparse (X -- "X") - [ |java.lang.Object ] |factor.FactorJava |factorTypeToString +: unparse ( X -- "X" ) + [ |java.lang.Object ] |factor.FactorParser |unparse jinvoke-static ; -: . (expr --) +: . ( expr -- ) unparse print ; + +: parse-number ( str -- number ) + parse dup length 1 = [ + car dup number? [ drop f ] unless + ] [ + drop f + ] ifte ; diff --git a/factor/prettyprint.factor b/factor/prettyprint.factor new file mode 100644 index 0000000000..68cbefa833 --- /dev/null +++ b/factor/prettyprint.factor @@ -0,0 +1,176 @@ +!:folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2003, 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +4 @indent + +: ( string -- token ) + dup [ + @name + t @prettyprint-token + ] extend tuck s@ ; + +: prettyprint-token? ( token -- token? ) + dup has-namespace? [ + [ $prettyprint-token ] bind + ] [ + drop f + ] ifte ; + +: prettyprint-indent ( indent -- indent ) + dup spaces write ; + +: prettyprint-newline/space ( indent ? -- indent ) + [ "\n" write prettyprint-indent ] [ " " write ] ifte ; + +: prettyprint-indent-params ( indent obj -- indent ? ? name ) + [ + $indent+ [ $indent + ] when + $indent- [ $indent - ] when + $-indent [ $indent - t ] [ f ] ifte + $newline + $name + ] bind ; + +: prettyprint-token ( indent obj -- indent ) + prettyprint-indent-params + [ + [ + "\n" write + prettyprint-indent + ] when + ] 2dip + write prettyprint-newline/space ; + +: prettyprint-unparsed ( indent unparse -- indent ) + dup "\n" = [ + drop "\n" write prettyprint-indent + ] [ + write " " write + ] ifte ; + +: [prettyprint-tty] ( indent obj -- indent ) + dup prettyprint-token? [ + prettyprint-token + ] [ + unparse prettyprint-unparsed + ] ifte ; + +: prettyprint-html-unparse ( obj -- unparse ) + dup unparse dup "\n" = [ + nip + ] [ + swap word? [ + "" over "" cat5 + ] [ + chars>entities + ] ifte + ] ifte ; + +: [prettyprint-html] ( indent obj -- indent ) + dup prettyprint-token? [ + prettyprint-token + ] [ + prettyprint-html-unparse prettyprint-unparsed + ] ifte ; + +: prettyprint-list* ( quot list -- ) + ! Pretty-print a list, without [ and ]. + [ + over [ + prettyprint* + ] dip + ] each + ! Drop the quotation + drop ; + +: prettyprint-list ( quot list before after -- ) + ! Apply the quotation to 'before', call prettyprint* on + ! 'list', and apply the quotation to 'after'. + swapd [ + [ + swap dup [ + call + ] dip + ] dip + swap dup [ + swap prettyprint-list* + ] dip + ] dip + swap call ; + +: prettyprint* ( quot obj -- ) + [ + [ not ] [ swap call ] + [ list? ] [ $[ $] prettyprint-list ] + [ compound? ] [ worddef>list $: $; prettyprint-list ] + [ compiled? ] [ worddef>list $: $; prettyprint-list ] + [ shuffle? ] [ worddef>list $~<< $>>~ prettyprint-list ] + [ drop t ] [ swap call ] + ] cond ; + +: prettyprint-tty ( list -- ) + 0 [ [prettyprint-tty] ] rot prettyprint* drop ; + +: prettyprint-html ( list -- ) + 0 [ [prettyprint-html] ] rot prettyprint* drop ; + +: see ( word -- ) + worddef prettyprint-tty ; + +: see/html ( word -- ) + "
    " 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 diff --git a/factor/primitives/Bind.java b/factor/primitives/Bind.java index f7d34a214d..8357b48a30 100644 --- a/factor/primitives/Bind.java +++ b/factor/primitives/Bind.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class Bind extends FactorWordDefinition @@ -55,40 +55,26 @@ public class Bind extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws Exception { state.ensure(state.datastack,2); - LocalAllocator.FlowObject quot - = (LocalAllocator.FlowObject) - state.datastack.pop(); + FlowObject quot = (FlowObject)state.datastack.pop(); state.pop(null); - StackEffect effect = quot.getStackEffect(recursiveCheck); - if(effect != null) - { - // add 2 to inD since we consume the - // quotation and the object - return new StackEffect(effect.inD + 2, - effect.outD, - effect.inR, - effect.outR); - } - else - return null; + quot.getStackEffect(recursiveCheck); } //}}} - //{{{ compileCallTo() method + //{{{ compileImmediate() method /** * Compile a call to this word. Returns maximum JVM stack use. */ - public int compileCallTo( + public int compileImmediate( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - LocalAllocator.FlowObject quot = (LocalAllocator.FlowObject) - allocator.datastack.pop(); + FlowObject quot = (FlowObject)compiler.datastack.pop(); // store namespace on callstack mw.visitVarInsn(ALOAD,0); @@ -101,11 +87,11 @@ public class Bind extends FactorWordDefinition "factor/FactorCallFrame", "namespace", "Lfactor/FactorNamespace;"); - allocator.pushR(mw); + compiler.pushR(mw); // set new namespace mw.visitInsn(DUP); - allocator.pop(mw); + compiler.pop(mw); FactorJava.generateFromConversion(mw,FactorNamespace.class); mw.visitFieldInsn(PUTFIELD, "factor/FactorCallFrame", @@ -115,7 +101,7 @@ public class Bind extends FactorWordDefinition int maxJVMStack = quot.compileCallTo(mw,recursiveCheck); // restore namespace from callstack - allocator.popR(mw); + compiler.popR(mw); mw.visitFieldInsn(PUTFIELD, "factor/FactorCallFrame", "namespace", diff --git a/factor/primitives/Call.java b/factor/primitives/Call.java index a52249eecc..efd89b5d75 100644 --- a/factor/primitives/Call.java +++ b/factor/primitives/Call.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class Call extends FactorWordDefinition @@ -52,39 +52,25 @@ public class Call extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws Exception { state.ensure(state.datastack,1); - LocalAllocator.FlowObject quot - = (LocalAllocator.FlowObject) - state.datastack.pop(); - StackEffect effect = quot.getStackEffect(recursiveCheck); - if(effect != null) - { - // add 1 to inD since we consume the - // quotation - return new StackEffect(effect.inD + 1, - effect.outD, - effect.inR, - effect.outR); - } - else - return null; + FlowObject quot = (FlowObject)state.datastack.pop(); + quot.getStackEffect(recursiveCheck); } //}}} - //{{{ compileCallTo() method + //{{{ compileImmediate() method /** * Compile a call to this word. Returns maximum JVM stack use. */ - public int compileCallTo( + public int compileImmediate( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - LocalAllocator.FlowObject quot = (LocalAllocator.FlowObject) - allocator.datastack.pop(); + FlowObject quot = (FlowObject)compiler.datastack.pop(); return quot.compileCallTo(mw,recursiveCheck); } //}}} } diff --git a/factor/primitives/Choice.java b/factor/primitives/Choice.java index 41e7468779..fc74913747 100644 --- a/factor/primitives/Choice.java +++ b/factor/primitives/Choice.java @@ -60,26 +60,25 @@ public class Choice extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(java.util.Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,3); - state.pushChoice(); - return new StackEffect(3,1,0,0); + state.pushChoice(recursiveCheck); } //}}} //{{{ compileCallTo() method /** * Compile a call to this word. Returns maximum JVM stack use. */ - /* public int compileCallTo( + public int compileCallTo( CodeVisitor mw, - LocalAllocator allocator, - java.util.Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - allocator.pushChoice(); + compiler.pushChoice(recursiveCheck); return 0; - } */ //}}} + } //}}} } diff --git a/factor/primitives/Define.java b/factor/primitives/Define.java index c12126e685..865394eba8 100644 --- a/factor/primitives/Define.java +++ b/factor/primitives/Define.java @@ -31,7 +31,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; -import java.util.Set; +import java.util.Map; public class Define extends FactorWordDefinition { @@ -46,32 +46,38 @@ public class Define extends FactorWordDefinition throws Exception { FactorDataStack datastack = interp.datastack; - FactorDictionary dict = interp.dict; - // handle old define syntax - Object obj = datastack.pop(); + Object def = datastack.pop(); + Object name = datastack.pop(); + core(interp,name,def); + } //}}} - FactorWord newWord = interp.dict.intern( - (String)datastack.pop(String.class)); + //{{{ core() method + public static void core(FactorInterpreter interp, + Object name, Object def) throws Exception + { + // name: either a string or a word + FactorWord newWord; + if(name instanceof FactorWord) + newWord = (FactorWord)name; + else + newWord = interp.intern((String)name); - if(obj instanceof Cons) + if(def instanceof Cons) { - obj = new FactorCompoundDefinition( - newWord,(Cons)obj); + def = new FactorCompoundDefinition( + newWord,(Cons)def); } - FactorWordDefinition def = (FactorWordDefinition)obj; - - newWord.define(def); - dict.last = newWord; + newWord.define((FactorWordDefinition)def); + interp.last = newWord; } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,2); state.pop(null); state.pop(null); - return new StackEffect(2,0,0,0); } //}}} } diff --git a/factor/primitives/Execute.java b/factor/primitives/Execute.java new file mode 100644 index 0000000000..841c5c1f8a --- /dev/null +++ b/factor/primitives/Execute.java @@ -0,0 +1,52 @@ +/* :folding=explicit:collapseFolds=1: */ + +/* + * $Id$ + * + * Copyright (C) 2003, 2004 Slava Pestov. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND + * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +package factor.primitives; + +import factor.compiler.*; +import factor.*; +import java.lang.reflect.*; +import java.util.Set; +import org.objectweb.asm.*; + +public class Execute extends FactorWordDefinition +{ + //{{{ Execute constructor + public Execute(FactorWord word) + { + super(word); + } //}}} + + //{{{ eval() method + public void eval(FactorInterpreter interp) + throws Exception + { + interp.eval(interp.datastack.pop()); + } //}}} +} diff --git a/factor/primitives/Get.java b/factor/primitives/Get.java index 868d4d148e..2c7fb78562 100644 --- a/factor/primitives/Get.java +++ b/factor/primitives/Get.java @@ -31,7 +31,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; -import java.util.Set; +import java.util.Map; public class Get extends FactorWordDefinition { @@ -58,12 +58,11 @@ public class Get extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,1); state.pop(null); state.push(null); - return new StackEffect(1,1,0,0); } //}}} } diff --git a/factor/primitives/JInvoke.java b/factor/primitives/JInvoke.java index 0612543689..cb6905e995 100644 --- a/factor/primitives/JInvoke.java +++ b/factor/primitives/JInvoke.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JInvoke extends FactorWordDefinition @@ -57,8 +57,8 @@ public class JInvoke extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws Exception { state.ensure(state.datastack,4); Object clazz = state.popLiteral(); @@ -75,31 +75,31 @@ public class JInvoke extends FactorWordDefinition (String)name, (Cons)args); - boolean returnValue = method.getReturnType() == Void.TYPE; + boolean returnValue = (method.getReturnType() != Void.TYPE); + + int params = method.getParameterTypes().length; + state.consume(state.datastack,params); if(returnValue) state.push(null); - return new StackEffect( - 4 + method.getParameterTypes().length, - returnValue ? 0 : 1,0,0); } else - return null; + throw new FactorCompilerException("Cannot deduce stack effect of " + word + " with non-literal arguments"); } //}}} - //{{{ compileCallTo() method + //{{{ compileImmediate() method /** * Compile a call to this word. Returns maximum JVM stack use. * XXX: does not use factor type system conversions. */ - public int compileCallTo( + public int compileImmediate( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _method = allocator.popLiteral(); - Object _clazz = allocator.popLiteral(); - Object _args = allocator.popLiteral(); + Object _method = compiler.popLiteral(); + Object _clazz = compiler.popLiteral(); + Object _args = compiler.popLiteral(); if(_method instanceof String && _clazz instanceof String && (_args == null || _args instanceof Cons)) @@ -116,10 +116,10 @@ public class JInvoke extends FactorWordDefinition FactorJava.generateToConversionPre(mw,returnType); - allocator.pop(mw); + compiler.pop(mw); FactorJava.generateFromConversion(mw,cls); - allocator.generateArgs(mw,args.length,args); + compiler.generateArgs(mw,args.length,args); int opcode; if(cls.isInterface()) @@ -135,7 +135,7 @@ public class JInvoke extends FactorWordDefinition if(returnType != Void.TYPE) { FactorJava.generateToConversion(mw,returnType); - allocator.push(mw); + compiler.push(mw); } return 4 + args.length; diff --git a/factor/primitives/JInvokeStatic.java b/factor/primitives/JInvokeStatic.java index 376ec8ea2e..5dc721ceb4 100644 --- a/factor/primitives/JInvokeStatic.java +++ b/factor/primitives/JInvokeStatic.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JInvokeStatic extends FactorWordDefinition @@ -56,8 +56,8 @@ public class JInvokeStatic extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws Exception { state.ensure(state.datastack,3); Object clazz = state.popLiteral(); @@ -73,31 +73,31 @@ public class JInvokeStatic extends FactorWordDefinition (String)name, (Cons)args); - boolean returnValue = method.getReturnType() == Void.TYPE; + boolean returnValue = (method.getReturnType() != Void.TYPE); + int params = method.getParameterTypes().length; + + state.consume(state.datastack,params); if(returnValue) state.push(null); - return new StackEffect( - 3 + method.getParameterTypes().length, - returnValue ? 0 : 1,0,0); } else - return null; + throw new FactorCompilerException("Cannot deduce stack effect of " + word + " with non-literal arguments");; } //}}} - //{{{ compileCallTo() method + //{{{ compileImmediate() method /** * Compile a call to this word. Returns maximum JVM stack use. * XXX: does not use factor type system conversions. */ - public int compileCallTo( + public int compileImmediate( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _method = allocator.popLiteral(); - Object _clazz = allocator.popLiteral(); - Object _args = allocator.popLiteral(); + Object _method = compiler.popLiteral(); + Object _clazz = compiler.popLiteral(); + Object _args = compiler.popLiteral(); if(_method instanceof String && _clazz instanceof String && (_args == null || _args instanceof Cons)) @@ -114,7 +114,7 @@ public class JInvokeStatic extends FactorWordDefinition FactorJava.generateToConversionPre(mw,returnType); - allocator.generateArgs(mw,args.length,args); + compiler.generateArgs(mw,args.length,args); mw.visitMethodInsn(INVOKESTATIC, clazz, @@ -125,7 +125,7 @@ public class JInvokeStatic extends FactorWordDefinition if(returnType != Void.TYPE) { FactorJava.generateToConversion(mw,returnType); - allocator.push(mw); + compiler.push(mw); } return 4 + args.length; diff --git a/factor/primitives/JNew.java b/factor/primitives/JNew.java index c5b6c0421f..16399e6492 100644 --- a/factor/primitives/JNew.java +++ b/factor/primitives/JNew.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JNew extends FactorWordDefinition @@ -59,8 +59,8 @@ public class JNew extends FactorWordDefinition /** * XXX: does not use factor type system conversions. */ - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws Exception + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws Exception { state.ensure(state.datastack,2); @@ -74,28 +74,27 @@ public class JNew extends FactorWordDefinition (String)clazz, (Cons)args); + int params = constructor.getParameterTypes().length; + state.consume(state.datastack,params); state.push(null); - return new StackEffect( - 2 + constructor.getParameterTypes() - .length,1,0,0); } else - return null; + throw new FactorCompilerException("Cannot deduce stack effect of " + word + " with non-literal arguments");; } //}}} - //{{{ compileCallTo() method + //{{{ compileImmediate() method /** * Compile a call to this word. Returns maximum JVM stack use. * XXX: does not use factor type system conversions. */ - public int compileCallTo( + public int compileImmediate( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _clazz = allocator.popLiteral(); - Object _args = allocator.popLiteral(); + Object _clazz = compiler.popLiteral(); + Object _args = compiler.popLiteral(); if(_clazz instanceof String && (_args == null || _args instanceof Cons)) { @@ -107,7 +106,7 @@ public class JNew extends FactorWordDefinition mw.visitTypeInsn(NEW,clazz); mw.visitInsn(DUP); - allocator.generateArgs(mw,args.length,args); + compiler.generateArgs(mw,args.length,args); mw.visitMethodInsn(INVOKESPECIAL, clazz, @@ -115,7 +114,7 @@ public class JNew extends FactorWordDefinition FactorJava.javaSignatureToVMSignature( args,void.class)); - allocator.push(mw); + compiler.push(mw); return 3 + args.length; } diff --git a/factor/primitives/JVarGet.java b/factor/primitives/JVarGet.java index 7bcf82ce1d..4be8233d9c 100644 --- a/factor/primitives/JVarGet.java +++ b/factor/primitives/JVarGet.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JVarGet extends FactorWordDefinition @@ -57,15 +57,14 @@ public class JVarGet extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,3); state.pop(null); state.pop(null); state.pop(null); state.push(null); - return new StackEffect(3,1,0,0); } //}}} //{{{ compileCallTo() method @@ -75,12 +74,12 @@ public class JVarGet extends FactorWordDefinition */ public int compileCallTo( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _field = allocator.popLiteral(); - Object _clazz = allocator.popLiteral(); + Object _field = compiler.popLiteral(); + Object _clazz = compiler.popLiteral(); if(_clazz instanceof String && _field instanceof String) { @@ -92,7 +91,7 @@ public class JVarGet extends FactorWordDefinition FactorJava.generateToConversionPre(mw,fld.getType()); - allocator.pop(mw); + compiler.pop(mw); FactorJava.generateFromConversion(mw,cls); mw.visitFieldInsn(GETFIELD,clazz,field, @@ -100,7 +99,7 @@ public class JVarGet extends FactorWordDefinition FactorJava.generateToConversion(mw,fld.getType()); - allocator.push(mw); + compiler.push(mw); return 2; } diff --git a/factor/primitives/JVarGetStatic.java b/factor/primitives/JVarGetStatic.java index 2d1113242f..9ccbc984e9 100644 --- a/factor/primitives/JVarGetStatic.java +++ b/factor/primitives/JVarGetStatic.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JVarGetStatic extends FactorWordDefinition @@ -56,14 +56,13 @@ public class JVarGetStatic extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,2); state.pop(null); state.pop(null); state.push(null); - return new StackEffect(2,1,0,0); } //}}} //{{{ compileCallTo() method @@ -73,12 +72,12 @@ public class JVarGetStatic extends FactorWordDefinition */ public int compileCallTo( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _field = allocator.popLiteral(); - Object _clazz = allocator.popLiteral(); + Object _field = compiler.popLiteral(); + Object _clazz = compiler.popLiteral(); if(_clazz instanceof String && _field instanceof String) { @@ -95,7 +94,7 @@ public class JVarGetStatic extends FactorWordDefinition FactorJava.generateToConversion(mw,fld.getType()); - allocator.push(mw); + compiler.push(mw); return 2; } diff --git a/factor/primitives/JVarSet.java b/factor/primitives/JVarSet.java index 7b75ca112a..092621ec72 100644 --- a/factor/primitives/JVarSet.java +++ b/factor/primitives/JVarSet.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JVarSet extends FactorWordDefinition @@ -58,15 +58,14 @@ public class JVarSet extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,4); state.pop(null); state.pop(null); state.pop(null); state.pop(null); - return new StackEffect(4,0,0,0); } //}}} //{{{ compileCallTo() method @@ -76,12 +75,12 @@ public class JVarSet extends FactorWordDefinition */ public int compileCallTo( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _field = allocator.popLiteral(); - Object _clazz = allocator.popLiteral(); + Object _field = compiler.popLiteral(); + Object _clazz = compiler.popLiteral(); if(_clazz instanceof String && _field instanceof String) { @@ -91,10 +90,10 @@ public class JVarSet extends FactorWordDefinition clazz = clazz.replace('.','/'); Field fld = cls.getField(field); - allocator.pop(mw); + compiler.pop(mw); FactorJava.generateFromConversion(mw,cls); - allocator.pop(mw); + compiler.pop(mw); FactorJava.generateFromConversion(mw,fld.getType()); mw.visitFieldInsn(PUTFIELD, diff --git a/factor/primitives/JVarSetStatic.java b/factor/primitives/JVarSetStatic.java index ad68057492..46e078d38a 100644 --- a/factor/primitives/JVarSetStatic.java +++ b/factor/primitives/JVarSetStatic.java @@ -32,7 +32,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; import java.lang.reflect.*; -import java.util.Set; +import java.util.Map; import org.objectweb.asm.*; public class JVarSetStatic extends FactorWordDefinition @@ -56,14 +56,13 @@ public class JVarSetStatic extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,3); state.pop(null); state.pop(null); state.pop(null); - return new StackEffect(3,0,0,0); } //}}} //{{{ compileCallTo() method @@ -73,12 +72,12 @@ public class JVarSetStatic extends FactorWordDefinition */ public int compileCallTo( CodeVisitor mw, - LocalAllocator allocator, - Set recursiveCheck) + FactorCompiler compiler, + RecursiveState recursiveCheck) throws Exception { - Object _field = allocator.popLiteral(); - Object _clazz = allocator.popLiteral(); + Object _field = compiler.popLiteral(); + Object _clazz = compiler.popLiteral(); if(_clazz instanceof String && _field instanceof String) { @@ -88,7 +87,7 @@ public class JVarSetStatic extends FactorWordDefinition clazz = clazz.replace('.','/'); Field fld = cls.getField(field); - allocator.pop(mw); + compiler.pop(mw); FactorJava.generateFromConversion(mw,fld.getType()); mw.visitFieldInsn(PUTSTATIC, diff --git a/factor/primitives/Set.java b/factor/primitives/Set.java index 9a58151394..1510813121 100644 --- a/factor/primitives/Set.java +++ b/factor/primitives/Set.java @@ -31,6 +31,7 @@ package factor.primitives; import factor.compiler.*; import factor.*; +import java.util.Map; public class Set extends FactorWordDefinition { @@ -59,12 +60,11 @@ public class Set extends FactorWordDefinition } //}}} //{{{ getStackEffect() method - public StackEffect getStackEffect(java.util.Set recursiveCheck, - LocalAllocator state) throws FactorStackException + public void getStackEffect(RecursiveState recursiveCheck, + FactorCompiler state) throws FactorStackException { state.ensure(state.datastack,2); state.pop(null); state.pop(null); - return new StackEffect(2,0,0,0); } //}}} } diff --git a/factor/stream.factor b/factor/stream.factor index 7f91733950..0d8ff860f7 100644 --- a/factor/stream.factor +++ b/factor/stream.factor @@ -25,6 +25,9 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +"user.home" system-property @~ +"file.separator" system-property @/ + : ( -- stream ) ! Create a stream object. A stream is a namespace with the ! following entries: @@ -42,6 +45,8 @@ [ "freadln not implemented." break ] @freadln ( string -- ) [ "fwrite not implemented." break ] @fwrite + ( string -- ) + [ "fedit not implemented." break ] @fedit ( -- ) [ ] @fflush ( -- ) @@ -165,6 +170,12 @@ : fwrite ( string stream -- ) [ $fwrite call ] bind ; +: fedit ( string stream -- ) + [ $fedit call ] bind ; + +: edit ( string -- ) + $stdio fedit ; + : fclose ( stream -- ) [ $fclose call ] bind ; @@ -175,14 +186,8 @@ [ "java.io.InputStream" "java.io.OutputStream" ] "factor.FactorLib" "copy" jinvoke-static ; -"java.lang.System" "in" jvar-static$ @stdin -"java.lang.System" "out" jvar-static$ @stdout -$stdin $stdout @stdio - -!(file -- freader) -| [ - [ |java.lang.String ] |java.io.FileReader jnew -] define +: ( file -- freader ) + [ |java.lang.String ] |java.io.FileReader jnew ; : (path -- file) dup "java.io.File" is not [ @@ -206,10 +211,8 @@ $stdin $stdout @stdio [ "java.io.File" ] "java.io.File" "renameTo" jinvoke ; -!(string -- reader) -| [ - [ |java.lang.String ] |java.io.StringReader jnew -] define +: (string -- reader) + [ |java.lang.String ] |java.io.StringReader jnew ; : close (stream --) dup "java.io.Reader" is [ @@ -222,18 +225,18 @@ $stdin $stdout @stdio [ [ "java.lang.String" ] ] "factor.FactorLib" "exec" jinvoke-static ; -!(stream -- string) -|read* [ - [ ] |java.io.BufferedReader |readLine jinvoke -] define +: print-numbered-list* ( number list -- ) + ! Print each element of the list with a number. + dup [ + uncons [ over pred ] dip print-numbered-list* + ": " swap cat3 print + ] [ + 2drop + ] ifte ; -: print* (string stream --) - tuck write* - "\n" swap write* ; +: print-numbered-list ( list -- ) + dup length pred swap print-numbered-list* ; -!(string stream --) -|write* [ - tuck - [ |java.lang.String ] |java.io.Writer |write jinvoke - [ ] |java.io.Writer |flush jinvoke -] define +"java.lang.System" "in" jvar-static$ @stdin +"java.lang.System" "out" jvar-static$ @stdout +$stdin $stdout @stdio diff --git a/factor/strings.factor b/factor/strings.factor index a88827cee6..c47d699e3d 100644 --- a/factor/strings.factor +++ b/factor/strings.factor @@ -35,10 +35,6 @@ ! [ #\" , """ ] ] @entities -: >str ( obj -- string ) - ! Returns the Java string representation of this object. - [ ] "java.lang.Object" "toString" jinvoke ; - : >bytes ( string -- array ) ! Converts a string to an array of ASCII bytes. An exception ! is thrown if the string contains non-ASCII characters. @@ -46,6 +42,19 @@ [ "java.lang.String" ] "java.lang.String" "getBytes" jinvoke ; +: >lower ( str -- str ) + [ ] "java.lang.String" "toLowerCase" jinvoke ; + +: >str ( obj -- string ) + ! Returns the Java string representation of this object. + [ ] "java.lang.Object" "toString" jinvoke ; + +: >title ( str -- str ) + 1 str/ [ >upper ] dip >lower cat2 ; + +: >upper ( str -- str ) + [ ] "java.lang.String" "toUpperCase" jinvoke ; + : ( -- StringBuffer ) [ ] "java.lang.StringBuffer" jnew ; @@ -67,12 +76,15 @@ : cat4 ( "a" "b" "c" "d" -- "abcd" ) [ ] cons cons cons cons cat ; +: cat5 ( "a" "b" "c" "d" "e" -- "abcde" ) + [ ] cons cons cons cons cons cat ; + : char? ( obj -- boolean ) "java.lang.Character" is ; : chars>entities ( str -- str ) ! Convert <, >, &, ' and " to HTML entities. - [ dup $entities assoc dup [ nip ] [ drop ] ifte ] strmap ; + [ dup $entities assoc dup rot ? ] str-map ; : group ( index match -- ) [ "int" ] "java.util.regex.Matcher" "group" @@ -151,6 +163,10 @@ jinvoke-static ] when ; +: spaces ( len -- str ) + ! Returns a string containing the given number of spaces. + swap [ " " swap sbuf-append ] times >str ; + : split ( string split -- list ) 2dup index-of dup -1 = [ 2drop unit @@ -158,16 +174,27 @@ swap [ str// ] dip split cons ] ifte ; +: string? ( obj -- ? ) + "java.lang.String" is ; + +: str->=< ( str1 str2 -- n ) + swap [ "java.lang.String" ] "java.lang.String" "compareTo" + jinvoke ; + +: str-lexi> ( str1 str2 -- ? ) + ! Returns if the first string lexicographically follows str2 + str->=< 0 > ; + : str/ ( str index -- str str ) ! Returns 2 strings, that when concatenated yield the ! original string. - 2dup strtail [ str-head ] dip ; + 2dup str-tail [ str-head ] dip ; : str// ( str index -- str str ) ! Returns 2 strings, that when concatenated yield the ! original string, without the character at the given ! index. - 2dup succ strtail [ str-head ] dip ; + 2dup succ str-tail [ str-head ] dip ; : str-each ( str [ code ] -- ) ! Execute the code, with each character of the string pushed @@ -205,12 +232,15 @@ : str-length> ( str str -- boolean ) ! Compare string lengths. - [ str-length ] apply2 > ; + [ str-length ] 2apply > ; : str-map ( str [ code ] -- [ mapping ] ) 2list restack str-each unstack cat ; -: strtail ( str index -- str ) +: str-contains ( substr str -- ? ) + swap index-of -1 = not ; + +: str-tail ( str index -- str ) ! Returns a new string, from the given index until the end ! of the string. over str-length rot substring ; diff --git a/factor/test/combinators.factor b/factor/test/combinators.factor new file mode 100644 index 0000000000..58ad7f9196 --- /dev/null +++ b/factor/test/combinators.factor @@ -0,0 +1,6 @@ +! Tests the combinators. + +"Checking combinators." print + +[ ] [ 3 ] [ [ ] cond ] test-word +[ t ] [ 4 ] [ [ [ 1 = ] [ ] [ 4 = ] [ drop t ] [ 2 = ] [ ] ] cond ] test-word diff --git a/factor/test/compiler.factor b/factor/test/compiler.factor new file mode 100644 index 0000000000..a63cf73702 --- /dev/null +++ b/factor/test/compiler.factor @@ -0,0 +1,55 @@ +! Compiler tests + +"Checking compiler." print + +[ 1 2 3 ] [ 4 5 6 ] [ t [ drop drop drop 1 2 3 ] when ] test-word +[ 4 5 6 ] [ 4 5 6 ] [ f [ drop drop drop 1 2 3 ] when ] test-word + +[ t ] [ t ] [ [ t ] [ f ] rot [ drop call ] [ nip call ] ifte ] test-word +[ f ] [ f ] [ [ t ] [ f ] rot [ drop call ] [ nip call ] ifte ] test-word +[ 4 ] [ 2 ] [ t [ 2 ] [ 3 ] ifte + ] test-word +[ 5 ] [ 2 ] [ f [ 2 ] [ 3 ] ifte + ] test-word + +: stack-frame-test ( x -- x ) + >r t [ r> ] [ rdrop 11 ] ifte ; + +[ 10 ] [ 10 ] [ stack-frame-test ] test-word + +: balance>list ( quotation -- list ) + balance effect>list ; + +[ [ 1 1 0 0 ] ] [ [ sq ] ] [ balance>list ] test-word +[ [ 2 1 0 0 ] ] [ [ mag2 ] ] [ balance>list ] test-word +[ [ 2 1 0 0 ] ] [ [ append ] ] [ balance>list ] test-word +[ [ 1 1 0 0 ] ] [ [ fac ] ] [ balance>list ] test-word +[ [ 1 1 0 0 ] ] [ [ fib ] ] [ balance>list ] test-word + +[ [ 1 1 0 0 ] ] [ [ dup [ sq ] when ] ] [ balance>list ] test-word + +: test-null-rec ( -- ) + [ [ 0 0 0 0 ] ] [ [ null-rec ] ] [ balance>list ] test-word ; + +: null-rec ( -- ) + t [ null-rec ] when ; compile-maybe test-null-rec + +: null-rec ( -- ) + t [ null-rec ] unless ; compile-maybe test-null-rec + +: null-rec ( -- ) + t [ drop null-rec ] when* ; compile-maybe test-null-rec + +!: null-rec ( -- ) +! t [ t null-rec ] unless* drop ; compile-maybe test-null-rec + +[ f 1 2 3 ] [ [ [ 2 , 1 ] ] 3 ] [ [ unswons unswons ] dip ] test-word + +[ [ 2 1 0 0 ] ] [ [ >r [ ] [ ] ? call r> ] ] [ balance>list ] test-word + +: nested-rec ( -- ) + t [ nested-rec ] when ; compile-maybe + +: nested-rec-test ( -- ) + 5 nested-rec drop ; compile-maybe + +[ [ 0 0 0 0 ] ] [ [ nested-rec-test ] ] [ balance>list ] test-word +"All compiler checks passed." print diff --git a/factor/test/dictionary.factor b/factor/test/dictionary.factor new file mode 100644 index 0000000000..4de526e5a6 --- /dev/null +++ b/factor/test/dictionary.factor @@ -0,0 +1,37 @@ +! Tests the dictionary words. + +"Checking dictionary words." print + +! Just make sure this works. + +! OUTPUT INPUT WORD +[ ] [ "httpd" ] [ apropos ] test-word +[ t ] [ "ifte" ] [ worddef compound? ] test-word +[ t ] [ "dup" ] [ worddef shuffle? ] test-word +[ f ] [ "ifte" ] [ worddef shuffle? ] test-word +[ f ] [ "dup" ] [ worddef compound? ] test-word + +! Test word iternalization. + +: gensym-test ( -- ? ) + f 10 [ gensym gensym = and ] times ; + +[ f ] [ ] [ gensym-test ] test-word + +: intern-test ( 1 2 -- ? ) + [ intern ] 2apply = ; + +[ t ] [ "a" "a" ] [ intern-test ] test-word +[ f ] [ "a" "A" ] [ intern-test ] test-word +[ f ] [ "a" "B" ] [ intern-test ] test-word +[ f ] [ "a" "a" ] [ swap intern = ] test-word + +: worddef>list-test ( -- ? ) + [ dup * ] dup no-name worddef>list cdr cdr = ; + +[ t ] [ ] [ worddef>list-test ] test-word + +: words-test ( -- ? ) + t words [ word? and ] each ; + +[ t ] [ ] [ words-test ] test-word diff --git a/factor/test/list.factor b/factor/test/list.factor new file mode 100644 index 0000000000..6db6192fe0 --- /dev/null +++ b/factor/test/list.factor @@ -0,0 +1,153 @@ +! Tests the list words. + +"Checking list words." print + +! OUTPUT INPUT WORD +[ [ 1 2 ] ] [ 1 2 ] [ 2list ] test-word +[ [ 1 2 3 ] ] [ 1 2 3 ] [ 3list ] test-word +[ [ 2 1 ] ] [ 1 2 ] [ 2rlist ] test-word + +[ [ ] ] [ [ ] [ ] ] [ append ] test-word +[ [ 1 ] ] [ [ 1 ] [ ] ] [ append ] test-word +[ [ 2 ] ] [ [ ] [ 2 ] ] [ append ] test-word +[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] ] [ append ] test-word + +[ [ 1 2 3 4 ] ] [ [ 3 4 ] [ 1 2 ] ] [ @x "x" append@ $x ] test-word + +[ [ ] ] [ [ ] ] [ array>list ] test-word +[ [ 1 2 3 ] ] [ [ 1 2 3 ] ] [ array>list ] test-word + +[ [ 1 2 3 4 ] ] [ 4 [ 1 2 3 ] ] [ @x "x" add@ $x ] test-word + +[ + [ "monkey" , 1 ] + [ "banana" , 2 ] + [ "Java" , 3 ] + [ t , "true" ] + [ f , "false" ] + [ [ 1 2 ] , [ 2 1 ] ] +] @assoc + +[ f ] [ "monkey" f ] [ assoc ] test-word +[ f ] [ "donkey" $assoc ] [ assoc ] test-word +[ 1 ] [ "monkey" $assoc ] [ assoc ] test-word +[ "false" ] [ f $assoc ] [ assoc ] test-word +[ [ 2 1 ] ] [ [ 1 2 ] $assoc ] [ assoc ] test-word + +f @monkey +t @donkey +[ 1 2 ] @lisp + +[ + [ "monkey" , 1 ] + [ "donkey" , 2 ] + [ "lisp" , [ 2 1 ] ] +] @assoc + +[ 1 ] [ f $assoc ] [ assoc$ ] test-word +[ [ 2 1 ] ] [ [ 1 2 ] $assoc ] [ assoc$ ] test-word + +[ 1 ] [ [ 1 , 2 ] ] [ car ] test-word +[ 2 ] [ [ 1 , 2 ] ] [ cdr ] test-word + +[ [ ] ] [ [ ] ] [ clone-list ] test-word +[ [ 1 2 , 3 ] ] [ [ 1 2 , 3 ] ] [ clone-list ] test-word +[ [ 1 2 3 4 ] ] [ [ 1 2 3 4 ] ] [ clone-list ] test-word + +: clone-list-actually-clones? ( list1 list2 -- ) + [ clone-list ] dip ! we don't want to mutate literals + [ dup clone-list ] dip nappend = not ; + +[ t ] [ [ 1 2 ] [ 3 4 ] ] [ clone-list-actually-clones? ] test-word + +[ [ 1 , 2 ] ] [ 1 2 ] [ cons ] test-word +[ [ 1 ] ] [ 1 f ] [ cons ] test-word + +[ f ] [ 3 [ ] ] [ contains ] test-word +[ f ] [ 3 [ 1 2 ] ] [ contains ] test-word +[ [ 1 2 ] ] [ 1 [ 1 2 ] ] [ contains ] test-word +[ [ 2 ] ] [ 2 [ 1 2 ] ] [ contains ] test-word + +[ [ 1 ] ] [ 1 f ] [ @x "x" cons@ $x ] test-word +[ [ 1 , 2 ] ] [ 1 2 ] [ @x "x" cons@ $x ] test-word +[ [ 1 2 ] ] [ 1 [ 2 ] ] [ @x "x" cons@ $x ] test-word + +[ [ ] ] [ 0 ] [ count ] test-word +[ [ ] ] [ -10 ] [ count ] test-word +[ [ ] ] [ $-inf ] [ count ] test-word +[ [ 0 1 2 ] ] [ $e ] [ count ] test-word +[ [ 0 1 2 3 ] ] [ 4 ] [ count ] test-word + +[ 1 ] [ [ 1 2 ] -1 ] [ get ] test-word +[ 1 ] [ [ 1 2 ] 0 ] [ get ] test-word +[ 2 ] [ [ 1 2 ] 1 ] [ get ] test-word + +[ [ 3 ] ] [ [ 3 ] ] [ last* ] test-word +[ [ 3 ] ] [ [ 1 2 3 ] ] [ last* ] test-word +[ [ 3 , 4 ] ] [ [ 1 2 3 , 4 ] ] [ last* ] test-word + +[ 3 ] [ [ 3 ] ] [ last ] test-word +[ 3 ] [ [ 1 2 3 ] ] [ last ] test-word +[ 3 ] [ [ 1 2 3 , 4 ] ] [ last ] test-word + +[ 0 ] [ [ ] ] [ length ] test-word +[ 3 ] [ [ 1 2 3 ] ] [ length ] test-word + +! CMU CL bombs on (length '(1 2 3 . 4)) +![ 3 ] [ [ 1 2 3 , 4 ] ] [ length ] test-word + +[ t ] [ f ] [ list? ] test-word +[ f ] [ t ] [ list? ] test-word +[ t ] [ [ 1 2 ] ] [ list? ] test-word +[ f ] [ [ 1 , 2 ] ] [ list? ] test-word + +: clone-and-nappend ( list list -- list ) + [ clone-list ] 2apply nappend ; + +[ [ ] ] [ [ ] [ ] ] [ clone-and-nappend ] test-word +[ [ 1 ] ] [ [ 1 ] [ ] ] [ clone-and-nappend ] test-word +[ [ 2 ] ] [ [ ] [ 2 ] ] [ clone-and-nappend ] test-word +[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] ] [ clone-and-nappend ] test-word + +[ 1 2 3 ] clone-list @x [ 4 5 6 ] clone-list @y + +[ [ 4 5 6 ] ] [ $x $y ] [ nappend drop $y ] test-word + +[ 1 2 3 ] clone-list @x [ 4 5 6 ] clone-list @y + +[ [ 1 2 3 4 5 6 ] ] [ $x $y ] [ nappend drop $x ] test-word + +[ f ] [ f ] [ cons? ] test-word +[ f ] [ t ] [ cons? ] test-word +[ t ] [ [ t , f ] ] [ cons? ] test-word + +[ [ ] ] [ [ ] ] [ reverse ] test-word +[ [ 1 ] ] [ [ 1 ] ] [ reverse ] test-word +[ [ 3 2 1 ] ] [ [ 1 2 3 ] ] [ reverse ] test-word + +[ a , b ] clone-list @x +[ [ 1 , b ] ] [ 1 $x ] [ rplaca $x ] test-word + +[ a , b ] clone-list @x +[ [ a , 2 ] ] [ 2 $x ] [ rplacd $x ] test-word + +[ [ 1 , 2 ] ] [ 2 1 ] [ swons ] test-word +[ [ 1 ] ] [ f 1 ] [ swons ] test-word + +[ [ 1 ] ] [ 1 f ] [ @x "x" swap swons@ $x ] test-word +[ [ 1 , 2 ] ] [ 1 2 ] [ @x "x" swap swons@ $x ] test-word +[ [ 1 2 ] ] [ 1 [ 2 ] ] [ @x "x" swap swons@ $x ] test-word + +[ 1 2 ] [ [ 1 , 2 ] ] [ uncons ] test-word +[ 1 [ 2 ] ] [ [ 1 2 ] ] [ uncons ] test-word + +[ [ 1 2 3 ] ] [ 1 [ 2 3 ] ] [ unique ] test-word +[ [ 1 2 3 ] ] [ 1 [ 1 2 3 ] ] [ unique ] test-word +[ [ 1 2 3 ] ] [ 2 [ 1 2 3 ] ] [ unique ] test-word + +[ [ [ [ ] ] ] ] [ [ ] ] [ unit unit ] test-word + +[ 1 2 ] [ [ 2 , 1 ] ] [ unswons ] test-word +[ [ 2 ] 1 ] [ [ 1 2 ] ] [ unswons ] test-word + +"List checks passed." print diff --git a/factor/test/miscellaneous.factor b/factor/test/miscellaneous.factor new file mode 100644 index 0000000000..553dd7ba8b --- /dev/null +++ b/factor/test/miscellaneous.factor @@ -0,0 +1,22 @@ +! Miscellaneous tests. + +"Miscellaneous tests." print + +: test-last ( -- ) + nop ; +word >str @last-word-test + +[ "test-last" ] [ ] [ $last-word-test ] test-word +[ f ] [ 5 ] [ compound? ] test-word +[ f ] [ 5 ] [ compiled? ] test-word +[ f ] [ 5 ] [ shuffle? ] test-word + +! These stress-test a lot of code. +"prettyprint*" see +"prettyprint*" see/html +$global describe +$global describe/html + +[ t ] [ ] [ [ "global" "stdio" ] object-path $stdio = ] test-word + +"Miscellaneous passed." print diff --git a/factor/test/random.factor b/factor/test/random.factor new file mode 100644 index 0000000000..e83cb00f2a --- /dev/null +++ b/factor/test/random.factor @@ -0,0 +1,13 @@ +! Random tests + +"Checking random number generation." print + +[ + [ 10 , t ] + [ 20 , f ] + [ 30 , "monkey" ] +] @random-pairs + +[ f ] [ $random-pairs ] [ random-element* [ t f "monkey" ] contains not ] test-word + +"Random number checks complete." print diff --git a/factor/test/stack.factor b/factor/test/stack.factor new file mode 100644 index 0000000000..8034c593ae --- /dev/null +++ b/factor/test/stack.factor @@ -0,0 +1,36 @@ +! Test the built-in stack words. + +"Checking stack words." print + +! OUTPUT INPUT WORD +[ ] [ 1 ] [ drop ] test-word +[ ] [ 1 2 ] [ 2drop ] test-word +[ 1 1 ] [ 1 ] [ dup ] test-word +[ 1 2 1 2 ] [ 1 2 ] [ 2dup ] test-word +[ 1 1 2 ] [ 1 2 ] [ dupd ] test-word +[ 1 2 1 2 3 4 ] [ 1 2 3 4 ] [ 2dupd ] test-word +[ 2 ] [ 1 2 ] [ nip ] test-word +[ 3 4 ] [ 1 2 3 4 ] [ 2nip ] test-word +[ ] [ ] [ nop ] test-word +[ 1 2 1 ] [ 1 2 ] [ over ] test-word +[ 1 2 3 4 1 2 ] [ 1 2 3 4 ] [ 2over ] test-word +[ 1 2 3 1 ] [ 1 2 3 ] [ pick ] test-word +[ 2 3 1 ] [ 1 2 3 ] [ rot ] test-word +[ 3 4 5 6 1 2 ] [ 1 2 3 4 5 6 ] [ 2rot ] test-word +[ 3 1 2 ] [ 1 2 3 ] [ -rot ] test-word +[ 5 6 1 2 3 4 ] [ 1 2 3 4 5 6 ] [ 2-rot ] test-word +[ 2 1 ] [ 1 2 ] [ swap ] test-word +[ 3 4 1 2 ] [ 1 2 3 4 ] [ 2swap ] test-word +[ 2 1 3 ] [ 1 2 3 ] [ swapd ] test-word +[ 3 4 1 2 5 6 ] [ 1 2 3 4 5 6 ] [ 2swapd ] test-word +[ 3 2 1 ] [ 1 2 3 ] [ transp ] test-word +[ 5 6 3 4 1 2 ] [ 1 2 3 4 5 6 ] [ 2transp ] test-word +[ 2 1 2 ] [ 1 2 ] [ tuck ] test-word +[ 3 4 1 2 3 4 ] [ 1 2 3 4 ] [ 2tuck ] test-word + +[ ] [ 1 ] [ >r rdrop ] test-word +[ 2 1 2 ] [ 1 2 ] [ >r >r rover r> r> r> ] test-word +[ 2 1 ] [ 1 2 ] [ 2>r r> r> ] test-word +[ 2 1 ] [ 1 2 ] [ >r >r 2r> ] test-word + +"Stack checks passed." print diff --git a/factor/test/test.factor b/factor/test/test.factor new file mode 100644 index 0000000000..f8ee842611 --- /dev/null +++ b/factor/test/test.factor @@ -0,0 +1,40 @@ +! Factor test suite. + +! Some of these words should be moved to the standard library. + +: assert ( t -- ) + [ "Assertion failed!" break ] unless ; + +: assert= ( x y -- ) + = assert ; + +: compile-maybe ( -- ) + $compile [ word compile ] when ; + +: compile-no-name ( list -- ) + no-name compile-maybe ; + +~<< 3dup A B C -- A B C A B C >>~ + +: test-word ( output word input ) + 3dup 3list . + append compile-no-name unit expand assert= ; + +: test ( name -- ) + ! Run the given test. + "/factor/test/" swap ".factor" cat3 runResource ; + +: all-tests ( -- ) + "Running Factor test suite..." print + [ + "combinators" + "compiler" + "dictionary" + "list" + "miscellaneous" + "random" + "stack" + ] [ + test + ] each + "All tests passed." print ; diff --git a/version.factor b/version.factor index 8f2710a217..af9e4a66d1 100644 --- a/version.factor +++ b/version.factor @@ -1 +1 @@ -"0.36" @version +"0.53" @version