on master help sign in
When canonicalizing, prefer local definitions
440c182Evan Czaplicki
compiler/Transform/Canonicalize/Variable.hs+36−19
@@ -1,4 +1,4 @@
1−{-# OPTIONS_GHC -W #-}
1+{-# OPTIONS_GHC -Wall #-}
2module Transform.Canonicalize.Variable where
2module Transform.Canonicalize.Variable where
3
3
4import qualified Data.List as List
4import qualified Data.List as List
@@ -20,45 +20,62 @@ variable env var =
20
20
21 _ -> case Map.lookup var (_values env) of
21 _ -> case Map.lookup var (_values env) of
22 Just [v] -> return v
22 Just [v] -> return v
23− Just vs -> Left (ambiguous "variable" (map Var.toString vs) var)
23+ Just vs -> preferLocals "variable" vs var
24− Nothing -> Left (notFound "variable" (Map.keys (_values env)) var)
24+ Nothing -> notFound "variable" (Map.keys (_values env)) var
25 where
25 where
26 (modul, name) = case Help.splitDots var of
26 (modul, name) = case Help.splitDots var of
27 [x] -> (Nothing, x)
27 [x] -> (Nothing, x)
28 xs -> (Just (init xs), last xs)
28 xs -> (Just (init xs), last xs)
29
29
30tvar :: Environment -> String
30tvar :: Environment -> String
31− -> Either String (Either Var.Canonical (Var.Canonical, [String], Type.Type Var.Canonical))
31+ -> Either String (Either Var.Canonical (Var.Canonical, [String], Type.CanonicalType))
32tvar env var =
32tvar env var =
33 case adts ++ aliases of
33 case adts ++ aliases of
34− [] -> Left $ notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
34+ [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
35 [v] -> return v
35 [v] -> return v
36− vs -> Left $ ambiguous "type" (map toString vs) var
36+ vs -> preferLocals' extract "type" vs var
37 where
37 where
38− adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)
38+ adts = map Left . fromMaybe [] $ Map.lookup var (_adts env)
39 aliases = map Right . fromMaybe [] $ Map.lookup var (_aliases env)
39 aliases = map Right . fromMaybe [] $ Map.lookup var (_aliases env)
40− toString v =
40+
41+ extract value =
41− Var.toString $ case v of
42+ case value of
42− Left x -> x
43+ Left v -> v
43− Right (x,_,_) -> x
44+ Right (v,_,_) -> v
44
45
45pvar :: Environment -> String -> Either String Var.Canonical
46pvar :: Environment -> String -> Either String Var.Canonical
46pvar env var =
47pvar env var =
47 case Map.lookup var (_patterns env) of
48 case Map.lookup var (_patterns env) of
48 Just [v] -> return v
49 Just [v] -> return v
49− Just vs -> Left (ambiguous "pattern" (map Var.toString vs) var)
50+ Just vs -> preferLocals "pattern" vs var
50− Nothing -> Left (notFound "pattern" (Map.keys (_patterns env)) var)
51+ Nothing -> notFound "pattern" (Map.keys (_patterns env)) var
51
52
52−notFound :: String -> [String] -> String -> String
53+notFound :: String -> [String] -> String -> Either String a
53notFound kind possibilities var =
54notFound kind possibilities var =
54− "Could not find " ++ kind ++ " '" ++ var ++ "'." ++ msg
55+ Left $ "Could not find " ++ kind ++ " '" ++ var ++ "'." ++ msg
55 where
56 where
56 matches = filter (List.isInfixOf var) possibilities
57 matches = filter (List.isInfixOf var) possibilities
57 msg = if null matches then "" else
58 msg = if null matches then "" else
58 "\nClose matches include: " ++ List.intercalate ", " matches
59 "\nClose matches include: " ++ List.intercalate ", " matches
59
60
61+preferLocals :: String -> [Var.Canonical] -> String -> Either String Var.Canonical
62+preferLocals = preferLocals' id
63+
60−ambiguous :: String -> [String] -> String -> String
64+preferLocals' :: (a -> Var.Canonical) -> String -> [a] -> String -> Either String a
61−ambiguous kind possibilities var =
65+preferLocals' extract kind possibilities var =
66+ case filter (isLocal . extract) possibilities of
67+ [] -> ambiguous possibilities
68+ [v] -> return v
69+ locals -> ambiguous locals
70+ where
71+ isLocal :: Var.Canonical -> Bool
72+ isLocal (Var.Canonical Var.Local _) = True
73+ isLocal (Var.Canonical _ _) = False
74+
75+ ambiguous possibleVars =
76+ Left msg
77+ where
78+ vars = map (Var.toString . extract) possibleVars
62− "Ambiguous usage of " ++ kind ++ " '" ++ var ++ "'.\n" ++
79+ msg = "Ambiguous usage of " ++ kind ++ " '" ++ var ++ "'.\n" ++
63− " Disambiguate between: " ++ List.intercalate ", " possibilities
80+ " Disambiguate between: " ++ List.intercalate ", " vars
64
81