git.iko.soy/elk
on master help sign in
Fix #659, prefer local types and patterns
commit7b070a072d1ed92016d11326d02ece323b87c741 authorEvan Czaplicki <info@elm-lang.org> dateTue 17 Jun 2014, 19:08 (12 years ago) parentbf9573c
3 files changed+35−24
compare with master
unifiedsplit
compiler/Transform/Canonicalize/Environment.hs+15−11 compiler/Transform/Canonicalize/Setup.hs+6−5 compiler/Transform/Canonicalize/Variable.hs+14−8
compiler/Transform/Canonicalize/Environment.hs+15−11
@@ -12,7 +12,6 @@ import qualified AST.Pattern as P
1212import qualified AST.Type as Type
1313import qualified AST.Variable as Var
1414
15−import AST.PrettyPrint ()
1615import Text.PrettyPrint (Doc)
1716
1817type Dict a = Map.Map String [a]
@@ -48,15 +47,17 @@ onError handler canonicalizer =
4847 Right x -> return x
4948
5049data Environment = Env
51− { _values :: Dict Var.Canonical
50+ { _home :: String
51+ , _values :: Dict Var.Canonical
5252 , _adts :: Dict Var.Canonical
5353 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
5454 , _patterns :: Dict Var.Canonical
5555 }
5656
57−builtIns :: Environment
58−builtIns =
59− Env { _values = builtIn (tuples ++ [saveEnvName])
57+builtIns :: String -> Environment
58+builtIns home =
59+ Env { _home = home
60+ , _values = builtIn (tuples ++ [saveEnvName])
6061 , _adts = builtIn (tuples ++ ["_List","Int","Float","Char","Bool","String"])
6162 , _aliases = dict []
6263 , _patterns = builtIn (tuples ++ ["::","[]"])
@@ -72,9 +73,12 @@ update ptrn env =
7273 put x = Map.insert x [Var.local x]
7374
7475merge :: Environment -> Environment -> Environment
75−merge (Env v1 t1 a1 p1) (Env v2 t2 a2 p2) =
76− Env { _values = Map.unionWith (++) v1 v2
77− , _adts = Map.unionWith (++) t1 t2
78− , _aliases = Map.unionWith (++) a1 a2
79− , _patterns = Map.unionWith (++) p1 p2
80− }
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
80+ , _values = Map.unionWith (++) v1 v2
81+ , _adts = Map.unionWith (++) t1 t2
82+ , _aliases = Map.unionWith (++) a1 a2
83+ , _patterns = Map.unionWith (++) p1 p2
84+ }
compiler/Transform/Canonicalize/Setup.hs+6−5
@@ -25,9 +25,9 @@ import qualified Transform.Canonicalize.Type as Canonicalize
2525environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment
2626environment interfaces modul@(Module.Module _ _ _ imports decls) =
2727 do () <- allImportsAvailable
28− nonLocalEnv <- foldM (addImports interfaces) builtIns imports
2928 let moduleName = Module.getName modul
30− (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
29+ nonLocalEnv <- foldM (addImports moduleName interfaces) (builtIns moduleName) imports
30+ let (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
3131 addTypeAliases moduleName aliases env
3232 where
3333 allImportsAvailable :: Canonicalizer [Doc] ()
@@ -46,9 +46,9 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =
4646 , "\n You may need to compile with the --make "
4747 , "flag to detect modules you have written." ]
4848
49−addImports :: Module.Interfaces -> Environment -> (String, Module.ImportMethod)
49+addImports :: String -> Module.Interfaces -> Environment -> (String, Module.ImportMethod)
5050 -> Canonicalizer [Doc] Environment
51−addImports interfaces environ (name,method)
51+addImports moduleName interfaces environ (name,method)
5252 | List.isPrefixOf "Native." name = return environ
5353 | otherwise =
5454 case method of
@@ -64,7 +64,8 @@ addImports interfaces environ (name,method)
6464 updateEnviron prefix =
6565 let dict' = dict . map (first (prefix++)) in
6666 merge environ $
67− Env { _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
67+ Env { _home = moduleName
68+ , _values = dict' $ map pair (Map.keys (iTypes interface)) ++ ctors
6869 , _adts = dict' $ map pair (Map.keys (iAdts interface))
6970 , _aliases = dict' $ map alias (Map.toList (iAliases interface))
7071 , _patterns = dict' $ ctors
compiler/Transform/Canonicalize/Variable.hs+14−8
@@ -21,7 +21,7 @@ variable env var =
2121
2222 _ -> case Map.lookup var (_values env) of
2323 Just [v] -> Env.using v
24− Just vs -> preferLocals "variable" vs var
24+ Just vs -> preferLocals env "variable" vs var
2525 Nothing -> notFound "variable" (Map.keys (_values env)) var
2626 where
2727 (modul, name) = case Help.splitDots var of
@@ -34,7 +34,7 @@ tvar env var =
3434 case adts ++ aliases of
3535 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
3636 [v] -> found extract v
37− vs -> preferLocals' extract "type" vs var
37+ vs -> preferLocals' env extract "type" vs var
3838 where
3939 adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)
4040 aliases = map Right . fromMaybe [] $ Map.lookup var (_aliases env)
@@ -48,7 +48,7 @@ pvar :: Environment -> String -> Canonicalizer String Var.Canonical
4848pvar env var =
4949 case Map.lookup var (_patterns env) of
5050 Just [v] -> Env.using v
51− Just vs -> preferLocals "pattern" vs var
51+ Just vs -> preferLocals env "pattern" vs var
5252 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var
5353
5454found :: (a -> Var.Canonical) -> a -> Canonicalizer String a
@@ -64,18 +64,24 @@ notFound kind possibilities var =
6464 msg = if null matches then "" else
6565 "\nClose matches include: " ++ List.intercalate ", " matches
6666
67−preferLocals :: String -> [Var.Canonical] -> String -> Canonicalizer String Var.Canonical
68−preferLocals = preferLocals' id
67+preferLocals :: Environment -> String -> [Var.Canonical] -> String
68+ -> Canonicalizer String Var.Canonical
69+preferLocals env = preferLocals' env id
6970
70−preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Canonicalizer String a
71−preferLocals' extract kind possibilities var =
71+preferLocals' :: Environment -> (a -> Var.Canonical) -> String -> [a] -> String
72+ -> Canonicalizer String a
73+preferLocals' env extract kind possibilities var =
7274 case filter (isLocal . extract) possibilities of
7375 [] -> ambiguous possibilities
7476 [v] -> found extract v
7577 locals -> ambiguous locals
7678 where
7779 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
7985
8086 ambiguous possibleVars =
8187 throwError msg