git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Canonicalize/Environment.hs
171 lines 3.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Canonicalize.Environment
4 ( Env(..)
5 , getPackage
6 , insert
7 , Patch(..), fromPatches, addPattern
8 , builtinPatches
9 , toLocalizer
10 )
11 where
13import qualified Data.List as List
14import qualified Data.Map as Map
15import qualified Data.Maybe as Maybe
16import qualified Data.Set as Set
17import qualified Data.Text as Text
18import Data.Text (Text)
20import qualified AST.Helpers as Help
21import qualified AST.Declaration as Decl
22import qualified AST.Module.Name as ModuleName
23import qualified AST.Pattern as P
24import qualified AST.Type as Type
25import qualified AST.Variable as Var
26import qualified Elm.Package as Pkg
27import qualified Reporting.Render.Type as RT
31-- ENVIRONMENT
34data Env = Env
35 { _home :: ModuleName.Canonical
36 , _values :: Dict Var.Canonical
37 , _unions :: Dict Var.Canonical
38 , _aliases :: Dict (Var.Canonical, [Text], Type.Canonical)
39 , _patterns :: Dict (Var.Canonical, Int)
40 , _infixes :: Map.Map Var.Canonical (Decl.Assoc, Int)
41 }
44type Dict a =
45 Map.Map Text (Set.Set a)
48fromPatches :: ModuleName.Canonical -> [Patch] -> Env
49fromPatches moduleName patches =
50 addPatches patches (Env moduleName Map.empty Map.empty Map.empty Map.empty Map.empty)
53addPattern :: P.Pattern ann var -> Env -> Env
54addPattern pattern env =
55 let
56 patches =
57 map (\x -> Value x (Var.local x)) (P.boundVarList pattern)
58 in
59 addPatches patches env
62getPackage :: Env -> Pkg.Name
63getPackage env =
64 ModuleName._package (_home env)
68-- PATCHES
71data Patch
72 = Value Text Var.Canonical
73 | Union Text Var.Canonical
74 | Alias Text (Var.Canonical, [Text], Type.Canonical)
75 | Pattern Text (Var.Canonical, Int)
76 | Infix Var.Canonical Decl.Assoc Int
80-- ADD PATCH TO ENVIRONMENT
83addPatches :: [Patch] -> Env -> Env
84addPatches patches env =
85 List.foldl' (flip addPatch) env patches
88addPatch :: Patch -> Env -> Env
89addPatch patch env =
90 case patch of
91 Value name var ->
92 env { _values = insert name var (_values env) }
94 Union name var ->
95 env { _unions = insert name var (_unions env) }
97 Alias name var ->
98 env { _aliases = insert name var (_aliases env) }
100 Pattern name var ->
101 env { _patterns = insert name var (_patterns env) }
103 Infix name assoc prec ->
104 env { _infixes = Map.insert name (assoc, prec) (_infixes env) }
107insert :: (Ord a) => Text -> a -> Dict a -> Dict a
108insert key value =
109 Map.insertWith Set.union key (Set.singleton value)
113-- PATCH HELPERS
116builtinPatches :: [Patch]
117builtinPatches =
118 concat
119 [ map (patch Value) tupleNames
120 , map (patch Union) (tupleNames ++ ["List","Int","Float","Char","Bool","String"])
121 , map (patternPatch) (tuples ++ [ ("::", 2), ("[]", 0) ])
122 ]
123 where
124 patch mkPatch name =
125 mkPatch name (Var.builtin name)
127 patternPatch (name, args) =
128 Pattern name (Var.builtin name, args)
130 tupleNames =
131 map fst tuples
133 tuples =
134 map toTuple [0..9]
136 toTuple :: Int -> (Text, Int)
137 toTuple n =
138 ( Help.makeTuple n, n )
142-- TO TYPE DEALIASER
145toLocalizer :: Env -> RT.Localizer
146toLocalizer (Env _ _ unions aliases _ _) =
147 let
148 dealiasUnion (localName, canonicalSet) =
149 case Set.toList canonicalSet of
150 [canonicalName] ->
151 Just (canonicalName, localName)
152 _ ->
153 Nothing
155 dealiasAlias (localName, canonicalSet) =
156 case Set.toList canonicalSet of
157 [(canonicalName,_,_)] ->
158 Just (canonicalName, localName)
159 _ ->
160 Nothing
162 unionPairs =
163 Maybe.mapMaybe dealiasUnion (Map.toList unions)
165 aliasPairs =
166 Maybe.mapMaybe dealiasAlias (Map.toList aliases)
168 add (key,value) dict =
169 Map.insertWith (\v v' -> if Text.length v < Text.length v' then v else v') key value dict
170 in
171 foldr add Map.empty (unionPairs ++ aliasPairs)