Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fix parsing of (~) #428

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Fix parsing of (~) #428

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
d1209cb
add failing test
yairchu Nov 29, 2018
35c9ad1
Fix parsing of (~)
yairchu Feb 2, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions src/Language/Haskell/Exts/ExactPrint.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -248,6 +248,9 @@ instance ExactP SpecialCon where
FunCon l -> case srcInfoPoints l of
[_,b,_] -> printStringAt (pos b) "->"
_ -> errorEP "ExactP: SpecialCon is given wrong number of srcInfoPoints"
TyEqCon l -> case srcInfoPoints l of
[_,b,_] -> printStringAt (pos b) "~"
_ -> errorEP "ExactP: SpecialCon is given wrong number of srcInfoPoints"
TupleCon l b n -> printPoints l $
case b of
Unboxed -> "(#": replicate (n-1) "," ++ ["#)"]
Expand All @@ -265,6 +268,7 @@ isSymbolQName (UnQual _ n) = isSymbolName n
isSymbolQName (Qual _ _ n) = isSymbolName n
isSymbolQName (Special _ Cons{}) = True
isSymbolQName (Special _ FunCon{}) = True
isSymbolQName (Special _ TyEqCon{}) = True
isSymbolQName _ = False

instance ExactP QName where
Expand Down
1 change: 1 addition & 0 deletions src/Language/Haskell/Exts/InternalParser.ly
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1037,6 +1037,7 @@ the (# and #) lexemes. Kinds will be handled at the kind rule.
> : otycon_(ostar) { $1 }
> | '(' ')' { unit_tycon_name ($1 <^^> $2 <** [$1,$2]) }
> | '(' '->' ')' { fun_tycon_name ($1 <^^> $3 <** [$1,$2,$3]) }
> | '(' '~' ')' { tyeq_tycon_name ($1 <^^> $3 <** [$1,$2,$3]) }
> | '[' ']' { list_tycon_name ($1 <^^> $2 <** [$1,$2]) }
> | '(' commas ')' { tuple_tycon_name ($1 <^^> $3 <** ($1:reverse $2 ++ [$3])) Boxed (length $2) }
> | '(#' '#)' { unboxed_singleton_tycon_name ($1 <^^> $2 <** [$1,$2]) }
Expand Down
2 changes: 2 additions & 0 deletions src/Language/Haskell/Exts/Pretty.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1317,6 +1317,7 @@ instance Pretty (SpecialCon l) where
pretty (UnitCon {}) = text "()"
pretty (ListCon {}) = text "[]"
pretty (FunCon {}) = text "->"
pretty (TyEqCon {}) = text "~"
pretty (TupleCon _ b n) = listFun $ foldr (<>) empty (replicate (n-1) comma)
where listFun = if b == Unboxed then hashParens else parens
pretty (Cons {}) = text ":"
Expand All @@ -1332,6 +1333,7 @@ isSymbolQName (UnQual _ n) = isSymbolName n
isSymbolQName (Qual _ _ n) = isSymbolName n
isSymbolQName (Special _ (Cons {})) = True
isSymbolQName (Special _ (FunCon {})) = True
isSymbolQName (Special _ (TyEqCon {})) = True
isSymbolQName _ = False

--getSpecialName :: QName l -> Maybe (SpecialCon l)
Expand Down
7 changes: 5 additions & 2 deletions src/Language/Haskell/Exts/Syntax.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -106,7 +106,7 @@ module Language.Haskell.Exts.Syntax (
javascript_name, capi_name, forall_name, family_name, role_name, hole_name,
stock_name, anyclass_name, via_name,
-- ** Type constructors
unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name, unboxed_singleton_tycon_name,
unit_tycon_name, fun_tycon_name, tyeq_tycon_name, list_tycon_name, tuple_tycon_name, unboxed_singleton_tycon_name,
unit_tycon, fun_tycon, list_tycon, tuple_tycon, unboxed_singleton_tycon,

-- * Source coordinates
Expand Down Expand Up @@ -136,6 +136,7 @@ data SpecialCon l
= UnitCon l -- ^ unit type and data constructor @()@
| ListCon l -- ^ list type and data constructor @[]@
| FunCon l -- ^ function type constructor @->@
| TyEqCon l -- ^ type equality constructor @~@
| TupleCon l Boxed Int -- ^ /n/-ary tuple type and data
-- constructors @(,)@ etc, possibly boxed @(\#,\#)@
| Cons l -- ^ list data constructor @(:)@
Expand Down Expand Up @@ -1074,10 +1075,11 @@ stock_name l = Ident l "stock"
anyclass_name l = Ident l "anyclass"
via_name l = Ident l "via"

unit_tycon_name, fun_tycon_name, list_tycon_name, unboxed_singleton_tycon_name :: l -> QName l
unit_tycon_name, fun_tycon_name, list_tycon_name, tyeq_tycon_name, unboxed_singleton_tycon_name :: l -> QName l
unit_tycon_name l = unit_con_name l
fun_tycon_name l = Special l (FunCon l)
list_tycon_name l = Special l (ListCon l)
tyeq_tycon_name l = Special l (TyEqCon l)
unboxed_singleton_tycon_name l = Special l (UnboxedSingleCon l)

tuple_tycon_name :: l -> Boxed -> Int -> QName l
Expand Down Expand Up @@ -1120,6 +1122,7 @@ instance Annotated SpecialCon where
UnitCon l -> l
ListCon l -> l
FunCon l -> l
TyEqCon l -> l
TupleCon l _ _ -> l
Cons l -> l
UnboxedSingleCon l -> l
Expand Down
4 changes: 4 additions & 0 deletions tests/examples/EqualityConstraints3.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
{-# LANGUAGE GADTs, FlexibleContexts #-}

one :: (~) a Int => a
one = 1
1 change: 1 addition & 0 deletions tests/examples/EqualityConstraints3.hs.exactprinter.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Match
190 changes: 190 additions & 0 deletions tests/examples/EqualityConstraints3.hs.parser.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,190 @@
ParseOk
( Module
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 1 1 5 1
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 1 1 1 1
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 1 3 1
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 1 3 1
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 1 3 1
, SrcSpan "tests/examples/EqualityConstraints3.hs" 4 1 4 1
, SrcSpan "tests/examples/EqualityConstraints3.hs" 5 1 5 1
, SrcSpan "tests/examples/EqualityConstraints3.hs" 5 1 5 1
]
}
Nothing
[ LanguagePragma
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 1 1 1 41
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 1 1 1 13
, SrcSpan "tests/examples/EqualityConstraints3.hs" 1 19 1 20
, SrcSpan "tests/examples/EqualityConstraints3.hs" 1 38 1 41
]
}
[ Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 1 14 1 19
, srcInfoPoints = []
}
"GADTs"
, Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 1 21 1 37
, srcInfoPoints = []
}
"FlexibleContexts"
]
]
[]
[ TypeSig
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 1 3 22
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 3 5 3 7 ]
}
[ Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 1 3 4
, srcInfoPoints = []
}
"one"
]
(TyForall
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 22
, srcInfoPoints = []
}
Nothing
(Just
(CxSingle
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 20
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 3 18 3 20 ]
}
(ClassA
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 20
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 3 18 3 20 ]
}
(Special
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 11
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 9
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 9 3 10
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 10 3 11
]
}
(TyEqCon
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 11
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 3 8 3 9
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 9 3 10
, SrcSpan "tests/examples/EqualityConstraints3.hs" 3 10 3 11
]
}))
[ TyVar
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 12 3 13
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 12 3 13
, srcInfoPoints = []
}
"a")
, TyCon
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 14 3 17
, srcInfoPoints = []
}
(UnQual
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 14 3 17
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 14 3 17
, srcInfoPoints = []
}
"Int"))
])))
(TyVar
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 21 3 22
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 3 21 3 22
, srcInfoPoints = []
}
"a")))
, PatBind
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 4 1 4 8
, srcInfoPoints = []
}
(PVar
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 4 1 4 4
, srcInfoPoints = []
}
(Ident
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 4 1 4 4
, srcInfoPoints = []
}
"one"))
(UnGuardedRhs
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 4 5 4 8
, srcInfoPoints =
[ SrcSpan "tests/examples/EqualityConstraints3.hs" 4 5 4 6 ]
}
(Lit
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 4 7 4 8
, srcInfoPoints = []
}
(Int
SrcSpanInfo
{ srcInfoSpan =
SrcSpan "tests/examples/EqualityConstraints3.hs" 4 7 4 8
, srcInfoPoints = []
}
1
"1")))
Nothing
]
, []
)
1 change: 1 addition & 0 deletions tests/examples/EqualityConstraints3.hs.prettyparser.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Match
4 changes: 4 additions & 0 deletions tests/examples/EqualityConstraints3.hs.prettyprinter.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
{-# LANGUAGE GADTs, FlexibleContexts #-}

one :: (~) a Int => a
one = 1