{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
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
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 :: 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 :: 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 :: 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
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
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"
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'
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
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]
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]
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"
Builtin
Tuple -> Builtin'
Tuple'
Proj Integer
n -> Integer -> Builtin'
Proj' Integer
n
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
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"
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