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

-- |
-- Module      : Jikka.CPlusPlus.Convert.AddMain
-- Description : adds @main@ function. / @main@ 関数を追加します。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.CPlusPlus.Convert.AddMain
  ( run,
  )
where

import Control.Monad.State.Strict
import qualified Data.Map as M
import qualified Data.Set as S
import Jikka.CPlusPlus.Language.Expr
import Jikka.CPlusPlus.Language.Util
import Jikka.Common.Alpha
import Jikka.Common.Error
import qualified Jikka.Common.IOFormat as F

lookup' :: (MonadState (M.Map String VarName) m, MonadError Error m) => String -> m VarName
lookup' :: String -> m VarName
lookup' String
x = do
  Maybe VarName
y <- (Map String VarName -> Maybe VarName) -> m (Maybe VarName)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Map String VarName -> Maybe VarName) -> m (Maybe VarName))
-> (Map String VarName -> Maybe VarName) -> m (Maybe VarName)
forall a b. (a -> b) -> a -> b
$ String -> Map String VarName -> Maybe VarName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
x
  case Maybe VarName
y of
    Just VarName
y -> VarName -> m VarName
forall (m :: * -> *) a. Monad m => a -> m a
return VarName
y
    Maybe VarName
Nothing -> String -> m VarName
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m VarName) -> String -> m VarName
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

runFormatExpr :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.FormatExpr -> m Expr
runFormatExpr :: FormatExpr -> m Expr
runFormatExpr = \case
  F.Var String
x -> VarName -> Expr
Var (VarName -> Expr) -> m VarName -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m VarName
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadError Error m) =>
String -> m VarName
lookup' String
x
  F.Plus FormatExpr
e Integer
k -> BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
Add (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
e m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Expr
Lit (Integer -> Literal
LitInt32 Integer
k))
  F.At FormatExpr
e String
i -> Expr -> Expr -> Expr
at (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
e m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VarName -> Expr
Var (VarName -> Expr) -> m VarName -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m VarName
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadError Error m) =>
String -> m VarName
lookup' String
i)
  F.Len FormatExpr
e -> do
    Expr
e <- FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
e
    Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> Expr -> Expr
cast Type
TyInt32 (Function -> [Expr] -> Expr
Call Function
MethodSize [Expr
e])

runMainDeclare :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.IOFormat -> m [(S.Set VarName, Statement)]
runMainDeclare :: IOFormat -> m [(Set VarName, Statement)]
runMainDeclare IOFormat
format = Map String Expr -> FormatTree -> m [(Set VarName, Statement)]
forall (m :: * -> *).
(MonadError Error m, MonadAlpha m,
 MonadState (Map String VarName) m) =>
Map String Expr -> FormatTree -> m [(Set VarName, Statement)]
go Map String Expr
forall k a. Map k a
M.empty (IOFormat -> FormatTree
F.inputTree IOFormat
format)
  where
    go :: Map String Expr -> FormatTree -> m [(Set VarName, Statement)]
go Map String Expr
sizes = \case
      F.Exp FormatExpr
e -> do
        (String
x, [String]
indices) <- FormatExpr -> m (String, [String])
forall (m :: * -> *).
MonadError Error m =>
FormatExpr -> m (String, [String])
F.unpackSubscriptedVar FormatExpr
e
        VarName
y <- NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LocalNameKind String
x
        (Map String VarName -> Map String VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Map String VarName -> Map String VarName) -> m ())
-> (Map String VarName -> Map String VarName) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> VarName -> Map String VarName -> Map String VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
x VarName
y
        let lookupSize :: String -> m Expr
lookupSize String
i = case String -> Map String Expr -> Maybe Expr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
i Map String Expr
sizes of
              Just Expr
e -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
              Maybe Expr
Nothing -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"undefined variable" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i
        [Expr]
sizes' <- (String -> m Expr) -> [String] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m Expr
forall (m :: * -> *). MonadError Error m => String -> m Expr
lookupSize [String]
indices
        let deps :: Set VarName
deps = [Set VarName] -> Set VarName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((Expr -> Set VarName) -> [Expr] -> [Set VarName]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Set VarName
freeVars [Expr]
sizes')
        let t :: Type
t = (Type -> String -> Type) -> Type -> [String] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Type
t String
_ -> Type -> Type
TyVector Type
t) Type
TyInt64 [String]
indices
        let decl :: Statement
