compiler/Type/Inference.hs · elk

on f56db87 help sign in

elk/compiler/Type/Inference.hs

52 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 Type.ExtraChecks (extraChecks)

18import Control.Monad.State

19import Control.Arrow (second)

20import Transform.SortDefinitions as Sort

22import System.IO.Unsafe -- Possible to switch over to the ST monad instead of

23 -- the IO monad. I don't think that'd be worthwhile.

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

27infer interfaces modul = unsafePerformIO $ do

28 env <- Env.initialEnvironment

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

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

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

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

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

35 importedVars <-

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

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

39 let allTypes = ctors ++ importedVars

40 vars = concatMap (fst . snd) allTypes

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

42 environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]

44 fvar <- T.var T.Flexible

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

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

48 let errors = TS.sErrors state

49 if null errors

50 then extraChecks $ Map.difference (TS.sSavedEnv state) header

51 else Left `fmap` sequence (reverse errors)