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

-- |
-- Module      : Jikka.CPlusPlus.Convert.MoveSemantics
-- Description : removes unnecessary copying. / 無用なコピーを削除します。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.CPlusPlus.Convert.MoveSemantics
  ( run,
  )
where

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

runExpr :: MonadState (M.Map VarName VarName) m => Expr -> m Expr
runExpr :: Expr -> m Expr
runExpr = \case
  Var VarName
x -> do
    Maybe VarName
y <- (Map VarName VarName -> Maybe VarName) -> m (Maybe VarName)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName VarName -> Maybe VarName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VarName
x)
    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
$ VarName -> Expr
Var (VarName -> Maybe VarName -> VarName
forall a. a -> Maybe a -> a
fromMaybe VarName
x Maybe VarName
y)
  Lit Literal
lit -> 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
$ Literal -> Expr
Lit Literal
lit
  UnOp UnaryOp
op Expr
e -> UnaryOp -> Expr -> Expr
UnOp UnaryOp
op (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
  BinOp BinaryOp
op Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
op (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e1 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e2
  Cond Expr
e1 Expr
e2 Expr
e3 -> Expr -> Expr -> Expr -> Expr
Cond (Expr -> Expr -> Expr -> Expr)
-> m Expr -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e1 m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e2 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e3
  Lam [(Type, VarName)]
args Type
ret [Statement]
body -> [(Type, VarName)] -> Type -> [Statement] -> Expr
Lam [(Type, VarName)]
args Type
ret ([Statement] -> Expr) -> m [Statement] -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body []
  Call Function
f [Expr]
args -> Function -> [Expr] -> Expr
Call Function
f ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr [Expr]
args
  CallExpr Expr
f [Expr]
args -> Expr -> [Expr] -> Expr
CallExpr (Expr -> [Expr] -> Expr) -> m Expr -> m ([Expr] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
f m ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr [Expr]
args

runLeftExpr :: MonadState (M.Map VarName VarName) m => LeftExpr -> m LeftExpr
runLeftExpr :: LeftExpr -> m LeftExpr
runLeftExpr = \case
  LeftVar VarName
x -> do
    Maybe VarName
y <- (Map VarName VarName -> Maybe VarName) -> m (Maybe VarName)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName VarName -> Maybe VarName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VarName
x)
    LeftExpr -> m LeftExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftExpr -> m LeftExpr) -> LeftExpr -> m LeftExpr
forall a b. (a -> b) -> a -> b
$ VarName -> LeftExpr
LeftVar (VarName -> Maybe VarName -> VarName
forall a. a -> Maybe a -> a
fromMaybe VarName
x Maybe VarName
y)
  LeftAt LeftExpr
e1 Expr
e2 -> LeftExpr -> Expr -> LeftExpr
LeftAt (LeftExpr -> Expr -> LeftExpr)
-> m LeftExpr -> m (Expr -> LeftExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LeftExpr -> m LeftExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e1 m (Expr -> LeftExpr) -> m Expr -> m LeftExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e2
  LeftGet Integer
n LeftExpr
e -> Integer -> LeftExpr -> LeftExpr
LeftGet Integer
n (LeftExpr -> LeftExpr) -> m LeftExpr -> m LeftExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LeftExpr -> m LeftExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e

runAssignExpr :: MonadState (M.Map VarName VarName) m => AssignExpr -> m AssignExpr
runAssignExpr :: AssignExpr -> m AssignExpr
runAssignExpr = \case
  AssignExpr AssignOp
op LeftExpr
e1 Expr
e2 -> AssignOp -> LeftExpr -> Expr -> AssignExpr
AssignExpr AssignOp
op (LeftExpr -> Expr -> AssignExpr)
-> m LeftExpr -> m (Expr -> AssignExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LeftExpr -> m LeftExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e1 m (Expr -> AssignExpr) -> m Expr -> m AssignExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e2
  AssignIncr LeftExpr
e -> LeftExpr -> AssignExpr
AssignIncr (LeftExpr -> AssignExpr) -> m LeftExpr -> m AssignExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LeftExpr -> m LeftExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e
  AssignDecr LeftExpr
e -> LeftExpr -> AssignExpr
AssignDecr (LeftExpr -> AssignExpr) -> m LeftExpr -> m AssignExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LeftExpr -> m LeftExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e

isMovable :: VarName -> [[Statement]] -> Bool
isMovable :: VarName -> [[Statement]] -> Bool
isMovable VarName
x [[Statement]]
cont =
  let ReadWriteList Set VarName
rs Set VarName
_ = [Statement] -> ReadWriteList
analyzeStatements ([[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Statement]]
cont)
   in VarName
x VarName -> Set VarName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set VarName
rs

runStatement :: MonadState (M.Map VarName VarName) m => Statement -> [[Statement]] -> m [Statement]
runStatement :: Statement -> [[Statement]] -> m [Statement]
runStatement Statement
stmt [[Statement]]
cont = case Statement
stmt of
  ExprStatement Expr
e -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> Statement
ExprStatement Expr
e]
  Block [Statement]
stmts -> do
    [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
stmts [[Statement]]
cont
  If Expr
e [Statement]
body1 Maybe [Statement]
body2 -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement]
body1 <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body1 [[Statement]]
cont
    Maybe [Statement]
body2 <- ([Statement] -> m [Statement])
-> Maybe [Statement] -> m (Maybe [Statement])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
`runStatements` [[Statement]]
cont) Maybe [Statement]
body2
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> [Statement] -> Maybe [Statement] -> Statement
If Expr
e [Statement]
body1 Maybe [Statement]
body2]
  For Type
t VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body -> do
    Expr
init <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
init
    Expr
pred <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
pred
    AssignExpr
incr <- AssignExpr -> m AssignExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
AssignExpr -> m AssignExpr
runAssignExpr AssignExpr
incr
    [Statement]
body <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body [[Statement]]
cont
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type
-> VarName
-> Expr
-> Expr
-> AssignExpr
-> [Statement]
-> Statement
For Type
t VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body]
  ForEach Type
t VarName
x Expr
e [Statement]
body -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement]
body <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body [[Statement]]
cont
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type -> VarName -> Expr -> [Statement] -> Statement
ForEach Type
t VarName
x Expr
e [Statement]
body]
  While Expr
e [Statement]
body -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement]
body <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body [[Statement]]
cont
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> [Statement] -> Statement
While Expr
e [Statement]
body]
  Declare Type
t VarName
y DeclareRight
init -> do
    DeclareRight
init <- case DeclareRight
init of
      DeclareRight
DeclareDefault -> DeclareRight -> m DeclareRight
forall (m :: * -> *) a. Monad m => a -> m a
return DeclareRight
DeclareDefault
      DeclareCopy Expr
e -> Expr -> DeclareRight
DeclareCopy (Expr -> DeclareRight) -> m Expr -> m DeclareRight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
      DeclareInitialize [Expr]
es -> [Expr] -> DeclareRight
DeclareInitialize ([Expr] -> DeclareRight) -> m [Expr] -> m DeclareRight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr [Expr]
es
    case DeclareRight
init of
      DeclareCopy (Var VarName
x) | VarName
x VarName -> [[Statement]] -> Bool
`isMovable` [[Statement]]
cont -> do
        (Map VarName VarName -> Map VarName VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName -> VarName -> Map VarName VarName -> Map VarName VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
y VarName
x)
        [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      DeclareCopy (Call Function
ConvexHullTrickCtor []) -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
y DeclareRight
DeclareDefault]
      DeclareCopy (Call Function
ConvexHullTrickCopyAddLine [Var VarName
x, Expr
a, Expr
b])
        | VarName
x VarName -> [[Statement]] -> Bool
`isMovable` [[Statement]]
cont -> do
          (Map VarName VarName -> Map VarName VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName -> VarName -> Map VarName VarName -> Map VarName VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
y VarName
x)
          [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> FunName -> [Expr] -> Statement
callMethod' (VarName -> Expr
Var VarName
x) FunName
"add_line" [Expr
a, Expr
b]]
      DeclareCopy (Call (SegmentTreeCopySetPoint Monoid'
_) [Var VarName
x, Expr
i, Expr
a])
        | VarName
x VarName -> [[Statement]] -> Bool
`isMovable` [[Statement]]
cont -> do
          (Map VarName VarName -> Map VarName VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName -> VarName -> Map VarName VarName -> Map VarName VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
y VarName
x)
          [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> FunName -> [Expr] -> Statement
callMethod' (VarName -> Expr
Var VarName
x) FunName
"set" [Expr
i, Expr
a]]
      DeclareRight
_ -> do
        [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
y DeclareRight
init]
  DeclareDestructure [VarName]
xs Expr
e -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [[VarName] -> Expr -> Statement
DeclareDestructure [VarName]
xs Expr
e]
  Assign AssignExpr
e -> do
    AssignExpr
e <- AssignExpr -> m AssignExpr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
AssignExpr -> m AssignExpr
runAssignExpr AssignExpr
e
    case AssignExpr
e of
      AssignExpr AssignOp
SimpleAssign (LeftVar VarName
y) (Var VarName
x) | VarName
x VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
y -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      AssignExpr AssignOp
SimpleAssign (LeftVar VarName
y) (Call Function
ConvexHullTrickCopyAddLine [Var VarName
x, Expr
a, Expr
b])
        | VarName
x VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
y -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> FunName -> [Expr] -> Statement
callMethod' (VarName -> Expr
Var VarName
x) FunName
"add_line" [Expr
a, Expr
b]]
        | VarName
x VarName -> [[Statement]] -> Bool
`isMovable` [[Statement]]
cont -> do
          (Map VarName VarName -> Map VarName VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName -> VarName -> Map VarName VarName -> Map VarName VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
y VarName
x)
          [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> FunName -> [Expr] -> Statement
callMethod' (VarName -> Expr
Var VarName
x) FunName
"add_line" [Expr
a, Expr
b]]
        | Bool
