msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

ttg boilerplate

Browse Source
This commit is contained in:
crumbtoo
2024-01-30 13:01:01 -07:00
parent fbea3d6f3d
commit 6a41e123ea
3 changed files with 113 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/Rlp/Parse/Types.hs
View File

@@ -54,6 +54,22 @@ data RlpcPs
type instance XRec RlpcPs f = Located (f RlpcPs)
type instance IdP RlpcPs = PsName
type instance XFunD RlpcPs = ()
type instance XDataD RlpcPs = ()
type instance XInfixD RlpcPs = ()
type instance XTySigD RlpcPs = ()
type instance XXDeclD RlpcPs = ()
type instance XLetE RlpcPs = ()
type instance XVarE RlpcPs = ()
type instance XLamE RlpcPs = ()
type instance XCaseE RlpcPs = ()
type instance XIfE RlpcPs = ()
type instance XAppE RlpcPs = ()
type instance XLitE RlpcPs = ()
type instance XParE RlpcPs = ()
type instance XOAppE RlpcPs = ()
type PsName = Text
--------------------------------------------------------------------------------

113
src/Rlp/Syntax.hs
View File

@@ -16,8 +16,20 @@ module Rlp.Syntax
, ConAlt(..)
, Binding(..), Binding'
-- * Trees That Grow extensions
, UnXRec(..), MapXRec(..), XRec, IdP
-- * Trees That Grow boilerplate
-- ** Extension points
, IdP, XRec, UnXRec(..), MapXRec(..)
-- *** Decl
, XFunD, XTySigD, XInfixD, XDataD, XXDeclD
-- *** RlpExpr
, XLetE, XVarE, XLamE, XCaseE, XIfE, XAppE, XLitE
, XParE, XOAppE
-- ** Pattern synonyms
-- *** Decl
, pattern FunD, pattern TySigD, pattern InfixD, pattern DataD
-- *** RlpExpr
, pattern LetE, pattern VarE, pattern LamE, pattern CaseE, pattern IfE
, pattern AppE, pattern LitE, pattern ParE, pattern OAppE
)
where
----------------------------------------------------------------------------------
@@ -61,12 +73,39 @@ type RlpType' p = XRec p RlpType
deriving instance (PhaseShow p)
=> Show (RlpType p)
data Decl p = FunD (IdP p) [Pat' p] (RlpExpr' p) (Maybe (Where p))
| TySigD [IdP p] (RlpType' p)
| DataD (IdP p) [IdP p] [ConAlt p]
| InfixD Assoc Int (IdP p)
data Decl p = FunD' (XFunD p) (IdP p) [Pat' p] (RlpExpr' p) (Maybe (Where p))
| TySigD' (XTySigD p) [IdP p] (RlpType' p)
| DataD' (XDataD p) (IdP p) [IdP p] [ConAlt p]
| InfixD' (XInfixD p) Assoc Int (IdP p)
| XDeclD' !(XXDeclD p)
deriving instance (Show (IdP p), PhaseShow p) => Show (Decl p)
deriving instance
( Show (XFunD p), Show (XTySigD p)
, Show (XDataD p), Show (XInfixD p)
, Show (XXDeclD p)
, PhaseShow p
)
=> Show (Decl p)
type family XFunD p
type family XTySigD p
type family XDataD p
type family XInfixD p
type family XXDeclD p
pattern FunD :: (XFunD p ~ ())
=> (IdP p) -> [Pat' p] -> (RlpExpr' p) -> (Maybe (Where p))
-> Decl p
pattern TySigD :: (XTySigD p ~ ()) => [IdP p] -> (RlpType' p) -> Decl p
pattern DataD :: (XDataD p ~ ()) => (IdP p) -> [IdP p] -> [ConAlt p] -> Decl p
pattern InfixD :: (XInfixD p ~ ()) => Assoc -> Int -> (IdP p) -> Decl p
pattern XDeclD :: (XXDeclD p ~ ()) => Decl p
pattern FunD n as e wh = FunD' () n as e wh
pattern TySigD ns t = TySigD' () ns t
pattern DataD n as cs = DataD' () n as cs
pattern InfixD a p n = InfixD' () a p n
pattern XDeclD = XDeclD' ()
type Decl' p = XRec p Decl
@@ -79,17 +118,57 @@ data ConAlt p = ConAlt (IdP p) [RlpType' p]
deriving instance (Show (IdP p), Show (XRec p RlpType)) => Show (ConAlt p)
data RlpExpr p = LetE [Binding' p] (RlpExpr' p)
| VarE (IdP p)
| LamE [Pat p] (RlpExpr' p)
| CaseE (RlpExpr' p) [(Alt p, Where p)]
| IfE (RlpExpr' p) (RlpExpr' p) (RlpExpr' p)
| AppE (RlpExpr' p) (RlpExpr' p)
| LitE (Lit p)
| ParE (RlpExpr' p)
| OAppE (IdP p) (RlpExpr' p) (RlpExpr' p)
data RlpExpr p = LetE' (XLetE p) [Binding' p] (RlpExpr' p)
| VarE' (XVarE p) (IdP p)
| LamE' (XLamE p) [Pat p] (RlpExpr' p)
| CaseE' (XCaseE p) (RlpExpr' p) [(Alt p, Where p)]
| IfE' (XIfE p) (RlpExpr' p) (RlpExpr' p) (RlpExpr' p)
| AppE' (XAppE p) (RlpExpr' p) (RlpExpr' p)
| LitE' (XLitE p) (Lit p)
| ParE' (XParE p) (RlpExpr' p)
| OAppE' (XOAppE p) (IdP p) (RlpExpr' p) (RlpExpr' p)
| XRlpExprE' (XXRlpExprE p)
deriving instance (PhaseShow p) => Show (RlpExpr p)
type family XLetE p
type family XVarE p
type family XLamE p
type family XCaseE p
type family XIfE p
type family XAppE p
type family XLitE p
type family XParE p
type family XOAppE p
type family XXRlpExprE p
pattern LetE :: (XLetE p ~ ()) => [Binding' p] -> RlpExpr' p -> RlpExpr p
pattern VarE :: (XVarE p ~ ()) => IdP p -> RlpExpr p
pattern LamE :: (XLamE p ~ ()) => [Pat p] -> RlpExpr' p -> RlpExpr p
pattern CaseE :: (XCaseE p ~ ()) => RlpExpr' p -> [(Alt p, Where p)] -> RlpExpr p
pattern IfE :: (XIfE p ~ ()) => RlpExpr' p -> RlpExpr' p -> RlpExpr' p -> RlpExpr p
pattern AppE :: (XAppE p ~ ()) => RlpExpr' p -> RlpExpr' p -> RlpExpr p
pattern LitE :: (XLitE p ~ ()) => Lit p -> RlpExpr p
pattern ParE :: (XParE p ~ ()) => RlpExpr' p -> RlpExpr p
pattern OAppE :: (XOAppE p ~ ()) => IdP p -> RlpExpr' p -> RlpExpr' p -> RlpExpr p
pattern XRlpExprE :: (XXRlpExprE p ~ ()) => RlpExpr p
pattern LetE bs e = LetE' () bs e
pattern VarE n = VarE' () n
pattern LamE as e = LamE' () as e
pattern CaseE e as = CaseE' () e as
pattern IfE c a b = IfE' () c a b
pattern AppE f x = AppE' () f x
pattern LitE l = LitE' () l
pattern ParE e = ParE' () e
pattern OAppE n a b = OAppE' () n a b
pattern XRlpExprE = XRlpExprE' ()
deriving instance
( Show (XLetE p), Show (XVarE p), Show (XLamE p)
, Show (XCaseE p), Show (XIfE p), Show (XAppE p)
, Show (XLitE p), Show (XParE p), Show (XOAppE p)
, Show (XXRlpExprE p)
, PhaseShow p
) => Show (RlpExpr p)
type RlpExpr' p = XRec p RlpExpr