{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

-- |
-- Module      : Jikka.Core.Format
-- Description : converts the syntax trees of core language to strings. / core 言語の構文木を文字列に変換します。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- TODO: add parens with considering precedences.
module Jikka.Core.Format
  ( run,
    formatBuiltinIsolated,
    formatBuiltin,
    formatType,
    formatExpr,
    formatToplevelExpr,
    formatProgram,
  )
where

import Data.Char (toLower)
import Data.List (intercalate)
import Data.Text (Text, pack)
import Jikka.Common.Format.AutoIndent
import Jikka.Core.Language.BuiltinPatterns (pattern Range1')
import Jikka.Core.Language.Expr
import Jikka.Core.Language.FreeVars (isUnusedVar)
import Jikka.Core.Language.LambdaPatterns
import Jikka.Core.Language.Util

-- | See also Table 2 of <https://www.haskell.org/onlinereport/decls.html Haskell Online Report, 4 Declarations and Bindings>.
newtype Prec = Prec Int
  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)

instance Enum Prec where
  toEnum :: Int -> Prec
toEnum Int
n = Int -> Prec
Prec Int
n
  fromEnum :: Prec -> Int
fromEnum (Prec Int
n) = Int
n

identPrec :: Prec
identPrec = Int -> Prec
Prec Int
12

funCallPrec :: Prec
funCallPrec = Int -> Prec
Prec Int
11

unaryPrec :: Prec
unaryPrec = Int -> Prec
Prec Int
10

powerPrec :: Prec
powerPrec = Int -> Prec
Prec Int
8

multPrec :: Prec
multPrec = Int -> Prec
Prec Int
7

addPrec :: Prec
addPrec = Int -> Prec
Prec Int
6

appendPrec :: Prec
appendPrec = Int -> Prec
Prec Int
5

comparePrec :: Prec
comparePrec = Int -> Prec
Prec Int
4

andPrec :: Prec
andPrec = Int -> Prec
Prec Int
3

orPrec :: Prec
orPrec = Int -> Prec
Prec Int
2

impliesPrec :: Prec
impliesPrec = Int -> Prec
Prec Int
1

commaPrec :: Prec
commaPrec = Int -> Prec
Prec Int
0

lambdaPrec :: Prec
lambdaPrec = Int -> Prec
Prec (-Int
1)

parenPrec :: Prec
parenPrec = Int -> Prec
Prec (-Int
2)

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
Assoc -> Int
Assoc -> [Assoc]
Assoc -> Assoc
Assoc -> Assoc -> [Assoc]
Assoc -> Assoc -> Assoc -> [Assoc]
(Assoc -> Assoc)
-> (Assoc -> Assoc)
-> (Int -> Assoc)
-> (Assoc -> Int)
-> (Assoc -> [Assoc])
-> (Assoc -> Assoc -> [Assoc])
-> (Assoc -> Assoc -> [Assoc])
-> (Assoc -> Assoc -> Assoc -> [Assoc])
-> Enum Assoc
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Assoc -> Assoc -> Assoc -> [Assoc]
$cenumFromThenTo :: Assoc -> Assoc -> Assoc -> [Assoc]
enumFromTo :: Assoc -> Assoc -> [Assoc]
$cenumFromTo :: Assoc -> Assoc -> [Assoc]
enumFromThen :: Assoc -> Assoc -> [Assoc]
$cenumFromThen :: Assoc -> Assoc -> [Assoc]
enumFrom :: Assoc -> [Assoc]
$cenumFrom :: Assoc -> [Assoc]
fromEnum :: Assoc -> Int
$cfromEnum :: Assoc -> Int
toEnum :: Int -> Assoc
$ctoEnum :: Int -> Assoc
pred :: Assoc -> Assoc
$cpred :: Assoc -> Assoc
succ :: Assoc -> Assoc
$csucc :: Assoc -> Assoc
Enum, 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)

