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

-- |
-- Module      : Jikka.Python.Convert.ToRestrictedPython
-- Description : converts AST of the standard Python to AST of our restricted Python. / 標準の Python の抽象構文木を我々の restricted Python の抽象構文木に変換します。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.Python.Convert.ToRestrictedPython
  ( run,
  )
where

import Control.Monad.Except
import Jikka.Common.Alpha
import Jikka.Common.Error
import Jikka.Common.Location
import qualified Jikka.Python.Language.Expr as X
import qualified Jikka.RestrictedPython.Language.Expr as Y
import qualified Jikka.RestrictedPython.Language.Util as Y (genType)

-- ---------------------------------------------------------------------------
-- convert AST

runIdent :: X.Ident' -> Y.VarName'
runIdent :: Ident' -> VarName'
runIdent (WithLoc Loc
loc (X.Ident String
x)) = Maybe Loc -> VarName -> VarName'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
loc) (String -> VarName
Y.VarName String
x)

runAttribute :: X.Ident' -> Y.Attribute'
runAttribute :: Ident' -> Attribute'
runAttribute (WithLoc Loc
loc (X.Ident String
x)) = Maybe Loc -> Attribute -> Attribute'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
loc) (AttributeName -> Attribute
Y.UnresolvedAttribute (String -> AttributeName
Y.AttributeName String
x))

runType :: (MonadAlpha m, MonadError Error m) => X.Type' -> m Y.Type
runType :: Type' -> m Type
runType Type'
t = Loc -> m Type -> m Type
forall (m :: * -> *) a. MonadError Error m => Loc -> m a -> m a
wrapAt (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
t) (m Type -> m Type) -> m Type -> m Type
forall a b. (a -> b) -> a -> b
$ case Type' -> Expr
forall a. WithLoc a -> a
value Type'
t of
  X.Constant (X.ConstString String
_) -> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
  X.Constant Constant
X.ConstNone -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.NoneTy
  X.Name (WithLoc Loc
_ (X.Ident String
"int")) -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.IntTy
  X.Name (WithLoc Loc
_ (X.Ident String
"bool")) -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.BoolTy
  X.Subscript (WithLoc Loc
_ (X.Name (WithLoc Loc
_ (X.Ident String
f)))) Type'
e -> case (String
f, Type'
e) of
    (String
"List", Type'
_) -> Type -> Type
Y.ListTy (Type -> Type) -> m Type -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
e
    (String
"Iterator", Type'
_) -> Type -> Type
Y.ListTy (Type -> Type) -> m Type -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
e
    (String
"Sequence", Type'
_) -> Type -> Type
Y.ListTy (Type -> Type) -> m Type -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
e
    (String
"Tuple", WithLoc Loc
_ (X.Tuple [Type']
es)) -> [Type] -> Type
Y.TupleTy ([Type] -> Type) -> m [Type] -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type' -> m Type) -> [Type'] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType [Type']
es
    (String
"Tuple", Type'
_) -> [Type] -> Type
Y.TupleTy ([Type] -> Type) -> (Type -> [Type]) -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: []) (Type -> Type) -> m Type -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
e
    (String
"Callable", WithLoc Loc
_ (X.Tuple [WithLoc Loc
_ (X.List [Type']
es), Type'
e])) -> do
      [Type]
ts <- (Type' -> m Type) -> [Type'] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType [Type']
es
      Type
t <- Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
e
      Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ [Type] -> Type -> Type
Y.CallableTy [Type]
ts Type
t
    (String, Type')
_ -> String -> m Type
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError (String
"not a type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type' -> String
forall a. Show a => a -> String
show Type'
t)
  Expr
_ -> String -> m Type
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError (String
"not a type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type' -> String
forall a. Show a => a -> String
show Type'
t)

runMaybeType :: (MonadAlpha m, MonadError Error m) => Maybe X.Type' -> m Y.Type
runMaybeType :: Maybe Type' -> m Type
runMaybeType Maybe Type'
Nothing = m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
runMaybeType (Just Type'
t) = Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
t

runConstant :: MonadError Error m => X.Constant -> m Y.Constant
runConstant :: Constant -> m Constant
runConstant = \case
  Constant
X.ConstNone -> Constant -> m Constant
forall (m :: * -> *) a. Monad m => a -> m a
return Constant
Y.ConstNone
  X.ConstInt Integer
n -> Constant -> m Constant
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant -> m Constant) -> Constant -> m Constant
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
Y.ConstInt Integer
n
  X.ConstBool Bool
p -> Constant -> m Constant
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant -> m Constant) -> Constant -> m Constant
forall a b. (a -> b) -> a -> b
$ Bool -> Constant
Y.ConstBool Bool
p
  Constant
e -> String -> m Constant
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError (String
"unsupported constant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Constant -> String
forall a. Show a => a -> String
show Constant
e)

runTargetName :: (MonadAlpha m, MonadError Error m) => X.Expr' -> m Y.VarName'
runTargetName :: Type' -> m VarName'
runTargetName Type'
e = case Type' -> Expr
forall a. WithLoc a -> a
value Type'
e of
  X.Name Ident'
x -> VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName' -> m VarName') -> VarName' -> m VarName'
forall a b. (a -> b) -> a -> b
$ Ident' -> VarName'
runIdent Ident'
x
  Expr
