    {-# LANGUAGE PatternGuards #-}
    module Lambdabot.Plugin.Haskell.Pl.PrettyPrinter (Expr) where

    -- Dummy export to make ghc -Wall happy

    import Lambdabot.Plugin.Haskell.Pl.Common

    instance Show Decl where
      show :: Decl -> String
    show (Define String
    f Expr
    e) = String
    f String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " = " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Expr -> String
    forall a. Show a => a -> String
    show Expr
    e
      showList :: [Decl] -> ShowS
    showList [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] -> [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 Int
    p (TLE Expr
    e) = Int -> Expr -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p Expr
    e
      showsPrec Int
    p (TLD Bool
    _ Decl
    d) = Int -> Decl -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p Decl
    d

    -- | Expression with syntactic sugar
    data SExpr
      = SVar !String
      | SLambda ![Pattern] !SExpr
      | SLet ![Decl] !SExpr
      | SApp !SExpr !SExpr
      | SInfix !String !SExpr !SExpr
      | LeftSection !String !SExpr  -- (x +)
      | RightSection !String !SExpr -- (+ x)
      | List ![SExpr]
      | Tuple ![SExpr]
      | Enum !Expr !(Maybe Expr) !(Maybe Expr)

    {-# INLINE toSExprHead #-}
    toSExprHead :: String -> [Expr] -> Maybe SExpr
    toSExprHead :: String -> [Expr] -> Maybe SExpr
    toSExprHead String
    hd [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
    ==Char
    ',') String
    hd, String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    hdInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Expr] -> Int
    forall a. [a] -> 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
          (String
    "enumFrom", [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
          (String
    "enumFromThen", [Expr
    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
          (String
    "enumFromTo", [Expr
    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')
          (String
    "enumFromThenTo", [Expr
    e,Expr
    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'')
          (String, [Expr])
    _                              -> Maybe SExpr
    forall a. Maybe a
    Nothing

    toSExpr :: Expr -> SExpr
    toSExpr :: Expr -> SExpr
    toSExpr (Var Fixity
    _ String
    v) = String -> SExpr
    SVar String
    v
    toSExpr (Lambda Pattern
    v Expr
    e) = case Expr -> SExpr
    toSExpr Expr
    e of
      (SLambda [Pattern]
    vs SExpr
    e') -> [Pattern] -> SExpr -> SExpr
    SLambda (Pattern
    vPattern -> [Pattern] -> [Pattern]
    forall a. a -> [a] -> [a]
    :[Pattern]
    vs) SExpr
    e'
      SExpr
    e'              -> [Pattern] -> SExpr -> SExpr
    SLambda [Pattern
    v] SExpr
    e'
    toSExpr (Let [Decl]
    ds 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 Expr
    e | Just (String
    hd,[Expr]
    tl) <- Expr -> Maybe (String, [Expr])
    getHead Expr
    e, Just SExpr
    se <- String -> [Expr] -> Maybe SExpr
    toSExprHead String
    hd [Expr]
    tl = SExpr
    se
    toSExpr Expr
    e | ([Expr]
    ls, 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 Expr
    e1 Expr
    e2) = case Expr
    e1 of
      App (Var Fixity
    Inf String
    v) Expr
    e0
        -> String -> SExpr -> SExpr -> SExpr
    SInfix String
    v (Expr -> SExpr
    toSExpr Expr
    e0) (Expr -> SExpr
    toSExpr Expr
    e2)
      Var Fixity
    Inf String
    v | String
    v String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "-"
        -> String -> SExpr -> SExpr
    LeftSection String
    v (Expr -> SExpr
    toSExpr Expr
    e2)

      Var Fixity
    _ String
    "flip" | Var Fixity
    Inf String
    v <- Expr
    e2, String
    v String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-" -> Expr -> SExpr
    toSExpr (Expr -> SExpr) -> Expr -> SExpr
    forall a b. (a -> b) -> a -> b
    $ Fixity -> String -> Expr
    Var Fixity
    Pref String
    "subtract"

      App (Var Fixity
    _ String
    "flip") (Var Fixity
    pr String
    v)
        | String
    v String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-"  -> Expr -> SExpr
    toSExpr (Expr -> SExpr) -> Expr -> SExpr
    forall a b. (a -> b) -> a -> b
    $ Fixity -> String -> Expr
    Var Fixity
    Pref String
    "subtract" Expr -> Expr -> Expr
    `App` Expr
    e2
        | String
    v String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "id" -> String -> SExpr -> SExpr
    RightSection String
    "$" (Expr -> SExpr
    toSExpr Expr
    e2)
        | Fixity
    Inf <- Fixity
    pr -> String -> SExpr -> SExpr
    RightSection String
    v (Expr -> SExpr
    toSExpr Expr
    e2)
      Expr
    _ -> 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 Fixity
    _ String
    v) = (String, [Expr]) -> Maybe (String, [Expr])
    forall a. a -> Maybe a
    Just (String
    v, [])
    getHead (App Expr
    e1 Expr
    e2) = ([Expr] -> [Expr]) -> (String, [Expr]) -> (String, [Expr])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    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 a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Expr -> Maybe (String, [Expr])
    getHead Expr
    e1
    getHead Expr
    _ = Maybe (String, [Expr])
    forall a. Maybe a
    Nothing

    instance Show Expr where
      showsPrec :: Int -> Expr -> ShowS
    showsPrec 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 Int
    _ (SVar String
    v) = (ShowS
    getPrefName String
    v String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
      showsPrec Int
    p (SLambda [Pattern]
    vs 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
    '\\'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 a b. (a -> b -> b) -> b -> [a] -> b
    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
    ' '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
    +Int
    1) [Pattern]
    vs)) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (String
    " -> "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 Int
    p (SApp SExpr
    e1 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
    ' '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
    +Int
    1) SExpr
    e2
      showsPrec Int
    _ (LeftSection String
    fx 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
    + Int
    1) SExpr
    e ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    ' '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 Int
    _ (RightSection String
    fx 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
    ' '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
    + Int
    1) SExpr
    e
      showsPrec Int
    _ (Tuple [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 String
    ", " ((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 Int
    _ (List [SExpr]
    es)
        | Just 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
    '['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 String
    ", " ((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
    ']'Char -> ShowS
    forall a. a -> [a] -> [a]
    :)
        where fromSVar :: SExpr -> Maybe String
    fromSVar (SVar String
    str) = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    str
              fromSVar SExpr
    _          = Maybe String
    forall a. Maybe a
    Nothing
      showsPrec Int
    _ (Enum Expr
    fr Maybe Expr
    tn Maybe Expr
    to) = (Char
    '['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
    ','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 a b. (a -> b) -> Maybe a -> Maybe b
    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
    ".."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 a b. (a -> b) -> Maybe a -> Maybe b
    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
    ']'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 Int
    _ (SLet [Decl]
    ds SExpr
    e) = (String
    "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
    . (String
    " 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 Int
    p (SInfix String
    fx SExpr
    e1 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
    ' '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
    ' '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
          (Int
    f1, 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
            Assoc
    AssocRight -> (Int
    fixityInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, Int
    fixity Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + SExpr -> Assoc -> Int -> Int
    infixSafe SExpr
    e2 Assoc
    AssocLeft Int
    fixity)
            Assoc
    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
    +Int
    1)
            Assoc
    AssocNone  -> (Int
    fixityInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, Int
    fixityInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)

          -- This is a little bit awkward, but at least seems to produce no false
          -- results anymore
          infixSafe :: SExpr -> Assoc -> Int -> Int
          infixSafe :: SExpr -> Assoc -> Int -> Int
    infixSafe (SInfix String
    fx'' SExpr
    _ SExpr
    _) Assoc
    assoc Int
    fx'
            | String -> (Assoc, Int)
    lookupFix String
    fx'' (Assoc, Int) -> (Assoc, Int) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Assoc
    assoc, Int
    fx') = Int
    1
            | Bool
    otherwise = Int
    0
          infixSafe SExpr
    _ Assoc
    _ Int
    _ = Int
    0 -- doesn't matter

    instance Show Pattern where
      showsPrec :: Int -> Pattern -> ShowS
    showsPrec Int
    _ (PVar String
    v) = (String
    vString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
      showsPrec Int
    _ (PTuple Pattern
    p1 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 Int
    0 Pattern
    p1 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    ", "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 Int
    0 Pattern
    p2
      showsPrec Int
    p (PCons Pattern
    p1 Pattern
    p2) = Bool -> ShowS -> ShowS
    showParen (Int
    pInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >Int
    5) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
        Int -> Pattern -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    6 Pattern
    p1 ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    ':'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 Int
    5 Pattern
    p2

    isOperator :: String -> Bool
    isOperator :: String -> Bool
    isOperator String
    str = String -> Char
    forall a. HasCallStack => [a] -> a
    last String
    str Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    opchars

    getInfName :: String -> String
    getInfName :: ShowS
    getInfName String
    str = if String -> Bool
    isOperator String
    str then String
    str else String
    "`"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    strString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "`"

    getPrefName :: String -> String
    getPrefName :: ShowS
    getPrefName String
    str = if String -> Bool
    isOperator String
    str Bool -> Bool -> Bool
    || Char
    ',' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    str then String
    "("String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    strString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ")" else String
    str

    instance Eq Assoc where
      Assoc
    AssocLeft  == :: Assoc -> Assoc -> Bool
    == Assoc
    AssocLeft  = Bool
    True
      Assoc
    AssocRight == Assoc
    AssocRight = Bool
    True
      Assoc
    AssocNone  == Assoc
    AssocNone  = Bool
    True
      Assoc
    _          == Assoc
    _          = Bool
    False

    {-
    instance Show Assoc where
      show AssocLeft  = "AssocLeft"
      show AssocRight = "AssocRight"
      show AssocNone  = "AssocNone"

    instance Ord Assoc where
      AssocNone <= _ = True
      _ <= AssocNone = False
      AssocLeft <= _ = True
      _ <= AssocLeft = False
      _ <= _ = True
    -}