{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

module Jikka.Common.IOFormat where

import Control.Arrow
import Control.Monad.Identity
import Data.IORef
import Data.List
import qualified Data.Map as M
import qualified Data.Vector as V
import Jikka.Common.Error
import Jikka.Common.IO (hGetWord)
import System.IO (stdin)
import Text.Read (readMaybe)

data FormatExpr
  = Var String
  | Plus FormatExpr Integer
  | At FormatExpr String
  | Len FormatExpr
  deriving (FormatExpr -> FormatExpr -> Bool
(FormatExpr -> FormatExpr -> Bool)
-> (FormatExpr -> FormatExpr -> Bool) -> Eq FormatExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatExpr -> FormatExpr -> Bool
$c/= :: FormatExpr -> FormatExpr -> Bool
== :: FormatExpr -> FormatExpr -> Bool
$c== :: FormatExpr -> FormatExpr -> Bool
Eq, Eq FormatExpr
Eq FormatExpr
-> (FormatExpr -> FormatExpr -> Ordering)
-> (FormatExpr -> FormatExpr -> Bool)
-> (FormatExpr -> FormatExpr -> Bool)
-> (FormatExpr -> FormatExpr -> Bool)
-> (FormatExpr -> FormatExpr -> Bool)
-> (FormatExpr -> FormatExpr -> FormatExpr)
-> (FormatExpr -> FormatExpr -> FormatExpr)
-> Ord FormatExpr
FormatExpr -> FormatExpr -> Bool
FormatExpr -> FormatExpr -> Ordering
FormatExpr -> FormatExpr -> FormatExpr
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 :: FormatExpr -> FormatExpr -> FormatExpr
$cmin :: FormatExpr -> FormatExpr -> FormatExpr
max :: FormatExpr -> FormatExpr -> FormatExpr
$cmax :: FormatExpr -> FormatExpr -> FormatExpr
>= :: FormatExpr -> FormatExpr -> Bool
$c>= :: FormatExpr -> FormatExpr -> Bool
> :: FormatExpr -> FormatExpr -> Bool
$c> :: FormatExpr -> FormatExpr -> Bool
<= :: FormatExpr -> FormatExpr -> Bool
$c<= :: FormatExpr -> FormatExpr -> Bool
< :: FormatExpr -> FormatExpr -> Bool
$c< :: FormatExpr -> FormatExpr -> Bool
compare :: FormatExpr -> FormatExpr -> Ordering
$ccompare :: FormatExpr -> FormatExpr -> Ordering
$cp1Ord :: Eq FormatExpr
Ord, ReadPrec [FormatExpr]
ReadPrec FormatExpr
Int -> ReadS FormatExpr
ReadS [FormatExpr]
(Int -> ReadS FormatExpr)
-> ReadS [FormatExpr]
-> ReadPrec FormatExpr
-> ReadPrec [FormatExpr]
-> Read FormatExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormatExpr]
$creadListPrec :: ReadPrec [FormatExpr]
readPrec :: ReadPrec FormatExpr
$creadPrec :: ReadPrec FormatExpr
readList :: ReadS [FormatExpr]
$creadList :: ReadS [FormatExpr]
readsPrec :: Int -> ReadS FormatExpr
$creadsPrec :: Int -> ReadS FormatExpr
Read, Int -> FormatExpr -> ShowS
[FormatExpr] -> ShowS
FormatExpr -> String
(Int -> FormatExpr -> ShowS)
-> (FormatExpr -> String)
-> ([FormatExpr] -> ShowS)
-> Show FormatExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatExpr] -> ShowS
$cshowList :: [FormatExpr] -> ShowS
show :: FormatExpr -> String
$cshow :: FormatExpr -> String
showsPrec :: Int -> FormatExpr -> ShowS
$cshowsPrec :: Int -> FormatExpr -> ShowS
Show)

