{-# LANGUAGE LambdaCase #-}

-- |
-- Module      : Jikka.CPlusPlus.Format
-- Description : converts the AST of C++ to strings. / C++ の抽象構文木を文字列に変換します。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- `Jikka.CPlusPlus.Format` module converts the AST for C++ to the plain source code.
module Jikka.CPlusPlus.Format
  ( run,
    run',
    Code,
    formatExpr,
    formatType,
  )
where

import Data.List (intercalate, isInfixOf)
import Data.Text (Text, pack)
import Jikka.CPlusPlus.Language.Expr
import Jikka.CPlusPlus.Language.Util
import Jikka.Common.Format.AutoIndent (makeIndentFromBraces)

type Code = String

-- | <https://docs.microsoft.com/en-us/cpp/cpp/cpp-built-in-operators-precedence-and-associativity>
data Prec
  = IdentPrec
  | ScopeResolutionPrec
  | -- | the precidense of function calls
    FunCallPrec
  | -- | the precidense of @!@ and @~@
    UnaryPrec
  | PointerToMemberPrec
  | -- | the precidense of @*@, @/@, and @%@
    MultPrec
  | -- | the precidense of @+@, @-@
    AddPrec
  | -- | the precidense of @<<@, @>>@
    ShiftPrec
  | -- | the precidense of @<@, @<=@, @>@, and @>=@
    LessThanPrec
  | -- | the precidense of @==@ and @!=@
    EqualPrec
  | -- | the precidense of @&@
    BitAndPrec
  | -- | the precidense of @^@
    BitXorPrec
  | -- | the precidense of @|@
    BitOrPrec
  | -- | the precidense of @&&@
    AndPrec
  | -- | the precidense of @||@
    OrPrec
  | -- | the precidense of the conditional operator @?@ and @:@
    CondPrec
  | -- | the precidense of the conditional operator @=@, @+=@, @-=@, ...
    AssignPrec
  | ThrowPrec
  | -- | the precidense of @,@
    CommaPrec
  | ParenPrec
  deriving (Prec -> Prec -> Bool
(Prec -> Prec -> Bool) -> (Prec -> Prec -> Bool) -> Eq Prec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prec -> Prec -> Bool
$c/= :: Prec -> Prec -> Bool
== :: Prec -> Prec -> Bool
$c== :: Prec -> Prec -> Bool
Eq, Eq Prec
Eq Prec
-> (Prec -> Prec -> Ordering)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Prec)
-> (Prec -> Prec -> Prec)
-> Ord Prec
Prec -> Prec -> Bool
Prec -> Prec -> Ordering
Prec -> Prec -> Prec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Prec -> Prec -> Prec
$cmin :: Prec -> Prec -> Prec
max :: Prec -> Prec -> Prec
$cmax :: Prec -> Prec -> Prec
>= :: Prec -> Prec -> Bool
$c>= :: Prec -> Prec -> Bool
> :: Prec -> Prec -> Bool
$c> :: Prec -> Prec -> Bool
<= :: Prec -> Prec -> Bool
$c<= :: Prec -> Prec -> Bool
< :: Prec -> Prec -> Bool
$c< :: Prec -> Prec -> Bool
compare :: Prec -> Prec -> Ordering
$ccompare :: Prec -> Prec -> Ordering
$cp1Ord :: Eq Prec
Ord, Int -> Prec -> ShowS
[Prec] -> ShowS
Prec -> String
(Int -> Prec -> ShowS)
-> (Prec -> String) -> ([Prec] -> ShowS) -> Show Prec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prec] -> ShowS
$cshowList :: [Prec] -> ShowS
show :: Prec -> String
$cshow :: Prec -> String
showsPrec :: Int -> Prec -> ShowS
$cshowsPrec :: Int -> Prec -> ShowS
Show, ReadPrec [Prec]
ReadPrec Prec
Int -> ReadS Prec
ReadS [Prec]
(Int -> ReadS Prec)
-> ReadS [Prec] -> ReadPrec Prec -> ReadPrec [Prec] -> Read Prec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Prec]
$creadListPrec :: ReadPrec [Prec]
readPrec :: ReadPrec Prec
$creadPrec :: ReadPrec Prec
readList :: ReadS [Prec]
$creadList :: ReadS [Prec]
readsPrec :: Int -> ReadS Prec
$creadsPrec :: Int -> ReadS Prec
Read)

