github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-25 02:58:36 +03:00
Code Issues Projects Releases Wiki Activity

Rename Elem to Find.

Browse Source
This commit is contained in:
Rob Rix 2019-10-08 15:34:33 -04:00
parent da890fa747
commit da227888ce
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
semantic-tags/src/AST/Element.hs
View File

@ -12,8 +12,8 @@ class Element sub sup where
-- | Project one element out of a sum type. -- | Project one element out of a sum type.
prj :: sup a -> Maybe (sub a) prj :: sup a -> Maybe (sub a)
instance (Element' elem sub sup, elem ~ Elem sub sup) => Element sub sup where instance (Element' side sub sup, side ~ Find sub sup) => Element sub sup where
prj = prj' @elem prj = prj' @side
pattern Prj :: Element sub sup => sub a -> sup a pattern Prj :: Element sub sup => sub a -> sup a
@ -21,21 +21,21 @@ pattern Prj sub <- (prj -> Just sub)
data Side = None | Here | L | R data Side = None | Here | L | R
type family Elem sub sup :: Side where type family Find sub sup :: Side where
Elem t t = 'Here Find t t = 'Here
Elem t (l :+: r) = Elem' 'L t l <> Elem' 'R t r Find t (l :+: r) = Find' 'L t l <> Find' 'R t r
Elem _ _ = 'None Find _ _ = 'None
type family Elem' (side :: Side) sub sup :: Side where type family Find' (side :: Side) sub sup :: Side where
Elem' s t t = s Find' s t t = s
Elem' s t (l :+: r) = Elem' s t l <> Elem' s t r Find' s t (l :+: r) = Find' s t l <> Find' s t r
Elem' _ _ _ = 'None Find' _ _ _ = 'None
type family (a :: Side) <> (b :: Side) :: Side where type family (a :: Side) <> (b :: Side) :: Side where
'None <> b = b 'None <> b = b
a <> _ = a a <> _ = a
class Element' (elem :: Side) sub sup where class Element' (side :: Side) sub sup where
prj' :: sup a -> Maybe (sub a) prj' :: sup a -> Maybe (sub a)
instance {-# OVERLAPPABLE #-} instance {-# OVERLAPPABLE #-}