data FormatTree
  = Exp FormatExpr
  | Newline
  | Seq [FormatTree]
  | Loop String FormatExpr FormatTree
  deriving (FormatTree -> FormatTree -> Bool
(FormatTree -> FormatTree -> Bool)
-> (FormatTree -> FormatTree -> Bool) -> Eq FormatTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatTree -> FormatTree -> Bool
$c/= :: FormatTree -> FormatTree -> Bool
== :: FormatTree -> FormatTree -> Bool
$c== :: FormatTree -> FormatTree -> Bool
Eq, Eq FormatTree
Eq FormatTree
-> (FormatTree -> FormatTree -> Ordering)
-> (FormatTree -> FormatTree -> Bool)
-> (FormatTree -> FormatTree -> Bool)
-> (FormatTree -> FormatTree -> Bool)
-> (FormatTree -> FormatTree -> Bool)
-> (FormatTree -> FormatTree -> FormatTree)
-> (FormatTree -> FormatTree -> FormatTree)
-> Ord FormatTree
FormatTree -> FormatTree -> Bool
FormatTree -> FormatTree -> Ordering
FormatTree -> FormatTree -> FormatTree
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 :: FormatTree -> FormatTree -> FormatTree
$cmin :: FormatTree -> FormatTree -> FormatTree
max :: FormatTree -> FormatTree -> FormatTree
$cmax :: FormatTree -> FormatTree -> FormatTree
>= :: FormatTree -> FormatTree -> Bool
$c>= :: FormatTree -> FormatTree -> Bool
> :: FormatTree -> FormatTree -> Bool
$c> :: FormatTree -> FormatTree -> Bool
<= :: FormatTree -> FormatTree -> Bool
$c<= :: FormatTree -> FormatTree -> Bool
< :: FormatTree -> FormatTree -> Bool
$c< :: FormatTree -> FormatTree -> Bool
compare :: FormatTree -> FormatTree -> Ordering
$ccompare :: FormatTree -> FormatTree -> Ordering
$cp1Ord :: Eq FormatTree
Ord, ReadPrec [FormatTree]
ReadPrec FormatTree
Int -> ReadS FormatTree
ReadS [FormatTree]
(Int -> ReadS FormatTree)
-> ReadS [FormatTree]
-> ReadPrec FormatTree
-> ReadPrec [FormatTree]
-> Read FormatTree
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormatTree]
$creadListPrec :: ReadPrec [FormatTree]
readPrec :: ReadPrec FormatTree
$creadPrec :: ReadPrec FormatTree
readList :: ReadS [FormatTree]
$creadList :: ReadS [FormatTree]
readsPrec :: Int -> ReadS FormatTree
$creadsPrec :: Int -> ReadS FormatTree
Read, Int -> FormatTree -> ShowS
[FormatTree] -> ShowS
FormatTree -> String
(Int -> FormatTree -> ShowS)
-> (FormatTree -> String)
-> ([FormatTree] -> ShowS)
-> Show FormatTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatTree] -> ShowS
$cshowList :: [FormatTree] -> ShowS
show :: FormatTree -> String
$cshow :: FormatTree -> String
showsPrec :: Int -> FormatTree -> ShowS
$cshowsPrec :: Int -> FormatTree -> ShowS
Show)