_ -> Loc -> String -> m VarName'
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwSemanticErrorAt (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e) (String
"not an assignment target: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type' -> String
forall a. Show a => a -> String
show Type'
e)

runTarget :: (MonadAlpha m, MonadError Error m) => X.Expr' -> m Y.Target'
runTarget :: Type' -> m Target'
runTarget Type'
e =
  Maybe Loc -> Target -> Target'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Loc -> Maybe Loc
forall a. a -> Maybe a
Just (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e)) (Target -> Target') -> m Target -> m Target'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Type' -> Expr
forall a. WithLoc a -> a
value Type'
e of
    X.Subscript Type'
f Type'
index -> Target' -> Expr' -> Target
Y.SubscriptTrg (Target' -> Expr' -> Target) -> m Target' -> m (Expr' -> Target)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Target'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Target'
runTarget Type'
f m (Expr' -> Target) -> m Expr' -> m Target
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
index
    X.Name Ident'
_ -> VarName' -> Target
Y.NameTrg (VarName' -> Target) -> m VarName' -> m Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m VarName'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m VarName'
runTargetName Type'
e
    X.Tuple [Type']
es -> [Target'] -> Target
Y.TupleTrg ([Target'] -> Target) -> m [Target'] -> m Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type' -> m Target') -> [Type'] -> m [Target']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Target'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Target'
runTarget [Type']
es
    Expr
_ -> Loc -> String -> m Target
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwSemanticErrorAt (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e) (String
"not an assignment target: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type' -> String
forall a. Show a => a -> String
show Type'
e)

runTargetIdent :: MonadError Error m => X.Expr' -> m Y.VarName'
runTargetIdent :: Type' -> m VarName'
runTargetIdent Type'
e = case Type' -> Expr
forall a. WithLoc a -> a
value Type'
e of
  X.Name Ident'
x -> VarName' -> m VarName'
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName' -> m VarName') -> VarName' -> m VarName'
forall a b. (a -> b) -> a -> b
$ Ident' -> VarName'
runIdent Ident'
x
  Expr
_ -> Loc -> String -> m VarName'
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwSemanticErrorAt (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e) (String
"not an simple assignment target: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type' -> String
forall a. Show a => a -> String
show Type'
e)

runComprehension :: (MonadAlpha m, MonadError Error m) => [X.Comprehension] -> m Y.Comprehension
runComprehension :: [Comprehension] -> m Comprehension
runComprehension = \case
  [Comprehension
comp] -> do
    Target'
x <- Type' -> m Target'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Target'
runTarget (Comprehension -> Type'
X.compTarget Comprehension
comp)
    Expr'
iter <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr (Comprehension -> Type'
X.compIter Comprehension
comp)
    Maybe Expr'
ifs <- (Type' -> m Expr') -> Maybe Type' -> m (Maybe Expr')
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr (Comprehension -> Maybe Type'
X.compIfs Comprehension
comp)
    Comprehension -> m Comprehension
forall (m :: * -> *) a. Monad m => a -> m a
return (Comprehension -> m Comprehension)
-> Comprehension -> m Comprehension
forall a b. (a -> b) -> a -> b
$ Target' -> Expr' -> Maybe Expr' -> Comprehension
Y.Comprehension Target'
x Expr'
iter Maybe Expr'
ifs
  [Comprehension]
comp -> String -> m Comprehension
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError (String
"many comprehensions are unsupported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Comprehension] -> String
forall a. Show a => a -> String
show [Comprehension]
comp)

runArguments :: (MonadAlpha m, MonadError Error m) => X.Arguments -> m [(Y.VarName', Y.Type)]
runArguments :: Arguments -> m [(VarName', Type)]
runArguments = \case
  X.Arguments
    { argsPosonlyargs :: Arguments -> [Arg]
X.argsPosonlyargs = [],
      argsArgs :: Arguments -> [Arg]
X.argsArgs = [Arg]
args,
      argsVarargs :: Arguments -> Maybe Arg
X.argsVarargs = Maybe Arg
Nothing,
      argsKwonlyargs :: Arguments -> [Arg]
X.argsKwonlyargs = [],
      argsKwDefaults :: Arguments -> [Type']
X.argsKwDefaults = [],
      argsKwarg :: Arguments -> Maybe Arg
X.argsKwarg = Maybe Arg
Nothing,
      argsDefaults :: Arguments -> [Type']
X.argsDefaults = []
    } -> do
      [Arg] -> (Arg -> m (VarName', Type)) -> m [(VarName', Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Arg]
args ((Arg -> m (VarName', Type)) -> m [(VarName', Type)])
-> (Arg -> m (VarName', Type)) -> m [(VarName', Type)]
forall a b. (a -> b) -> a -> b
$ \(Ident'
x, Maybe Type'
t) -> do
        let x' :: VarName'
x' = Ident' -> VarName'
runIdent Ident'
x
        Type
t <- Maybe Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Maybe Type' -> m Type
runMaybeType Maybe Type'
t
        (VarName', Type) -> m (VarName', Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName'
x', Type
t)
  Arguments
args -> String -> m [(VarName', Type)]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError (String
"unsupported arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Arguments -> String
forall a. Show a => a -> String
show Arguments
args)

runCompareExpr :: (MonadAlpha m, MonadError Error m) => X.Expr' -> [(X.CmpOp, X.Expr')] -> m Y.Expr
runCompareExpr :: Type' -> [(CmpOp, Type')] -> m Expr
runCompareExpr Type'
e1 [(CmpOp, Type')]
ops = Expr' -> Expr
forall a. WithLoc' a -> a
value' (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e1 m Expr' -> (Expr' -> m Expr') -> m Expr'
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Expr' -> [(CmpOp, Type')] -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> [(CmpOp, Type')] -> m Expr'
`go` [(CmpOp, Type')]
ops))
  where
    withLoc :: a -> WithLoc' a
withLoc = Maybe Loc -> a -> WithLoc' a
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Loc -> Maybe Loc
forall a. a -> Maybe a
Just (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e1))
    go :: (MonadAlpha m, MonadError Error m) => Y.Expr' -> [(X.CmpOp, X.Expr')] -> m Y.Expr'
    go :: Expr' -> [(CmpOp, Type')] -> m Expr'
go Expr'
e1 = \case
      [] -> Expr' -> m Expr'
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr' -> m Expr') -> (Expr -> Expr') -> Expr -> m Expr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr'
forall a. a -> WithLoc' a
withLoc (Expr -> m Expr') -> Expr -> m Expr'
forall a b. (a -> b) -> a -> b
$ Constant -> Expr
Y.Constant (Bool -> Constant
Y.ConstBool Bool
True)
      [(CmpOp
op, Type'
e2)] -> Expr -> Expr'
forall a. a -> WithLoc' a
withLoc (Expr -> Expr') -> m Expr -> m Expr'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr' -> CmpOp' -> Expr' -> Expr
Y.Compare Expr'
e1 (CmpOp' -> Expr' -> Expr) -> m CmpOp' -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CmpOp -> Type -> CmpOp'
Y.CmpOp' CmpOp
op (Type -> CmpOp') -> m Type -> m CmpOp'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType) m (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e2)
      (CmpOp
op, Type'
e2) : [(CmpOp, Type')]
ops -> do
        Type
t <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
        Expr'
e2 <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e2
        Expr'
cont <- Expr' -> [(CmpOp, Type')] -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> [(CmpOp, Type')] -> m Expr'
go Expr'
e2 [(CmpOp, Type')]
ops
        Expr' -> m Expr'
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr' -> m Expr') -> (Expr -> Expr') -> Expr -> m Expr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr'
forall a. a -> WithLoc' a
withLoc (Expr -> m Expr') -> Expr -> m Expr'
forall a b. (a -> b) -> a -> b
$ Expr' -> BoolOp -> Expr' -> Expr
Y.BoolOp (Expr -> Expr'
forall a. a -> WithLoc' a
withLoc (Expr' -> CmpOp' -> Expr' -> Expr
Y.Compare Expr'
e1 (CmpOp -> Type -> CmpOp'
Y.CmpOp' CmpOp
op Type
t) Expr'
e2)) BoolOp
Y.And Expr'
cont

runExpr :: (MonadAlpha m, MonadError Error m) => X.Expr' -> m Y.Expr'
runExpr :: Type' -> m Expr'
runExpr Type'
e =
  Maybe Loc -> Expr -> Expr'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Loc -> Maybe Loc
forall a. a -> Maybe a
Just (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e)) (Expr -> Expr') -> m Expr -> m Expr'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Type' -> Expr
forall a. WithLoc a -> a
value Type'
e of
    X.BoolOp Type'
e1 BoolOp
op Type'
e2 -> Expr' -> BoolOp -> Expr' -> Expr
Y.BoolOp (Expr' -> BoolOp -> Expr' -> Expr)
-> m Expr' -> m (BoolOp -> Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
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
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e2
    X.BinOp Type'
e1 Operator
op Type'
e2 -> Expr' -> Operator -> Expr' -> Expr
Y.BinOp (Expr' -> Operator -> Expr' -> Expr)
-> m Expr' -> m (Operator -> Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
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
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e2
    X.UnaryOp UnaryOp
op Type'
e -> UnaryOp -> Expr' -> Expr
Y.UnaryOp UnaryOp
op (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    X.Lambda Arguments
args Type'
body -> [(VarName', Type)] -> Expr' -> Expr
Y.Lambda ([(VarName', Type)] -> Expr' -> Expr)
-> m [(VarName', Type)] -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> m [(VarName', Type)]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Arguments -> m [(VarName', Type)]
runArguments Arguments
args m (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
body
    X.IfExp Type'
e1 Type'
e2 Type'
e3 -> Expr' -> Expr' -> Expr' -> Expr
Y.IfExp (Expr' -> Expr' -> Expr' -> Expr)
-> m Expr' -> m (Expr' -> Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e1 m (Expr' -> Expr' -> Expr) -> m Expr' -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e2 m (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e3
    X.ListComp Type'
e [Comprehension]
comp -> Expr' -> Comprehension -> Expr
Y.ListComp (Expr' -> Comprehension -> Expr)
-> m Expr' -> m (Comprehension -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e m (Comprehension -> Expr) -> m Comprehension -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Comprehension] -> m Comprehension
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Comprehension] -> m Comprehension
runComprehension [Comprehension]
comp
    X.GeneratorExp Type'
e [Comprehension]
comp -> Expr' -> Comprehension -> Expr
Y.ListComp (Expr' -> Comprehension -> Expr)
-> m Expr' -> m (Comprehension -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e m (Comprehension -> Expr) -> m Comprehension -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Comprehension] -> m Comprehension
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Comprehension] -> m Comprehension
runComprehension [Comprehension]
comp
    X.Compare Type'
e1 [(CmpOp, Type')]
e2 -> Type' -> [(CmpOp, Type')] -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> [(CmpOp, Type')] -> m Expr
runCompareExpr Type'
e1 [(CmpOp, Type')]
e2
    X.Call Type'
f [Type']
args [] -> Expr' -> [Expr'] -> Expr
Y.Call (Expr' -> [Expr'] -> Expr) -> m Expr' -> m ([Expr'] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
f m ([Expr'] -> Expr) -> m [Expr'] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type' -> m Expr') -> [Type'] -> m [Expr']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr [Type']
args
    X.Constant Constant
const -> Constant -> Expr
Y.Constant (Constant -> Expr) -> m Constant -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constant -> m Constant
forall (m :: * -> *). MonadError Error m => Constant -> m Constant
runConstant Constant
const
    X.Attribute Type'
e Ident'
x -> Expr' -> Attribute' -> Expr
Y.Attribute (Expr' -> Attribute' -> Expr) -> m Expr' -> m (Attribute' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
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 (Ident' -> Attribute'
runAttribute Ident'
x)
    X.Subscript Type'
e1 Type'
e2 -> case Type' -> Expr
forall a. WithLoc a -> a
value Type'
e2 of
      X.Slice Maybe Type'
from Maybe Type'
to Maybe Type'
step -> Expr' -> Maybe Expr' -> Maybe Expr' -> Maybe Expr' -> Expr
Y.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
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e1 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
<*> (Type' -> m Expr') -> Maybe Type' -> m (Maybe Expr')
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Maybe Type'
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
<*> (Type' -> m Expr') -> Maybe Type' -> m (Maybe Expr')
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Maybe Type'
to m (Maybe Expr' -> Expr) -> m (Maybe Expr') -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type' -> m Expr') -> Maybe Type' -> m (Maybe Expr')
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Maybe Type'
step
      Expr
_ -> Expr' -> Expr' -> Expr
Y.Subscript (Expr' -> Expr' -> Expr) -> m Expr' -> m (Expr' -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e1 m (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e2
    X.Starred Type'
e -> Expr' -> Expr
Y.Starred (Expr' -> Expr) -> m Expr' -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    X.Name Ident'
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
Y.Name (Ident' -> VarName'
runIdent Ident'
x)
    X.List [Type']
es -> Type -> [Expr'] -> Expr
Y.List (Type -> [Expr'] -> Expr) -> m Type -> m ([Expr'] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType m ([Expr'] -> Expr) -> m [Expr'] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type' -> m Expr') -> [Type'] -> m [Expr']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr [Type']
es
    X.Tuple [Type']
es -> [Expr'] -> Expr
Y.Tuple ([Expr'] -> Expr) -> m [Expr'] -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type' -> m Expr') -> [Type'] -> m [Expr']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr [Type']
es
    Expr
_ -> Loc -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwSemanticErrorAt (Type' -> Loc
forall a. WithLoc a -> Loc
loc Type'
e) (String
"unsupported expr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type' -> String
forall a. Show a => a -> String
show Type'
e)

runStatement :: (MonadAlpha m, MonadError Error m) => X.Statement' -> m [Y.Statement]
runStatement :: Statement' -> m [Statement]
runStatement Statement'
stmt = Loc -> m [Statement] -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => Loc -> m a -> m a
wrapAt (Statement' -> Loc
forall a. WithLoc a -> Loc
loc Statement'
stmt) (m [Statement] -> m [Statement]) -> m [Statement] -> m [Statement]
forall a b. (a -> b) -> a -> b
$ case Statement' -> Statement
forall a. WithLoc a -> a
value Statement'
stmt of
  X.FunctionDef Ident'
_ Arguments
_ [Statement']
_ [Type']
_ Maybe Type'
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"def statement is not allowed in def statement"
  X.AsyncFunctionDef Ident'
_ Arguments
_ [Statement']
_ [Type']
_ Maybe Type'
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"async-def statement is not allowed in def statement"
  X.ClassDef Ident'
_ [Type']
_ [Keyword']
_ [Statement']
_ [Type']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"class statement is not allowed in def statement"
  X.Return Maybe Type'
e -> do
    Expr'
e <- case Maybe Type'
e of
      Maybe Type'
Nothing -> Expr' -> m Expr'
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr' -> m Expr') -> (Expr -> Expr') -> Expr -> m Expr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Loc -> Expr -> Expr'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (Loc -> Maybe Loc
forall a. a -> Maybe a
Just (Statement' -> Loc
forall a. WithLoc a -> Loc
loc Statement'
stmt)) (Expr -> m Expr') -> Expr -> m Expr'
forall a b. (a -> b) -> a -> b
$ Constant -> Expr
Y.Constant Constant
Y.ConstNone
      Just Type'
e -> Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr' -> Statement
Y.Return Expr'
e]
  X.Delete [Type']
_ -> Loc -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwSemanticErrorAt (Statement' -> Loc
forall a. WithLoc a -> Loc
loc Statement'
stmt) String
"del statement is not allowed in def statement"
  X.Assign [Type']
xs Type'
e -> case [Type']
xs of
    [] -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Type'
x] -> do
      Target'
x <- Type' -> m Target'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Target'
runTarget Type'
x
      Type
t <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
      Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
      [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Target' -> Type -> Expr' -> Statement
Y.AnnAssign Target'
x Type
t Expr'
e]
    [Type']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"assign statement with multiple targets is not allowed in def statement"
  X.AugAssign Type'
x Operator
op Type'
e -> do
    Target'
x <- Type' -> m Target'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Target'
runTarget Type'
x
    Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Target' -> Operator -> Expr' -> Statement
Y.AugAssign Target'
x Operator
op Expr'
e]
  X.AnnAssign Type'
x Type'
t Maybe Type'
e -> case Maybe Type'
e of
    Maybe Type'
Nothing -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"annotated assignment statement without value is not allowed in def statement"
    Just Type'
e -> do
      VarName'
x <- Type' -> m VarName'
forall (m :: * -> *). MonadError Error m => Type' -> m VarName'
runTargetIdent Type'
x
      Type
t <- Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
t
      Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
      [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Target' -> Type -> Expr' -> Statement
Y.AnnAssign (Maybe Loc -> Target -> Target'
forall a. Maybe Loc -> a -> WithLoc' a
WithLoc' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) (VarName' -> Target
Y.NameTrg VarName'
x)) Type
t Expr'
e]
  X.For Type'
x Type'
e [Statement']
body [Statement']
orelse -> do
    Target'
x <- Type' -> m Target'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Target'
runTarget Type'
x
    Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [Statement]
body <- [Statement'] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Statement'] -> m [Statement]
runStatements [Statement']
body
    [Statement]
orelse <- [Statement'] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Statement'] -> m [Statement]
runStatements [Statement']
orelse
    [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
Y.For Target'
x Expr'
e [Statement]
body Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
orelse
  X.AsyncFor Type'
_ Type'
_ [Statement']
_ [Statement']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"async-for statement is not allowed in def statement"
  X.While Type'
_ [Statement']
_ [Statement']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"while statement is not allowed in def statement"
  X.If Type'
e [Statement']
body1 [Statement']
body2 -> do
    Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [Statement]
body1 <- [Statement'] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Statement'] -> m [Statement]
runStatements [Statement']
body1
    [Statement]
body2 <- [Statement'] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Statement'] -> m [Statement]
runStatements [Statement']
body2
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr' -> [Statement] -> [Statement] -> Statement
Y.If Expr'
e [Statement]
body1 [Statement]
body2]
  X.With [WithItem]
_ [Statement']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"with statement is not allowed in def statement"
  X.AsyncWith [WithItem]
_ [Statement']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"async-with statement is not allowed in def statement"
  X.Raise Maybe Type'
_ Maybe Type'
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"raise statement is not allowed in def statement"
  X.Try [Statement']
_ [ExceptHandler']
_ [Statement']
_ [Statement']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"try statement is not allowed in def statement"
  X.Assert Type'
e Maybe Type'
_ -> do
    Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr' -> Statement
Y.Assert Expr'
e]
  X.Import [Alias]
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"import statement is not allowed in def statement"
  X.ImportFrom [Ident']
_ [Alias]
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"import-from statement is not allowed in def statement"
  X.Global [Ident']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"global statement is not allowed in def statement"
  X.Nonlocal [Ident']
_ -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"nonlocal statement is not allowed in def statement"
  X.Expr' Type'
e -> do
    Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr' -> Statement
Y.Expr' Expr'
e]
  Statement
X.Pass -> [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Statement
X.Break -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"break statement is not allowed in def statement"
  Statement
X.Continue -> String -> m [Statement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"continue statement is not allowed in def statement"

runStatements :: (MonadAlpha m, MonadError Error m) => [X.Statement'] -> m [Y.Statement]
runStatements :: [Statement'] -> m [Statement]
runStatements [Statement']
stmts = do
  [Either Error [Statement]]
stmts <- (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 :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Statement' -> m [Statement]
runStatement) [Statement']
stmts
  [[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Statement]] -> [Statement]) -> m [[Statement]] -> m [Statement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either Error [Statement]] -> m [[Statement]]
forall (m :: * -> *) a.
MonadError Error m =>
[Either Error a] -> m [a]
reportErrors [Either Error [Statement]]
stmts

runToplevelStatement :: (MonadAlpha m, MonadError Error m) => X.Statement' -> m [Y.ToplevelStatement]
runToplevelStatement :: Statement' -> m [ToplevelStatement]
runToplevelStatement Statement'
stmt = Loc -> m [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => Loc -> m a -> m a
wrapAt (Statement' -> Loc
forall a. WithLoc a -> Loc
loc Statement'
stmt) (m [ToplevelStatement] -> m [ToplevelStatement])
-> m [ToplevelStatement] -> m [ToplevelStatement]
forall a b. (a -> b) -> a -> b
$ case Statement' -> Statement
forall a. WithLoc a -> a
value Statement'
stmt of
  X.FunctionDef Ident'
f Arguments
args [Statement']
body [Type']
decorators Maybe Type'
ret -> case [Type']
decorators of
    [] -> do
      let f' :: VarName'
f' = Ident' -> VarName'
runIdent Ident'
f
      [(VarName', Type)]
args <- Arguments -> m [(VarName', Type)]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Arguments -> m [(VarName', Type)]
runArguments Arguments
args
      [Statement]
body <- [Statement'] -> m [Statement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Statement'] -> m [Statement]
runStatements [Statement']
body
      Type
ret <- Maybe Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Maybe Type' -> m Type
runMaybeType Maybe Type'
ret
      [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [VarName'
-> [(VarName', Type)] -> Type -> [Statement] -> ToplevelStatement
Y.ToplevelFunctionDef VarName'
f' [(VarName', Type)]
args Type
ret [Statement]
body]
    [Type']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"def statement with decorators is not allowed at toplevel"
  X.AsyncFunctionDef Ident'
_ Arguments
_ [Statement']
_ [Type']
_ Maybe Type'
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"async-def statement is not allowed at toplevel"
  X.ClassDef Ident'
_ [Type']
_ [Keyword']
_ [Statement']
_ [Type']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"class statement is not allowed at toplevel"
  X.Return Maybe Type'
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"retrun statement is not allowed at toplevel"
  X.Delete [Type']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"del statement is not allowed at toplevel"
  X.Assign [Type']
xs Type'
e -> case [Type']
xs of
    [] -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [Type'
x] -> do
      VarName'
x <- Type' -> m VarName'
forall (m :: * -> *). MonadError Error m => Type' -> m VarName'
runTargetIdent Type'
x
      Type
t <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
      Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
      [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [VarName' -> Type -> Expr' -> ToplevelStatement
Y.ToplevelAnnAssign VarName'
x Type
t Expr'
e]
    [Type']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"assignment statement with multiple targets is not allowed at toplevel"
  X.AugAssign Type'
_ Operator
_ Type'
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"augumented assignment statement is not allowed at toplevel"
  X.AnnAssign Type'
x Type'
t Maybe Type'
e -> case Maybe Type'
e of
    Maybe Type'
Nothing -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"annotated assignment statement without value is not allowed at toplevel"
    Just Type'
e -> do
      VarName'
x <- Type' -> m VarName'
forall (m :: * -> *). MonadError Error m => Type' -> m VarName'
runTargetIdent Type'
x
      Type
t <- Type' -> m Type
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Type
runType Type'
t
      Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
      [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [VarName' -> Type -> Expr' -> ToplevelStatement
Y.ToplevelAnnAssign VarName'
x Type
t Expr'
e]
  X.For Type'
_ Type'
_ [Statement']
_ [Statement']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"for statement is not allowed at toplevel"
  X.AsyncFor Type'
_ Type'
_ [Statement']
_ [Statement']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"async-for statement is not allowed at toplevel"
  X.While Type'
_ [Statement']
_ [Statement']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"while statement is not allowed at toplevel"
  X.If Type'
e [Statement']
body1 [Statement']
body2 -> case (Type'
e, [Statement']
body1, [Statement']
body2) of
    ( WithLoc Loc
_ (X.Compare (WithLoc Loc
_ (X.Name (WithLoc Loc
_ (X.Ident String
"__name__")))) [(CmpOp
X.Eq', WithLoc Loc
_ (X.Constant (X.ConstString String
"__main__")))]),
      [WithLoc Loc
_ (X.Expr' (WithLoc Loc
_ (X.Call (WithLoc Loc
_ (X.Name (WithLoc Loc
_ (X.Ident String
"main")))) [] [])))],
      []
      ) -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    (Type', [Statement'], [Statement'])
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"only `if __name__ == \"__main__\": main()' is allowed for if statements at toplevel"
  X.With [WithItem]
_ [Statement']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"with statement is not allowed at toplevel"
  X.AsyncWith [WithItem]
_ [Statement']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"async-with statement is not allowed at toplevel"
  X.Raise Maybe Type'
_ Maybe Type'
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"raise statement is not allowed at toplevel"
  X.Try [Statement']
_ [ExceptHandler']
_ [Statement']
_ [Statement']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"try statement is not allowed at toplevel"
  X.Assert Type'
e Maybe Type'
_ -> do
    Expr'
e <- Type' -> m Expr'
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Type' -> m Expr'
runExpr Type'
e
    [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr' -> ToplevelStatement
Y.ToplevelAssert Expr'
e]
  X.Import [Alias]
_ -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  X.ImportFrom [Ident']
_ [Alias]
_ -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  X.Global [Ident']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"global statement is not allowed at toplevel"
  X.Nonlocal [Ident']
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"nonlocal statement is not allowed at toplevel"
  X.Expr' Type'
e -> case Type'
e of
    WithLoc Loc
_ (X.Call (WithLoc Loc
_ (X.Name (WithLoc Loc
_ (X.Ident String
"main")))) [] []) -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Type'
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"only `main()' is allowed for expression statements at toplevel"
  Statement
X.Pass -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Statement
X.Break -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"break statement is not allowed at toplevel"
  Statement
X.Continue -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"continue statement is not allowed at toplevel"

runProgram :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program
runProgram :: [Statement'] -> m [ToplevelStatement]
runProgram [Statement']
stmts = do
  [Either Error [ToplevelStatement]]
stmts <- (Statement' -> m (Either Error [ToplevelStatement]))
-> [Statement'] -> 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]))
-> (Statement' -> m [ToplevelStatement])
-> Statement'
-> m (Either Error [ToplevelStatement])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement' -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Statement' -> m [ToplevelStatement]
runToplevelStatement) [Statement']
stmts
  [[ToplevelStatement]] -> [ToplevelStatement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ToplevelStatement]] -> [ToplevelStatement])
-> m [[ToplevelStatement]] -> m [ToplevelStatement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either Error [ToplevelStatement]] -> m [[ToplevelStatement]]
forall (m :: * -> *) a.
MonadError Error m =>
[Either Error a] -> m [a]
reportErrors [Either Error [ToplevelStatement]]
stmts

run :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program
run :: [Statement'] -> m [ToplevelStatement]
run [Statement']
prog = String -> m [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Failed at Jikka.Python.Convert.ToplevelDecl" (m [ToplevelStatement] -> m [ToplevelStatement])
-> m [ToplevelStatement] -> m [ToplevelStatement]
forall a b. (a -> b) -> a -> b
$ [Statement'] -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[Statement'] -> m [ToplevelStatement]
runProgram [Statement']
prog