otherwise -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [AssignExpr -> Statement
Assign AssignExpr
e]
      AssignExpr AssignOp
SimpleAssign (LeftVar VarName
y) (Call (SegmentTreeCopySetPoint Monoid'
_) [Var VarName
x, Expr
i, Expr
a])
        | VarName
x VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
y -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> FunName -> [Expr] -> Statement
callMethod' (VarName -> Expr
Var VarName
x) FunName
"set" [Expr
i, Expr
a]]
        | VarName
x VarName -> [[Statement]] -> Bool
`isMovable` [[Statement]]
cont -> do
          (Map VarName VarName -> Map VarName VarName) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName -> VarName -> Map VarName VarName -> Map VarName VarName
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
y VarName
x)
          [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> FunName -> [Expr] -> Statement
callMethod' (VarName -> Expr
Var VarName
x) FunName
"set" [Expr
i, Expr
a]]
        | Bool
otherwise -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [AssignExpr -> Statement
Assign AssignExpr
e]
      AssignExpr
_ -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [AssignExpr -> Statement
Assign AssignExpr
e]
  Assert Expr
e -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> Statement
Assert Expr
e]
  Return Expr
e -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr -> Statement
Return Expr
e]

runStatements :: MonadState (M.Map VarName VarName) m => [Statement] -> [[Statement]] -> m [Statement]
runStatements :: [Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
stmts [[Statement]]
cont = case [Statement]
stmts of
  [] -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Statement
stmt : [Statement]
stmts -> do
    [Statement]
stmt <- Statement -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Statement -> [[Statement]] -> m [Statement]
runStatement Statement
stmt ([Statement]
stmts [Statement] -> [[Statement]] -> [[Statement]]
forall a. a -> [a] -> [a]
: [[Statement]]
cont)
    [Statement]
stmts <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
stmts [[Statement]]
cont
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmt [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts)

runToplevelStatement :: MonadState (M.Map VarName VarName) m => ToplevelStatement -> m ToplevelStatement
runToplevelStatement :: ToplevelStatement -> m ToplevelStatement
runToplevelStatement = \case
  VarDef Type
t VarName
x Expr
e -> Type -> VarName -> Expr -> ToplevelStatement
VarDef Type
t VarName
x (Expr -> ToplevelStatement) -> m Expr -> m ToplevelStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
Expr -> m Expr
runExpr Expr
e
  FunDef Type
ret VarName
f [(Type, VarName)]
args [Statement]
body -> Type
-> VarName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
FunDef Type
ret VarName
f [(Type, VarName)]
args ([Statement] -> ToplevelStatement)
-> m [Statement] -> m ToplevelStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body []

runProgram :: Monad m => Program -> m Program
runProgram :: Program -> m Program
runProgram (Program [ToplevelStatement]
decls) = (StateT (Map VarName VarName) m Program
-> Map VarName VarName -> m Program
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Map VarName VarName
forall k a. Map k a
M.empty) (StateT (Map VarName VarName) m Program -> m Program)
-> StateT (Map VarName VarName) m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
  [ToplevelStatement] -> Program
Program ([ToplevelStatement] -> Program)
-> StateT (Map VarName VarName) m [ToplevelStatement]
-> StateT (Map VarName VarName) m Program
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ToplevelStatement
 -> StateT (Map VarName VarName) m ToplevelStatement)
-> [ToplevelStatement]
-> StateT (Map VarName VarName) m [ToplevelStatement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ToplevelStatement
-> StateT (Map VarName VarName) m ToplevelStatement
forall (m :: * -> *).
MonadState (Map VarName VarName) m =>
ToplevelStatement -> m ToplevelStatement
runToplevelStatement [ToplevelStatement]
decls

-- | `run` replaces superfluous copying.
--
-- == Examples
--
-- Before:
--
-- > vector<int> solve(vector<int> a) {
-- >     vector<int> b = a;
-- >     b[0] = 1;
-- >     return b;
-- > }
--
-- After:
--
-- > vector<int> solve(vector<int> a) {
-- >     a[0] = 1;
-- >     return a;
-- > }
--
-- Before:
--
-- > int solve(int a, int b, int x) {
-- >     jikka::convex_hull_trick cht = jikka::convex_hull_trick();
-- >     cht = jikka::convex_hull_trick::persistent_add_line(cht, a, b);
-- >     return cht.get_min(x);
-- > }
--
-- After:
--
-- > int solve(int a, int b, int x) {
-- >     jikka::convex_hull_trick cht;
-- >     cht = cht.add_line(a, b);
-- >     return cht.get_min(x);
-- > }
run :: MonadError Error m => Program -> m Program
run :: Program -> m Program
run Program
prog = String -> m Program -> m Program
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.CPlusPlus.Convert.MoveSemantics" (m Program -> m Program) -> m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
  Program -> m Program
forall (m :: * -> *). Monad m => Program -> m Program
runProgram Program
prog