compiler/Type/Inference.hs · elk

on 2d4afca help sign in

elk/compiler/Type/Inference.hs

50 lines 1.9 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.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. I don't think that'd be worthwhile.

24infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)

25infer interfaces modul = unsafePerformIO $ do

26 env <- Env.initialEnvironment

27 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))

28 (aliases modul ++ concatMap iAliases (Map.elems interfaces))

29 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->

30 do (_, vars, args, result) <- Env.freshDataScheme env name

31 return (name, (vars, foldr (T.==>) result args))

33 importedVars <-

34 forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->

35 (,) name `fmap` Env.instantiateType env tipe Map.empty

37 let allTypes = ctors ++ importedVars

38 vars = concatMap (fst . snd) allTypes

39 header = Map.map snd (Map.fromList allTypes)

40 environ = T.CLet [ T.Scheme vars [] T.CTrue header ]

42 fvar <- T.var T.Flexible

43 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)

45 state <- execStateT (Solve.solve constraint) TS.initialState

46 let errors = TS.sErrors state

47 if null errors

48 then return $ Right (Map.difference (TS.sSavedEnv state) header)

49 else Left `fmap` sequence (reverse errors)