data IOFormat = IOFormat
  { IOFormat -> [String]
inputVariables :: [String],
    IOFormat -> FormatTree
inputTree :: FormatTree,
    -- | This uses `Either` to distinguish a type and the 1-tuple of it.
    IOFormat -> Either String [String]
outputVariables :: Either String [String],
    IOFormat -> FormatTree
outputTree :: FormatTree
  }
  deriving (IOFormat -> IOFormat -> Bool
(IOFormat -> IOFormat -> Bool)
-> (IOFormat -> IOFormat -> Bool) -> Eq IOFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IOFormat -> IOFormat -> Bool
$c/= :: IOFormat -> IOFormat -> Bool
== :: IOFormat -> IOFormat -> Bool
$c== :: IOFormat -> IOFormat -> Bool
Eq, Eq IOFormat
Eq IOFormat
-> (IOFormat -> IOFormat -> Ordering)
-> (IOFormat -> IOFormat -> Bool)
-> (IOFormat -> IOFormat -> Bool)
-> (IOFormat -> IOFormat -> Bool)
-> (IOFormat -> IOFormat -> Bool)
-> (IOFormat -> IOFormat -> IOFormat)
-> (IOFormat -> IOFormat -> IOFormat)
-> Ord IOFormat
IOFormat -> IOFormat -> Bool
IOFormat -> IOFormat -> Ordering
IOFormat -> IOFormat -> IOFormat
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 :: IOFormat -> IOFormat -> IOFormat
$cmin :: IOFormat -> IOFormat -> IOFormat
max :: IOFormat -> IOFormat -> IOFormat
$cmax :: IOFormat -> IOFormat -> IOFormat
>= :: IOFormat -> IOFormat -> Bool
$c>= :: IOFormat -> IOFormat -> Bool
> :: IOFormat -> IOFormat -> Bool
$c> :: IOFormat -> IOFormat -> Bool
<= :: IOFormat -> IOFormat -> Bool
$c<= :: IOFormat -> IOFormat -> Bool
< :: IOFormat -> IOFormat -> Bool
$c< :: IOFormat -> IOFormat -> Bool
compare :: IOFormat -> IOFormat -> Ordering
$ccompare :: IOFormat -> IOFormat -> Ordering
$cp1Ord :: Eq IOFormat
Ord, ReadPrec [IOFormat]
ReadPrec IOFormat
Int -> ReadS IOFormat
ReadS [IOFormat]
(Int -> ReadS IOFormat)
-> ReadS [IOFormat]
-> ReadPrec IOFormat
-> ReadPrec [IOFormat]
-> Read IOFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IOFormat]
$creadListPrec :: ReadPrec [IOFormat]
readPrec :: ReadPrec IOFormat
$creadPrec :: ReadPrec IOFormat
readList :: ReadS [IOFormat]
$creadList :: ReadS [IOFormat]
readsPrec :: Int -> ReadS IOFormat
$creadsPrec :: Int -> ReadS IOFormat
Read, Int -> IOFormat -> ShowS
[IOFormat] -> ShowS
IOFormat -> String
(Int -> IOFormat -> ShowS)
-> (IOFormat -> String) -> ([IOFormat] -> ShowS) -> Show IOFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IOFormat] -> ShowS
$cshowList :: [IOFormat] -> ShowS
show :: IOFormat -> String
$cshow :: IOFormat -> String
showsPrec :: Int -> IOFormat -> ShowS
$cshowsPrec :: Int -> IOFormat -> ShowS
Show)

mapFormatTreeM :: Monad m => (FormatTree -> m FormatTree) -> FormatTree -> m FormatTree
mapFormatTreeM :: (FormatTree -> m FormatTree) -> FormatTree -> m FormatTree
mapFormatTreeM FormatTree -> m FormatTree
f = \case
  Loop String
i FormatExpr
n FormatTree
body -> do
    FormatTree
body <- (FormatTree -> m FormatTree) -> FormatTree -> m FormatTree
forall (m :: * -> *).
Monad m =>
(FormatTree -> m FormatTree) -> FormatTree -> m FormatTree
mapFormatTreeM FormatTree -> m FormatTree
f FormatTree
body
    FormatTree -> m FormatTree
f (FormatTree -> m FormatTree) -> FormatTree -> m FormatTree
forall a b. (a -> b) -> a -> b
$ String -> FormatExpr -> FormatTree -> FormatTree
Loop String
i FormatExpr
n FormatTree
body
  Seq [FormatTree]
formats -> [FormatTree] -> FormatTree
Seq ([FormatTree] -> FormatTree) -> m [FormatTree] -> m FormatTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FormatTree -> m FormatTree) -> [FormatTree] -> m [FormatTree]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FormatTree -> m FormatTree
f [FormatTree]
formats
  FormatTree
format -> FormatTree -> m FormatTree
f FormatTree
format

