git.iko.soy/elk
on 501c607 help sign in
elk/src/Transform/Canonicalize/Environment.hs
110 lines 3.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Canonicalize.Environment where
4import Control.Arrow (second)
5import qualified Control.Monad.Error as Error
6import qualified Control.Monad.State as State
7import qualified Data.Map as Map
8import qualified Data.Set as Set
10import AST.Expression.General (saveEnvName)
11import qualified AST.Module as Module
12import qualified AST.Pattern as P
13import qualified AST.Type as Type
14import qualified AST.Variable as Var
16import Text.PrettyPrint (Doc)
19-- ENVIRONMENT
21data Environment = Env
22 { _home :: Module.Name
23 , _values :: Dict Var.Canonical
24 , _adts :: Dict Var.Canonical
25 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
26 , _patterns :: Dict Var.Canonical
27 }
30builtIns :: Module.Name -> Environment
31builtIns home =
32 Env { _home = home
33 , _values = builtIn (tuples ++ [saveEnvName])
34 , _adts = builtIn (tuples ++ ["List","Int","Float","Char","Bool","String"])
35 , _aliases = dict []
36 , _patterns = builtIn (tuples ++ ["::","[]"])
37 }
38 where
39 builtIn xs =
40 dict $ map (\x -> (x, Var.Canonical Var.BuiltIn x)) xs
42 tuples =
43 map (\n -> "_Tuple" ++ show n) [0 .. 9 :: Int]
46addPattern :: P.Pattern var -> Environment -> Environment
47addPattern ptrn env =
48 env { _values = foldr put (_values env) (P.boundVarList ptrn) }
49 where
50 put x =
51 Map.insert x [Var.local x]
54merge :: Environment -> Environment -> Environment
55merge (Env n1 v1 t1 a1 p1) (Env n2 v2 t2 a2 p2)
56 | n1 /= n2 = error "trying to merge incompatable environments"
57 | otherwise =
58 Env { _home = n1
59 , _values = Map.unionWith (++) v1 v2
60 , _adts = Map.unionWith (++) t1 t2
61 , _aliases = Map.unionWith (++) a1 a2
62 , _patterns = Map.unionWith (++) p1 p2
63 }
66-- RAW NAMES to CANONICAL NAMES
68type Dict a =
69 Map.Map String [a]
72dict :: [(String,a)] -> Dict a
73dict pairs =
74 Map.fromList (map (second (:[])) pairs)
77insert :: String -> a -> Dict a -> Dict a
78insert key value =
79 Map.insertWith (++) key [value]
82-- CANONICALIZATION MANAGER
84type Canonicalizer err a =
85 Error.ErrorT err (State.State (Set.Set Module.Name)) a
88uses :: (Error.Error e) => Module.Name -> Canonicalizer e ()
89uses home =
90 Error.lift (State.modify (Set.insert home))
93using :: Var.Canonical -> Canonicalizer String Var.Canonical
94using var@(Var.Canonical home _) =
95 do case home of
96 Var.BuiltIn -> return ()
97 Var.Module path -> uses path
98 Var.Local -> return ()
99 return var
102onError :: (String -> Doc) -> Canonicalizer String a -> Canonicalizer [Doc] a
103onError handler canonicalizer =
104 do usedModules <- Error.lift State.get
105 let (result, usedModules') =
106 State.runState (Error.runErrorT canonicalizer) usedModules
107 Error.lift (State.put usedModules')
108 case result of
109 Left err -> Error.throwError [handler err]
110 Right x -> return x