From c140d690fcde3f511ddc62743531116c2acdb215 Mon Sep 17 00:00:00 2001
From: Evan Czaplicki <info@elm-lang.org>
Date: Sun, 21 Jul 2013 22:50:48 +0200
Subject: [PATCH] First draft of cross-module type checking

Currently, all top-level types are imported. No alias resolution
happens so you need to use "import open M" atm.
---
 compiler/Initialize.hs          | 14 +++++++-------
 compiler/SourceSyntax/Module.hs |  4 +++-
 compiler/Type/Environment.hs    |  7 +++++--
 compiler/Type/Inference.hs      | 14 ++++++++++----
 4 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/compiler/Initialize.hs b/compiler/Initialize.hs
index 49fc5d9..b60a310 100644
--- a/compiler/Initialize.hs
+++ b/compiler/Initialize.hs
@@ -1,4 +1,4 @@
-module Initialize (buildFromSource, getSortedModuleNames, TypeLibrary) where
+module Initialize (buildFromSource, getSortedModuleNames, Interfaces) where
 
 import qualified Data.Map as Map
 import Data.Data
@@ -17,15 +17,14 @@ import qualified Transform.SortDefinitions as SD
 import qualified Type.Inference as TI
 import qualified Type.Constrain.Declaration as TcDecl
 
-
-type TypeLibrary = Map.Map String ModuleInterface
+import System.IO.Unsafe
 
 buildFromSource ::
     (Data t, Data v) =>
-    TypeLibrary ->
+    Interfaces ->
     String ->
     Either [Doc] (MetadataModule t v)
-buildFromSource typeLibrary source =
+buildFromSource interfaces source =
   do modul@(Module _ _ _ decls') <- Parse.program source
 
      -- check for structural errors
@@ -42,14 +41,15 @@ buildFromSource typeLibrary source =
            -- reorder AST into strongly connected components
            program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
            types = Map.empty,
-           datatypes = [ (name, vars, ctors) | Datatype name vars ctors <- decls ],
+           datatypes = [ (name, vars, ctors) | Datatype name vars ctors <- decls ] ++
+                       concatMap iAdts (Map.elems interfaces),
            fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
            aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
            foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
            foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
           }
 
-     types <- TI.infer metaModule
+     types <- TI.infer interfaces metaModule
 
      return $ metaModule { types = types }
 
diff --git a/compiler/SourceSyntax/Module.hs b/compiler/SourceSyntax/Module.hs
index 137ce73..24f15af 100644
--- a/compiler/SourceSyntax/Module.hs
+++ b/compiler/SourceSyntax/Module.hs
@@ -37,9 +37,11 @@ data MetadataModule t v = MetadataModule {
     foreignExports :: [(String, String, Type)]
 }
 
+type Interfaces = Map.Map String ModuleInterface
+
 data ModuleInterface = ModuleInterface {
     iTypes :: Map.Map String Type,
-    iAdts  :: Map.Map String (Int, [String])
+    iAdts  :: [(String, [String], [(String,[Type])])]
 } deriving Show
 
 instance Binary ModuleInterface where
diff --git a/compiler/Type/Environment.hs b/compiler/Type/Environment.hs
index afc76dd..49d9b27 100644
--- a/compiler/Type/Environment.hs
+++ b/compiler/Type/Environment.hs
@@ -22,11 +22,12 @@ initialEnvironment datatypes = do
     types <- makeTypes datatypes
 
     return $ Environment {
-      constructor = makeConstructors types datatypes,
+      constructor = makeConstructors types,
       types = types,
       value = Map.empty
     }
 
+makeTypes :: [(String, [String], [(String, [Src.Type])])] -> IO (Map.Map String Type)
 makeTypes datatypes = 
     Map.fromList <$> mapM makeCtor (builtins ++ map nameAndKind datatypes)
   where
@@ -46,7 +47,9 @@ makeTypes datatypes =
                       , kind 0 ["Int","Float","Char","Bool","Element"]
                       ]
 
-makeConstructors types datatypes = Map.fromList builtins
+
+makeConstructors :: Map.Map String Type -> Map.Map String (IO (Int, [Variable], Type))
+makeConstructors types = Map.fromList builtins
   where
     list  t = (types ! "_List") <| t
     maybe t = (types ! "Maybe") <| t
diff --git a/compiler/Type/Inference.hs b/compiler/Type/Inference.hs
index 41ad3d9..763c9df 100644
--- a/compiler/Type/Inference.hs
+++ b/compiler/Type/Inference.hs
@@ -21,18 +21,24 @@ import System.IO.Unsafe  -- Possible to switch over to the ST monad instead of
                          -- the IO monad. Not sure if that'd be worthwhile.
 
 
-infer :: MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
-infer modul = unsafePerformIO $ do
+infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
+infer interfaces modul = unsafePerformIO $ do
   env <- Env.initialEnvironment (datatypes modul)
   var <- T.flexibleVar
   ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
                do (_, vars, tipe) <- Env.freshDataScheme env name
                   return (name, (vars, tipe))
 
-  let vars = concatMap (fst . snd) ctors
-      header = Map.map snd (Map.fromList ctors)
+  importedVars <-
+      forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->
+          (,) name `fmap` Env.instantiateTypeWithContext env tipe Map.empty
+
+  let allTypes = ctors ++ importedVars
+      vars = concatMap (fst . snd) allTypes
+      header = Map.map snd (Map.fromList allTypes)
       environ = T.CLet [ T.Scheme vars [] T.CTrue header ]
   constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN var)
+--  print =<< T.extraPretty constraint
   state <- execStateT (Solve.solve constraint) TS.initialState
   let errors = TS.sErrors state
   if null errors