mapFormatTree :: (FormatTree -> FormatTree) -> FormatTree -> FormatTree
mapFormatTree :: (FormatTree -> FormatTree) -> FormatTree -> FormatTree
mapFormatTree FormatTree -> FormatTree
f = Identity FormatTree -> FormatTree
forall a. Identity a -> a
runIdentity (Identity FormatTree -> FormatTree)
-> (FormatTree -> Identity FormatTree) -> FormatTree -> FormatTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatTree -> Identity FormatTree)
-> FormatTree -> Identity FormatTree
forall (m :: * -> *).
Monad m =>
(FormatTree -> m FormatTree) -> FormatTree -> m FormatTree
mapFormatTreeM (FormatTree -> Identity FormatTree
forall (m :: * -> *) a. Monad m => a -> m a
return (FormatTree -> Identity FormatTree)
-> (FormatTree -> FormatTree) -> FormatTree -> Identity FormatTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatTree -> FormatTree
f)

normalizeFormatTree :: FormatTree -> FormatTree
normalizeFormatTree :: FormatTree -> FormatTree
normalizeFormatTree = \case
  Exp FormatExpr
e -> FormatExpr -> FormatTree
Exp FormatExpr
e
  FormatTree
Newline -> FormatTree
Newline
  Seq [FormatTree]
formats ->
    let unSeq :: FormatTree -> [FormatTree]
unSeq = \case
          Seq [FormatTree]
formats -> [FormatTree]
formats
          FormatTree
format -> [FormatTree
format]
     in [FormatTree] -> FormatTree
Seq ((FormatTree -> [FormatTree]) -> [FormatTree] -> [FormatTree]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FormatTree -> [FormatTree]
unSeq (FormatTree -> [FormatTree])
-> (FormatTree -> FormatTree) -> FormatTree -> [FormatTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatTree -> FormatTree
normalizeFormatTree) [FormatTree]
formats)
  Loop String
i FormatExpr
n FormatTree
body -> case FormatTree -> FormatTree
normalizeFormatTree FormatTree
body of
    Seq [] -> [FormatTree] -> FormatTree
Seq []
    FormatTree
body -> String -> FormatExpr -> FormatTree -> FormatTree
Loop String
i FormatExpr
n FormatTree
body

normalizeIOFormat :: IOFormat -> IOFormat
normalizeIOFormat :: IOFormat -> IOFormat
normalizeIOFormat IOFormat
format =
  IOFormat
format
    { inputTree :: FormatTree
inputTree = FormatTree -> FormatTree
normalizeFormatTree (IOFormat -> FormatTree
inputTree IOFormat
format),
      outputTree :: FormatTree
outputTree = FormatTree -> FormatTree
normalizeFormatTree (IOFormat -> FormatTree
outputTree IOFormat
format)
    }

hasNewline :: FormatTree -> Bool
hasNewline :: FormatTree -> Bool
hasNewline = \case
  Exp FormatExpr
_ -> Bool
False
  FormatTree
Newline -> Bool
True
  Seq [FormatTree]
formats -> (FormatTree -> Bool) -> [FormatTree] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FormatTree -> Bool
hasNewline [FormatTree]
formats
  Loop String
_ FormatExpr
_ FormatTree
body -> FormatTree -> Bool
hasNewline FormatTree
body

formatFormatExpr :: FormatExpr -> String
formatFormatExpr :: FormatExpr -> String
formatFormatExpr = \case
  Var String
x -> String
x
  Plus FormatExpr
e Integer
k -> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormatExpr -> String
formatFormatExpr FormatExpr
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
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  At FormatExpr
e String
i -> FormatExpr -> String
formatFormatExpr FormatExpr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  Len FormatExpr
e -> String
"len(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormatExpr -> String
formatFormatExpr FormatExpr
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

formatFormatTree :: FormatTree -> String
formatFormatTree :: FormatTree -> String
formatFormatTree =
  let replace :: Eq a => [a] -> [a] -> [a] -> [a]
      replace :: [a] -> [a] -> [a] -> [a]
replace [a]
patt [a]
subst = [a] -> [a]
go
        where
          go :: [a] -> [a]
