github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-03 00:16:52 +03:00
Code Issues Projects Releases Wiki Activity

Revert "Revert "Define an abstraction over the Term introduction/elimination forms.""

Browse Source 
This reverts commit 7ab610a24d.
This commit is contained in:
Rob Rix 2019-10-18 21:37:31 -04:00
parent 80040853b7
commit 46c4c788c9
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/Data/Term.hs
View File

@ -1,9 +1,6 @@
{-# LANGUAGE FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-} {-# LANGUAGE FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
module Data.Term module Data.Term
( Term(..) ( Term(..)
, termIn
, termAnnotation
, termOut
, injectTerm , injectTerm
, projectTerm , projectTerm
, guardTerm , guardTerm
@ -12,6 +9,8 @@ module Data.Term
, hoistTerm , hoistTerm
, hoistTermF , hoistTermF
, Annotated (..) , Annotated (..)
-- * Abstract term interfaces
, IsTerm(..)
) where ) where
import Prologue import Prologue
@ -26,12 +25,6 @@ import Text.Show
-- | A Term with an abstract syntax tree and an annotation. -- | A Term with an abstract syntax tree and an annotation.
newtype Term syntax ann = Term { unTerm :: TermF syntax ann (Term syntax ann) } newtype Term syntax ann = Term { unTerm :: TermF syntax ann (Term syntax ann) }
termAnnotation :: Term syntax ann -> ann
termAnnotation = termFAnnotation . unTerm
termOut :: Term syntax ann -> syntax (Term syntax ann)
termOut = termFOut . unTerm
projectTerm :: forall f syntax ann . (f :< syntax) => Term (Sum syntax) ann -> Maybe (f (Term (Sum syntax) ann)) projectTerm :: forall f syntax ann . (f :< syntax) => Term (Sum syntax) ann -> Maybe (f (Term (Sum syntax) ann))
projectTerm = Sum.project . termOut projectTerm = Sum.project . termOut
@ -72,10 +65,6 @@ termSize :: (Foldable f, Functor f) => Term f annotation -> Int
termSize = cata size where termSize = cata size where
size (In _ syntax) = 1 + sum syntax size (In _ syntax) = 1 + sum syntax
-- | Build a Term from its annotation and syntax.
termIn :: ann -> syntax (Term syntax ann) -> Term syntax ann
termIn = (Term .) . In
injectTerm :: (f :< syntax) => ann -> f (Term (Sum syntax) ann) -> Term (Sum syntax) ann injectTerm :: (f :< syntax) => ann -> f (Term (Sum syntax) ann) -> Term (Sum syntax) ann
injectTerm a = termIn a . Sum.inject injectTerm a = termIn a . Sum.inject
@ -171,3 +160,22 @@ instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSONFields (TermF f a
instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSON (TermF f a b) where instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSON (TermF f a b) where
toJSON = object . toJSONFields toJSON = object . toJSONFields
toEncoding = pairs . mconcat . toJSONFields toEncoding = pairs . mconcat . toJSONFields
class IsTerm term where
type Syntax term :: * -> *
termAnnotation :: term ann -> ann
termOut :: term ann -> Syntax term (term ann)
-- | Build a Term from its annotation and syntax.
termIn :: ann -> Syntax term (term ann) -> term ann
instance IsTerm (Term syntax) where
type Syntax (Term syntax) = syntax
termAnnotation = termFAnnotation . unTerm
termOut = termFOut . unTerm
termIn = fmap Term . In