data Assoc
  = NoAssoc
  | LeftToRight
  | RightToLeft
  deriving (Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c== :: Assoc -> Assoc -> Bool
Eq, Eq Assoc
Eq Assoc
-> (Assoc -> Assoc -> Ordering)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Assoc)
-> (Assoc -> Assoc -> Assoc)
-> Ord Assoc
Assoc -> Assoc -> Bool
Assoc -> Assoc -> Ordering
Assoc -> Assoc -> Assoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Assoc -> Assoc -> Assoc
$cmin :: Assoc -> Assoc -> Assoc
max :: Assoc -> Assoc -> Assoc
$cmax :: Assoc -> Assoc -> Assoc
>= :: Assoc -> Assoc -> Bool
$c>= :: Assoc -> Assoc -> Bool
> :: Assoc -> Assoc -> Bool
$c> :: Assoc -> Assoc -> Bool
<= :: Assoc -> Assoc -> Bool
$c<= :: Assoc -> Assoc -> Bool
< :: Assoc -> Assoc -> Bool
$c< :: Assoc -> Assoc -> Bool
compare :: Assoc -> Assoc -> Ordering
$ccompare :: Assoc -> Assoc -> Ordering
$cp1Ord :: Eq Assoc
Ord, Int -> Assoc -> ShowS
[Assoc] -> ShowS
Assoc -> String
(Int -> Assoc -> ShowS)
-> (Assoc -> String) -> ([Assoc] -> ShowS) -> Show Assoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assoc] -> ShowS
$cshowList :: [Assoc] -> ShowS
show :: Assoc -> String
$cshow :: Assoc -> String
showsPrec :: Int -> Assoc -> ShowS
$cshowsPrec :: Int -> Assoc -> ShowS
Show, ReadPrec [Assoc]
ReadPrec Assoc
Int -> ReadS Assoc
ReadS [Assoc]
(Int -> ReadS Assoc)
-> ReadS [Assoc]
-> ReadPrec Assoc
-> ReadPrec [Assoc]
-> Read Assoc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Assoc]
$creadListPrec :: ReadPrec [Assoc]
readPrec :: ReadPrec Assoc
$creadPrec :: ReadPrec Assoc
readList :: ReadS [Assoc]
$creadList :: ReadS [Assoc]
readsPrec :: Int -> ReadS Assoc
$creadsPrec :: Int -> ReadS Assoc
Read)

assocOf :: Prec -> Assoc
assocOf :: Prec -> Assoc
assocOf = \case
  Prec
IdentPrec -> Assoc
NoAssoc
  Prec
ScopeResolutionPrec -> Assoc
NoAssoc
  Prec
FunCallPrec -> Assoc
LeftToRight
  Prec
UnaryPrec -> Assoc
RightToLeft
  Prec
PointerToMemberPrec -> Assoc
LeftToRight
  Prec
MultPrec -> Assoc
LeftToRight
  Prec
AddPrec -> Assoc
LeftToRight
  Prec
ShiftPrec -> Assoc
LeftToRight
  Prec
LessThanPrec -> Assoc
LeftToRight
  Prec
EqualPrec -> Assoc
LeftToRight
  Prec
BitAndPrec -> Assoc
LeftToRight
  Prec
BitXorPrec -> Assoc
LeftToRight
  Prec
BitOrPrec -> Assoc
LeftToRight
  Prec
AndPrec -> Assoc
LeftToRight
  Prec
OrPrec -> Assoc
LeftToRight
  Prec
CondPrec -> Assoc
RightToLeft
  Prec
AssignPrec -> Assoc
RightToLeft
  Prec
ThrowPrec -> Assoc
RightToLeft
  Prec
CommaPrec -> Assoc
LeftToRight
  Prec
ParenPrec -> Assoc
NoAssoc

formatUnaryOp :: UnaryOp -> (Code, Prec)
formatUnaryOp :: UnaryOp -> (String, Prec)
formatUnaryOp = \case
  UnaryOp