go [a]
text | [a]
patt [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
text = [a]
subst [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
patt) [a]
text)
          go [] = []
          go (a
c : [a]
s) = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
s
      unwords' :: [String] -> String
unwords' = String -> String -> ShowS
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"\n\n" String
"\n" ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> ShowS
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"\n " String
"\n" ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> ShowS
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
" \n" String
"\n" ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords
   in \case
        Exp FormatExpr
e -> FormatExpr -> String
formatFormatExpr FormatExpr
e
        FormatTree
Newline -> String
"(newline)\n"
        Seq [FormatTree]
formats -> [String] -> String
unwords' ((FormatTree -> String) -> [FormatTree] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FormatTree -> String
formatFormatTree [FormatTree]
formats)
        Loop String
i FormatExpr
n FormatTree
body ->
          [String] -> String
unwords'
            [ String
"for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormatExpr -> String
formatFormatExpr FormatExpr
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {\n",
              FormatTree -> String
formatFormatTree FormatTree
body String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n",
              String
"}"
            ]

formatIOFormat :: IOFormat -> String
formatIOFormat :: IOFormat -> String
formatIOFormat IOFormat
format =
  [String] -> String
unlines
    ( [ String
"input tree:"
      ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++) (String -> [String]
lines (FormatTree -> String
formatFormatTree (IOFormat -> FormatTree
inputTree IOFormat
format)))
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"input variables: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (IOFormat -> [String]
inputVariables IOFormat
format),
             String
"output variables: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String [String] -> String
forall a. Show a => a -> String
show (IOFormat -> Either String [String]
outputVariables IOFormat
format),
             String
"output tree:"
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++) (String -> [String]
lines (FormatTree -> String
formatFormatTree (IOFormat -> FormatTree
outputTree IOFormat
format)))
    )

packSubscriptedVar :: String -> [String] -> FormatExpr
packSubscriptedVar :: String -> [String] -> FormatExpr
packSubscriptedVar String
x [String]
indices = (FormatExpr -> String -> FormatExpr)
-> FormatExpr -> [String] -> FormatExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FormatExpr -> String -> FormatExpr
At (String -> FormatExpr
Var String
x) [String]
indices

packSubscriptedVar' :: String -> [String] -> FormatTree
packSubscriptedVar' :: String -> [String] -> FormatTree
packSubscriptedVar' = (FormatExpr -> FormatTree
Exp (FormatExpr -> FormatTree)
-> ([String] -> FormatExpr) -> [String] -> FormatTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([String] -> FormatExpr) -> [String] -> FormatTree)
-> (String -> [String] -> FormatExpr)
-> String
-> [String]
-> FormatTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> FormatExpr
packSubscriptedVar

unpackSubscriptedVar :: MonadError Error m => FormatExpr -> m (String, [String])
unpackSubscriptedVar :: FormatExpr -> m (String, [String])
unpackSubscriptedVar = \case
  Var String
x -> (String, [String]) -> m (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x, [])
  At FormatExpr
e String
i -> ([String] -> [String]) -> (String, [String]) -> (String, [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
i]) ((String, [String]) -> (String, [String]))
-> m (String, [String]) -> m (String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatExpr -> m (String, [String])
forall (m :: * -> *).
MonadError Error m =>
FormatExpr -> m (String, [String])
unpackSubscriptedVar FormatExpr
e
  FormatExpr
e -> String -> m (String, [String])
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m (String, [String])) -> String -> m (String, [String])
forall a b. (a -> b) -> a -> b
$ String
"not a subscripted variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormatExpr -> String
formatFormatExpr FormatExpr
e

makeReadValueIO :: (MonadError Error m, MonadIO m) => (value -> m Integer) -> (Integer -> value) -> (value -> m (V.Vector value)) -> (V.Vector value -> value) -> IOFormat -> m ([value], M.Map String value)
makeReadValueIO :: (value -> m Integer)
-> (Integer -> value)
-> (value -> m (Vector value))
-> (Vector value -> value)
-> IOFormat
-> m ([value], Map String value)
makeReadValueIO value -> m Integer
toInt Integer -> value
fromInt value -> m (Vector value)
toList Vector value -> value
fromList IOFormat
format = String
-> m ([value], Map String value) -> m ([value], Map String value)
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.Common.IOFormat.makeReadValueIO" (m ([value], Map String value) -> m ([value], Map String value))
-> m ([value], Map String value) -> m ([value], Map String value)
forall a b. (a -> b) -> a -> b
$ do
  IORef (Map String value)
