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.Text;

namespace Cat
{
    /// <summary>
    /// This class is used to provide unit testing of high-level components. Primarily 
    /// this tests the type inference engine, the atomic operations and the standard 
    /// prdefined library functions.
    /// </summary>
    public static class Tests
    {
        #region static fields
        // These two fields are counters to report the number of passing and failing tests
        private static int nPass = 0;
        private static int nFail = 0;
        #endregion
    
        /// <summary>
        /// This is used primarily to output a failed test message to the console. 
        /// This is a good place to set breakpoints when debugging. 
        /// </summary>
        public static void Log(string s)
        {
            Console.WriteLine(s);
        }

        /// <summary>
        /// This will execute a string of valid Cat code, catching any exception and 
        /// counting them and logging them as failing the test.
        /// </summary>
        public static void TestExecute(string s)
        {
            try
            {
                Executor.Execute(s + "\n");
                nPass++;
            }
            catch (Exception e)
            {
                Log("Execution of '" + s + "' threw an exception '" + e.Message + "'");
                nFail++;
            }
        }

        /// <summary>
        /// This function works like TestExecute, but if no exception is thrown it is treated like 
        /// a test failure. 
        /// </summary>
        public static void TestFailExecute(string s)
        {
            try
            {
                Executor.Execute(s + "\n");
                Log("Expected failure to execute '" + s + "'");
                nFail++;
            }
            catch 
            {
                nPass++;
            }
        }

        /// <summary>
        /// This will infer the type for a sequence of functions passed to sProgram as a string (without curly braces)
        /// and then compare those against the type written in sType. 
        /// </summary>
        public static void TestInferTypes(string sProgram, string sType)
        {
            if (!Config.gbStaticTyping)
                return;
            Function p = null;
            CatType t = null;
            try
            {
                p = Function.MakeFunction(sProgram);
                t = CatType.MakeCatType(sType);
                if (!p.mpType.IsTypeEq(t))
                {
                    Log("Type inference failed for '" + sProgram + "', expected '" + t.ToString() + "' but inferred '" + p.mpType.ToString() + "'");
                    nFail++;
                }
                else
                {
                    nPass++;
                }
            }
            catch (Exception e)
            {
                Log("Exception occured when inferring types for '" + sProgram + "' : " + e.Message);
                nFail++;
            }
        }

        /// <summary>
        /// This tests two types for equality. 
        /// </summary>
        public static void TypeEqTest(string s1, string s2)
        {
            CatType t1 = CatType.MakeCatType(s1);
            CatType t2 = CatType.MakeCatType(s2);
            if (!t1.IsTypeEq(t2))
            {
                Log("Type equality test failed between " + t1.ToString() + " to " + t2.ToString());
                nFail++;
            }
            else
            {
                if (!t2.IsTypeEq(t1))
                {
                    Log("Type equality test partially failed between " + t2.ToString() + " to " + t1.ToString());
                    nFail++;
                }
                else
                {
                    nPass++;
                }
            }
        }

        /// <summary>
        /// This tests two types to assure that they are not equal. 
        /// </summary>
        public static void TypeNotEqTest(string s1, string s2)
        {
            CatType t1 = CatType.MakeCatType(s1);
            CatType t2 = CatType.MakeCatType(s2);
            if (t1.IsTypeEq(t2))
            {
                Log("Type non-equality test failed between " + t1.ToString() + " to " + t2.ToString());
                nFail++;
            }
            else
            {
                if (t2.IsTypeEq(t1))
                {
                    Log("Type non-equality partially failed between " + t2.ToString() + " to " + t1.ToString());
                    nFail++;
                }
                else
                {
                    nPass++;
                }
            }
        }

