git.iko.soy/elk
on 51dfa67 help sign in
elk/compiler/Type/Inference.hs
51 lines 2.0 kB history raw
1module Type.Inference where
3import qualified Data.Map as Map
5import qualified Type.Type as T
6import qualified Type.Environment as Env
7import qualified Type.Constrain.Expression as TcExpr
8import qualified Type.Constrain.Declaration as TcDecl
9import qualified Type.Solve as Solve
11import SourceSyntax.Module as Module
12import qualified SourceSyntax.Expression as Expr
13import SourceSyntax.Location (Located, noneNoDocs)
14import SourceSyntax.PrettyPrint
15import Text.PrettyPrint
16import qualified Type.State as TS
17import Control.Monad.State
18import Control.Arrow (second)
19import Transform.SortDefinitions as Sort
21import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
22 -- the IO monad. I don't think that'd be worthwhile.
25infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
26infer interfaces modul = unsafePerformIO $ do
27 env <- Env.initialEnvironment
28 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
29 (aliases modul ++ concatMap iAliases (Map.elems interfaces))
30 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
31 do (_, vars, args, result) <- Env.freshDataScheme env name
32 return (name, (vars, foldr (T.==>) result args))
34 importedVars <-
35 forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->
36 (,) name `fmap` Env.instantiateType env tipe Map.empty
38 let allTypes = ctors ++ importedVars
39 vars = concatMap (fst . snd) allTypes
40 header = Map.map snd (Map.fromList allTypes)
41 environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]
43 fvar <- T.var T.Flexible
44 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
46 state <- execStateT (Solve.solve constraint) TS.initialState
47 let errors = TS.sErrors state
48 if null errors
49 then return $ Right (Map.difference (TS.sSavedEnv state) header)
50 else Left `fmap` sequence (reverse errors)