env <- IO (IORef (Map String value)) -> m (IORef (Map String value))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map String value)) -> m (IORef (Map String value)))
-> IO (IORef (Map String value)) -> m (IORef (Map String value))
forall a b. (a -> b) -> a -> b
$ Map String value -> IO (IORef (Map String value))
forall a. a -> IO (IORef a)
newIORef Map String value
forall k a. Map k a
M.empty
  IORef (Map String Integer)
sizes <- IO (IORef (Map String Integer)) -> m (IORef (Map String Integer))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map String Integer)) -> m (IORef (Map String Integer)))
-> IO (IORef (Map String Integer))
-> m (IORef (Map String Integer))
forall a b. (a -> b) -> a -> b
$ Map String Integer -> IO (IORef (Map String Integer))
forall a. a -> IO (IORef a)
newIORef Map String Integer
forall k a. Map k a
M.empty
  let lookup :: String -> m value
lookup String
x = do
        Maybe value
y <- String -> Map String value -> Maybe value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
x (Map String value -> Maybe value)
-> m (Map String value) -> m (Maybe value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map String value) -> m (Map String value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Map String value) -> IO (Map String value)
forall a. IORef a -> IO a
readIORef IORef (Map String value)
env)
        case Maybe value
y of
          Maybe value
Nothing -> String -> m value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m value) -> String -> m value
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
          Just value
y -> value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return value
y
  let go :: FormatTree -> m ()
go = \case
        Exp FormatExpr
e -> do
          (String
x, [String]
indices) <- FormatExpr -> m (String, [String])
forall (m :: * -> *).
MonadError Error m =>
FormatExpr -> m (String, [String])
unpackSubscriptedVar FormatExpr
e
          String
word <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
hGetWord Handle
stdin
          Integer
n <- case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe String
word of
            Just Integer
n -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
            Maybe Integer
Nothing -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwWrongInputError (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$ String
"not a integer: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
word
          Maybe value
y <- String -> Map String value -> Maybe value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
x (Map String value -> Maybe value)
-> m (Map String value) -> m (Maybe value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map String value) -> m (Map String value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Map String value) -> IO (Map String value)
forall a. IORef a -> IO a
readIORef IORef (Map String value)
env)
          value
y <- case Maybe value
y of
            Just value
y -> value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return value
y
            Maybe value
Nothing -> do
              let go' :: value -> String -> m value
go' value
x String
i = do
                    Maybe Integer
size <- String -> Map String Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
i (Map String Integer -> Maybe Integer)
-> m (Map String Integer) -> m (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map String Integer) -> m (Map String Integer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Map String Integer) -> IO (Map String Integer)
forall a. IORef a -> IO a
readIORef IORef (Map String Integer)
sizes)
                    case Maybe Integer
size of
                      Maybe Integer
Nothing -> String -> m value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m value) -> String -> m value
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
i
                      Just Integer
size -> value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return (value -> m value)
-> (Vector value -> value) -> Vector value -> m value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector value -> value
fromList (Vector value -> m value) -> Vector value -> m value
forall a b. (a -> b) -> a -> b
$ Int -> value -> Vector value
forall a. Int -> a -> Vector a
V.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
size) value
x
              (value -> String -> m value) -> value -> [String] -> m value
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM value -> String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
value -> String -> m value
go' (Integer -> value
fromInt (-Integer
1)) [String]
indices
          let go' :: value -> [String] -> m value
go' value
y = \case
                [] -> value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> value
fromInt Integer
n)
                (String
i : [String]
indices) -> do
                  Integer
i <- value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup String
i
                  Vector value
y <- value -> m (Vector value)
toList value
y
                  value
