41 lines
1.1 KiB
Haskell
41 lines
1.1 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 TC (initialState, runCheck, infer, generalize)
|
|
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 >>= generalize . snd
|
|
let result = fst (runCheck initialState action)
|
|
|
|
case result of
|
|
Left err -> print err
|
|
Right res -> T.putStrLn (pretty res)
|
|
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
|