git.iko.soy/elk
on 267f708 help sign in
elk/src/Canonicalize/Variable.hs
293 lines 6.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Variable (Result, variable, tvar, pvar) where
4import qualified Data.Either as Either
5import qualified Data.Map as Map
6import qualified Data.Set as Set
8import qualified AST.Helpers as Help
9import qualified AST.Module.Name as ModuleName
10import qualified AST.Type as Type
11import qualified AST.Variable as Var
12import qualified Canonicalize.Environment as Env
13import qualified Reporting.Error.Canonicalize as Error
14import qualified Reporting.Error.Helpers as Error
15import qualified Reporting.Region as R
16import qualified Reporting.Result as Result
17import qualified Reporting.Warning as Warning
18import Elm.Utils ((|>))
22-- RESULT HELPERS
25type Result a =
26 Result.Result (Set.Set ModuleName.Raw) Warning.Warning Error.Error a
29logVarWith :: (a -> Var.Canonical) -> a -> Result a
30logVarWith toVar value =
31 case toVar value of
32 Var.Canonical (Var.Module (ModuleName.Canonical _ moduleName)) _name ->
33 Result.accumulate (Set.singleton moduleName) value
35 Var.Canonical _ _ ->
36 Result.ok value
39logVar :: Var.Canonical -> Result Var.Canonical
40logVar var =
41 logVarWith id var
45-- FINDERS
48variable :: R.Region -> Env.Environment -> String -> Result Var.Canonical
49variable region env var =
50 case toVarName var of
51 Right (name, varName) | ModuleName.isNative name ->
52 let
53 localPkg =
54 ModuleName._package (Env._home env)
56 moduleName =
57 ModuleName.Canonical localPkg name
58 in
59 logVar (Var.Canonical (Var.Module moduleName) varName)
61 _ ->
62 case Set.toList <$> Map.lookup var (Env._values env) of
63 Just [v] ->
64 logVar v
66 Just vs ->
67 preferLocals region env "variable" vs var
69 Nothing ->
70 notFound region "variable" (Map.keys (Env._values env)) var
73tvar
74 :: R.Region
75 -> Env.Environment
76 -> String
77 -> Result
78 (Either
79 Var.Canonical
80 (Var.Canonical, [String], Type.Canonical)
81 )
82tvar region env var =
83 case unions ++ aliases of
84 [] -> notFound region "type" (Map.keys (Env._unions env) ++ Map.keys (Env._aliases env)) var
85 [v] -> logVarWith extract v
86 vs -> preferLocals' region env extract "type" vs var
87 where
88 unions =
89 map Left (maybe [] Set.toList (Map.lookup var (Env._unions env)))
91 aliases =
92 map Right (maybe [] Set.toList (Map.lookup var (Env._aliases env)))
94 extract value =
95 case value of
96 Left v -> v
97 Right (v,_,_) -> v
100pvar
101 :: R.Region
102 -> Env.Environment
103 -> String
104 -> Int
105 -> Result Var.Canonical
106pvar region env var actualArgs =
107 case Set.toList <$> Map.lookup var (Env._patterns env) of
108 Just [value] ->
109 foundArgCheck value
111 Just values ->
112 foundArgCheck =<< preferLocals' region env fst "pattern" values var
114 Nothing ->
115 notFound region "pattern" (Map.keys (Env._patterns env)) var
116 where
117 foundArgCheck (name, expectedArgs) =
118 if actualArgs == expectedArgs then
119 logVar name
121 else
122 Result.throw region (Error.argMismatch name expectedArgs actualArgs)
126-- FOUND
129preferLocals
130 :: R.Region
131 -> Env.Environment
132 -> String
133 -> [Var.Canonical]
134 -> String
135 -> Result Var.Canonical
136preferLocals region env =
137 preferLocals' region env id
140preferLocals'
141 :: R.Region
142 -> Env.Environment
143 -> (a -> Var.Canonical)
144 -> String
145 -> [a]
146 -> String
147 -> Result a
148preferLocals' region env extract kind possibilities var =
149 case filter (isLocal (Env._home env) . extract) possibilities of
150 [] ->
151 ambiguous possibilities
153 [v] ->
154 logVarWith extract v
156 --Local vars shadow top-level vars
157 [v1, v2]
158 | isTopLevel (extract v1) ->
159 logVarWith extract v2
161 | isTopLevel (extract v2) ->
162 logVarWith extract v1
164 locals ->
165 ambiguous locals
166 where
167 ambiguous possibleVars =
168 Result.throw region (Error.variable kind var Error.Ambiguous vars)
169 where
170 vars = map (Var.toString . extract) possibleVars
173isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool
174isLocal contextName (Var.Canonical home _) =
175 case home of
176 Var.Local ->
177 True
179 Var.TopLevel _ ->
180 True
182 Var.BuiltIn ->
183 False
185 Var.Module name ->
186 name == contextName
189isTopLevel :: Var.Canonical -> Bool
190isTopLevel (Var.Canonical home _) =
191 case home of
192 Var.TopLevel _ ->
193 True
195 _ ->
196 False
200-- NOT FOUND HELPERS
203type VarName =
204 Either String (ModuleName.Raw, String)
207toVarName :: String -> VarName
208toVarName var =
209 case Help.splitDots var of
210 [x] -> Left x
211 xs -> Right (init xs, last xs)
214noQualifier :: VarName -> String
215noQualifier name =
216 case name of
217 Left x -> x
218 Right (_, x) -> x
221qualifiedToString :: (ModuleName.Raw, String) -> String
222qualifiedToString (modul, name) =
223 ModuleName.toString modul ++ "." ++ name
226isOp :: VarName -> Bool
227isOp name =
228 Help.isOp (noQualifier name)
232-- NOT FOUND
235notFound :: R.Region -> String -> [String] -> String -> Result a
236notFound region kind possibilities var =
237 let name =
238 toVarName var
240 possibleNames =
241 map toVarName possibilities
243 (problem, suggestions) =
244 case name of
245 Left _ ->
246 exposedProblem name possibleNames
248 Right (modul, varName) ->
249 qualifiedProblem modul varName (Either.rights possibleNames)
250 in
251 Result.throw region (Error.variable kind var problem suggestions)
254exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [String])
255exposedProblem name possibleNames =
256 let (exposed, qualified) =
257 possibleNames
258 |> filter (\n -> isOp name == isOp n)
259 |> Error.nearbyNames noQualifier name
260 |> Either.partitionEithers
261 in
262 ( Error.ExposedUnknown
263 , exposed ++ map qualifiedToString qualified
264 )
267qualifiedProblem
268 :: ModuleName.Raw
269 -> String
270 -> [(ModuleName.Raw, String)]
271 -> (Error.VarProblem, [String])
272qualifiedProblem moduleName name allQualified =
273 let availableModules =
274 Set.fromList (map fst allQualified)
276 moduleNameString =
277 ModuleName.toString moduleName
278 in
279 case Set.member moduleName availableModules of
280 True ->
281 ( Error.QualifiedUnknown moduleNameString name
282 , allQualified
283 |> filter ((==) moduleName . fst)
284 |> map snd
285 |> Error.nearbyNames id name
286 )
288 False ->
289 ( Error.UnknownQualifier moduleNameString name
290 , Set.toList availableModules
291 |> map ModuleName.toString
292 |> Error.nearbyNames id moduleNameString
293 )