package code.lang; import code.instr.*; import code.modules.CurryModule; import code.space.*; import code.stuff.Logger; import code.stuff.Tracer; import code.symbols.ConstructorSymbol; import code.symbols.DataSymbol; import code.symbols.OperationSymbol; import code.symbols.Symbol; import code.table.MapTable; import code.table.ModuleTable; import code.term.Term; import code.term.visitor.*; import code.type.*; import code.lang.SuccessModule.*; import static code.type.PredefinedTypes.*; import static code.type.TypeFactory.*; import java.util.Vector; /** * This class defines a few "core" symbols, some of which * cannot be defined in Curry. *

* Builtin symbols that want to work with TeaBag need to have * two instructions sets, the normal one and one with debug * instructions inserted. Currently, the parser removes debug * instructions when the vm is not running in debug mode. * However, builtin modules are not run through the parser. * So builtin modules need to maintain two sets of instructions. * See List.map for an example. Right now there is a number of * builtin modules. Eventually, this will change so that there is * just a small number of builtin modules that do not change much. * * @author Sergio Antoy * @since July 2, 2003 */ public class SystemModule extends CurryModule { // public static final String moduleName = "$System"; public static final String moduleName = "Prelude"; public SystemModule() { super(moduleName, new Vector(), null, 0, createSymbols(), false); } // ------------------------------------------------------------------ private static Vector createSymbols() { Vector v = new Vector (); // prelude operations v.add(eqGenericOperation); v.add(applyOperation); v.add(ensureNotFreeOperation); v.add(seqOperation); v.add(condOperation); v.add(showOperation); // prelude operations not yet implemented v.add(tryoneOperation); v.add(commitOperation); v.add(errorOperation); v.add(oneOperation); v.add(condSearchOperation); v.add(tryOperation); // internal operations v.add(normalizeOperation); v.add(closureConstructor); return v; } /* An operation defined by Java code, as opposed to bytecode produced by a compiler has the following pieces of information: name a String, type a TypeExpression, code an Instruction [], symbol an OperationSymbol class a class implementing Instruction The latter is optional but frequent. Operations are defined by Java code because they perform some action that can't be performed by bytecode instruction, therefore the latter. */ // ------------------------------------------------------------------ // seq :: a -> b -> b // seq x y = evaluate x to HNF and return y public static final String seqName = "seq"; private final static TypeExpression seqType = makeFunctionType(makeTypeVariable("a"), makeFunctionType(makeTypeVariable("b"), makeTypeVariable("b"))); private final static OperationSymbol seqOperation = new OperationSymbol(moduleName, seqName, 0, 2, DataSymbol.NonInfix, 0, Symbol.Public, seqType, new Instruction[]{new seqCode()} ); public static class seqCode implements Instruction { public void execute(Computation computation) { Term term = computation.getTerm(); if (Tracer.instruction) Logger.logln(computation.getIdString() + ": Builtin " + term); Term first = term.getArgument((byte) 0); switch (first.getKind()) { case DataSymbol.Operation: computation.push(first); break; case DataSymbol.Failure: Term fail = SuccessModule.termFail; if (Tracer.reduction) Tracer.traceRewrite(computation, term, fail); term.update(fail); break; default: Term second = term.getArgument((byte) 1); if (Tracer.reduction) Tracer.traceRewrite(computation, term, second); term.update(second); break; } return; } public String printAsTxtLoadable() { return "external function \"seq\""; } } // ------------------------------------------------------------------ // ensureNotFree :: a -> a // External function, public static final String ensureNotFreeName = "ensureNotFree"; private final static TypeExpression ensureNotFreeType = makeFunctionType(makeTypeVariable("a"), makeTypeVariable("a")); private final static OperationSymbol ensureNotFreeOperation = new OperationSymbol(moduleName, ensureNotFreeName, 0, 1, DataSymbol.NonInfix, 0, Symbol.Public, ensureNotFreeType, new Instruction[]{new ensureNotFreeCode()} ); public static class ensureNotFreeCode implements Instruction { public void execute(Computation computation) { Term term = computation.getTerm(); if (Tracer.instruction) Logger.logln(computation.getIdString() + ": ensureNotFree " + term); Term left = term.getArgument((byte) 0); switch (left.getKind()) { case DataSymbol.UnboundVariable: computation.selfSetState(Computation.RESIDUATING); break; case DataSymbol.Operation: computation.push(left); break; case DataSymbol.Failure: Term fail = SuccessModule.termFail; if (Tracer.reduction) Tracer.traceRewrite(computation, term, fail); term.update(fail); break; default: if (Tracer.reduction) Tracer.traceRewrite(computation, term, left); term.update(left); break; } return; } public String printAsTxtLoadable() { return "external function \"ensureNotFree\""; } } // ------------------------------------------------------------------ // Operation normalize :: a -> a public static final String normalizeName = "normalize"; public static final int normalizeId = ModuleTable.getId(moduleName, normalizeName); private final static TypeExpression normalizeType = makeFunctionType(makeTypeVariable("a"), makeTypeVariable("a")); private static Instruction [] normalizeCode = { new normalizeInstruction(), }; private static class normalizeInstruction implements Instruction { public void execute(Computation computation) { Term term = computation.getTerm(); Term arg = term.getArgument((byte) 0); if (Tracer.instruction) Logger.logln(computation.getIdString() + ": normalize " + arg); try { findOperationRooted(arg); if (Tracer.reduction) Tracer.traceRewrite(computation, term, arg); term.update(arg); // term is a normal form. } catch (FoundOperation found) { computation.push(found.term); } catch (FoundFailure found) { Term fail = SuccessModule.termFail; if (Tracer.reduction) Tracer.traceRewrite(computation, term, fail); term.update(fail); } } private class FoundOperation extends Exception { private Term term; private FoundOperation(Term term) { this.term = term; } } private class FoundFailure extends Exception {} private void findOperationRooted(Term term) throws FoundOperation, FoundFailure { switch (term.getKind()) { case DataSymbol.UnboundVariable: // it could/SHOULD residuate as well break; case DataSymbol.Operation: throw new FoundOperation (term); case DataSymbol.Failure: throw new FoundFailure(); default: Term [] argument = term.getArgument(); for (int i=0; i a) -> Bool private static final String eqGenericName = "=="; private final static TypeExpression eqGenericType = makeFunctionType(makeTypeVariable("a"), makeFunctionType(makeTypeVariable("a"), boolType)); private static Instruction [] eqGenericCode = { new eqGenericInstruction(), }; private final static OperationSymbol eqGenericOperation = new OperationSymbol(moduleName, eqGenericName, 0, 2, DataSymbol.NonAssoc, 4, Symbol.Public, eqGenericType, eqGenericCode); private static class eqGenericInstruction implements Instruction { public void execute(Computation computation) { Term term = computation.getTerm(); if (Tracer.instruction) Logger.logln(computation.getIdString() + ": Generic== " + term); Term left = term.getArgument((byte) 0); if (left.isHNF()) { if (left.getKind() == DataSymbol.UnboundVariable) { computation.selfSetState(Computation.RESIDUATING); } else { Term right = term.getArgument((byte) 1); if (right.isHNF()) { if (right.getKind() == DataSymbol.UnboundVariable) { computation.selfSetState(Computation.RESIDUATING); } else { // Term.eqBool must recursively call this operation Term reduct = left.eqBool(right); if (Tracer.reduction) Tracer.traceRewrite(computation, term, reduct); term.update(reduct); } } else computation.push(right); } } else computation.push(left); } public String printAsTxtLoadable() { return "external function \"==\""; } } public final static int eqGenericId = ModuleTable.getId(moduleName, eqGenericName); // ------------------------------------------------------------------ // Operation apply :: (a -> b) -> a -> b // apply (closure (f x1 ... xn)) y = f x1 ... xn y // apply (f x1 ... xn) y = apply (hnf (f x1 ... xn)) y public static final String applyName = "apply"; private final static TypeExpression applyType = makeFunctionType(makeFunctionType(makeTypeVariable("a"), makeTypeVariable("b")), makeFunctionType(makeTypeVariable("a"), makeTypeVariable("b"))); private final static OperationSymbol applyOperation = new OperationSymbol(moduleName, applyName, 0, 2, DataSymbol.NonAssoc, 0, Symbol.Public, applyType, new Instruction[]{ new applyCode() }); // ------------------------------------------------------------------ // Data closure a = closure a // Used in conjunction with apply, see above // Cannot be typed, cannot be defined in curry public static final String closureName = "closure"; private final static TypeExpression closureType = makeFunctionType(makeTypeVariable("a"), makeTypeVariable("a")); private final static ConstructorSymbol closureConstructor = new ConstructorSymbol(moduleName, closureName, DataSymbol.toplevel, 1, DataSymbol.Failure + 1, DataSymbol.NonInfix, DataSymbol.NonInfix, Symbol.Public, closureType); // ------------------------------------------------------------------ // Operation cond :: Success -> a -> a // cond Success a = a // Should it narrow or residuate ??? private static final String condName = "cond"; private final static TypeExpression condType = makeFunctionType (makeFunctionType(successType, makeTypeVariable("a")), makeTypeVariable("a")); private static final Instruction[] condCode = new Instruction[]{ new Load((byte) 0), new Branch(new Instruction[][]{ new Instruction[]{ new MakeTerm(SuccessModule.moduleName, "success"), Narrow.singleton, }, Fail.failSeq, new Instruction[]{ new Load((byte) 1), Replace.singleton, }, }), }; private static final OperationSymbol condOperation = new OperationSymbol(moduleName, condName, 0, 2, DataSymbol.NonAssoc, 0, Symbol.Public, condType, condCode); // TODO: The following is slightly incomplete in the sense that // it prints uninstantiated variables. // Perhaps, it could be replaced by a builtin instruction. public static final String showName = "show"; private final static TypeExpression showType = makeFunctionType(makeTypeVariable("a"), makeApplicationType(listTypeName, charType)); private final static OperationSymbol showOperation = new OperationSymbol(moduleName, showName, DataSymbol.toplevel, 1, DataSymbol.NonInfix, DataSymbol.NonInfix, Symbol.Public, showType, new Instruction[]{ new showInstruction(),}); public static class showInstruction implements Instruction { private static int nilId = ModuleTable.getId("Prelude", "[]"); private static Term nilTerm = new Term(nilId, new Term[] {}); private static int consId = ModuleTable.getId("Prelude", ":"); public void execute(Computation computation) { Term term = computation.getTerm(); Term arg = term.getArgument((byte)0); if (Tracer.instruction) Logger.logln(computation.getIdString() + ": Builtin show " + arg); if (arg.getKind() == DataSymbol.Failure) term.update(SuccessModule.termFail); else if (arg.isNF()) { String showArg = arg.toString(); int length = showArg.length(); Term reduct = nilTerm; for (int i = length-1; i >= 0; i--) { reduct = new Term(consId, new Term [] { new Term(showArg.charAt(i)), reduct}); } if (Tracer.reduction) Tracer.traceRewrite(computation, term, reduct); term.update(reduct); } else { Term planned = new Term(normalizeId, new Term [] { arg }); computation.push(planned); } } public String printAsTxtLoadable() { return "external function \"show\""; } } /** * Not yet implemented operations. * Must be somewhat defined to avoid error messages. * Throw an exception if they are executed */ private final static DataSymbol tryoneOperation = new OperationSymbol(moduleName, "tryone", 0, 1, DataSymbol.NonAssoc, DataSymbol.NonInfix, Symbol.Public, makeFunctionType (makeFunctionType (makeTypeVariable("a"), successType), makeTypeVariable("a")), new Instruction[]{ new NotImplemented("tryone") }); private final static DataSymbol oneOperation = new OperationSymbol(moduleName, "one", 0, 1, DataSymbol.NonAssoc, DataSymbol.NonInfix, Symbol.Public, makeFunctionType (makeFunctionType (makeTypeVariable("a"), successType), makeApplicationType (listTypeName, makeFunctionType (makeTypeVariable("a"), successType))), new Instruction[]{ new NotImplemented("one") }); private final static DataSymbol tryOperation = new OperationSymbol(moduleName, "try", 0, 1, DataSymbol.NonAssoc, DataSymbol.NonInfix, Symbol.Public, makeFunctionType (makeFunctionType (makeTypeVariable("a"), successType), makeApplicationType (listTypeName, makeFunctionType (makeTypeVariable("a"), successType))), new Instruction[]{ new NotImplemented("try") }); private final static DataSymbol condSearchOperation = new OperationSymbol(moduleName, "condSearch", 0, 2, DataSymbol.NonAssoc, DataSymbol.NonInfix, Symbol.Public, makeFunctionType (makeFunctionType (makeTypeVariable("a"), successType), makeFunctionType (makeFunctionType (makeTypeVariable("a"), boolType), makeApplicationType (listTypeName, makeFunctionType (makeTypeVariable("a"), successType)))), new Instruction[]{ new NotImplemented("condSearch") }); private final static DataSymbol commitOperation = new OperationSymbol(moduleName, "commit", 0, 1, DataSymbol.NonAssoc, DataSymbol.NonInfix, Symbol.Public, makeFunctionType (makeTypeVariable("a"),makeTypeVariable("a")), new Instruction[]{ new NotImplemented("commit") }); private final static DataSymbol errorOperation = new OperationSymbol(moduleName, "error", 0, 1, DataSymbol.NonAssoc, DataSymbol.NonInfix, Symbol.Public, makeFunctionType (makeApplicationType (listTypeName, charType), makeTypeVariable("a")), new Instruction[]{ new NotImplemented("error") }); private static class NotImplemented implements Instruction { private String name; public NotImplemented(String name){ this.name = name; } public void execute(Computation computation) { throw new RuntimeException(name + " not yet implemented!"); } public String printAsTxtLoadable() { return "NotImplemented" ; } } public static class applyCode implements Instruction { private final static int closureId = ModuleTable.getId(moduleName, closureName); public void execute(Computation computation) { Term term = computation.getTerm(); if (Tracer.instruction) Logger.logln(computation.getIdString() + ": Builtin " + term); Term left = term.getArgument((byte) 0); int root = left.getRoot(); if (root == closureId) { // The first argument of apply is a partially applied term // term = apply (closure (f x1 ...xk)) y, arity(f) > k // Therefore, apply it to the second argoment Term right = term.getArgument((byte) 1); Term closureArg = left.getArgument((byte) 0); int symbolRoot = closureArg.getRoot(); Term[] symbolArg = closureArg.getArgument(); int length = symbolArg.length; Term[] symbolNewArg = new Term[length + 1]; System.arraycopy(symbolArg, 0, symbolNewArg, 0, length); symbolNewArg[length] = right; Term newTerm = new Term(symbolRoot, symbolNewArg); // newTerm = f x1 ... xn y int symbolArity = MapTable.getSymbol(symbolRoot).arity; if (symbolArity > length + 1) { // newTerm is still partially applied. // Therefore, wrap it by the "closure" symbol. // newTerm = closure (f x1 ... xn y) newTerm = new Term(closureId, new Term[]{newTerm}); } if (Tracer.reduction) Tracer.traceRewrite(computation, term, newTerm); term.update(newTerm); } else { // The first argument of apply is a fully applied term // term = apply (f x1 ...xk) y, arity(f) == k // Therefore, reduce it to a HNF, a partially applied term computation.push(left); } } public String printAsTxtLoadable() { return "external function \"apply\""; } } }