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

-- |
-- Module      : Jikka.RestrictedPython.Convert.Alpha
-- Description : does alpha conversion. / alpha 変換を行います。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.RestrictedPython.Convert.Alpha
  ( run,
  )
where

import Control.Monad.State.Strict
import Data.List (delete, intersect)
import Data.Maybe (isNothing)
import qualified Data.Set as S
import Jikka.Common.Alpha
import Jikka.Common.Error
import Jikka.RestrictedPython.Language.Builtin
import Jikka.RestrictedPython.Language.Expr
import Jikka.RestrictedPython.Language.Lint
import Jikka.RestrictedPython.Language.Util
import Jikka.RestrictedPython.Language.VariableAnalysis

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

initialEnv :: Env
initialEnv :: Env
initialEnv =
  Env :: [(VarName, VarName)] -> [[(VarName, VarName)]] -> Env
Env
    { currentMapping :: [(VarName, VarName)]
currentMapping = [],
      parentMappings :: [[(VarName, VarName)]]
parentMappings = [(VarName -> (VarName, VarName))
-> [VarName] -> [(VarName, VarName)]
forall a b. (a -> b) -> [a] -> [b]
map (\VarName
x -> (VarName
x, VarName
x)) (Set VarName -> [VarName]
forall a. Set a -> [a]
S.toList Set VarName
builtinNames)]
    }

withToplevelScope :: (MonadError Error m, MonadState Env m) => m a -> m a
withToplevelScope :: m a -> m a
withToplevelScope m a
f = do
  Env
env <- m Env
forall s (m :: * -> *). MonadState s m => m s
get
  Either Error a
x <- m a -> m (Either Error a)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
catchError' (m a -> m (Either Error a)) -> m a -> m (Either Error a)
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall (m :: * -> *) a.
(MonadError Error m, MonadState Env m) =>
m a -> m a
withScope m a
f
  Env -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Env
env
  Either Error a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither Either Error a
x

withScope :: (MonadError Error m, MonadState Env m) => m a -> m a
withScope :: m a -> m a
withScope m a
f = do
  (Env -> Env) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Env -> Env) -> m ()) -> (Env -> Env) -> m ()
forall a b. (a -> b) -> a -> b
$ \Env
env ->
    Env
env
      { currentMapping :: [(VarName, VarName)]
currentMapping = [],
        parentMappings :: [[(VarName, VarName)]]
parentMappings = Env -> [(VarName, VarName)]
currentMapping Env
env [(VarName, VarName)]
-> [[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. a -> [a] -> [a]
: Env -> [[(VarName, VarName)]]
parentMappings Env
env
      }
  Either Error a
x <- m a -> m (Either Error a)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
catchError' m a
f
  (Env -> Env) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Env -> Env) -> m ()) -> (Env -> Env) -> m ()
forall a b. (a -> b) -> a -> b
$ \Env
env ->
    Env
env
      { currentMapping :: [(VarName, VarName)]
currentMapping = [[(VarName, VarName)]] -> [(VarName, VarName)]
forall a. [a] -> a
head (Env -> [[(VarName, VarName)]]
parentMappings Env
env),
        parentMappings :: [[(VarName, VarName)]]
parentMappings = [[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. [a] -> [a]
tail (Env -> [[(VarName, VarName)]]
parentMappings Env
env)
      }
  Either Error a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither Either Error a
x

-- | `renameLocalNew` renames given variables and record them to the `Env`.
renameLocalNew :: (MonadAlpha m, MonadState Env m) => VarName' -> m VarName'
renameLocalNew :: VarName' -> m VarName'
renameLocalNew VarName'
x = do
  Env
env <- m Env
forall s (m :: * -> *). MonadState s m => m s
get
  case VarName' -> Env -> Maybe VarName'
lookupLocalName VarName'
x (Env
env {currentMapping :: [(VarName, VarName)]
currentMapping = []}) of
    Just VarName'
y -> VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return VarName'
y
    Maybe VarName'
Nothing -> do
      VarName'
y <- VarName' -> m VarName'
forall (m :: * -> *). MonadAlpha m => VarName' -> m VarName'
genVarName VarName'
x
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"_") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Env -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Env -> m ()) -> Env -> m ()
forall a b. (a -> b) -> a -> b
$
          Env
env
            { currentMapping :: [(VarName, VarName)]
currentMapping = (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x, VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
y) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, VarName)]
currentMapping Env
env
            }
      VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return VarName'
