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

@@ -101,6 +101,14 @@ DataCon :: { DataCon PsName }
Type1 :: { Type PsName } Type1 :: { Type PsName }
: varname { VarT $ extractVarName $1 } : varname { VarT $ extractVarName $1 }
| Con { ConT $1 } | Con { ConT $1 }
| '(' Type ')' { $2 }
Type :: { Type PsName }
: AppT { $1 }
AppT :: { Type PsName }
: Type1 { $1 }
| AppT Type1 { AppT $1 $2 }
TyVars :: { [PsName] } TyVars :: { [PsName] }
: list0(varname) { $1 <&> view ( to extract : list0(varname) { $1 <&> view ( to extract
@@ -111,6 +119,14 @@ FunD :: { Decl PsName (RlpExpr PsName) }
Expr :: { RlpExpr PsName } Expr :: { RlpExpr PsName }
: AppE { $1 } : AppE { $1 }
| LetE { $1 }
LetE :: { RlpExpr PsName }
: let layout1(Binding) in Expr
{ Finr $ LetEF Core.NonRec $2 $4 }
Binding :: { Binding PsName (RlpExpr PsName) }
: Pat '=' Expr { VarB $1 $3 }
AppE :: { RlpExpr PsName } AppE :: { RlpExpr PsName }
: AppE VarE { Finl $ Core.AppF $1 $2 } : AppE VarE { Finl $ Core.AppF $1 $2 }
@@ -125,6 +141,9 @@ Pat1s :: { [Pat PsName] }
Pat1 :: { Pat PsName } Pat1 :: { Pat PsName }
: Var { VarP $1 } : Var { VarP $1 }
Pat :: { Pat PsName }
: Pat1 { $1 }
Con :: { PsName } Con :: { PsName }
: conname { $1 ^. to extract : conname { $1 ^. to extract
. singular _TokenConName } . singular _TokenConName }

View File

@@ -3,7 +3,7 @@ module Rlp.AltSyntax
( (
-- * AST -- * AST
Program(..), Decl(..), ExprF(..), Pat(..) Program(..), Decl(..), ExprF(..), Pat(..)
, RlpExprF, RlpExpr , RlpExprF, RlpExpr, Binding(..)
, DataCon(..), Type(..) , DataCon(..), Type(..)
, Core.Name, PsName , Core.Name, PsName
@@ -16,6 +16,7 @@ module Rlp.AltSyntax
import Data.Functor.Sum import Data.Functor.Sum
import Control.Comonad.Cofree import Control.Comonad.Cofree
import Data.Fix import Data.Fix
import Data.Function (fix)
import Text.Show.Deriving import Text.Show.Deriving
import Data.Text qualified as T import Data.Text qualified as T
@@ -44,6 +45,11 @@ data Type b = VarT b
deriving Show deriving Show
data ExprF b a = InfixEF b a a 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) -- type Expr b = Cofree (ExprF b)
@@ -54,6 +60,7 @@ type RlpExpr b = Fix (RlpExprF b)
data Pat b = VarP b data Pat b = VarP b
deriving Show deriving Show
deriveShow1 ''Binding
deriveShow1 ''ExprF deriveShow1 ''ExprF
deriving instance (Show b, Show a) => Show (ExprF b a) 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 prettyPrec = prettyPrec1
instance (Pretty b) => Pretty1 (Decl b) where 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) hsep [ ttext f, hsep (prettyPrec appPrec1 <$> as)
, "=", pr 0 e ] , "=", 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 instance (Pretty b) => Pretty (Pat b) where
prettyPrec p (VarP b) = prettyPrec p b prettyPrec p (VarP b) = prettyPrec p b