git.iko.soy/elk
on 577fc17 help sign in
elk/compiler/Transform/Canonicalize/Environment.hs
80 lines 2.6 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.Pattern as P
12import qualified AST.Type as Type
13import qualified AST.Variable as Var
15import AST.PrettyPrint ()
16import Text.PrettyPrint (Doc)
18type Dict a = Map.Map String [a]
20dict :: [(String,a)] -> Dict a
21dict pairs = Map.fromList $ map (second (:[])) pairs
23insert :: String -> a -> Dict a -> Dict a
24insert key value = Map.insertWith (++) key [value]
26type Canonicalizer err a = Error.ErrorT err (State.State (Set.Set String)) a
28uses :: (Error.Error e) => String -> Canonicalizer e ()
29uses home =
30 Error.lift (State.modify (Set.insert home))
32using :: Var.Canonical -> Canonicalizer String Var.Canonical
33using var@(Var.Canonical home _) =
34 do case home of
35 Var.BuiltIn -> return ()
36 Var.Module path -> uses path
37 Var.Local -> return ()
38 return var
40onError :: (String -> Doc) -> Canonicalizer String a -> Canonicalizer [Doc] a
41onError handler canonicalizer =
42 do usedModules <- Error.lift State.get
43 let (result, usedModules') =
44 State.runState (Error.runErrorT canonicalizer) usedModules
45 Error.lift (State.put usedModules')
46 case result of
47 Left err -> Error.throwError [handler err]
48 Right x -> return x
50data Environment = Env
51 { _values :: Dict Var.Canonical
52 , _adts :: Dict Var.Canonical
53 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
54 , _patterns :: Dict Var.Canonical
55 }
57builtIns :: Environment
58builtIns =
59 Env { _values = builtIn (tuples ++ [saveEnvName])
60 , _adts = builtIn (tuples ++ ["_List","Int","Float","Char","Bool","String"])
61 , _aliases = dict []
62 , _patterns = builtIn (tuples ++ ["::","[]"])
63 }
64 where
65 builtIn xs = dict $ map (\x -> (x, Var.Canonical Var.BuiltIn x)) xs
66 tuples = map (\n -> "_Tuple" ++ show (n :: Int)) [0..9]
68update :: P.Pattern var -> Environment -> Environment
69update ptrn env =
70 env { _values = foldr put (_values env) (P.boundVarList ptrn) }
71 where
72 put x = Map.insert x [Var.local x]
74merge :: Environment -> Environment -> Environment
75merge (Env v1 t1 a1 p1) (Env v2 t2 a2 p2) =
76 Env { _values = Map.unionWith (++) v1 v2
77 , _adts = Map.unionWith (++) t1 t2
78 , _aliases = Map.unionWith (++) a1 a2
79 , _patterns = Map.unionWith (++) p1 p2
80 }