Flatten TypeError

seagreen · Nov 10, 2019 · 497f51b · 497f51b
1 parent 8f09c74
commit 497f51b
Show file tree

Hide file tree

Showing 6 changed files with 17 additions and 11 deletions.
diff --git a/bowtie/src/Bowtie/Infer/Unify.hs b/bowtie/src/Bowtie/Infer/Unify.hs
@@ -8,8 +8,8 @@ import Bowtie.Surface.AST
 import qualified Data.Set as Set
 
 data UnifyError
-  = UnifyError Type Type
-  | OccursCheckFailed Id Type
+  = TypeMismatch Type Type
+  | IdOccursInType Id Type
   deriving (Eq, Show)
 
 -- | Implementation based on <doc.md#AlgorithmWStepByStep>.
@@ -67,13 +67,13 @@ unify t1 t2 =
           Right (s1 <> s2)
 
         _ ->
-          Left (UnifyError t1 t2)
+          Left (TypeMismatch t1 t2)
   where
     unifyVariable :: Id -> Type -> Either UnifyError Substitution
     unifyVariable id typ =
       if Set.member id (freeVars typ)
         then
-          Left (OccursCheckFailed id typ)
+          Left (IdOccursInType id typ)
 
         else
           Right (singleSub id typ)
diff --git a/bowtie/src/Bowtie/Surface/Infer.hs b/bowtie/src/Bowtie/Surface/Infer.hs
@@ -21,7 +21,8 @@ import qualified Data.Set as Set
 
 data TypeError
   = SolveStuck
-  | SolveUnifyError UnifyError
+  | UnifyError Type Type
+  | OccursCheckFailed Id Type
   | AssumptionsRemain Assumptions
   deriving (Eq, Show)
 
@@ -96,8 +97,13 @@ instance CanSolveStuck Infer where
 
 instance CanUnifyError Infer where
   failUnifyError :: UnifyError -> Infer a
-  failUnifyError =
-    throwError . SolveUnifyError
+  failUnifyError e =
+    throwError (case e of
+                 TypeMismatch t1 t2 ->
+                   UnifyError t1 t2
+
+                 IdOccursInType id t ->
+                   OccursCheckFailed id t)
 
 instance CanAssumptionsRemain Infer where
   failAssumptionsRemain :: Assumptions -> Infer a

diff --git a/bowtie/test/ill-typed-examples/case-binding-used-incorrectly.bowtie b/bowtie/test/ill-typed-examples/case-binding-used-incorrectly.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
diff --git a/bowtie/test/ill-typed-examples/case-mismatched-bodies.bowtie b/bowtie/test/ill-typed-examples/case-mismatched-bodies.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
diff --git a/bowtie/test/ill-typed-examples/let-recursion-mistyped-realistic.bowtie b/bowtie/test/ill-typed-examples/let-recursion-mistyped-realistic.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
diff --git a/bowtie/test/ill-typed-examples/let-recursion-mistyped-simple.bowtie b/bowtie/test/ill-typed-examples/let-recursion-mistyped-simple.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
Original file line number	Diff line number	Diff line change
		@@ -1 +1 @@
		SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
		UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))