ref: 0a8d30070d8a79e07615a58ef9567b0dbcb71d94
parent: ee79af7381357c5e7331a9c4f5a037136cdd6a56
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Oct 30 05:51:31 EDT 2023
Simplify addConstraint calls
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -473,11 +473,12 @@
mkInstInfo ic = InstInfo M.empty [ic]
putInstTable $ foldr (\ ic -> M.insertWith mergeInstInfo (getInstCon ic) (mkInstInfo ic)) is ics
-addConstraint :: String -> (Ident, EConstraint) -> T ()
-addConstraint _msg e@(_d, _ctx) = T.do
+addConstraint :: Ident -> EConstraint -> T ()
+addConstraint d ctx = T.do
-- traceM $ "addConstraint: " ++ msg ++ " " ++ showIdent d ++ " :: " ++ showEType ctx
+ ctx' <- expandSyn ctx
TC mn n fx tt st vt ast sub m cs is es <- get
- put $ TC mn n fx tt st vt ast sub m cs is (e : es)
+ put $ TC mn n fx tt st vt ast sub m cs is ((d, ctx') : es)
withDict :: forall a . Ident -> EConstraint -> T a -> T a
withDict i c ta = T.do
@@ -783,8 +784,7 @@
let d = mkIdentSLoc loc ("dict$" ++ showInt u)loc = getSLocExpr ae
--traceM $ "addConstraint: " ++ showIdent d ++ " :: " ++ showEType ctx ++ " " ++ showSLoc loc
- ctx' <- expandSyn ctx
- addConstraint "from tDict " (d, ctx')
+ addConstraint d ctx
tDict (EApp ae (EVar d), t)
tDict at = T.return at
@@ -1336,9 +1336,7 @@
d <- newIdent (getSLocIdent i) "dict$"
case mt of
Infer _ -> impossible
- Check t -> T.do
- t' <- expandSyn t
- addConstraint "from dict$" (d, t')
+ Check t -> addConstraint d t
T.return (EVar d)
_ -> T.do
--
⑨