Skip to content

Commit

Permalink
More informative, nicer error message for fixity errors.
Browse files Browse the repository at this point in the history
Fixes #590.
  • Loading branch information
Brian Huffman committed Jun 21, 2019
1 parent 8001e5d commit f0e527a
Show file tree
Hide file tree
Showing 3 changed files with 18 additions and 9 deletions.
15 changes: 8 additions & 7 deletions src/Cryptol/ModuleSystem/Renamer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ data RenamerError
-- ^ When a type is missing from the naming environment, but one or more
-- values exist with the same name.

| FixityError (Located Name) (Located Name) NameDisp
| FixityError (Located Name) Fixity (Located Name) Fixity NameDisp
-- ^ When the fixity of two operators conflict

| InvalidConstraint (Type PName) NameDisp
Expand Down Expand Up @@ -126,11 +126,12 @@ instance PP RenamerError where
4 (fsep [ text "Expected a type named", quotes (pp (thing lqn))
, text "but found a value instead" ])

FixityError o1 o2 disp -> fixNameDisp disp $
hang (text "[error]")
4 (fsep [ text "The fixities of", pp o1, text "and", pp o2
, text "are not compatible. "
, text "You may use explicit parenthesis to disambiguate" ])
FixityError o1 f1 o2 f2 disp -> fixNameDisp disp $
hang (text "[error] at" <+> pp (srcRange o1) <+> text "and" <+> pp (srcRange o2))
4 (fsep [ text "The fixities of", pp (thing o1), parens (pp f1)
, text "and", pp (thing o2), parens (pp f2)
, text "are not compatible."
, text "You may use explicit parentheses to disambiguate." ])

InvalidConstraint ty disp -> fixNameDisp disp $
hang (text "[error]" <+> maybe empty (\r -> text "at" <+> pp r) (getLoc ty))
Expand Down Expand Up @@ -867,7 +868,7 @@ mkEInfix e@(EInfix x o1 f1 y) op@(o2,f2) z =
FCRight -> do r <- mkEInfix y op z
return (EInfix x o1 f1 r)

FCError -> do record (FixityError o1 o2)
FCError -> do record (FixityError o1 f1 o2 f2)
return (EInfix e o2 f2 z)

mkEInfix (ELocated e' _) op z =
Expand Down
6 changes: 5 additions & 1 deletion src/Cryptol/Parser/Fixity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ module Cryptol.Parser.Fixity
, compareFixity
) where

import Cryptol.Utils.PP (Assoc(..))
import Cryptol.Utils.PP

import GHC.Generics (Generic)
import Control.DeepSeq
Expand All @@ -44,3 +44,7 @@ compareFixity (Fixity a1 p1) (Fixity a2 p2) =
-- | The fixity used when none is provided.
defaultFixity :: Fixity
defaultFixity = Fixity LeftAssoc 100

instance PP Fixity where
ppPrec _ (Fixity assoc level) =
text "precedence" <+> int level <.> comma <+> pp assoc
6 changes: 5 additions & 1 deletion src/Cryptol/Utils/PP.hs
Original file line number Diff line number Diff line change
Expand Up @@ -177,7 +177,7 @@ ppInfix lp isInfix expr =



-- | Display a numeric values as an ordinar (e.g., 2nd)
-- | Display a numeric value as an ordinal (e.g., 2nd)
ordinal :: (Integral a, Show a, Eq a) => a -> Doc
ordinal x = text (show x) <.> text (ordSuffix x)

Expand Down Expand Up @@ -293,3 +293,7 @@ instance PP Ident where
instance PP ModName where
ppPrec _ = text . T.unpack . modNameToText

instance PP Assoc where
ppPrec _ LeftAssoc = text "left-associative"
ppPrec _ RightAssoc = text "right-associative"
ppPrec _ NonAssoc = text "non-associative"

0 comments on commit f0e527a

Please sign in to comment.