Report ambiguous type/kind uvars, don't crash

1 files changed, 11 insertions, 11 deletions

diff --git a/src/HSVIS/Typecheck/Solve.hs b/src/HSVIS/Typecheck/Solve.hs
index 250d7e7..7b91585 100644
--- a/src/HSVIS/Typecheck/Solve.hs
+++ b/src/HSVIS/Typecheck/Solve.hs
@@ -84,7 +84,7 @@ solveConstraints reduce frees subst detect size = \tupcs ->
   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'] ++
-              "\n... errors: " ++ intercalate ", " (map summariseUE (toList errs'')))
+              "\n... errors: [" ++ intercalate ", " (map summariseUE (toList errs'')) ++ "]")
      (asg', errs'')
   where
     reduce' :: Constr t t -> (Bag (Constr v t), Bag (Constr t t))
@@ -92,14 +92,14 @@ solveConstraints reduce frees subst detect size = \tupcs ->
 
     loop :: Map v (Bag (RConstr t)) -> [(v, t)] -> (Bag (UnifyErr v t), Map v t)
     loop m eqlog = do
-      traceM $ "[solver] Step:" ++ concat
-                 [case toList rhss of
-                    [] -> "\n- " ++ show v ++ " <no RHSs>"
-                    RConstr t r : rest ->
-                      "\n- " ++ show v ++ " == " ++ pretty t ++ "  {" ++ pretty r ++ "}" ++
-                        concat ["\n  " ++ replicate (length (show v)) ' ' ++ " == " ++ pretty t' ++ "  {" ++ pretty r' ++ "}"
-                               | RConstr t' r' <- rest]
-                 | (v, rhss) <- Map.assocs m]
+      -- traceM $ "[solver] Step:" ++ concat
+      --            [case toList rhss of
+      --               [] -> "\n- " ++ show v ++ " <no RHSs>"
+      --               RConstr t r : rest ->
+      --                 "\n- " ++ show v ++ " == " ++ pretty t ++ "  {" ++ pretty r ++ "}" ++
+      --                   concat ["\n  " ++ replicate (length (show v)) ' ' ++ " == " ++ pretty t' ++ "  {" ++ pretty r' ++ "}"
+      --                          | RConstr t' r' <- rest]
+      --            | (v, rhss) <- Map.assocs m]
 
       m' <- Map.traverseWithKey
               (\v rhss ->
@@ -120,10 +120,10 @@ solveConstraints reduce frees subst detect size = \tupcs ->
 
       case msmallestvar of
         Nothing -> do
-          traceM $ "[solver] Log = [" ++ intercalate ", " [show v ++ " = " ++ pretty t | (v, t) <- eqlog] ++ "]"
+          -- traceM $ "[solver] Log = [" ++ intercalate ", " [show v ++ " = " ++ pretty t | (v, t) <- eqlog] ++ "]"
           return $ applyLog eqlog mempty
         Just (var, RConstr smallrhs _) -> do
-          traceM $ "[solver] Retiring " ++ show var ++ " = " ++ pretty smallrhs
+          -- traceM $ "[solver] Retiring " ++ show var ++ " = " ++ pretty smallrhs
           let (_, otherrhss) = bagPartition (guard . (== smallrhs) . rconType) (m' Map.! var)
           let (newcs, errs) = foldMap (reduce' . unsplitConstr smallrhs) (dedupRCs (toList otherrhss))
           (fmap constrUnequal errs, ())  -- write the errors