ref: e6d99ada6f9321e0837840737cfd9a0e573d42b3
parent: 9779f4db8b850a7dce62bcc4a620882090ac429d
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Nov 17 19:10:14 EST 2023
small tweaks
--- a/TODO
+++ b/TODO
@@ -43,6 +43,7 @@
* Parse prefix negation
* Set lib from envvar
* Faster compression
+* Fix polymorphic pattern literals
Bugs
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -1613,12 +1613,6 @@
newDictIdent :: SLoc -> T Ident
newDictIdent loc = newIdent loc "adict"
-tcPats :: forall a . EType -> [EPat] -> (EType -> [EPat] -> T a) -> T a
-tcPats t [] ta = ta t []
-tcPats t (p:ps) ta = do
- (tp, tr) <- unArrow (getSLoc p) t
- tCheckPatC tp p $ \ pp -> tcPats tr ps $ \ tt pps -> ta tt (pp : pps)
-
tcExprLam :: Expected -> [Eqn] -> T Expr
tcExprLam mt qs = do
t <- tGetExpType mt
@@ -1655,9 +1649,15 @@
tcEqn t eqn =
case eqn of
Eqn ps alts -> tcPats t ps $ \ tt ps' -> do
- aalts <- tcAlts tt alts
- return (Eqn ps' aalts)
+ alts' <- tcAlts tt alts
+ return (Eqn ps' alts')
+tcPats :: forall a . EType -> [EPat] -> (EType -> [EPat] -> T a) -> T a
+tcPats t [] ta = ta t []
+tcPats t (p:ps) ta = do
+ (tp, tr) <- unArrow (getSLoc p) t
+ tCheckPatC tp p $ \ pp -> tcPats tr ps $ \ tt pps -> ta tt (pp : pps)
+
tcAlts :: EType -> EAlts -> T EAlts
tcAlts tt (EAlts alts bs) =
-- trace ("tcAlts: bs in " ++ showEBinds bs) $@@ -1687,8 +1687,8 @@
tcArm t tpat arm =
case arm of
(p, alts) -> tCheckPatC tpat p $ \ pp -> do
- aalts <- tcAlts t alts
- return (pp, aalts)
+ alts' <- tcAlts t alts
+ return (pp, alts')
eBinds :: [(Ident, Expr)] -> [EBind]
eBinds ds = [BFcn i [Eqn [] (EAlts [([], e)] [])] | (i, e) <- ds]
--
⑨