git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Canonicalize/Variable.hs
270 lines 6.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Canonicalize.Variable (Result, variable, tvar, pvar) where
5import Data.Monoid ((<>))
6import qualified Data.Either as Either
7import qualified Data.Map as Map
8import qualified Data.Set as Set
9import qualified Data.Text as Text
10import Data.Text (Text)
12import qualified AST.Helpers as Help
13import qualified AST.Module.Name as ModuleName
14import qualified AST.Type as Type
15import qualified AST.Variable as Var
16import qualified Canonicalize.Environment as Env
17import qualified Reporting.Error.Canonicalize as Error
18import qualified Reporting.Helpers as Help (nearbyNames)
19import qualified Reporting.Region as R
20import qualified Reporting.Result as Result
21import qualified Reporting.Warning as Warning
22import Elm.Utils ((|>))
26-- RESULT HELPERS
29type Result a =
30 Result.Result (Set.Set ModuleName.Raw) Warning.Warning Error.Error a
33logVarWith :: (a -> Var.Canonical) -> a -> Result a
34logVarWith toVar value =
35 case toVar value of
36 Var.Canonical (Var.Module (ModuleName.Canonical _ moduleName)) _name ->
37 Result.accumulate (Set.singleton moduleName) value
39 Var.Canonical _ _ ->
40 Result.ok value
43logVar :: Var.Canonical -> Result Var.Canonical
44logVar var =
45 logVarWith id var
49-- FINDERS
52variable :: R.Region -> Env.Env -> Text -> Result Var.Canonical
53variable region env var =
54 case toVarName var of
55 Right (name, varName) | ModuleName.isKernel name ->
56 let
57 localPkg =
58 ModuleName._package (Env._home env)
60 moduleName =
61 ModuleName.Canonical localPkg name
62 in
63 logVar (Var.Canonical (Var.Module moduleName) varName)
65 _ ->
66 case Set.toList <$> Map.lookup var (Env._values env) of
67 Just [v] ->
68 logVar v
70 Just vs ->
71 preferLocals region env "variable" vs var
73 Nothing ->
74 notFound region "variable" (Map.keys (Env._values env)) var
77tvar :: R.Region -> Env.Env -> Text -> Result (Either Var.Canonical (Var.Canonical, [Text], Type.Canonical))
78tvar region env var =
79 case unions ++ aliases of
80 [] -> notFound region "type" (Map.keys (Env._unions env) ++ Map.keys (Env._aliases env)) var
81 [v] -> logVarWith extract v
82 vs -> preferLocals' region env extract "type" vs var
83 where
84 unions =
85 map Left (maybe [] Set.toList (Map.lookup var (Env._unions env)))
87 aliases =
88 map Right (maybe [] Set.toList (Map.lookup var (Env._aliases env)))
90 extract value =
91 case value of
92 Left v -> v
93 Right (v,_,_) -> v
96pvar :: R.Region -> Env.Env -> Text -> Int -> Result Var.Canonical
97pvar region env var actualArgs =
98 case Set.toList <$> Map.lookup var (Env._patterns env) of
99 Just [value] ->
100 foundArgCheck value
102 Just values ->
103 foundArgCheck =<< preferLocals' region env fst "pattern" values var
105 Nothing ->
106 notFound region "pattern" (Map.keys (Env._patterns env)) var
107 where
108 foundArgCheck (name, expectedArgs) =
109 if actualArgs == expectedArgs then
110 logVar name
112 else
113 Result.throw region (Error.argMismatch name expectedArgs actualArgs)
117-- FOUND
120preferLocals :: R.Region -> Env.Env -> Text -> [Var.Canonical] -> Text -> Result Var.Canonical
121preferLocals region env =
122 preferLocals' region env id
125preferLocals'
126 :: R.Region
127 -> Env.Env
128 -> (a -> Var.Canonical)
129 -> Text
130 -> [a]
131 -> Text
132 -> Result a
133preferLocals' region env extract kind possibilities var =
134 case filter (isLocal (Env._home env) . extract) possibilities of
135 [] ->
136 ambiguous possibilities
138 [v] ->
139 logVarWith extract v
141 --Local vars shadow top-level vars
142 [v1, v2]
143 | isTopLevel (extract v1) ->
144 logVarWith extract v2
146 | isTopLevel (extract v2) ->
147 logVarWith extract v1
149 locals ->
150 ambiguous locals
151 where
152 ambiguous possibleVars =
153 Result.throw region (Error.variable kind var Error.Ambiguous vars)
154 where
155 vars = map (Var.toText . extract) possibleVars
158isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool
159isLocal contextName (Var.Canonical home _) =
160 case home of
161 Var.Local ->
162 True
164 Var.TopLevel _ ->
165 True
167 Var.BuiltIn ->
168 False
170 Var.Module name ->
171 name == contextName
174isTopLevel :: Var.Canonical -> Bool
175isTopLevel (Var.Canonical home _) =
176 case home of
177 Var.TopLevel _ ->
178 True
180 _ ->
181 False
185-- NOT FOUND HELPERS
188type VarName =
189 Either Text (ModuleName.Raw, Text)
192toVarName :: Text -> VarName
193toVarName var =
194 case Text.splitOn "." var of
195 [x] -> Left x
196 xs -> Right (Text.intercalate "." (init xs), last xs)
199noQualifier :: VarName -> Text
200noQualifier name =
201 case name of
202 Right (_, x) -> x
203 Left x -> x
206qualifiedToText :: (ModuleName.Raw, Text) -> Text
207qualifiedToText (modul, name) =
208 ModuleName.toText modul <> "." <> name
211isOp :: VarName -> Bool
212isOp name =
213 Help.isOp (noQualifier name)
217-- NOT FOUND
220notFound :: R.Region -> Text -> [Text] -> Text -> Result a
221notFound region kind possibilities var =
222 let name =
223 toVarName var
225 possibleNames =
226 map toVarName possibilities
228 (problem, suggestions) =
229 case name of
230 Left _ ->
231 exposedProblem name possibleNames
233 Right (modul, varName) ->
234 qualifiedProblem modul varName (Either.rights possibleNames)
235 in
236 Result.throw region (Error.variable kind var problem suggestions)
239exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [Text])
240exposedProblem name possibleNames =
241 let (exposed, qualified) =
242 possibleNames
243 |> filter (\n -> isOp name == isOp n)
244 |> Help.nearbyNames noQualifier name
245 |> Either.partitionEithers
246 in
247 ( Error.ExposedUnknown
248 , exposed ++ map qualifiedToText qualified
249 )
252qualifiedProblem :: ModuleName.Raw -> Text -> [(ModuleName.Raw, Text)] -> (Error.VarProblem, [Text])
253qualifiedProblem moduleName name allQualified =
254 let availableModules =
255 Set.fromList (map fst allQualified)
256 in
257 case Set.member moduleName availableModules of
258 True ->
259 ( Error.QualifiedUnknown moduleName name
260 , allQualified
261 |> filter ((==) moduleName . fst)
262 |> map snd
263 |> Help.nearbyNames id name
264 )
266 False ->
267 ( Error.UnknownQualifier moduleName name
268 , Set.toList availableModules
269 |> Help.nearbyNames id moduleName
270 )