git.iko.soy/elk
on 54dfb21 help sign in
elk/src/Canonicalize/Variable.hs
257 lines 6.5 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 qualified Elm.Package as Pkg
19import Elm.Utils ((|>))
22variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canonical
23variable region env var =
24 case toVarName var of
25 Right (name, varName) | ModuleName.isNative name ->
26 let
27 moduleName =
28 ModuleName.Canonical Pkg.dummyName name
29 in
30 Result.var (Var.Canonical (Var.Module moduleName) varName)
32 _ ->
33 case Set.toList `fmap` Map.lookup var (Env._values env) of
34 Just [v] ->
35 Result.var v
37 Just vs ->
38 preferLocals region env "variable" vs var
40 Nothing ->
41 notFound region "variable" (Map.keys (Env._values env)) var
44tvar
45 :: R.Region
46 -> Env.Environment
47 -> String
48 -> Result.ResultErr
49 (Either
50 Var.Canonical
51 (Var.Canonical, [String], Type.Canonical)
52 )
53tvar region env var =
54 case adts ++ aliases of
55 [] -> notFound region "type" (Map.keys (Env._adts env) ++ Map.keys (Env._aliases env)) var
56 [v] -> Result.var' extract v
57 vs -> preferLocals' region env extract "type" vs var
58 where
59 adts =
60 map Left (maybe [] Set.toList (Map.lookup var (Env._adts env)))
62 aliases =
63 map Right (maybe [] Set.toList (Map.lookup var (Env._aliases env)))
65 extract value =
66 case value of
67 Left v -> v
68 Right (v,_,_) -> v
71pvar
72 :: R.Region
73 -> Env.Environment
74 -> String
75 -> Int
76 -> Result.ResultErr Var.Canonical
77pvar region env var actualArgs =
78 case Set.toList `fmap` Map.lookup var (Env._patterns env) of
79 Just [value] ->
80 foundArgCheck value
82 Just values ->
83 preferLocals' region env fst "pattern" values var
84 `Result.andThen` foundArgCheck
86 Nothing ->
87 notFound region "pattern" (Map.keys (Env._patterns env)) var
88 where
89 foundArgCheck (name, expectedArgs) =
90 if actualArgs == expectedArgs
91 then Result.var name
92 else Result.err (A.A region (Error.argMismatch name expectedArgs actualArgs))
95-- FOUND
97preferLocals
98 :: R.Region
99 -> Env.Environment
100 -> String
101 -> [Var.Canonical]
102 -> String
103 -> Result.ResultErr Var.Canonical
104preferLocals region env =
105 preferLocals' region env id
108preferLocals'
109 :: R.Region
110 -> Env.Environment
111 -> (a -> Var.Canonical)
112 -> String
113 -> [a]
114 -> String
115 -> Result.ResultErr a
116preferLocals' region env extract kind possibilities var =
117 case filter (isLocal (Env._home env) . extract) possibilities of
118 [] ->
119 ambiguous possibilities
121 [v] ->
122 Result.var' extract v
124 --Local vars shadow top-level vars
125 [v1, v2]
126 | isTopLevel (extract v1) ->
127 Result.var' extract v2
129 | isTopLevel (extract v2) ->
130 Result.var' extract v1
132 locals ->
133 ambiguous locals
134 where
135 ambiguous possibleVars =
136 Result.err (A.A region (Error.variable kind var Error.Ambiguous vars))
137 where
138 vars = map (Var.toString . extract) possibleVars
141isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool
142isLocal contextName (Var.Canonical home _) =
143 case home of
144 Var.Local ->
145 True
147 Var.TopLevel _ ->
148 True
150 Var.BuiltIn ->
151 False
153 Var.Module name ->
154 name == contextName
157isTopLevel :: Var.Canonical -> Bool
158isTopLevel (Var.Canonical home _) =
159 case home of
160 Var.TopLevel _ ->
161 True
163 _ ->
164 False
167-- NOT FOUND HELPERS
169type VarName =
170 Either String (ModuleName.Raw, String)
173toVarName :: String -> VarName
174toVarName var =
175 case Help.splitDots var of
176 [x] -> Left x
177 xs -> Right (init xs, last xs)
180noQualifier :: VarName -> String
181noQualifier name =
182 case name of
183 Left x -> x
184 Right (_, x) -> x
187qualifiedToString :: (ModuleName.Raw, String) -> String
188qualifiedToString (modul, name) =
189 ModuleName.toString modul ++ "." ++ name
192isOp :: VarName -> Bool
193isOp name =
194 Help.isOp (noQualifier name)
197-- NOT FOUND
199notFound :: R.Region -> String -> [String] -> String -> Result.ResultErr a
200notFound region kind possibilities var =
201 let name =
202 toVarName var
204 possibleNames =
205 map toVarName possibilities
207 (problem, suggestions) =
208 case name of
209 Left _ ->
210 exposedProblem name possibleNames
212 Right (modul, varName) ->
213 qualifiedProblem modul varName (Either.rights possibleNames)
214 in
215 Result.err (A.A region (Error.variable kind var problem suggestions))
218exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [String])
219exposedProblem name possibleNames =
220 let (exposed, qualified) =
221 possibleNames
222 |> filter (\n -> isOp name == isOp n)
223 |> Error.nearbyNames noQualifier name
224 |> Either.partitionEithers
225 in
226 ( Error.ExposedUnknown
227 , exposed ++ map qualifiedToString qualified
228 )
231qualifiedProblem
232 :: ModuleName.Raw
233 -> String
234 -> [(ModuleName.Raw, String)]
235 -> (Error.VarProblem, [String])
236qualifiedProblem moduleName name allQualified =
237 let availableModules =
238 Set.fromList (map fst allQualified)
240 moduleNameString =
241 ModuleName.toString moduleName
242 in
243 case Set.member moduleName availableModules of
244 True ->
245 ( Error.QualifiedUnknown moduleNameString name
246 , allQualified
247 |> filter ((==) moduleName . fst)
248 |> map snd
249 |> Error.nearbyNames id name
250 )
252 False ->
253 ( Error.UnknownQualifier moduleNameString name
254 , Set.toList availableModules
255 |> map ModuleName.toString
256 |> Error.nearbyNames id moduleNameString
257 )