paren :: String -> String
paren :: ShowS
paren String
s = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | `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 :: Prec -> (String, Prec) -> String
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 = ShowS
paren String
s
  | Bool
otherwise = String
s

-- | `resolvePrecLeft` inserts parens to the given string if required.
--
-- >>> resolvePrecLeft addPrec LeftToRight ("1 - 2", addPrec) ++ " - 3"
-- "1 - 2 - 3"
resolvePrecLeft :: Prec -> Assoc -> (String, Prec) -> String
resolvePrecLeft :: Prec -> Assoc -> (String, Prec) -> String
resolvePrecLeft Prec
cur Assoc
assoc (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
&& Assoc
assoc Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
/= Assoc
LeftToRight) = ShowS
paren String
s
  | Bool
otherwise = String
s

-- | `resolvePrecRight` inserts parens to the given string if required.
--
-- >>> "1 - " ++ resolvePrecRight addPrec LeftToRight ("2 - 3", addPrec)
-- "1 - (2 - 3)"
resolvePrecRight :: Prec -> Assoc -> (String, Prec) -> String
resolvePrecRight :: Prec -> Assoc -> (String, Prec) -> String
resolvePrecRight Prec
cur Assoc
assoc (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
&& Assoc
assoc Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
/= Assoc
RightToLeft) = ShowS
paren String
s
  | Bool
otherwise = String
s

formatType' :: Type -> (String, Prec)
formatType' :: Type -> (String, Prec)
formatType' = \case
  VarTy (TypeName String
a) -> (String
a, Prec
identPrec)
  Type
IntTy -> (String
"int", Prec
identPrec)
  Type
BoolTy -> (String
"bool", Prec
identPrec)
  ListTy Type
t -> (Prec -> (String, Prec) -> String
resolvePrec Prec
funCallPrec (Type -> (String, Prec)
formatType' Type
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" list", Prec
funCallPrec)
  TupleTy [Type]
ts -> case [Type]
ts of
    [] -> (String
"unit", Prec
identPrec)
    [Type
t] -> (Prec -> (String, Prec) -> String
resolvePrec Prec
funCallPrec (Type -> (String, Prec)
formatType' Type
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" one_tuple", Prec
funCallPrec)
    [Type]
_ -> (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" * " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> (String, Prec) -> String
resolvePrec (Prec -> Prec
forall a. Enum a => a -> a
pred Prec
multPrec) ((String, Prec) -> String)
-> (Type -> (String, Prec)) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (String, Prec)
formatType') [Type]
ts), Prec
multPrec)
  FunTy Type
t1 Type
t2 ->
    (Prec -> Assoc -> (String, Prec) -> String
resolvePrecLeft Prec
impliesPrec Assoc
RightToLeft (Type -> (String, Prec)
formatType' Type
t1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> Assoc -> (String, Prec) -> String
resolvePrecRight Prec
impliesPrec Assoc
RightToLeft (Type -> (String, Prec)
formatType' Type
t2), Prec
impliesPrec)
  DataStructureTy DataStructure
ds -> (DataStructure -> String
formatDataStructure DataStructure
ds, Prec
identPrec)

formatType :: Type -> String
formatType :: Type -> String
formatType = Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec ((String, Prec) -> String)
-> (Type -> (String, Prec)) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (String, Prec)
formatType'

formatDataStructure :: DataStructure -> String
formatDataStructure :: DataStructure -> String
formatDataStructure = \case
  DataStructure
ConvexHullTrick -> String
"convex_hull_trick"
  SegmentTree Semigroup'
semigrp -> String
"segment_tree<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Semigroup' -> String
formatSemigroup Semigroup'
semigrp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

formatSemigroup :: Semigroup' -> String
formatSemigroup :: Semigroup' -> String
formatSemigroup = \case
  Semigroup'
SemigroupIntPlus -> String
"int_plus"
  Semigroup'
SemigroupIntMin -> String
"int_min"
  Semigroup'
SemigroupIntMax -> String
"int_max"
  Semigroup'
SemigroupIntGcd -> String
"int_gcd"
  Semigroup'
SemigroupIntLcm -> String
"int_lcm"

data Builtin'
  = Fun String
  | PrefixOp String
  | InfixOp String Prec Assoc
  | At'
  | SetAt'
  | Tuple'
  | Proj' Integer
  | If'
  deriving (Builtin' -> Builtin' -> Bool
(Builtin' -> Builtin' -> Bool)
-> (Builtin' -> Builtin' -> Bool) -> Eq Builtin'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Builtin' -> Builtin' -> Bool
$c/= :: Builtin' -> Builtin' -> Bool
== :: Builtin' -> Builtin' -> Bool
$c== :: Builtin' -> Builtin' -> Bool
Eq, Eq Builtin'
Eq Builtin'
-> (Builtin' -> Builtin' -> Ordering)
-> (Builtin' -> Builtin' -> Bool)
-> (Builtin' -> Builtin' -> Bool)
-> (Builtin' -> Builtin' -> Bool)
-> (Builtin' -> Builtin' -> Bool)
-> (Builtin' -> Builtin' -> Builtin')
-> (Builtin' -> Builtin' -> Builtin')
-> Ord Builtin'
Builtin' -> Builtin' -> Bool
Builtin' -> Builtin' -> Ordering
Builtin' -> Builtin' -> Builtin'
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 :: Builtin' -> Builtin' -> Builtin'
$cmin :: Builtin' -> Builtin' -> Builtin'
max :: Builtin' -> Builtin' -> Builtin'
$cmax :: Builtin' -> Builtin' -> Builtin'
>= :: Builtin' -> Builtin' -> Bool
$c>= :: Builtin' -> Builtin' -> Bool
> :: Builtin' -> Builtin' -> Bool
$c> :: Builtin' -> Builtin' -> Bool
<= :: Builtin' -> Builtin' -> Bool
$c<= :: Builtin' -> Builtin' -> Bool
< :: Builtin' -> Builtin' -> Bool
$c< :: Builtin' -> Builtin' -> Bool
compare :: Builtin' -> Builtin' -> Ordering
$ccompare :: Builtin' -> Builtin' -> Ordering
$cp1Ord :: Eq Builtin'
Ord, Int -> Builtin' -> ShowS
[Builtin'] -> ShowS
Builtin' -> String
(Int -> Builtin' -> ShowS)
-> (Builtin' -> String) -> ([Builtin'] -> ShowS) -> Show Builtin'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Builtin'] -> ShowS
$cshowList :: [Builtin'] -> ShowS
show :: Builtin' -> String
$cshow :: Builtin' -> String
showsPrec :: Int -> Builtin' -> ShowS
$cshowsPrec :: Int -> Builtin' -> ShowS
Show, ReadPrec [Builtin']
ReadPrec Builtin'
Int -> ReadS Builtin'
ReadS [Builtin']
(Int -> ReadS Builtin')
-> ReadS [Builtin']
-> ReadPrec Builtin'
-> ReadPrec [Builtin']
-> Read Builtin'
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Builtin']
$creadListPrec :: ReadPrec [Builtin']
readPrec :: ReadPrec Builtin'
$creadPrec :: ReadPrec Builtin'
readList :: ReadS [Builtin']
$creadList :: ReadS [Builtin']
readsPrec :: Int -> ReadS Builtin'
$creadsPrec :: Int -> ReadS Builtin'
Read)

funMat :: String -> [Integer] -> Builtin'
funMat :: String -> [Integer] -> Builtin'
funMat String
f [Integer]
args = String -> Builtin'
Fun (String -> Builtin') -> String -> Builtin'
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"@" (String
f String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer]
args)

analyzeBuiltin :: Builtin -> Builtin'
analyzeBuiltin :: Builtin -> Builtin'
analyzeBuiltin = \case
  -- arithmetical functions
  Builtin
Negate -> String -> Builtin'
PrefixOp String
"-"
  Builtin
Plus -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"+" Prec
addPrec Assoc
LeftToRight
  Builtin
Minus -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"-" Prec
addPrec Assoc
LeftToRight
  Builtin
Mult -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"*" Prec
multPrec Assoc
LeftToRight
  Builtin
FloorDiv -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"/" Prec
multPrec Assoc
LeftToRight
  Builtin
FloorMod -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"%" Prec
multPrec Assoc
LeftToRight
  Builtin
CeilDiv -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"/^" Prec
multPrec Assoc
LeftToRight
  Builtin
CeilMod -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"%^" Prec
multPrec Assoc
LeftToRight
  Builtin
JustDiv -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"/!" Prec
multPrec Assoc
LeftToRight
  Builtin
Pow -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"**" Prec
powerPrec Assoc
RightToLeft
  -- advanced arithmetical functions
  Builtin
Abs -> String -> Builtin'
Fun String
"abs"
  Builtin
Gcd -> String -> Builtin'
Fun String
"gcd"
  Builtin
Lcm -> String -> Builtin'
Fun String
"lcm"
  Builtin
Min2 -> String -> Builtin'
Fun String
"min"
  Builtin
Max2 -> String -> Builtin'
Fun String
"max"
  -- logical functions
  Builtin
Not -> String -> Builtin'
Fun String
"not"
  Builtin
And -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"&&" Prec
andPrec Assoc
RightToLeft
  Builtin
Or -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"||" Prec
orPrec Assoc
RightToLeft
  Builtin
Implies -> String -> Builtin'
Fun String
"implies"
  Builtin
If -> Builtin'
If'
  -- bitwise functions
  Builtin
BitNot -> String -> Builtin'
PrefixOp String
"~"
  Builtin
BitAnd -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"&" Prec
multPrec Assoc
LeftToRight
  Builtin
BitOr -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"|" Prec
appendPrec Assoc
LeftToRight
  Builtin
BitXor -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"^" Prec
addPrec Assoc
LeftToRight
  Builtin
BitLeftShift -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"<<" Prec
powerPrec Assoc
LeftToRight
  Builtin
BitRightShift -> String -> Prec -> Assoc -> Builtin'
InfixOp String
">>" Prec
powerPrec Assoc
LeftToRight
  -- matrix functions
  MatAp Integer
h Integer
w -> String -> [Integer] -> Builtin'
funMat String
"matap" [Integer
h, Integer
w]
  MatZero Integer
h Integer
w -> String -> [Integer] -> Builtin'
funMat String
"matzero" [Integer
h, Integer
w]
  MatOne Integer
n -> String -> [Integer] -> Builtin'
funMat String
"matone" [Integer
n]
  MatAdd Integer
h Integer
w -> String -> [Integer] -> Builtin'
funMat String
"matadd" [Integer
h, Integer
w]
  MatMul Integer
h Integer
n Integer
w -> String -> [Integer] -> Builtin'
funMat String
"matmul" [Integer
h, Integer
n, Integer
w]
  MatPow Integer
n -> String -> [Integer] -> Builtin'
funMat String
"matpow" [Integer
n]
  VecFloorMod Integer
n -> String -> [Integer] -> Builtin'
funMat String
"vecfloormod" [Integer
n]
  MatFloorMod Integer
h Integer
w -> String -> [Integer] -> Builtin'
funMat String
"matfloormod" [Integer
h, Integer
w]
  -- modular functions
  Builtin
ModNegate -> String -> Builtin'
Fun String
"modnegate"
  Builtin
ModPlus -> String -> Builtin'
Fun String
"modplus"
  Builtin
ModMinus -> String -> Builtin'
Fun String
"modminus"
  Builtin
ModMult -> String -> Builtin'
Fun String
"modmult"
  Builtin
ModInv -> String -> Builtin'
Fun String
"modinv"
  Builtin
ModPow -> String -> Builtin'
Fun String
"modpow"
  ModMatAp Integer
h Integer
w -> String -> [Integer] -> Builtin'
funMat String
"modmatap" [Integer
h, Integer
w]
  ModMatAdd Integer
h Integer
w -> String -> [Integer] -> Builtin'
funMat String
"modmatadd" [Integer
h, Integer
w]
  ModMatMul Integer
h Integer
n Integer
w -> String -> [Integer] -> Builtin'
funMat String
"modmatmul" [Integer
h, Integer
n, Integer
w]
  ModMatPow Integer
n -> String -> [Integer] -> Builtin'
funMat String
"modmatpow" [Integer
n]
  -- list functions
  Builtin
Cons -> String -> Builtin'
Fun String
"cons"
  Builtin
Snoc -> String -> Builtin'
Fun String
"snoc"
  Builtin
Foldl -> String -> Builtin'
Fun String
"foldl"
  Builtin
Scanl -> String -> Builtin'
Fun String
"scanl"
  Builtin
Build -> String -> Builtin'
Fun String
"build"
  Builtin
Iterate -> String -> Builtin'
Fun String
"iterate"
  Builtin
Len -> String -> Builtin'
Fun String
"len"
  Builtin
Map -> String -> Builtin'
Fun String
"map"
  Builtin
Filter -> String -> Builtin'
Fun String
"filter"
  Builtin
At -> Builtin'
At'
  Builtin
SetAt -> Builtin'
SetAt'
  Builtin
Elem -> String -> Builtin'
Fun String
"elem"
  Builtin
Sum -> String -> Builtin'
Fun String
"sum"
  Builtin
Product -> String -> Builtin'
Fun String
"product"
  Builtin
ModSum -> String -> Builtin'
Fun String
"modsum"
  Builtin
ModProduct -> String -> Builtin'
Fun String
"modproduct"
  Builtin
Min1 -> String -> Builtin'
Fun String
"minimum"
  Builtin
Max1 -> String -> Builtin'
Fun String
"maximum"
  Builtin
ArgMin -> String -> Builtin'
Fun String
"argmin"
  Builtin
ArgMax -> String -> Builtin'
Fun String
"argmax"
  Builtin
Gcd1 -> String -> Builtin'
Fun String
"gcds"
  Builtin
Lcm1 -> String -> Builtin'
Fun String
"lcms"
  Builtin
All -> String -> Builtin'
Fun String
"all"
  Builtin
Any -> String -> Builtin'
Fun String
"any"
  Builtin
Sorted -> String -> Builtin'
Fun String
"sort"
  Builtin
Reversed -> String -> Builtin'
Fun String
"reverse"
  Builtin
Range1 -> String -> Builtin'
Fun String
"range"
  Builtin
Range2 -> String -> Builtin'
Fun String
"range2"
  Builtin
Range3 -> String -> Builtin'
Fun String
"range3"
  -- tuple functions
  Builtin
Tuple -> Builtin'
Tuple'
  Proj Integer
n -> Integer -> Builtin'
Proj' Integer
n
  -- comparison
  Builtin
LessThan -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"<" Prec
comparePrec Assoc
NoAssoc
  Builtin
LessEqual -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"<=" Prec
comparePrec Assoc
NoAssoc
  Builtin
GreaterThan -> String -> Prec -> Assoc -> Builtin'
InfixOp String
">" Prec
comparePrec Assoc
NoAssoc
  Builtin
GreaterEqual -> String -> Prec -> Assoc -> Builtin'
InfixOp String
">=" Prec
comparePrec Assoc
NoAssoc
  Builtin
Equal -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"==" Prec
comparePrec Assoc
NoAssoc
  Builtin
NotEqual -> String -> Prec -> Assoc -> Builtin'
InfixOp String
"!=" Prec
comparePrec Assoc
NoAssoc
  -- combinational functions
  Builtin
Fact -> String -> Builtin'
Fun String
"fact"
  Builtin
Choose -> String -> Builtin'
Fun String
"choose"
  Builtin
Permute -> String -> Builtin'
Fun String
"permute"
  Builtin
MultiChoose -> String -> Builtin'
Fun String
"multichoose"
  -- data structures
  Builtin
ConvexHullTrickInit -> String -> Builtin'
Fun String
"cht_init"
  Builtin
ConvexHullTrickGetMin -> String -> Builtin'
Fun String
"cht_getmin"
  Builtin
ConvexHullTrickInsert -> String -> Builtin'
Fun String
"cht_insert"
  SegmentTreeInitList Semigroup'
_ -> String -> Builtin'
Fun String
"segtree_initlist"
  SegmentTreeGetRange Semigroup'
_ -> String -> Builtin'
Fun String
"segtree_getrange"
  SegmentTreeSetPoint Semigroup'
_ -> String -> Builtin'
Fun String
"segtree_setpoint"

formatTemplate :: [Type] -> String
formatTemplate :: [Type] -> String
formatTemplate [Type]
ts = (Type -> String) -> [Type] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char
'@' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (Type -> String) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> String
formatType) [Type]
ts

formatFunCall :: (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall :: (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (String, Prec)
f [] = (String, Prec)
f
formatFunCall (String, Prec)
f [Expr]
args =
  let f' :: String
f' = Prec -> Assoc -> (String, Prec) -> String
resolvePrecLeft Prec
funCallPrec Assoc
LeftToRight (String, Prec)
f
      args' :: [String]
args' = (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> Assoc -> (String, Prec) -> String
resolvePrecRight Prec
funCallPrec Assoc
LeftToRight ((String, Prec) -> String)
-> (Expr -> (String, Prec)) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> (String, Prec)
formatExpr') [Expr]
args
   in ([String] -> String
unwords (String
f' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args'), Prec
funCallPrec)

formatBuiltinIsolated' :: Builtin' -> [Type] -> String
formatBuiltinIsolated' :: Builtin' -> [Type] -> String
formatBuiltinIsolated' Builtin'
builtin [Type]
ts = case Builtin'
builtin of
  Fun String
name -> String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts
  PrefixOp String
op -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts
  InfixOp String
op Prec
_ Assoc
_ -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts
  Builtin'
At' -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"at" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts
  Builtin'
SetAt' -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"set-at" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts
  Builtin'
Tuple' -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"tuple" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts
  Proj' Integer
n -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"proj-" 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]
++ [Type] -> String
formatTemplate [Type]
ts
  Builtin'
If' -> ShowS
paren ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"if-then-else" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Type] -> String
formatTemplate [Type]
ts

formatBuiltinIsolated :: Builtin -> [Type] -> String
formatBuiltinIsolated :: Builtin -> [Type] -> String
formatBuiltinIsolated Builtin
builtin [Type]
ts = Builtin' -> [Type] -> String
formatBuiltinIsolated' (Builtin -> Builtin'
analyzeBuiltin Builtin
builtin) [Type]
ts

formatBuiltin' :: Builtin -> [Type] -> [Expr] -> (String, Prec)
formatBuiltin' :: Builtin -> [Type] -> [Expr] -> (String, Prec)
formatBuiltin' Builtin
builtin [Type]
ts [Expr]
args = case (Builtin -> Builtin'
analyzeBuiltin Builtin
builtin, [Type]
ts, [Expr]
args) of
  (Fun String
"map", [Type]
_, [Lam VarName
x Type
IntTy Expr
e, Range1' Expr
n]) | VarName
x VarName -> Expr -> Bool
`isUnusedVar` Expr
e -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (String
"replicate", Prec
identPrec) [Expr
n, Expr
e]
  (Fun String
name, [Type]
_, [Expr]
_) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (String
name, Prec
identPrec) [Expr]
args
  (PrefixOp String
op, [Type]
_, Expr
e1 : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (String
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
unaryPrec (Expr -> (String, Prec)
formatExpr' Expr
e1), Prec
unaryPrec) [Expr]
args
  (InfixOp String
op Prec
prec Assoc
assoc, [Type]
_, Expr
e1 : Expr
e2 : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (Prec -> Assoc -> (String, Prec) -> String
resolvePrecLeft Prec
prec Assoc
assoc (Expr -> (String, Prec)
formatExpr' Expr
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]
++ Prec -> Assoc -> (String, Prec) -> String
resolvePrecRight Prec
prec Assoc
assoc (Expr -> (String, Prec)
formatExpr' Expr
e2), Prec
prec) [Expr]
args
  (Builtin'
At', [Type]
_, Expr
e1 : Expr
e2 : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (Prec -> (String, Prec) -> String
resolvePrec Prec
identPrec (Expr -> (String, Prec)
formatExpr' Expr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]", Prec
identPrec) [Expr]
args
  (Builtin'
SetAt', [Type]
_, Expr
e1 : Expr
e2 : Expr
e3 : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (Prec -> (String, Prec) -> String
resolvePrec Prec
identPrec (Expr -> (String, Prec)
formatExpr' Expr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e3) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]", Prec
identPrec) [Expr]
args
  (Builtin'
Tuple', [Type
_], Expr
e : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (ShowS
paren (Prec -> (String, Prec) -> String
resolvePrec Prec
commaPrec (Expr -> (String, Prec)
formatExpr' Expr
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
","), Prec
identPrec) [Expr]
args
  (Builtin'
Tuple', [Type]
_, [Expr]
args) | [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (ShowS
paren (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Prec -> (String, Prec) -> String
resolvePrec Prec
commaPrec ((String, Prec) -> String)
-> (Expr -> (String, Prec)) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> (String, Prec)
formatExpr') (Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) [Expr]
args))), Prec
identPrec) (Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
drop ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) [Expr]
args)
  (Proj' Integer
n, [Type]
_, Expr
e : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (Prec -> (String, Prec) -> String
resolvePrec Prec
identPrec (Expr -> (String, Prec)
formatExpr' Expr
e) 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, Prec
identPrec) [Expr]
args
  (Builtin'
If', [Type]
_, Expr
e1 : Expr
e2 : Expr
e3 : [Expr]
args) -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (String
"if" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" else " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
lambdaPrec (Expr -> (String, Prec)
formatExpr' Expr
e3), Prec
lambdaPrec) [Expr]
args
  (Builtin', [Type], [Expr])
_ -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (Builtin' -> [Type] -> String
formatBuiltinIsolated' (Builtin -> Builtin'
analyzeBuiltin Builtin
builtin) [Type]
ts, Prec
identPrec) [Expr]
args

formatBuiltin :: Builtin -> [Type] -> [Expr] -> String
formatBuiltin :: Builtin -> [Type] -> [Expr] -> String
formatBuiltin Builtin
f [Type]
ts [Expr]
args = Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Builtin -> [Type] -> [Expr] -> (String, Prec)
formatBuiltin' Builtin
f [Type]
ts [Expr]
args)

formatLiteral :: Literal -> String
formatLiteral :: Literal -> String
formatLiteral = \case
  LitBuiltin Builtin
builtin [Type]
ts -> Builtin -> [Type] -> String
formatBuiltinIsolated Builtin
builtin [Type]
ts
  LitInt Integer
n -> Integer -> String
forall a. Show a => a -> String
show Integer
n
  LitBool Bool
p -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
p
  LitNil Type
_ -> String
"nil"
  LitBottom Type
_ String
msg -> String
"bottom<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

formatFormalArgs :: [(VarName, Type)] -> String
formatFormalArgs :: [(VarName, Type)] -> String
formatFormalArgs [(VarName, Type)]
args = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((VarName, Type) -> String) -> [(VarName, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(VarName
x, Type
t) -> ShowS
paren (VarName -> String
unVarName VarName
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t)) [(VarName, Type)]
args

formatExpr' :: Expr -> (String, 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)
  e :: Expr
e@(App Expr
_ Expr
_) ->
    let (Expr
f, [Expr]
args) = Expr -> (Expr, [Expr])
curryApp Expr
e
     in case Expr
f of
          Var VarName
x -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (VarName -> String
unVarName VarName
x, Prec
identPrec) [Expr]
args
          Lit (LitBuiltin Builtin
builtin [Type]
ts) -> Builtin -> [Type] -> [Expr] -> (String, Prec)
formatBuiltin' Builtin
builtin [Type]
ts [Expr]
args
          Expr
_ -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (Expr -> (String, Prec)
formatExpr' Expr
f) [Expr]
args
  LamId Type
_ -> (String
"id", Prec
identPrec)
  LamConst Type
_ Expr
e -> (String, Prec) -> [Expr] -> (String, Prec)
formatFunCall (String
"const", Prec
identPrec) [Expr
e]
  e :: Expr
e@(Lam VarName
_ Type
_ Expr
_) ->
    let ([(VarName, Type)]
args, Expr
body) = Expr -> ([(VarName, Type)], Expr)
uncurryLam Expr
e
     in (String
"fun " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(VarName, Type)] -> String
formatFormalArgs [(VarName, Type)]
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ->\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
indent String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
body) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dedent String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n", Prec
lambdaPrec)
  Let VarName
x Type
t Expr
e1 Expr
e2 -> (String
"let " 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]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nin " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
lambdaPrec (Expr -> (String, Prec)
formatExpr' Expr
e2), Prec
lambdaPrec)
  Assert Expr
e1 Expr
e2 -> (String
"assert " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
lambdaPrec (Expr -> (String, Prec)
formatExpr' Expr
e2), Prec
lambdaPrec)

formatExpr :: Expr -> String
formatExpr :: Expr -> String
formatExpr = [String] -> String
unlines ([String] -> String) -> (Expr -> [String]) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
makeIndentFromMarkers Int
4 ([String] -> [String]) -> (Expr -> [String]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (Expr -> String) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec ((String, Prec) -> String)
-> (Expr -> (String, Prec)) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> (String, Prec)
formatExpr'

formatToplevelExpr' :: ToplevelExpr -> [String]
formatToplevelExpr' :: ToplevelExpr -> [String]
formatToplevelExpr' = \case
  ResultExpr Expr
e -> String -> [String]
lines (Prec -> (String, Prec) -> String
resolvePrec Prec
lambdaPrec (Expr -> (String, Prec)
formatExpr' Expr
e))
  ToplevelLet VarName
x Type
t Expr
e ToplevelExpr
cont -> String -> Type -> Expr -> ToplevelExpr -> [String]
let' (VarName -> String
unVarName VarName
x) Type
t Expr
e ToplevelExpr
cont
  ToplevelLetRec VarName
f [(VarName, Type)]
args Type
ret Expr
e ToplevelExpr
cont -> String -> Type -> Expr -> ToplevelExpr -> [String]
let' (String
"rec " 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]
++ [(VarName, Type)] -> String
formatFormalArgs [(VarName, Type)]
args) Type
ret Expr
e ToplevelExpr
cont
  ToplevelAssert Expr
e ToplevelExpr
cont -> [String
"assert " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e), String
"in"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ToplevelExpr -> [String]
formatToplevelExpr' ToplevelExpr
cont
  where
    let' :: String -> Type -> Expr -> ToplevelExpr -> [String]
let' String
s Type
t Expr
e ToplevelExpr
cont =
      [String
"let " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
formatType Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" =", String
indent]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
lines (Prec -> (String, Prec) -> String
resolvePrec Prec
parenPrec (Expr -> (String, Prec)
formatExpr' Expr
e))
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
dedent, String
"in"]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ToplevelExpr -> [String]
formatToplevelExpr' ToplevelExpr
cont

formatToplevelExpr :: ToplevelExpr -> String
formatToplevelExpr :: ToplevelExpr -> String
formatToplevelExpr = [String] -> String
unlines ([String] -> String)
-> (ToplevelExpr -> [String]) -> ToplevelExpr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
makeIndentFromMarkers Int
4 ([String] -> [String])
-> (ToplevelExpr -> [String]) -> ToplevelExpr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToplevelExpr -> [String]
formatToplevelExpr'

formatProgram :: Program -> String
formatProgram :: ToplevelExpr -> String
formatProgram = ToplevelExpr -> String
formatToplevelExpr

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