release
import-0.53
nomennescio
parent
e29a64334c
commit
fc8c5b6fec
98
.cvskeywords
98
.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 $
|
||||
|
|
|
|||
|
|
@ -119,6 +119,35 @@ public class Cons implements PublicCloneable, FactorExternalizable
|
|||
return size;
|
||||
} //}}}
|
||||
|
||||
//{{{ nappend() method
|
||||
public static Cons nappend(Cons l1, Cons l2)
|
||||
{
|
||||
if(l1 == null)
|
||||
return l2;
|
||||
if(l2 == null)
|
||||
return l1;
|
||||
Cons last = l1;
|
||||
while(last.cdr != null)
|
||||
last = last.next();
|
||||
last.cdr = l2;
|
||||
return l1;
|
||||
} //}}}
|
||||
|
||||
//{{{ assoc() method
|
||||
public static Object assoc(Cons assoc, Object key)
|
||||
{
|
||||
if(assoc == null)
|
||||
return null;
|
||||
else
|
||||
{
|
||||
Cons first = (Cons)assoc.car;
|
||||
if(FactorLib.equal(first.car,key))
|
||||
return first.cdr;
|
||||
else
|
||||
return assoc(assoc.next(),key);
|
||||
}
|
||||
} //}}}
|
||||
|
||||
//{{{ isProperList() method
|
||||
public boolean isProperList()
|
||||
{
|
||||
|
|
@ -140,7 +169,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
|
|||
if(iter.car == this)
|
||||
buf.append("<circular reference>");
|
||||
else
|
||||
buf.append(FactorJava.factorTypeToString(iter.car));
|
||||
buf.append(FactorParser.unparse(iter.car));
|
||||
if(iter.cdr instanceof Cons)
|
||||
{
|
||||
buf.append(' ');
|
||||
|
|
@ -152,7 +181,7 @@ public class Cons implements PublicCloneable, FactorExternalizable
|
|||
else
|
||||
{
|
||||
buf.append(" , ");
|
||||
buf.append(FactorJava.factorTypeToString(iter.cdr));
|
||||
buf.append(FactorParser.unparse(iter.cdr));
|
||||
iter = null;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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();
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
"<init>",
|
||||
"(Lfactor/FactorWord;Lfactor/compiler/StackEffect;)V",
|
||||
"(Lfactor/FactorWord;"
|
||||
+ "Lfactor/compiler/StackEffect;"
|
||||
+ "Lfactor/Cons;)V",
|
||||
null, null);
|
||||
// pushes the 'this' variable
|
||||
mw.visitVarInsn(ALOAD, 0);
|
||||
|
|
@ -176,34 +175,27 @@ public class FactorCompoundDefinition extends FactorWordDefinition
|
|||
mw.visitVarInsn(ALOAD, 1);
|
||||
// pushes the stack effect parameter
|
||||
mw.visitVarInsn(ALOAD, 2);
|
||||
// pushes the definition parameter
|
||||
mw.visitVarInsn(ALOAD, 3);
|
||||
// invokes the super class constructor
|
||||
mw.visitMethodInsn(INVOKESPECIAL,
|
||||
"factor/compiler/CompiledDefinition", "<init>",
|
||||
"(Lfactor/FactorWord;Lfactor/compiler/StackEffect;)V");
|
||||
"(Lfactor/FactorWord;"
|
||||
+ "Lfactor/compiler/StackEffect;"
|
||||
+ "Lfactor/Cons;)V");
|
||||
mw.visitInsn(RETURN);
|
||||
mw.visitMaxs(3, 3);
|
||||
} //}}}
|
||||
|
||||
//{{{ 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();
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
} //}}}
|
||||
}
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
/*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright (C) 2003 Slava Pestov.
|
||||
* Copyright (C) 2003, 2004 Slava Pestov.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
|
|
@ -29,6 +29,7 @@
|
|||
|
||||
package factor;
|
||||
|
||||
import factor.primitives.*;
|
||||
import java.io.*;
|
||||
|
||||
public class FactorInterpreter
|
||||
|
|
@ -41,53 +42,20 @@ public class FactorInterpreter
|
|||
public boolean trace = false;
|
||||
public boolean errorFlag = false;
|
||||
public boolean compile = true;
|
||||
public boolean compileDump = false;
|
||||
public boolean dump = false;
|
||||
|
||||
public FactorCallFrame callframe;
|
||||
public FactorCallStack callstack = new FactorCallStack();
|
||||
public FactorDataStack datastack = new FactorDataStack();
|
||||
public final FactorDictionary dict = new FactorDictionary();
|
||||
public FactorNamespace dict;
|
||||
public FactorWord last;
|
||||
public FactorNamespace global;
|
||||
|
||||
//{{{ main() method
|
||||
/**
|
||||
* Need to refactor this into Factor.
|
||||
*/
|
||||
public static void main(String[] args) throws Exception
|
||||
{
|
||||
FactorInterpreter interp = new FactorInterpreter();
|
||||
|
||||
interp.init(args,null);
|
||||
|
||||
/* if(virgin)
|
||||
{
|
||||
System.out.println("Mini-interpreter");
|
||||
BufferedReader in = new BufferedReader(
|
||||
new InputStreamReader(
|
||||
System.in));
|
||||
String line;
|
||||
for(;;)
|
||||
{
|
||||
System.out.print("] ");
|
||||
System.out.flush();
|
||||
line = in.readLine();
|
||||
if(line == null)
|
||||
break;
|
||||
|
||||
FactorParser parser = new FactorParser(
|
||||
"<mini>",new StringReader(line),
|
||||
interp.dict);
|
||||
Cons parsed = parser.parse();
|
||||
interp.call(parsed);
|
||||
interp.run();
|
||||
System.out.println(interp.datastack);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
interp.run();
|
||||
} */
|
||||
|
||||
System.exit(0);
|
||||
} //}}}
|
||||
|
||||
|
|
@ -98,12 +66,81 @@ public class FactorInterpreter
|
|||
|
||||
callstack.top = 0;
|
||||
datastack.top = 0;
|
||||
dict.init();
|
||||
initDictionary();
|
||||
initNamespace(root);
|
||||
topLevel();
|
||||
runBootstrap();
|
||||
} //}}}
|
||||
|
||||
//{{{ initDictionary() method
|
||||
private void initDictionary() throws Exception
|
||||
{
|
||||
dict = new FactorNamespace(null,null);
|
||||
|
||||
// data stack primitives
|
||||
FactorWord datastackGet = intern("datastack$");
|
||||
datastackGet.def = new DatastackGet(
|
||||
datastackGet);
|
||||
FactorWord datastackSet = intern("datastack@");
|
||||
datastackSet.def = new DatastackSet(
|
||||
datastackSet);
|
||||
FactorWord clear = intern("clear");
|
||||
clear.def = new Clear(clear);
|
||||
|
||||
// call stack primitives
|
||||
FactorWord callstackGet = intern("callstack$");
|
||||
callstackGet.def = new CallstackGet(
|
||||
callstackGet);
|
||||
FactorWord callstackSet = intern("callstack@");
|
||||
callstackSet.def = new CallstackSet(
|
||||
callstackSet);
|
||||
FactorWord restack = intern("restack");
|
||||
restack.def = new Restack(restack);
|
||||
FactorWord unstack = intern("unstack");
|
||||
unstack.def = new Unstack(unstack);
|
||||
FactorWord unwind = intern("unwind");
|
||||
unwind.def = new Unwind(unwind);
|
||||
|
||||
// reflection primitives
|
||||
FactorWord jinvoke = intern("jinvoke");
|
||||
jinvoke.def = new JInvoke(jinvoke);
|
||||
FactorWord jinvokeStatic = intern("jinvoke-static");
|
||||
jinvokeStatic.def = new JInvokeStatic(
|
||||
jinvokeStatic);
|
||||
FactorWord jnew = intern("jnew");
|
||||
jnew.def = new JNew(jnew);
|
||||
FactorWord jvarGet = intern("jvar$");
|
||||
jvarGet.def = new JVarGet(jvarGet);
|
||||
FactorWord jvarGetStatic = intern("jvar-static$");
|
||||
jvarGetStatic.def = new JVarGetStatic(
|
||||
jvarGetStatic);
|
||||
FactorWord jvarSet = intern("jvar@");
|
||||
jvarSet.def = new JVarSet(jvarSet);
|
||||
FactorWord jvarSetStatic = intern("jvar-static@");
|
||||
jvarSetStatic.def = new JVarSetStatic(
|
||||
jvarSetStatic);
|
||||
|
||||
// namespaces
|
||||
FactorWord get = intern("$");
|
||||
get.def = new Get(get);
|
||||
FactorWord set = intern("@");
|
||||
set.def = new Set(set);
|
||||
|
||||
// definition
|
||||
FactorWord define = intern("define");
|
||||
define.def = new Define(define);
|
||||
|
||||
// combinators
|
||||
FactorWord execute = intern("execute");
|
||||
execute.def = new Execute(execute);
|
||||
FactorWord call = intern("call");
|
||||
call.def = new Call(call);
|
||||
FactorWord bind = intern("bind");
|
||||
bind.def = new Bind(bind);
|
||||
FactorWord choice = intern("?");
|
||||
choice.def = new Choice(choice);
|
||||
} //}}}
|
||||
|
||||
//{{{ initNamespace() method
|
||||
private void initNamespace(Object root) throws Exception
|
||||
{
|
||||
|
|
@ -111,9 +148,14 @@ public class FactorInterpreter
|
|||
|
||||
global.setVariable("interpreter",this);
|
||||
|
||||
String[] boundFields = { "compile", "compileDump",
|
||||
global.setVariable("error-flag",
|
||||
new FactorNamespace.VarBinding(
|
||||
getClass().getField("errorFlag"),
|
||||
this));
|
||||
|
||||
String[] boundFields = { "compile", "dump",
|
||||
"interactive", "trace",
|
||||
"dict", "errorFlag", "args" };
|
||||
"dict", "args", "global", "last" };
|
||||
for(int i = 0; i < boundFields.length; i++)
|
||||
{
|
||||
global.setVariable(boundFields[i],
|
||||
|
|
@ -132,8 +174,8 @@ public class FactorInterpreter
|
|||
new InputStreamReader(
|
||||
getClass().getResourceAsStream(
|
||||
initFile)),
|
||||
dict);
|
||||
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);
|
||||
} //}}}
|
||||
|
|
|
|||
|
|
@ -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())
|
||||
{
|
||||
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())
|
||||
{
|
||||
Class comp = type.getComponentType();
|
||||
if(comp.isPrimitive())
|
||||
{
|
||||
methodName = getConversionMethodName(comp)
|
||||
+ "Array";
|
||||
}
|
||||
else
|
||||
methodName = "toArray";
|
||||
}
|
||||
|
||||
if(methodName == null)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ 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 )");
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -52,32 +52,33 @@ public class FactorParser
|
|||
|
||||
private String filename;
|
||||
private Reader in;
|
||||
private FactorDictionary dict;
|
||||
private FactorInterpreter interp;;
|
||||
private StreamTokenizer st;
|
||||
|
||||
// sometimes one token is expanded into two words
|
||||
private Object next;
|
||||
|
||||
//{{{ FactorParser constructor
|
||||
public FactorParser(String filename, Reader in, FactorDictionary dict)
|
||||
public FactorParser(String filename, Reader in,
|
||||
FactorInterpreter interp)
|
||||
{
|
||||
this.filename = (filename == null ? "<eval>" : filename);
|
||||
this.in = in;
|
||||
this.dict = dict;
|
||||
this.interp = interp;
|
||||
|
||||
DEF = dict.intern(":");
|
||||
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());
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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();*/
|
||||
}
|
||||
} //}}}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
{
|
||||
StackEffect effect = getStackEffect();
|
||||
if(effect == null)
|
||||
{
|
||||
// combinator; inline
|
||||
return compileImmediate(mw,allocator,recursiveCheck);
|
||||
}
|
||||
else
|
||||
public int compileCallTo(CodeVisitor mw, FactorCompiler compiler,
|
||||
RecursiveState recursiveCheck) throws Exception
|
||||
{
|
||||
// normal word
|
||||
mw.visitVarInsn(ALOAD,0);
|
||||
|
||||
allocator.generateArgs(mw,effect.inD,null);
|
||||
String defclass;
|
||||
StackEffect effect;
|
||||
|
||||
String defclass = getClass().getName().replace('.','/');
|
||||
RecursiveForm rec = recursiveCheck.get(word);
|
||||
if(rec != null && rec.active && compiler.word == word)
|
||||
{
|
||||
// recursive call!
|
||||
defclass = compiler.className;
|
||||
effect = compiler.word.def.getStackEffect();
|
||||
}
|
||||
else if(this instanceof FactorCompoundDefinition)
|
||||
{
|
||||
throw new FactorCompilerException("You are an idiot!");
|
||||
}
|
||||
else
|
||||
{
|
||||
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 > 1)
|
||||
throw new FactorCompilerException("Cannot compile word with non-0/1-out factors");
|
||||
if(effect.outD == 1)
|
||||
allocator.push(mw);
|
||||
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;
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
@ -54,6 +54,7 @@
|
|||
~<< 2tuck A B C D -- C D A B C D >>~
|
||||
|
||||
~<< rdrop r:A -- >>~
|
||||
~<< rover r:A r:B -- r:A r:B r:A >>~
|
||||
~<< >r A -- r:A >>~
|
||||
~<< 2>r A B -- r:A r:B >>~
|
||||
~<< r> r:A -- A >>~
|
||||
|
|
@ -73,8 +74,8 @@
|
|||
<ireader> <breader> ;
|
||||
|
||||
: 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
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
|
|
@ -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,8 +175,8 @@
|
|||
! 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
|
||||
|
|
@ -168,18 +188,31 @@
|
|||
! 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.
|
||||
[ 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 ;
|
||||
|
|
|
|||
|
|
@ -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";
|
||||
} //}}}
|
||||
}
|
||||
|
|
@ -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)));
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
@ -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;
|
||||
}
|
||||
} //}}}
|
||||
}
|
||||
|
|
@ -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!");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
@ -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);
|
||||
}
|
||||
} //}}}
|
||||
}
|
||||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
@ -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);
|
||||
} //}}}
|
||||
}
|
||||
|
|
@ -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 )";
|
||||
}
|
||||
}
|
||||
|
|
@ -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());
|
||||
} //}}}
|
||||
|
||||
//{{{ 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;
|
||||
|
||||
Cons iter = definition;
|
||||
while(iter != null)
|
||||
{
|
||||
Object obj = iter.car;
|
||||
if(obj instanceof FactorWord)
|
||||
{
|
||||
StackEffect se = ((FactorWord)obj).def
|
||||
.getStackEffect(
|
||||
recursiveCheck,
|
||||
state);
|
||||
|
||||
if(se == null)
|
||||
if(first == null || second == null)
|
||||
return null;
|
||||
|
||||
if(se.inD <= outD)
|
||||
outD -= se.inD;
|
||||
int inD = first.inD;
|
||||
int inR = first.inR;
|
||||
int outD = first.outD;
|
||||
int outR = first.outR;
|
||||
|
||||
if(second.inD <= outD)
|
||||
outD -= second.inD;
|
||||
else
|
||||
{
|
||||
inD += (se.inD - outD);
|
||||
inD += (second.inD - outD);
|
||||
outD = 0;
|
||||
}
|
||||
|
||||
if(se.inR <= outR)
|
||||
outR -= se.inR;
|
||||
if(second.inR <= outR)
|
||||
outR -= second.inR;
|
||||
else
|
||||
{
|
||||
inR += (se.inR - outR);
|
||||
inR += (second.inR - outR);
|
||||
outR = 0;
|
||||
}
|
||||
|
||||
outD += se.outD;
|
||||
outR += se.outR;
|
||||
}
|
||||
else
|
||||
{
|
||||
outD++;
|
||||
state.pushLiteral(obj);
|
||||
}
|
||||
|
||||
iter = iter.next();
|
||||
}
|
||||
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);
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@
|
|||
: suspend (--)
|
||||
! Suspend the current fiber.
|
||||
! Not really implemented yet.
|
||||
$initialInterpreterContinuation dup [
|
||||
$top-level-continuation dup [
|
||||
call
|
||||
] [
|
||||
clear unwind
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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,32 +53,65 @@
|
|||
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 )
|
||||
"factor.FactorCompoundDefinition" is ;
|
||||
|
||||
: <compound> ( word def -- worddef )
|
||||
[ "factor.FactorWord" "factor.Cons" ]
|
||||
"factor.FactorCompoundDefinition"
|
||||
jnew ;
|
||||
|
||||
: effect ( word -- effect )
|
||||
! Push stack effect of the given word.
|
||||
worddef [ ] "factor.FactorWordDefinition"
|
||||
"getStackEffect" jinvoke ;
|
||||
|
||||
: effect>list ( effect -- effect )
|
||||
[
|
||||
[ "factor.compiler.StackEffect" "inD" jvar$ ]
|
||||
[ "factor.compiler.StackEffect" "outD" jvar$ ]
|
||||
[ "factor.compiler.StackEffect" "inR" jvar$ ]
|
||||
[ "factor.compiler.StackEffect" "outR" jvar$ ]
|
||||
] interleave unit cons cons cons ;
|
||||
|
||||
: gensym ( -- word )
|
||||
[ ] "factor.FactorWord" "gensym" jinvoke-static ;
|
||||
|
||||
: <word> ( name -- word )
|
||||
! Creates a new uninternalized word.
|
||||
[ "java.lang.String" ] "factor.FactorWord" jnew ;
|
||||
|
||||
: intern* ( "word" -- word )
|
||||
dup $ dup [
|
||||
nip
|
||||
] [
|
||||
drop dup $ tuck s@
|
||||
] ifte ;
|
||||
|
||||
: intern ( "word" -- word )
|
||||
! Returns the top of the stack if it already been interned.
|
||||
dup word? [ $dict [ intern* ] bind ] unless ;
|
||||
|
||||
: missing>f ( word -- word/f )
|
||||
! Is it the missing word placeholder? Then push f.
|
||||
dup undefined? [ drop f ] when ;
|
||||
|
||||
: no-name ( list -- word )
|
||||
! Generates an uninternalized word and gives it a compound
|
||||
! definition created from the given list.
|
||||
[ gensym dup dup ] dip <compound> define ;
|
||||
|
||||
: shuffle? ( obj -- boolean )
|
||||
"factor.FactorShuffleDefinition" is ;
|
||||
|
||||
: 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 ;
|
||||
|
||||
: undefined? ( obj -- boolean )
|
||||
"factor.FactorMissingDefinition" is ;
|
||||
|
||||
|
|
@ -79,21 +120,21 @@
|
|||
|
||||
: 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 )
|
||||
! Pushes a list of all defined words.
|
||||
$dict [ ] "factor.FactorDictionary" "toWordList" jinvoke ;
|
||||
$dict [ uvalues ] bind
|
||||
[
|
||||
cdr dup [ drop ] unless
|
||||
] map ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -1,151 +0,0 @@
|
|||
!:folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2003 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
! To make this a bit more useful:
|
||||
! - URL encoding
|
||||
! - log with date
|
||||
! - log user agent
|
||||
! - add a socket timeout
|
||||
! - if a directory is requested and URL does not end with /, redirect
|
||||
! - return more header fields, like Content-Length, Last-Modified, and so on
|
||||
! - HEAD request
|
||||
! - make httpdFiletype generic, specify file types in a list of comma pairs
|
||||
! - basic authentication, using httpdAuth function from a config file
|
||||
! - when string formatting is added, some code can be simplified
|
||||
! - use nio to handle multiple requests
|
||||
! - implement an LSP that does an "apropos" search
|
||||
|
||||
: httpdGetPath ( request -- file )
|
||||
dup ".*\\.\\.*" re-matches [
|
||||
f
|
||||
] [
|
||||
dup [ "GET (.*?)( HTTP.*|)" groups dup [ car ] when ] when
|
||||
] ifte ;
|
||||
|
||||
: httpdResponse (stream msg contentType --)
|
||||
[ "HTTP/1.0 " over fwrite ] 2dip
|
||||
[ over fwriteln "Content-type: " over fwriteln ] dip
|
||||
swap fwriteln ;
|
||||
|
||||
: httpdError (stream error --)
|
||||
"Error: " write dup print
|
||||
2dup "text/html" httpdResponse
|
||||
"\n<html><body><h1>" swap "</h1></body></html>" cat3 swap fwriteln ;
|
||||
|
||||
: httpdFiletype (filename -- mime-type)
|
||||
[
|
||||
[ ".*\.gif" re-matches ] [ drop "image/gif" ]
|
||||
[ ".*\.png" re-matches ] [ drop "image/png" ]
|
||||
[ ".*\.html" re-matches ] [ drop "text/html" ]
|
||||
[ ".*\.txt" re-matches ] [ drop "text/plain" ]
|
||||
[ ".*\.lsd" re-matches ] [ drop "text/plain" ]
|
||||
[ t ] [ drop "application/octet-stream" ]
|
||||
] cond ;
|
||||
|
||||
: httpdUriToPath (uri -- path)
|
||||
$httpdDocRoot swap
|
||||
dup "http://.*?(/.*)" groups [ car ] when*
|
||||
cat2 ;
|
||||
|
||||
: httpdPathToAbsolute (path -- absolute)
|
||||
$httpdDocRoot swap cat2
|
||||
"Serving " over cat2 print
|
||||
dup directory? [ "/index.html" cat2 ] when ;
|
||||
|
||||
: httpdServeFile (stream argument filename --)
|
||||
nip
|
||||
2dup "200 Document follows" swap httpdFiletype httpdResponse
|
||||
[ "" over fwriteln ] dip
|
||||
<filebr> swap fcopy ;
|
||||
|
||||
: httpdListDirectory (stream directory -- string)
|
||||
[ "<html><head><title>" over fwrite ] dip
|
||||
2dup swap fwrite
|
||||
[ "</title></head><body><h1>" over fwrite ] dip
|
||||
2dup swap fwrite
|
||||
[ "</h1><ul>" over fwrite ] dip
|
||||
directory [
|
||||
chars>entities
|
||||
dup directory? [ "/" cat2 ] when
|
||||
[ "<li><a href=\"" over fwrite ] dip
|
||||
2dup swap fwrite
|
||||
[ "\">" over fwrite ] dip
|
||||
2dup swap fwrite
|
||||
[ "</a></li>" over fwrite ] dip
|
||||
drop
|
||||
] each
|
||||
"</ul></body></html>" swap fwrite ;
|
||||
|
||||
: httpdServeDirectory (stream argument directory --)
|
||||
dup "/index.html" cat2 dup exists? [
|
||||
nip httpdServeFile
|
||||
] [
|
||||
drop nip
|
||||
over "200 Document follows" "text/plain" httpdResponse
|
||||
[ "" over fwriteln ] dip
|
||||
httpdListDirectory
|
||||
] ifte ;
|
||||
|
||||
: httpdServeScript (stream argument filename --)
|
||||
<namespace> [ [ @argument @stdio ] dip runFile ] bind ;
|
||||
|
||||
: httpdParseObjectName ( filename -- argument filename )
|
||||
dup "(.*?)\\?(.*)" groups dup [ nip push ] when swap ;
|
||||
|
||||
: httpdServeObject (stream filename --)
|
||||
"Serving " write dup print
|
||||
httpdParseObjectName
|
||||
dup exists? [
|
||||
dup directory? [
|
||||
httpdServeDirectory
|
||||
] [
|
||||
dup ".*\.lhtml" re-matches [
|
||||
httpdServeScript
|
||||
] [
|
||||
httpdServeFile
|
||||
] ifte
|
||||
] ifte
|
||||
] [
|
||||
2drop "404 Not Found" httpdError
|
||||
] ifte ;
|
||||
|
||||
: httpdRequest (stream request --)
|
||||
httpdGetPath dup [
|
||||
httpdUriToPath httpdServeObject
|
||||
] [
|
||||
drop "400 Bad request" httpdError
|
||||
] ifte ;
|
||||
|
||||
: httpdClient (socket --)
|
||||
"Accepted connection from " write dup [ $socket ] bind .
|
||||
[ dup freadln httpdRequest ] [ fclose ] cleave ;
|
||||
|
||||
: httpdLoop (server --)
|
||||
dup accept httpdClient $httpdQuit [ fclose ] [ httpdLoop ] ifte ;
|
||||
|
||||
: httpd (port docroot --)
|
||||
@httpdDocRoot <server> httpdLoop ;
|
||||
|
|
@ -0,0 +1,194 @@
|
|||
!:folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2003, 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
! To make this a bit more useful:
|
||||
! - URL encoding
|
||||
! - log with date
|
||||
! - log user agent
|
||||
! - add a socket timeout
|
||||
! - if a directory is requested and URL does not end with /, redirect
|
||||
! - return more header fields, like Content-Length, Last-Modified, and so on
|
||||
! - HEAD request
|
||||
! - basic authentication, using httpdAuth function from a config file
|
||||
! - when string formatting is added, some code can be simplified
|
||||
! - use nio to handle multiple requests
|
||||
! - implement an LSP that does an "apropos" search
|
||||
|
||||
[
|
||||
[ "html" , "text/html" ]
|
||||
[ "txt" , "text/plain" ]
|
||||
|
||||
[ "gif" , "image/gif" ]
|
||||
[ "png" , "image/png" ]
|
||||
[ "jpg" , "image/jpeg" ]
|
||||
[ "jpeg" , "image/jpeg" ]
|
||||
|
||||
[ "jar" , "application/octet-stream" ]
|
||||
[ "zip" , "application/octet-stream" ]
|
||||
[ "tgz" , "application/octet-stream" ]
|
||||
[ "tar.gz" , "application/octet-stream" ]
|
||||
[ "gz" , "application/octet-stream" ]
|
||||
] @httpd-extensions
|
||||
|
||||
: group1 ( string regex -- string )
|
||||
groups dup [ car ] when ;
|
||||
|
||||
: httpd-response ( msg content-type -- response )
|
||||
[ "HTTP/1.0 " swap "\nContent-Type: " ] dip "\n" cat5 ;
|
||||
|
||||
: httpd-file-header ( filename -- header )
|
||||
"200 Document follows" swap httpd-filetype httpd-response ;
|
||||
|
||||
: httpd-serve-file ( stream filename -- )
|
||||
2dup httpd-file-header swap fwriteln <filebr> swap fcopy ;
|
||||
|
||||
: httpd-log-error ( error -- )
|
||||
"Error: " swap cat2 print ;
|
||||
|
||||
: httpd-error-body ( error -- body )
|
||||
"\n<html><body><h1>" swap "</h1></body></html>" cat3 ;
|
||||
|
||||
: httpd-error ( stream error -- )
|
||||
dup httpd-log-error
|
||||
[ "text/html" httpd-response ] [ httpd-error-body ] cleave
|
||||
cat2
|
||||
swap fwriteln ;
|
||||
|
||||
: httpd-response-write ( stream msg content-type -- )
|
||||
httpd-response swap fwriteln ;
|
||||
|
||||
: httpd-file-extension ( filename -- extension )
|
||||
".*\\.(.*)" group1 ;
|
||||
|
||||
: httpd-filetype ( filename -- mime-type )
|
||||
httpd-file-extension $httpd-extensions assoc
|
||||
[ "text/plain" ] unless* ;
|
||||
|
||||
: httpd-url>path ( uri -- path )
|
||||
dup "http://.*?(/.*)" group1 dup [
|
||||
nip
|
||||
] [
|
||||
drop
|
||||
] ifte
|
||||
$httpd-doc-root swap cat2 ;
|
||||
|
||||
: httpd-file>html ( filename -- ... )
|
||||
"<li><a href=\"" swap
|
||||
!dup directory? [ "/" cat2 ] when
|
||||
chars>entities
|
||||
"\">" over "</a></li>" ;
|
||||
|
||||
: httpd-directory>html ( directory -- html )
|
||||
directory [ httpd-file>html ] map cat ;
|
||||
|
||||
: httpd-directory-header ( stream directory -- )
|
||||
"200 Document follows" "text/html" httpd-response fwriteln ;
|
||||
|
||||
: httpd-list-directory ( stream directory -- )
|
||||
2dup httpd-directory-header [
|
||||
"<html><head><title>" swap
|
||||
"</title></head><body><h1>" over
|
||||
"</h1><ul>" over
|
||||
httpd-directory>html
|
||||
"</ul></body></html>"
|
||||
] cons expand cat swap fwrite ;
|
||||
|
||||
: httpd-serve-directory ( stream directory -- )
|
||||
dup "/index.html" cat2 dup exists? [
|
||||
nip httpd-serve-file
|
||||
] [
|
||||
drop httpd-list-directory
|
||||
] ifte ;
|
||||
|
||||
: httpd-serve-script ( stream argument filename -- )
|
||||
<namespace> [ [ @argument @stdio ] dip runFile ] bind ;
|
||||
|
||||
: httpd-parse-object-name ( filename -- argument filename )
|
||||
dup "(.*?)\\?(.*)" groups dup [ nip call ] when swap ;
|
||||
|
||||
: httpd-serve-static ( stream filename -- )
|
||||
dup exists? [
|
||||
dup directory? [
|
||||
httpd-serve-directory
|
||||
] [
|
||||
httpd-serve-file
|
||||
] ifte
|
||||
] [
|
||||
drop "404 Not Found" httpd-error
|
||||
] ifte ;
|
||||
|
||||
: httpd-serve-object ( stream argument filename -- )
|
||||
dup ".*\\.lhtml" re-matches [
|
||||
httpd-serve-script
|
||||
] [
|
||||
nip httpd-serve-static
|
||||
] ifte ;
|
||||
|
||||
: httpd-serve-log ( filename -- )
|
||||
"Serving " swap cat2 print ;
|
||||
|
||||
: httpd-get-request ( stream url -- )
|
||||
httpd-url>path dup httpd-serve-log
|
||||
httpd-parse-object-name httpd-serve-object ;
|
||||
|
||||
: httpd-get-path ( request -- file )
|
||||
"GET (.*?)( HTTP.*|)" group1 ;
|
||||
|
||||
: httpd-get-secure-path ( path -- path )
|
||||
dup [
|
||||
httpd-get-path dup [
|
||||
dup ".*\\.\\.*" re-matches [ drop f ] when
|
||||
] [
|
||||
drop f
|
||||
] ifte
|
||||
] [
|
||||
drop f
|
||||
] ifte ;
|
||||
|
||||
: httpd-request ( stream request -- )
|
||||
httpd-get-secure-path dup [
|
||||
httpd-get-request
|
||||
] [
|
||||
drop "400 Bad request" httpd-error
|
||||
] ifte ;
|
||||
|
||||
: httpd-client-log ( socket -- )
|
||||
"Accepted connection from " write [ $socket ] bind . ;
|
||||
|
||||
: httpd-client ( socket -- )
|
||||
dup httpd-client-log
|
||||
dup freadln [ httpd-request ] when* ;
|
||||
|
||||
: httpd-loop ( server -- )
|
||||
[
|
||||
$httpd-quit not
|
||||
] [
|
||||
dup accept dup httpd-client fclose
|
||||
] while ;
|
||||
|
||||
: httpd ( port docroot -- )
|
||||
@httpd-doc-root <server> httpd-loop ;
|
||||
|
|
@ -0,0 +1,141 @@
|
|||
!:folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2003, 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
: max-str-length ( list -- len )
|
||||
! Returns the length of the longest string in the given
|
||||
! list.
|
||||
0 swap [ str-length max ] each ;
|
||||
|
||||
: pad-string ( len str -- str )
|
||||
str-length - spaces ;
|
||||
|
||||
: words. (--)
|
||||
! Print all defined words.
|
||||
words [ . ] each ;
|
||||
|
||||
: vars. ( -- )
|
||||
! Print a list of defined variables.
|
||||
uvars [ print ] each ;
|
||||
|
||||
: value/tty ( max [ name , value ] -- ... )
|
||||
uncons [ dup [ pad-string ] dip ": " ] dip unparse "\n" ;
|
||||
|
||||
: values/tty ( -- ... )
|
||||
! Apply 'expand' or 'str-expand' to this word.
|
||||
uvars max-str-length
|
||||
uvalues [ over [ value/tty ] dip ] each drop ;
|
||||
|
||||
: value/html ( [ name , value ] -- ... )
|
||||
uncons [
|
||||
[ "<tr><th align=\"left\">" ] dip
|
||||
"</th><td><a href=\"inspect.lhtml?" over "\">"
|
||||
] dip
|
||||
unparse chars>entities
|
||||
"</a></td></tr>" ;
|
||||
|
||||
: values/html ( -- ... )
|
||||
! Apply 'expand' or 'str-expand' to this word.
|
||||
uvalues [ value/html ] each ;
|
||||
|
||||
: inspecting ( obj -- namespace )
|
||||
dup has-namespace? [ <objnamespace> ] unless ;
|
||||
|
||||
: describe* ( obj quot -- )
|
||||
! Print an informational header about the object, and print
|
||||
! all values in its object namespace.
|
||||
swap inspecting [ str-expand ] bind print ;
|
||||
|
||||
: describe ( obj -- )
|
||||
[
|
||||
[ worddef? ] [ see ]
|
||||
[ stack? ] [ stack>list print-numbered-list ]
|
||||
[ string? ] [ print ]
|
||||
[ drop t ] [
|
||||
"OBJECT: " write dup .
|
||||
[
|
||||
"CLASS : " write dup class-of print
|
||||
"--------" print
|
||||
[ values/tty ] describe*
|
||||
] when*
|
||||
]
|
||||
] cond ;
|
||||
|
||||
: describe/html ( obj -- )
|
||||
[
|
||||
[ worddef? ] [ see/html ]
|
||||
[ string? ] [
|
||||
"<pre>" print chars>entities print "</pre>" print
|
||||
]
|
||||
[ drop t ] [
|
||||
"<table><tr><th align=\"left\">OBJECT:</th><td>" print
|
||||
dup unparse chars>entities write
|
||||
"</td></tr>" print
|
||||
|
||||
[
|
||||
"<tr><th align=\"left\">CLASS:</th><td>" write
|
||||
dup class-of print
|
||||
"</td></tr>" print
|
||||
"<tr><td colspan=\"2\"><hr></td></tr>" print
|
||||
[ values/html ] describe*
|
||||
] when*
|
||||
|
||||
"</table>" print
|
||||
]
|
||||
] cond ;
|
||||
|
||||
: object-path ( list -- object )
|
||||
! An object path is a list of strings. Each string is a
|
||||
! variable name in the object namespace at that level.
|
||||
! Returns f if any of the objects are not set.
|
||||
dup [
|
||||
unswons $ dup [
|
||||
! Defined.
|
||||
inspecting [ object-path ] bind
|
||||
] [
|
||||
! Undefined. Just return f.
|
||||
2drop f
|
||||
] ifte
|
||||
] [
|
||||
! Current object.
|
||||
drop $this [ $namespace ] unless*
|
||||
] ifte ;
|
||||
|
||||
: inspect ( obj -- )
|
||||
! Display the inspector for the object, and start a new
|
||||
! REPL bound to the object's namespace.
|
||||
inspecting dup describe
|
||||
"--------" print
|
||||
! Start a REPL, only if the object is not the dictionary.
|
||||
dup $dict = [
|
||||
"Cannot enter into dictionary. Use 'see' word." print
|
||||
] [
|
||||
"exit - exit one level of inspector." print
|
||||
"suspend - return to top level." print
|
||||
dup [
|
||||
" " swap unparse " " cat3 interpreter-loop
|
||||
] bind
|
||||
] ifte ;
|
||||
|
|
@ -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
|
||||
"" print
|
||||
"Some basic commands:" print
|
||||
"clear -- clear stack." print
|
||||
".s -- print stack." print
|
||||
". -- print top of stack." print
|
||||
"vars. -- list all variables." 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
|
||||
"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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
! 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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 / ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
@ -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> - . ;
|
||||
|
|
|
|||
|
|
@ -28,13 +28,16 @@
|
|||
: s@ ( variable value -- )
|
||||
swap @ ;
|
||||
|
||||
: 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 ].
|
||||
! 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 ;
|
||||
"factor.FactorNamespace" is ;
|
||||
|
||||
: <namespace> (-- namespace)
|
||||
$namespace [ |factor.FactorNamespace ] |factor.FactorNamespace
|
||||
|
|
@ -54,7 +57,8 @@
|
|||
over [ bind ] dip ;
|
||||
|
||||
: import ( class pairs -- )
|
||||
! Import some static variables from a Java class into the current namespace.
|
||||
! Import some static variables from a Java class into the
|
||||
! current namespace.
|
||||
$namespace [ |java.lang.String |factor.Cons ]
|
||||
|factor.FactorNamespace |importVars
|
||||
jinvoke ;
|
||||
|
|
@ -62,10 +66,17 @@
|
|||
: vars ( -- list )
|
||||
$namespace [ ] |factor.FactorNamespace |toVarList jinvoke ;
|
||||
|
||||
: values ( -- list )
|
||||
$namespace [ ] |factor.FactorNamespace |toValueList
|
||||
jinvoke ;
|
||||
|
||||
: uvalues ( -- list )
|
||||
values [ car uvar? ] subset ;
|
||||
|
||||
: uvar? ( name -- )
|
||||
[ "namespace" "parent" ] contains not ;
|
||||
[ "namespace" "parent" "this" ] contains not ;
|
||||
|
||||
: uvars ( -- list )
|
||||
! Does not include "namespace" and "parent" variables; ie, all user-defined
|
||||
! variables in given namespace.
|
||||
! Does not include "namespace" and "parent" variables; ie,
|
||||
! all user-defined variables in given namespace.
|
||||
vars [ uvar? ] subset ;
|
||||
|
|
|
|||
|
|
@ -28,15 +28,28 @@
|
|||
: parse ( string -- list )
|
||||
f swap <sreader> parse* ;
|
||||
|
||||
: compile-call ( [ X ] -- X )
|
||||
no-name dup compile execute ;
|
||||
|
||||
: eval ( "X" -- X )
|
||||
parse call ;
|
||||
parse $compile-toplevel [ compile-call ] [ call ] ifte ;
|
||||
|
||||
: eval-compile ( "X" -- X )
|
||||
parse no-name word compile word execute ;
|
||||
|
||||
: runFile ( path -- )
|
||||
dup <freader> parse* call ;
|
||||
|
||||
: unparse ( X -- "X" )
|
||||
[ |java.lang.Object ] |factor.FactorJava |factorTypeToString
|
||||
[ |java.lang.Object ] |factor.FactorParser |unparse
|
||||
jinvoke-static ;
|
||||
|
||||
: . ( expr -- )
|
||||
unparse print ;
|
||||
|
||||
: parse-number ( str -- number )
|
||||
parse dup length 1 = [
|
||||
car dup number? [ drop f ] unless
|
||||
] [
|
||||
drop f
|
||||
] ifte ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,176 @@
|
|||
!:folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2003, 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
4 @indent
|
||||
|
||||
: <prettyprint-token> ( string -- token )
|
||||
dup <namespace> [
|
||||
@name
|
||||
t @prettyprint-token
|
||||
] extend tuck s@ ;
|
||||
|
||||
: prettyprint-token? ( token -- token? )
|
||||
dup has-namespace? [
|
||||
[ $prettyprint-token ] bind
|
||||
] [
|
||||
drop f
|
||||
] ifte ;
|
||||
|
||||
: prettyprint-indent ( indent -- indent )
|
||||
dup spaces write ;
|
||||
|
||||
: prettyprint-newline/space ( indent ? -- indent )
|
||||
[ "\n" write prettyprint-indent ] [ " " write ] ifte ;
|
||||
|
||||
: prettyprint-indent-params ( indent obj -- indent ? ? name )
|
||||
[
|
||||
$indent+ [ $indent + ] when
|
||||
$indent- [ $indent - ] when
|
||||
$-indent [ $indent - t ] [ f ] ifte
|
||||
$newline
|
||||
$name
|
||||
] bind ;
|
||||
|
||||
: prettyprint-token ( indent obj -- indent )
|
||||
prettyprint-indent-params
|
||||
[
|
||||
[
|
||||
"\n" write
|
||||
prettyprint-indent
|
||||
] when
|
||||
] 2dip
|
||||
write prettyprint-newline/space ;
|
||||
|
||||
: prettyprint-unparsed ( indent unparse -- indent )
|
||||
dup "\n" = [
|
||||
drop "\n" write prettyprint-indent
|
||||
] [
|
||||
write " " write
|
||||
] ifte ;
|
||||
|
||||
: [prettyprint-tty] ( indent obj -- indent )
|
||||
dup prettyprint-token? [
|
||||
prettyprint-token
|
||||
] [
|
||||
unparse prettyprint-unparsed
|
||||
] ifte ;
|
||||
|
||||
: prettyprint-html-unparse ( obj -- unparse )
|
||||
dup unparse dup "\n" = [
|
||||
nip
|
||||
] [
|
||||
swap word? [
|
||||
"<a href=\"see.lhtml?" swap "\">" over "</a>" cat5
|
||||
] [
|
||||
chars>entities
|
||||
] ifte
|
||||
] ifte ;
|
||||
|
||||
: [prettyprint-html] ( indent obj -- indent )
|
||||
dup prettyprint-token? [
|
||||
prettyprint-token
|
||||
] [
|
||||
prettyprint-html-unparse prettyprint-unparsed
|
||||
] ifte ;
|
||||
|
||||
: prettyprint-list* ( quot list -- )
|
||||
! Pretty-print a list, without [ and ].
|
||||
[
|
||||
over [
|
||||
prettyprint*
|
||||
] dip
|
||||
] each
|
||||
! Drop the quotation
|
||||
drop ;
|
||||
|
||||
: prettyprint-list ( quot list before after -- )
|
||||
! Apply the quotation to 'before', call prettyprint* on
|
||||
! 'list', and apply the quotation to 'after'.
|
||||
swapd [
|
||||
[
|
||||
swap dup [
|
||||
call
|
||||
] dip
|
||||
] dip
|
||||
swap dup [
|
||||
swap prettyprint-list*
|
||||
] dip
|
||||
] dip
|
||||
swap call ;
|
||||
|
||||
: prettyprint* ( quot obj -- )
|
||||
[
|
||||
[ not ] [ swap call ]
|
||||
[ list? ] [ $[ $] prettyprint-list ]
|
||||
[ compound? ] [ worddef>list $: $; prettyprint-list ]
|
||||
[ compiled? ] [ worddef>list $: $; prettyprint-list ]
|
||||
[ shuffle? ] [ worddef>list $~<< $>>~ prettyprint-list ]
|
||||
[ drop t ] [ swap call ]
|
||||
] cond ;
|
||||
|
||||
: prettyprint-tty ( list -- )
|
||||
0 [ [prettyprint-tty] ] rot prettyprint* drop ;
|
||||
|
||||
: prettyprint-html ( list -- )
|
||||
0 [ [prettyprint-html] ] rot prettyprint* drop ;
|
||||
|
||||
: see ( word -- )
|
||||
worddef prettyprint-tty ;
|
||||
|
||||
: see/html ( word -- )
|
||||
"<pre>" print
|
||||
worddef prettyprint-html
|
||||
"</pre>" print ;
|
||||
|
||||
!!!
|
||||
|
||||
"[" <prettyprint-token> [
|
||||
t @indent+
|
||||
t @newline
|
||||
] bind
|
||||
|
||||
"]" <prettyprint-token> [
|
||||
t @-indent
|
||||
] bind
|
||||
|
||||
":" <prettyprint-token> [
|
||||
t @indent+
|
||||
] bind
|
||||
|
||||
";" <prettyprint-token> [
|
||||
t @indent-
|
||||
t @newline
|
||||
] bind
|
||||
|
||||
"~<<" <prettyprint-token> [
|
||||
t @indent+
|
||||
] bind
|
||||
|
||||
">>~" <prettyprint-token> [
|
||||
t @indent-
|
||||
t @newline
|
||||
] bind
|
||||
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
} */ //}}}
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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));
|
||||
|
||||
if(obj instanceof Cons)
|
||||
//{{{ core() method
|
||||
public static void core(FactorInterpreter interp,
|
||||
Object name, Object def) throws Exception
|
||||
{
|
||||
obj = new FactorCompoundDefinition(
|
||||
newWord,(Cons)obj);
|
||||
// name: either a string or a word
|
||||
FactorWord newWord;
|
||||
if(name instanceof FactorWord)
|
||||
newWord = (FactorWord)name;
|
||||
else
|
||||
newWord = interp.intern((String)name);
|
||||
|
||||
if(def instanceof Cons)
|
||||
{
|
||||
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);
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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());
|
||||
} //}}}
|
||||
}
|
||||
|
|
@ -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);
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
} //}}}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -25,6 +25,9 @@
|
|||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
"user.home" system-property @~
|
||||
"file.separator" system-property @/
|
||||
|
||||
: <stream> ( -- stream )
|
||||
! Create a stream object. A stream is a namespace with the
|
||||
! following entries:
|
||||
|
|
@ -42,6 +45,8 @@
|
|||
[ "freadln not implemented." break ] @freadln
|
||||
( string -- )
|
||||
[ "fwrite not implemented." break ] @fwrite
|
||||
( string -- )
|
||||
[ "fedit not implemented." break ] @fedit
|
||||
( -- )
|
||||
[ ] @fflush
|
||||
( -- )
|
||||
|
|
@ -165,6 +170,12 @@
|
|||
: fwrite ( string stream -- )
|
||||
[ $fwrite call ] bind ;
|
||||
|
||||
: fedit ( string stream -- )
|
||||
[ $fedit call ] bind ;
|
||||
|
||||
: edit ( string -- )
|
||||
$stdio fedit ;
|
||||
|
||||
: fclose ( stream -- )
|
||||
[ $fclose call ] bind ;
|
||||
|
||||
|
|
@ -175,14 +186,8 @@
|
|||
[ "java.io.InputStream" "java.io.OutputStream" ]
|
||||
"factor.FactorLib" "copy" jinvoke-static ;
|
||||
|
||||
"java.lang.System" "in" jvar-static$ <ireader> <breader> @stdin
|
||||
"java.lang.System" "out" jvar-static$ <owriter> @stdout
|
||||
$stdin $stdout <charstream> @stdio
|
||||
|
||||
!(file -- freader)
|
||||
|<freader> [
|
||||
[ |java.lang.String ] |java.io.FileReader jnew <breader>
|
||||
] define
|
||||
: <freader> ( file -- freader )
|
||||
[ |java.lang.String ] |java.io.FileReader jnew <breader> ;
|
||||
|
||||
: <file> (path -- file)
|
||||
dup "java.io.File" is not [
|
||||
|
|
@ -206,10 +211,8 @@ $stdin $stdout <charstream> @stdio
|
|||
[ "java.io.File" ] "java.io.File" "renameTo"
|
||||
jinvoke ;
|
||||
|
||||
!(string -- reader)
|
||||
|<sreader> [
|
||||
[ |java.lang.String ] |java.io.StringReader jnew
|
||||
] define
|
||||
: <sreader> (string -- reader)
|
||||
[ |java.lang.String ] |java.io.StringReader jnew ;
|
||||
|
||||
: close (stream --)
|
||||
dup "java.io.Reader" is [
|
||||
|
|
@ -222,18 +225,18 @@ $stdin $stdout <charstream> @stdio
|
|||
[ [ "java.lang.String" ] ] "factor.FactorLib" "exec"
|
||||
jinvoke-static ;
|
||||
|
||||
!(stream -- string)
|
||||
|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$ <ireader> <breader> @stdin
|
||||
"java.lang.System" "out" jvar-static$ <owriter> @stdout
|
||||
$stdin $stdout <charstream> @stdio
|
||||
|
|
|
|||
|
|
@ -35,10 +35,6 @@
|
|||
! [ #\" , """ ]
|
||||
] @entities
|
||||
|
||||
: >str ( obj -- string )
|
||||
! Returns the Java string representation of this object.
|
||||
[ ] "java.lang.Object" "toString" jinvoke ;
|
||||
|
||||
: >bytes ( string -- array )
|
||||
! Converts a string to an array of ASCII bytes. An exception
|
||||
! is thrown if the string contains non-ASCII characters.
|
||||
|
|
@ -46,6 +42,19 @@
|
|||
[ "java.lang.String" ] "java.lang.String" "getBytes"
|
||||
jinvoke ;
|
||||
|
||||
: >lower ( str -- str )
|
||||
[ ] "java.lang.String" "toLowerCase" jinvoke ;
|
||||
|
||||
: >str ( obj -- string )
|
||||
! Returns the Java string representation of this object.
|
||||
[ ] "java.lang.Object" "toString" jinvoke ;
|
||||
|
||||
: >title ( str -- str )
|
||||
1 str/ [ >upper ] dip >lower cat2 ;
|
||||
|
||||
: >upper ( str -- str )
|
||||
[ ] "java.lang.String" "toUpperCase" jinvoke ;
|
||||
|
||||
: <sbuf> ( -- StringBuffer )
|
||||
[ ] "java.lang.StringBuffer" jnew ;
|
||||
|
||||
|
|
@ -67,12 +76,15 @@
|
|||
: cat4 ( "a" "b" "c" "d" -- "abcd" )
|
||||
[ ] cons cons cons cons cat ;
|
||||
|
||||
: cat5 ( "a" "b" "c" "d" "e" -- "abcde" )
|
||||
[ ] cons cons cons cons cons cat ;
|
||||
|
||||
: char? ( obj -- boolean )
|
||||
"java.lang.Character" is ;
|
||||
|
||||
: chars>entities ( str -- str )
|
||||
! Convert <, >, &, ' and " to HTML entities.
|
||||
[ dup $entities assoc dup [ nip ] [ drop ] ifte ] strmap ;
|
||||
[ dup $entities assoc dup rot ? ] str-map ;
|
||||
|
||||
: group ( index match -- )
|
||||
[ "int" ] "java.util.regex.Matcher" "group"
|
||||
|
|
@ -151,6 +163,10 @@
|
|||
jinvoke-static
|
||||
] when ;
|
||||
|
||||
: spaces ( len -- str )
|
||||
! Returns a string containing the given number of spaces.
|
||||
<sbuf> swap [ " " swap sbuf-append ] times >str ;
|
||||
|
||||
: split ( string split -- list )
|
||||
2dup index-of dup -1 = [
|
||||
2drop unit
|
||||
|
|
@ -158,16 +174,27 @@
|
|||
swap [ str// ] dip split cons
|
||||
] ifte ;
|
||||
|
||||
: string? ( obj -- ? )
|
||||
"java.lang.String" is ;
|
||||
|
||||
: str->=< ( str1 str2 -- n )
|
||||
swap [ "java.lang.String" ] "java.lang.String" "compareTo"
|
||||
jinvoke ;
|
||||
|
||||
: str-lexi> ( str1 str2 -- ? )
|
||||
! Returns if the first string lexicographically follows str2
|
||||
str->=< 0 > ;
|
||||
|
||||
: str/ ( str index -- str str )
|
||||
! Returns 2 strings, that when concatenated yield the
|
||||
! original string.
|
||||
2dup strtail [ str-head ] dip ;
|
||||
2dup str-tail [ str-head ] dip ;
|
||||
|
||||
: str// ( str index -- str str )
|
||||
! Returns 2 strings, that when concatenated yield the
|
||||
! original string, without the character at the given
|
||||
! index.
|
||||
2dup succ strtail [ str-head ] dip ;
|
||||
2dup succ str-tail [ str-head ] dip ;
|
||||
|
||||
: str-each ( str [ code ] -- )
|
||||
! Execute the code, with each character of the string pushed
|
||||
|
|
@ -205,12 +232,15 @@
|
|||
|
||||
: str-length> ( str str -- boolean )
|
||||
! Compare string lengths.
|
||||
[ str-length ] apply2 > ;
|
||||
[ str-length ] 2apply > ;
|
||||
|
||||
: str-map ( str [ code ] -- [ mapping ] )
|
||||
2list restack str-each unstack cat ;
|
||||
|
||||
: strtail ( str index -- str )
|
||||
: str-contains ( substr str -- ? )
|
||||
swap index-of -1 = not ;
|
||||
|
||||
: str-tail ( str index -- str )
|
||||
! Returns a new string, from the given index until the end
|
||||
! of the string.
|
||||
over str-length rot substring ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
! Tests the combinators.
|
||||
|
||||
"Checking combinators." print
|
||||
|
||||
[ ] [ 3 ] [ [ ] cond ] test-word
|
||||
[ t ] [ 4 ] [ [ [ 1 = ] [ ] [ 4 = ] [ drop t ] [ 2 = ] [ ] ] cond ] test-word
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
! Tests the dictionary words.
|
||||
|
||||
"Checking dictionary words." print
|
||||
|
||||
! Just make sure this works.
|
||||
|
||||
! OUTPUT INPUT WORD
|
||||
[ ] [ "httpd" ] [ apropos ] test-word
|
||||
[ t ] [ "ifte" ] [ worddef compound? ] test-word
|
||||
[ t ] [ "dup" ] [ worddef shuffle? ] test-word
|
||||
[ f ] [ "ifte" ] [ worddef shuffle? ] test-word
|
||||
[ f ] [ "dup" ] [ worddef compound? ] test-word
|
||||
|
||||
! Test word iternalization.
|
||||
|
||||
: gensym-test ( -- ? )
|
||||
f 10 [ gensym gensym = and ] times ;
|
||||
|
||||
[ f ] [ ] [ gensym-test ] test-word
|
||||
|
||||
: intern-test ( 1 2 -- ? )
|
||||
[ intern ] 2apply = ;
|
||||
|
||||
[ t ] [ "a" "a" ] [ intern-test ] test-word
|
||||
[ f ] [ "a" "A" ] [ intern-test ] test-word
|
||||
[ f ] [ "a" "B" ] [ intern-test ] test-word
|
||||
[ f ] [ "a" "a" ] [ <word> swap intern = ] test-word
|
||||
|
||||
: worddef>list-test ( -- ? )
|
||||
[ dup * ] dup no-name worddef>list cdr cdr = ;
|
||||
|
||||
[ t ] [ ] [ worddef>list-test ] test-word
|
||||
|
||||
: words-test ( -- ? )
|
||||
t words [ word? and ] each ;
|
||||
|
||||
[ t ] [ ] [ words-test ] test-word
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -1 +1 @@
|
|||
"0.36" @version
|
||||
"0.53" @version
|
||||
|
|
|
|||
Loading…
Reference in New Issue