        /// <summary>
        /// Compare will execute two function (which are passed without curly braces). Each one should generate
        /// a single value, which is compared using the eq atomic operation. The resulting stack should hold a 
        /// single boolean value of true in order for the test to pass.
        /// </summary>
        public static void Compare(string s1, string s2)
        {
            try
            {
                Function p1 = Function.MakeFunction(s1);
                Function p2 = Function.MakeFunction(s2);
                p1.Exec();
                Object o1 = Executor.Peek();
                p2.Exec();
                Object o2 = Executor.Peek();
                Executor.Execute("=");
                
                bool b = Executor.TypedPop<bool>();
                if (!b) 
                    throw new Exception(o1.ToString() + " and " + o2.ToString() + " are not equal");
                if (!Executor.IsEmpty())
                    throw new Exception("stack should be empty");

                if (Config.gbStaticTyping)
                {
                    FxnType ft1 = p1.GetFxnType();
                    FxnType ft2 = p2.GetFxnType();
                    if (!(ft1.IsTypeEq(ft2)))
                        throw new Exception("expected type to be equal: " + ft1.ToString() + " and " + ft2.ToString());
                }
                nPass++;
            }
            catch (Exception e)
            {
                Log("Exception occured when comparing '" + s1 + "' and '" + s2 + "' : " + e.Message);
                nFail++;
            }
            Executor.ClearStack();
        }