decl = Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
y (Expr -> DeclareRight
DeclareCopy ((Type, Expr) -> Expr
forall a b. (a, b) -> b
snd ((Expr -> (Type, Expr) -> (Type, Expr))
-> (Type, Expr) -> [Expr] -> (Type, Expr)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Expr
size (Type
t, Expr
e) -> (Type -> Type
TyVector Type
t, Type -> [Expr] -> Expr
vecCtor Type
t [Expr
size, Expr
e])) (Type
TyInt64, Literal -> Expr
Lit (Integer -> Literal
LitInt64 (-Integer
1))) [Expr]
sizes')))
        [(Set VarName, Statement)] -> m [(Set VarName, Statement)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Set VarName
deps, Statement
decl)]
      FormatTree
F.Newline -> [(Set VarName, Statement)] -> m [(Set VarName, Statement)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      F.Seq [FormatTree]
formats -> [[(Set VarName, Statement)]] -> [(Set VarName, Statement)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Set VarName, Statement)]] -> [(Set VarName, Statement)])
-> m [[(Set VarName, Statement)]] -> m [(Set VarName, Statement)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FormatTree -> m [(Set VarName, Statement)])
-> [FormatTree] -> m [[(Set VarName, Statement)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Map String Expr -> FormatTree -> m [(Set VarName, Statement)]
go Map String Expr
sizes) [FormatTree]
formats
      F.Loop String
i FormatExpr
n FormatTree
body -> do
        Expr
n <- FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
n
        Map String Expr -> FormatTree -> m [(Set VarName, Statement)]
go (String -> Expr -> Map String Expr -> Map String Expr
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
i Expr
n Map String Expr
sizes) FormatTree
body

runMainInput :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.IOFormat -> [(S.Set VarName, Statement)] -> m [Statement]
runMainInput :: IOFormat -> [(Set VarName, Statement)] -> m [Statement]
runMainInput IOFormat
format [(Set VarName, Statement)]
decls = do
  let go :: Set VarName -> FormatTree -> m ([Statement], Set VarName)
go Set VarName
initialized = \case
        F.Exp FormatExpr
e -> do
          (String
x, [String]
_) <- FormatExpr -> m (String, [String])
forall (m :: * -> *).
MonadError Error m =>
FormatExpr -> m (String, [String])
F.unpackSubscriptedVar FormatExpr
e
          VarName
y <- String -> m VarName
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadError Error m) =>
String -> m VarName
lookup' String
x
          Expr
e <- FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
e
          let decls' :: [Statement]
