From 0e21fb5be982ed7e48be455f872fb862ef28b895 Mon Sep 17 00:00:00 2001 From: Péter Diviánszky Date: Thu, 28 Apr 2016 04:01:56 +0200 Subject: unify Doc types; better expr. pretty print --- lambdacube-compiler.cabal | 4 +- src/LambdaCube/Compiler/CoreToIR.hs | 2 +- src/LambdaCube/Compiler/DesugaredSource.hs | 26 +-- src/LambdaCube/Compiler/Infer.hs | 14 +- src/LambdaCube/Compiler/Parser.hs | 10 +- src/LambdaCube/Compiler/Patterns.hs | 4 +- src/LambdaCube/Compiler/Pretty.hs | 182 +++++++++++---------- testdata/language-features/basic-values/case05.out | 2 +- testdata/language-features/basic-values/def03.out | 2 +- .../basic-values/def07.reject.out | 4 +- 10 files changed, 133 insertions(+), 117 deletions(-) diff --git a/lambdacube-compiler.cabal b/lambdacube-compiler.cabal index 17c8fd56..a5bd8980 100644 --- a/lambdacube-compiler.cabal +++ b/lambdacube-compiler.cabal @@ -136,7 +136,7 @@ executable lambdacube-compiler-test-suite monad-control >= 1.0 && <1.1, optparse-applicative == 0.12.*, megaparsec >= 4.3.0 && <4.5, - wl-pprint >=1.2 && <1.3, + ansi-wl-pprint >=0.6 && <0.7, patience >= 0.1 && < 0.2, text >= 1.2 && <1.3, time >= 1.5 && <1.6, @@ -244,7 +244,7 @@ executable lambdacube-compiler-coverage-test-suite monad-control >= 1.0 && <1.1, optparse-applicative == 0.12.*, megaparsec >= 4.3.0 && <4.5, - wl-pprint >=1.2 && <1.3, + ansi-wl-pprint >=0.6 && <0.7, pretty-show >= 1.6.9, patience >= 0.1 && < 0.2, text >= 1.2 && <1.3, diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs index 13aac101..d9d31d68 100644 --- a/src/LambdaCube/Compiler/CoreToIR.hs +++ b/src/LambdaCube/Compiler/CoreToIR.hs @@ -913,7 +913,7 @@ instance Up ExpTV where closedExp (ExpTV a b cs) = ExpTV (closedExp a) (closedExp b) cs instance PShow ExpTV where - pShowPrec p (ExpTV x t _) = pShowPrec p (x, t) + pShow (ExpTV x t _) = pShow (x, t) isSampler (TyCon n _) = show n == "'Sampler" isSampler _ = False diff --git a/src/LambdaCube/Compiler/DesugaredSource.hs b/src/LambdaCube/Compiler/DesugaredSource.hs index 0511988a..e588403a 100644 --- a/src/LambdaCube/Compiler/DesugaredSource.hs +++ b/src/LambdaCube/Compiler/DesugaredSource.hs @@ -24,6 +24,7 @@ import qualified Data.Set as Set import qualified Data.IntMap as IM import Control.Arrow hiding ((<+>)) import Control.DeepSeq +import Debug.Trace import LambdaCube.Compiler.Utils import LambdaCube.Compiler.DeBruijn @@ -64,7 +65,7 @@ data SPos = SPos deriving (Eq, Ord) instance PShow SPos where - pShowPrec _ (SPos r c) = pShow r <> ":" <> pShow c + pShow (SPos r c) = pShow r <> ":" <> pShow c -------------------------------------------------------------------------------- file info @@ -77,7 +78,7 @@ data FileInfo = FileInfo instance Eq FileInfo where (==) = (==) `on` fileId instance Ord FileInfo where compare = compare `on` fileId -instance PShow FileInfo where pShowPrec _ = text . filePath +instance PShow FileInfo where pShow = text . filePath instance Show FileInfo where show = ppShow showPos :: FileInfo -> SPos -> Doc @@ -92,7 +93,7 @@ instance NFData Range where rnf Range{} = () -- short version -instance PShow Range where pShowPrec _ (Range n b e) = pShow n <+> pShow b <> "-" <> pShow e +instance PShow Range where pShow (Range n b e) = pShow n <+> pShow b <> "-" <> pShow e instance Show Range where show = ppShow -- long version @@ -131,8 +132,8 @@ instance Monoid SI where mappend _ r@RangeSI{} = r instance PShow SI where - pShowPrec _ (NoSI ds) = hsep $ map text $ Set.toList ds - pShowPrec _ (RangeSI r) = pShow r + pShow (NoSI ds) = hsep $ map text $ Set.toList ds + pShow (RangeSI r) = pShow r -- long version showSI x = case sourceInfo x of @@ -155,13 +156,14 @@ pattern SIName si n <- SIName_ si _ n instance Eq SIName where (==) = (==) `on` sName instance Ord SIName where compare = compare `on` sName instance Show SIName where show = sName -instance PShow SIName where pShowPrec _ = text . sName +instance PShow SIName where pShow = text . sName sName (SIName _ s) = s --appName f (SIName si n) = SIName si $ f n -getFixity (SIName_ _ f _) = fromMaybe (Fixity InfixL 9) f +getFixity_ (SIName_ _ f _) = f +--getFixity (SIName_ _ f _) = fromMaybe (Fixity InfixL 9) f ------------- @@ -386,13 +388,14 @@ trSExp' :: SExp -> SExp' a trSExp' = trSExp elimVoid instance Up a => PShow (SExp' a) where - pShowPrec _ = showDoc_ . sExpDoc + pShow = sExpDoc sExpDoc :: Up a => SExp' a -> NDoc sExpDoc = \case SGlobal ns -> shAtom $ sName ns SAnn a b -> shAnn ":" False (sExpDoc a) (sExpDoc b) TyType a -> shApp Visible (shAtom "tyType") (sExpDoc a) + SGlobal op `SAppV` a `SAppV` b | Just p <- getFixity_ op -> DOp p (pShow a) (sName op) (pShow b) SApp h a b -> shApp h (sExpDoc a) (sExpDoc b) Wildcard t -> shAnn ":" True (shAtom "_") (sExpDoc t) SBind_ _ h _ a b -> shLam (usedVar 0 b) h (sExpDoc a) (sExpDoc b) @@ -401,6 +404,9 @@ sExpDoc = \case SVar _ i -> shVar i SLit _ l -> shAtom $ show l +shApp Visible a b = DApp a b +shApp Hidden a b = DApp a (DOp (Fixity InfixR 20) "@" "" b) + shLam usedVar h a b = DFreshName usedVar $ lam (p $ DUp 0 a) b where lam = case h of @@ -408,7 +414,7 @@ shLam usedVar h a b = DFreshName usedVar $ lam (p $ DUp 0 a) b _ -> shLam' p = case h of - BMeta -> cpar . shAnn ":" True (inBlue' $ DVar 0) + BMeta -> shAnn ":" True (inBlue' $ DVar 0) BLam h -> vpar h BPi h -> vpar h @@ -429,7 +435,7 @@ data Stmt pattern Primitive n t = Let n (Just t) (SBuiltin "undefined") instance PShow Stmt where - pShowPrec p = \case + pShow = \case Let n ty e -> text (sName n) "=" <+> maybe (pShow e) (\ty -> pShow e "::" <+> pShow ty) ty Data n ps ty cs -> "data" <+> text (sName n) PrecDef n i -> "precedence" <+> text (sName n) <+> text (show i) diff --git a/src/LambdaCube/Compiler/Infer.hs b/src/LambdaCube/Compiler/Infer.hs index 492e9a69..b44d67f2 100644 --- a/src/LambdaCube/Compiler/Infer.hs +++ b/src/LambdaCube/Compiler/Infer.hs @@ -1443,29 +1443,29 @@ joinEnv e1 e2 = do downTo n m = map Var [n+m-1, n+m-2..n] -tellType si t = tell $ mkInfoItem (sourceInfo si) $ removeEscs $ showDoc $ mkDoc False True (t, TType) +tellType si t = tell $ mkInfoItem (sourceInfo si) $ removeEscs $ show $ mkDoc False True (t, TType) -------------------------------------------------------------------------------- pretty print -- todo: do this via conversion to SExp instance PShow Exp where - pShowPrec _ = showDoc_ . mkDoc False False + pShow = mkDoc False False instance PShow (CEnv Exp) where - pShowPrec _ = showDoc_ . mkDoc False False + pShow = mkDoc False False instance PShow Env where - pShowPrec _ e = showDoc_ $ envDoc e $ epar $ shAtom "<>" + pShow e = envDoc e $ epar $ shAtom "<>" showEnvExp :: Env -> ExpType -> String -showEnvExp e c = showDoc $ envDoc e $ epar $ mkDoc False False c +showEnvExp e c = show $ envDoc e $ epar $ mkDoc False False c showEnvSExp :: Up a => Env -> SExp' a -> String -showEnvSExp e c = showDoc $ envDoc e $ epar $ sExpDoc c +showEnvSExp e c = show $ envDoc e $ epar $ sExpDoc c showEnvSExpType :: Up a => Env -> SExp' a -> Exp -> String -showEnvSExpType e c t = showDoc $ envDoc e $ epar $ (shAnn "::" False (sExpDoc c) (mkDoc False False (t, TType))) +showEnvSExpType e c t = show $ envDoc e $ epar $ (shAnn "::" False (sExpDoc c) (mkDoc False False (t, TType))) {- where infixl 4 <**> diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs index 49079073..33a24d0a 100644 --- a/src/LambdaCube/Compiler/Parser.hs +++ b/src/LambdaCube/Compiler/Parser.hs @@ -71,7 +71,7 @@ instance Show LCParseError where show = \case MultiplePatternVars xs -> unlines $ "multiple pattern vars:": concat [(sName (head ns) ++ " is defined at"): map showSI ns | ns <- xs] - OperatorMismatch op op' -> "Operator precedences don't match:\n" ++ show (getFixity op) ++ " at " ++ showSI op ++ "\n" ++ show (getFixity op') ++ " at " ++ showSI op' + OperatorMismatch op op' -> "Operator precedences don't match:\n" ++ show (fromJust $ getFixity_ op) ++ " at " ++ showSI op ++ "\n" ++ show (fromJust $ getFixity_ op') ++ " at " ++ showSI op' UndefinedConstructor n -> "Constructor " ++ show n ++ " is not defined at " ++ showSI n ParseError p -> show p @@ -105,7 +105,7 @@ instance Monoid DesugarInfo where addFixity :: BodyParser SIName -> BodyParser SIName addFixity p = f <$> asks (fixityMap . desugarInfo) <*> p where - f fm sn@(SIName_ si _ n) = SIName_ si (Map.lookup n fm) n + f fm sn@(SIName_ si _ n) = SIName_ si (Just $ fromMaybe (Fixity InfixL 9) $ Map.lookup n fm) n addConsInfo p = join $ f <$> asks (consMap . desugarInfo) <*> p where @@ -278,7 +278,7 @@ calculatePrecs = go where waitOp lsec e acc [] = calcPrec' e acc waitOp lsec e acc _ = error "impossible @ Parser 488" - calcPrec' e = postponedCheck id . calcPrec (\op x y -> SGlobal op `SAppV` x `SAppV` y) getFixity e . reverse + calcPrec' e = postponedCheck id . calcPrec (\op x y -> SGlobal op `SAppV` x `SAppV` y) (fromJust . getFixity_) e . reverse generator, letdecl, boolExpression :: BodyParser (SExp -> ErrorFinder SExp) generator = do @@ -337,7 +337,7 @@ mkPVar s = PVarSimp s concatParPats ps = ParPat $ concat [p | ParPat p <- ps] -litP = flip ViewPatSimp cTrue . SAppV (SBuiltin "==") +litP = flip ViewPatSimp cTrue . SAppV (SGlobal $ SIName_ mempty (Just $ Fixity Infix 4) "==") patlist = commaSep $ setR parsePatAnn @@ -357,7 +357,7 @@ mkTup ps = foldr cHCons cHNil ps patType p (Wildcard SType) = p patType p t = PatTypeSimp p t -calculatePatPrecs e xs = postponedCheck fst $ calcPrec (\op x y -> PConSimp op [x, y]) (getFixity . fst) e xs +calculatePatPrecs e xs = postponedCheck fst $ calcPrec (\op x y -> PConSimp op [x, y]) (fromJust . getFixity_ . fst) e xs longPattern = setR parsePatAnn <&> (reverse . getPVars &&& id) diff --git a/src/LambdaCube/Compiler/Patterns.hs b/src/LambdaCube/Compiler/Patterns.hs index 00626d2e..06036f44 100644 --- a/src/LambdaCube/Compiler/Patterns.hs +++ b/src/LambdaCube/Compiler/Patterns.hs @@ -54,9 +54,9 @@ pattern ParPat ps <- ParPat_ _ ps where ParPat ps = ParPat_ (foldMap sourceInfo ps) ps instance PShow (Pat_ a) where - pShowPrec _ = showDoc_ . patDoc + pShow = patDoc instance PShow (ParPat_ a) where - pShowPrec _ = showDoc_ . parPatDoc + pShow = parPatDoc pattern PWildcard si = ParPat_ si [] diff --git a/src/LambdaCube/Compiler/Pretty.hs b/src/LambdaCube/Compiler/Pretty.hs index e7c1216f..e94f6e41 100644 --- a/src/LambdaCube/Compiler/Pretty.hs +++ b/src/LambdaCube/Compiler/Pretty.hs @@ -4,98 +4,74 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DeriveFoldable #-} module LambdaCube.Compiler.Pretty ( module LambdaCube.Compiler.Pretty - , Doc - , (<+>), (), (<$$>) - , hsep, hcat, vcat --- , punctuate - , tupled, braces, parens - , text - , nest ) where -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Map (Map) -import qualified Data.Map as Map -import Control.Monad.Except +import Data.Monoid +import Data.String +--import qualified Data.Set as Set +--import qualified Data.Map as Map import Control.Monad.Reader import Control.Monad.State import Control.Arrow hiding ((<+>)) -import Debug.Trace +--import Debug.Trace -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) +import qualified Text.PrettyPrint.ANSI.Leijen as P import LambdaCube.Compiler.Utils +type Doc = NDoc +hsep [] = mempty +hsep xs = foldr1 (<+>) xs +vcat [] = mempty +vcat xs = foldr1 (<$$>) xs +text = DAtom + -------------------------------------------------------------------------------- class PShow a where - pShowPrec :: Int -> a -> Doc + pShow :: a -> NDoc -pShow = pShowPrec (-2) ppShow = show . pShow -ppShow' = show - --------------------------------------------------------------------------------- - -pParens p x - | p = tupled [x] - | otherwise = x - -pOp i j k sep p a b = pParens (p >= i) $ pShowPrec j a <+> sep <+> pShowPrec k b -pOp' i j k sep p a b = pParens (p >= i) $ pShowPrec j a sep <+> pShowPrec k b - -pInfixl i = pOp i (i-1) i -pInfixr i = pOp i i (i-1) -pInfixr' i = pOp' i i (i-1) -pInfix i = pOp i i i - -pTyApp = pInfixl 10 "@" -pApps p x [] = pShowPrec p x -pApps p x xs = pParens (p > 9) $ hsep $ pShowPrec 9 x: map (pShowPrec 10) xs -pApp p a b = pApps p a [b] - -showRecord = braces . hsep . punctuate (pShow ',') . map (\(a, b) -> pShow a <> ":" <+> pShow b) - -------------------------------------------------------------------------------- instance PShow Bool where - pShowPrec p b = if b then "True" else "False" + pShow b = if b then "True" else "False" instance (PShow a, PShow b) => PShow (a, b) where - pShowPrec p (a, b) = tupled [pShow a, pShow b] + pShow (a, b) = tupled [pShow a, pShow b] instance (PShow a, PShow b, PShow c) => PShow (a, b, c) where - pShowPrec p (a, b, c) = tupled [pShow a, pShow b, pShow c] + pShow (a, b, c) = tupled [pShow a, pShow b, pShow c] instance PShow a => PShow [a] where - pShowPrec p = brackets . sep . punctuate comma . map pShow +-- pShow = P.brackets . P.sep . P.punctuate P.comma . map pShow -- TODO instance PShow a => PShow (Maybe a) where - pShowPrec p = \case - Nothing -> "Nothing" - Just x -> "Just" <+> pShow x + pShow = maybe "Nothing" (("Just" `DApp`) . pShow) -instance PShow a => PShow (Set a) where - pShowPrec p = pShowPrec p . Set.toList +--instance PShow a => PShow (Set a) where +-- pShow = pShow . Set.toList -instance (PShow s, PShow a) => PShow (Map s a) where - pShowPrec p = braces . vcat . map (\(k, t) -> pShow k <> colon <+> pShow t) . Map.toList +--instance (PShow s, PShow a) => PShow (Map s a) where +-- pShow = braces . vcat . map (\(k, t) -> pShow k <> P.colon <+> pShow t) . Map.toList instance (PShow a, PShow b) => PShow (Either a b) where - pShowPrec p = either (("Left" <+>) . pShow) (("Right" <+>) . pShow) + pShow = either (("Left" `DApp`) . pShow) (("Right" `DApp`) . pShow) -instance PShow Doc where - pShowPrec p x = x +instance PShow NDoc where + pShow x = x -instance PShow Int where pShowPrec _ = int -instance PShow Integer where pShowPrec _ = integer -instance PShow Double where pShowPrec _ = double -instance PShow Char where pShowPrec _ = char -instance PShow () where pShowPrec _ _ = "()" +instance PShow Int where pShow = fromString . show +instance PShow Integer where pShow = fromString . show +instance PShow Double where pShow = fromString . show +instance PShow Char where pShow = fromString . show +instance PShow () where pShow _ = "()" --------------------------------------------------------------------------------- -- TODO: remove @@ -118,7 +94,7 @@ data FixityDir = Infix | InfixL | InfixR data Fixity = Fixity !FixityDir !Int deriving (Eq, Show) --------------------------------------------------------------------------------- pretty print +-------------------------------------------------------------------------------- doc data type data NDoc = DAtom String @@ -128,15 +104,40 @@ data NDoc | DVar Int | DFreshName Bool{-False: dummy-} NDoc | DUp Int NDoc - | DColor Color NDoc + | DDoc (DocOp NDoc) --Color Color NDoc -- add wl-pprint combinators as necessary here deriving (Eq) +data DocOp a + = DOColor Color a + | DOHSep a a + | DOHCat a a + | DOSoftSep a a + | DOVCat a a + | DONest Int a + | DOTupled [a] + deriving (Eq, Functor, Foldable, Traversable) + +pattern DColor c a = DDoc (DOColor c a) + +a <+> b = DDoc $ DOHSep a b +a b = DDoc $ DOSoftSep a b +a <$$> b = DDoc $ DOVCat a b +nest n = DDoc . DONest n +tupled = DDoc . DOTupled + +instance Monoid NDoc where + mempty = fromString "" + a `mappend` b = DDoc $ DOHCat a b + pattern DParen x = DPar "(" x ")" pattern DBrace x = DPar "{" x "}" pattern DArr x y = DOp (Fixity InfixR (-1)) x "->" y pattern DAnn x y = DOp (Fixity InfixR (-3)) x ":" y +braces = DBrace +parens = DParen + data Color = Green | Blue | Underlined deriving (Eq) @@ -148,7 +149,7 @@ strip = \case DColor _ x -> strip x DUp _ x -> strip x DFreshName _ x -> strip x - x -> x + x -> x simple x = case strip x of DAtom{} -> True @@ -156,12 +157,12 @@ simple x = case strip x of DPar{} -> True _ -> False -renderDocX :: NDoc -> Doc +renderDocX :: NDoc -> P.Doc renderDocX = render . addPar (-10) . flip runReader [] . flip evalStateT (flip (:) <$> iterate ('\'':) "" <*> ['a'..'z']) . showVars where showVars x = case x of DAtom s -> pure x - DColor c x -> DColor c <$> showVars x + DDoc d -> DDoc <$> traverse showVars d DPar l x r -> DPar l <$> showVars x <*> pure r DOp pr x s y -> DOp pr <$> showVars x <*> pure s <*> showVars y DVar i -> asks $ DAtom . lookupVarName i @@ -180,6 +181,7 @@ renderDocX = render . addPar (-10) . flip runReader [] . flip evalStateT (flip ( DPar l x r -> DPar l (addPar (-20) x) r DOp pr' x s y -> paren $ DOp pr' (addPar (precL pr') x) s (addPar (precR pr') y) DLam lam vs arr e -> paren $ DLam lam (addPar 10 <$> vs) arr (addPar (-10) e) + DDoc d -> DDoc $ addPar (-10) <$> d where paren d | protect x = DParen d @@ -199,46 +201,57 @@ renderDocX = render . addPar (-10) . flip runReader [] . flip evalStateT (flip ( precR (Fixity InfixR i) = i render x = case x of - DColor c x -> colorFun c $ render x - DAtom s -> text s - DPar l x r -> text l <> render x <> text r + DDoc d -> case render <$> d of + DOColor c x -> colorFun c x + DOHSep a b -> a P.<+> b + DOHCat a b -> a <> b + DOSoftSep a b -> a P. b + DOVCat a b -> a P.<$$> b + DONest n a -> P.nest n a + DOTupled a -> P.tupled a + DAtom s -> P.text s + DPar l x r -> P.text l <> render x <> P.text r DOp _ x s y -> case s of - "" -> render x <+> render y - _ | simple x && simple y && s /= "," -> render x <> text s <> render y - | otherwise -> (render x <++> s) <+> render y - DLam lam vs arr e -> text lam <> hsep (render <$> vs) <+> text arr <+> render e + "" -> render x P.<> render y + " " -> render x P.<+> render y + _ | simple x && simple y && s /= "," -> render x <> P.text s <> render y + | otherwise -> (render x <++> s) P.<+> render y + DLam lam vs arr e -> P.text lam <> P.hsep (render <$> vs) P.<+> P.text arr P.<+> render e where - x <++> "," = x <> text "," - x <++> s = x <+> text s + x <++> "," = x <> P.text "," + x <++> s = x P.<+> P.text s colorFun = \case - Green -> dullgreen - Blue -> dullblue - Underlined -> underline + Green -> P.dullgreen + Blue -> P.dullblue + Underlined -> P.underline -showDoc :: NDoc -> String -showDoc = show . renderDocX +instance Show NDoc where + show = show . renderDocX -showDoc_ :: NDoc -> Doc +showDoc_ :: NDoc -> P.Doc showDoc_ = renderDocX shVar = DVar -shLet i a b = shLam' (cpar . shLet' (inBlue' $ shVar i) $ DUp i a) (DUp i b) -shLet_ a b = DFreshName True $ shLam' (cpar . shLet' (shVar 0) $ DUp 0 a) b +shLet i a b = shLam' (shLet' (inBlue' $ shVar i) $ DUp i a) (DUp i b) +shLet_ a b = DFreshName True $ shLam' (shLet' (shVar 0) $ DUp 0 a) b ----------------------------------------- +instance IsString NDoc where + fromString = DAtom + shAtom = DAtom -shTuple [] = DAtom "()" +shTuple [] = "()" shTuple [x] = DParen $ DParen x shTuple xs = DParen $ foldr1 (\x y -> DOp (Fixity InfixR (-20)) x "," y) xs -shAnn _ True x y | strip y == DAtom "Type" = x +shAnn _ True x y | strip y == "Type" = x shAnn s _ x y = DOp (Fixity InfixR (-3)) x s y -shApp _ x y = DOp (Fixity InfixL 10) x "" y +pattern DApp x y = DOp (Fixity InfixL 10) x " " y shArr = DArr @@ -252,7 +265,4 @@ getFN a = (0, a) shLam' x (getFN -> (i, DLam "\\" xs "->" y)) = iterateN i (DFreshName True) $ DLam "\\" (iterateN i (DUp 0) x: xs) "->" y shLam' x y = DLam "\\" [x] "->" y -cpar s | simple s = s -cpar s = DParen s - diff --git a/testdata/language-features/basic-values/case05.out b/testdata/language-features/basic-values/case05.out index 85e6bced..f4f03c51 100644 --- a/testdata/language-features/basic-values/case05.out +++ b/testdata/language-features/basic-values/case05.out @@ -11,5 +11,5 @@ Uncovered pattern(s) at testdata/language-features/basic-values/case05.lc:1:16: value x = case x of ^ Missing case(s): - _ | False <- == (fromInt 1) a_ + _ | False <- fromInt 1 == a_ diff --git a/testdata/language-features/basic-values/def03.out b/testdata/language-features/basic-values/def03.out index ba33b297..3161d04a 100644 --- a/testdata/language-features/basic-values/def03.out +++ b/testdata/language-features/basic-values/def03.out @@ -11,5 +11,5 @@ Uncovered pattern(s) at testdata/language-features/basic-values/def03.lc:1:1: fun 1 = '1' fun 2 = '2' Missing case(s): - _ | False <- == (fromInt 1) a_, False <- == (fromInt 2) a_ + _ | False <- fromInt 1 == a_, False <- fromInt 2 == a_ diff --git a/testdata/language-features/basic-values/def07.reject.out b/testdata/language-features/basic-values/def07.reject.out index 0ce641f7..e54d61ca 100644 --- a/testdata/language-features/basic-values/def07.reject.out +++ b/testdata/language-features/basic-values/def07.reject.out @@ -28,11 +28,11 @@ Uncovered pattern(s) at testdata/language-features/basic-values/def07.reject.lc: fun 1 = '1' fun 2 = '2' Missing case(s): - _ | False <- == (fromInt 1) a_, False <- == (fromInt 2) a_ + _ | False <- fromInt 1 == a_, False <- fromInt 2 == a_ Uncovered pattern(s) at testdata/language-features/basic-values/def07.reject.lc:3:1: fun2 1 _ = '1' ^^^^ Missing case(s): - _ _ | False <- == (fromInt 1) b_ + _ _ | False <- fromInt 1 == b_ -- cgit v1.2.3