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

-- |
-- Module      : Jikka.CPlusPlus.Convert.UnpackTuples
-- Description : unpack tuples. / タプルを展開します。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.CPlusPlus.Convert.UnpackTuples
  ( 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

runExpr :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, VarName)]) m) => Expr -> m Expr
runExpr :: Expr -> m Expr
runExpr = \case
  Var VarName
x -> do
    Maybe [(Type, VarName)]
ys <- (Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)])
-> m (Maybe [(Type, VarName)])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName [(Type, VarName)] -> Maybe [(Type, 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
$ case Maybe [(Type, VarName)]
ys of
      Maybe [(Type, VarName)]
Nothing -> VarName -> Expr
Var VarName
x
      Just [(Type, VarName)]
ys ->
        let es :: [Expr]
es = ((Type, VarName) -> Expr) -> [(Type, VarName)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Var (VarName -> Expr)
-> ((Type, VarName) -> VarName) -> (Type, VarName) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd) [(Type, VarName)]
ys
         in if [Type] -> Bool
shouldBeArray (((Type, VarName) -> Type) -> [(Type, VarName)] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Type, VarName) -> Type
forall a b. (a, b) -> a
fst [(Type, VarName)]
ys)
              then
                let t :: Type
t = (Type, VarName) -> Type
forall a b. (a, b) -> a
fst ([(Type, VarName)] -> (Type, VarName)
forall a. [a] -> a
head [(Type, VarName)]
ys)
                 in Function -> [Expr] -> Expr
Call (Type -> Function
ArrayExt Type
t) [Expr]
es
              else
                let ts :: [Type]
ts = ((Type, VarName) -> Type) -> [(Type, VarName)] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Type, VarName) -> Type
forall a b. (a, b) -> a
fst [(Type, VarName)]
ys
                 in Function -> [Expr] -> Expr
Call ([Type] -> Function
StdTuple [Type]
ts) [Expr]
es
  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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body []
  Call Function
f [Expr]
args -> Function -> [Expr] -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Function -> [Expr] -> m Expr
runCall Function
f [Expr]
args
  CallExpr Expr
e [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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr Expr
e 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr [Expr]
args

runCall :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, VarName)]) m) => Function -> [Expr] -> m Expr
runCall :: Function -> [Expr] -> m Expr
runCall Function
f [Expr]
args = do
  [Expr]
args <- (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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr [Expr]
args
  case (Function
f, [Expr]
args) of
    (StdGet Integer
n, [Var VarName
x]) -> do
      Maybe [(Type, VarName)]
ys <- (Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)])
-> m (Maybe [(Type, VarName)])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VarName
x)
      case Maybe [(Type, VarName)]
ys of
        Just [(Type, VarName)]
ys -> do
          let es :: [Expr]
es = ((Type, VarName) -> Expr) -> [(Type, VarName)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Var (VarName -> Expr)
-> ((Type, VarName) -> VarName) -> (Type, VarName) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd) [(Type, VarName)]
ys
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([(Type, VarName)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Type, VarName)]
ys) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"index out of range"
          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
$ [Expr]
es [Expr] -> Int -> Expr
forall a. [a] -> Int -> a
!! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
        Maybe [(Type, VarName)]
Nothing -> 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
$ Function -> [Expr] -> Expr
Call Function
f [Expr]
args
    (StdGet Integer
n, [Call (StdTuple [Type]
_) [Expr]
es]) -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
es) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"index out of range"
      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
$ [Expr]
es [Expr] -> Int -> Expr
forall a. [a] -> Int -> a
!! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
    (Function
At, [Var VarName
x, Expr
e2]) -> do
      Maybe [(Type, VarName)]
ys <- (Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)])
-> m (Maybe [(Type, VarName)])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VarName
x)
      case Maybe [(Type, VarName)]
ys of
        Just [(Type, VarName)]
ys -> do
          let es :: [Expr]
es = ((Type, VarName) -> Expr) -> [(Type, VarName)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Var (VarName -> Expr)
-> ((Type, VarName) -> VarName) -> (Type, VarName) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd) [(Type, VarName)]
ys
          let n :: Maybe Integer
n = case Expr
e2 of
                Lit (LitInt32 Integer
n) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
                Lit (LitInt64 Integer
n) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
                Expr