z <- value -> [String] -> m value
go' (Vector value
y Vector value -> Int -> value
forall a. Vector a -> Int -> a
V.! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i) [String]
indices
                  value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return (value -> m value)
-> (Vector value -> value) -> Vector value -> m value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector value -> value
fromList (Vector value -> m value) -> Vector value -> m value
forall a b. (a -> b) -> a -> b
$ Vector value
y Vector value -> [(Int, value)] -> Vector value
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i, value
z)]
          value
y <- value -> [String] -> m value
go' value
y [String]
indices
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map String value)
-> (Map String value -> Map String value) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String value)
env (String -> value -> Map String value -> Map String value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
x value
y)
        FormatTree
Newline -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Seq [FormatTree]
formats -> (FormatTree -> m ()) -> [FormatTree] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FormatTree -> m ()
go [FormatTree]
formats
        Loop String
i FormatExpr
n FormatTree
body -> do
          Integer
n <- case FormatExpr
n of
            Var String
n -> value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup String
n
            Plus (Var String
n) Integer
k -> (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
k) (Integer -> Integer) -> m Integer -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup String
n)
            Len (Var String
xs) -> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> (Vector value -> Int) -> Vector value -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector value -> Int
forall a. Vector a -> Int
V.length (Vector value -> Integer) -> m (Vector value) -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (value -> m (Vector value)
toList (value -> m (Vector value)) -> m value -> m (Vector value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup String
xs)
            FormatExpr
_ -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$ String
"invalid loop size in input tree: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormatExpr -> String
formatFormatExpr FormatExpr
n
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map String Integer)
-> (Map String Integer -> Map String Integer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String Integer)
sizes (String -> Integer -> Map String Integer -> Map String Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
i Integer
n)
          [Integer] -> (Integer -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Integer
0 .. Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1] ((Integer -> m ()) -> m ()) -> (Integer -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Integer
i' -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map String value)
-> (Map String value -> Map String value) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String value)
env (String -> value -> Map String value -> Map String value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
i (Integer -> value
fromInt Integer
i'))
            FormatTree -> m ()
go FormatTree
body
  FormatTree -> m ()
go (IOFormat -> FormatTree
inputTree IOFormat
format)
  [value]
values <- (String -> m value) -> [String] -> m [value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup (IOFormat -> [String]
inputVariables IOFormat
format)
  Map String value
env <- IO (Map String value) -> m (Map String value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map String value) -> m (Map String value))
-> IO (Map String value) -> m (Map String value)
forall a b. (a -> b) -> a -> b
$ IORef (Map String value) -> IO (Map String value)
forall a. IORef a -> IO a
readIORef IORef (Map String value)
env
  ([value], Map String value) -> m ([value], Map String value)
forall (m :: * -> *) a. Monad m => a -> m a
return ([value]
values, Map String value
env)

makeWriteValueIO :: (MonadError Error m, MonadIO m) => (value -> m [value]) -> (Integer -> value) -> (value -> m Integer) -> (value -> m (V.Vector value)) -> IOFormat -> M.Map String value -> value -> m ()
makeWriteValueIO :: (value -> m [value])
-> (Integer -> value)
-> (value -> m Integer)
-> (value -> m (Vector value))
-> IOFormat
-> Map String value
-> value
-> m ()
makeWriteValueIO value -> m [value]
toTuple Integer -> value
fromInt value -> m Integer
toInt value -> m (Vector value)
toList IOFormat
format Map String value
env value
value = String -> m () -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.Common.IOFormat.makeWriteValueIO" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  IORef (Map String value)
env <- IO (IORef (Map String value)) -> m (IORef (Map String value))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map String value)) -> m (IORef (Map String value)))
-> IO (IORef (Map String value)) -> m (IORef (Map String value))
forall a b. (a -> b) -> a -> b
$ Map String value -> IO (IORef (Map String value))
forall a. a -> IO (IORef a)
newIORef Map String value
env
  let lookup :: String -> m value
lookup String
x = do
        Maybe value