        /// <summary>
        /// Test the behaviour of many atomic programs and basic .
        /// </summary>
        public static void RunLibraryTests()
        {
            if (!Config.gbUnitTesting) 
                return;

            TestExecute("define _test : (B:any A:any)->(bool) { eq }");
            TestExecute("define _test : ()->(bool) { 1 1 eq }");
            TestExecute("define _test : ()->() { true [] [] if }");
            TestExecute("define _test : ()->(int) { true [1] [2] if }");

            if (Config.gbUnitTestingWithExceptions)
            {
                TestFailExecute("define _test : ()->(int) { true [1] [\"fubar\"] if }");
                TestFailExecute("define _test : ()->(string) { true [1] [\"fubar\"] if }");
                TestFailExecute("define _test : ()->(int) { true [1] [\"fubar\"] if }");
            }

            Compare("0 0 +", "0");
            Compare("1 0 +", "1");
            Compare("0 1 +", "1");
            Compare("1 1 +", "2");
            Compare("1 1 +", "2");
            Compare("0 ++", "1");
            Compare("1 ++", "2");
            Compare("2 --", "1");
            Compare("1 --", "0");
            Compare("1 2 max", "2");
            Compare("2 1 max", "2");
            Compare("1 1 max", "1");

            // Simple comparison tests.
            Compare("0 0 >", "false");
            Compare("1 0 >", "true");
            Compare("0 1 >", "false");
            Compare("1 1 >", "false");
            Compare("0 0 >=", "true");
            Compare("1 0 >=", "true");
            Compare("0 1 >=", "false");
            Compare("1 1 >=", "true");
            Compare("0 0 <", "false");
            Compare("1 0 <", "false");
            Compare("0 1 <", "true");
            Compare("1 1 <", "false");
            Compare("0 0 <=", "true");
            Compare("1 0 <=", "false");
            Compare("0 1 <=", "true");
            Compare("1 1 <=", "true");
            
            // Uncategorized tests.
            Compare("6 7 *", "42");
            Compare("7 7 +", "14");
            Compare("42 7 /", "6");
            Compare("1 2 +", "3");
            Compare("1 2 [+] eval", "3");
            Compare("1 2 3 [+] dip pop", "3");
            Compare("1 2 3 4 [+] diip pop pop", "3");
            Compare("2 3 [1 +] dip +", "6");
            Compare("[0 1 2] $", "3 n");
            Compare("[] $", "new_list");
            Compare("3 n", "new_list 2 cons 1 cons 0 cons");
            Compare("3 n", "3 n uncons cons");
            Compare("3 n", "[1 2 3] $ [dec] map");
            Compare("3 n", "4 n 3 take");
            Compare("3 n", "[42 0 1 2] $ 1 drop");
            Compare("15", "6 n 0 [+] fold");
            Compare("\"abcd\"", "\"ab\" \"cd\" str_cat");
            Compare("\"abcd\"", "\"cd\" \"ab\" swap str_cat");
            Compare("\"abcd\"", "\"cd\" [\"ab\"] dip str_cat");
            Compare("\"abcd\"", "\"ab\" \"cd\" pair str_fold");          
            
            // The following tests were taken from the tutorial October 29
            // it is just a good idea to make sure that the tutorial works!
            Compare("1 id", "1");
            Compare("27 3 /", "9");
            Compare("1 2 + 5 *", "15");
            Compare("1 2 >", "false");
            Compare("1 1 =", "true");
            Compare("[1 2] $", "[1 2 3 pop] $");
            Compare("[1 1 2] $", "[1 2 dupd] $");
            Compare("[1 1 2] $", "[1 2 [dup] dip] $");
            Compare("[2 1 3] $", "[1 2 3 [swap] dip] $");
            Compare("[2 1 3] $", "[1 2 3 swapd] $");
            Compare("[1 2 3 pop dup] $", "[1 2 2] $");
            Compare("[1 2 +] eval", "3");
            Compare("[1 2 +] $", "[3] $");
            Compare("[0 1 2 3 4] $", "5 n");
            Compare("5 n [2 *] map", "[0 2 4 6 8] $");
            Compare("5 [10 +] init", "[10 11 12 13 14] $");
            Compare("5 [10 +] init", "5 n [10 +] map");
            Compare("1 even", "false");
            Compare("0 even", "true");
            Compare("2 even", "true");
            Compare("3 even", "false");
            Compare("10 n [even] filter", "5 n [2 *] map");
            
            // The following tests were added November 1st.

            if (Config.gbUnitTestingWithExceptions)
            {
                // This is an interesting failure. It fails, while one might expect it to 
                // work. Notice that the [inc] consumes and produces a single int, while 
                // the [dup2 + 5 >] consumes two ints and produces two ints and a bool. 
                TestFailExecute("define _test { 1 1 [dup2 + 5 >] [inc] while }");
            }
            
            // The following is correct because forces the "inc" to actually consume and 
            // produce two values. This result is worth an article all by itself. 
            TestInferTypes("1 1 [dup2 + 5 >] [[id] dip inc] while", "()->(int int)");

            TestInferTypes("dup2 +", "(int int)->(int int int)");
            TestInferTypes("dup2 + 5 >", "(int int)->(int int bool)");
            TestInferTypes("0 [dup 3 <] [inc] while", "()->(int)");
            TestInferTypes("[dup 3 <] [inc] while", "(int)->(int)");
            TestInferTypes("id", "(A:any)->(A)");
            TestInferTypes("[id] dip", "(A:any B:any)->(A B)");
            TestInferTypes("[append] dip", "(list A:any B:any)->(list B)");
            TestInferTypes("1 [append] dip", "(list A:any)->(list int)");
            TestInferTypes("dup [append] dip", "(list A:any)->(list A)");
            TestInferTypes("dup [append] dip inc", "(list int)->(list int)");
            TestInferTypes("dup2 dup 3 <", "(A:any int)->(A int A int bool)");
            TestInferTypes("dup 3 <", "(int)->(int bool)");
            TestInferTypes("dup2 [pop] dip 3 <", "(A:any int)->(A int bool)");

            Compare("3", "0 [dup 3 <] [inc] while");
            Compare("new_list 0 cons", "[0] $");
            Compare("new_list 0 cons 1 cons", "[1 0] $"); 
            Compare("[new_list 0 dup [append] dip inc] $", "[[0] $ 1] $");
            Compare("[1 2 3 dup2] $", "[1 2 3 2 3] $");
            
            // Note that we have to force the loop body to conform to the signature: (list A)->(list A) 
            // for symmetry with the type of the body. Maintaining type symmetry between the 
            // loop body and loop invariant can be very challenging. 
            Compare("3 n", "new_list 0 [dup2 [pop] dip 3 <] [dup [append] dip inc] while pop");
        }

