This commit is contained in:
crumbtoo
2024-01-26 19:19:41 -07:00
parent e00e4d3418
commit c74c192645
3 changed files with 17 additions and 8 deletions

View File

@@ -17,6 +17,7 @@ import Data.Functor.Apply
import Data.Functor.Bind
import Control.Comonad
import Data.Functor
import Data.Semigroup.Traversable
import Data.Text qualified as T
import Data.Void
}
@@ -104,23 +105,24 @@ DataCons :: { [ConAlt RlpcPs] }
| DataCon { [$1] }
DataCon :: { ConAlt RlpcPs }
: Con Type1s { ConAlt $1 $2 }
: Con Type1s { undefined }
Type1s :: { [Type] }
: {- epsilon -} { [] }
| Type1s Type1 { $1 `snoc` $2 }
Type1 :: { Type }
: '(' Type ')' { $2 }
| conname { TyCon $1 }
| varname { TyVar $1 }
: '(' Type ')' { undefined }
| conname { undefined }
| varname { undefined }
Type :: { Type }
: Type '->' Type { $1 :-> $3 }
| Type1 { $1 }
FunDecl :: { Decl' RlpcPs }
FunDecl : Var Params '=' Expr { FunD undefined $2 $4 Nothing }
FunDecl : Var Params '=' Expr { $4 =>> \e ->
FunD' (extract $1) $2 e Nothing }
Params :: { [Pat' RlpcPs] }
Params : {- epsilon -} { [] }

View File

@@ -55,6 +55,7 @@ type instance IdP RlpcPs = PsName
type instance XInfixD RlpcPs = ()
type instance XVarE RlpcPs = ()
type instance XLitE RlpcPs = ()
type instance XFunD RlpcPs = ()
type PsName = Text

View File

@@ -12,16 +12,17 @@ module Rlp.Syntax
, Assoc(..)
, Lit(..), Lit'
, Type(..)
, pattern (:->)
, ConAlt(..)
-- * Pattern synonyms for unused extensions
-- ** Decl
, pattern InfixD'
, pattern InfixD', pattern FunD'
-- ** RlpExpr
, pattern ParE', pattern VarE', pattern LitE'
-- * Trees That Grow extensions
, XRec, IdP
, UnXRec(..), MapXRec(..), XRec, IdP
-- ** RlpExpr
, XLetE, XVarE, XConE, XLamE, XCaseE, XIfE, XAppE, XLitE, XXRlpExpr
-- ** Decl
@@ -47,7 +48,7 @@ data RlpModule p = RlpModule
newtype RlpProgram p = RlpProgram [Decl p]
data Decl p = FunD (XFunD p) (IdP p) [Pat p] (RlpExpr p) (Maybe (Where p))
data Decl p = FunD (XFunD p) (IdP p) [Pat' p] (RlpExpr' p) (Maybe (Where p))
| TySigD (XTySigD p) [IdP p] Type
| DataD (XDataD p) (IdP p) [IdP p] [ConAlt p]
| InfixD (XInfixD p) Assoc Int (IdP p)
@@ -59,6 +60,11 @@ type family XDataD p
type family XInfixD p
type family XXDecl p
pattern FunD' :: (XFunD p ~ ())
=> IdP p -> [Pat' p] -> RlpExpr' p -> (Maybe (Where p))
-> Decl p
pattern FunD' n as e wh = FunD () n as e wh
pattern InfixD' :: (XInfixD p ~ ()) => Assoc -> Int -> (IdP p) -> Decl p
pattern InfixD' a p n = InfixD () a p n