49 lines
1.5 KiB
Haskell
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
|