hm/app/Main.hs

49 lines
1.5 KiB
Haskell

import System.Exit
import Hm.Layout ( resolveLayout )
import Hm.Lex ( Token, mkPosToken )
import Hm.Par ( pExp, myLexer )
import Hm.Print ( Print, printTree )
import Data.Text (Text)
import qualified Data.Text.IO as T
import qualified Data.Set as S
import qualified Data.Map as M
import Type (initialState, emptySubst, apply)
import TC (runInfer, infer, generalize)
import Solve (runSolve)
import PostProcess (expToExp, runProcess)
import Pretty
inferType :: Text -> IO ()
inferType s = case pExp ts of
Left err -> do
putStrLn "\nParse Failed...\n"
putStrLn "Tokens:"
mapM_ (putStrLn . showPosToken . mkPosToken) ts
putStrLn err
exitFailure
Right tree -> do
putStrLn "\nParse Successful!"
putStrLn (printTree tree)
let action = runProcess (expToExp tree) S.empty >>= infer
let result = runInfer M.empty action
case result of
Left err -> print err
Right (t,_,c) -> case runSolve (emptySubst, c) of
Left err -> print err
Right subst -> case runInfer M.empty (generalize (apply subst t)) of
Left err -> print err
Right (t,_,_) -> T.putStrLn (pretty t)
where
ts = init (resolveLayout True (myLexer s))
showPosToken ((l,c),t) = concat [ show l, ":", show c, "\t", show t ]
main :: IO ()
main = T.getContents >>= inferType