y

-- | `renameShadow` renames given variables ignoring the current `Env` and record them to the `Env`.
renameShadow :: (MonadAlpha m, MonadState Env m) => VarName' -> m VarName'
renameShadow :: VarName' -> m VarName'
renameShadow VarName'
x = do
  Env
env <- m Env
forall s (m :: * -> *). MonadState s m => m s
get
  VarName'
y <- VarName' -> m VarName'
forall (m :: * -> *). MonadAlpha m => VarName' -> m VarName'
genVarName VarName'
x
  Env -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Env -> m ()) -> Env -> m ()
forall a b. (a -> b) -> a -> b
$
    Env
env
      { currentMapping :: [(VarName, VarName)]
currentMapping = (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x, VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
y) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, VarName)]
currentMapping Env
env
      }
  VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return VarName'
y

-- | `renameLocalCompletelyNew` throws errors when given variables already exists in environments.
renameLocalCompletelyNew :: (MonadAlpha m, MonadState Env m, MonadError Error m) => VarName' -> m VarName'
renameLocalCompletelyNew :: VarName' -> m VarName'
renameLocalCompletelyNew VarName'
x = do
  Env
env <- m Env
forall s (m :: * -> *). MonadState s m => m s
get
  case VarName' -> Env -> Maybe VarName'
lookupLocalName VarName'
x Env
env of
    Just VarName'
_ -> Maybe Loc -> String -> m VarName'
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSemanticErrorAt' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) (String -> m VarName') -> String -> m VarName'
forall a b. (a -> b) -> a -> b
$ String
"cannot redefine variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)
    Maybe VarName'
Nothing -> VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m) =>
VarName' -> m VarName'
renameLocalNew VarName'
x

-- | `renameToplevel` records given variables to the `Env` without actual renaming.
renameToplevel :: (MonadAlpha m, MonadState Env m, MonadError Error m) => VarName' -> m VarName'
renameToplevel :: VarName' -> m VarName'
renameToplevel VarName'
x = do
  Env
env <- m Env
forall s (m :: * -> *). MonadState s m => m s
get
  case VarName' -> Env -> Maybe VarName'
lookupName VarName'
x Env
env of
    Just VarName'
_ -> do
      let msg :: String
msg =
            if VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x VarName -> Set VarName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set VarName
builtinNames
              then String
"cannot assign to builtin function: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)
              else String
"cannot redefine variable in toplevel: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)
      Maybe Loc -> String -> m VarName'
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSemanticErrorAt' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) String
msg
    Maybe VarName'
Nothing -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"_") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Env -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Env -> m ()) -> Env -> m ()
forall a b. (a -> b) -> a -> b
$
          Env
env
            { currentMapping :: [(VarName, VarName)]
currentMapping = (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x, VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, VarName)]
currentMapping Env
env
            }
      VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return VarName'
x

-- | `renameToplevelArgument` always introduces a new variable.
renameToplevelArgument :: (MonadAlpha m, MonadState Env m, MonadError Error m) => VarName' -> m VarName'
renameToplevelArgument :: VarName' -> m VarName'
renameToplevelArgument = VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m) =>
VarName' -> m VarName'
renameShadow

popRename :: (MonadState Env m, MonadError Error m) => VarName' -> m ()
popRename :: VarName' -> m ()
popRename VarName'
x =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"_") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    VarName'
y <- VarName' -> m VarName'
forall (m :: * -> *).
(MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
lookupName' VarName'
x
    (Env -> Env) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Env -> Env) -> m ()) -> (Env -> Env) -> m ()
