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

some

Browse Source
This commit is contained in:
crumbtoo
2024-01-26 15:12:10 -07:00
parent 559fd49f2b
commit 6a6076f26e
7 changed files with 190 additions and 316 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/Rlp/Lex.x
View File

@@ -193,13 +193,13 @@ readInt = T.foldr f 0 where
constToken :: RlpToken -> LexerAction (Located RlpToken)
constToken t inp l = do
pos <- use (psInput . aiPos)
pure (Located (pos,l) t)
pure (Located (spanFromPos pos l) t)
tokenWith :: (Text -> RlpToken) -> LexerAction (Located RlpToken)
tokenWith tf inp l = do
pos <- getPos
let t = tf (T.take l $ inp ^. aiSource)
pure (Located (pos,l) t)
pure (Located (spanFromPos pos l) t)
getPos :: P Position
getPos = use (psInput . aiPos)
@@ -207,7 +207,8 @@ getPos = use (psInput . aiPos)
alexEOF :: P (Located RlpToken)
alexEOF = do
inp <- getInput
pure (Located undefined TokenEOF)
pos <- getPos
pure (Located (spanFromPos pos 0) TokenEOF)
initParseState :: Text -> ParseState
initParseState s = ParseState
@@ -238,7 +239,7 @@ lexToken = do
st <- use id
-- traceM $ "st: " <> show st
case alexScan inp c of
AlexEOF -> pure $ Located (inp ^. aiPos, 0) TokenEOF
AlexEOF -> pure $ Located (spanFromPos (inp^.aiPos) 0) TokenEOF
AlexSkip inp' l -> do
psInput .= inp'
lexToken
@@ -274,7 +275,7 @@ indentLevel = do
insertToken :: RlpToken -> P (Located RlpToken)
insertToken t = do
pos <- use (psInput . aiPos)
pure (Located (pos, 0) t)
pure (Located (spanFromPos pos 0) t)
popLayout :: P Layout
popLayout = do

80
src/Rlp/Parse.y
View File