_ -> Maybe Integer
forall a. Maybe a
Nothing
          case Maybe Integer
n of
            Just Integer
n -> do
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([(Type, VarName)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Type, VarName)]
ys) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"index out of range"
              Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Expr]
es [Expr] -> Int -> Expr
forall a. [a] -> Int -> a
!! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
            Maybe Integer
Nothing -> 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
$ Function -> [Expr] -> Expr
Call Function
f [Expr]
args
        Maybe [(Type, VarName)]
Nothing -> 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
$ Function -> [Expr] -> Expr
Call Function
f [Expr]
args
    (Function
At, [Call (ArrayExt Type
_) [Expr]
es, Expr
e2]) -> do
      let n :: Maybe Integer
n = case Expr
e2 of
            Lit (LitInt32 Integer
n) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
            Lit (LitInt64 Integer
n) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
            Expr
_ -> Maybe Integer
forall a. Maybe a
Nothing
      case Maybe Integer
n of
        Just Integer
n -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
es) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"index out of range"
          Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Expr]
es [Expr] -> Int -> Expr
forall a. [a] -> Int -> a
!! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
        Maybe Integer
Nothing -> 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
$ Function -> [Expr] -> Expr
Call Function
f [Expr]
args
    (Function, [Expr])
_ -> 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
$ Function -> [Expr] -> Expr
Call Function
f [Expr]
args

runLeftExpr :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, VarName)]) m) => LeftExpr -> m LeftExpr
runLeftExpr :: LeftExpr -> m LeftExpr
runLeftExpr = \case
  LeftVar 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
x -- do nothing
  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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e

runAssignExpr :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
LeftExpr -> m LeftExpr
runLeftExpr LeftExpr
e

runStatement :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr Expr
e
    [Statement]
body1 <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr Expr
init
    Expr
pred <- Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr Expr
pred
    AssignExpr
incr <- AssignExpr -> m AssignExpr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
AssignExpr -> m AssignExpr
runAssignExpr AssignExpr
incr
    [Statement]
body <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr Expr
e
    [Statement]
body <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr Expr
e
    [Statement]
body <- [Statement] -> [[Statement]] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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
x 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
Expr -> m Expr
runExpr [Expr]
es
    case DeclareRight
init of
      DeclareCopy (Call (StdTuple [Type]
ts) [Expr]
es) -> do
        [VarName]
ys <- Int -> m VarName -> m [VarName]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
es) (NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LocalNameKind (VarName -> String
unVarName VarName
x))
        (Map VarName [(Type, VarName)] -> Map VarName [(Type, VarName)])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName
-> [(Type, VarName)]
-> Map VarName [(Type, VarName)]
-> Map VarName [(Type, VarName)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
x ([Type] -> [VarName] -> [(Type, VarName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
ts [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
$ (Type -> VarName -> Expr -> Statement)
-> [Type] -> [VarName] -> [Expr] -> [Statement]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Type
t VarName
y Expr
e -> Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
y (Expr -> DeclareRight
DeclareCopy Expr
e)) [Type]
ts [VarName]
ys [Expr]
es
      DeclareCopy (Call (ArrayExt Type
t) [Expr]
es) -> do
        let ts :: [Type]
ts = Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
es) Type
t
        [VarName]
ys <- Int -> m VarName -> m [VarName]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
es) (NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
LocalNameKind (VarName -> String
unVarName VarName
x))
        (Map VarName [(Type, VarName)] -> Map VarName [(Type, VarName)])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName
-> [(Type, VarName)]
-> Map VarName [(Type, VarName)]
-> Map VarName [(Type, VarName)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
x ([Type] -> [VarName] -> [(Type, VarName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
ts [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
$ (Type -> VarName -> Expr -> Statement)
-> [Type] -> [VarName] -> [Expr] -> [Statement]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Type
t VarName
y Expr
e -> Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
y (Expr -> DeclareRight
DeclareCopy Expr
e)) [Type]
ts [VarName]
ys [Expr]
es
      DeclareRight
_ -> do
        [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
x DeclareRight
init]
  DeclareDestructure [VarName]
xs Expr
e -> do
    Expr
e <- Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
AssignExpr -> m AssignExpr
runAssignExpr AssignExpr
e
    case AssignExpr
e of
      AssignExpr AssignOp
SimpleAssign (LeftVar VarName
x) Expr
e -> do
        Maybe [(Type, VarName)]
ys <- (Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)])
-> m (Maybe [(Type, VarName)])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VarName
x)
        case Maybe [(Type, VarName)]
ys of
          Just [(Type, VarName)]
ys -> do
            let ts :: [Type]
ts = ((Type, VarName) -> Type) -> [(Type, VarName)] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Type, VarName) -> Type
forall a b. (a, b) -> a
fst [(Type, VarName)]
ys
            let n :: Integer
n = Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts)
            let es :: [Expr]
es = case Expr
e of
                  Call (StdTuple [Type]
_) [Expr]
es -> [Expr]
es
                  Call (ArrayExt Type
_) [Expr]
es -> [Expr]
es
                  Expr
_ ->
                    if [Type] -> Bool
shouldBeArray [Type]
ts
                      then (Integer -> Expr) -> [Integer] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> Function -> [Expr] -> Expr
Call Function
At [Expr
e, Integer -> Expr
litInt32 Integer
i]) [Integer
0 .. Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]
                      else (Integer -> Expr) -> [Integer] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> Function -> [Expr] -> Expr
