This commit is contained in:
crumbtoo
2024-03-03 14:52:27 -07:00
parent 1f3dd80127
commit 1b1185648a
2 changed files with 46 additions and 2 deletions

View File

@@ -3,7 +3,7 @@ module Rlp.AltSyntax
(
-- * AST
Program(..), Decl(..), ExprF(..), Pat(..)
, RlpExprF, RlpExpr
, RlpExprF, RlpExpr, Binding(..)
, DataCon(..), Type(..)
, Core.Name, PsName
@@ -16,6 +16,7 @@ module Rlp.AltSyntax
import Data.Functor.Sum
import Control.Comonad.Cofree
import Data.Fix
import Data.Function (fix)
import Text.Show.Deriving
import Data.Text qualified as T
@@ -44,6 +45,11 @@ data Type b = VarT b
deriving Show
data ExprF b a = InfixEF b a a
| LetEF Core.Rec [Binding b a] a
data Binding b a = FunB b [Pat b] a
| VarB (Pat b) a
deriving Show
-- type Expr b = Cofree (ExprF b)
@@ -54,6 +60,7 @@ type RlpExpr b = Fix (RlpExprF b)
data Pat b = VarP b
deriving Show
deriveShow1 ''Binding
deriveShow1 ''ExprF
deriving instance (Show b, Show a) => Show (ExprF b a)
@@ -76,10 +83,28 @@ instance (Pretty b, Pretty a) => Pretty (Decl b a) where
prettyPrec = prettyPrec1
instance (Pretty b) => Pretty1 (Decl b) where
liftPrettyPrec pr p (FunD f as e) = maybeParens (p>0) $
liftPrettyPrec pr _ (FunD f as e) =
hsep [ ttext f, hsep (prettyPrec appPrec1 <$> as)
, "=", pr 0 e ]
liftPrettyPrec _ _ (DataD f as []) =
hsep [ "data", ttext f, hsep (pretty <$> as) ]
liftPrettyPrec _ _ (DataD f as ds) =
hsep [ "data", ttext f, hsep (pretty <$> as), cons ]
where
cons = vcat $ zipWith (<+>) delims (pretty <$> ds)
delims = "=" : repeat "|"
instance (Pretty b) => Pretty (DataCon b) where
pretty (DataCon n as) = ttext n <+> hsep (prettyPrec appPrec1 <$> as)
instance (Pretty b) => Pretty (Type b) where
prettyPrec _ (VarT n) = ttext n
prettyPrec _ (ConT n) = ttext n
prettyPrec p (AppT f x) = maybeParens (p>appPrec) $
prettyPrec appPrec f <+> prettyPrec appPrec1 x
instance (Pretty b) => Pretty (Pat b) where
prettyPrec p (VarP b) = prettyPrec p b