IntNop -> (String
"+", Prec
UnaryPrec)
  UnaryOp
Negate -> (String
"-", Prec
UnaryPrec)
  UnaryOp
BitNot -> (String
"~", Prec
UnaryPrec)
  UnaryOp
Not -> (String
"not", Prec
UnaryPrec)
  UnaryOp
Deref -> (String
"*", Prec
UnaryPrec)

formatBinaryOp :: BinaryOp -> (Code, Prec)
formatBinaryOp :: BinaryOp -> (String, Prec)
formatBinaryOp = \case
  BinaryOp
Add -> (String
"+", Prec
AddPrec)
  BinaryOp
Sub -> (String
"-", Prec
AddPrec)
  BinaryOp
Mul -> (String
"*", Prec
MultPrec)
  BinaryOp
Div -> (String
"/", Prec
MultPrec)
  BinaryOp
Mod -> (String
"%", Prec
MultPrec)
  BinaryOp
BitLeftShift -> (String
"<<", Prec
ShiftPrec)
  BinaryOp
BitRightShift -> (String
">>", Prec
ShiftPrec)
  BinaryOp
LessThan -> (String
"<", Prec
LessThanPrec)
  BinaryOp
LessEqual -> (String
"<=", Prec
LessThanPrec)
  BinaryOp
GreaterThan -> (String
">", Prec
LessThanPrec)
  BinaryOp
GreaterEqual -> (String
">=", Prec
LessThanPrec)
  BinaryOp
Equal -> (String
"==", Prec
EqualPrec)
  BinaryOp
NotEqual -> (String
"!=", Prec
EqualPrec)
  BinaryOp
BitAnd -> (String
"&", Prec
BitAndPrec)
  BinaryOp
BitXor -> (String
"^", Prec
BitXorPrec)
  BinaryOp
BitOr -> (String
"|", Prec
BitOrPrec)
  BinaryOp
And -> (String
"and", Prec
AndPrec)
  BinaryOp
Or -> (String
"or", Prec
OrPrec)

formatAssignOp :: AssignOp -> (Code, Prec)
formatAssignOp :: AssignOp -> (String, Prec)
formatAssignOp = \case
  AssignOp
SimpleAssign -> (String
"=", Prec
AssignPrec)
  AssignOp
AddAssign -> (String
"+=", Prec
AssignPrec)
  AssignOp
SubAssign -> (String
"-=", Prec
AssignPrec)
  AssignOp
MulAssign -> (String
"*=", Prec
AssignPrec)
  AssignOp
DivAssign -> (String
"/=", Prec
AssignPrec)
  AssignOp
ModAssign -> (String
"%=", Prec
AssignPrec)
  AssignOp
BitLeftShiftAssign -> (String
"<<=", Prec
AssignPrec)
  AssignOp
BitRightShiftAssign -> (String
">>=", Prec
AssignPrec)
  AssignOp
BitAndAssign -> (String
"&=", Prec
AssignPrec)
  AssignOp
BitOrAssign -> (String
"|=", Prec
AssignPrec)
  AssignOp
BitXorAssign -> (String
"^=", Prec
AssignPrec)

-- | `resolvePrec` inserts parens to the given string if required.
--
-- >>> resolvePrec MultPrec ("1 + 2", AddPrec) ++ " * 3"
-- "(1 + 2) * 3"
--
-- >>> resolvePrec AddPrec ("1 * 2", MultPrec) ++ " + 3"
-- "1 * 2 + 3"
--
-- >>> resolvePrec CommaPrec ("1, 2", CommaPrec) ++ ", 3"
-- "1, 2, 3"
resolvePrec :: Prec -> (Code, Prec) -> Code
resolvePrec :: Prec -> (String, Prec) -> String
resolvePrec Prec
cur (String
s, Prec
prv)
  | Prec
cur Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
< Prec
prv = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  | Bool
otherwise = String
s

-- | `resolvePrecLeft` inserts parens to the given string if required.
--
-- >>> resolvePrecLeft AddPrec ("1 - 2", AddPrec) ++ " - 3"
-- "1 - 2 - 3"
resolvePrecLeft :: Prec -> (Code, Prec) -> Code
resolvePrecLeft :: Prec -> (String, Prec) -> String
resolvePrecLeft Prec
cur (String
s, Prec
prv)
  | Prec
