@@ -16,41 +16,47 @@ import qualified AST.Variable as Var
1616import Text.PrettyPrint (Doc)
1717
1818
19−type Dict a = Map.Map String [a]
19+type Dict a =
20+ Map.Map String [a]
21+
2022
2123dict :: [(String,a)] -> Dict a
2224dict pairs =
23− Map.fromList $ map (second (:[])) pairs
25+ Map.fromList $ map (second (:[])) pairs
26+
2427
2528insert :: String -> a -> Dict a -> Dict a
2629insert key value =
27− Map.insertWith (++) key [value]
30+ Map.insertWith (++) key [value]
2831
2932
3033type Canonicalizer err a =
3134 Error.ErrorT err (State.State (Set.Set Module.Name)) a
3235
36+
3337uses :: (Error.Error e) => Module.Name -> Canonicalizer e ()
3438uses home =
35− Error.lift (State.modify (Set.insert home))
39+ Error.lift (State.modify (Set.insert home))
40+
3641
3742using :: Var.Canonical -> Canonicalizer String Var.Canonical
3843using var@(Var.Canonical home _) =
39− do case home of
40− Var.BuiltIn -> return ()
41− Var.Module path -> uses path
42− Var.Local -> return ()
43− return var
44+ do case home of
45+ Var.BuiltIn -> return ()
46+ Var.Module path -> uses path
47+ Var.Local -> return ()
48+ return var
49+
4450
4551onError :: (String -> Doc) -> Canonicalizer String a -> Canonicalizer [Doc] a
4652onError handler canonicalizer =
47− do usedModules <- Error.lift State.get
48− let (result, usedModules') =
49− State.runState (Error.runErrorT canonicalizer) usedModules
50− Error.lift (State.put usedModules')
51− case result of
52− Left err -> Error.throwError [handler err]
53− Right x -> return x
53+ do usedModules <- Error.lift State.get
54+ let (result, usedModules') =
55+ State.runState (Error.runErrorT canonicalizer) usedModules
56+ Error.lift (State.put usedModules')
57+ case result of
58+ Left err -> Error.throwError [handler err]
59+ Right x -> return x
5460
5561
5662data Environment = Env
@@ -61,6 +67,7 @@ data Environment = Env
6167 , _patterns :: Dict Var.Canonical
6268 }
6369
70+
6471builtIns :: Module.Name -> Environment
6572builtIns home =
6673 Env { _home = home
@@ -70,22 +77,27 @@ builtIns home =
7077 , _patterns = builtIn (tuples ++ ["::","[]"])
7178 }
7279 where
73− builtIn xs = dict $ map (\x -> (x, Var.Canonical Var.BuiltIn x)) xs
74− tuples = map (\n -> "_Tuple" ++ show (n :: Int)) [0..9]
80+ builtIn xs =
81+ dict $ map (\x -> (x, Var.Canonical Var.BuiltIn x)) xs
82+
83+ tuples =
84+ map (\n -> "_Tuple" ++ show (n :: Int)) [0..9]
85+
7586
7687update :: P.Pattern var -> Environment -> Environment
7788update ptrn env =
7889 env { _values = foldr put (_values env) (P.boundVarList ptrn) }
79− where
80− put x = Map.insert x [Var.local x]
90+ where
91+ put x = Map.insert x [Var.local x]
92+
8193
8294merge :: Environment -> Environment -> Environment
8395merge (Env n1 v1 t1 a1 p1) (Env n2 v2 t2 a2 p2)
84− | n1 /= n2 = error "trying to merge incompatable environments"
85− | otherwise =
86− Env { _home = n1
87− , _values = Map.unionWith (++) v1 v2
88− , _adts = Map.unionWith (++) t1 t2
89− , _aliases = Map.unionWith (++) a1 a2
90− , _patterns = Map.unionWith (++) p1 p2
91− }
96+ | n1 /= n2 = error "trying to merge incompatable environments"
97+ | otherwise =
98+ Env { _home = n1
99+ , _values = Map.unionWith (++) v1 v2
100+ , _adts = Map.unionWith (++) t1 t2
101+ , _aliases = Map.unionWith (++) a1 a2
102+ , _patterns = Map.unionWith (++) p1 p2
103+ }