diff --git a/parser-typechecker/src/Unison/ABT.hs b/parser-typechecker/src/Unison/ABT.hs index a517bf91b..11d0cebe5 100644 --- a/parser-typechecker/src/Unison/ABT.hs +++ b/parser-typechecker/src/Unison/ABT.hs @@ -257,9 +257,11 @@ changeVars :: (Foldable f, Functor f, Var v) => Map v v -> Term f v a -> Term f changeVars m t = case out t of Abs v body -> case Map.lookup v m of Nothing -> abs' (annotation t) v (changeVars m body) - Just v' -> abs' (annotation t) v' (changeVars m (rename v v' body)) + Just v' -> abs' (annotation t) v' (changeVars m body) Cycle body -> cycle' (annotation t) (changeVars m body) - Var _ -> t + Var v -> case Map.lookup v m of + Nothing -> t + Just v -> annotatedVar (annotation t) v Tm v -> tm' (annotation t) (changeVars m <$> v) -- | Produce a variable which is free in both terms diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 142b437b4..f2dc4b214 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -279,7 +279,7 @@ renderTypeError e env src = case e of ] FunctionApplication {..} -> let - fte = Type.cleanup (Type.removePureEffects ft) + fte = Type.removePureEffects ft fteFreeVars = Set.map TypeVar.underlying $ ABT.freeVars fte showVar (v, _t) = Set.member v fteFreeVars solvedVars' = filter showVar solvedVars diff --git a/parser-typechecker/src/Unison/Typechecker/TypeError.hs b/parser-typechecker/src/Unison/Typechecker/TypeError.hs index 64f113b45..75912efd9 100644 --- a/parser-typechecker/src/Unison/Typechecker/TypeError.hs +++ b/parser-typechecker/src/Unison/Typechecker/TypeError.hs @@ -1,8 +1,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE BangPatterns #-} module Unison.Typechecker.TypeError where +-- import Debug.Trace import Control.Applicative (empty) import Data.Foldable (asum, toList) import Data.Bifunctor (second) @@ -135,11 +137,11 @@ unknownType = do n <- Ex.errorNote pure $ UnknownType v loc n -unknownTerm :: Ex.ErrorExtractor v loc (TypeError v loc) +unknownTerm :: Var v => Ex.ErrorExtractor v loc (TypeError v loc) unknownTerm = do (loc, v, suggs, typ) <- Ex.unknownTerm n <- Ex.errorNote - pure $ UnknownTerm v loc suggs typ n + pure $ UnknownTerm v loc suggs (Type.cleanup typ) n generalMismatch :: (Var v, Ord loc) => Ex.ErrorExtractor v loc (TypeError v loc) generalMismatch = do @@ -159,10 +161,9 @@ generalMismatch = do n <- Ex.errorNote mismatchSite <- Ex.innermostTerm ((foundLeaf, expectedLeaf), (foundType, expectedType)) <- firstLastSubtype - pure $ Mismatch (sub foundType) (sub expectedType) - (sub foundLeaf) (sub expectedLeaf) - (ABT.annotation mismatchSite) - n + let [ft, et, fl, el] = Type.cleanups [sub foundType, sub expectedType, + sub foundLeaf, sub expectedLeaf] + pure $ Mismatch ft et fl el (ABT.annotation mismatchSite) n and,or,cond,matchGuard