/// Dedicated to the public domain by Christopher Diggins /// http://creativecommons.org/licenses/publicdomain/ using System; using System.IO; using System.Collections; using System.Collections.Generic; using System.Reflection; using System.Threading; using System.Text; using System.Text.RegularExpressions; namespace Cat { public class CatException : Exception { object data; public CatException(object o) { data = o; } public object GetObject() { return data; } } public class Primitives { #region conversion functions public class EvalFun : PrimitiveFunction { public EvalFun() : base("eval", "(list string ~> list)", "evaluates a string as a function using the list as a stack", "level2,misc") { } public override void Eval(Executor exec) { string s = exec.PopString(); Executor aux = new Executor(exec); aux.Execute(s); exec.Push(aux.GetStackAsList()); } } public class Str : PrimitiveFunction { public Str() : base("str", "(any -> string)", "converts any value into a string representation.", "level2,strings") { } public override void Eval(Executor exec) { exec.Push(Output.ObjectToString(exec.Pop())); } } public class MakeByte : PrimitiveFunction { public MakeByte() : base("int_to_byte", "(int -> byte)", "converts an integer into a byte, throwing away sign and ignoring higher bits", "level1,math,conversion") { } public override void Eval(Executor exec) { int n = exec.PopInt(); byte b = (byte)n; exec.Push(b); } } public class BinStr : PrimitiveFunction { public BinStr() : base("bin_str", "(int -> string)", "converts a number into a binary string representation.", "level2,strings,math,conversion") { } public override void Eval(Executor exec) { int n = exec.PopInt(); string s = ""; if (n == 0) s = "0"; while (n > 0) { if (n % 2 == 1) { s = "1" + s; } else { s = "0" + s; } n /= 2; } exec.PushString(n.ToString(s)); } } public class HexStr : PrimitiveFunction { public HexStr() : base("hex_str", "(int -> string)", "converts a number into a hexadecimal string representation.", "level2,strings,math,conversion") { } public override void Eval(Executor exec) { int n = exec.PopInt(); exec.PushString(n.ToString("x")); } } #endregion #region primitive function classes public class Halt : PrimitiveFunction { public Halt() : base("halt", "(int ~> )", "halts the program with an error code", "level2,application") { } public override void Eval(Executor exec) { int n = exec.PopInt(); throw new Exception("Program halted with error code " + n.ToString()); } } public class Id : PrimitiveFunction { public Id() : base("id", "('a -> 'a)", "does nothing, but requires one item on the stack.", "level1,misc") { } public override void Eval(Executor exec) { } } public class Eq : PrimitiveFunction { public Eq() : base("eq", "('a 'a -> bool)", "returns true if both items on stack have the same value", "level1,comparison") { } public override void Eval(Executor exec) { Object x = exec.Pop(); Object y = exec.Pop(); exec.PushBool(x.Equals(y)); } } public class Dup : PrimitiveFunction { public Dup() : base("dup", "('a -> 'a 'a)", "duplicate the top item on the stack", "level0,stack") { } public override void Eval(Executor exec) { exec.Dup(); } } public class Pop : PrimitiveFunction { public Pop() : base("pop", "('a -> )", "removes the top item from the stack", "level0,stack") { } public override void Eval(Executor exec) { exec.Pop(); } } public class Swap : PrimitiveFunction { public Swap() : base("swap", "('a 'b -> 'b 'a)", "swap the top two items on the stack", "level0,stack") { } public override void Eval(Executor exec) { exec.Swap(); } } #endregion #region function functions public class ApplyFxn : PrimitiveFunction { public ApplyFxn() : base("apply", "('A ('A -> 'B) -> 'B)", "applies a function to the stack (i.e. executes an instruction)", "level0,functions") { } public override void Eval(Executor exec) { Function f = exec.TypedPop(); f.Eval(exec); } } public class ApplyOneFxn : PrimitiveFunction { public ApplyOneFxn() : base("A", "('a ('a -> 'b) -> 'b)", "applies a unary function to its argument", "functions") { } public override void Eval(Executor exec) { Function f = exec.TypedPop(); f.Eval(exec); } } public class PartialApplyFxn : PrimitiveFunction { public PartialApplyFxn() : base("papply", "('C 'a ('A 'a -> 'B) -> 'C ('A -> 'B))", "partial application: binds the top argument to the top value in the stack", "level0,functions") { } public override void Eval(Executor exec) { exec.Execute("swap quote swap compose"); } } public class Dip : PrimitiveFunction { public Dip() : base("dip", "('A 'b ('A -> 'C) -> 'C 'b)", "evaluates a function, temporarily removing second item", "level0,functions") { } public override void Eval(Executor exec) { Function f = exec.TypedPop(); Object o = exec.Pop(); f.Eval(exec); exec.Push(o); } } public class Compose : PrimitiveFunction { public Compose() : base("compose", "(('A -> 'B) ('B -> 'C) -> ('A -> 'C))", "creates a function by composing (concatenating) two existing functions", "level0,functions") { } public override void Eval(Executor exec) { QuotedFunction right = exec.TypedPop(); QuotedFunction left = exec.TypedPop(); QuotedFunction f = new QuotedFunction(left, right); exec.PushFxn(f); } } public class Pull : PrimitiveFunction { public Pull() : base("pull", "(( -> 'A 'b) -> ( -> 'A) 'b)", "deconstructs a function", "experimental") { } public override void Eval(Executor exec) { QuotedFunction f = exec.TypedPeek(); int n = f.GetSubFxns().Count; Function g = f.GetSubFxns()[n - 1]; if (((g is PushFunction) || (g is QuotedFunction) || (g is QuotedValue)) || (g is PushValueBase)) { f.GetSubFxns().RemoveAt(n - 1); g.Eval(exec); } else if (g is PushStack) { Executor e2 = (g as PushStack).GetStack(); exec.Push(e2.Pop()); } else { exec.Pop(); Executor e2 = new Executor(); f.Eval(e2); Object o = e2.Pop(); Function h = new PushStack(e2); exec.Push(h); exec.Push(o); } } } public class Quote : PrimitiveFunction { public Quote() : base("quote", "('a -> ( -> 'a))", "creates a constant generating function from the top value on the stack", "level0,functions") { } public override void Eval(Executor exec) { Object o = exec.Pop(); QuotedValue q = new QuotedValue(o); exec.PushFxn(q); } } public class Dispatch1 : PrimitiveFunction { public Dispatch1() : base("dispatch1", "('a list -> any)", "dynamically dispatches a function depending on the type on top of the stack", "level1,functions") { } public override void Eval(Executor exec) { CatList fs = exec.TypedPop(); Object o = exec.Peek(); for (int i = 0; i < fs.Count / 2; ++i) { Type t = fs[i * 2 + 1] as Type; Function f = fs[i * 2] as Function; if (t.IsInstanceOfType(o)) { f.Eval(exec); return; } } throw new Exception("could not dispatch function"); } } public class Dispatch2 : PrimitiveFunction { public Dispatch2() : base("dispatch2", "('a 'b list -> any)", "dynamically dispatches a function depending on the type on top of the stack", "level1,functions") { } public override void Eval(Executor exec) { CatList fs = exec.TypedPop(); Object o = exec.Peek(); for (int i = 0; i < fs.Count / 2; ++i) { Type t = fs[i * 2 + 1] as Type; Function f = fs[i * 2] as Function; if (t.IsInstanceOfType(o)) { f.Eval(exec); return; } } throw new Exception("could not dispatch function"); } } #endregion #region reflection api public class Explode : PrimitiveFunction { public Explode() : base("explode", "('A -> 'B) -> list)", "breaks a function up into a list of instructions", "level2,functions") { } public CatList FxnsToList(CatExpr fxns) { CatList list = new CatList(); foreach (Function f in fxns ) { if (f is PushFunction) { list.Add(FxnsToList(f.GetSubFxns())); } else if (f is DefinedFunction) { DefinedFunction def = f as DefinedFunction; if (f.GetSubFxns().Count > 0) { foreach (Function g in f.GetSubFxns()) list.Add(g); } else { list.Add(f); } } else { list.Add(f); } } return list; } public override void Eval(Executor exec) { QuotedFunction f = exec.TypedPop(); exec.Push(FxnsToList(f.GetSubFxns())); } } #endregion #region control flow primitives public class Default : PrimitiveFunction { public Default() : base("default", "('A -> 'B) -> ('A int -> 'B)", "used to construct a default 'case' statement", "level1,control,functions") { } public override void Eval(Executor exec) { QuotedFunction f = exec.TypedPop(); f.GetSubFxns().Insert(0, new Pop()); JumpTable jt = new JumpTable(f); exec.Push(jt); } } public class Case : PrimitiveFunction { public Case() : base("case", "('A int -> 'B) ('A -> 'B) int -> ('A int -> 'B)", "used to construct a 'case' statement member of a switch statement", "level1,control,functions") { } public override void Eval(Executor exec) { int n = exec.PopInt(); Function f = exec.TypedPop(); Function g = exec.TypedPeek(); if (g is JumpTable) { JumpTable jt = g as JumpTable; jt.AddCase(n, f); } else { exec.Pop(); JumpTable jt = new JumpTable(g); exec.Push(jt); } } } /* public class CallCC : PrimitiveFunction { public CallCC() : base("callcc", "('A ('A ('B -> 'C) -> 'B) ~> 'B)", "calls a function with the current continuation", "experimental") { } public override void Eval(Executor exec) { throw new Exception("unimplemented"); // TODO: make a copy of the stack, and a pointer to the current instruction. // this implies that I need to make a copy of the index stream. } }*/ public class While : PrimitiveFunction { public While() : base("while", "('A ('A -> 'A) ('A -> 'A bool) -> 'A)", "executes a block of code repeatedly until the condition returns true", "level1,control") { } public override void Eval(Executor exec) { Function cond = exec.TypedPop(); Function body = exec.TypedPop(); cond.Eval(exec); while ((bool)exec.Pop()) { body.Eval(exec); cond.Eval(exec); } } } public class If : PrimitiveFunction { public If() : base("if", "('A bool ('A -> 'B) ('A -> 'B) -> 'B)", "executes one predicate or another whether the condition is true", "level0,control") { } public override void Eval(Executor exec) { Function onfalse = exec.TypedPop(); Function ontrue = exec.TypedPop(); if ((bool)exec.Pop()) { ontrue.Eval(exec); } else { onfalse.Eval(exec); } } } public class BinRec : PrimitiveFunction { // The fact that it takes 'b instead of 'B is a minor optimization for untyped implementations // I may ignore it later on. public BinRec() : base("bin_rec", "('a ('a -> bool) ('a -> 'b) ('a -> 'C 'a 'a) ('C 'b 'b -> 'b) -> 'b)", "execute a binary recursion process", "level1,control") { } public class BinRecHelper { Executor mExec; Function mResultRelation; Function mArgRelation; Function mBaseCase; Function mCondition; public BinRecHelper(Executor exec, Function fResultRelation, Function fArgRelation, Function fBaseCase, Function fCondition) { mExec = exec; mResultRelation = fResultRelation; mArgRelation = fArgRelation; mBaseCase = fBaseCase; mCondition = fCondition; } public void LocalExec() { mCondition.Eval(mExec); if (mExec.PopBool()) { mBaseCase.Eval(mExec); } else { mArgRelation.Eval(mExec); Object o = mExec.Pop(); LocalExec(); mExec.Push(o); LocalExec(); mResultRelation.Eval(mExec); } } static public void LaunchThread(Object o) { BinRecHelper h = o as BinRecHelper; try { h.LocalExec(); } finally { mWait.Set(); } } static EventWaitHandle mWait = new EventWaitHandle(false, EventResetMode.AutoReset); public void Exec() { if (!Config.gbMultiThreadBinRec) { LocalExec(); return; } mCondition.Eval(mExec); if (mExec.PopBool()) { mBaseCase.Eval(mExec); } else { mArgRelation.Eval(mExec); Executor e2; e2 = new Executor(); e2.Push(mExec.Pop()); BinRecHelper h2 = new BinRecHelper(e2, mResultRelation, mArgRelation, mBaseCase, mCondition); Thread t = new Thread(new ParameterizedThreadStart(LaunchThread)); t.Start(h2); LocalExec(); mWait.WaitOne(); mExec.Push(e2.Pop()); mResultRelation.Eval(mExec); } } } public override void Eval(Executor exec) { Function fResultRelation = exec.PopFxn(); Function fArgRelation = exec.PopFxn(); Function fBaseCase = exec.PopFxn(); Function fCondition = exec.PopFxn(); BinRecHelper h = new BinRecHelper(exec, fResultRelation, fArgRelation, fBaseCase, fCondition); h.Exec(); } } public class Throw : PrimitiveFunction { public Throw() : base("throw", "(any -> )", "throws an exception", "level2,control") { } public override void Eval(Executor exec) { object o = exec.Pop(); throw new CatException(o); } } public class TryCatch : PrimitiveFunction { public TryCatch() : base("try_catch", "(( -> 'A) (exception -> 'A) -> 'A)", "evaluates a function, and catches any exceptions", "level2,control") { } public override void Eval(Executor exec) { Function c = exec.TypedPop(); Function t = exec.TypedPop(); int n = exec.Count(); try { t.Eval(exec); } catch (CatException e) { exec.ClearTo(n); Output.WriteLine("exception caught"); exec.Push(e.GetObject()); c.Eval(exec); } } } #endregion #region boolean functions public class True : PrimitiveFunction { public True() : base("true", "( -> bool)", "pushes the boolean value true on the stack", "level0,boolean") { } public override void Eval(Executor exec) { exec.PushBool(true); } } public class False : PrimitiveFunction { public False() : base("false", "( -> bool)", "pushes the boolean value false on the stack", "level0,boolean") { } public override void Eval(Executor exec) { exec.PushBool(false); } } public class And : PrimitiveFunction { public And() : base("and", "(bool bool -> bool)", "returns true if both of the top two values on the stack are true", "level0,boolean") { } public override void Eval(Executor exec) { bool x = (bool)exec.Pop(); bool y = (bool)exec.Pop(); exec.PushBool(x && y); } } public class Or : PrimitiveFunction { public Or() : base("or", "(bool bool -> bool)", "returns true if either of the top two values on the stack are true", "level0,boolean") { } public override void Eval(Executor exec) { bool x = (bool)exec.Pop(); bool y = (bool)exec.Pop(); exec.PushBool(x || y); } } public class Not : PrimitiveFunction { public Not() : base("not", "(bool -> bool)", "returns true if the top value on the stack is false", "level0,boolean") { } public override void Eval(Executor exec) { exec.PushBool(!(bool)exec.Pop()); } } #endregion #region type functions public class TypeName : PrimitiveFunction { public TypeName() : base("typename", "(any -> string)", "returns the name of the type of an object", "level1,types") { } public override void Eval(Executor exec) { Object o = exec.Pop(); exec.PushString(CatKind.TypeNameFromObject(o)); } } public class TypeId : PrimitiveFunction { public TypeId() : base("typeof", "(any -> any type)", "returns a type tag for an object", "level1,types") { } public override void Eval(Executor exec) { // TODO: fix this some day Object o = exec.Peek(); if (o is CatList) { // HACK: this is not the correct type! exec.Push(typeof(CatList)); } else if (o is Function) { // HACK: this is not the correct type! exec.Push((o as Function).GetFxnType()); } else { // HACK: this is not the correct type! exec.Push(o.GetType()); } } } public class TypeType : PrimitiveFunction { public TypeType() : base("type_type", "( -> type)", "pushes a value representing the type of a type", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(Type)); } } public class IntType : PrimitiveFunction { public IntType() : base("int_type", "( -> type)", "pushes a value representing the type of an int", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(int)); } } public class StrType : PrimitiveFunction { public StrType() : base("string_type", "( -> type)", "pushes a value representing the type of a string", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(string)); } } public class DblType : PrimitiveFunction { public DblType() : base("double_type", "( -> type)", "pushes a value representing the type of a double", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(double)); } } public class ByteType : PrimitiveFunction { public ByteType() : base("byte_type", "( -> type)", "pushes a value representing the type of a byte", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(byte)); } } public class BitType : PrimitiveFunction { public BitType() : base("bit_type", "( -> type)", "pushes a value representing the type of a bit", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(Bit)); } } public class BoolType : PrimitiveFunction { public BoolType() : base("bool_type", "( -> type)", "pushes a value representing the type of a boolean", "level1,types") { } public override void Eval(Executor exec) { exec.Push(typeof(Bit)); } } public class TypeEq : PrimitiveFunction { public TypeEq() : base("type_eq", "(type type -> bool)", "returns true if either type is assignable to the other", "level1,types") { } public override void Eval(Executor exec) { Type t = exec.TypedPop(); Type u = exec.TypedPop(); exec.PushBool(t.Equals(u) || u.Equals(t)); } } // TODO: complete the type functions #endregion #region date-time functions public class Now : PrimitiveFunction { public Now() : base("now", "( ~> date_time)", "pushes a value representing the current date and time", "level2,datetime") { } public override void Eval(Executor exec) { exec.Push(DateTime.Now); } } public class SubTime : PrimitiveFunction { public SubTime() : base("sub_time", "(date_time date_time -> time_span)", "computes the time period between two dates", "level2,datetime") { } public override void Eval(Executor exec) { DateTime x = exec.TypedPop(); DateTime y = exec.TypedPop(); exec.Push(y - x); } } public class AddTime : PrimitiveFunction { public AddTime() : base("add_time", "(date_time time_span -> date_time)", "computes a date by adding a time period to a date", "level2,datetime") { } public override void Eval(Executor exec) { TimeSpan x = exec.TypedPop(); DateTime y = exec.TypedPop(); exec.Push(y + x); } } public class ToMsec : PrimitiveFunction { public ToMsec() : base("to_msec", "(time_span -> int)", "computes the length of a time span in milliseconds", "level2,datetime") { } public override void Eval(Executor exec) { exec.Push(exec.TypedPop().TotalMilliseconds); } } #endregion #region int functions public class AddInt : PrimitiveFunction { public AddInt() : base("add_int", "(int int -> int)", "adds two integers", "level0,math") { } public override void Eval(Executor exec) { exec.PushInt(exec.PopInt() + exec.PopInt()); } } public class MulInt : PrimitiveFunction { public MulInt() : base("mul_int", "(int int -> int)", "multiplies two integers", "level0,math") { } public override void Eval(Executor exec) { exec.PushInt(exec.PopInt() * exec.PopInt()); } } public class DivInt : PrimitiveFunction { public DivInt() : base("div_int", "(int int -> int)", "divides the top value (an integer) from the second value (an integer)", "level0,math") { } public override void Eval(Executor exec) { int x = exec.PopInt(); int y = exec.PopInt(); exec.PushInt(y / x); } } public class SubInt : PrimitiveFunction { public SubInt() : base("sub_int", "(int int -> int)", "subtracts the top value (an integer) from the second value (an integer)", "level0,math") { } public override void Eval(Executor exec) { int x = exec.PopInt(); int y = exec.PopInt(); exec.PushInt(y - x); } } public class ModInt : PrimitiveFunction { public ModInt() : base("mod_int", "(int int -> int)", "computes the remainder of dividing the top value (an integer) from the second value (an integer)", "level0,math") { } public override void Eval(Executor exec) { int x = exec.PopInt(); int y = exec.PopInt(); exec.PushInt(y % x); } } public class NegInt : PrimitiveFunction { public NegInt() : base("neg_int", "(int -> int)", "negates the top value", "level0,math") { } public override void Eval(Executor exec) { exec.PushInt(-exec.PopInt()); } } public class ComplInt : PrimitiveFunction { public ComplInt() : base("compl_int", "(int -> int)", "performs a bitwise complement of the top value", "level0,math") { } public override void Eval(Executor exec) { exec.PushInt(~exec.PopInt()); } } public class ShlInt : PrimitiveFunction { public ShlInt() : base("shl_int", "(int int -> int)", "shifts the second value left by the number of bits indicated on the top of the stack", "level0,math") { } public override void Eval(Executor exec) { exec.Swap(); exec.PushInt(exec.PopInt() << exec.PopInt()); } } public class ShrInt : PrimitiveFunction { public ShrInt() : base("shr_int", "(int int -> int)", "shifts the second value left by the number of bits indicated on the top of the stack", "level0,math") { } public override void Eval(Executor exec) { exec.Swap(); exec.PushInt(exec.PopInt() >> exec.PopInt()); } } public class GtInt : PrimitiveFunction { public GtInt() : base("gt_int", "(int int -> bool)", "replaces the top two values (integers) with true, if the second value is greater than the top value, otherwise pushes false", "level0,math") { } public override void Eval(Executor exec) { exec.Swap(); exec.PushBool(exec.PopInt() > exec.PopInt()); } } public class LtInt : PrimitiveFunction { public LtInt() : base("lt_int", "(int int -> bool)", "replaces the top two values (integers) with true, if the second value is less than the top value, otherwise pushes false", "level0,math") { } public override void Eval(Executor exec) { exec.Swap(); exec.PushBool(exec.PopInt() < exec.PopInt()); } } public class GtEqInt : PrimitiveFunction { public GtEqInt() : base("gteq_int", "(int int -> bool)", "replaces the top two values (integers) with true, if the second value is greater than or equal to the top value, otherwise pushes false", "level0,math") { } public override void Eval(Executor exec) { exec.Swap(); exec.PushBool(exec.PopInt() >= exec.PopInt()); } } public class LtEqInt : PrimitiveFunction { public LtEqInt() : base("lteq_int", "(int int -> bool)", "replaces the top two values (integers) with true, if the second value is less than or equal to the top value, otherwise pushes false", "level0,math") { } public override void Eval(Executor exec) { exec.Swap(); exec.PushBool(exec.PopInt() <= exec.PopInt()); } } #endregion // Notice at this point I use static functions instead of declaring objects. // this is simply because I am lazy, and these few dozen operations don't really merit documentation. #region byte functions public static byte add_byte(byte x, byte y) { return (byte)(x + y); } public static byte sub_byte(byte x, byte y) { return (byte)(x - y); } public static byte div_byte(byte x, byte y) { return (byte)(x / y); } public static byte mul_byte(byte x, byte y) { return (byte)(x * y); } public static byte mod_byte(byte x, byte y) { return (byte)(x % y); } public static byte compl_byte(byte x) { return (byte)(~x); } public static byte shl_byte(byte x, byte y) { return (byte)(x << y); } public static byte shr_byte(byte x, byte y) { return (byte)(x >> y); } public static bool gt_byte(byte x, byte y) { return x > y; } public static bool lt_byte(byte x, byte y) { return x < y; } public static bool gteq_byte(byte x, byte y) { return x >= y; } public static bool lteq_byte(byte x, byte y) { return x <= y; } #endregion #region char functions public static int char_to_int(char c) { return (int)c; } public static char int_to_char(int n) { return (char)n; } public static string char_to_str(char c) { return c.ToString(); } #endregion #region bit functions public struct Bit { public bool m; public Bit(int n) { m = n != 0; } public Bit(bool x) { m = x; } public Bit add(Bit x) { return new Bit(m ^ x.m); } public Bit sub(Bit x) { return new Bit(m && !x.m); } public Bit mul(Bit x) { return new Bit(m && !x.m); } public Bit div(Bit x) { return new Bit(m && !x.m); } public Bit mod(Bit x) { return new Bit(m && !x.m); } public bool lteq(Bit x) { return !m || x.m; } public bool eq(Bit x) { return m == x.m; } public override bool Equals(object obj) { return (obj is Bit) && (((Bit)obj).m == m); } public override int GetHashCode() { return m.GetHashCode(); } public override string ToString() { return m ? "0b1" : "0b0"; } } public static Bit add_bit(Bit x, Bit y) { return x.add(y); } public static Bit sub_bit(Bit x, Bit y) { return x.sub(y); } public static Bit mul_bit(Bit x, Bit y) { return x.mul(y); } public static Bit div_bit(Bit x, Bit y) { return x.div(y); } public static Bit mod_bit(Bit x, Bit y) { return x.mod(y); } public static Bit compl_bit(Bit x) { return new Bit(!x.m); } public static bool neq_bit(Bit x, Bit y) { return !x.eq(y); } public static bool gt_bit(Bit x, Bit y) { return !x.lteq(y); } public static bool lt_bit(Bit x, Bit y) { return !x.eq(y) && x.lteq(y); } public static bool gteq_bit(Bit x, Bit y) { return x.eq(y) || !x.lteq(y); } public static bool lteq_bit(Bit x, Bit y) { return x.lteq(y); } public static Bit min_bit(Bit x, Bit y) { return new Bit(x.m && y.m); } public static Bit max_bit(Bit x, Bit y) { return new Bit(x.m || y.m); } #endregion #region double functions public static double add_dbl(double x, double y) { return x + y; } public static double sub_dbl(double x, double y) { return x - y; } public static double div_dbl(double x, double y) { return x / y; } public static double mul_dbl(double x, double y) { return x * y; } public static double mod_dbl(double x, double y) { return x % y; } public static double inc_dbl(double x) { return x + 1; } public static double dec_dbl(double x) { return x - 1; } public static double neg_dbl(double x) { return -x; } public static bool gt_dbl(double x, double y) { return x > y; } public static bool lt_dbl(double x, double y) { return x < y; } public static bool gteq_dbl(double x, double y) { return x >= y; } public static bool lteq_dbl(double x, double y) { return x <= y; } public static double min_dbl(double x, double y) { return Math.Min(x, y); } public static double max_dbl(double x, double y) { return Math.Max(x, y); } public static double abs_dbl(double x) { return Math.Abs(x); } public static double pow_dbl(double x, double y) { return Math.Pow(x, y); } public static double sqr_dbl(double x) { return x * x; } public static double sin_dbl(double x) { return Math.Sin(x); } public static double cos_dbl(double x) { return Math.Cos(x); } public static double tan_dbl(double x) { return Math.Tan(x); } public static double asin_dbl(double x) { return Math.Asin(x); } public static double acos_dbl(double x) { return Math.Acos(x); } public static double atan_dbl(double x) { return Math.Atan(x); } public static double atan2_dbl(double x, double y) { return Math.Atan2(x, y); } public static double sinh_dbl(double x) { return Math.Sinh(x); } public static double cosh_dbl(double x) { return Math.Cosh(x); } public static double tanh_dbl(double x) { return Math.Tanh(x); } public static double sqrt_dbl(double x) { return Math.Sqrt(x); } public static double trunc_dbl(double x) { return Math.Truncate(x); } public static double round_dbl(double x) { return Math.Round(x); } public static double ceil_dbl(double x) { return Math.Ceiling(x); } public static double floor_dbl(double x) { return Math.Floor(x); } public static double log_dbl(double x, double y) { return Math.Log(x, y); } public static double log10_dbl(double x) { return Math.Log10(x); } public static double ln_dbl(double x) { return Math.Log(x); } public static double e() { return Math.E; } public static double pi() { return Math.PI; } public static string format_scientific(double x) { return x.ToString("E"); } public static string format_currency(double x) { return x.ToString("C"); } #endregion #region string functions public static bool gt_str(string x, string y) { return x.CompareTo(y) > 0; } public static bool lt_str(string x, string y) { return x.CompareTo(y) < 0; } public static bool gteq_str(string x, string y) { return x.CompareTo(y) >= 0; } public static bool lteq_str(string x, string y) { return x.CompareTo(y) <= 0; } public static string min_str(string x, string y) { return lteq_str(x, y) ? x : y; } public static string max_str(string x, string y) { return gteq_str(x, y) ? x : y; } public static string add_str(string x, string y) { return x + y; } public static string sub_str(string x, int i, int n) { return x.Substring(i, n); } public static string new_str(char c, int n) { return new string(c, n); } public static int index_of(string x, string y) { return x.IndexOf(y); } public static string replace_str(string x, string y, string z) { return x.Replace(y, z); } public static CatList str_to_list(string x) { return new CatList(x); } public static string list_to_str(CatList x) { string result = ""; foreach (Object o in x) result += o.ToString(); return result; } #endregion #region console functions public class Write : PrimitiveFunction { public Write() : base("write", "('a ~> )", "outputs the text representation of a value to the console","level1,console") { } public override void Eval(Executor exec) { Output.Write(exec.Pop()); } } public class WriteLn : PrimitiveFunction { public WriteLn() : base("writeln", "('a ~> )", "outputs the text representation of a value to the console followed by a newline character","level1,console") { } public override void Eval(Executor exec) { Output.WriteLine(exec.Pop()); } } public class ReadLn : PrimitiveFunction { public ReadLn() : base("readln", "( ~> string)", "inputs a string from the console", "level1,console") { } public override void Eval(Executor exec) { exec.PushString(Console.ReadLine()); } } public class ReadKey : PrimitiveFunction { public ReadKey() : base("readch", "( ~> char)", "inputs a single character from the console", "level1,console") { } public override void Eval(Executor exec) { exec.Push(Console.ReadKey().KeyChar); } } #endregion #region i/o functions public class OpenFileReader : PrimitiveFunction { public OpenFileReader() : base("file_reader", "(string -> istream)", "creates an input stream from a file name","level2,streams") { } public override void Eval(Executor exec) { string s = exec.PopString(); exec.Push(File.OpenRead(s)); } } public class OpenWriter : PrimitiveFunction { public OpenWriter() : base("file_writer", "(string -> ostream)", "creates an output stream from a file name", "level2,streams") { } public override void Eval(Executor exec) { string s = exec.PopString(); exec.Push(File.Create(s)); } } public class FileExists : PrimitiveFunction { public FileExists() : base("file_exists", "(string -> string bool)", "returns a boolean value indicating whether a file or directory exists", "level2,streams") { } public override void Eval(Executor exec) { string s = exec.PeekString(); exec.Push(Directory.Exists(s)); } } public class TmpFileName : PrimitiveFunction { public TmpFileName() : base("temp_file", "( -> string)", "creates a unique temporary file", "level2,streams") { } public override void Eval(Executor exec) { exec.Push(Path.GetTempFileName()); } } /* TODO: reimplement these functions * public class ReadBytes : PrimitiveFunction { public ReadBytes() : base("read_bytes", "(istream int -> istream byte_block)", "reads a number of bytes into an array from an input stream") { } public override void Eval(Executor exec) { int n = exec.PopInt(); Stream f = exec.TypedPeek(); byte[] ab = new byte[n]; f.Read(ab, 0, n); exec.Push(new MArray(ab)); } } public class WriteBytes : PrimitiveFunction { public WriteBytes() : base("write_bytes", "(ostream byte_block -> ostream)", "writes a byte array to an output stream") { } public override void Eval(Executor exec) { MArray mb = exec.TypedPop>(); Stream f = exec.TypedPeek(); f.Write(mb.m, 0, mb.Count()); } } */ public class CloseStream : PrimitiveFunction { public CloseStream() : base("close_stream", "(stream ~> )", "closes a stream", "level2,streams") { } public override void Eval(Executor exec) { Stream f = exec.TypedPop(); f.Flush(); f.Close(); f.Dispose(); } } #endregion #region hash functions public class MakeHashList : PrimitiveFunction { public MakeHashList() : base("hash_list", "( -> hash_list)", "makes an empty hash list", "level2,hash") { } public override void Eval(Executor exec) { exec.Push(new HashList()); } } public class HashGet : PrimitiveFunction { public HashGet() : base("hash_get", "(hash_list any -> hash_list any)", "gets a value from a hash list using a key", "level2,hash") { } public override void Eval(Executor exec) { Object key = exec.Pop(); HashList hash = exec.TypedPeek(); Object value = hash.Get(key); exec.Push(value); } } public class HashSet : PrimitiveFunction { public HashSet() : base("hash_set", "(hash_list any any -> hash_list)", "associates the second value with a key (the top value) in a hash list", "level2,hash") { } public override void Eval(Executor exec) { Object key = exec.Pop(); Object value = exec.Pop(); HashList hash = exec.TypedPeek(); hash.Set(key, value); } } public class HashAdd : PrimitiveFunction { public HashAdd() : base("hash_add", "(hash_list any any -> hash_list)", "associates the second value with a key (the top value) in a hash list", "level2,hash") { } public override void Eval(Executor exec) { Object key = exec.Pop(); Object value = exec.Pop(); HashList hash = exec.TypedPeek(); hash.Add(key, value); } } public class HashContains : PrimitiveFunction { public HashContains() : base("hash_contains", "(hash_list any -> hash_list bool)", "returns true if hash list contains key", "level2,hash") { } public override void Eval(Executor exec) { Object key = exec.Pop(); HashList hash = exec.TypedPeek(); exec.PushBool(hash.ContainsKey(key)); } } public class HashToList : PrimitiveFunction { public HashToList() : base("hash_to_list", "(hash_list -> list)", "converts a hash_list to a list of pairs", "level2,hash") { } public override void Eval(Executor exec) { HashList hash = exec.TypedPop(); exec.Push(hash.ToArray()); } } #endregion #region list functions public class List : PrimitiveFunction { public List() : base("list", "(( -> 'A) -> list)", "creates a list from a function", "level0,lists") { } public override void Eval(Executor exec) { Function f = exec.TypedPop(); Executor e2 = new Executor(); f.Eval(e2); CatList list = e2.GetStackAsList(); exec.Push(list); } } public class Map : PrimitiveFunction { public Map() : base("map", "(list ('a -> 'b) -> list)", "creates a list from another by transforming every value using the supplied function", "level0,lists") { } public override void Eval(Executor exec) { Function f = exec.TypedPop(); CatList list = exec.TypedPeek(); int n = exec.Count(); for (int i = 0; i < list.Count; ++i) { exec.Push(list[i]); f.Eval(exec); if (exec.Count() != n + 1) throw new Exception("dynamic type-checking error in map function"); list[i] = exec.Pop(); } } } public class IsEmpty : PrimitiveFunction { public IsEmpty() : base("empty", "(list -> list bool)", "returns true if the list is empty", "level0,lists") { } public override void Eval(Executor exec) { CatList list = exec.TypedPeek(); exec.PushBool(list.IsEmpty()); } } public class Count : PrimitiveFunction { public Count() : base("count", "(list -> list int)", "returns the number of items in a list", "level1,lists") { } public override void Eval(Executor exec) { CatList list = exec.TypedPeek(); exec.Push(list.Count); } } public class Nil : PrimitiveFunction { public Nil() : base("nil", "( -> list)", "creates an empty list", "level0,lists") { } public override void Eval(Executor exec) { exec.Push(new CatList()); } } public class Cons : PrimitiveFunction { public Cons() : base("cons", "(list 'a -> list)", "prepends an item to a list", "level0,lists") { } public override void Eval(Executor exec) { object x = exec.Pop(); CatList list = exec.TypedPeek(); list.Add(x); } } public class Uncons : PrimitiveFunction { public Uncons() : base("uncons", "(list -> list any)", "returns the top of the list, and the rest of a list", "level0,lists") {} public override void Eval(Executor exec) { CatList list = exec.TypedPeek(); Object o = list[list.Count - 1]; list.RemoveAt(list.Count - 1); exec.Push(o); } } public class Cat : PrimitiveFunction { public Cat() : base("cat", "(list list -> list)", "concatenates two lists", "level1,lists") { } public override void Eval(Executor exec) { CatList second = exec.TypedPop(); CatList first = exec.TypedPeek(); first.AddRange(second); } } public class GetAt : PrimitiveFunction { public GetAt() : base("get_at", "(list int -> list any)", "returns the nth item in a list", "level1,lists") { } public override void Eval(Executor exec) { int n = exec.PopInt(); CatList list = exec.TypedPeek(); exec.Push(list[list.Count - n - 1]); } } public class SetAt : PrimitiveFunction { public SetAt() : base("set_at", "(list 'a int -> list)", "sets an item in a list", "level1,lists") { } public override void Eval(Executor exec) { int n = exec.PopInt(); Object o = exec.Pop(); CatList list = exec.TypedPeek(); list[n] = o; } } public class SwapAt : PrimitiveFunction { public SwapAt() : base("swap_at", "(list any int -> list any)", "swaps an item, with an item in the list", "level1,lists") { } public override void Eval(Executor exec) { int n = exec.PopInt(); Object o = exec.Pop(); CatList list = exec.TypedPeek(); Object x = list[n]; list[n] = o; exec.Push(x); } } #endregion #region misc functions public class RandomInt : PrimitiveFunction { static Random mGen = new Random(); public RandomInt() : base("rnd_int", "(int ~> int)", "creates a random integer between zero and some maximum value", "level1,misc") { } public override void Eval(Executor exec) { exec.PushInt(mGen.Next(exec.PopInt())); } } public class RandomDbl : PrimitiveFunction { static Random mGen = new Random(); public RandomDbl() : base("rnd_dbl", "( ~> double)", "creates a random floating point number between zero and 1.0", "level1,misc") { } public override void Eval(Executor exec) { exec.Push(mGen.NextDouble()); } } public class Null : PrimitiveFunction { public Null() : base("null", "( -> " + CatClass.GetNullType() + ")", "returns the default object with no fields") { } public override void Eval(Executor exec) { exec.Push(CatObject.GetNullObject()); } } #endregion #region casting functions public class AsVar : PrimitiveFunction { public AsVar() : base("as_var", "('a -> var)", "casts anything into a variant", "level1,conversion") { } public override void Eval(Executor exec) { // does nothing. } } public class AsBool : PrimitiveFunction { public AsBool() : base("as_bool", "(any -> bool)", "casts a variant to a bool", "level1,conversion") { } public override void Eval(Executor exec) { exec.PushBool(exec.PopBool()); } } public class AsInt : PrimitiveFunction { public AsInt() : base("as_int", "(any -> int)", "casts a variant to an int", "level1,conversion") { } public override void Eval(Executor exec) { exec.PushInt(exec.PopInt()); } } public class AsList : PrimitiveFunction { public AsList() : base("as_list", "(any -> list)", "casts a variant to a list", "level1,conversion") { } public override void Eval(Executor exec) { exec.Push(exec.TypedPop()); } } public class AsString : PrimitiveFunction { public AsString() : base("as_string", "(any -> string)", "casts a variant to a char", "level1,conversion") { } public override void Eval(Executor exec) { exec.PushString(exec.PopString()); } } public class AsDbl : PrimitiveFunction { public AsDbl() : base("as_dbl", "(any -> double)", "casts a variant to a double", "level1,conversion") { } public override void Eval(Executor exec) { exec.Push(exec.TypedPop()); } } public class AsChar : PrimitiveFunction { public AsChar() : base("as_char", "(any -> char)", "casts a variant to a double", "level1,conversion") { } public override void Eval(Executor exec) { exec.Push(exec.TypedPop()); } } public class ToInt : PrimitiveFunction { public ToInt() : base("to_int", "(any -> int)", "coerces any value to an integer", "level1,conversion") { } public override void Eval(Executor exec) { Object o = exec.Pop(); if (o is int) { exec.Push(o); } else if (o is double) { exec.Push((int)(Double)o); } else if (o is char) { exec.Push((int)(Char)o); } else if (o is string) { exec.Push(Int32.Parse(o as String)); } else if (o is bool) { exec.Push((Boolean)o ? 1 : 0); } else if (o is Bit) { exec.Push(((Bit)(o)).m ? 1 : 0); } else if (o is Stack) { exec.Push((o as Stack).Count); } else { exec.PushInt(0); } } } public class ToStr : PrimitiveFunction { public ToStr() : base("to_str", "(any -> str)", "coerces any value to a string", "level1,conversion") { } public override void Eval(Executor exec) { Object o = exec.Pop(); exec.Push(o.ToString()); } } public class ToBool : PrimitiveFunction { public ToBool() : base("to_bool", "(any -> bool)", "coerces any value to a boolean", "level1,conversion") { } public override void Eval(Executor exec) { Object o = exec.Pop(); if (o is int) { exec.Push(o); } else if (o is double) { exec.Push((Double)o != 0.0); } else if (o is char) { exec.Push((int)(Char)o != 0); } else if (o is string) { exec.Push(Boolean.Parse(o as String)); } else if (o is bool) { exec.Push(o); } else if (o is Bit) { exec.Push(((Bit)(o)).m); } else if (o is Stack) { exec.Push((o as Stack).Count == 0); } else { exec.PushBool(false); } } } #endregion #region graphics primitives #if (!NOGRAPHICS) public class OpenWindow : PrimitiveFunction { public OpenWindow() : base("open_window", "( ~> )", "opens a drawing window", "level2,graphics") { } public override void Eval(Executor exec) { WindowGDI.OpenWindow(); } } public class SaveWindow : PrimitiveFunction { public SaveWindow() : base("save_window", "(string ~> )", "saves a bitmap of the viewport", "level2,graphics") { } public override void Eval(Executor exec) { WindowGDI.SaveToFile(exec.TypedPop()); } } public class CloseWindow : PrimitiveFunction { public CloseWindow() : base("close_window", "( ~> )", "close a drawing window", "level2,graphics") { } public override void Eval(Executor exec) { WindowGDI.CloseWindow(); } } public class ClearWindow : PrimitiveFunction { public ClearWindow() : base("clear", "( ~> )", "clears the drawing window", "level2,graphics") { } public override void Eval(Executor exec) { WindowGDI.ClearWindow(); } } public class Render : PrimitiveFunction { public Render() : base("render", "(list string ~> )", "sends a drawing instruction to the graphics device", "level2,graphics") { } public override void Eval(Executor exec) { string s = exec.TypedPop(); CatList f = exec.TypedPop(); Object[] args = f.ToArray(); GraphicCommand c = new GraphicCommand(s, args); WindowGDI.Render(c); } } #endif #endregion #region .NET (CLR) reflection API public class Invoke : PrimitiveFunction { public Invoke() : base("clr_invoke", "(list string any -> any any)", "calls a method on a .NET object", "clr") { } public override void Eval(Executor exec) { Object self = exec.Pop(); string s = exec.TypedPop(); CatList a = exec.TypedPop(); MethodInfo m = self.GetType().GetMethod(s, a.GetTypeArray()); if (m == null) throw new Exception("could not find method " + s + " on object of type " + self.GetType().ToString() + " with matching types"); Object o = m.Invoke(self, a.ToArray()); exec.Push(o); exec.Push(self); } } public class SetField : PrimitiveFunction { public SetField() : base("clr_set_field", "(any string any -> any)", "assigns a value to a field of a .NET object", "clr") { } public override void Eval(Executor exec) { Object self = exec.Pop(); string s = exec.TypedPop(); Object val = exec.Pop(); FieldInfo fi = self.GetType().GetField(s); if (fi == null) throw new Exception("could not find field " + s + " on object of type " + self.GetType().ToString()); fi.SetValue(self, val); exec.Push(self); } } public class GetField : PrimitiveFunction { public GetField() : base("clr_get_field", "(string any -> any any)", "retrieves the value of a field from a .NET object", "clr") { } public override void Eval(Executor exec) { Object self = exec.Pop(); string s = exec.TypedPop(); FieldInfo fi = self.GetType().GetField(s); if (fi == null) throw new Exception("could not find field " + s + " on object of type " + self.GetType().ToString()); exec.Push(fi.GetValue(self)); exec.Push(self); } } public class ListFields : PrimitiveFunction { public ListFields() : base("clr_list_fields", "(any -> list any)", "retrieves a list of field names from a .NET object", "clr") { } public override void Eval(Executor exec) { Object self = exec.Pop(); List list = new List(); FieldInfo[] fis = self.GetType().GetFields(); foreach (FieldInfo fi in fis) list.Add(fi.Name); string[] a = list.ToArray(); exec.Push(new CatList(a)); exec.Push(self); } } public class ListMethods : PrimitiveFunction { public ListMethods() : base("clr_list_methods", "(any -> list any)", "retrieves a list of field names from a .NET object", "clr") { } public override void Eval(Executor exec) { Object self = exec.Peek(); List list = new List(); FieldInfo[] fis = self.GetType().GetFields(); foreach (FieldInfo fi in fis) list.Add(fi.Name); string[] a = list.ToArray(); exec.Push(new CatList(a)); } } public class New : PrimitiveFunction { public New() : base("clr_new", "(list string -> any)", "constructs a new .NET object", "clr") { } public override void Eval(Executor exec) { string s = exec.TypedPop(); CatList a = exec.TypedPop(); Type t = Type.GetType(s); if (t == null) throw new Exception("could not find type " + s); ConstructorInfo c = t.GetConstructor(a.GetTypeArray()); if (c == null) throw new Exception("could not find constructor for object of type " + t.ToString() + " with matching types"); Object o = c.Invoke(a.ToArray()); if (o == null) throw new Exception(s + " object could not be constructed"); exec.Push(o); } } public class ClrEnumerableToList : PrimitiveFunction { public ClrEnumerableToList() : base("clr_enumerable_to_list", "(any -> list)", "converts a .NET IEnumerable object into a list", "clr") { } public override void Eval(Executor exec) { IEnumerable e = exec.TypedPop(); exec.Push(new CatList(e)); } } #endregion #region regular expressions public class MakeRegex : PrimitiveFunction { public MakeRegex() : base("regex", "(string -> regex)", "constructs a regular expression matcher", "clr") { } public override void Eval(Executor exec) { exec.Push(new Regex(exec.TypedPop())); } } public class ReMatch : PrimitiveFunction { public ReMatch() : base("re_match", "(string regex -> list)", "matches the regular expression", "clr") { } public override void Eval(Executor exec) { Regex re = exec.TypedPop(); string s = exec.TypedPop(); List list = new List(); foreach (Match m in re.Matches(s)) list.Add(m.Value); CatList f = new CatList(list); exec.Push(f); } } public class ReFind : PrimitiveFunction { public ReFind() : base("re_find", "(string regex -> string int)", "finds the regular expression", "clr") { } public override void Eval(Executor exec) { Regex re = exec.TypedPop(); string s = exec.TypedPeek(); Match m = re.Match(s); if (m == null) exec.Push(-1); else exec.Push(m.Index); } } #endregion #region references public class Ref { Object val; public Ref(Object o) { val = o; } public Object GetVal() { return val; } public Ref SetVal(Object o) { val = o; return this; } } public class MakeRef : PrimitiveFunction { public MakeRef() : base("ref", "('a -> ref)", "creates a reference", "level2,ref") { } public override void Eval(Executor exec) { exec.Push(new Ref(exec.Pop())); } } public class GetVal : PrimitiveFunction { public GetVal() : base("getval", "(ref ~> ref any)", "gets value associated with reference", "level2,ref") { } public override void Eval(Executor exec) { exec.Push(exec.TypedPop().GetVal()); } } public class SetVal : PrimitiveFunction { public SetVal() : base("setval", "(ref any ~> ref)", "sets a reference to a new value", "level2,ref") { } public override void Eval(Executor exec) { Object o = exec.Pop(); exec.TypedPeek().SetVal(o); } } #endregion } }