git.iko.soy/elk
on master help sign in
Begin to canonicalize imported values and types
138e99cEvan Czaplicki
compiler/SourceSyntax/Module.hs+34−2
compare with master
unifiedsplit
@@ -6,8 +6,9 @@ import Data.Binary
6import Data.List (intercalate)
6import Data.List (intercalate)
7import qualified Data.Map as Map
7import qualified Data.Map as Map
8import Control.Applicative ((<$>), (<*>))
8import Control.Applicative ((<$>), (<*>))
9+import Control.Arrow (second)
9
10
10−import SourceSyntax.Expression
11+import SourceSyntax.Expression (LExpr)
11import SourceSyntax.Declaration
12import SourceSyntax.Declaration
12import SourceSyntax.Type
13import SourceSyntax.Type
13import System.FilePath (joinPath)
14import System.FilePath (joinPath)
@@ -46,4 +47,35 @@ data ModuleInterface = ModuleInterface {
46
47
47instance Binary ModuleInterface where
48instance Binary ModuleInterface where
48 put modul = put (iTypes modul) >> put (iAdts modul)
49 put modul = put (iTypes modul) >> put (iAdts modul)
49− get = ModuleInterface <$> get <*> get
50+ get = ModuleInterface <$> get <*> get
51+
52+
53+canonicalize :: String -> ImportMethod -> ModuleInterface -> ModuleInterface
54+canonicalize prefix importMethod interface =
55+ let addPrefix name = prefix ++ "." ++ name
56+
57+ newName (tipe,_,_) =
58+ case importMethod of
59+ As name -> (tipe, name ++ "." ++ tipe)
60+ Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
61+ Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
62+ newNames = Map.fromList . map newName $ iAdts interface
63+
64+ rename name = Map.findWithDefault name name newNames
65+
66+ renameADT (name, tvars, ctors) =
67+ (rename name, tvars, map (second (map (renameType rename))) ctors)
68+ in ModuleInterface {
69+ iTypes = Map.map (renameType rename) (iTypes interface),
70+ iAdts = map renameADT (iAdts interface)
71+ }
72+
73+renameType :: (String -> String) -> Type -> Type
74+renameType find tipe =
75+ let rnm = renameType find in
76+ case tipe of
77+ Lambda a b -> Lambda (rnm a) (rnm b)
78+ Var x -> Var x
79+ Data name ts -> Data (find name) (map rnm ts)
80+ EmptyRecord -> EmptyRecord
81+ Record fields ext -> Record (Map.map (map rnm) fields) (rnm ext)
compiler/Type/Inference.hs+11−6
@@ -22,14 +22,20 @@ import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
22
22
23
23
24infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
24infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
25−infer interfaces modul = unsafePerformIO $ do
25+infer interfaces' modul = unsafePerformIO $ do
26+ let localImports = Map.fromList (imports modul)
27+ interfaces = Map.intersectionWithKey canonicalize localImports interfaces'
28+
29+-- mapM print (concatMap iAdts (Map.elems interfaces))
30+
26− env <- Env.initialEnvironment (datatypes modul)
31+ env <- Env.initialEnvironment (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
27 var <- T.flexibleVar
32 var <- T.flexibleVar
28 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
33 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
29 do (_, vars, tipe) <- Env.freshDataScheme env name
34 do (_, vars, tipe) <- Env.freshDataScheme env name
30 return (name, (vars, tipe))
35 return (name, (vars, tipe))
31
36
37+ let locals = Map.intersectionWithKey combine localImports interfaces
32− let combine name importMethod interface =
38+ combine name importMethod interface =
33 let tipes = iTypes interface in
39 let tipes = iTypes interface in
34 case importMethod of
40 case importMethod of
35 As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
41 As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
@@ -37,9 +43,8 @@ infer interfaces modul = unsafePerformIO $ do
37 Importing visibles ->
43 Importing visibles ->
38 Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
44 Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
39
45
40− locals = Map.intersectionWithKey combine (Map.fromList (imports modul)) interfaces
46+-- mapM print (map Map.toList $ Map.elems locals)
41−
42− mapM print (imports modul)
47+-- mapM print (imports modul)
43
48
44 importedVars <-
49 importedVars <-
45 forM (concatMap Map.toList $ Map.elems locals) $ \(name,tipe) ->
50 forM (concatMap Map.toList $ Map.elems locals) $ \(name,tipe) ->