@@ -13,43 +13,68 @@ import qualified AST.Variable as Var
1313import Transform.Canonicalize.Environment
1414import qualified Transform.Canonicalize.Variable as Canonicalize
1515
16−tipe :: Environment -> T.RawType -> Canonicalizer String T.CanonicalType
16+
17+tipe
18+ :: Environment
19+ -> T.RawType
20+ -> Canonicalizer String T.CanonicalType
1721tipe env typ =
1822 let go = tipe env in
1923 case typ of
20− T.Var x -> return (T.Var x)
21− T.Type _ -> canonicalizeApp env typ []
22− T.App t ts -> canonicalizeApp env t ts
24+ T.Var x ->
25+ return (T.Var x)
26+
27+ T.Type _ ->
28+ canonicalizeApp env typ []
29+
30+ T.App t ts ->
31+ canonicalizeApp env t ts
2332
24− T.Lambda a b -> T.Lambda <$> go a <*> go b
25− T.Aliased name t -> T.Aliased name <$> go t
33+ T.Lambda a b ->
34+ T.Lambda <$> go a <*> go b
35+
36+ T.Aliased name t ->
37+ T.Aliased name <$> go t
2638
2739 T.Record fields ext ->
2840 let go' (f,t) = (,) f <$> go t
29− in T.Record <$> mapM go' fields <*> traverse go ext
41+ in
42+ T.Record <$> mapM go' fields <*> traverse go ext
43+
3044
31−canonicalizeApp :: Environment -> T.RawType -> [T.RawType]
32− -> Canonicalizer String T.CanonicalType
45+canonicalizeApp
46+ :: Environment
47+ -> T.RawType
48+ -> [T.RawType]
49+ -> Canonicalizer String T.CanonicalType
3350canonicalizeApp env f args =
3451 case f of
3552 T.Type (Var.Raw rawName) ->
36− do answer <- Canonicalize.tvar env rawName
37− case answer of
38− Right alias -> canonicalizeAlias env alias args
39− Left name -> case args of
40− [] -> return (T.Type name)
41− _:_ -> T.App (T.Type name) <$> mapM (tipe env) args
42−
43− _ -> T.App <$> tipe env f <*> mapM (tipe env) args
44−
45−canonicalizeAlias :: Environment -> (Var.Canonical, [String], T.CanonicalType)
46− -> [T.RawType]
47− -> Canonicalizer String T.CanonicalType
53+ do answer <- Canonicalize.tvar env rawName
54+ case answer of
55+ Right alias ->
56+ canonicalizeAlias env alias args
57+
58+ Left name ->
59+ case args of
60+ [] -> return (T.Type name)
61+ _ ->
62+ T.App (T.Type name) <$> mapM (tipe env) args
63+
64+ _ ->
65+ T.App <$> tipe env f <*> mapM (tipe env) args
66+
67+
68+canonicalizeAlias
69+ :: Environment
70+ -> (Var.Canonical, [String], T.CanonicalType)
71+ -> [T.RawType]
72+ -> Canonicalizer String T.CanonicalType
4873canonicalizeAlias env (name, tvars, dealiasedTipe) tipes =
49− do when (tipesLen /= tvarsLen) (throwError msg)
50− tipes' <- mapM (tipe env) tipes
51− let tipe' = replace (Map.fromList (zip tvars tipes')) dealiasedTipe
52− return $ T.Aliased name tipe'
74+ do when (tipesLen /= tvarsLen) (throwError msg)
75+ tipes' <- mapM (tipe env) tipes
76+ let tipe' = replace (Map.fromList (zip tvars tipes')) dealiasedTipe
77+ return $ T.Aliased name tipe'
5378 where
5479 tipesLen = length tipes
5580 tvarsLen = length tvars