Click here to Skip to main content
11,435,048 members (49,218 online)
Click here to Skip to main content
Add your own
alternative version

Cat - A Statically Typed Programming Language Interpreter in C#

, 4 Nov 2006
This article contains the public domain implementation of an interpreter for a statically typed stack-based programming language in C# called Cat. The accompanying article is a high-level description of how the various modules work, a brief description of the language, and links to related work.
/// 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"); 
        }
    }
}

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here

Share

About the Author

Christopher Diggins
Software Developer Autodesk
Canada Canada
This article was written by Christopher Diggins, a computer science nerd who currently works at Autodesk as an SDK specialist.
Follow on   Twitter   Google+   LinkedIn

| Advertise | Privacy | Terms of Use | Mobile
Web04 | 2.8.150428.2 | Last Updated 4 Nov 2006
Article Copyright 2006 by Christopher Diggins
Everything else Copyright © CodeProject, 1999-2015
Layout: fixed | fluid