diff options
author | Tom Smeding <tom@tomsmeding.com> | 2025-01-19 22:46:39 +0100 |
---|---|---|
committer | Tom Smeding <tom@tomsmeding.com> | 2025-01-19 22:46:39 +0100 |
commit | c7619a27f841d24b5acb4c99ed486e95bd5130d8 (patch) | |
tree | 9aae2e1c9665b83090e1c3d80f71c0b9fdffea34 /src/HSVIS/Typecheck/Solve.hs | |
parent | e13b0a681108697f8b67d8c836edd54c042aad55 (diff) |
Noodling on the type checker
Diffstat (limited to 'src/HSVIS/Typecheck/Solve.hs')
-rw-r--r-- | src/HSVIS/Typecheck/Solve.hs | 8 |
1 files changed, 6 insertions, 2 deletions
diff --git a/src/HSVIS/Typecheck/Solve.hs b/src/HSVIS/Typecheck/Solve.hs index 7250e79..250d7e7 100644 --- a/src/HSVIS/Typecheck/Solve.hs +++ b/src/HSVIS/Typecheck/Solve.hs @@ -83,7 +83,8 @@ solveConstraints reduce frees subst detect size = \tupcs -> errs'' = fmap constrUnequal errs <> errs' in trace ("[solver] Solving:" ++ concat ["\n- " ++ pretty a ++ " == " ++ pretty b ++ " {" ++ pretty r ++ "}" | Constr a b r <- cs]) $ trace ("[solver] Result: (with " ++ show (length errs'') ++ " errors)" ++ - concat ["\n- " ++ show v ++ " = " ++ pretty t | (v, t) <- Map.assocs asg']) + concat ["\n- " ++ show v ++ " = " ++ pretty t | (v, t) <- Map.assocs asg'] ++ + "\n... errors: " ++ intercalate ", " (map summariseUE (toList errs''))) (asg', errs'') where reduce' :: Constr t t -> (Bag (Constr v t), Bag (Constr t t)) @@ -136,10 +137,13 @@ solveConstraints reduce frees subst detect size = \tupcs -> applyLog ((v, t) : l) m = applyLog l $ Map.insert v (subst m t) m applyLog [] m = m - -- If there are multiple sources for the same cosntraint, only one of them is kept. + -- If there are multiple sources for the same constraint, only one of them is kept. dedupRCs :: Ord t => [RConstr t] -> [RConstr t] dedupRCs = map head . groupBy ((==) `on` rconType) . sortBy (comparing rconType) + summariseUE (UEUnequal t1 t2 rng) = "({" ++ pretty rng ++ "} " ++ pretty t1 ++ " /= " ++ pretty t2 ++ ")" + summariseUE (UERecursive v t2 rng) = "({" ++ pretty rng ++ "} [" ++ show v ++ "] rec in " ++ pretty t2 ++ ")" + minimumByMay :: Foldable t' => (a -> a -> Ordering) -> t' a -> Maybe a minimumByMay cmp = foldl' min' Nothing where min' mx y = Just $! case mx of |