decls' = ((Set VarName, Statement) -> Statement)
-> [(Set VarName, Statement)] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map (Set VarName, Statement) -> Statement
forall a b. (a, b) -> b
snd ([(Set VarName, Statement)] -> [Statement])
-> [(Set VarName, Statement)] -> [Statement]
forall a b. (a -> b) -> a -> b
$ ((Set VarName, Statement) -> Bool)
-> [(Set VarName, Statement)] -> [(Set VarName, Statement)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Set VarName
deps, Statement
_) -> Bool -> Bool
not (Set VarName
deps Set VarName -> Set VarName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set VarName
initialized) Bool -> Bool -> Bool
&& Set VarName
deps Set VarName -> Set VarName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` VarName -> Set VarName -> Set VarName
forall a. Ord a => a -> Set a -> Set a
S.insert VarName
y Set VarName
initialized) [(Set VarName, Statement)]
decls
          ([Statement], Set VarName) -> m ([Statement], Set VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Statement
cinStatement Expr
e Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
decls', VarName -> Set VarName -> Set VarName
forall a. Ord a => a -> Set a -> Set a
S.insert VarName
y Set VarName
initialized)
        FormatTree
F.Newline -> ([Statement], Set VarName) -> m ([Statement], Set VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Set VarName
initialized)
        F.Seq [] -> ([Statement], Set VarName) -> m ([Statement], Set VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Set VarName
initialized)
        F.Seq (FormatTree
format : [FormatTree]
formats) -> do
          ([Statement]
stmts, Set VarName
initialized) <- Set VarName -> FormatTree -> m ([Statement], Set VarName)
go Set VarName
initialized FormatTree
format
          ([Statement]
stmts', Set VarName
initialized) <- Set VarName -> FormatTree -> m ([Statement], Set VarName)
go Set VarName
initialized ([FormatTree] -> FormatTree
F.Seq [FormatTree]
formats)
          ([Statement], Set VarName) -> m ([Statement], Set VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts', Set VarName
initialized)
        F.Loop String
i FormatExpr
n FormatTree
body -> do
          VarName
j <- NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LoopCounterNameKind String
i
          (Map String VarName -> Map String VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Map String VarName -> Map String VarName) -> m ())
-> (Map String VarName -> Map String VarName) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> VarName -> Map String VarName -> Map String VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
i VarName
j
          Expr
n <- FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
n
          ([Statement]
body, Set VarName
initialized) <- Set VarName -> FormatTree -> m ([Statement], Set VarName)
go Set VarName
initialized FormatTree
body
          ([Statement], Set VarName) -> m ([Statement], Set VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return ([VarName -> Expr -> [Statement] -> Statement
repStatement VarName
j Expr
n [Statement]
body], Set VarName
initialized)
  let decls' :: [Statement]
decls' = ((Set VarName, Statement) -> Statement)
-> [(Set VarName, Statement)] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map (Set VarName, Statement) -> Statement
forall a b. (a, b) -> b
snd ([(Set VarName, Statement)] -> [Statement])
-> [(Set VarName, Statement)] -> [Statement]
forall a b. (a -> b) -> a -> b
$ ((Set VarName, Statement) -> Bool)
-> [(Set VarName, Statement)] -> [(Set VarName, Statement)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Set VarName
deps, Statement
_) -> Set VarName -> Bool
forall a. Set a -> Bool
S.null Set VarName
deps) [(Set VarName, Statement)]
decls
  [Statement]
stmts <- ([Statement], Set VarName) -> [Statement]
forall a b. (a, b) -> a
fst (([Statement], Set VarName) -> [Statement])
-> m ([Statement], Set VarName) -> m [Statement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set VarName -> FormatTree -> m ([Statement], Set VarName)
forall (m :: * -> *).
(MonadError Error m, MonadState (Map String VarName) m,
 MonadAlpha m) =>
Set VarName -> FormatTree -> m ([Statement], Set VarName)
go Set VarName
forall a. Set a
S.empty (IOFormat -> FormatTree
F.inputTree IOFormat
format)
  [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement] -> m [Statement]) -> [Statement] -> m [Statement]
forall a b. (a -> b) -> a -> b
$ [Statement]
decls' [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts

runMainSolve :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.IOFormat -> m Statement
runMainSolve :: IOFormat -> m Statement
runMainSolve IOFormat
format = do
  [VarName]
args <- (String -> m VarName) -> [String] -> m [VarName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m VarName
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadError Error m) =>
String -> m VarName
lookup' (IOFormat -> [String]
F.inputVariables IOFormat
format)
  let solve :: Expr
solve = Function -> [Expr] -> Expr
Call (FunName -> [Type] -> Function
Function FunName
"solve" []) ((VarName -> Expr) -> [VarName] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> Expr
Var [VarName]
args)
  case IOFormat -> Either String [String]
F.outputVariables IOFormat
format of
    Left String
x -> do
      VarName
y <- NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LocalNameKind String
x
      (Map String VarName -> Map String VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Map String VarName -> Map String VarName) -> m ())
-> (Map String VarName -> Map String VarName) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> VarName -> Map String VarName -> Map String VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
x VarName
y
      Statement -> m Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> m Statement) -> Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Declare Type
TyAuto VarName
y (Expr -> DeclareRight
DeclareCopy Expr
solve)
    Right [String]
xs -> do
      [VarName]
ys <- (String -> m VarName) -> [String] -> m [VarName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LocalNameKind) [String]
xs
      (Map String VarName -> Map String VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Map String VarName -> Map String VarName) -> m ())
-> (Map String VarName -> Map String VarName) -> m ()
forall a b. (a -> b) -> a -> b
$ \Map String VarName
env -> (Map String VarName -> (String, VarName) -> Map String VarName)
-> Map String VarName -> [(String, VarName)] -> Map String VarName
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map String VarName
env (String
x, VarName
y) -> String -> VarName -> Map String VarName -> Map String VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
x VarName
y Map String VarName
env) Map String VarName
env ([String] -> [VarName] -> [(String, VarName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
xs [VarName]
ys)
      Statement -> m Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> m Statement) -> Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ [VarName] -> Expr -> Statement
DeclareDestructure [VarName]
ys Expr
solve

runMainOutput :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.IOFormat -> m [Statement]
runMainOutput :: IOFormat -> m [Statement]
runMainOutput IOFormat
format = FormatTree -> m [Statement]
go (IOFormat -> FormatTree
F.outputTree IOFormat
format)
  where
    go :: FormatTree -> m [Statement]
go = \case
      F.Exp FormatExpr
e -> do
        Expr
e <- FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
e
        [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> Statement
coutStatement Expr
e]
      FormatTree
F.Newline -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> Statement
coutStatement (Literal -> Expr
Lit (Char -> Literal
LitChar Char
'\n'))]
      F.Seq [FormatTree]
formats -> [[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Statement]] -> [Statement]) -> m [[Statement]] -> m [Statement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FormatTree -> m [Statement]) -> [FormatTree] -> m [[Statement]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FormatTree -> m [Statement]
go [FormatTree]
formats
      F.Loop String
i FormatExpr
n FormatTree
body -> do
        VarName
j <- NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LoopCounterNameKind String
i
        (Map String VarName -> Map String VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Map String VarName -> Map String VarName) -> m ())
-> (Map String VarName -> Map String VarName) -> m ()
forall a b. (a -> b) -> a -> b
$ String -> VarName -> Map String VarName -> Map String VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
i VarName
j
        Expr
n <- FormatExpr -> m Expr
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
FormatExpr -> m Expr
runFormatExpr FormatExpr
n
        [Statement]
body <- FormatTree -> m [Statement]
go FormatTree
body
        [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [VarName -> Expr -> [Statement] -> Statement
repStatement VarName
j Expr
n [Statement]
body]

runMain :: (MonadAlpha m, MonadError Error m) => F.IOFormat -> m ToplevelStatement
runMain :: IOFormat -> m ToplevelStatement
runMain IOFormat
format = do
  (StateT (Map String VarName) m ToplevelStatement
-> Map String VarName -> m ToplevelStatement
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Map String VarName
forall k a. Map k a
M.empty) (StateT (Map String VarName) m ToplevelStatement
 -> m ToplevelStatement)
-> StateT (Map String VarName) m ToplevelStatement
-> m ToplevelStatement
forall a b. (a -> b) -> a -> b
$ do
    [(Set VarName, Statement)]
decls <- IOFormat
-> StateT (Map String VarName) m [(Set VarName, Statement)]
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
IOFormat -> m [(Set VarName, Statement)]
runMainDeclare IOFormat
format
    [Statement]
input <- IOFormat
-> [(Set VarName, Statement)]
-> StateT (Map String VarName) m [Statement]
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
IOFormat -> [(Set VarName, Statement)] -> m [Statement]
runMainInput IOFormat
format [(Set VarName, Statement)]
decls
    Statement
solve <- IOFormat -> StateT (Map String VarName) m Statement
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
IOFormat -> m Statement
runMainSolve IOFormat
format
    [Statement]
output <- IOFormat -> StateT (Map String VarName) m [Statement]
forall (m :: * -> *).
(MonadState (Map String VarName) m, MonadAlpha m,
 MonadError Error m) =>
IOFormat -> m [Statement]
runMainOutput IOFormat
format
    ToplevelStatement
-> StateT (Map String VarName) m ToplevelStatement
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelStatement
 -> StateT (Map String VarName) m ToplevelStatement)
-> ToplevelStatement
-> StateT (Map String VarName) m ToplevelStatement
forall a b. (a -> b) -> a -> b
$ Type
-> VarName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
FunDef Type
TyInt VarName
"main" [] ([Statement]
input [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement
solve] [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
output)

run :: (MonadAlpha m, MonadError Error m) => Program -> F.IOFormat -> m Program
run :: Program -> IOFormat -> m Program
run Program
prog IOFormat
format = String -> m Program -> m Program
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.CPlusPlus.Convert.AddMain" (m Program -> m Program) -> m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
  ToplevelStatement
main <- IOFormat -> m ToplevelStatement
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
IOFormat -> m ToplevelStatement
runMain IOFormat
format
  Program -> m Program
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> m Program) -> Program -> m Program
forall a b. (a -> b) -> a -> b
$ [ToplevelStatement] -> Program
Program (Program -> [ToplevelStatement]
decls Program
prog [ToplevelStatement] -> [ToplevelStatement] -> [ToplevelStatement]
forall a. [a] -> [a] -> [a]
++ [ToplevelStatement
main])