Cat - A Statically Typed Programming Language Interpreter in C#

/// Public domain code by Christopher Diggins
/// http://www.cat-language.com

using System;
using System.Collections.Generic;
using System.Reflection;
using System.Text;

namespace Cat
{
    /// <summary>
    /// Used to associate program objects with PrimitiveDelegates. 
    /// </summary>
    public delegate void PrimitiveDelegate();

    /// <summary>
    /// Represents a built in function. 
    /// </summary>
    public class Primitive : Function
    {
        PrimitiveDelegate mpDeleg;

        public Primitive(PrimitiveDelegate deleg, string sName, string sType, string sDesc)
        {
            msName = sName;
            mpDeleg = deleg;
            msDesc = sDesc;
            SetType(sType);
        }
        public override void AbstractExec()
        {
            mpDeleg();
        }
        public virtual MethodInfo GetMethodInfo()
        {
            return mpDeleg.Method;
        }
    }

    /// <summary>
    /// This class is used for associating built-in (atomic) operations and standard library
    /// operations with names, types, and descriptions. I'm calling this process registration.
    /// The actual implementations of the primitive functions are static functions which are 
    /// stored in the "Executor" class. 
    /// </summary>
    class Primitives : CatBase
    {
        /// <summary>
        /// Associates a static void function with no parameters (an OpDelegate) 
        /// with a name, a type and a description, inside of the global scope. 
        /// </summary>
        public static void RegPrimitive(PrimitiveDelegate pDeleg, string sName, string sType, string sDesc)
        {
            Scope.Global().AddProgram(new Primitive(pDeleg, sName, sType, sDesc));
        }

        /// <summary>
        /// Defines and registers a standard library function. The question here was why 
        /// not implement the standard library externally in a source file. This makes
        /// it easier to test and use the library in the UnitTests module, and to debug.
        /// </summary>
        public static void RegLibFxn(string sName, string sCode, string sExpType, string sDesc)
        {
            try
            {
                Function p = Function.MakeNamedFunction(sName, sCode, Scope.Global(), sDesc);
                CatType pExpType = CatType.MakeCatType(sExpType);

                if (Config.gbStaticTyping)
                {
                    if (!pExpType.IsTypeEq(p.GetFxnType()))
                        Throw("Expected type " + sExpType + " but found " + p.GetFxnType().ToString());
                }
            }
            catch (Exception e)
            {
                WriteLine("failed to register library function " + sName + " = { " + sCode + " ); " + e.Message);
            }
        }

        /// <summary>
        /// Descriptionless and typeless library function registration function.
        /// </summary>
        public static void RegLibFxn(string sName, string sCode)
        {
            try
            {
                Function.MakeNamedFunction(sName, sCode, Scope.Global(), "");
            }
            catch (Exception e)
            {
                WriteLine("failed to register library function " + sName + " = { " + sCode + " ); " + e.Message);
            }
        }