        public static void RunTypeInferenceTests()
        {
            if (!Config.gbUnitTesting)
                return;

            TestInferTypes("", "()->()");
            TestInferTypes("pop", "(A:any)->()");
            TestInferTypes("pop pop", "(A:any B:any)->()");
            TestInferTypes("pop pop pop", "(A:any B:any C:any)->()");
            TestInferTypes("1", "()->(int)");
            TestInferTypes("1 2", "()->(int int)");
            TestInferTypes("1 2 3", "()->(int int int)");
            TestInferTypes("1 2 pop", "()->(int)");
            TestInferTypes("1 pop", "()->()");
            TestInferTypes("1 2 pop pop", "()->()");
            TestInferTypes("1 2 3 pop pop", "()->(int)");
            TestInferTypes("1 2 pop pop pop", "(A:any)->()");
            TestInferTypes("true", "()->(bool)");
            TestInferTypes("1 true", "()->(int bool)");
            TestInferTypes("1 2 true", "()->(int int bool)");
            TestInferTypes("true 1", "()->(bool int)");
            TestInferTypes("true 1 2", "()->(bool int int)");
            TestInferTypes("1 dup", "()->(int int)");
            TestInferTypes("1 dup dup", "()->(int int int)");
            TestInferTypes("1 pop", "()->()");
            TestInferTypes("1 dup pop", "()->(int)");
            TestInferTypes("1 2 +", "()->(int)");
            TestInferTypes("1 +", "(int)->(int)");
            TestInferTypes("1 + pop", "(int)->()");
            TestInferTypes("1 + pop pop", "(A:any int)->()");
            TestInferTypes("1 +", "(int)->(int)");
            TestInferTypes("load", "(A:any)()->()(A)");
            TestInferTypes("store", "()(A:any)->(A)()");
            TestInferTypes("1 load", "()()->()(int)");
            TestInferTypes("1 load store", "()->(int)");
            TestInferTypes("1 2 load", "()()->(int)(int)");
            TestInferTypes("1 2 load load", "()()->()(int int)");
            TestInferTypes("1 2 load load store", "()()->(int)(int)");
            TestInferTypes("1 + load", "(int)()->()(int)");
            TestInferTypes("eval", "(A (A:any*)->(B:any*))->(B)");
            TestInferTypes("[] eval", "()->()");
            TestInferTypes("[1] eval", "()->(int)");
            TestInferTypes("[1 2] eval", "()->(int int)");
            TestInferTypes("[swap] eval", "(A:any B:any)->(B A)");
            TestInferTypes("[pop] eval", "(A:any)->()");
            TestInferTypes("true [] [] if", "()->()");
            TestInferTypes("[] [] if", "(bool)->()");
            TestInferTypes("true [1] [2] if", "()->(int)");
            TestInferTypes("[1] [2] if", "(bool)->(int)");
            TestInferTypes("dup", "(A:any)->(A A)");
            TestInferTypes("dup dup", "(A:any)->(A A A)");
            TestInferTypes("dup pop", "(A:any)->(A)");
            TestInferTypes("dup dup pop", "(A:any)->(A A)");
            TestInferTypes("pop", "(A:any)->()");
            TestInferTypes("swap", "(A:any B:any)->(B A)");
            TestInferTypes("swap swap", "(A:any B:any)->(A B)");
            TestInferTypes("swap swap swap", "(A:any B:any)->(B A)");
            TestInferTypes("swap pop", "(A:any B:any)->(B)");
            TestInferTypes("pop swap", "(A:any B:any C:any)->(B A)");
            TestInferTypes("swap pop swap", "(A:any B:any C:any)->(C A)");
            TestInferTypes("load", "(A:any)()->()(A)");
            TestInferTypes("store", "()(A:any)->(A)()");
            TestInferTypes("1 load", "()()->()(int)");
            TestInferTypes("1 load store", "()()->(int)()");
            TestInferTypes("pop load", "(A:any B:any)()->()(A)");
            TestInferTypes("dup load", "(A:any)()->(A)(A)");
            TestInferTypes("swap load", "(A:any B:any)()->(B)(A)");
            TestInferTypes("swap load store", "(A:any B:any)()->(B A)()");
            TestInferTypes("load load", "(A:any B:any)()->()(B A)");
            TestInferTypes("store store", "()(A:any B:any)->(B A)()");
            TestInferTypes("store load", "()(A:any)->()(A)");
            TestInferTypes("store swap load", "(A:any)(B:any)->(B)(A)");
            TestInferTypes("[eval] eval", "(A (A:any*)->(B:any*))->(B)");
            TestInferTypes("eval eval", "((A:any*)->(B:any* C (C:any*)->(D:any*)))->(D)");
            TestInferTypes("load eval", "(A (A:any*)->(C:any*) B:any)()->(C)(B)");
            TestInferTypes("load eval store", "(A (A:any*)->(C:any*) B:any)->(C B)");
            TestInferTypes("swap load", "(A:any B:any)()->(B)(A)");
            TestInferTypes("swap load eval", "(A B:any (A:any*)->(C:any*))()->(C)(B)");
            TestInferTypes("swap load eval store", "(A B:any (A:any*)->(C:any*))->(C B)");
            TestInferTypes("name_of", "((A:any*)->(B:any*))->((A)->(B) string)");
            TestInferTypes("desc_of", "((A:any*)->(B:any*))->((A)->(B) string)");
        }