cur Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
< Prec
prv Bool -> Bool -> Bool
|| (Prec
cur Prec -> Prec -> Bool
forall a. Eq a => a -> a -> Bool
== Prec
prv Bool -> Bool -> Bool
&& Prec -> Assoc
assocOf Prec
cur Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
/= Assoc
LeftToRight) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  | Bool
otherwise = String
s

-- | `resolvePrecRight` inserts parens to the given string if required.
--
-- >>> "1 - " ++ resolvePrecRight AddPrec ("2 - 3", AddPrec)
-- "1 - (2 - 3)"
resolvePrecRight :: Prec -> (Code, Prec) -> Code
resolvePrecRight :: Prec -> (String, Prec) -> String
resolvePrecRight Prec
cur (String
s, Prec
prv)
  | Prec
cur Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
< Prec
prv Bool -> Bool -> Bool
|| (Prec
cur Prec -> Prec -> Bool
forall a. Eq a => a -> a -> Bool
== Prec
prv Bool -> Bool -> Bool
&& Prec -> Assoc
assocOf Prec
cur Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
/= Assoc
RightToLeft) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  | Bool
otherwise = String
s

formatType :: Type -> Code
formatType :: Type -> String
formatType = \case
  Type
TyAuto -> String
"auto"
  Type
TyVoid -> String
"void"
  Type
TyInt -> String
"int"
  Type
TyInt32 -> String
"int32_t"
  Type
TyInt64 -> String
"int64_t"
  Type
TyBool -> String
"bool"
  TyTuple [Type]
ts -> String
"std::tuple<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
formatType [Type]
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  TyVector Type
t -> String
"std::vector<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  TyArray Type
t Integer
n -> String
"std::array<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  Type
TyString -> String
"std::string"
  TyFunction Type
t [Type]
ts -> String
"std::function<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
formatType [Type]
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")>"
  Type
TyConvexHullTrick -> String
"jikka::convex_hull_trick"
  TySegmentTree Monoid'
mon -> case Monoid'
mon of
    Monoid'
MonoidIntPlus -> String
"atcoder::segtree<int64_t, jikka::plus_int64_t, jikka::const_zero>"
    Monoid'
MonoidIntMin -> String
"atcoder::segtree<int64_t, jikka::min_int64_t, jikka::const_int64_max>"
    Monoid'
MonoidIntMax -> String
"atcoder::segtree<int64_t, jikka::max_int64_t, jikka::const_int64_min>"
  TyIntValue Integer
n -> Integer -> String
forall a. Show a => a -> String
show Integer
n

formatLiteral :: Literal -> Code
formatLiteral :: Literal -> String
formatLiteral = \case
  LitInt32 Integer
n -> Integer -> String
forall a. Show a => a -> String
show Integer
n
  LitInt64 Integer
n -> Integer -> String
forall a. Show a => a -> String
show Integer
n
  LitBool Bool
p -> if Bool
p then String
"true" else String
"false"
  LitChar Char
c -> Char -> String
forall a. Show a => a -> String
show Char
c
  LitString String
s -> ShowS
forall a. Show a => a -> String
show String
s

formatExpr' :: Prec -> Expr -> Code
formatExpr' :: Prec -> Expr -> String
formatExpr' Prec
prec = Prec -> (String, Prec) -> String
resolvePrec Prec
prec ((String, Prec) -> String)
-> (Expr -> (String, Prec)) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> (String, Prec)
formatExpr

formatExpr :: Expr -> (Code, Prec)
formatExpr :: Expr -> (String, Prec)
formatExpr = \case
  Var VarName
x -> (VarName -> String
unVarName VarName
x, Prec
IdentPrec)
  Lit Literal
lit -> (Literal -> String
formatLiteral Literal
lit, Prec
IdentPrec)
  UnOp UnaryOp
op Expr
e ->
    let (String
op', Prec
prec) = UnaryOp -> (String, Prec)
formatUnaryOp UnaryOp
op
        e' :: String