        /// <summary>
        /// This loads defintions for the core (atomic) operations into the Cat interpreter at the global scope.
        /// These functions are associated with names, descriptions and types. All atomic programs are defined 
        /// as static functions which take no args, and operate by manipulating the main and/or auxiliary stacks 
        /// in the Executor. This is the best place to start for modidifying the underlying language. Make sure 
        /// that any new functions you introduce have the correct type, otherwise you will break the type system. 
        /// </summary>
        public static void RegisterAtomicPrograms()
        {
            // Environment operations
            RegPrimitive(Executor.Defs, "defs", "() ~> (list)", "creates a list containing each defined function");

            // Basic Operators
            RegPrimitive(Executor.NullOp, "null_op", "() -> ()", "does nothing");
            RegPrimitive(Executor.Id, "id", "(A:any) -> (A)", "returns a value");
            RegPrimitive(Executor.Exec, "eval", "(A (A:any*) -> (B:any*)) -> (B)", "evaluates a function");
            RegPrimitive(Executor.Exec, "exec", "(A (A:any*) ~> (B:any*)) ~> (B)", "evaluates an impure function");
            RegPrimitive(Executor.Swap, "swap", "(A:any B:any) -> (B A)", "swaps the top two items on the stack");
            RegPrimitive(Executor.Dup, "dup", "(A:any) -> (A A)", "duplicates the top item on the stack");
            RegPrimitive(Executor.Zap, "pop", "(A:any) -> ()", "removes the top item from the stack");

            // Artithmetic operators
            RegPrimitive(Executor.Max, "max", "(int int) -> (int)", "returns the larger of two integers");
            RegPrimitive(Executor.Min, "min", "(int int) -> (int)", "returns the smaller of two integers");
            RegPrimitive(Executor.Inc, "inc", "(int) -> (int)", "adds one to an integer");
            RegPrimitive(Executor.Dec, "dec", "(int) -> (int)", "subtracts one from an integer");
            RegPrimitive(Executor.Add, "+", "(int int) -> (int)", "adds two integers");
            RegPrimitive(Executor.Sub, "-", "(int int) -> (int)", "subtracts the top value from the second value");
            RegPrimitive(Executor.Mul, "*", "(int int) -> (int)", "multiplies two integers");
            RegPrimitive(Executor.Div, "/", "(int int) -> (int)", "divides the top value from the second value");
            RegPrimitive(Executor.Mod, "%", "(int int) -> (int)", "modulos the top value from the second value");
            RegPrimitive(Executor.DivMod, "/%", "(int int) -> (int int)", "divides two integers and returns the quotient and remainder");
            RegPrimitive(Executor.Neg, "neg", "(int) -> (int)", "negates an integer");
            RegPrimitive(Executor.Compl, "compl", "(int) -> (int)", "returns the twos-complement of an integer");

            // Integer Comparison operators
            RegPrimitive(Executor.Gt, ">", "(int int) -> (bool)", "returns true if the second value is greater than the top value");
            RegPrimitive(Executor.GtEq, ">=", "(int int) -> (bool)", "returns true if the second value is greater than or equal to the top value");
            RegPrimitive(Executor.Lt, "<", "(int int) -> (bool)", "returns true if the second value is less than than the top value");
            RegPrimitive(Executor.LtEq, "<=", "(int int) -> (bool)", "return true if the second value is less than or equal to the top value");

            // Generic Comparison Operators
            RegPrimitive(Executor.Eq, "=", "(A:any B:any) -> (bool)", "returns true if the top two values are the same");

            // Logical Operators
            RegPrimitive(Executor.True, "true", "()->(bool)", "pushes a true value onto the stack");
            RegPrimitive(Executor.False, "false", "()->(bool)", "pushes a false value onto the stack");
            RegPrimitive(Executor.And, "and", "(bool bool) -> (bool)", "computes the logical and of the top two values");
            RegPrimitive(Executor.Or, "or", "(bool bool) -> (bool)", "computes the logical or of the top two values");
            RegPrimitive(Executor.NOr, "nor", "(bool bool) -> (bool)", "computes the logical nor of the top two values");
            RegPrimitive(Executor.NAnd, "nand", "(bool bool) -> (bool)", "computes the logical nand of the top two values");
            RegPrimitive(Executor.XOr, "xor", "(bool bool) -> (bool)", "computes the logical xor of the top two values");
            RegPrimitive(Executor.Not, "not", "(bool) -> (bool)", "returns the opposite of the top value on the stack");
            
            // Control Flow Operators
            RegPrimitive(Executor.If, "if", "(A bool (A)->(B) (A:any*)->(B:any*)) -> (B)", "evaluates the top function if the boolean value is false, otherwise evaluates the second function");
            RegPrimitive(Executor.While, "while", "(A (A)->(A bool) (A:any*)->(A)) -> (A)", "repeatedly executes the top function while the conditional program evaluates to true");

            // Misc Operators
            RegPrimitive(Executor.Write, "write", "(A:any)~>()", "writes a string representation of a value to the console");
            RegPrimitive(Executor.WriteLine, "write_line", "(A:any)~>()", "writes a string representation of a value followed by a newline character to the console");
            RegPrimitive(Executor.Man, "man", "((A:any*)~>(B:any*))~>((A)~>(B))", "provides detailed information about a specific function");
            RegPrimitive(Executor.ClearStack, "clear", "(A:any*)(B:any*)->()()", "clears both the main and auxiliary stack");

            // Type Operators
            RegPrimitive(Executor.PushIntType, "int", "()->(typeid)", "pushes a value representing the int type onto the stack");
            RegPrimitive(Executor.PushBoolType, "bool", "()->(typeid)", "pushes a value representing the bool type onto the stack");
            RegPrimitive(Executor.PushStringType, "string", "()->(typeid)", "pushes a value representing the string type onto the stack");
            RegPrimitive(Executor.PushListType, "list", "()->(typeid)", "pushes a value representing the string type onto the stack");
            RegPrimitive(Executor.PushVarType, "var", "()->(typeid)", "pushes a value representing the var type onto the stack");
            RegPrimitive(Executor.TypeOf, "type_of", "(A:any)->(A typeid)", "pushes a value representing the type onto the stack");
            RegPrimitive(Executor.TypeOf, "var_tag", "(var)->(var typeid)", "pushes a value representing the type of the value stored in the variant onto the stack");
            RegPrimitive(Executor.TypeEq, "type_eq", "(typeid typeid)->(bool)", "returns true if the types are the same");

            // Function operations
            RegPrimitive(Executor.Decompose, "decompose", "((A:any*)->(B:any*))->(list)", "returns a list a function's sub-functions");
            RegPrimitive(Executor.NameOf, "name_of", "((A:any*)->(B:any*))->((A)->(B) string)", "returns the name of a function");
            RegPrimitive(Executor.DescOf, "desc_of", "((A:any*)->(B:any*))->((A)->(B) string)", "returns a short description of a function if available");
            //RegisterOp(Executor.Compose, "compose", "(list)->((list)->(list))");

            // Auxiliary operations
            RegPrimitive(Executor.Load, "load", "(A:any)()->()(A)", "moves the top value from the main stack to the auxiliary stack");
            RegPrimitive(Executor.Store, "store", "()(A:any)->(A)()", "moves the top value from the auxiliary stack to the main stack");

            // Casting functions
            RegPrimitive(Executor.CastToVar, "to_var", "(A:any)->(var)", "converts a value to a variant");
            RegPrimitive(Executor.CastToInt, "to_int", "(A:any)->(int)", "converts a value to an integer");
            RegPrimitive(Executor.CastToBool, "to_bool", "(A:any)->(bool)", "converts a value to a boolean");
            RegPrimitive(Executor.CastToString, "to_string", "(A:any)->(string)", "converts a value to a string");
            RegPrimitive(Executor.CastToList, "to_list", "(A:any)->(list)", "if the top value is a list does nothing otherwise a creates a list holding one item");

            // List operations
            RegPrimitive(Executor.QuoteToList, "$", "(()->(A:any*))->(list)", "creates a list from the results of executing a quuotation");
            RegPrimitive(Executor.NewList, "new_list", "()->(list)", "pushes an empty list on to the stack");
            RegPrimitive(Executor.Single, "single", "(A:any)->(list)", "creates a new list holding only the top item from the stack");
            RegPrimitive(Executor.Pair, "pair", "(A:any B:any)->(list)", "creates a new list holding the top two items from the stack");
            RegPrimitive(Executor.Map, "map", "(list (A:any)->(B:any*))->(list)", "transforms a list by applying the function to each value");
            RegPrimitive(Executor.ForEach, "for_each", "(list (A:any)~>())~>(list)", "executes an impure function with each item in the list");
            RegPrimitive(Executor.Append, "append", "(list A:any)->(list)", "adds the value on top of the stack to the end of a list");
            RegPrimitive(Executor.Prepend, "prepend", "(list A:any)->(list)", "inserts the value on top of the stack at the beginning of a list");
            RegPrimitive(Executor.Gen, "gen", "((A)->(bool) (A:any)->(A))->(list)", "generates a list using a generator function, until the predicate returns false");
            RegPrimitive(Executor.N, "n", "(int)->(list)", "returns the first x natural numbers");
            RegPrimitive(Executor.Init, "init", "(int (int)->(A:any))->(list)", "creates a list by calling a generator function x times");
            RegPrimitive(Executor.Head, "head", "(list)->(var)", "returns the first item in a list");
            RegPrimitive(Executor.Tail, "tail", "(list)->(list)", "returns a list which is missing the first item of the list");
            RegPrimitive(Executor.Take, "take", "(list int)->(list)", "returns a list containing the first x items of the list on top of the stack");
            RegPrimitive(Executor.Drop, "drop", "(list int)->(list)", "returns a list equivalent to the list on top of the stack but without the first x items");
            RegPrimitive(Executor.Cat, "cat", "(list list)->(list)", "concatenates two lists");
            RegPrimitive(Executor.Fold, "fold", "(list A (A A:any)->(A))->(A)", "combines all items in a lists by applying the function to the cumulative result and the next value in the list");
            RegPrimitive(Executor.Filter, "filter", "(list (A:any)->(bool))->(list)", "creates a new list of values from the original list which satisfy the predicate");

            // String operations
            RegPrimitive(Executor.StrCat, "str_cat", "(string string)->(string)", "concatenates two strings");
            RegPrimitive(Executor.Tab, "tab", "()->(string)", "returns a string containing a tab character");
            RegPrimitive(Executor.NewLine, "nl", "()->(string)", "returns a string containing a new-line character");
            RegPrimitive(Executor.NewString, "new_str", "()->(string)", "creates a new empty string");
            RegPrimitive(Executor.StrLen, "str_len", "(string)->(string int)", "returns the size of a string");
            RegPrimitive(Executor.SubStr, "sub_str", "(int int string)->(string)", "returns a sub-string of another string, the top int is the number of characters and the lower one is the first index");

            // RegEx operations
            RegPrimitive(Executor.RegExSplit, "split", "(string string)->(list)", "splits a string using the regular expression on top of the stack");
            RegPrimitive(Executor.RegExMatch, "match", "(string string)->(list)", "matches a string using the regular expression on top of the stack");
            RegPrimitive(Executor.RegExReplace, "replace", "(string string string)->(string)", "replaces matches in a string using the regular expression on top of the stack");
        
            // File operations 
            RegPrimitive(Executor.StrToFile, "str_to_file", "(string string)~>()", "writes a string to the file named on the top of the stack");
            RegPrimitive(Executor.StrFromFile, "str_from_file", "(string)~>(string)", "reads a string from the file");
        }