y <- String -> Map String value -> Maybe value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
x (Map String value -> Maybe value)
-> m (Map String value) -> m (Maybe value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map String value) -> m (Map String value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Map String value) -> IO (Map String value)
forall a. IORef a -> IO a
readIORef IORef (Map String value)
env)
        case Maybe value
y of
          Maybe value
Nothing -> String -> m value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m value) -> String -> m value
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
          Just value
y -> value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return value
y
  case IOFormat -> Either String [String]
outputVariables IOFormat
format of
    Left String
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map String value)
-> (Map String value -> Map String value) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String value)
env (String -> value -> Map String value -> Map String value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
x value
value)
    Right [String]
xs -> do
      [value]
values <- value -> m [value]
toTuple value
value
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [value]
values Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"sizes of values mismtach: expected = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", actual = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [value]
values)
      [(String, value)] -> ((String, value) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([String] -> [value] -> [(String, value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
xs [value]
values) (((String, value) -> m ()) -> m ())
-> ((String, value) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(String
x, value
value) -> do
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map String value)
-> (Map String value -> Map String value) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String value)
env (String -> value -> Map String value -> Map String value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
x value
value)
  let evaluate :: FormatExpr -> m value
evaluate = \case
        Var String
n -> String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup String
n
        Plus FormatExpr
e Integer
k -> Integer -> value
fromInt (Integer -> value) -> (Integer -> Integer) -> Integer -> value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
k) (Integer -> value) -> m Integer -> m value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FormatExpr -> m value
evaluate FormatExpr
e)
        Len FormatExpr
e -> do
          Vector value
e <- value -> m (Vector value)
toList (value -> m (Vector value)) -> m value -> m (Vector value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FormatExpr -> m value
evaluate FormatExpr
e
          value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return (value -> m value) -> (Int -> value) -> Int -> m value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> value
fromInt (Integer -> value) -> (Int -> Integer) -> Int -> value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> m value) -> Int -> m value
forall a b. (a -> b) -> a -> b
$ Vector value -> Int
forall a. Vector a -> Int
V.length Vector value
e
        At FormatExpr
e String
i -> do
          Vector value
xs <- value -> m (Vector value)
toList (value -> m (Vector value)) -> m value -> m (Vector value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FormatExpr -> m value
evaluate FormatExpr
e
          Integer
i <- value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m value
forall (m :: * -> *).
(MonadIO m, MonadError Error m) =>
String -> m value
lookup String
i
          case Vector value
xs Vector value -> Int -> Maybe value
forall a. Vector a -> Int -> Maybe a
V.!? Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i of
            Maybe value
Nothing -> String -> m value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError (String -> m value) -> String -> m value
forall a b. (a -> b) -> a -> b
$ String
"length of list is shorter than expected: expected > " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", actual = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Vector value -> Int
forall a. Vector a -> Int
V.length Vector value
xs)
            Just value
x -> value -> m value
forall (m :: * -> *) a. Monad m => a -> m a
return value
x
  let go :: FormatTree -> m ()
go = \case
        Exp FormatExpr
e -> do
          Integer
x <- value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FormatExpr -> m value
evaluate FormatExpr
e
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr (Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ")
        FormatTree
Newline -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Char -> IO ()
putChar Char
'\n'
        Seq [FormatTree]
formats -> (FormatTree -> m ()) -> [FormatTree] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FormatTree -> m ()
go [FormatTree]
formats
        Loop String
i FormatExpr
n FormatTree
body -> do
          Integer
n <- value -> m Integer
toInt (value -> m Integer) -> m value -> m Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FormatExpr -> m value
evaluate FormatExpr
n
          [Integer] -> (Integer -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Integer
0 .. Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1] ((Integer -> m ()) -> m ()) -> (Integer -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Integer
i' -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map String value)
-> (Map String value -> Map String value) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String value)
env (String -> value -> Map String value -> Map String value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
i (Integer -> value
fromInt Integer
i'))
            FormatTree -> m ()
go FormatTree
body
  FormatTree -> m ()
go (IOFormat -> FormatTree
outputTree IOFormat
format)