e' = Prec -> Expr -> String
formatExpr' Prec
prec Expr
e
     in (String
op' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e', Prec
prec)
  BinOp BinaryOp
op Expr
e1 Expr
e2 ->
    let (String
op', Prec
prec) = BinaryOp -> (String, Prec)
formatBinaryOp BinaryOp
op
        e1' :: String
e1' = Prec -> (String, Prec) -> String
resolvePrecLeft Prec
prec (Expr -> (String, Prec)
formatExpr Expr
e1)
        e2' :: String
e2' = Prec -> (String, Prec) -> String
resolvePrecRight Prec
prec (Expr -> (String, Prec)
formatExpr Expr
e2)
     in (String
e1' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
op' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e2', Prec
prec)
  Lam [(Type, VarName)]
args Type
ret [Statement]
body ->
    let args' :: [String]
args' = ((Type, VarName) -> String) -> [(Type, VarName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Type
t, VarName
x) -> Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x) [(Type, VarName)]
args
        ret' :: String
ret' = Type -> String
formatType Type
ret
        body' :: [String]
body' = (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body
     in (String
"[=](" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
args' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ret' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"{ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
body' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" }", Prec
FunCallPrec)
  Call Function
f [Expr]
args ->
    let args' :: String
args' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> Expr -> String
formatExpr' Prec
CommaPrec) [Expr]
args)
        call :: String -> (String, Prec)
call String
f = (String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")", Prec
FunCallPrec)
        method :: String -> (String, Prec)
method String
f = case [Expr]
args of
          [] -> String -> (String, Prec)
forall a. HasCallStack => String -> a
error (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ String
"Jikka.CPlusPlus.Language.Format.formatExpr: no receiver for method: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f
          Expr
e : [Expr]
args -> (Prec -> Expr -> String
formatExpr' Prec
FunCallPrec Expr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> Expr -> String
formatExpr' Prec
CommaPrec) [Expr]
args) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")", Prec
FunCallPrec)
     in case Function
f of
          Function FunName
f [Type]
ts -> String -> (String, Prec)
call (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ FunName -> String
unFunName FunName
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
ts then String
"" else String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
formatType [Type]
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">")
          Method FunName
f -> String -> (String, Prec)
method (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ FunName -> String
unFunName FunName
f
          Function
At -> case [Expr]
args of
            [Expr
e1, Expr
e2] ->
              let e1' :: String
e1' = Prec -> Expr -> String
formatExpr' Prec
FunCallPrec Expr
e1
                  e2' :: String
e2' = Prec -> Expr -> String
formatExpr' Prec
FunCallPrec Expr
e2
               in (String
e1' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e2' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]", Prec
FunCallPrec)
            [Expr]