        /// <summary>
        /// These tests are designed to assure that the type comparison functions 
        /// work correctly.
        /// </summary>
        public static void RunTypeComparisonTests()
        {
            if (!Config.gbUnitTesting)
                return;

            TypeEqTest("()->()", "()->()");
            TypeEqTest("(int)->(int)", "(int)->(int)");
            TypeEqTest("()->(int)", "()->(int)");
            TypeEqTest("(int)->()", "(int)->()");
            TypeEqTest("(A:any)->(int)", "(A:any)->(int)");
            TypeEqTest("(A:any)->(int)", "(B:any)->(int)");
            TypeEqTest("(A:any*)->(int)", "(A:any*)->(int)");
            TypeEqTest("(A:any*)->(int)", "(B:any*)->(int)");
            TypeEqTest("(int)->(A:any*)", "(int)->(A:any*)");
            TypeEqTest("(int)->(A:any*)", "(int)->(B:any*)");
            TypeEqTest("(A:any)->(B:any)", "(A:any)->(B:any)");
            TypeEqTest("(A:any)->(B:any)", "(B:any)->(A:any)");
            TypeEqTest("(A:any)->(B:any)", "(C:any)->(D:any)");
            TypeEqTest("(A:any*)->(B:any*)", "(A:any*)->(B:any*)");
            TypeEqTest("(A:any*)->(B:any*)", "(B:any*)->(A:any*)");
            TypeEqTest("(A:any*)->(B:any*)", "(C:any*)->(D:any*)");
            
            TypeNotEqTest("()->()", "(int)->()");
            TypeNotEqTest("(A:any)->(int)", "(A:any)->()");
            TypeNotEqTest("(A:any)->(int)", "(A:any)->(B:any)");
            TypeNotEqTest("(int)->(int)", "(A:any)->()");
            TypeNotEqTest("(int)->(int)", "(A:any)->(B:any)");
            TypeNotEqTest("(A:any)->(B:any)", "(A:any B:any)->(B:any)");
            TypeNotEqTest("(A:any)->(B:any)", "(A:any* B:any)->(B:any)");
            TypeNotEqTest("(A:any)->(B:any)", "(A:any*)->(B:any)");
        }

        /// <summary>
        /// Runs inference testing and type comparison tests.
        /// </summary>
        public static void RunCoreTests()
        {
            if (!Config.gbUnitTesting)
                return;

            RunTypeComparisonTests();
            RunTypeInferenceTests();
        }

        /// <summary>
        /// Runs tests that will fail in the current release. 
        /// </summary>
        public static void RunKnownIssuesTests()
        {
            if (!Config.gbUnitTesting)
                return;

            if (!Config.gbTestKnownIssues)
                return;

            // This takes a function, which takes itself as input. 
            // This concept can't currently be expressed in the language. 
            // What is misssing is the ability to express recursive types.
            // TestInferTypes("dup eval", "???");

            // This test works but the type isn't exactly what one would hope for.
            // I would rather have some kind of result which wasn't constrained,
            TestInferTypes("swap eval", "((A)->(B:any*) A:any)->(B)");

            // This causes a lot assertions to fail. Specifically what seems to occur
            // is that certain functions are duplicated. 
            TestInferTypes("dup name_of", "((A:any*)->(B:any*))->((A)->(B) (A)->(B) string)");
        }

        /// <summary>
        /// Writes to the console how many tests passed and how many failed. 
        /// But only if Config.gbUnitTesting is set to true
        /// </summary>
        public static void OutputTestCoverage()
        {
            if (!Config.gbUnitTesting)
                return;

            int nTotal = nPass + nFail;
            Console.WriteLine();
            Console.WriteLine("Unit test coverage: passed " + nPass.ToString() + " out of " + nTotal.ToString() + " tests"); 
        }
    }
}