git.iko.soy/elk
on master help sign in
Fix #659, prefer local types and patterns
7b070a0Evan Czaplicki
compiler/Transform/Canonicalize/Environment.hs+15−11
compare with master
unifiedsplit
@@ -12,7 +12,6 @@ import qualified AST.Pattern as P
12import qualified AST.Type as Type
12import qualified AST.Type as Type
13import qualified AST.Variable as Var
13import qualified AST.Variable as Var
14
14
15−import AST.PrettyPrint ()
16import Text.PrettyPrint (Doc)
15import Text.PrettyPrint (Doc)
17
16
18type Dict a = Map.Map String [a]
17type Dict a = Map.Map String [a]
@@ -48,15 +47,17 @@ onError handler canonicalizer =
48 Right x -> return x
47 Right x -> return x
49
48
50data Environment = Env
49data Environment = Env
50+ { _home :: String
51− { _values :: Dict Var.Canonical
51+ , _values :: Dict Var.Canonical
52 , _adts :: Dict Var.Canonical
52 , _adts :: Dict Var.Canonical
53 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
53 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
54 , _patterns :: Dict Var.Canonical
54 , _patterns :: Dict Var.Canonical
55 }
55 }
56
56
57−builtIns :: Environment
57+builtIns :: String -> Environment
58−builtIns =
58+builtIns home =
59+ Env { _home = home
59− Env { _values = builtIn (tuples ++ [saveEnvName])
60+ , _values = builtIn (tuples ++ [saveEnvName])
60 , _adts = builtIn (tuples ++ ["_List","Int","Float","Char","Bool","String"])
61 , _adts = builtIn (tuples ++ ["_List","Int","Float","Char","Bool","String"])
61 , _aliases = dict []
62 , _aliases = dict []
62 , _patterns = builtIn (tuples ++ ["::","[]"])
63 , _patterns = builtIn (tuples ++ ["::","[]"])
@@ -72,9 +73,12 @@ update ptrn env =
72 put x = Map.insert x [Var.local x]
73 put x = Map.insert x [Var.local x]
73
74
74merge :: Environment -> Environment -> Environment
75merge :: Environment -> Environment -> Environment
75−merge (Env v1 t1 a1 p1) (Env v2 t2 a2 p2) =
76+merge (Env n1 v1 t1 a1 p1) (Env n2 v2 t2 a2 p2)
77+ | n1 /= n2 = error "trying to merge incompatable environments"
78+ | otherwise =
79+ Env { _home = n1
76− Env { _values = Map.unionWith (++) v1 v2
80+ , _values = Map.unionWith (++) v1 v2
77− , _adts = Map.unionWith (++) t1 t2
81+ , _adts = Map.unionWith (++) t1 t2
78− , _aliases = Map.unionWith (++) a1 a2
82+ , _aliases = Map.unionWith (++) a1 a2
79− , _patterns = Map.unionWith (++) p1 p2
83+ , _patterns = Map.unionWith (++) p1 p2
80− }
84+ }
compiler/Transform/Canonicalize/Setup.hs+6−5
@@ -25,9 +25,9 @@ import qualified Transform.Canonicalize.Type as Canonicalize
25environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment
25environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment
26environment interfaces modul@(Module.Module _ _ _ imports decls) =
26environment interfaces modul@(Module.Module _ _ _ imports decls) =
27 do () <- allImportsAvailable
27 do () <- allImportsAvailable
28− nonLocalEnv <- foldM (addImports interfaces) builtIns imports
29 let moduleName = Module.getName modul
28 let moduleName = Module.getName modul
29+ nonLocalEnv <- foldM (addImports moduleName interfaces) (builtIns moduleName) imports
30− (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
30+ let (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
31 addTypeAliases moduleName aliases env
31 addTypeAliases moduleName aliases env
32 where
32 where
33 allImportsAvailable :: Canonicalizer [Doc] ()
33 allImportsAvailable :: Canonicalizer [Doc] ()
@@ -46,9 +46,9 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =
46 , "\n You may need to compile with the --make "
46 , "\n You may need to compile with the --make "
47 , "flag to detect modules you have written." ]
47 , "flag to detect modules you have written." ]
48
48
49−addImports :: Module.Interfaces -> Environment -> (String, Module.ImportMethod)
49+addImports :: String -> Module.Interfaces -> Environment -> (String, Module.ImportMethod)
50 -> Canonicalizer [Doc] Environment
50 -> Canonicalizer [Doc] Environment
51−addImports interfaces environ (name,method)
51+addImports moduleName interfaces environ (name,method)
52 | List.isPrefixOf "Native." name = return environ
52 | List.isPrefixOf "Native." name = return environ
53 | otherwise =
53 | otherwise =
54 case method of
54 case method of
@@ -64,7 +64,8 @@ addImports interfaces environ (name,method)
64 updateEnviron prefix =
64 updateEnviron prefix =
65 let dict' = dict . map (first (prefix++)) in
65 let dict' = dict . map (first (prefix++)) in
66 merge environ $
66 merge environ $
67+ Env { _home = moduleName
67− Env { _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
68+ , _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
68 , _adts = dict' $ map pair (Map.keys (iAdts interface))
69 , _adts = dict' $ map pair (Map.keys (iAdts interface))
69 , _aliases = dict' $ map alias (Map.toList (iAliases interface))
70 , _aliases = dict' $ map alias (Map.toList (iAliases interface))
70 , _patterns = dict' $ ctors
71 , _patterns = dict' $ ctors
compiler/Transform/Canonicalize/Variable.hs+14−8
@@ -21,7 +21,7 @@ variable env var =
21
21
22 _ -> case Map.lookup var (_values env) of
22 _ -> case Map.lookup var (_values env) of
23 Just [v] -> Env.using v
23 Just [v] -> Env.using v
24− Just vs -> preferLocals "variable" vs var
24+ Just vs -> preferLocals env "variable" vs var
25 Nothing -> notFound "variable" (Map.keys (_values env)) var
25 Nothing -> notFound "variable" (Map.keys (_values env)) var
26 where
26 where
27 (modul, name) = case Help.splitDots var of
27 (modul, name) = case Help.splitDots var of
@@ -34,7 +34,7 @@ tvar env var =
34 case adts ++ aliases of
34 case adts ++ aliases of
35 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
35 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
36 [v] -> found extract v
36 [v] -> found extract v
37− vs -> preferLocals' extract "type" vs var
37+ vs -> preferLocals' env extract "type" vs var
38 where
38 where
39 adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)
39 adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)
40 aliases = map Right . fromMaybe [] $ Map.lookup var (_aliases env)
40 aliases = map Right . fromMaybe [] $ Map.lookup var (_aliases env)
@@ -48,7 +48,7 @@ pvar :: Environment -> String -> Canonicalizer String Var.Canonical
48pvar env var =
48pvar env var =
49 case Map.lookup var (_patterns env) of
49 case Map.lookup var (_patterns env) of
50 Just [v] -> Env.using v
50 Just [v] -> Env.using v
51− Just vs -> preferLocals "pattern" vs var
51+ Just vs -> preferLocals env "pattern" vs var
52 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var
52 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var
53
53
54found :: (a -> Var.Canonical) -> a -> Canonicalizer String a
54found :: (a -> Var.Canonical) -> a -> Canonicalizer String a
@@ -64,18 +64,24 @@ notFound kind possibilities var =
64 msg = if null matches then "" else
64 msg = if null matches then "" else
65 "\nClose matches include: " ++ List.intercalate ", " matches
65 "\nClose matches include: " ++ List.intercalate ", " matches
66
66
67−preferLocals :: String -> [Var.Canonical] -> String -> Canonicalizer String Var.Canonical
67+preferLocals :: Environment -> String -> [Var.Canonical] -> String
68+ -> Canonicalizer String Var.Canonical
68−preferLocals = preferLocals' id
69+preferLocals env = preferLocals' env id
69
70
70−preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Canonicalizer String a
71+preferLocals' :: Environment -> (a -> Var.Canonical) -> String -> [a] -> String
72+ -> Canonicalizer String a
71−preferLocals' extract kind possibilities var =
73+preferLocals' env extract kind possibilities var =
72 case filter (isLocal . extract) possibilities of
74 case filter (isLocal . extract) possibilities of
73 [] -> ambiguous possibilities
75 [] -> ambiguous possibilities
74 [v] -> found extract v
76 [v] -> found extract v
75 locals -> ambiguous locals
77 locals -> ambiguous locals
76 where
78 where
77 isLocal :: Var.Canonical -> Bool
79 isLocal :: Var.Canonical -> Bool
78− isLocal (Var.Canonical home _) = home == Var.Local
80+ isLocal (Var.Canonical home _) =
81+ case home of
82+ Var.Local -> True
83+ Var.BuiltIn -> False
84+ Var.Module name -> name == Env._home env
79
85
80 ambiguous possibleVars =
86 ambiguous possibleVars =
81 throwError msg
87 throwError msg