git.iko.soy/elk
on eaa751d help sign in
elk/compiler/Type/Inference.hs
64 lines 2.5 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
12import qualified SourceSyntax.Expression as Expr
13import SourceSyntax.PrettyPrint
14import Text.PrettyPrint
15import qualified Type.State as TS
16import Control.Monad.State
17import Control.Arrow (second)
18import Transform.SortDefinitions as Sort
20import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
21 -- the IO monad. Not sure if that'd be worthwhile.
24infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
25infer interfaces' modul = unsafePerformIO $ do
26 let localImports = Map.fromList (imports modul)
27 interfaces = Map.intersectionWithKey canonicalize localImports interfaces'
29-- mapM print (concatMap iAdts (Map.elems interfaces))
31 env <- Env.initialEnvironment (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
32 var <- T.flexibleVar
33 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
34 do (_, vars, tipe) <- Env.freshDataScheme env name
35 return (name, (vars, tipe))
37 let locals = Map.intersectionWithKey combine localImports interfaces
38 combine name importMethod interface =
39 let tipes = iTypes interface in
40 case importMethod of
41 As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
42 Hiding hidens -> foldr Map.delete tipes hidens
43 Importing visibles ->
44 Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
46-- mapM print (map Map.toList $ Map.elems locals)
47-- mapM print (imports modul)
49 importedVars <-
50 forM (concatMap Map.toList $ Map.elems locals) $ \(name,tipe) ->
51 (,) name `fmap` Env.instantiateTypeWithContext env tipe Map.empty
53 let allTypes = ctors ++ importedVars
54 vars = concatMap (fst . snd) allTypes
55 header = Map.map snd (Map.fromList allTypes)
56 environ = T.CLet [ T.Scheme vars [] T.CTrue header ]
57 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN var)
58-- print =<< T.extraPretty constraint
59 state <- execStateT (Solve.solve constraint) TS.initialState
60 let errors = TS.sErrors state
61 if null errors
62 then return $ Right (Map.difference (TS.sSavedEnv state) header)
63 else Left `fmap` sequence errors