_ -> String -> (String, Prec)
forall a. HasCallStack => String -> a
error (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ String
"Jikka.CPlusPlus.Language.Format.formatExpr: wrong number of arguments for subscription: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args)
          Cast Type
t -> String -> (String, Prec)
call (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ Type -> String
formatType Type
t
          StdTuple [Type]
ts -> String -> (String, Prec)
call (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ String
"std::tuple<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
formatType [Type]
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
          StdGet Integer
n -> String -> (String, Prec)
call (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ String
"std::get<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
          ArrayExt Type
t -> (String
"std::array<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}", Prec
IdentPrec)
          VecExt Type
t -> (String
"std::vector<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}", Prec
IdentPrec)
          VecCtor Type
t -> String -> (String, Prec)
call (String -> (String, Prec)) -> String -> (String, Prec)
forall a b. (a -> b) -> a -> b
$ String
"std::vector<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
          Function
Range -> String -> (String, Prec)
call String
"jikka::range"
          Function
MethodSize -> String -> (String, Prec)
method String
"size"
          Function
ConvexHullTrickCtor -> String -> (String, Prec)
call String
"jikka::convex_hull_trick"
          Function
ConvexHullTrickCopyAddLine -> String -> (String, Prec)
call String
"jikka::convex_hull_trick::add_line"
          SegmentTreeCtor Monoid'
mon -> String -> (String, Prec)
call (Type -> String
formatType (Monoid' -> Type
TySegmentTree Monoid'
mon))
          SegmentTreeCopySetPoint Monoid'
_ -> String -> (String, Prec)
call String
"jikka::segment_tree_set"
  CallExpr Expr
f [Expr]
args ->
    let f' :: String
f' = Prec -> Expr -> String
formatExpr' Prec
FunCallPrec Expr
f
        args' :: String
args' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> Expr -> String
formatExpr' Prec
CommaPrec) [Expr]
args)
     in (String
f' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")", Prec
FunCallPrec)
  Cond Expr
e1 Expr
e2 Expr
e3 ->
    let e1' :: String
e1' = Prec -> (String, Prec) -> String
resolvePrecLeft Prec
CondPrec (Expr -> (String, Prec)
formatExpr Expr
e1)
        e2' :: String
e2' = Prec -> (String, Prec) -> String
resolvePrec Prec
CondPrec (Expr -> (String, Prec)
formatExpr Expr
e2)
        e3' :: String
e3' = Prec -> (String, Prec) -> String
resolvePrecRight Prec
CondPrec (Expr -> (String, Prec)
formatExpr Expr
e3)
     in (String
e1' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ? " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e2' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e3', Prec
CondPrec)

formatLeftExpr :: LeftExpr -> (Code, Prec)
formatLeftExpr :: LeftExpr -> (String, Prec)
formatLeftExpr = Expr -> (String, Prec)
formatExpr (Expr -> (String, Prec))
-> (LeftExpr -> Expr) -> LeftExpr -> (String, Prec)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeftExpr -> Expr
fromLeftExpr

formatAssignExpr :: AssignExpr -> (Code, Prec)
formatAssignExpr :: AssignExpr -> (String, Prec)
formatAssignExpr = \case
  AssignExpr AssignOp
op LeftExpr
e1 Expr
e2 ->
    let (String
op', Prec
prec) = AssignOp -> (String, Prec)
formatAssignOp AssignOp
op
        e1' :: String
e1' = Prec -> (String, Prec) -> String
resolvePrecLeft Prec
prec (LeftExpr -> (String, Prec)
formatLeftExpr LeftExpr
e1)
        e2' :: String
e2' = Prec -> (String, Prec) -> String
resolvePrecRight Prec
prec (Expr -> (String, Prec)
formatExpr Expr
e2)
     in (String
e1' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
op' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e2', Prec
AssignPrec)
  AssignIncr LeftExpr
e -> (String
"++ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
UnaryPrec (LeftExpr -> (String, Prec)
formatLeftExpr LeftExpr
e), Prec
UnaryPrec)
  AssignDecr LeftExpr
e -> (String
"-- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
UnaryPrec (LeftExpr -> (String, Prec)
formatLeftExpr LeftExpr
e), Prec
UnaryPrec)

formatStatement :: Statement -> [Code]
formatStatement :: Statement -> [String]
formatStatement = \case
  ExprStatement Expr
e -> [Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
  Block [Statement]
stmts -> [String
"{"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
stmts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
  If Expr
e [Statement]
body1 Maybe [Statement]
body2 ->
    let e' :: String
e' = Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
e
        body1' :: [String]
body1' = (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body1
     in case Maybe [Statement]
body2 of
          Maybe [Statement]
Nothing -> [String
"if (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body1' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
          Just [Statement]
body2 -> case (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body2 of
            ((Char
'i' : Char
'f' : Char
' ' : Char
'(' : String
line) : [String]
lines) -> [String
"if (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body1' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"} else if (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
lines
            [String]
body2 -> [String
"if (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body1' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"} else {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
  For Type
t VarName
x Expr
init Expr
cond AssignExpr
incr [Statement]
body ->
    let t' :: String
t' = Type -> String
formatType Type
t
        init' :: String
init' = Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
init
        cond' :: String
cond' = Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
cond
        incr' :: String
incr' = Prec -> (String, Prec) -> String
resolvePrec Prec
ParenPrec ((String, Prec) -> String) -> (String, Prec) -> String
forall a b. (a -> b) -> a -> b
$ AssignExpr -> (String, Prec)
formatAssignExpr AssignExpr
incr
        body' :: [String]
body' = (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body
     in [String
"for (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
init' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cond' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
incr' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
  ForEach Type
t VarName
x Expr
xs [Statement]
body ->
    let t' :: String
t' = Type -> String
formatType Type
t
        xs' :: String
xs' = Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
xs
        body' :: [String]
body' = (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body
     in [String
"for (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
  While Expr
cond [Statement]
body ->
    let cond' :: String
cond' = Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
cond
        body' :: [String]
body' = (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body
     in [String
"while (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cond' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
  Declare Type
t VarName
x DeclareRight
init ->
    let t' :: String
t' = Type -> String
formatType Type
t
        init' :: String
init' = case DeclareRight
init of
          DeclareRight
DeclareDefault -> String
""
          DeclareCopy Expr
e -> String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrecRight Prec
AssignPrec (Expr -> (String, Prec)
formatExpr Expr
e)
          DeclareInitialize [Expr]
es -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> Expr -> String
formatExpr' Prec
CommaPrec) [Expr]
es) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
     in [String
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
init' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
  DeclareDestructure [VarName]
xs Expr
e -> [String
"auto [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((VarName -> String) -> [VarName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> String
unVarName [VarName]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrecRight Prec
AssignPrec (Expr -> (String, Prec)
formatExpr Expr
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
  Assign AssignExpr
e -> [Prec -> (String, Prec) -> String
resolvePrec Prec
ParenPrec (AssignExpr -> (String, Prec)
formatAssignExpr AssignExpr
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
  Assert Expr
e -> [String
"assert (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");"]
  Return Expr
e -> [String
"return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> Expr -> String
formatExpr' Prec
ParenPrec Expr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]

formatToplevelStatement :: ToplevelStatement -> [Code]
formatToplevelStatement :: ToplevelStatement -> [String]
formatToplevelStatement = \case
  VarDef Type
t VarName
x Expr
e -> [Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrecRight Prec
AssignPrec (Expr -> (String, Prec)
formatExpr Expr
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
  FunDef Type
ret VarName
f [(Type, VarName)]
args [Statement]
body ->
    let ret' :: String
ret' = Type -> String
formatType Type
ret
        args' :: String
args' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Type, VarName) -> String) -> [(Type, VarName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Type
t, VarName
x) -> Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x) [(Type, VarName)]
args
        body' :: [String]
body' = (Statement -> [String]) -> [Statement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement -> [String]
formatStatement [Statement]
body
     in [String
ret' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]

formatProgram :: Program -> [Code]
formatProgram :: Program -> [String]
formatProgram Program
prog =
  let body :: [String]
body = (ToplevelStatement -> [String]) -> [ToplevelStatement] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ToplevelStatement -> [String]
formatToplevelStatement (Program -> [ToplevelStatement]
decls Program
prog)
      standardHeaders :: [String]
standardHeaders =
        [ String
"#include <algorithm>",
          String
"#include <array>",
          String
"#include <cstdint>",
          String
"#include <functional>",
          String
"#include <iostream>",
          String
"#include <numeric>",
          String
"#include <string>",
          String
"#include <tuple>",
          String
"#include <vector>"
        ]
      additionalHeader :: [String]
additionalHeader =
        ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$
          ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter
            (\(String
key, String
_) -> String
key String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [String] -> String
unlines [String]
body)
            [ (String
"jikka::", String
"#include \"jikka/base.hpp\""),
              (String
"jikka::convex_hull_trick", String
"#include \"jikka/convex_hull_trick.hpp\""),
              (String
"atcoder::segtree", String
"#include \"jikka/segment_tree.hpp\""),
              (String
"atcoder::segtree", String
"#include <atcoder/segtree>")
            ]
   in [String]
standardHeaders [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
additionalHeader [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body

run' :: Program -> String
run' :: Program -> String
run' = [String] -> String
unlines ([String] -> String) -> (Program -> [String]) -> Program -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
makeIndentFromBraces Int
4 ([String] -> [String])
-> (Program -> [String]) -> Program -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> [String]
formatProgram

run :: Applicative m => Program -> m Text
run :: Program -> m Text
run = Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> (Program -> Text) -> Program -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Program -> String) -> Program -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
run'