Call (Integer -> Function
StdGet Integer
i) [Expr
e]) [Integer
0 .. Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]
            [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)
-> [VarName] -> [Expr] -> [Statement]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VarName
y Expr
e -> AssignExpr -> Statement
Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
AssignExpr AssignOp
SimpleAssign (VarName -> LeftExpr
LeftVar VarName
y) Expr
e)) (((Type, VarName) -> VarName) -> [(Type, VarName)] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
map (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd [(Type, VarName)]
ys) [Expr]
es
          Maybe [(Type, VarName)]
Nothing -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [AssignExpr -> Statement
Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
AssignExpr AssignOp
SimpleAssign (VarName -> LeftExpr
LeftVar VarName
x) Expr
e)]
      AssignExpr
_ -> do
        [VarName] -> (VarName -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Set VarName -> [VarName]
forall a. Set a -> [a]
S.toList (AssignExpr -> Set VarName
freeVarsAssignExpr AssignExpr
e)) ((VarName -> m ()) -> m ()) -> (VarName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \VarName
x -> do
          Maybe [(Type, VarName)]
ys <- (Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)])
-> m (Maybe [(Type, VarName)])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName -> Map VarName [(Type, VarName)] -> Maybe [(Type, VarName)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VarName
x)
          case Maybe [(Type, VarName)]
ys of
            Just [(Type, VarName)]
_ -> String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"wrong assignment to a tuple: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName VarName
x
            Maybe [(Type, VarName)]
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, 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 :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
[Statement] -> [[Statement]] -> m [Statement]
runStatements [Statement]
body []

runProgram :: (MonadAlpha m, MonadError Error m) => Program -> m Program
runProgram :: Program -> m Program
runProgram (Program [ToplevelStatement]
decls) = (StateT (Map VarName [(Type, VarName)]) m Program
-> Map VarName [(Type, VarName)] -> m Program
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Map VarName [(Type, VarName)]
forall k a. Map k a
M.empty) (StateT (Map VarName [(Type, VarName)]) m Program -> m Program)
-> StateT (Map VarName [(Type, VarName)]) m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
  [ToplevelStatement] -> Program
Program ([ToplevelStatement] -> Program)
-> StateT (Map VarName [(Type, VarName)]) m [ToplevelStatement]
-> StateT (Map VarName [(Type, VarName)]) m Program
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ToplevelStatement
 -> StateT (Map VarName [(Type, VarName)]) m ToplevelStatement)
-> [ToplevelStatement]
-> StateT (Map VarName [(Type, 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 [(Type, VarName)]) m ToplevelStatement
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m,
 MonadState (Map VarName [(Type, VarName)]) m) =>
ToplevelStatement -> m ToplevelStatement
runToplevelStatement [ToplevelStatement]
decls

-- | `run` unpack tuples.
--
-- == Examples
--
-- Before:
--
-- > tuple<int, int> c = make_tuple(a, b);
-- > func(get<0>(c), get<1>(c));
--
-- After:
--
-- > int c0 = a;
-- > int c1 = b;
-- > func(c0, c1);
run :: (MonadAlpha m, 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.UnpackTuples" (m Program -> m Program) -> m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
  Program -> m Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Program -> m Program
runProgram Program
prog