@@ -24,9 +24,9 @@ import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
25infer :: Interfaces -> CanonicalModule -> Either [Doc] (Map.Map String CanonicalType)
25infer :: Interfaces -> CanonicalModule -> Either [Doc] (Map.Map String CanonicalType)
26infer interfaces modul = unsafePerformIO $ do
26infer interfaces modul = unsafePerformIO $ do
27+ let moduleBody = body modul
28+ adts = Map.unions (datatypes moduleBody : map iAdts (Map.elems interfaces))
27− env <- Env.initialEnvironment
29+ env <- Env.initialEnvironment adts
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 ->
30 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
31 do (_, vars, args, result) <- Env.freshDataScheme env name
31 do (_, vars, args, result) <- Env.freshDataScheme env name
32 return (name, (vars, foldr (T.==>) result args))
32 return (name, (vars, foldr (T.==>) result args))
@@ -42,16 +42,16 @@ infer interfaces modul = unsafePerformIO $ do
42 environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]
42 environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]
44 fvar <- liftIO $ T.var T.Flexible
44 fvar <- liftIO $ T.var T.Flexible
45− c <- TcExpr.constrain env (program modul) (T.VarN fvar)
45+ c <- TcExpr.constrain env (program moduleBody) (T.VarN fvar)
46 return (header, environ c)
46 return (header, environ c)
48 case attemptConstraint of
48 case attemptConstraint of
49 Left err -> return $ Left err
49 Left err -> return $ Left err
50 Right (header, constraint) -> do
50 Right (header, constraint) -> do
51 state <- execStateT (Solve.solve constraint) TS.initialState
51 state <- execStateT (Solve.solve constraint) TS.initialState
52− let rules = Alias.rules interfaces (aliases modul) (imports modul)
52+ let rules = Alias.rules interfaces (aliases moduleBody) (imports modul)
53 case TS.sErrors state of
53 case TS.sErrors state of
54 errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))
54 errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))
55− [] -> case Check.portTypes rules (program modul) of
55+ [] -> case Check.portTypes rules (program moduleBody) of
56 Right () -> Check.mainType rules (Map.difference (TS.sSavedEnv state) header)
56 Right () -> Check.mainType rules (Map.difference (TS.sSavedEnv state) header)
57 Left err -> return (Left err)
57 Left err -> return (Left err)