{-# LANGUAGE PatternGuards #-}
module Lambdabot.Plugin.Haskell.Pl.PrettyPrinter (Expr) where
import Lambdabot.Plugin.Haskell.Pl.Common
instance Show Decl where
show :: Decl -> String
show (Define f :: String
f e :: Expr
e) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
showList :: [Decl] -> ShowS
showList ds :: [Decl]
ds = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "; " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Decl -> String) -> [Decl] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> String
forall a. Show a => a -> String
show [Decl]
ds
instance Show TopLevel where
showsPrec :: Int -> TopLevel -> ShowS
showsPrec p :: Int
p (TLE e :: Expr
e) = Int -> Expr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Expr
e
showsPrec p :: Int
p (TLD _ d :: Decl
d) = Int -> Decl -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Decl
d
data SExpr
= SVar !String
| SLambda ![Pattern] !SExpr
| SLet ![Decl] !SExpr
| SApp !SExpr !SExpr
| SInfix !String !SExpr !SExpr
| LeftSection !String !SExpr
| RightSection !String !SExpr
| List ![SExpr]
| Tuple ![SExpr]
| Enum !Expr !(Maybe Expr) !(Maybe Expr)
{-# INLINE toSExprHead #-}
toSExprHead :: String -> [Expr] -> Maybe SExpr
toSExprHead :: String -> [Expr] -> Maybe SExpr
toSExprHead hd :: String
hd tl :: [Expr]
tl
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==',') String
hd, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hdInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
tl
= SExpr -> Maybe SExpr
forall a. a -> Maybe a
Just (SExpr -> Maybe SExpr)
-> ([SExpr] -> SExpr) -> [SExpr] -> Maybe SExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SExpr] -> SExpr
Tuple ([SExpr] -> SExpr) -> ([SExpr] -> [SExpr]) -> [SExpr] -> SExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SExpr] -> [SExpr]
forall a. [a] -> [a]
reverse ([SExpr] -> Maybe SExpr) -> [SExpr] -> Maybe SExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> SExpr) -> [Expr] -> [SExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> SExpr
toSExpr [Expr]
tl
| Bool
otherwise = case (String
hd,[Expr] -> [Expr]
forall a. [a] -> [a]
reverse [Expr]
tl) of
("enumFrom", [e :: Expr
e]) -> SExpr -> Maybe SExpr
forall a. a -> Maybe a
Just (SExpr -> Maybe SExpr) -> SExpr -> Maybe SExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr -> Maybe Expr -> SExpr
Enum Expr
e Maybe Expr
forall a. Maybe a
Nothing Maybe Expr
forall a. Maybe a
Nothing
("enumFromThen", [e :: Expr
e,e' :: Expr
e']) -> SExpr -> Maybe SExpr
forall a. a -> Maybe a
Just (SExpr -> Maybe SExpr) -> SExpr -> Maybe SExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr -> Maybe Expr -> SExpr
Enum Expr
e (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e') Maybe Expr
forall a. Maybe a
Nothing
("enumFromTo", [e :: Expr
e,e' :: Expr
e']) -> SExpr -> Maybe SExpr
forall a. a -> Maybe a
Just (SExpr -> Maybe SExpr) -> SExpr -> Maybe SExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr -> Maybe Expr -> SExpr
Enum Expr
e Maybe Expr
forall a. Maybe a
Nothing (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e')
("enumFromThenTo", [e :: Expr
e,e' :: Expr
e',e'' :: Expr
e'']) -> SExpr -> Maybe SExpr
forall a. a -> Maybe a
Just (SExpr -> Maybe SExpr) -> SExpr -> Maybe SExpr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr -> Maybe Expr -> SExpr
Enum Expr
e (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e') (Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e'')
_ -> Maybe SExpr
forall a. Maybe a
Nothing
toSExpr :: Expr -> SExpr
toSExpr :: Expr -> SExpr
toSExpr (Var _ v :: String
v) = String -> SExpr
SVar String
v
toSExpr (Lambda v :: Pattern
v e :: Expr
e) = case Expr -> SExpr
toSExpr Expr
e of
(SLambda vs :: [Pattern]
vs e' :: SExpr
e') -> [Pattern] -> SExpr -> SExpr
SLambda (Pattern
vPattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
:[Pattern]
vs) SExpr
e'
e' :: SExpr
e' -> [Pattern] -> SExpr -> SExpr
SLambda [Pattern
v] SExpr
e'
toSExpr (Let ds :: [Decl]
ds e :: Expr
e) = [Decl] -> SExpr -> SExpr
SLet [Decl]
ds (SExpr -> SExpr) -> SExpr -> SExpr
forall a b. (a -> b) -> a -> b
$ Expr -> SExpr
toSExpr Expr
e
toSExpr e :: Expr
e | Just (hd :: String
hd,tl :: [Expr]
tl) <- Expr -> Maybe (String, [Expr])
getHead Expr
e, Just se :: SExpr
se <- String -> [Expr] -> Maybe SExpr
toSExprHead String
hd [Expr]
tl = SExpr
se
toSExpr e :: Expr
e | (ls :: [Expr]
ls, tl :: Expr
tl) <- Expr -> ([Expr], Expr)
getList Expr
e, Expr
tl Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
nil
= [SExpr] -> SExpr
List ([SExpr] -> SExpr) -> [SExpr] -> SExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> SExpr) -> [Expr] -> [SExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> SExpr
toSExpr [Expr]
ls
toSExpr (App e1 :: Expr
e1 e2 :: Expr
e2) = case Expr
e1 of
App (Var Inf v :: String
v) e0 :: Expr
e0
-> String -> SExpr -> SExpr -> SExpr
SInfix String
v (Expr -> SExpr
toSExpr Expr
e0) (Expr -> SExpr
toSExpr Expr
e2)
Var Inf v :: String
v | String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "-"
-> String -> SExpr -> SExpr
LeftSection String
v (Expr -> SExpr
toSExpr Expr
e2)
Var _ "flip" | Var Inf v :: String
v <- Expr
e2, String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-" -> Expr -> SExpr
toSExpr (Expr -> SExpr) -> Expr -> SExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref "subtract"
App (Var _ "flip") (Var pr :: Fixity
pr v :: String
v)
| String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-" -> Expr -> SExpr
toSExpr (Expr -> SExpr) -> Expr -> SExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref "subtract" Expr -> Expr -> Expr
`App` Expr
e2
| String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "id" -> String -> SExpr -> SExpr
RightSection "$" (Expr -> SExpr
toSExpr Expr
e2)
| Fixity
Inf <- Fixity
pr -> String -> SExpr -> SExpr
RightSection String
v (Expr -> SExpr
toSExpr Expr
e2)
_ -> SExpr -> SExpr -> SExpr
SApp (Expr -> SExpr
toSExpr Expr
e1) (Expr -> SExpr
toSExpr Expr
e2)
getHead :: Expr -> Maybe (String, [Expr])
getHead :: Expr -> Maybe (String, [Expr])
getHead (Var _ v :: String
v) = (String, [Expr]) -> Maybe (String, [Expr])
forall a. a -> Maybe a
Just (String
v, [])
getHead (App e1 :: Expr
e1 e2 :: Expr
e2) = ([Expr] -> [Expr]) -> (String, [Expr]) -> (String, [Expr])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Expr
e2Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:) ((String, [Expr]) -> (String, [Expr]))
-> Maybe (String, [Expr]) -> Maybe (String, [Expr])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Expr -> Maybe (String, [Expr])
getHead Expr
e1
getHead _ = Maybe (String, [Expr])
forall a. Maybe a
Nothing
instance Show Expr where
showsPrec :: Int -> Expr -> ShowS
showsPrec p :: Int
p = Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (SExpr -> ShowS) -> (Expr -> SExpr) -> Expr -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> SExpr
toSExpr
instance Show SExpr where
showsPrec :: Int -> SExpr -> ShowS
showsPrec _ (SVar v :: String
v) = (ShowS
getPrefName String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++)
showsPrec p :: Int
p (SLambda vs :: [Pattern]
vs e :: SExpr
e) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
minPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ('\\'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ((Pattern -> ShowS) -> [Pattern] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pattern -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int -> Pattern -> ShowS) -> Int -> Pattern -> ShowS
forall a b. (a -> b) -> a -> b
$ Int
maxPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Pattern]
vs)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(" -> "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
minPrec SExpr
e
showsPrec p :: Int
p (SApp e1 :: SExpr
e1 e2 :: SExpr
e2) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
maxPrec SExpr
e1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
maxPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) SExpr
e2
showsPrec _ (LeftSection fx :: String
fx e :: SExpr
e) = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec ((Assoc, Int) -> Int
forall a b. (a, b) -> b
snd (String -> (Assoc, Int)
lookupFix String
fx) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) SExpr
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS
getInfName String
fxString -> ShowS
forall a. [a] -> [a] -> [a]
++)
showsPrec _ (RightSection fx :: String
fx e :: SExpr
e) = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
(ShowS
getInfName String
fxString -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec ((Assoc, Int) -> Int
forall a b. (a, b) -> b
snd (String -> (Assoc, Int)
lookupFix String
fx) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) SExpr
e
showsPrec _ (Tuple es :: [SExpr]
es) = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a. a -> a
`id` String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((SExpr -> String) -> [SExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SExpr -> String
forall a. Show a => a -> String
show [SExpr]
es) String -> ShowS
forall a. [a] -> [a] -> [a]
++)
showsPrec _ (List es :: [SExpr]
es)
| Just cs :: String
cs <- (SExpr -> Maybe Char) -> [SExpr] -> Maybe String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Maybe Char) -> Maybe String -> Maybe Char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) String -> Maybe Char
forall a (m :: * -> *). (Read a, Alternative m) => String -> m a
readM (Maybe String -> Maybe Char)
-> (SExpr -> Maybe String) -> SExpr -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SExpr -> Maybe String
fromSVar) [SExpr]
es = String -> ShowS
forall a. Show a => a -> ShowS
shows (String
cs::String)
| Bool
otherwise = ('['Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a. a -> a
`id` String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse ", " ((SExpr -> String) -> [SExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SExpr -> String
forall a. Show a => a -> String
show [SExpr]
es) String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (']'Char -> ShowS
forall a. a -> [a] -> [a]
:)
where fromSVar :: SExpr -> Maybe String
fromSVar (SVar str :: String
str) = String -> Maybe String
forall a. a -> Maybe a
Just String
str
fromSVar _ = Maybe String
forall a. Maybe a
Nothing
showsPrec _ (Enum fr :: Expr
fr tn :: Maybe Expr
tn to :: Maybe Expr
to) = ('['Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ShowS
forall a. Show a => a -> ShowS
shows Expr
fr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe String -> ShowS
forall a. Maybe [a] -> [a] -> [a]
showsMaybe (((','Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (Expr -> String) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> String
forall a. Show a => a -> String
show) (Expr -> String) -> Maybe Expr -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Expr
tn) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (".."String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe String -> ShowS
forall a. Maybe [a] -> [a] -> [a]
showsMaybe (Expr -> String
forall a. Show a => a -> String
show (Expr -> String) -> Maybe Expr -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Expr
to) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (']'Char -> ShowS
forall a. a -> [a] -> [a]
:)
where showsMaybe :: Maybe [a] -> [a] -> [a]
showsMaybe = ([a] -> [a]) -> ([a] -> [a] -> [a]) -> Maybe [a] -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
showsPrec _ (SLet ds :: [Decl]
ds e :: SExpr
e) = ("let "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Decl] -> ShowS
forall a. Show a => a -> ShowS
shows [Decl]
ds ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (" in "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SExpr -> ShowS
forall a. Show a => a -> ShowS
shows SExpr
e
showsPrec p :: Int
p (SInfix fx :: String
fx e1 :: SExpr
e1 e2 :: SExpr
e2) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
fixity) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
f1 SExpr
e1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS
getInfName String
fxString -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> SExpr -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
f2 SExpr
e2 where
fixity :: Int
fixity = (Assoc, Int) -> Int
forall a b. (a, b) -> b
snd ((Assoc, Int) -> Int) -> (Assoc, Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> (Assoc, Int)
lookupFix String
fx
(f1 :: Int
f1, f2 :: Int
f2) = case (Assoc, Int) -> Assoc
forall a b. (a, b) -> a
fst ((Assoc, Int) -> Assoc) -> (Assoc, Int) -> Assoc
forall a b. (a -> b) -> a -> b
$ String -> (Assoc, Int)
lookupFix String
fx of
AssocRight -> (Int
fixityInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, Int
fixity Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SExpr -> Assoc -> Int -> Int
infixSafe SExpr
e2 Assoc
AssocLeft Int
fixity)
AssocLeft -> (Int
fixity Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SExpr -> Assoc -> Int -> Int
infixSafe SExpr
e1 Assoc
AssocRight Int
fixity, Int
fixityInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
AssocNone -> (Int
fixityInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, Int
fixityInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
infixSafe :: SExpr -> Assoc -> Int -> Int
infixSafe :: SExpr -> Assoc -> Int -> Int
infixSafe (SInfix fx'' :: String
fx'' _ _) assoc :: Assoc
assoc fx' :: Int
fx'
| String -> (Assoc, Int)
lookupFix String
fx'' (Assoc, Int) -> (Assoc, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Assoc
assoc, Int
fx') = 1
| Bool
otherwise = 0
infixSafe _ _ _ = 0
instance Show Pattern where
showsPrec :: Int -> Pattern -> ShowS
showsPrec _ (PVar v :: String
v) = (String
vString -> ShowS
forall a. [a] -> [a] -> [a]
++)
showsPrec _ (PTuple p1 :: Pattern
p1 p2 :: Pattern
p2) = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> Pattern -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 Pattern
p1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (", "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pattern -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 Pattern
p2
showsPrec p :: Int
p (PCons p1 :: Pattern
p1 p2 :: Pattern
p2) = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> Pattern -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 6 Pattern
p1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (':'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pattern -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 5 Pattern
p2
isOperator :: String -> Bool
isOperator :: String -> Bool
isOperator str :: String
str = String -> Char
forall a. [a] -> a
last String
str Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
opchars
getInfName :: String -> String
getInfName :: ShowS
getInfName str :: String
str = if String -> Bool
isOperator String
str then String
str else "`"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
strString -> ShowS
forall a. [a] -> [a] -> [a]
++"`"
getPrefName :: String -> String
getPrefName :: ShowS
getPrefName str :: String
str = if String -> Bool
isOperator String
str Bool -> Bool -> Bool
|| ',' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str then "("String -> ShowS
forall a. [a] -> [a] -> [a]
++String
strString -> ShowS
forall a. [a] -> [a] -> [a]
++")" else String
str
instance Eq Assoc where
AssocLeft == :: Assoc -> Assoc -> Bool
== AssocLeft = Bool
True
AssocRight == AssocRight = Bool
True
AssocNone == AssocNone = Bool
True
_ == _ = Bool
False