diff --git a/tests/Tests.hs b/tests/Tests.hs index 261014c..de9ab7c 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use <$>" #-} @@ -10,32 +11,50 @@ import Grammar.Print (printTree) import System.IO (stderr) import GHC.IO.Handle.Text (hPutStrLn) + printToErr :: String -> IO () printToErr = hPutStrLn stderr --- A simple demo -simpleDemo = do - printToErr "#### f" - printToErr "-- Lifted Tree --" - printToErr $ printTree example1 - printToErr "-- Monomorphized Tree --" - printToErr $ printTree (monomorphize example1) - - printToErr "#### p" - printToErr "-- Lifted Tree --" - printToErr $ printTree example2 - printToErr "-- Monomorphized Tree --" - printToErr $ printTree (monomorphize example2) - - printToErr "#### g" - printToErr "-- Lifted Tree --" - printToErr $ printTree example3 - printToErr "-- Monomorphized Tree --" - printToErr $ printTree (monomorphize example3) - main :: IO () main = do - return () + -- Only demonstrations for now, will fail if error is thrown. + simpleDemo + +-- A simple demo +simpleDemo = do + demo "main = f 5" $ simpleProgram [f] "f" 5 + demo "main = p 5" $ simpleProgram [p] "p" 5 + demo "main = g 5" $ simpleProgram [g, p] "g" 5 + +-- Nice demo 👍 +demo :: String -> T.Program -> IO () +demo label prg = do + printToErr $ "#### " ++ label ++ " ####" + printToErr " * Lifted Tree * " + printToErr $ printTree prg + printToErr " * Monomorphized Tree * " + printToErr $ printTree (monomorphize prg) + printToErr "##########\n" + +-- Programs in the form of "main = 'func' 'x'" +simpleProgram :: [T.Bind] -> T.Ident -> Int -> T.Program +simpleProgram binds fToCall input = T.Program (T.Bind ("main", typeInt) [] (simpleProgramExp fToCall):binds) +simpleProgramExp func = T.EApp typeInt (T.EId (func, typeIntToInt)) (T.ELit typeInt $ LInt 5) + +-- f :: Int -> Int +-- f x = x + x +f = T.Bind ("f", typeIntToInt) [("x", typeInt)] fExp +fExp = T.EAdd typeInt (T.EId ("x", typeInt)) (T.EId (Ident "x", typeInt)) + +-- p :: a -> a +-- p x = x + x +p = T.Bind (Ident "p", typeAToA) [(Ident "x", typeA)] pExp +pExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EId (Ident "x", typeA)) + +-- g :: a -> a +-- g x = x + (p x) +g = T.Bind (Ident "g", typeAToA) [("x", typeA)] gExp +gExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EApp typeA (T.EId (Ident "p", typeAToA)) (T.EId (Ident "x", typeA))) -- | Reusable test constructs for Monomorpher. typeInt = T.TMono $ Ident "Int" @@ -46,42 +65,3 @@ typeA = T.TPol $ Ident "a" typeAToA = T.TArr typeA typeA --- f :: Int -> Int --- f x = x + x -fName = (Ident "f", typeIntToInt) -fArg1 = (Ident "x", typeInt) -fArgs = [fArg1] -fExp = T.EAdd typeInt (T.EId (Ident "x", typeInt)) (T.EId (Ident "x", typeInt)) -f = T.Bind fName fArgs fExp - --- p :: a -> a --- p x = x + x -pName = (Ident "p", typeAToA) -pArg1 = (Ident "x", typeA) -pArgs = [pArg1] -pExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EId (Ident "x", typeA)) -p = T.Bind pName pArgs pExp - --- g :: a -> a --- g x = x + (p x) -gName = (Ident "g", typeAToA) -gArg1 = (Ident "x", typeA) -gArgs = [gArg1] -gExp = T.EAdd typeA (T.EId (Ident "x", typeA)) (T.EApp typeA (T.EId (Ident "p", typeAToA)) (T.EId (Ident "x", typeA))) -g = T.Bind gName gArgs gExp - --- | Examples -mainName = (Ident "main", typeInt) --- func 5 -mainBoilerProg func binds = T.Program (T.Bind mainName [] (mainBoilerExp func) : binds) -mainBoilerExp func = T.EApp typeInt (T.EId (Ident func, typeIntToInt)) (T.ELit typeInt $ LInt 5) - --- main = f 5 -example1 = mainBoilerProg "f" [f] - --- main = p 5 -example2 = mainBoilerProg "p" [p] - --- main = g 5 -example3 = mainBoilerProg "g" [g, p] -