git.iko.soy/elk
on 00a3069 help sign in
elk/src/Canonicalize/Environment.hs
241 lines 5.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Canonicalize.Environment
4 ( Env(..)
5 , Exposed
6 , Qualified
7 , Var(..)
8 , ForeignVar(..)
9 , Type(..)
10 , Ctor(..)
11 , addLocals
12 , findType
13 , findTypeQual
14 , findCtor
15 , findCtorQual
16 , findBinop
17 , Binop(..)
18 )
19 where
22import qualified Data.Map.Strict as Map
23import qualified Data.Map.Merge.Strict as Map
25import qualified AST.Utils.Binop as Binop
26import qualified AST.Canonical as Can
27import qualified AST.Module.Name as ModuleName
28import qualified Data.Index as Index
29import qualified Data.OneOrMore as OneOrMore
30import qualified Elm.Name as N
31import qualified Reporting.Error.Canonicalize as Error
32import qualified Reporting.Region as R
33import qualified Reporting.Result as Result
37-- RESULT
40type Result i w a =
41 Result.Result i w Error.Error a
45-- ENVIRONMENT
48data Env =
49 Env
50 { _home :: ModuleName.Canonical
51 , _vars :: Map.Map N.Name Var
52 , _types :: Exposed Type
53 , _ctors :: Exposed Ctor
54 , _binops :: Exposed Binop
55 , _q_vars :: Qualified ForeignVar
56 , _q_types :: Qualified Type
57 , _q_ctors :: Qualified Ctor
58 }
61type Exposed a =
62 Map.Map N.Name (OneOrMore.OneOrMore a)
65type Qualified a =
66 Map.Map N.Name (Map.Map N.Name (OneOrMore.OneOrMore a))
70-- VARIABLES
73data Var
74 = Local R.Region
75 | TopLevel R.Region
76 | Foreign (OneOrMore.OneOrMore ForeignVar)
79data ForeignVar =
80 ForeignVar ModuleName.Canonical Can.Annotation
84-- TYPES
87data Type
88 = Alias Int ModuleName.Canonical [N.Name] Can.Type
89 | Union Int ModuleName.Canonical
93-- CTORS
96data Ctor
97 = RecordCtor ModuleName.Canonical [N.Name] Can.Type
98 | Ctor
99 { _c_home :: ModuleName.Canonical
100 , _c_type :: N.Name
101 , _c_union :: Can.Union
102 , _c_index :: Index.ZeroBased
103 , _c_args :: [Can.Type]
104 }
108-- BINOPS
111data Binop =
112 Binop
113 { _op :: N.Name
114 , _op_home :: ModuleName.Canonical
115 , _op_name :: N.Name
116 , _op_annotation :: Can.Annotation
117 , _op_associativity :: Binop.Associativity
118 , _op_precedence :: Binop.Precedence
119 }
123-- VARIABLE -- ADD LOCALS
126addLocals :: Map.Map N.Name R.Region -> Env -> Result i w Env
127addLocals names (Env home vars ts cs bs qvs qts qcs) =
128 do newVars <-
129 Map.mergeA
130 (Map.mapMissing addLocalLeft)
131 (Map.mapMissing (\_ homes -> homes))
132 (Map.zipWithAMatched addLocalBoth)
133 names
134 vars
136 Result.ok (Env home newVars ts cs bs qvs qts qcs)
139addLocalLeft :: N.Name -> R.Region -> Var
140addLocalLeft _ region =
141 Local region
144addLocalBoth :: N.Name -> R.Region -> Var -> Result i w Var
145addLocalBoth name region var =
146 case var of
147 Foreign _ ->
148 Result.ok (Local region)
150 Local parentRegion ->
151 Result.throw (Error.Shadowing name parentRegion region)
153 TopLevel parentRegion ->
154 Result.throw (Error.Shadowing name parentRegion region)
158-- FIND TYPE
161findType :: R.Region -> Env -> N.Name -> Result i w Type
162findType region (Env _ _ types _ _ _ _ _) name =
163 case Map.lookup name types of
164 Just (OneOrMore.One tipe) ->
165 Result.ok tipe
167 Just _ ->
168 error "TODO findType ambiguous unqualified"
170 Nothing ->
171 error "TODO findType not found" region
174findTypeQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Type
175findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =
176 case Map.lookup prefix types of
177 Just qualified ->
178 case Map.lookup name qualified of
179 Just (OneOrMore.One tipe) ->
180 Result.ok tipe
182 Just more ->
183 error "TODO findTypeQual ambiguous qualified" more
185 Nothing ->
186 error "TODO findTypeQual no qualified"
188 Nothing ->
189 error "TODO findTypeQual not found" region
193-- FIND CTOR
196findCtor :: R.Region -> Env -> N.Name -> Result i w Ctor
197findCtor region (Env _ _ _ ctors _ _ _ _) name =
198 case Map.lookup name ctors of
199 Just (OneOrMore.One ctor) ->
200 Result.ok ctor
202 Just _ ->
203 error "TODO findCtor ambiguous unqualified"
205 Nothing ->
206 error "TODO findCtor not found" region
209findCtorQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Ctor
210findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =
211 case Map.lookup prefix ctors of
212 Just qualified ->
213 case Map.lookup name qualified of
214 Just (OneOrMore.One pattern) ->
215 Result.ok pattern
217 Just _ ->
218 error "TODO findCtorQual ambiguous qualified"
220 Nothing ->
221 error "TODO findCtorQual no qualified"
223 Nothing ->
224 error "TODO findCtorQual not found" region
228-- FIND BINOP
231findBinop :: R.Region -> Env -> N.Name -> Result i w Binop
232findBinop region (Env _ _ _ _ binops _ _ _) name =
233 case Map.lookup name binops of
234 Just (OneOrMore.One binop) ->
235 Result.ok binop
237 Nothing ->
238 Result.throw (error "TODO unknown binop" region)
240 Just _ ->
241 Result.throw (error "TODO ambiguous binop" region)