67 lines
2 KiB
Haskell
67 lines
2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
{-# HLINT ignore "Use <$>" #-}
|
|
|
|
module Main where
|
|
import Grammar.Abs (Ident (Ident), Literal (LInt))
|
|
import qualified TypeChecker.TypeCheckerIr as T
|
|
|
|
import Monomorpher.Monomorpher (monomorphize)
|
|
import Grammar.Print (printTree)
|
|
import System.IO (stderr)
|
|
import GHC.IO.Handle.Text (hPutStrLn)
|
|
|
|
|
|
printToErr :: String -> IO ()
|
|
printToErr = hPutStrLn stderr
|
|
|
|
main :: IO ()
|
|
main = do
|
|
-- 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"
|
|
|
|
typeIntToInt = T.TArr typeInt typeInt
|
|
|
|
typeA = T.TPol $ Ident "a"
|
|
|
|
typeAToA = T.TArr typeA typeA
|
|
|