git.iko.soy/elk
on ff98144 help sign in
elk/src/Canonicalize/Variable.hs
253 lines 6.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Variable 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 Reporting.Annotation as A
13import qualified Reporting.Error.Canonicalize as Error
14import qualified Reporting.Error.Helpers as Error
15import qualified Reporting.Region as R
16import qualified Canonicalize.Environment as Env
17import qualified Canonicalize.Result as Result
18import Elm.Utils ((|>))
21variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canonical
22variable region env var =
23 case toVarName var of
24 Right (name, varName)
25 | ModuleName.isNative name ->
26 error "TODO" "Result.var (Var.Canonical (Var.Module name) varName)"
28 _ ->
29 case Set.toList `fmap` Map.lookup var (Env._values env) of
30 Just [v] ->
31 Result.var v
33 Just vs ->
34 preferLocals region env "variable" vs var
36 Nothing ->
37 notFound region "variable" (Map.keys (Env._values env)) var
40tvar
41 :: R.Region
42 -> Env.Environment
43 -> String
44 -> Result.ResultErr
45 (Either
46 Var.Canonical
47 (Var.Canonical, [String], Type.Canonical)
48 )
49tvar region env var =
50 case adts ++ aliases of
51 [] -> notFound region "type" (Map.keys (Env._adts env) ++ Map.keys (Env._aliases env)) var
52 [v] -> Result.var' extract v
53 vs -> preferLocals' region env extract "type" vs var
54 where
55 adts =
56 map Left (maybe [] Set.toList (Map.lookup var (Env._adts env)))
58 aliases =
59 map Right (maybe [] Set.toList (Map.lookup var (Env._aliases env)))
61 extract value =
62 case value of
63 Left v -> v
64 Right (v,_,_) -> v
67pvar
68 :: R.Region
69 -> Env.Environment
70 -> String
71 -> Int
72 -> Result.ResultErr Var.Canonical
73pvar region env var actualArgs =
74 case Set.toList `fmap` Map.lookup var (Env._patterns env) of
75 Just [value] ->
76 foundArgCheck value
78 Just values ->
79 preferLocals' region env fst "pattern" values var
80 `Result.andThen` foundArgCheck
82 Nothing ->
83 notFound region "pattern" (Map.keys (Env._patterns env)) var
84 where
85 foundArgCheck (name, expectedArgs) =
86 if actualArgs == expectedArgs
87 then Result.var name
88 else Result.err (A.A region (Error.argMismatch name expectedArgs actualArgs))
91-- FOUND
93preferLocals
94 :: R.Region
95 -> Env.Environment
96 -> String
97 -> [Var.Canonical]
98 -> String
99 -> Result.ResultErr Var.Canonical
100preferLocals region env =
101 preferLocals' region env id
104preferLocals'
105 :: R.Region
106 -> Env.Environment
107 -> (a -> Var.Canonical)
108 -> String
109 -> [a]
110 -> String
111 -> Result.ResultErr a
112preferLocals' region env extract kind possibilities var =
113 case filter (isLocal (Env._home env) . extract) possibilities of
114 [] ->
115 ambiguous possibilities
117 [v] ->
118 Result.var' extract v
120 --Local vars shadow top-level vars
121 [v1, v2]
122 | isTopLevel (extract v1) ->
123 Result.var' extract v2
125 | isTopLevel (extract v2) ->
126 Result.var' extract v1
128 locals ->
129 ambiguous locals
130 where
131 ambiguous possibleVars =
132 Result.err (A.A region (Error.variable kind var Error.Ambiguous vars))
133 where
134 vars = map (Var.toString . extract) possibleVars
137isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool
138isLocal contextName (Var.Canonical home _) =
139 case home of
140 Var.Local ->
141 True
143 Var.TopLevel _ ->
144 True
146 Var.BuiltIn ->
147 False
149 Var.Module name ->
150 name == contextName
153isTopLevel :: Var.Canonical -> Bool
154isTopLevel (Var.Canonical home _) =
155 case home of
156 Var.TopLevel _ ->
157 True
159 _ ->
160 False
163-- NOT FOUND HELPERS
165type VarName =
166 Either String (ModuleName.Raw, String)
169toVarName :: String -> VarName
170toVarName var =
171 case Help.splitDots var of
172 [x] -> Left x
173 xs -> Right (init xs, last xs)
176noQualifier :: VarName -> String
177noQualifier name =
178 case name of
179 Left x -> x
180 Right (_, x) -> x
183qualifiedToString :: (ModuleName.Raw, String) -> String
184qualifiedToString (modul, name) =
185 ModuleName.toString modul ++ "." ++ name
188isOp :: VarName -> Bool
189isOp name =
190 Help.isOp (noQualifier name)
193-- NOT FOUND
195notFound :: R.Region -> String -> [String] -> String -> Result.ResultErr a
196notFound region kind possibilities var =
197 let name =
198 toVarName var
200 possibleNames =
201 map toVarName possibilities
203 (problem, suggestions) =
204 case name of
205 Left _ ->
206 exposedProblem name possibleNames
208 Right (modul, varName) ->
209 qualifiedProblem modul varName (Either.rights possibleNames)
210 in
211 Result.err (A.A region (Error.variable kind var problem suggestions))
214exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [String])
215exposedProblem name possibleNames =
216 let (exposed, qualified) =
217 possibleNames
218 |> filter (\n -> isOp name == isOp n)
219 |> Error.nearbyNames noQualifier name
220 |> Either.partitionEithers
221 in
222 ( Error.ExposedUnknown
223 , exposed ++ map qualifiedToString qualified
224 )
227qualifiedProblem
228 :: ModuleName.Raw
229 -> String
230 -> [(ModuleName.Raw, String)]
231 -> (Error.VarProblem, [String])
232qualifiedProblem moduleName name allQualified =
233 let availableModules =
234 Set.fromList (map fst allQualified)
236 moduleNameString =
237 ModuleName.toString moduleName
238 in
239 case Set.member moduleName availableModules of
240 True ->
241 ( Error.QualifiedUnknown moduleNameString name
242 , allQualified
243 |> filter ((==) moduleName . fst)
244 |> map snd
245 |> Error.nearbyNames id name
246 )
248 False ->
249 ( Error.UnknownQualifier moduleNameString name
250 , Set.toList availableModules
251 |> map ModuleName.toString
252 |> Error.nearbyNames id moduleNameString
253 )