diff --git a/bowtie-visualize/src/Bowtie/Visualize.hs b/bowtie-visualize/src/Bowtie/Visualize.hs index 1d56dde..19fb54f 100644 --- a/bowtie-visualize/src/Bowtie/Visualize.hs +++ b/bowtie-visualize/src/Bowtie/Visualize.hs @@ -66,10 +66,12 @@ solutionSteps :: (MonadState Int m, MonadError SolveError m) => Constraints -> m solutionSteps cs = do case next cs of Nothing -> - if Constraints.isEmpty cs then - pure mempty - else - throwError SolveStuck + if Constraints.isEmpty cs + then + pure mempty + + else + throwError SolveStuck Just (c, rest) -> do (_sub, rest2) <- mapError SolveUnifyError (solveConstraint c rest) diff --git a/bowtie/src/Bowtie/Infer/Solve.hs b/bowtie/src/Bowtie/Infer/Solve.hs index 946f13d..ebb04b5 100644 --- a/bowtie/src/Bowtie/Infer/Solve.hs +++ b/bowtie/src/Bowtie/Infer/Solve.hs @@ -21,10 +21,12 @@ solve :: (MonadState Int m, MonadError SolveError m) => Constraints -> m Substit solve cs = do case next cs of Nothing -> - if Constraints.isEmpty cs then - pure mempty - else - throwError SolveStuck + if Constraints.isEmpty cs + then + pure mempty + + else + throwError SolveStuck Just (c, rest) -> do (sub, rest2) <- mapError SolveUnifyError (solveConstraint c rest) diff --git a/bowtie/src/Bowtie/Infer/Unify.hs b/bowtie/src/Bowtie/Infer/Unify.hs index abd7a48..8dc6c4b 100644 --- a/bowtie/src/Bowtie/Infer/Unify.hs +++ b/bowtie/src/Bowtie/Infer/Unify.hs @@ -44,32 +44,36 @@ unify t1 t2 = -- 5. It returns the composition of these, substituting Int for 1, -- followed by Int for 0. - if t1 == t2 then - Right mempty - else - case (t1, t2) of - (TVariable id, _) -> - unifyVariable id t2 + if t1 == t2 + then + Right mempty - (_, TVariable id) -> - unifyVariable id t1 + else + case (t1, t2) of + (TVariable id, _) -> + unifyVariable id t2 - (TArrow arg1 res1, TArrow arg2 res2) -> do - s1 <- unify arg1 arg2 - s2 <- unify (substType s1 res1) (substType s1 res2) - Right (s1 <> s2) + (_, TVariable id) -> + unifyVariable id t1 - (TypeApp a1 b1, TypeApp a2 b2) -> do - s1 <- unify a1 a2 - s2 <- unify (substType s1 b1) (substType s1 b2) - Right (s1 <> s2) + (TArrow arg1 res1, TArrow arg2 res2) -> do + s1 <- unify arg1 arg2 + s2 <- unify (substType s1 res1) (substType s1 res2) + Right (s1 <> s2) - _ -> - Left (UnifyError t1 t2) + (TypeApp a1 b1, TypeApp a2 b2) -> do + s1 <- unify a1 a2 + s2 <- unify (substType s1 b1) (substType s1 b2) + Right (s1 <> s2) + + _ -> + Left (UnifyError t1 t2) where unifyVariable :: Id -> Type -> Either UnifyError Substitution unifyVariable id typ = - if Set.member id (freeVars typ) then - Left (OccursCheckFailed id typ) - else - Right (singleSub id typ) + if Set.member id (freeVars typ) + then + Left (OccursCheckFailed id typ) + + else + Right (singleSub id typ) diff --git a/bowtie/src/Bowtie/Surface/Infer.hs b/bowtie/src/Bowtie/Surface/Infer.hs index 616dc3a..dfdf3ce 100644 --- a/bowtie/src/Bowtie/Surface/Infer.hs +++ b/bowtie/src/Bowtie/Surface/Infer.hs @@ -67,10 +67,12 @@ gatherConstraints env expr = do remaining :: Set Id remaining = Set.difference (Assumptions.keys a) (Environment.keys env) - if Set.null remaining then - pure () - else - throwError (AssumptionsRemain a) + if Set.null remaining + then + pure () + + else + throwError (AssumptionsRemain a) pure (c <> explicitConstraintOnSet env a, t)