forall a b. (a -> b) -> a -> b
$ \Env
env -> Env
env {currentMapping :: [(VarName, VarName)]
currentMapping = (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. Eq a => a -> [a] -> [a]
delete (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x, VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
y) (Env -> [(VarName, VarName)]
currentMapping Env
env)}

lookupName :: VarName' -> Env -> Maybe VarName'
lookupName :: VarName' -> Env -> Maybe VarName'
lookupName VarName'
x Env
env = VarName' -> [[(VarName, VarName)]] -> Maybe VarName'
lookupNameFromMappings VarName'
x (Env -> [(VarName, VarName)]
currentMapping Env
env [(VarName, VarName)]
-> [[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. a -> [a] -> [a]
: Env -> [[(VarName, VarName)]]
parentMappings Env
env)

lookupLocalName :: VarName' -> Env -> Maybe VarName'
lookupLocalName :: VarName' -> Env -> Maybe VarName'
lookupLocalName VarName'
x Env
env = VarName' -> [[(VarName, VarName)]] -> Maybe VarName'
lookupNameFromMappings VarName'
x ([[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. [a] -> [a]
reverse (Int -> [[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. Int -> [a] -> [a]
drop Int
2 ([[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. [a] -> [a]
reverse (Env -> [(VarName, VarName)]
currentMapping Env
env [(VarName, VarName)]
-> [[(VarName, VarName)]] -> [[(VarName, VarName)]]
forall a. a -> [a] -> [a]
: Env -> [[(VarName, VarName)]]
parentMappings Env
env))))

lookupNameFromMappings :: VarName' -> [[(VarName, VarName)]] -> Maybe VarName'
lookupNameFromMappings :: VarName' -> [[(VarName, VarName)]] -> Maybe VarName'
lookupNameFromMappings VarName'
_ [] = Maybe VarName'
forall a. Maybe a
Nothing
lookupNameFromMappings VarName'
x ([(VarName, VarName)]
mapping : [[(VarName, VarName)]]
mappings) =
  case VarName -> [(VarName, VarName)] -> Maybe VarName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) [(VarName, VarName)]
mapping of
    Just VarName
y -> VarName' -> Maybe VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName' -> Maybe VarName') -> VarName' -> Maybe VarName'
forall a b. (a -> b) -> a -> b
$ Maybe Loc -> VarName -> VarName'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) VarName
y
    Maybe VarName
Nothing -> VarName' -> [[(VarName, VarName)]] -> Maybe VarName'
lookupNameFromMappings VarName'
x [[(VarName, VarName)]]
mappings

lookupName' :: (MonadState Env m, MonadError Error m) => VarName' -> m VarName'
lookupName' :: VarName' -> m VarName'
lookupName' VarName'
x = do
  Env
env <- m Env
forall s (m :: * -> *). MonadState s m => m s
get
  case VarName' -> Env -> Maybe VarName'
lookupName VarName'
x Env
env of
    Just VarName'
y -> VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return VarName'
y
    Maybe VarName'
Nothing -> Maybe Loc -> String -> m VarName'
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSymbolErrorAt' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) (String -> m VarName') -> String -> m VarName'
forall a b. (a -> b) -> a -> b
$ String
"undefined identifier: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)

-- | `runAnnTarget` renames targets of annotated assignments.
runAnnTarget :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Target' -> m Target'
runAnnTarget :: Target' -> m Target'
runAnnTarget = (VarName' -> m VarName') -> Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
(VarName' -> m VarName') -> Target' -> m Target'
runTargetGeneric VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m) =>
VarName' -> m VarName'
renameLocalNew

-- | `runForTarget` renames targets of for-loops.
runForTarget :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Target' -> m Target'
runForTarget :: Target' -> m Target'
runForTarget = (VarName' -> m VarName') -> Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
(VarName' -> m VarName') -> Target' -> m Target'
runTargetGeneric VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
renameLocalCompletelyNew

-- | `runAugTarget` renames targets of augumented assignments.
runAugTarget :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Target' -> m Target'
runAugTarget :: Target' -> m Target'
runAugTarget = (VarName' -> m VarName') -> Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
(VarName' -> m VarName') -> Target' -> m Target'
runTargetGeneric VarName' -> m VarName'
forall (m :: * -> *).
(MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
lookupName'

runTargetGeneric :: (MonadState Env m, MonadAlpha m, MonadError Error m) => (VarName' -> m VarName') -> Target' -> m Target'
runTargetGeneric :: (VarName' -> m VarName') -> Target' -> m Target'
runTargetGeneric VarName' -> m VarName'
f Target'
x =
  Maybe Loc -> Target -> Target'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Target' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Target'
x) (Target -> Target') -> m Target -> m Target'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Target' -> Target
forall a. WithLoc' a -> a
value' Target'
x of
    SubscriptTrg Target'
f Expr'
index -> Target' -> Expr' -> Target
SubscriptTrg (Target' -> Expr' -> Target) -> m Target' -> m (Expr' -> Target)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Target' -> m Target'
runAugTarget Target'
f m (Expr' -> Target) -> m Expr' -> m Target
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
index
    NameTrg VarName'
x -> VarName' -> Target
NameTrg (VarName' -> Target) -> m VarName' -> m Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName' -> m VarName'
f VarName'
x
    TupleTrg [Target']
xs -> [Target'] -> Target
TupleTrg ([Target'] -> Target) -> m [Target'] -> m Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Target' -> m Target') -> [Target'] -> m [Target']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((VarName' -> m VarName') -> Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
(VarName' -> m VarName') -> Target' -> m Target'
runTargetGeneric VarName' -> m VarName'
f) [Target']
xs

popTarget :: (MonadState Env m, MonadError Error m) => Target' -> m ()
popTarget :: Target' -> m ()
popTarget (WithLoc' Maybe Loc
_ Target
x) = case Target
x of
  SubscriptTrg Target'
_ Expr'
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  NameTrg VarName'
x -> VarName' -> m ()
forall (m :: * -> *).
(MonadState Env m, MonadError Error m) =>
VarName' -> m ()
popRename VarName'
x
  TupleTrg [Target']
xs -> (Target' -> m ()) -> [Target'] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Target' -> m ()
forall (m :: * -> *).
(MonadState Env m, MonadError Error m) =>
Target' -> m ()
popTarget [Target']
xs

runExpr :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Expr' -> m Expr'
runExpr :: Expr' -> m Expr'
runExpr Expr'
e0 =
  Maybe Loc -> m Expr' -> m Expr'
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
e0) (m Expr' -> m Expr') -> m Expr' -> m Expr'
forall a b. (a -> b) -> a -> b
$
    Maybe Loc -> Expr -> Expr'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
e0) (Expr -> Expr') -> m Expr -> m Expr'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Expr' -> Expr
forall a. WithLoc' a -> a
value' Expr'
e0 of
      BoolOp Expr'
e1 BoolOp
op Expr'
e2 -> Expr' -> BoolOp -> Expr' -> Expr
BoolOp (Expr' -> BoolOp -> Expr' -> Expr)
-> m Expr' -> m (BoolOp -> Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e1 m (BoolOp -> Expr' -> Expr) -> m BoolOp -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BoolOp -> m BoolOp
forall (m :: * -> *) a. Monad m => a -> m a
return BoolOp
op 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e2
      BinOp Expr'
e1 Operator
op Expr'
e2 -> Expr' -> Operator -> Expr' -> Expr
BinOp (Expr' -> Operator -> Expr' -> Expr)
-> m Expr' -> m (Operator -> Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e1 m (Operator -> Expr' -> Expr) -> m Operator -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Operator -> m Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
op 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e2
      UnaryOp UnaryOp
op Expr'
e -> UnaryOp -> Expr' -> Expr
UnaryOp 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
      Lambda [(VarName', Type)]
args Expr'
body ->
        m Expr -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadState Env m) =>
m a -> m a
withToplevelScope (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
          [(VarName', Type)]
args <- [(VarName', Type)]
-> ((VarName', Type) -> m (VarName', Type)) -> m [(VarName', Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName', Type)]
args (((VarName', Type) -> m (VarName', Type)) -> m [(VarName', Type)])
-> ((VarName', Type) -> m (VarName', Type)) -> m [(VarName', Type)]
forall a b. (a -> b) -> a -> b
$ \(VarName'
x, Type
t) -> do
            VarName'
y <- VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m) =>
VarName' -> m VarName'
renameLocalNew VarName'
x
            (VarName', Type) -> m (VarName', Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName'
y, Type
t)
          Expr'
body <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
body
          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', Type)] -> Expr' -> Expr
Lambda [(VarName', Type)]
args Expr'
body
      IfExp Expr'
e1 Expr'
e2 Expr'
e3 -> Expr' -> Expr' -> Expr' -> Expr
IfExp (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 Env m, MonadAlpha m, MonadError Error 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 Env m, MonadAlpha m, MonadError Error 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e3
      ListComp Expr'
e (Comprehension Target'
x Expr'
iter Maybe Expr'
ifs) -> do
        Expr'
iter <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
iter
        Target'
y <- Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Target' -> m Target'
runAnnTarget Target'
x
        Maybe Expr'
ifs <- (Expr' -> m Expr') -> Maybe Expr' -> m (Maybe 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Maybe Expr'
ifs
        Expr'
e <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
        Target' -> m ()
forall (m :: * -> *).
(MonadState Env m, MonadError Error m) =>
Target' -> m ()
popTarget Target'
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
$ Expr' -> Comprehension -> Expr
ListComp Expr'
e (Target' -> Expr' -> Maybe Expr' -> Comprehension
Comprehension Target'
y Expr'
iter Maybe Expr'
ifs)
      Compare Expr'
e1 CmpOp'
op Expr'
e2 -> Expr' -> CmpOp' -> Expr' -> Expr
Compare (Expr' -> CmpOp' -> Expr' -> Expr)
-> m Expr' -> m (CmpOp' -> Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e1 m (CmpOp' -> Expr' -> Expr) -> m CmpOp' -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmpOp' -> m CmpOp'
forall (m :: * -> *) a. Monad m => a -> m a
return CmpOp'
op 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e2
      Call Expr'
f [Expr']
args -> Expr' -> [Expr'] -> Expr
Call (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 Env m, MonadAlpha m, MonadError Error 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr [Expr']
args
      Constant Constant
const -> 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
$ Constant -> Expr
Constant Constant
const
      Attribute Expr'
e Attribute'
x -> Expr' -> Attribute' -> Expr
Attribute (Expr' -> Attribute' -> Expr) -> m Expr' -> m (Attribute' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e m (Attribute' -> Expr) -> m Attribute' -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Attribute' -> m Attribute'
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute'
x
      Subscript Expr'
e1 Expr'
e2 -> Expr' -> Expr' -> Expr
Subscript (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 Env m, MonadAlpha m, MonadError Error 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e2
      Starred Expr'
e -> Expr' -> Expr
Starred (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
      Name VarName'
x -> VarName' -> Expr
Name (VarName' -> Expr) -> m VarName' -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName' -> m VarName'
forall (m :: * -> *).
(MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
lookupName' VarName'
x
      List Type
t [Expr']
es -> Type -> [Expr'] -> Expr
List Type
t ([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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr [Expr']
es
      Tuple [Expr']
es -> [Expr'] -> Expr
Tuple ([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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr [Expr']
es
      SubscriptSlice Expr'
e Maybe Expr'
from Maybe Expr'
to Maybe Expr'
step -> Expr' -> Maybe Expr' -> Maybe Expr' -> Maybe Expr' -> Expr
SubscriptSlice (Expr' -> Maybe Expr' -> Maybe Expr' -> Maybe Expr' -> Expr)
-> m Expr' -> m (Maybe Expr' -> Maybe Expr' -> Maybe Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e m (Maybe Expr' -> Maybe Expr' -> Maybe Expr' -> Expr)
-> m (Maybe Expr') -> m (Maybe Expr' -> Maybe Expr' -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr' -> m Expr') -> Maybe Expr' -> m (Maybe 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Maybe Expr'
from m (Maybe Expr' -> Maybe Expr' -> Expr)
-> m (Maybe Expr') -> m (Maybe Expr' -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr' -> m Expr') -> Maybe Expr' -> m (Maybe 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Maybe Expr'
to m (Maybe Expr' -> Expr) -> m (Maybe Expr') -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr' -> m Expr') -> Maybe Expr' -> m (Maybe 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 Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Maybe Expr'
step

runStatement :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Statement -> m Statement
runStatement :: Statement -> m Statement
runStatement = \case
  Return Expr'
e -> Expr' -> Statement
Return (Expr' -> Statement) -> m Expr' -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
  AugAssign Target'
x Operator
op Expr'
e -> do
    Expr'
e <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
    Target'
x <- Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Target' -> m Target'
runAugTarget Target'
x
    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
$ Target' -> Operator -> Expr' -> Statement
AugAssign Target'
x Operator
op Expr'
e
  AnnAssign Target'
x Type
t Expr'
e -> do
    Expr'
e <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e -- visit e before x
    Target'
x <- Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Target' -> m Target'
runAnnTarget Target'
x
    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
$ Target' -> Type -> Expr' -> Statement
AnnAssign Target'
x Type
t Expr'
e
  For Target'
x Expr'
e [Statement]
body -> do
    Expr'
e <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
    m Statement -> m Statement
forall (m :: * -> *) a.
(MonadError Error m, MonadState Env m) =>
m a -> m a
withScope (m Statement -> m Statement) -> m Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ do
      Target'
y <- Target' -> m Target'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Target' -> m Target'
runForTarget Target'
x
      [Statement]
body <- [Statement] -> m [Statement]
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
[Statement] -> m [Statement]
runStatements [Statement]
body
      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
$ Target' -> Expr' -> [Statement] -> Statement
For Target'
y Expr'
e [Statement]
body
  If Expr'
e [Statement]
body1 [Statement]
body2 -> do
    Expr'
e <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
    let (ReadList
_, WriteList [VarName]
w1) = [Statement] -> (ReadList, WriteList)
analyzeStatementsMin [Statement]
body1
    let (ReadList
_, WriteList [VarName]
w2) = [Statement] -> (ReadList, WriteList)
analyzeStatementsMin [Statement]
body2
    [VarName] -> (VarName -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([VarName]
w1 [VarName] -> [VarName] -> [VarName]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [VarName]
w2) ((VarName -> m ()) -> m ()) -> (VarName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \VarName
x -> do
      Bool
isLocallyUndefined <- Maybe VarName' -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe VarName' -> Bool) -> (Env -> Maybe VarName') -> Env -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName' -> Env -> Maybe VarName'
lookupLocalName (VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc VarName
x) (Env -> Bool) -> m Env -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Env
forall s (m :: * -> *). MonadState s m => m s
get
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isLocallyUndefined (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m) =>
VarName' -> m VarName'
renameLocalNew (VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc VarName
x) -- introduce variables to the parent scope
        () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [Statement]
body1 <- m [Statement] -> m [Statement]
forall (m :: * -> *) a.
(MonadError Error m, MonadState Env m) =>
m a -> m a
withScope (m [Statement] -> m [Statement]) -> m [Statement] -> m [Statement]
forall a b. (a -> b) -> a -> b
$ do
      [Statement] -> m [Statement]
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
[Statement] -> m [Statement]
runStatements [Statement]
body1
    [Statement]
body2 <- m [Statement] -> m [Statement]
forall (m :: * -> *) a.
(MonadError Error m, MonadState Env m) =>
m a -> m a
withScope (m [Statement] -> m [Statement]) -> m [Statement] -> m [Statement]
forall a b. (a -> b) -> a -> b
$ do
      [Statement] -> m [Statement]
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
[Statement] -> m [Statement]
runStatements [Statement]
body2
    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
$ Expr' -> [Statement] -> [Statement] -> Statement
If Expr'
e [Statement]
body1 [Statement]
body2
  Assert Expr'
e -> Expr' -> Statement
Assert (Expr' -> Statement) -> m Expr' -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e
  Expr' Expr'
e -> Expr' -> Statement
Expr' (Expr' -> Statement) -> m Expr' -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e

runStatements :: (MonadState Env m, MonadAlpha m, MonadError Error m) => [Statement] -> m [Statement]
runStatements :: [Statement] -> m [Statement]
runStatements [Statement]
stmts = [Either Error Statement] -> m [Statement]
forall (m :: * -> *) a.
MonadError Error m =>
[Either Error a] -> m [a]
reportErrors ([Either Error Statement] -> m [Statement])
-> m [Either Error Statement] -> m [Statement]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Statement -> m (Either Error Statement))
-> [Statement] -> m [Either Error Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m Statement -> m (Either Error Statement)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
catchError' (m Statement -> m (Either Error Statement))
-> (Statement -> m Statement)
-> Statement
-> m (Either Error Statement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> m Statement
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Statement -> m Statement
runStatement) [Statement]
stmts

runToplevelStatement :: (MonadState Env m, MonadAlpha m, MonadError Error m) => ToplevelStatement -> m ToplevelStatement
runToplevelStatement :: ToplevelStatement -> m ToplevelStatement
runToplevelStatement = \case
  ToplevelAnnAssign VarName'
x Type
t Expr'
e -> do
    Expr'
e <- Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e -- visit e before x
    VarName'
y <- VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
renameToplevel VarName'
x
    ToplevelStatement -> m ToplevelStatement
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelStatement -> m ToplevelStatement)
-> ToplevelStatement -> m ToplevelStatement
forall a b. (a -> b) -> a -> b
$ VarName' -> Type -> Expr' -> ToplevelStatement
ToplevelAnnAssign VarName'
y Type
t Expr'
e
  ToplevelFunctionDef VarName'
f [(VarName', Type)]
args Type
ret [Statement]
body -> do
    VarName'
g <- VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
renameToplevel VarName'
f
    m ToplevelStatement -> m ToplevelStatement
forall (m :: * -> *) a.
(MonadError Error m, MonadState Env m) =>
m a -> m a
withToplevelScope (m ToplevelStatement -> m ToplevelStatement)
-> m ToplevelStatement -> m ToplevelStatement
forall a b. (a -> b) -> a -> b
$ do
      [(VarName', Type)]
args <- [(VarName', Type)]
-> ((VarName', Type) -> m (VarName', Type)) -> m [(VarName', Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName', Type)]
args (((VarName', Type) -> m (VarName', Type)) -> m [(VarName', Type)])
-> ((VarName', Type) -> m (VarName', Type)) -> m [(VarName', Type)]
forall a b. (a -> b) -> a -> b
$ \(VarName'
x, Type
t) -> do
        VarName'
y <- VarName' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadState Env m, MonadError Error m) =>
VarName' -> m VarName'
renameToplevelArgument VarName'
x
        (VarName', Type) -> m (VarName', Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName'
y, Type
t)
      [Statement]
body <- [Statement] -> m [Statement]
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
[Statement] -> m [Statement]
runStatements [Statement]
body
      ToplevelStatement -> m ToplevelStatement
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelStatement -> m ToplevelStatement)
-> ToplevelStatement -> m ToplevelStatement
forall a b. (a -> b) -> a -> b
$ VarName'
-> [(VarName', Type)] -> Type -> [Statement] -> ToplevelStatement
ToplevelFunctionDef VarName'
g [(VarName', Type)]
args Type
ret [Statement]
body
  ToplevelAssert Expr'
e -> Expr' -> ToplevelStatement
ToplevelAssert (Expr' -> ToplevelStatement) -> m Expr' -> m ToplevelStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr'
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr'
runExpr Expr'
e

runProgram :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Program -> m Program
runProgram :: Program -> m Program
runProgram Program
prog = [Either Error ToplevelStatement] -> m Program
forall (m :: * -> *) a.
MonadError Error m =>
[Either Error a] -> m [a]
reportErrors ([Either Error ToplevelStatement] -> m Program)
-> m [Either Error ToplevelStatement] -> m Program
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ToplevelStatement -> m (Either Error ToplevelStatement))
-> Program -> m [Either Error ToplevelStatement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m ToplevelStatement -> m (Either Error ToplevelStatement)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
catchError' (m ToplevelStatement -> m (Either Error ToplevelStatement))
-> (ToplevelStatement -> m ToplevelStatement)
-> ToplevelStatement
-> m (Either Error ToplevelStatement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToplevelStatement -> m ToplevelStatement
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
ToplevelStatement -> m ToplevelStatement
runToplevelStatement) Program
prog

-- | `run` renames variables.
-- This assumes `doesntHaveAssignmentToBuiltin`.
--
-- * This introduce a new name for each assignment if possible.
--   For example, the following
--
--   > x = 21
--   > x += x
--   > x = 42
--   > x += x
--   > for _ in range(100):
--   >     x = x + 1
--   > x = x + 1
--
--   turns the following
--
--   > x0 = 21
--   > x1 += x0
--   > x2 = 42
--   > x3 += x2
--   > for a4 in range(100):
--   >     x3 = x3 + 1
--   > x5 = x3 + 1
--
-- * This blames leaks of loop counters of for-statements, i.e. `doesntHaveLeakOfLoopCounters`.
--   For example, the followings is not allowed.
--
--   > for i in range(10):
--   >     a = 0
--   > return a  # error
--
-- * This blames leaks of names from for-statements and if-statements at all.
--   For example, the followings are not allowed.
--
--   > if True:
--   >     a = 0
--   > else:
--   >     b = 1
--   > return a  # error
--
--   > for i in range(10):
--   >     a = 0
--   > return a  # error
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.RestrictedPython.Convert.Alpha" (m Program -> m Program) -> m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
  Program -> m ()
forall (m :: * -> *). MonadError Error m => Program -> m ()
ensureDoesntHaveLeakOfLoopCounters Program
prog
  Program -> m ()
forall (m :: * -> *). MonadError Error m => Program -> m ()
ensureDoesntHaveAssignmentToBuiltin Program
prog
  StateT Env m Program -> Env -> m Program
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Program -> StateT Env m Program
forall (m :: * -> *).
(MonadState Env m, MonadAlpha m, MonadError Error m) =>
Program -> m Program
runProgram Program
prog) Env
initialEnv