@@ -9,13 +9,13 @@ import Rlp.Lex
import Rlp.Syntax
import Rlp.Parse.Types
import Rlp.Parse.Associate
import Lens.Micro
import Lens.Micro.Mtl
import Lens.Micro.Platform ()
import Lens.Micro.Platform
import Data.List.Extra
import Data.Fix
import Data.Functor.Const
import Data.Functor
import Data.Text qualified as T
import Data.Void
}
%name parseRlpProg StandaloneProgram
@@ -26,12 +26,12 @@ import Data.Text qualified as T
%tokentype { Located RlpToken }
%token
varname { Located _ (TokenVarName $$) }
conname { Located _ (TokenConName $$) }
consym { Located _ (TokenConSym $$) }
varsym { Located _ (TokenVarSym $$) }
varname { Located _ (TokenVarName _) }
conname { Located _ (TokenConName _) }
consym { Located _ (TokenConSym _) }
varsym { Located _ (TokenVarSym _) }
data { Located _ TokenData }
litint { Located _ (TokenLitInt $$) }
litint { Located _ (TokenLitInt _) }
'=' { Located _ TokenEquals }
'|' { Located _ TokenPipe }
';' { Located _ TokenSemicolon }
@@ -51,7 +51,7 @@ import Data.Text qualified as T
%%
StandaloneProgram :: { RlpProgram' }
StandaloneProgram :: { RlpProgram RlpcPs }
StandaloneProgram : '{' Decls '}' {% mkProgram $2 }
| VL DeclsV VR {% mkProgram $2 }
@@ -62,12 +62,12 @@ VR :: { () }
VR : vrbrace { () }
| error { () }
Decls :: { [PartialDecl'] }
Decls :: { [Decl' RlpcPs] }
Decls : Decl ';' Decls { $1 : $3 }
| Decl ';' { [$1] }
| Decl { [$1] }
DeclsV :: { [PartialDecl'] }
DeclsV :: { [Decl' RlpcPs] }
DeclsV : Decl VS Decls { $1 : $3 }
| Decl VS { [$1] }
| Decl { [$1] }
@@ -76,12 +76,12 @@ VS :: { Located RlpToken }
VS : ';' { $1 }
| vsemi { $1 }
Decl :: { PartialDecl' }
Decl :: { Decl' RlpcPs }
: FunDecl { $1 }
| DataDecl { $1 }
| InfixDecl { $1 }
InfixDecl :: { PartialDecl' }
InfixDecl :: { Decl' RlpcPs }
: InfixWord litint InfixOp {% mkInfixD $1 $2 $3 }
InfixWord :: { Assoc }
@@ -89,18 +89,18 @@ InfixWord :: { Assoc }
| infixr { InfixR }
| infix { Infix }
DataDecl :: { PartialDecl' }
DataDecl :: { Decl' RlpcPs }
: data Con TyParams '=' DataCons { DataD $2 $3 $5 }
TyParams :: { [Name] }
TyParams :: { [PsName] }
: {- epsilon -} { [] }
| TyParams varname { $1 `snoc` $2 }
DataCons :: { [ConAlt] }
DataCons :: { [ConAlt RlpcPs] }
: DataCons '|' DataCon { $1 `snoc` $3 }
| DataCon { [$1] }
DataCon :: { ConAlt }
DataCon :: { ConAlt RlpcPs }
: Con Type1s { ConAlt $1 $2 }
Type1s :: { [Type] }
@@ -116,22 +116,22 @@ Type :: { Type }
: Type '->' Type { $1 :-> $3 }
| Type1 { $1 }
FunDecl :: { PartialDecl' }
FunDecl : Var Params '=' Expr { FunD $1 $2 (Const $4) Nothing }
FunDecl :: { Decl' RlpcPs }
FunDecl : Var Params '=' Expr { FunD $1 $2 $4 Nothing }
Params :: { [Pat'] }
Params :: { [Pat' RlpcPs] }
Params : {- epsilon -} { [] }
| Params Pat1 { $1 `snoc` $2 }
Pat1 :: { Pat' }
Pat1 :: { Pat' RlpcPs }
: Var { VarP $1 }
| Lit { LitP $1 }
Expr :: { PartialExpr' }
Expr :: { RlpExpr' RlpcPs }
: Expr1 varsym Expr { Fix $ B $2 (unFix $1) (unFix $3) }
| Expr1 { $1 }
Expr1 :: { PartialExpr' }
Expr1 :: { RlpExpr' RlpcPs }
: '(' Expr ')' { wrapFix . Par . unwrapFix $ $2 }
| Lit { Fix . E $ LitEF $1 }
| Var { Fix . E $ VarEF $1 }
@@ -139,34 +139,43 @@ Expr1 :: { PartialExpr' }
-- TODO: happy prefers left-associativity. doing such would require adjusting
-- the code in Rlp.Parse.Associate to expect left-associative input rather than
-- right.
InfixExpr :: { PartialExpr' }
InfixExpr :: { RlpExpr' RlpcPs }
: Expr1 varsym Expr { Fix $ B $2 (unFix $1) (unFix $3) }
InfixOp :: { Name }
InfixOp :: { PsName }
: consym { $1 }
| varsym { $1 }
Lit :: { Lit' }
Lit : litint { IntL $1 }
-- TODO: microlens-pro save me microlens-pro (rewrite this with prisms)
Lit :: { Lit' RlpcPs }
: litint { $1 <&> (IntL . (\ (TokenLitInt n) -> n)) }
Var :: { VarId }
Var : varname { NameVar $1 }
Var :: { Located PsName }
Var : varname { mkPsName $1 }
Con :: { ConId }
: conname { NameCon $1 }
Con :: { Located PsName }
: conname { mkPsName $1 }
{
mkProgram :: [PartialDecl'] -> P RlpProgram'
mkPsName :: Located RlpToken -> Located PsName
mkPsName = fmap $ \case
TokenVarName n -> n
TokenConName n -> n
TokenConSym n -> n
TokenVarSym n -> n
_ -> error "mkPsName: not an identifier"
mkProgram :: [Decl' RlpcPs] -> P (RlpProgram RlpcPs)
mkProgram ds = do
pt <- use psOpTable
pure $ RlpProgram (associate pt <$> ds)
parseError :: Located RlpToken -> P a
parseError (Located ((l,c),s) t) = addFatal $
parseError (Located (l,c,s) t) = addFatal $
errorMsg (SrcSpan l c s) RlpParErrUnexpectedToken
mkInfixD :: Assoc -> Int -> Name -> P PartialDecl'
mkInfixD :: Assoc -> Int -> PsName -> P (Decl' RlpcPs)
mkInfixD a p n = do
let opl :: Lens' ParseState (Maybe OpInfo)
opl = psOpTable . at n
@@ -176,6 +185,7 @@ mkInfixD a p n = do
l = T.length n
Nothing -> pure (Just (a,p))
)
pure $ InfixD a p n
pos <- use (psInput . aiPos)
pure $ Located (spanFromPos pos 0) (InfixD' a p n)
}

87
src/Rlp/Parse/Associate.hs
View File

@@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns, ImplicitParams #-}
module Rlp.Parse.Associate
{-# WARNING "temporarily unimplemented" #-}
( associate
)
where
@@ -13,88 +14,6 @@ import Rlp.Parse.Types
import Rlp.Syntax
--------------------------------------------------------------------------------
associate :: OpTable -> PartialDecl' -> Decl' RlpExpr
associate pt (FunD n as b w) = FunD n as b' w
where b' = let ?pt = pt in completeExpr (getConst b)
associate pt (TySigD ns t) = TySigD ns t
associate pt (DataD n as cs) = DataD n as cs
associate pt (InfixD a p n) = InfixD a p n
completeExpr :: (?pt :: OpTable) => PartialExpr' -> RlpExpr'
completeExpr = cata completePartial
completePartial :: (?pt :: OpTable) => PartialE -> RlpExpr'
completePartial (E e) = completeRlpExpr e
completePartial p@(B o l r) = completeB (build p)
completePartial (Par e) = completePartial e
completeRlpExpr :: (?pt :: OpTable) => RlpExprF' RlpExpr' -> RlpExpr'
completeRlpExpr = embed
completeB :: (?pt :: OpTable) => PartialE -> RlpExpr'
completeB p = case build p of
B o l r -> (o' `AppE` l') `AppE` r'
where
-- TODO: how do we know it's symbolic?
o' = VarE (SymVar o)
l' = completeB l
r' = completeB r
Par e -> completeB e
E e -> completeRlpExpr e
build :: (?pt :: OpTable) => PartialE -> PartialE
build e = go id e (rightmost e) where
rightmost :: PartialE -> PartialE
rightmost (B _ _ r) = rightmost r
rightmost p@(E _) = p
rightmost p@(Par _) = p
go :: (?pt :: OpTable)
=> (PartialE -> PartialE)
-> PartialE -> PartialE -> PartialE
go f p@(WithInfo o _ r) = case r of
E _ -> mkHole o (f . f')
Par _ -> mkHole o (f . f')
B _ _ _ -> go (mkHole o (f . f')) r
where f' r' = p & pR .~ r'
go f _ = id
mkHole :: (?pt :: OpTable)
=> OpInfo
-> (PartialE -> PartialE)
-> PartialE
-> PartialE
mkHole _ hole p@(Par _) = hole p
mkHole _ hole p@(E _) = hole p
mkHole (a,d) hole p@(WithInfo (a',d') _ _)
| d' < d = above
| d' > d = below
| d == d' = case (a,a') of
-- left-associative operators of equal precedence are
-- associated left
(InfixL,InfixL) -> above
-- right-associative operators are handled similarly
(InfixR,InfixR) -> below
-- non-associative operators of equal precedence, or equal
-- precedence operators of different associativities are
-- invalid
(_, _) -> error "invalid expression"
where
above = p & pL %~ hole
below = hole p
examplePrecTable :: OpTable
examplePrecTable = H.fromList
[ ("+", (InfixL,6))
, ("*", (InfixL,7))
, ("^", (InfixR,8))
, (".", (InfixR,7))
, ("~", (Infix, 9))
, ("=", (Infix, 4))
, ("&&", (Infix, 3))
, ("||", (Infix, 2))
, ("$", (InfixR,0))
, ("&", (InfixL,0))
]
associate = undefined
{-# WARNING associate "temporarily undefined" #-}

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

@@ -2,38 +2,24 @@
{-# LANGUAGE ImplicitParams, ViewPatterns, PatternSynonyms #-}
{-# LANGUAGE LambdaCase #-}
module Rlp.Parse.Types
( LexerAction
, MsgEnvelope(..)
, RlpcError(..)
, AlexInput(..)
, Position(..)
, RlpToken(..)
, P(..)
, ParseState(..)
, psLayoutStack
, psLexState
, psInput
, psOpTable
, Layout(..)
, Located(..)
, OpTable
, OpInfo
, RlpParseError(..)
, PartialDecl'
, Partial(..)
, pL, pR
, PartialE
, pattern WithInfo
, opInfoOrDef
, PartialExpr'
, aiPrevChar
, aiSource
, aiBytes
, aiPos
, addFatal
, addWound
, addFatalHere
, addWoundHere
(
-- * Trees That Grow
RlpcPs
-- * Parser monad and state
, P(..), ParseState(..), Layout(..), OpTable, OpInfo
-- ** Lenses
, psLayoutStack, psLexState, psInput, psOpTable
-- * Other parser types
, RlpToken(..), AlexInput(..), Position(..), spanFromPos, LexerAction
, Located(..), PsName
-- ** Lenses
, aiPrevChar, aiSource, aiBytes, aiPos, posLine, posColumn
-- * Error handling
, MsgEnvelope(..), RlpcError(..), RlpParseError(..)
, addFatal, addWound, addFatalHere, addWoundHere
)
where
--------------------------------------------------------------------------------
@@ -49,12 +35,26 @@ import Data.Functor.Foldable
import Data.Functor.Const
import Data.Functor.Classes
import Data.HashMap.Strict qualified as H
import Data.Void
import Data.Word (Word8)
import Lens.Micro.TH
import Lens.Micro
import Rlp.Syntax
--------------------------------------------------------------------------------
-- | Phantom type identifying rlpc's parser phase
data RlpcPs
type instance XRec RlpcPs f = Located (f RlpcPs)
type instance IdP RlpcPs = PsName
type instance XInfixD RlpcPs = ()
type PsName = Text
--------------------------------------------------------------------------------
type LexerAction a = AlexInput -> Int -> P a
data AlexInput = AlexInput
@@ -106,7 +106,7 @@ data RlpToken
| TokenLParen
| TokenRParen
-- 'virtual' control symbols, inserted by the lexer without any correlation
-- to a specific symbol
-- to a specific part of the input
| TokenSemicolonV
| TokenLBraceV
| TokenRBraceV
@@ -154,8 +154,14 @@ data Layout = Explicit
| Implicit Int
deriving (Show, Eq)
data Located a = Located (Position, Int) a
deriving (Show)
-- | Token wrapped with a span (line, column, length)
data Located a = Located !(Int, Int, Int) a
deriving (Show, Functor)
spanFromPos :: Position -> Int -> (Int, Int, Int)
spanFromPos (l,c) s = (l,c,s)
{-# INLINE spanFromPos #-}
type OpTable = H.HashMap Name OpInfo
type OpInfo = (Assoc, Int)
@@ -171,47 +177,6 @@ data RlpParseError = RlpParErrOutOfBoundsPrecedence Int
instance IsRlpcError RlpParseError where
----------------------------------------------------------------------------------
-- absolute psycho shit (partial ASTs)
type PartialDecl' = Decl (Const PartialExpr') Name
data Partial a = E (RlpExprF Name a)
| B Name (Partial a) (Partial a)
| Par (Partial a)
deriving (Show, Functor)
pL :: Traversal' (Partial a) (Partial a)
pL k (B o l r) = (\l' -> B o l' r) <$> k l
pL _ x = pure x
pR :: Traversal' (Partial a) (Partial a)
pR k (B o l r) = (\r' -> B o l r') <$> k r
pR _ x = pure x
type PartialE = Partial RlpExpr'
-- i love you haskell
pattern WithInfo :: (?pt :: OpTable) => OpInfo -> PartialE -> PartialE -> PartialE
pattern WithInfo p l r <- B (opInfoOrDef -> p) l r
opInfoOrDef :: (?pt :: OpTable) => Name -> OpInfo
opInfoOrDef c = fromMaybe (InfixL,9) $ H.lookup c ?pt
-- required to satisfy constraint on Fix's show instance
instance Show1 Partial where
liftShowsPrec :: forall a. (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int -> Partial a -> ShowS
liftShowsPrec sp sl p m = case m of
(E e) -> showsUnaryWith lshow "E" p e
(B f a b) -> showsTernaryWith showsPrec lshow lshow "B" p f a b
(Par e) -> showsUnaryWith lshow "Par" p e
where
lshow :: forall f. (Show1 f) => Int -> f a -> ShowS
lshow = liftShowsPrec sp sl
type PartialExpr' = Fix Partial
makeLenses ''AlexInput
makeLenses ''ParseState

208
src/Rlp/Syntax.hs
View File

@@ -1,40 +1,28 @@
-- recursion-schemes
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
-- recursion-schemes
{-# LANGUAGE TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable
, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings, PatternSynonyms #-}
{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-}
module Rlp.Syntax
( RlpModule(..)
, RlpProgram(..)
, RlpProgram'
, rlpmodName
, rlpmodProgram
, RlpExpr(..)
, RlpExpr'
, RlpExprF(..)
, RlpExprF'
, Decl(..)
, Decl'
, Bind(..)
, Where
, Where'
, ConAlt(..)
, Type(..)
, pattern (:->)
(
-- * AST
RlpProgram(..)
, Decl(..), Decl', RlpExpr(..), RlpExpr'
, Pat(..), Pat'
, Assoc(..)
, VarId(..)
, ConId(..)
, Pat(..)
, Pat'
, Lit(..)
, Lit'
, Name
, Lit(..), Lit'
, Type(..)
, ConAlt(..)
-- TODO: ugh move this somewhere else later
, showsTernaryWith
-- * Pattern synonyms for unused extensions
, pattern InfixD'
-- * Convenience re-exports
, Text
-- * Trees That Grow extensions
, XRec, IdP
-- ** RlpExpr
, XLetE, XVarE, XConE, XLamE, XCaseE, XIfE, XAppE, XLitE, XXRlpExpr
-- ** Decl
, XFunD, XTySigD, XDataD, XInfixD, XXDecl
)
where
----------------------------------------------------------------------------------
@@ -49,87 +37,91 @@ import Core.Syntax hiding (Lit)
import Core (HasRHS(..), HasLHS(..))
----------------------------------------------------------------------------------
data RlpModule b = RlpModule
data RlpModule p = RlpModule
{ _rlpmodName :: Text
, _rlpmodProgram :: RlpProgram b
, _rlpmodProgram :: RlpProgram p
}
newtype RlpProgram b = RlpProgram [Decl RlpExpr b]
deriving Show
newtype RlpProgram p = RlpProgram [Decl p]
type RlpProgram' = RlpProgram Name
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)
| XDecl !(XXDecl p)
-- | The @e@ parameter is used for partial results. When parsing an input, we
-- first parse all top-level declarations in order to extract infix[lr]
-- declarations. This process yields a @[Decl (Const Text) Name]@, where @Const
-- Text@ stores the remaining unparsed function bodies. Once infixities are
-- accounted for, we may complete the parsing task and get a proper @[Decl
-- RlpExpr Name]@.
type family XFunD p
type family XTySigD p
type family XDataD p
type family XInfixD p
type family XXDecl p
data Decl e b = FunD VarId [Pat b] (e b) (Maybe (Where b))
| TySigD [VarId] Type
| DataD ConId [Name] [ConAlt]
| InfixD Assoc Int Name
deriving Show
pattern InfixD' :: (XInfixD p ~ ()) => Assoc -> Int -> (IdP p) -> Decl p
pattern InfixD' a p n = InfixD () a p n
type Decl' e = Decl e Name
type Decl' p = XRec p Decl
data Assoc = InfixL
| InfixR
| Infix
deriving Show
deriving (Show)
data ConAlt = ConAlt ConId [Type]
deriving Show
data ConAlt p = ConAlt (IdP p) [Type]
data RlpExpr b = LetE [Bind b] (RlpExpr b)
| VarE VarId
| ConE ConId
| LamE [Pat b] (RlpExpr b)
| CaseE (RlpExpr b) [(Alt b, Where b)]
| IfE (RlpExpr b) (RlpExpr b) (RlpExpr b)
| AppE (RlpExpr b) (RlpExpr b)
| LitE (Lit b)
deriving Show
data RlpExpr p = LetE (XLetE p) [Bind 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)
| XRlpExpr !(XXRlpExpr p)
type RlpExpr' = RlpExpr Name
type RlpExpr' p = XRec p RlpExpr
type Where b = [Bind b]
type Where' = [Bind Name]
class UnXRec p where
unXRec :: XRec p f -> f p
class MapXRec p where
mapXRec :: (f p -> f p) -> XRec p f -> XRec p f
type family XRec p (f :: * -> *) = (r :: *) | r -> p f
type family XLetE p
type family XVarE p
type family XConE 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 XXRlpExpr p
type family IdP p
type Where p = [Bind p]
-- do we want guards?
data Alt b = AltA (Pat b) (RlpExpr b)
deriving Show
data Alt p = AltA (Pat' p) (RlpExpr' p)
data Bind b = PatB (Pat b) (RlpExpr b)
| FunB VarId [Pat b] (RlpExpr b)
deriving Show
data Bind p = PatB (Pat' p) (RlpExpr' p)
| FunB (IdP p) [Pat' p] (RlpExpr' p)
data VarId = NameVar Text
| SymVar Text
deriving Show
data Pat p = VarP (IdP p)
| LitP (Lit' p)
| ConP (IdP p) [Pat' p]
instance IsString VarId where
-- TODO: use symvar if it's an operator
fromString = NameVar . T.pack
type Pat' p = XRec p Pat
data ConId = NameCon Text
| SymCon Text
deriving Show
data Pat b = VarP VarId
| LitP (Lit b)
| ConP ConId [Pat b]
deriving Show
type Pat' = Pat Name
data Lit b = IntL Int
data Lit p = IntL Int
| CharL Char
| ListL [RlpExpr b]
deriving Show
| ListL [RlpExpr' p]
type Lit' = Lit Name
type Lit' p = XRec p Lit
-- instance HasLHS Alt Alt Pat Pat where
-- _lhs = lens
@@ -143,33 +135,17 @@ type Lit' = Lit Name
makeBaseFunctor ''RlpExpr
deriving instance (Show b, Show a) => Show (RlpExprF b a)
type RlpExprF' = RlpExprF Name
-- society if derivable Show1
instance (Show b) => Show1 (RlpExprF b) where
liftShowsPrec sp _ p m = case m of
(LetEF bs e) -> showsBinaryWith showsPrec sp "LetEF" p bs e
(VarEF n) -> showsUnaryWith showsPrec "VarEF" p n
(ConEF n) -> showsUnaryWith showsPrec "ConEF" p n
(LamEF bs e) -> showsBinaryWith showsPrec sp "LamEF" p bs e
(CaseEF e as) -> showsBinaryWith sp showsPrec "CaseEF" p e as
(IfEF a b c) -> showsTernaryWith sp sp sp "IfEF" p a b c
(AppEF f x) -> showsBinaryWith sp sp "AppEF" p f x
(LitEF l) -> showsUnaryWith showsPrec "LitEF" p l
showsTernaryWith :: (Int -> x -> ShowS)
-> (Int -> y -> ShowS)
-> (Int -> z -> ShowS)
-> String -> Int
-> x -> y -> z
-> ShowS
showsTernaryWith sa sb sc name p a b c = showParen (p > 10)
$ showString name
. showChar ' ' . sa 11 a
. showChar ' ' . sb 11 b
. showChar ' ' . sc 11 c
-- showsTernaryWith :: (Int -> x -> ShowS)
-- -> (Int -> y -> ShowS)
-- -> (Int -> z -> ShowS)
-- -> String -> Int
-- -> x -> y -> z
-- -> ShowS
-- showsTernaryWith sa sb sc name p a b c = showParen (p > 10)
-- $ showString name
-- . showChar ' ' . sa 11 a
-- . showChar ' ' . sb 11 b
-- . showChar ' ' . sc 11 c
--------------------------------------------------------------------------------