        public static void RegisterStdPrograms()
        {
            /////////////////////
            // Derived functions
            
            // Arithmetic functions 
            RegLibFxn("++", "inc", "(int) -> (int)", "adds one to an integer");
            RegLibFxn("--", "dec", "(int) -> (int)", "subtracts one from an integer");
            RegLibFxn("pred", "dup inc", "(int)->(int int)", "copies the integer on top of the stack, and increments the copy");
            RegLibFxn("succ", "dup dec", "(int)->(int int)", "copies the integer on top of the stack, and decrements the copy");            
            RegLibFxn("<>", "= not", "(A:any B:any)->(bool)", "returns true if the two top values are not equal");
            RegLibFxn("eq", "=", "(A:any B:any)->(bool)", "returns true if the two top values are not equal");
            RegLibFxn("neq", "<>", "(A:any B:any)->(bool)", "returns true if the two top values are not equal");
            RegLibFxn("even", "2 % 0 =", "(int)->(bool)", "return true if the top number is even");
            RegLibFxn("odd", "2 % 1 =", "(int)->(bool)", "return true if the top number is even");

            // Combinators 
            RegLibFxn("dip", "swap load eval store", "(A C:any (A:any*)->(B:any*))->(B C)", "executes the function on the top of the stack, but first hides the value below it, restoring it after completion");
            RegLibFxn("diip", "swap load dip store", "(A D:any C:any (A:any*)->(B:any*))->(B D C)", "works like dip but hides and restores two values on top of the stack");            

            // Stack manipulators
            RegLibFxn("swapd", "[swap] dip", "(A:any B:any C:any)->(B A C)", "swaps the two elements below the top element of the stack");
            RegLibFxn("dupd", "[dup] dip", "(A:any B:any)->(A A B)", "duplicates the element below the top element of the stack");
            RegLibFxn("dup2", "dupd dup swapd", "(A:any B:any)->(A B A B)", "duplicates the top two elements");
           
            // List operations
            RegLibFxn("cons", "prepend", "(list A:any)->(list)", "appends a value to a list");
            RegLibFxn("uncons", "dup head [tail] dip", "(list)->(list var)", "separates a list into its tail and head");
            RegLibFxn("triple", "[pair] dip cons", "(A:any B:any C:any)->(list)", "creates a list from the three top elements on the stack");

            // String functions
            RegLibFxn("str_fold", "\"\" [str_cat] fold", "(list)->(string)", "concatenates a list of strings");

            // Help functions
            RegLibFxn("name_desc", "name_of write tab write desc_of write_line pop", "((A:any*)->(B:any*)) ~> ()", "outputs the name and description of a function");
            RegLibFxn("help", "defs [name_desc] for_each pop", "()~>()", "outputs a list of commands and descriptiuons");
        }
    }
}