git.iko.soy/elk
on master help sign in
style: conform to modern style guide
b651262Evan Czaplicki
src/Transform/Canonicalize/Type.hs+50−25
compare with master
unifiedsplit
@@ -13,43 +13,68 @@ import qualified AST.Variable as Var
13import Transform.Canonicalize.Environment
13import Transform.Canonicalize.Environment
14import qualified Transform.Canonicalize.Variable as Canonicalize
14import qualified Transform.Canonicalize.Variable as Canonicalize
15
15
16+
17+tipe
18+ :: Environment
19+ -> T.RawType
16−tipe :: Environment -> T.RawType -> Canonicalizer String T.CanonicalType
20+ -> Canonicalizer String T.CanonicalType
17tipe env typ =
21tipe env typ =
18 let go = tipe env in
22 let go = tipe env in
19 case typ of
23 case typ of
24+ T.Var x ->
20− T.Var x -> return (T.Var x)
25+ return (T.Var x)
26+
27+ T.Type _ ->
21− T.Type _ -> canonicalizeApp env typ []
28+ canonicalizeApp env typ []
29+
30+ T.App t ts ->
22− T.App t ts -> canonicalizeApp env t ts
31+ canonicalizeApp env t ts
23
32
33+ T.Lambda a b ->
24− T.Lambda a b -> T.Lambda <$> go a <*> go b
34+ T.Lambda <$> go a <*> go b
35+
36+ T.Aliased name t ->
25− T.Aliased name t -> T.Aliased name <$> go t
37+ T.Aliased name <$> go t
26
38
27 T.Record fields ext ->
39 T.Record fields ext ->
28 let go' (f,t) = (,) f <$> go t
40 let go' (f,t) = (,) f <$> go t
41+ in
29− in T.Record <$> mapM go' fields <*> traverse go ext
42+ T.Record <$> mapM go' fields <*> traverse go ext
43+
30
44
31−canonicalizeApp :: Environment -> T.RawType -> [T.RawType]
45+canonicalizeApp
46+ :: Environment
47+ -> T.RawType
48+ -> [T.RawType]
32− -> Canonicalizer String T.CanonicalType
49+ -> Canonicalizer String T.CanonicalType
33canonicalizeApp env f args =
50canonicalizeApp env f args =
34 case f of
51 case f of
35 T.Type (Var.Raw rawName) ->
52 T.Type (Var.Raw rawName) ->
36− do answer <- Canonicalize.tvar env rawName
53+ do answer <- Canonicalize.tvar env rawName
37− case answer of
54+ case answer of
55+ Right alias ->
38− Right alias -> canonicalizeAlias env alias args
56+ canonicalizeAlias env alias args
57+
58+ Left name ->
39− Left name -> case args of
59+ case args of
40− [] -> return (T.Type name)
60+ [] -> return (T.Type name)
61+ _ ->
41− _:_ -> T.App (T.Type name) <$> mapM (tipe env) args
62+ T.App (T.Type name) <$> mapM (tipe env) args
42−
63+
64+ _ ->
43− _ -> T.App <$> tipe env f <*> mapM (tipe env) args
65+ T.App <$> tipe env f <*> mapM (tipe env) args
44−
66+
67+
68+canonicalizeAlias
69+ :: Environment
45−canonicalizeAlias :: Environment -> (Var.Canonical, [String], T.CanonicalType)
70+ -> (Var.Canonical, [String], T.CanonicalType)
46− -> [T.RawType]
71+ -> [T.RawType]
47− -> Canonicalizer String T.CanonicalType
72+ -> Canonicalizer String T.CanonicalType
48canonicalizeAlias env (name, tvars, dealiasedTipe) tipes =
73canonicalizeAlias env (name, tvars, dealiasedTipe) tipes =
49− do when (tipesLen /= tvarsLen) (throwError msg)
74+ do when (tipesLen /= tvarsLen) (throwError msg)
50− tipes' <- mapM (tipe env) tipes
75+ tipes' <- mapM (tipe env) tipes
51− let tipe' = replace (Map.fromList (zip tvars tipes')) dealiasedTipe
76+ let tipe' = replace (Map.fromList (zip tvars tipes')) dealiasedTipe
52− return $ T.Aliased name tipe'
77+ return $ T.Aliased name tipe'
53 where
78 where
54 tipesLen = length tipes
79 tipesLen = length tipes
55 tvarsLen = length tvars
80 tvarsLen = length tvars