--
-- Adapted from the program "infer", believed to have been originally
-- authored by Philip Wadler, and used in the nofib benchmark suite
-- since at least the late 90s.
--
module Main where
import Parse
import Lex
import Term
import Type
import Environment
import InferMonad
import Infer
import Control.Monad.Par.Scheds.Trace
import System.IO
import System.Exit (exitWith, ExitCode(..))
import qualified Data.Map as Map
main :: IO ()
main = do
l <- getContents
case parseBinds (alexScanTokens l) of
Left err -> die err
Right t -> print (inferBinds initialEnv t)
die :: String -> IO ()
die s = hPutStrLn stderr s >> exitWith (ExitFailure 1)
test :: String -> IO ()
test str =
case parseExp (alexScanTokens str) of
Left err -> die err
Right t -> print (useI (error "type error") $ inferTerm initialEnv t)
inferBinds :: Env -> [(VarId,Term)] -> [(VarId,PolyType)]
inferBinds e t = runPar $ do
ys <- mapM (\(x,ty) -> do v <- newFull ty; return (x,v)) (unmakeEnv e)
let topenv = Map.fromList ys
inferTop topenv t
initialEnv :: Env
initialEnv = foldl (uncurry . extendGlobal) emptyEnv types
where
types = [("+",intop),("*",intop),("-",intop),("/",intop)]
intop = All [] (intType `arrow` intType `arrow` intType)