{-# LANGUAGE TupleSections #-}

{- |
Module      : Language.Egison.Desugar
Licence     : MIT

This module provides desugar functions.
-}

module Language.Egison.Desugar
    ( desugarTopExpr
    , desugarTopExprs
    , desugarExpr
    ) where

import           Control.Monad.Except   (throwError)
import           Data.Char              (toUpper)
import           Data.Foldable          (foldrM)
import           Data.List              (union)

import           Language.Egison.AST
import           Language.Egison.Data
import           Language.Egison.IExpr
import           Language.Egison.RState


desugarTopExpr :: TopExpr -> EvalM (Maybe ITopExpr)
desugarTopExpr :: TopExpr -> EvalM (Maybe ITopExpr)
desugarTopExpr (Define VarWithIndices
vwi Expr
expr) = do
  (Var
var, IExpr
iexpr) <- VarWithIndices -> Expr -> EvalM (Var, IExpr)
desugarDefineWithIndices VarWithIndices
vwi Expr
expr
  Maybe ITopExpr -> EvalM (Maybe ITopExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ITopExpr -> EvalM (Maybe ITopExpr))
-> (ITopExpr -> Maybe ITopExpr)
-> ITopExpr
-> EvalM (Maybe ITopExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ITopExpr -> Maybe ITopExpr
forall a. a -> Maybe a
Just (ITopExpr -> EvalM (Maybe ITopExpr))
-> ITopExpr -> EvalM (Maybe ITopExpr)
forall a b. (a -> b) -> a -> b
$ Var -> IExpr -> ITopExpr
IDefine Var
var IExpr
iexpr
desugarTopExpr (Test Expr
expr)     = ITopExpr -> Maybe ITopExpr
forall a. a -> Maybe a
Just (ITopExpr -> Maybe ITopExpr)
-> (IExpr -> ITopExpr) -> IExpr -> Maybe ITopExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> ITopExpr
ITest (IExpr -> Maybe ITopExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> EvalM (Maybe ITopExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
desugarTopExpr (Execute Expr
expr)  = ITopExpr -> Maybe ITopExpr
forall a. a -> Maybe a
Just (ITopExpr -> Maybe ITopExpr)
-> (IExpr -> ITopExpr) -> IExpr -> Maybe ITopExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> ITopExpr
IExecute (IExpr -> Maybe ITopExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> EvalM (Maybe ITopExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
desugarTopExpr (Load String
file)     = Maybe ITopExpr -> EvalM (Maybe ITopExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ITopExpr -> EvalM (Maybe ITopExpr))
-> (ITopExpr -> Maybe ITopExpr)
-> ITopExpr
-> EvalM (Maybe ITopExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ITopExpr -> Maybe ITopExpr
forall a. a -> Maybe a
Just (ITopExpr -> EvalM (Maybe ITopExpr))
-> ITopExpr -> EvalM (Maybe ITopExpr)
forall a b. (a -> b) -> a -> b
$ String -> ITopExpr
ILoad String
file
desugarTopExpr (LoadFile String
file) = Maybe ITopExpr -> EvalM (Maybe ITopExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ITopExpr -> EvalM (Maybe ITopExpr))
-> (ITopExpr -> Maybe ITopExpr)
-> ITopExpr
-> EvalM (Maybe ITopExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ITopExpr -> Maybe ITopExpr
forall a. a -> Maybe a
Just (ITopExpr -> EvalM (Maybe ITopExpr))
-> ITopExpr -> EvalM (Maybe ITopExpr)
forall a b. (a -> b) -> a -> b
$ String -> ITopExpr
ILoadFile String
file
desugarTopExpr TopExpr
_               = Maybe ITopExpr -> EvalM (Maybe ITopExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ITopExpr
forall a. Maybe a
Nothing

desugarTopExprs :: [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs :: [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs [] = [ITopExpr] -> EvalM [ITopExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return []
desugarTopExprs (TopExpr
expr : [TopExpr]
exprs) = do
  Maybe ITopExpr
expr' <- TopExpr -> EvalM (Maybe ITopExpr)
desugarTopExpr TopExpr
expr
  case Maybe ITopExpr
expr' of
    Maybe ITopExpr
Nothing    -> [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs [TopExpr]
exprs
    Just ITopExpr
expr' -> (ITopExpr
expr' ITopExpr -> [ITopExpr] -> [ITopExpr]
forall a. a -> [a] -> [a]
:) ([ITopExpr] -> [ITopExpr]) -> EvalM [ITopExpr] -> EvalM [ITopExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TopExpr] -> EvalM [ITopExpr]
desugarTopExprs [TopExpr]
exprs

desugarExpr :: Expr -> EvalM IExpr
desugarExpr :: Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugarExpr = Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar

desugar :: Expr -> EvalM IExpr
desugar :: Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (ConstantExpr ConstantExpr
c) = IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ ConstantExpr -> IExpr
IConstantExpr ConstantExpr
c
desugar (VarExpr String
var)    = IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> IExpr
IVarExpr String
var

desugar (AlgebraicDataMatcherExpr [(String, [Expr])]
patterns) = do
  String
matcherName <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  let matcherRef :: IExpr
matcherRef = String -> IExpr
IVarExpr String
matcherName
  IExpr
matcher <- [(String, [Expr])]
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
genMatcherClauses [(String, [Expr])]
patterns IExpr
matcherRef
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
matcherName), IExpr
matcher)] IExpr
matcherRef
    where
      genMatcherClauses :: [(String, [Expr])] ->  IExpr -> EvalM IExpr
      genMatcherClauses :: [(String, [Expr])]
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
genMatcherClauses [(String, [Expr])]
patterns IExpr
matcher = do
        (PrimitivePatPattern, IExpr, [IBindingExpr])
main <- [(String, [Expr])]
-> IExpr -> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
genMainClause [(String, [Expr])]
patterns IExpr
matcher
        [(PrimitivePatPattern, IExpr, [IBindingExpr])]
body <- ((String, [Expr])
 -> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr]))
-> [(String, [Expr])]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(PrimitivePatPattern, IExpr, [IBindingExpr])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, [Expr])
-> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
genMatcherClause [(String, [Expr])]
patterns
        (PrimitivePatPattern, IExpr, [IBindingExpr])
footer <- EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
genSomethingClause
        let clauses :: [(PrimitivePatPattern, IExpr, [IBindingExpr])]
clauses = [(PrimitivePatPattern, IExpr, [IBindingExpr])
main] [(PrimitivePatPattern, IExpr, [IBindingExpr])]
-> [(PrimitivePatPattern, IExpr, [IBindingExpr])]
-> [(PrimitivePatPattern, IExpr, [IBindingExpr])]
forall a. [a] -> [a] -> [a]
++ [(PrimitivePatPattern, IExpr, [IBindingExpr])]
body [(PrimitivePatPattern, IExpr, [IBindingExpr])]
-> [(PrimitivePatPattern, IExpr, [IBindingExpr])]
-> [(PrimitivePatPattern, IExpr, [IBindingExpr])]
forall a. [a] -> [a] -> [a]
++ [(PrimitivePatPattern, IExpr, [IBindingExpr])
footer]
        IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [(PrimitivePatPattern, IExpr, [IBindingExpr])] -> IExpr
IMatcherExpr [(PrimitivePatPattern, IExpr, [IBindingExpr])]
clauses

      genMainClause :: [(String, [Expr])] -> IExpr -> EvalM (PrimitivePatPattern, IExpr, [(IPrimitiveDataPattern, IExpr)])
      genMainClause :: [(String, [Expr])]
-> IExpr -> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
genMainClause [(String, [Expr])]
patterns IExpr
matcher = do
        [IMatchClause]
clauses <- [(String, [Expr])] -> EvalM [IMatchClause]
genClauses [(String, [Expr])]
patterns
        (PrimitivePatPattern, IExpr, [IBindingExpr])
-> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PrimitivePatPattern
PPValuePat String
"val", [IExpr] -> IExpr
ITupleExpr [],
                [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
"tgt"),
                    PMMode -> IExpr -> IExpr -> [IMatchClause] -> IExpr
IMatchExpr PMMode
BFSMode
                               ([IExpr] -> IExpr
ITupleExpr [String -> IExpr
IVarExpr String
"val", String -> IExpr
IVarExpr String
"tgt"])
                               ([IExpr] -> IExpr
ITupleExpr [IExpr
matcher, IExpr
matcher])
                               [IMatchClause]
clauses)])
        where
          genClauses :: [(String, [Expr])] -> EvalM [IMatchClause]
          genClauses :: [(String, [Expr])] -> EvalM [IMatchClause]
genClauses [(String, [Expr])]
patterns = [IMatchClause] -> [IMatchClause] -> [IMatchClause]
forall a. [a] -> [a] -> [a]
(++) ([IMatchClause] -> [IMatchClause] -> [IMatchClause])
-> EvalM [IMatchClause]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([IMatchClause] -> [IMatchClause])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, [Expr])
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IMatchClause)
-> [(String, [Expr])] -> EvalM [IMatchClause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, [Expr])
-> StateT EvalState (ExceptT EgisonError RuntimeM) IMatchClause
genClause [(String, [Expr])]
patterns
                                     StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  ([IMatchClause] -> [IMatchClause])
-> EvalM [IMatchClause] -> EvalM [IMatchClause]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IMatchClause] -> EvalM [IMatchClause]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [([IPattern] -> IPattern
ITuplePat [IPattern
IWildCard, IPattern
IWildCard], IExpr
matchingFailure)]

          genClause :: (String, [Expr]) -> EvalM IMatchClause
          genClause :: (String, [Expr])
-> StateT EvalState (ExceptT EgisonError RuntimeM) IMatchClause
genClause (String, [Expr])
pattern = do
            (IPattern
pat0, IPattern
pat1) <- (String, [Expr]) -> EvalM (IPattern, IPattern)
genMatchingPattern (String, [Expr])
pattern
            IMatchClause
-> StateT EvalState (ExceptT EgisonError RuntimeM) IMatchClause
forall (m :: * -> *) a. Monad m => a -> m a
return ([IPattern] -> IPattern
ITuplePat [IPattern
pat0, IPattern
pat1], IExpr
matchingSuccess)

          genMatchingPattern :: (String, [Expr]) -> EvalM (IPattern, IPattern)
          genMatchingPattern :: (String, [Expr]) -> EvalM (IPattern, IPattern)
genMatchingPattern (String
name, [Expr]
patterns) = do
            [String]
names <- (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT EvalState (ExceptT EgisonError RuntimeM) String
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. a -> b -> a
const StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh) [Expr]
patterns
            (IPattern, IPattern) -> EvalM (IPattern, IPattern)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [IPattern] -> IPattern
IInductivePat String
name ((String -> IPattern) -> [String] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map String -> IPattern
IPatVar [String]
names),
                    String -> [IPattern] -> IPattern
IInductivePat String
name ((String -> IPattern) -> [String] -> [IPattern]
forall a b. (a -> b) -> [a] -> [b]
map (IExpr -> IPattern
IValuePat (IExpr -> IPattern) -> (String -> IExpr) -> String -> IPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IExpr
IVarExpr) [String]
names))

      genMatcherClause :: (String, [Expr]) -> EvalM (PrimitivePatPattern, IExpr, [(IPrimitiveDataPattern, IExpr)])
      genMatcherClause :: (String, [Expr])
-> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
genMatcherClause (String, [Expr])
pattern = do
        (PrimitivePatPattern
ppat, [IExpr]
matchers) <- (String, [Expr]) -> EvalM (PrimitivePatPattern, [IExpr])
genPrimitivePatPat (String, [Expr])
pattern
        (PDPatternBase Var
dpat, [IExpr]
body)     <- (String, [Expr]) -> EvalM (PDPatternBase Var, [IExpr])
genPrimitiveDataPat (String, [Expr])
pattern
        (PrimitivePatPattern, IExpr, [IBindingExpr])
-> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitivePatPattern
ppat, [IExpr] -> IExpr
ITupleExpr [IExpr]
matchers, [(PDPatternBase Var
dpat, [IExpr] -> IExpr
ICollectionExpr [[IExpr] -> IExpr
ITupleExpr [IExpr]
body]), (PDPatternBase Var
forall var. PDPatternBase var
PDWildCard, IExpr
matchingFailure)])

        where
          genPrimitivePatPat :: (String, [Expr]) -> EvalM (PrimitivePatPattern, [IExpr])
          genPrimitivePatPat :: (String, [Expr]) -> EvalM (PrimitivePatPattern, [IExpr])
genPrimitivePatPat (String
name, [Expr]
matchers) = do
            [PrimitivePatPattern]
patterns' <- (Expr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern)
-> [Expr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) [PrimitivePatPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern
-> Expr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern
forall a b. a -> b -> a
const (StateT
   EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern
 -> Expr
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern
-> Expr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern
forall a b. (a -> b) -> a -> b
$ PrimitivePatPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) PrimitivePatPattern
forall (m :: * -> *) a. Monad m => a -> m a
return PrimitivePatPattern
PPPatVar) [Expr]
matchers
            [IExpr]
matchers' <- (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
matchers
            (PrimitivePatPattern, [IExpr])
-> EvalM (PrimitivePatPattern, [IExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [PrimitivePatPattern] -> PrimitivePatPattern
PPInductivePat String
name [PrimitivePatPattern]
patterns', [IExpr]
matchers')

          genPrimitiveDataPat :: (String, [Expr]) -> EvalM (IPrimitiveDataPattern, [IExpr])
          genPrimitiveDataPat :: (String, [Expr]) -> EvalM (PDPatternBase Var, [IExpr])
genPrimitiveDataPat (String
name, [Expr]
patterns) = do
            [String]
patterns' <- (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT EvalState (ExceptT EgisonError RuntimeM) String
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. a -> b -> a
const StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh) [Expr]
patterns
            (PDPatternBase Var, [IExpr]) -> EvalM (PDPatternBase Var, [IExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [PDPatternBase Var] -> PDPatternBase Var
forall var. String -> [PDPatternBase var] -> PDPatternBase var
PDInductivePat (String -> String
capitalize String
name) ([PDPatternBase Var] -> PDPatternBase Var)
-> [PDPatternBase Var] -> PDPatternBase Var
forall a b. (a -> b) -> a -> b
$ (String -> PDPatternBase Var) -> [String] -> [PDPatternBase Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (Var -> PDPatternBase Var)
-> (String -> Var) -> String -> PDPatternBase Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Var
stringToVar) [String]
patterns', (String -> IExpr) -> [String] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map String -> IExpr
IVarExpr [String]
patterns')

          capitalize :: String -> String
          capitalize :: String -> String
capitalize (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs


      genSomethingClause :: EvalM (PrimitivePatPattern, IExpr, [(IPrimitiveDataPattern, IExpr)])
      genSomethingClause :: EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
genSomethingClause =
        (PrimitivePatPattern, IExpr, [IBindingExpr])
-> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimitivePatPattern
PPPatVar, [IExpr] -> IExpr
ITupleExpr [ConstantExpr -> IExpr
IConstantExpr ConstantExpr
SomethingExpr], [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
"tgt"), [IExpr] -> IExpr
ICollectionExpr [String -> IExpr
IVarExpr String
"tgt"])])

      matchingSuccess :: IExpr
      matchingSuccess :: IExpr
matchingSuccess = [IExpr] -> IExpr
ICollectionExpr [[IExpr] -> IExpr
ITupleExpr []]

      matchingFailure :: IExpr
      matchingFailure :: IExpr
matchingFailure = [IExpr] -> IExpr
ICollectionExpr []

desugar (MatchAllLambdaExpr Expr
matcher [MatchClause]
clauses) = do
  String
name <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [String -> Var
stringToVar String
name] (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (PMMode -> Expr -> Expr -> [MatchClause] -> Expr
MatchAllExpr PMMode
BFSMode (String -> Expr
VarExpr String
name) Expr
matcher [MatchClause]
clauses)

desugar (MatchLambdaExpr Expr
matcher [MatchClause]
clauses) = do
  String
name <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [String -> Var
stringToVar String
name] (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (PMMode -> Expr -> Expr -> [MatchClause] -> Expr
MatchExpr PMMode
BFSMode (String -> Expr
VarExpr String
name) Expr
matcher [MatchClause]
clauses)

desugar (IndexedExpr Bool
b Expr
expr [IndexExpr Expr]
indices) = do
  IExpr
expr' <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
  Bool
-> IExpr
-> [IndexExpr Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugarIndexedExpr Bool
b IExpr
expr' [IndexExpr Expr]
indices
  where
    desugarIndexedExpr :: Bool -> IExpr -> [IndexExpr Expr] -> EvalM IExpr
    desugarIndexedExpr :: Bool
-> IExpr
-> [IndexExpr Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugarIndexedExpr Bool
b IExpr
expr' [IndexExpr Expr]
indices =
      case [IndexExpr Expr]
indices of
        [] -> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return IExpr
expr'
        (MultiSubscript Expr
x Expr
y:[IndexExpr Expr]
indices') ->
          case (Expr
x, Expr
y) of
            (IndexedExpr Bool
b1 Expr
e1 [IndexExpr Expr
n1], IndexedExpr Bool
_ Expr
_ [IndexExpr Expr
n2]) -> do
              IExpr
expr'' <- Bool
-> IExpr
-> (Bool -> IExpr -> IExpr -> IExpr)
-> Bool
-> Expr
-> IndexExpr Expr
-> IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall t t b.
t
-> t
-> (t -> t -> IExpr -> b)
-> Bool
-> Expr
-> IndexExpr Expr
-> IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
desugarMultiScript Bool
b IExpr
expr' Bool -> IExpr -> IExpr -> IExpr
ISubrefsExpr Bool
b1 Expr
e1 IndexExpr Expr
n1 IndexExpr Expr
n2
              Bool
-> IExpr
-> [IndexExpr Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugarIndexedExpr Bool
False IExpr
expr'' [IndexExpr Expr]
indices'
            (Expr, Expr)
_ -> EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"Index should be IndexedExpr for multi subscript"
        (MultiSuperscript Expr
x Expr
y:[IndexExpr Expr]
indices') ->
          case (Expr
x, Expr
y) of
            (IndexedExpr Bool
b1 Expr
e1 [IndexExpr Expr
n1], IndexedExpr Bool
_ Expr
_ [IndexExpr Expr
n2]) -> do
              IExpr
expr'' <- Bool
-> IExpr
-> (Bool -> IExpr -> IExpr -> IExpr)
-> Bool
-> Expr
-> IndexExpr Expr
-> IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall t t b.
t
-> t
-> (t -> t -> IExpr -> b)
-> Bool
-> Expr
-> IndexExpr Expr
-> IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
desugarMultiScript Bool
b IExpr
expr' Bool -> IExpr -> IExpr -> IExpr
ISuprefsExpr Bool
b1 Expr
e1 IndexExpr Expr
n1 IndexExpr Expr
n2
              Bool
-> IExpr
-> [IndexExpr Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugarIndexedExpr Bool
False IExpr
expr'' [IndexExpr Expr]
indices'
            (Expr, Expr)
_ -> EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"Index should be IndexedExpr for multi superscript"
        [IndexExpr Expr]
_ -> do
          let ([IndexExpr Expr]
is, [IndexExpr Expr]
indices') = (IndexExpr Expr -> Bool)
-> [IndexExpr Expr] -> ([IndexExpr Expr], [IndexExpr Expr])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break IndexExpr Expr -> Bool
forall a. IndexExpr a -> Bool
isMulti [IndexExpr Expr]
indices
          IExpr
expr'' <- Bool -> IExpr -> [Index IExpr] -> IExpr
IIndexedExpr Bool
b IExpr
expr' ([Index IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Index IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IndexExpr Expr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr))
-> [IndexExpr Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Index IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
desugarIndex [IndexExpr Expr]
is
          Bool
-> IExpr
-> [IndexExpr Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugarIndexedExpr Bool
False IExpr
expr'' [IndexExpr Expr]
indices'
    desugarMultiScript :: t
-> t
-> (t -> t -> IExpr -> b)
-> Bool
-> Expr
-> IndexExpr Expr
-> IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) b
desugarMultiScript t
b t
expr' t -> t -> IExpr -> b
refExpr Bool
b1 Expr
e1 IndexExpr Expr
n1 IndexExpr Expr
n2 = do
      String
k     <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      IExpr
n1'   <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (IndexExpr Expr -> Expr
forall a. IndexExpr a -> a
extractIndexExpr IndexExpr Expr
n1)
      IExpr
n2'   <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (IndexExpr Expr -> Expr
forall a. IndexExpr a -> a
extractIndexExpr IndexExpr Expr
n2)
      IExpr
e1'   <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
e1
      b -> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> StateT EvalState (ExceptT EgisonError RuntimeM) b)
-> b -> StateT EvalState (ExceptT EgisonError RuntimeM) b
forall a b. (a -> b) -> a -> b
$ t -> t -> IExpr -> b
refExpr t
b t
expr' (String -> [IExpr] -> IExpr
makeIApply String
"map"
                                           [Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [String -> Var
stringToVar String
k] (Bool -> IExpr -> [Index IExpr] -> IExpr
IIndexedExpr Bool
b1 IExpr
e1' [IExpr -> Index IExpr
forall a. a -> Index a
Sub (String -> IExpr
IVarExpr String
k)]),
                                            String -> [IExpr] -> IExpr
makeIApply String
"between" [IExpr
n1', IExpr
n2']])
    isMulti :: IndexExpr a -> Bool
isMulti (MultiSubscript a
_ a
_)   = Bool
True
    isMulti (MultiSuperscript a
_ a
_) = Bool
True
    isMulti IndexExpr a
_                      = Bool
False


desugar (SubrefsExpr Bool
bool Expr
expr1 Expr
expr2) =
  Bool -> IExpr -> IExpr -> IExpr
ISubrefsExpr Bool
bool (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2

desugar (SuprefsExpr Bool
bool Expr
expr1 Expr
expr2) =
  Bool -> IExpr -> IExpr -> IExpr
ISuprefsExpr Bool
bool (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2

desugar (UserrefsExpr Bool
bool Expr
expr1 Expr
expr2) =
  Bool -> IExpr -> IExpr -> IExpr
IUserrefsExpr Bool
bool (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2

desugar (TupleExpr [Expr]
exprs) = [IExpr] -> IExpr
ITupleExpr ([IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
exprs
desugar (CollectionExpr [Expr]
xs) = [IExpr] -> IExpr
ICollectionExpr ([IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
xs
desugar (ConsExpr Expr
x Expr
xs) = IExpr -> IExpr -> IExpr
IConsExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
x StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
xs
desugar (JoinExpr Expr
x Expr
xs) = IExpr -> IExpr -> IExpr
IJoinExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
x StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
xs

desugar (HashExpr [(Expr, Expr)]
exprPairs) =
  [(IExpr, IExpr)] -> IExpr
IHashExpr ([(IExpr, IExpr)] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [(IExpr, IExpr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Expr, Expr)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr, IExpr))
-> [(Expr, Expr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [(IExpr, IExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Expr
expr1, Expr
expr2) -> (,) (IExpr -> IExpr -> (IExpr, IExpr))
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IExpr -> (IExpr, IExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IExpr -> (IExpr, IExpr))
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr, IExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2) [(Expr, Expr)]
exprPairs

desugar (VectorExpr [Expr]
exprs) =
  [IExpr] -> IExpr
IVectorExpr ([IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
exprs

desugar (TensorExpr Expr
nsExpr Expr
xsExpr) =
  IExpr -> IExpr -> IExpr
ITensorExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
nsExpr StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
xsExpr

-- Desugar of LambdaExpr takes place in 2 stages.
-- * LambdaExpr -> LambdaExpr'  : Desugar pattern matches at the arg positions
-- * LambdaExpr' -> ILambdaExpr : Desugar ScalarArg and InvertedScalarArg
desugar (LambdaExpr [Arg ArgPattern]
args Expr
expr) = do
  ([Arg VarWithIndices]
args', Expr
expr') <- (Arg ArgPattern
 -> ([Arg VarWithIndices], Expr)
 -> StateT
      EvalState
      (ExceptT EgisonError RuntimeM)
      ([Arg VarWithIndices], Expr))
-> ([Arg VarWithIndices], Expr)
-> [Arg ArgPattern]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Arg VarWithIndices], Expr)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM Arg ArgPattern
-> ([Arg VarWithIndices], Expr)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Arg VarWithIndices], Expr)
desugarArg ([], Expr
expr) [Arg ArgPattern]
args
  Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [Arg VarWithIndices] -> Expr -> Expr
LambdaExpr' [Arg VarWithIndices]
args' Expr
expr'
  where
    desugarArg :: Arg ArgPattern -> ([Arg VarWithIndices], Expr) -> EvalM ([Arg VarWithIndices], Expr)
    desugarArg :: Arg ArgPattern
-> ([Arg VarWithIndices], Expr)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Arg VarWithIndices], Expr)
desugarArg (TensorArg ArgPattern
x) ([Arg VarWithIndices]
args, Expr
expr) = do
      (VarWithIndices
var, Expr
expr') <- ArgPattern -> Expr -> EvalM (VarWithIndices, Expr)
desugarArgPat ArgPattern
x Expr
expr
      ([Arg VarWithIndices], Expr)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Arg VarWithIndices], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
TensorArg VarWithIndices
var Arg VarWithIndices -> [Arg VarWithIndices] -> [Arg VarWithIndices]
forall a. a -> [a] -> [a]
: [Arg VarWithIndices]
args, Expr
expr')
    desugarArg (ScalarArg ArgPattern
x) ([Arg VarWithIndices]
args, Expr
expr) = do
      (VarWithIndices
var, Expr
expr') <- ArgPattern -> Expr -> EvalM (VarWithIndices, Expr)
desugarArgPat ArgPattern
x Expr
expr
      ([Arg VarWithIndices], Expr)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Arg VarWithIndices], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
ScalarArg VarWithIndices
var Arg VarWithIndices -> [Arg VarWithIndices] -> [Arg VarWithIndices]
forall a. a -> [a] -> [a]
: [Arg VarWithIndices]
args, Expr
expr')
    desugarArg (InvertedScalarArg ArgPattern
x) ([Arg VarWithIndices]
args, Expr
expr) = do
      (VarWithIndices
var, Expr
expr') <- ArgPattern -> Expr -> EvalM (VarWithIndices, Expr)
desugarArgPat ArgPattern
x Expr
expr
      ([Arg VarWithIndices], Expr)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Arg VarWithIndices], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
InvertedScalarArg VarWithIndices
var Arg VarWithIndices -> [Arg VarWithIndices] -> [Arg VarWithIndices]
forall a. a -> [a] -> [a]
: [Arg VarWithIndices]
args, Expr
expr')

    -- Desugar argument patterns. Examples:
    -- \$(%x, %y) -> expr   ==> \$tmp -> let (tmp1, tmp2) := tmp in (\%x %y -> expr) tmp1 tmp2
    -- \(x, (y, z)) -> expr ==> \tmp  -> let (tmp1, tmp2) := tmp in (\x (y, z) -> expr) tmp1 tmp2
    -- \%($x :: xs) -> expr ==> \%tmp -> let (tmp1 :: xs) := tmp in (\$x %xs -> expr) tmp1 tmp2
    desugarArgPat :: ArgPattern -> Expr -> EvalM (VarWithIndices, Expr)
    desugarArgPat :: ArgPattern -> Expr -> EvalM (VarWithIndices, Expr)
desugarArgPat ArgPattern
APWildCard Expr
expr = do
      String
tmp <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let tmp' :: VarWithIndices
tmp' = String -> VarWithIndices
stringToVarWithIndices String
tmp
      (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
tmp', [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind PrimitiveDataPattern
forall var. PDPatternBase var
PDWildCard (String -> Expr
VarExpr String
tmp)] Expr
expr)
    desugarArgPat (APPatVar VarWithIndices
var) Expr
expr = (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
var, Expr
expr)
    desugarArgPat (APTuplePat [Arg ArgPattern]
args) Expr
expr = do
      String
tmp  <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let tmp' :: VarWithIndices
tmp' = String -> VarWithIndices
stringToVarWithIndices String
tmp
      [String]
tmps <- (Arg ArgPattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> [Arg ArgPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT EvalState (ExceptT EgisonError RuntimeM) String
-> Arg ArgPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. a -> b -> a
const StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh) [Arg ArgPattern]
args
      (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
tmp', [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind ([PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. [PDPatternBase var] -> PDPatternBase var
PDTuplePat ((String -> PrimitiveDataPattern)
-> [String] -> [PrimitiveDataPattern]
forall a b. (a -> b) -> [a] -> [b]
map String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar [String]
tmps)) (String -> Expr
VarExpr String
tmp)]
                      (Expr -> [Expr] -> Expr
ApplyExpr ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [Arg ArgPattern]
args Expr
expr) ((String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
VarExpr [String]
tmps)))
    desugarArgPat (APInductivePat String
ctor [Arg ArgPattern]
args) Expr
expr = do
      String
tmp  <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let tmp' :: VarWithIndices
tmp' = String -> VarWithIndices
stringToVarWithIndices String
tmp
      [String]
tmps <- (Arg ArgPattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> [Arg ArgPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT EvalState (ExceptT EgisonError RuntimeM) String
-> Arg ArgPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. a -> b -> a
const StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh) [Arg ArgPattern]
args
      (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
tmp', [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind (String -> [PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. String -> [PDPatternBase var] -> PDPatternBase var
PDInductivePat String
ctor ((String -> PrimitiveDataPattern)
-> [String] -> [PrimitiveDataPattern]
forall a b. (a -> b) -> [a] -> [b]
map String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar [String]
tmps)) (String -> Expr
VarExpr String
tmp)]
                      (Expr -> [Expr] -> Expr
ApplyExpr ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [Arg ArgPattern]
args Expr
expr) ((String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
VarExpr [String]
tmps)))
    desugarArgPat ArgPattern
APEmptyPat Expr
expr = do
      String
tmp <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let tmp' :: VarWithIndices
tmp' = String -> VarWithIndices
stringToVarWithIndices String
tmp
      (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
tmp', [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind PrimitiveDataPattern
forall var. PDPatternBase var
PDEmptyPat (String -> Expr
VarExpr String
tmp)] Expr
expr)
    desugarArgPat (APConsPat Arg ArgPattern
arg1 ArgPattern
arg2) Expr
expr = do
      String
tmp  <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let tmp' :: VarWithIndices
tmp' = String -> VarWithIndices
stringToVarWithIndices String
tmp
      String
tmp1 <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      String
tmp2 <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
tmp', [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind (PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDConsPat (String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
tmp1) (String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
tmp2)) (String -> Expr
VarExpr String
tmp)]
                     (Expr -> [Expr] -> Expr
ApplyExpr ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [Arg ArgPattern
arg1, ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg ArgPattern
arg2] Expr
expr) [String -> Expr
VarExpr String
tmp1, String -> Expr
VarExpr String
tmp2]))
    desugarArgPat (APSnocPat ArgPattern
arg1 Arg ArgPattern
arg2) Expr
expr = do
      String
tmp  <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      let tmp' :: VarWithIndices
tmp' = String -> VarWithIndices
stringToVarWithIndices String
tmp
      String
tmp1 <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      String
tmp2 <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
      (VarWithIndices, Expr) -> EvalM (VarWithIndices, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarWithIndices
tmp', [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind (PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDSnocPat (String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
tmp1) (String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
tmp2)) (String -> Expr
VarExpr String
tmp)]
                     (Expr -> [Expr] -> Expr
ApplyExpr ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg ArgPattern
arg1, Arg ArgPattern
arg2] Expr
expr) [String -> Expr
VarExpr String
tmp1, String -> Expr
VarExpr String
tmp2]))

desugar (LambdaExpr' [Arg VarWithIndices]
vwis Expr
expr) = do
  let ([VarWithIndices]
vwis', Expr
expr') = (Arg VarWithIndices
 -> ([VarWithIndices], Expr) -> ([VarWithIndices], Expr))
-> ([VarWithIndices], Expr)
-> [Arg VarWithIndices]
-> ([VarWithIndices], Expr)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Arg VarWithIndices
-> ([VarWithIndices], Expr) -> ([VarWithIndices], Expr)
desugarInvertedArgs ([], Expr
expr) [Arg VarWithIndices]
vwis
  let args' :: [Var]
args' = (VarWithIndices -> Var) -> [VarWithIndices] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map VarWithIndices -> Var
varWithIndicesToVar [VarWithIndices]
vwis'
  IExpr
expr' <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr'
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [Var]
args' IExpr
expr'
  where
    desugarInvertedArgs :: Arg VarWithIndices -> ([VarWithIndices], Expr) -> ([VarWithIndices], Expr)
    desugarInvertedArgs :: Arg VarWithIndices
-> ([VarWithIndices], Expr) -> ([VarWithIndices], Expr)
desugarInvertedArgs (TensorArg VarWithIndices
x) ([VarWithIndices]
args, Expr
expr) = (VarWithIndices
x VarWithIndices -> [VarWithIndices] -> [VarWithIndices]
forall a. a -> [a] -> [a]
: [VarWithIndices]
args, Expr
expr)
    desugarInvertedArgs (ScalarArg VarWithIndices
x) ([VarWithIndices]
args, Expr
expr) =
      (VarWithIndices
x VarWithIndices -> [VarWithIndices] -> [VarWithIndices]
forall a. a -> [a] -> [a]
: [VarWithIndices]
args,
       Expr -> Expr -> Expr
TensorMapExpr ([Arg VarWithIndices] -> Expr -> Expr
LambdaExpr' [VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
TensorArg VarWithIndices
x] Expr
expr) (String -> Expr
VarExpr (VarWithIndices -> String
extractNameFromVarWithIndices VarWithIndices
x)))
    desugarInvertedArgs (InvertedScalarArg VarWithIndices
x) ([VarWithIndices]
args, Expr
expr) =
      (VarWithIndices
x VarWithIndices -> [VarWithIndices] -> [VarWithIndices]
forall a. a -> [a] -> [a]
: [VarWithIndices]
args,
       Expr -> Expr -> Expr
TensorMapExpr ([Arg VarWithIndices] -> Expr -> Expr
LambdaExpr' [VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
TensorArg VarWithIndices
x] Expr
expr) (Expr -> Expr
FlipIndicesExpr (String -> Expr
VarExpr (VarWithIndices -> String
extractNameFromVarWithIndices VarWithIndices
x))))

desugar (MemoizedLambdaExpr [String]
names Expr
expr) =
  [String] -> IExpr -> IExpr
IMemoizedLambdaExpr [String]
names (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (CambdaExpr String
name Expr
expr) =
  String -> IExpr -> IExpr
ICambdaExpr String
name (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (PatternFunctionExpr [String]
names Pattern
pattern) =
  [String] -> IPattern -> IExpr
IPatternFunctionExpr [String]
names (IPattern -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern Pattern
pattern

desugar (IfExpr Expr
expr0 Expr
expr1 Expr
expr2) =
  IExpr -> IExpr -> IExpr -> IExpr
IIfExpr (IExpr -> IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr0 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2

desugar (LetExpr [BindingExpr]
binds Expr
expr) =
  [IBindingExpr] -> IExpr -> IExpr
ILetExpr ([IBindingExpr] -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarBindings [BindingExpr]
binds StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (LetRecExpr [BindingExpr]
binds Expr
expr) =
  [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr ([IBindingExpr] -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarBindings [BindingExpr]
binds StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (WithSymbolsExpr [String]
vars Expr
expr) =
  [String] -> IExpr -> IExpr
IWithSymbolsExpr [String]
vars (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (MatchExpr PMMode
pmmode Expr
expr0 Expr
expr1 [MatchClause]
clauses) =
  PMMode -> IExpr -> IExpr -> [IMatchClause] -> IExpr
IMatchExpr PMMode
pmmode (IExpr -> IExpr -> [IMatchClause] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IExpr -> [IMatchClause] -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr0 StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (IExpr -> [IMatchClause] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IMatchClause] -> IExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT
  EvalState (ExceptT EgisonError RuntimeM) ([IMatchClause] -> IExpr)
-> EvalM [IMatchClause]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [MatchClause] -> EvalM [IMatchClause]
desugarMatchClauses [MatchClause]
clauses

desugar (MatchAllExpr PMMode
pmmode Expr
expr0 Expr
expr1 [MatchClause]
clauses) =
  PMMode -> IExpr -> IExpr -> [IMatchClause] -> IExpr
IMatchAllExpr PMMode
pmmode (IExpr -> IExpr -> [IMatchClause] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IExpr -> [IMatchClause] -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr0 StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (IExpr -> [IMatchClause] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IMatchClause] -> IExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT
  EvalState (ExceptT EgisonError RuntimeM) ([IMatchClause] -> IExpr)
-> EvalM [IMatchClause]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [MatchClause] -> EvalM [IMatchClause]
desugarMatchClauses [MatchClause]
clauses

desugar (DoExpr [BindingExpr]
binds Expr
expr) =
  [IBindingExpr] -> IExpr -> IExpr
IDoExpr ([IBindingExpr] -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarBindings [BindingExpr]
binds StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (PrefixExpr String
"-" Expr
expr) = do
  IExpr
expr' <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> [IExpr] -> IExpr
makeIApply String
"*" [ConstantExpr -> IExpr
IConstantExpr (Integer -> ConstantExpr
IntegerExpr (-Integer
1)), IExpr
expr']
desugar (PrefixExpr String
"!" (ApplyExpr Expr
expr [Expr]
args)) =
  IExpr -> [IExpr] -> IExpr
IWedgeApplyExpr (IExpr -> [IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr StateT EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
args
desugar (PrefixExpr String
"'" Expr
expr) = IExpr -> IExpr
IQuoteExpr (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
desugar (PrefixExpr String
"`" Expr
expr) = IExpr -> IExpr
IQuoteSymbolExpr (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
desugar (PrefixExpr String
op Expr
_) = String -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown prefix " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op)

desugar (InfixExpr Op
op Expr
expr1 Expr
expr2) | Op -> Bool
isWedge Op
op =
  (\IExpr
x IExpr
y -> IExpr -> [IExpr] -> IExpr
IWedgeApplyExpr (String -> IExpr
IVarExpr (Op -> String
repr Op
op)) [IExpr
x, IExpr
y])
    (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2

desugar (InfixExpr Op
op Expr
expr1 Expr
expr2) | Op -> String
repr Op
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"::" =
  IExpr -> IExpr -> IExpr
IConsExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2
desugar (InfixExpr Op
op Expr
expr1 Expr
expr2) | Op -> String
repr Op
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"++" =
  IExpr -> IExpr -> IExpr
IJoinExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2
desugar (InfixExpr Op
op Expr
expr1 Expr
expr2) =
  (\IExpr
x IExpr
y -> String -> [IExpr] -> IExpr
makeIApply (Op -> String
repr Op
op) [IExpr
x, IExpr
y]) (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr2

-- section
--
-- If `op` is not a cambda, simply desugar it into the function
desugar (SectionExpr Op
op Maybe Expr
Nothing Maybe Expr
Nothing)
  | Bool -> Bool
not (Op -> Bool
isWedge Op
op Bool -> Bool -> Bool
|| Op -> String
repr Op
op String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"::", String
"++"]) =
    Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (String -> Expr
VarExpr (Op -> String
repr Op
op))
desugar (SectionExpr Op
op Maybe Expr
Nothing Maybe Expr
Nothing) = do
  String
x <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  String
y <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [String -> Var
stringToVar String
x, String -> Var
stringToVar String
y] (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Op -> Expr -> Expr -> Expr
InfixExpr Op
op (String -> Expr
VarExpr String
x) (String -> Expr
VarExpr String
y))

desugar (SectionExpr Op
op Maybe Expr
Nothing (Just Expr
expr2)) = do
  String
x <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [String -> Var
stringToVar String
x] (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Op -> Expr -> Expr -> Expr
InfixExpr Op
op (String -> Expr
VarExpr String
x) Expr
expr2)

desugar (SectionExpr Op
op (Just Expr
expr1) Maybe Expr
Nothing) = do
  String
y <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr Maybe Var
forall a. Maybe a
Nothing [String -> Var
stringToVar String
y] (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Op -> Expr -> Expr -> Expr
InfixExpr Op
op Expr
expr1 (String -> Expr
VarExpr String
y))

desugar SectionExpr{} = EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default String
"Cannot reach here: section with both arguments"

desugar (SeqExpr Expr
expr0 Expr
expr1) =
  IExpr -> IExpr -> IExpr
ISeqExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr0 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1

desugar (GenerateTensorExpr Expr
fnExpr Expr
sizeExpr) =
  IExpr -> IExpr -> IExpr
IGenerateTensorExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
fnExpr StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
sizeExpr

desugar (TensorContractExpr Expr
tExpr) =
  IExpr -> IExpr
ITensorContractExpr (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
tExpr

desugar (TensorMapExpr (LambdaExpr' [Arg VarWithIndices
x] (TensorMapExpr (LambdaExpr' [Arg VarWithIndices
y] Expr
expr) Expr
b)) Expr
a) =
  Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> Expr -> Expr -> Expr
TensorMap2Expr ([Arg VarWithIndices] -> Expr -> Expr
LambdaExpr' [Arg VarWithIndices
x, Arg VarWithIndices
y] Expr
expr) Expr
a Expr
b)
desugar (TensorMapExpr (LambdaExpr [Arg ArgPattern
x] (TensorMapExpr (LambdaExpr [Arg ArgPattern
y] Expr
expr) Expr
b)) Expr
a) =
  Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> Expr -> Expr -> Expr
TensorMap2Expr ([Arg ArgPattern] -> Expr -> Expr
LambdaExpr [Arg ArgPattern
x, Arg ArgPattern
y] Expr
expr) Expr
a Expr
b)

desugar (TensorMapExpr Expr
fnExpr Expr
tExpr) =
  IExpr -> IExpr -> IExpr
ITensorMapExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
fnExpr StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
tExpr

desugar (TensorMap2Expr Expr
fnExpr Expr
t1Expr Expr
t2Expr) =
  IExpr -> IExpr -> IExpr -> IExpr
ITensorMap2Expr (IExpr -> IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
fnExpr StateT
  EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
t1Expr StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
t2Expr

desugar (TransposeExpr Expr
vars Expr
expr) =
  IExpr -> IExpr -> IExpr
ITransposeExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
vars StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (FlipIndicesExpr Expr
expr) =
  IExpr -> IExpr
IFlipIndicesExpr (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (ApplyExpr Expr
expr [Expr]
args) =
  IExpr -> [IExpr] -> IExpr
IApplyExpr (IExpr -> [IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr StateT EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
args

desugar (CApplyExpr Expr
expr0 Expr
expr1) =
  IExpr -> IExpr -> IExpr
ICApplyExpr (IExpr -> IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr0 StateT EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr1

desugar Expr
FreshVarExpr = do
  String
id <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> IExpr
IVarExpr (String
":::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
id)

desugar (MatcherExpr [PatternDef]
patternDefs) =
  [(PrimitivePatPattern, IExpr, [IBindingExpr])] -> IExpr
IMatcherExpr ([(PrimitivePatPattern, IExpr, [IBindingExpr])] -> IExpr)
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(PrimitivePatPattern, IExpr, [IBindingExpr])]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PatternDef -> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr]))
-> [PatternDef]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(PrimitivePatPattern, IExpr, [IBindingExpr])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PatternDef -> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
desugarPatternDef [PatternDef]
patternDefs

desugar (AnonParamExpr Integer
n) = IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ String -> IExpr
IVarExpr (Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
n)

desugar (AnonParamFuncExpr Integer
n Expr
expr) = do
  let args :: [VarWithIndices]
args = (Integer -> VarWithIndices) -> [Integer] -> [VarWithIndices]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> String -> VarWithIndices
stringToVarWithIndices (Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
n)) [Integer
1..Integer
n]
  IExpr
lambda <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [Arg VarWithIndices] -> Expr -> Expr
LambdaExpr' ((VarWithIndices -> Arg VarWithIndices)
-> [VarWithIndices] -> [Arg VarWithIndices]
forall a b. (a -> b) -> [a] -> [b]
map VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
TensorArg [VarWithIndices]
args) Expr
expr
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
"%0"), IExpr
lambda)] (String -> IExpr
IVarExpr String
"%0")

desugar (AnonTupleParamFuncExpr Integer
1 Expr
expr) = do
  IExpr
lambda <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [Arg VarWithIndices] -> Expr -> Expr
LambdaExpr' [VarWithIndices -> Arg VarWithIndices
forall a. a -> Arg a
TensorArg (String -> VarWithIndices
stringToVarWithIndices String
"%1")] Expr
expr
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
"%0"), IExpr
lambda)] (String -> IExpr
IVarExpr String
"%0")
desugar (AnonTupleParamFuncExpr Integer
n Expr
expr) = do
  let args :: [VarWithIndices]
args = (Integer -> VarWithIndices) -> [Integer] -> [VarWithIndices]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> String -> VarWithIndices
stringToVarWithIndices (Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
n)) [Integer
1..Integer
n]
  IExpr
lambda <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$
    [Arg ArgPattern] -> Expr -> Expr
LambdaExpr [ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg ([Arg ArgPattern] -> ArgPattern
APTuplePat ([Arg ArgPattern] -> ArgPattern) -> [Arg ArgPattern] -> ArgPattern
forall a b. (a -> b) -> a -> b
$ (VarWithIndices -> Arg ArgPattern)
-> [VarWithIndices] -> [Arg ArgPattern]
forall a b. (a -> b) -> [a] -> [b]
map (ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg (ArgPattern -> Arg ArgPattern)
-> (VarWithIndices -> ArgPattern)
-> VarWithIndices
-> Arg ArgPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarWithIndices -> ArgPattern
APPatVar) [VarWithIndices]
args)] Expr
expr
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
"%0"), IExpr
lambda)] (String -> IExpr
IVarExpr String
"%0")

desugar (AnonListParamFuncExpr Integer
n Expr
expr) = do
  let args' :: [Arg ArgPattern]
args' = (Integer -> Arg ArgPattern) -> [Integer] -> [Arg ArgPattern]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg (VarWithIndices -> ArgPattern
APPatVar (String -> VarWithIndices
stringToVarWithIndices (Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
n)))) [Integer
1..Integer
n]
  let args :: ArgPattern
args = (Arg ArgPattern -> ArgPattern -> ArgPattern)
-> ArgPattern -> [Arg ArgPattern] -> ArgPattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Arg ArgPattern -> ArgPattern -> ArgPattern
APConsPat ArgPattern
APEmptyPat [Arg ArgPattern]
args'
  IExpr
lambda <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [Arg ArgPattern] -> Expr -> Expr
LambdaExpr [ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg ArgPattern
args] Expr
expr
  IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [IBindingExpr] -> IExpr -> IExpr
ILetRecExpr [(Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
"%0"), IExpr
lambda)] (String -> IExpr
IVarExpr String
"%0")

desugar (QuoteExpr Expr
expr) =
  IExpr -> IExpr
IQuoteExpr (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (QuoteSymbolExpr Expr
expr) =
  IExpr -> IExpr
IQuoteSymbolExpr (IExpr -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr

desugar (WedgeApplyExpr Expr
expr [Expr]
args) =
  IExpr -> [IExpr] -> IExpr
IWedgeApplyExpr (IExpr -> [IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr StateT EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
args

desugar (FunctionExpr [String]
args) = IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> IExpr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
forall a b. (a -> b) -> a -> b
$ [String] -> IExpr
IFunctionExpr [String]
args

desugarIndex :: IndexExpr Expr -> EvalM (Index IExpr)
desugarIndex :: IndexExpr Expr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
desugarIndex (Subscript Expr
e)    = IExpr -> Index IExpr
forall a. a -> Index a
Sub (IExpr -> Index IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
e
desugarIndex (Superscript Expr
e)  = IExpr -> Index IExpr
forall a. a -> Index a
Sup (IExpr -> Index IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
e
desugarIndex (SupSubscript Expr
e) = IExpr -> Index IExpr
forall a. a -> Index a
SupSub (IExpr -> Index IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
e
desugarIndex (Userscript Expr
e)   = IExpr -> Index IExpr
forall a. a -> Index a
User (IExpr -> Index IExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
e
desugarIndex IndexExpr Expr
_                = StateT EvalState (ExceptT EgisonError RuntimeM) (Index IExpr)
forall a. HasCallStack => a
undefined

desugarPattern :: Pattern -> EvalM IPattern
desugarPattern :: Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern Pattern
pat =
  case Pattern -> [String]
collectName Pattern
pat of
    []    -> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat
    [String]
names -> [IBindingExpr] -> IPattern -> IPattern
ILetPat ((String -> IBindingExpr) -> [String] -> [IBindingExpr]
forall a b. (a -> b) -> [a] -> [b]
map String -> IBindingExpr
makeBinding [String]
names) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat
 where
   collectNames :: [Pattern] -> [String]
   collectNames :: [Pattern] -> [String]
collectNames [Pattern]
pats = ([String] -> [String] -> [String])
-> [String] -> [[String]] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
union [] ((Pattern -> [String]) -> [Pattern] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> [String]
collectName [Pattern]
pats)

   collectName :: Pattern -> [String]
   collectName :: Pattern -> [String]
collectName (ForallPat Pattern
pat1 Pattern
pat2)                           = Pattern -> [String]
collectName Pattern
pat1 [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` Pattern -> [String]
collectName Pattern
pat2
   collectName (InfixPat Op
_ Pattern
pat1 Pattern
pat2)                          = Pattern -> [String]
collectName Pattern
pat1 [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` Pattern -> [String]
collectName Pattern
pat2
   collectName (NotPat Pattern
pat)                                    = Pattern -> [String]
collectName Pattern
pat
   collectName (AndPat Pattern
pat1 Pattern
pat2)                              = Pattern -> [String]
collectName Pattern
pat1 [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` Pattern -> [String]
collectName Pattern
pat2
   collectName (OrPat Pattern
pat1 Pattern
pat2)                               = Pattern -> [String]
collectName Pattern
pat1 [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` Pattern -> [String]
collectName Pattern
pat2
   collectName (TuplePat [Pattern]
pats)                                 = [Pattern] -> [String]
collectNames [Pattern]
pats
   collectName (InductiveOrPApplyPat String
_ [Pattern]
pats)                   = [Pattern] -> [String]
collectNames [Pattern]
pats
   collectName (InductivePat String
_ [Pattern]
pats)                           = [Pattern] -> [String]
collectNames [Pattern]
pats
   collectName (PApplyPat Expr
_ [Pattern]
pats)                              = [Pattern] -> [String]
collectNames [Pattern]
pats
   collectName (DApplyPat Pattern
_ [Pattern]
pats)                              = [Pattern] -> [String]
collectNames [Pattern]
pats
   collectName (LoopPat String
_ (LoopRange Expr
_ Expr
_ Pattern
endNumPat) Pattern
pat1 Pattern
pat2) = Pattern -> [String]
collectName Pattern
endNumPat [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` Pattern -> [String]
collectName Pattern
pat1 [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` Pattern -> [String]
collectName Pattern
pat2
   collectName (LetPat [BindingExpr]
_ Pattern
pat)                                  = Pattern -> [String]
collectName Pattern
pat
   collectName (IndexedPat (PatVar String
var) [Expr]
_)                     = [String
var]
   collectName Pattern
_                                               = []

   makeBinding :: String -> IBindingExpr
   makeBinding :: String -> IBindingExpr
makeBinding String
var = (Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar (String -> Var
stringToVar String
var), [(IExpr, IExpr)] -> IExpr
IHashExpr [])

desugarPattern' :: Pattern -> EvalM IPattern
desugarPattern' :: Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
WildCard        = IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (m :: * -> *) a. Monad m => a -> m a
return IPattern
IWildCard
desugarPattern' Pattern
ContPat         = IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (m :: * -> *) a. Monad m => a -> m a
return IPattern
IContPat
desugarPattern' Pattern
SeqNilPat       = IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (m :: * -> *) a. Monad m => a -> m a
return IPattern
ISeqNilPat
desugarPattern' Pattern
LaterPatVar     = IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (m :: * -> *) a. Monad m => a -> m a
return IPattern
ILaterPatVar
desugarPattern' (VarPat String
v)      = IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IPattern
IVarPat String
v)
desugarPattern' (PatVar String
var)    = IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IPattern
IPatVar String
var)
desugarPattern' (ValuePat Expr
expr) = IExpr -> IPattern
IValuePat (IExpr -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
desugarPattern' (PredPat Expr
expr)  = IExpr -> IPattern
IPredPat (IExpr -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
desugarPattern' (NotPat Pattern
pat)       = IPattern -> IPattern
INotPat (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat
desugarPattern' (AndPat Pattern
pat1 Pattern
pat2) = IPattern -> IPattern -> IPattern
IAndPat (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (OrPat Pattern
pat1 Pattern
pat2)  = IPattern -> IPattern -> IPattern
IOrPat (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (ForallPat Pattern
pat1 Pattern
pat2) = IPattern -> IPattern -> IPattern
IForallPat (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (InfixPat Op{ repr :: Op -> String
repr = String
"&" } Pattern
pat1 Pattern
pat2) =
  IPattern -> IPattern -> IPattern
IAndPat (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (InfixPat Op{ repr :: Op -> String
repr = String
"|" } Pattern
pat1 Pattern
pat2) =
  IPattern -> IPattern -> IPattern
IOrPat (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (InfixPat Op{ repr :: Op -> String
repr = String
f } Pattern
pat1 Pattern
pat2) =
  (\IPattern
x IPattern
y -> String -> [IPattern] -> IPattern
IInductivePat String
f [IPattern
x, IPattern
y]) (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (TuplePat [Pattern]
pats) = [IPattern] -> IPattern
ITuplePat ([IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern)
-> [Pattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' [Pattern]
pats
desugarPattern' (InductiveOrPApplyPat String
name [Pattern]
pats) = String -> [IPattern] -> IPattern
IInductiveOrPApplyPat String
name ([IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern)
-> [Pattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' [Pattern]
pats
desugarPattern' (InductivePat String
name [Pattern]
pats) = String -> [IPattern] -> IPattern
IInductivePat String
name ([IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern)
-> [Pattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' [Pattern]
pats
desugarPattern' (IndexedPat Pattern
pat [Expr]
exprs) = IPattern -> [IExpr] -> IPattern
IIndexedPat (IPattern -> [IExpr] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat StateT
  EvalState (ExceptT EgisonError RuntimeM) ([IExpr] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr)
-> [Expr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar [Expr]
exprs
desugarPattern' (PApplyPat Expr
expr [Pattern]
pats) = IExpr -> [IPattern] -> IPattern
IPApplyPat (IExpr -> [IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IPattern] -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr StateT
  EvalState (ExceptT EgisonError RuntimeM) ([IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern)
-> [Pattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' [Pattern]
pats
desugarPattern' (DApplyPat Pattern
pat [Pattern]
pats) = IPattern -> [IPattern] -> IPattern
IDApplyPat (IPattern -> [IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) ([IPattern] -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat StateT
  EvalState (ExceptT EgisonError RuntimeM) ([IPattern] -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pattern
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern)
-> [Pattern]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IPattern]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' [Pattern]
pats
desugarPattern' (LoopPat String
name LoopRange
range Pattern
pat1 Pattern
pat2) = String -> ILoopRange -> IPattern -> IPattern -> IPattern
ILoopPat String
name (ILoopRange -> IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ILoopRange
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IPattern -> IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoopRange
-> StateT EvalState (ExceptT EgisonError RuntimeM) ILoopRange
desugarLoopRange LoopRange
range StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2
desugarPattern' (LetPat [BindingExpr]
binds Pattern
pat) = [IBindingExpr] -> IPattern -> IPattern
ILetPat ([IBindingExpr] -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarBindings [BindingExpr]
binds StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat
desugarPattern' (SeqConsPat Pattern
pat1 Pattern
pat2) = IPattern -> IPattern -> IPattern
ISeqConsPat (IPattern -> IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat1 StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> IPattern)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat2

desugarLoopRange :: LoopRange -> EvalM ILoopRange
desugarLoopRange :: LoopRange
-> StateT EvalState (ExceptT EgisonError RuntimeM) ILoopRange
desugarLoopRange (LoopRange Expr
sExpr Expr
eExpr Pattern
pat) =
  IExpr -> IExpr -> IPattern -> ILoopRange
ILoopRange (IExpr -> IExpr -> IPattern -> ILoopRange)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     (IExpr -> IPattern -> ILoopRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
sExpr StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  (IExpr -> IPattern -> ILoopRange)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IPattern -> ILoopRange)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
eExpr StateT
  EvalState (ExceptT EgisonError RuntimeM) (IPattern -> ILoopRange)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT EvalState (ExceptT EgisonError RuntimeM) ILoopRange
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern' Pattern
pat

desugarBindings :: [BindingExpr] -> EvalM [IBindingExpr]
desugarBindings :: [BindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarBindings = (BindingExpr
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr)
-> [BindingExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr
desugarBinding
  where
    desugarBinding :: BindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr
desugarBinding (Bind PrimitiveDataPattern
name Expr
expr) = do
      let name' :: PDPatternBase Var
name' = (String -> Var) -> PrimitiveDataPattern -> PDPatternBase Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Var
stringToVar PrimitiveDataPattern
name
      IExpr
expr' <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
      case (PrimitiveDataPattern
name, IExpr
expr') of
        (PDPatVar String
var, ILambdaExpr Maybe Var
Nothing [Var]
args IExpr
body) ->
          IBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (PDPatternBase Var
name', Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> [Index (Maybe Var)] -> Var
Var String
var [])) [Var]
args IExpr
body)
        (PrimitiveDataPattern, IExpr)
_ -> IBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (PDPatternBase Var
name', IExpr
expr')
    desugarBinding (BindWithIndices VarWithIndices
vwi Expr
expr) = do
      (Var
var, IExpr
iexpr) <- VarWithIndices -> Expr -> EvalM (Var, IExpr)
desugarDefineWithIndices VarWithIndices
vwi Expr
expr
      IBindingExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> PDPatternBase Var
forall var. var -> PDPatternBase var
PDPatVar Var
var, IExpr
iexpr)

desugarMatchClauses :: [MatchClause] -> EvalM [IMatchClause]
desugarMatchClauses :: [MatchClause] -> EvalM [IMatchClause]
desugarMatchClauses = (MatchClause
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IMatchClause)
-> [MatchClause] -> EvalM [IMatchClause]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Pattern
pat, Expr
expr) -> (,) (IPattern -> IExpr -> IMatchClause)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IMatchClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> StateT EvalState (ExceptT EgisonError RuntimeM) IPattern
desugarPattern Pattern
pat StateT
  EvalState (ExceptT EgisonError RuntimeM) (IExpr -> IMatchClause)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IMatchClause
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr)

desugarPatternDef :: PatternDef -> EvalM IPatternDef
desugarPatternDef :: PatternDef -> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
desugarPatternDef (PrimitivePatPattern
pp, Expr
matcher, [(PrimitiveDataPattern, Expr)]
pds) =
  (PrimitivePatPattern
pp,,) (IExpr
 -> [IBindingExpr] -> (PrimitivePatPattern, IExpr, [IBindingExpr]))
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([IBindingExpr] -> (PrimitivePatPattern, IExpr, [IBindingExpr]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
matcher StateT
  EvalState
  (ExceptT EgisonError RuntimeM)
  ([IBindingExpr] -> (PrimitivePatPattern, IExpr, [IBindingExpr]))
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
-> EvalM (PrimitivePatPattern, IExpr, [IBindingExpr])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(PrimitiveDataPattern, Expr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarPrimitiveDataMatchClauses [(PrimitiveDataPattern, Expr)]
pds

desugarPrimitiveDataMatchClauses :: [(PrimitiveDataPattern, Expr)] -> EvalM [(IPrimitiveDataPattern, IExpr)]
desugarPrimitiveDataMatchClauses :: [(PrimitiveDataPattern, Expr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
desugarPrimitiveDataMatchClauses = ((PrimitiveDataPattern, Expr)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr)
-> [(PrimitiveDataPattern, Expr)]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [IBindingExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(PrimitiveDataPattern
pd, Expr
expr) -> ((String -> Var) -> PrimitiveDataPattern -> PDPatternBase Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Var
stringToVar PrimitiveDataPattern
pd,) (IExpr -> IBindingExpr)
-> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
-> StateT EvalState (ExceptT EgisonError RuntimeM) IBindingExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr)

desugarDefineWithIndices :: VarWithIndices -> Expr -> EvalM (Var, IExpr)
desugarDefineWithIndices :: VarWithIndices -> Expr -> EvalM (Var, IExpr)
desugarDefineWithIndices var :: VarWithIndices
var@(VarWithIndices String
_ [VarIndex]
_) expr :: Expr
expr@(LambdaExpr [Arg ArgPattern]
_ Expr
_) = do
  let var' :: Var
var' = VarWithIndices -> Var
varWithIndicesToVar VarWithIndices
var
  IExpr
expr' <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
  case IExpr
expr' of
    ILambdaExpr Maybe Var
Nothing [Var]
args IExpr
body -> (Var, IExpr) -> EvalM (Var, IExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var', Maybe Var -> [Var] -> IExpr -> IExpr
ILambdaExpr (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
var') [Var]
args IExpr
body)
    IExpr
_                             -> (Var, IExpr) -> EvalM (Var, IExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var
var', IExpr
expr')
desugarDefineWithIndices (VarWithIndices String
name [VarIndex]
is) Expr
expr = do
  let ([Bool]
isSubs, [String]
indexNames) = [(Bool, String)] -> ([Bool], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Bool, String)] -> ([Bool], [String]))
-> [(Bool, String)] -> ([Bool], [String])
forall a b. (a -> b) -> a -> b
$ (VarIndex -> [(Bool, String)]) -> [VarIndex] -> [(Bool, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [(Bool, String)]
extractSubSupIndex [VarIndex]
is
  Expr
expr <- if (VarIndex -> Bool) -> [VarIndex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any VarIndex -> Bool
isExtendedIndice [VarIndex]
is
             then [VarIndex] -> [Bool] -> [String] -> Expr -> EvalM Expr
desugarExtendedIndices [VarIndex]
is [Bool]
isSubs [String]
indexNames Expr
expr
             else Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
expr
  IExpr
body <- Expr -> StateT EvalState (ExceptT EgisonError RuntimeM) IExpr
desugar Expr
expr
  let indexNamesCollection :: IExpr
indexNamesCollection = [IExpr] -> IExpr
ICollectionExpr ((String -> IExpr) -> [String] -> [IExpr]
forall a b. (a -> b) -> [a] -> [b]
map String -> IExpr
IVarExpr [String]
indexNames)
  let is' :: [Index (Maybe a)]
is' = (Bool -> Index (Maybe a)) -> [Bool] -> [Index (Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Bool
b -> if Bool
b then Maybe a -> Index (Maybe a)
forall a. a -> Index a
Sub Maybe a
forall a. Maybe a
Nothing else Maybe a -> Index (Maybe a)
forall a. a -> Index a
Sup Maybe a
forall a. Maybe a
Nothing) [Bool]
isSubs
  (Var, IExpr) -> EvalM (Var, IExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Index (Maybe Var)] -> Var
Var String
name [Index (Maybe Var)]
forall a. [Index (Maybe a)]
is', [String] -> IExpr -> IExpr
IWithSymbolsExpr [String]
indexNames (IExpr -> IExpr -> IExpr
ITransposeExpr IExpr
indexNamesCollection IExpr
body))

varWithIndicesToVar :: VarWithIndices -> Var
varWithIndicesToVar :: VarWithIndices -> Var
varWithIndicesToVar (VarWithIndices String
name [VarIndex]
is) = String -> [Index (Maybe Var)] -> Var
Var String
name ((VarIndex -> [Index (Maybe Var)])
-> [VarIndex] -> [Index (Maybe Var)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Index (Maybe Var)]
transVarIndex [VarIndex]
is)

transVarIndex :: VarIndex -> [Index (Maybe Var)]
transVarIndex :: VarIndex -> [Index (Maybe Var)]
transVarIndex (VSubscript String
x)            = [Maybe Var -> Index (Maybe Var)
forall a. a -> Index a
Sub (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> Var
stringToVar String
x))]
transVarIndex (VSuperscript String
x)          = [Maybe Var -> Index (Maybe Var)
forall a. a -> Index a
Sup (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> Var
stringToVar String
x))]
transVarIndex (VMultiSubscript String
x Integer
s String
e)   = [Maybe Var -> Integer -> Maybe Var -> Index (Maybe Var)
forall a. a -> Integer -> a -> Index a
MultiSub (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> Var
stringToVar String
x)) Integer
s (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> Var
stringToVar String
e))]
transVarIndex (VMultiSuperscript String
x Integer
s String
e) = [Maybe Var -> Integer -> Maybe Var -> Index (Maybe Var)
forall a. a -> Integer -> a -> Index a
MultiSup (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> Var
stringToVar String
x)) Integer
s (Var -> Maybe Var
forall a. a -> Maybe a
Just (String -> Var
stringToVar String
e))]
transVarIndex (VGroupScripts [VarIndex]
xs)        = (VarIndex -> [Index (Maybe Var)])
-> [VarIndex] -> [Index (Maybe Var)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Index (Maybe Var)]
transVarIndex [VarIndex]
xs
transVarIndex (VSymmScripts [VarIndex]
xs)         = (VarIndex -> [Index (Maybe Var)])
-> [VarIndex] -> [Index (Maybe Var)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Index (Maybe Var)]
transVarIndex [VarIndex]
xs
transVarIndex (VAntiSymmScripts [VarIndex]
xs)     = (VarIndex -> [Index (Maybe Var)])
-> [VarIndex] -> [Index (Maybe Var)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Index (Maybe Var)]
transVarIndex [VarIndex]
xs

extractSubSupIndex :: VarIndex -> [(Bool, String)]
extractSubSupIndex :: VarIndex -> [(Bool, String)]
extractSubSupIndex (VSubscript String
x)        = [(Bool
True, String
x)]
extractSubSupIndex (VSuperscript String
x)      = [(Bool
False, String
x)]
extractSubSupIndex (VGroupScripts [VarIndex]
xs)    = (VarIndex -> [(Bool, String)]) -> [VarIndex] -> [(Bool, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [(Bool, String)]
extractSubSupIndex [VarIndex]
xs
extractSubSupIndex (VSymmScripts [VarIndex]
xs)     = (VarIndex -> [(Bool, String)]) -> [VarIndex] -> [(Bool, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [(Bool, String)]
extractSubSupIndex [VarIndex]
xs
extractSubSupIndex (VAntiSymmScripts [VarIndex]
xs) = (VarIndex -> [(Bool, String)]) -> [VarIndex] -> [(Bool, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [(Bool, String)]
extractSubSupIndex [VarIndex]
xs

desugarExtendedIndices :: [VarIndex] -> [Bool] -> [String] -> Expr -> EvalM Expr
desugarExtendedIndices :: [VarIndex] -> [Bool] -> [String] -> Expr -> EvalM Expr
desugarExtendedIndices [VarIndex]
indices [Bool]
isSubs [String]
indexNames Expr
tensorBody = do
  String
tensorName <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
  Expr
tensorGenExpr <- [VarIndex] -> Expr -> [String] -> [BindingExpr] -> EvalM Expr
f [VarIndex]
indices (String -> Expr
VarExpr String
tensorName) [] []
  let indexFunctionExpr :: Expr
indexFunctionExpr = [Arg ArgPattern] -> Expr -> Expr
LambdaExpr [ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg (ArgPattern -> Arg ArgPattern) -> ArgPattern -> Arg ArgPattern
forall a b. (a -> b) -> a -> b
$ (Arg ArgPattern -> ArgPattern -> ArgPattern)
-> ArgPattern -> [Arg ArgPattern] -> ArgPattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Arg ArgPattern -> ArgPattern -> ArgPattern
APConsPat ArgPattern
APEmptyPat ((VarWithIndices -> Arg ArgPattern)
-> [VarWithIndices] -> [Arg ArgPattern]
forall a b. (a -> b) -> [a] -> [b]
map (ArgPattern -> Arg ArgPattern
forall a. a -> Arg a
TensorArg (ArgPattern -> Arg ArgPattern)
-> (VarWithIndices -> ArgPattern)
-> VarWithIndices
-> Arg ArgPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarWithIndices -> ArgPattern
APPatVar) ((String -> VarWithIndices) -> [String] -> [VarWithIndices]
forall a b. (a -> b) -> [a] -> [b]
map String -> VarWithIndices
stringToVarWithIndices [String]
indexNames))] Expr
tensorGenExpr
  let genTensorExpr :: Expr
genTensorExpr = Expr -> Expr -> Expr
GenerateTensorExpr Expr
indexFunctionExpr (String -> [Expr] -> Expr
makeApply String
"tensorShape" [String -> Expr
VarExpr String
tensorName])
  let tensorIndices :: [IndexExpr Expr]
tensorIndices = (Bool -> String -> IndexExpr Expr)
-> [Bool] -> [String] -> [IndexExpr Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Bool
isSub String
name -> if Bool
isSub then Expr -> IndexExpr Expr
forall a. a -> IndexExpr a
Subscript (String -> Expr
VarExpr String
name) else Expr -> IndexExpr Expr
forall a. a -> IndexExpr a
Superscript (String -> Expr
VarExpr String
name)) [Bool]
isSubs [String]
indexNames
  Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> EvalM Expr) -> Expr -> EvalM Expr
forall a b. (a -> b) -> a -> b
$ [BindingExpr] -> Expr -> Expr
LetExpr [PrimitiveDataPattern -> Expr -> BindingExpr
Bind (String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
tensorName) Expr
tensorBody] (Bool -> Expr -> [IndexExpr Expr] -> Expr
IndexedExpr Bool
True Expr
genTensorExpr [IndexExpr Expr]
tensorIndices)
 where
  f :: [VarIndex] -> Expr -> [String] -> [BindingExpr] -> EvalM Expr
  f :: [VarIndex] -> Expr -> [String] -> [BindingExpr] -> EvalM Expr
f [] Expr
expr [] []       = Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
expr
  f [] Expr
expr [] [BindingExpr]
bindings = Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> EvalM Expr) -> Expr -> EvalM Expr
forall a b. (a -> b) -> a -> b
$ [BindingExpr] -> Expr -> Expr
LetRecExpr [BindingExpr]
bindings Expr
expr
  f [] Expr
expr [String]
signs [BindingExpr]
bindings =
    Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> EvalM Expr) -> Expr -> EvalM Expr
forall a b. (a -> b) -> a -> b
$ [BindingExpr] -> Expr -> Expr
LetRecExpr [BindingExpr]
bindings (String -> [Expr] -> Expr
makeApply String
"product" [[Expr] -> Expr
CollectionExpr ((String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
VarExpr [String]
signs [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr
expr])])
  f (VarIndex
index:[VarIndex]
indices) Expr
expr [String]
signs [BindingExpr]
bindings = do
    (Expr
indices', [String]
signs', [BindingExpr]
bindings') <- VarIndex -> EvalM (Expr, [String], [BindingExpr])
genBindings VarIndex
index
    let isSubs :: [Bool]
isSubs = VarIndex -> [Bool]
subOrSupScripts VarIndex
index
    [String]
symbols <- (Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> [Bool]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT EvalState (ExceptT EgisonError RuntimeM) String
-> Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. a -> b -> a
const StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh) [Bool]
isSubs
    let is :: [IndexExpr Expr]
is = (String -> Bool -> IndexExpr Expr)
-> [String] -> [Bool] -> [IndexExpr Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
x Bool
isSub -> (if Bool
isSub then Expr -> IndexExpr Expr
forall a. a -> IndexExpr a
Subscript else Expr -> IndexExpr Expr
forall a. a -> IndexExpr a
Superscript) (String -> Expr
VarExpr String
x)) [String]
symbols [Bool]
isSubs
    [VarIndex] -> Expr -> [String] -> [BindingExpr] -> EvalM Expr
f [VarIndex]
indices (Bool -> Expr -> [IndexExpr Expr] -> Expr
IndexedExpr Bool
True Expr
expr [IndexExpr Expr]
is)
      ([String]
signs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
signs') ([BindingExpr]
bindings [BindingExpr] -> [BindingExpr] -> [BindingExpr]
forall a. [a] -> [a] -> [a]
++ [BindingExpr]
bindings' [BindingExpr] -> [BindingExpr] -> [BindingExpr]
forall a. [a] -> [a] -> [a]
++ [PrimitiveDataPattern -> Expr -> BindingExpr
Bind ((String -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> PrimitiveDataPattern -> [String] -> PrimitiveDataPattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PrimitiveDataPattern
-> PrimitiveDataPattern -> PrimitiveDataPattern
forall var.
PDPatternBase var -> PDPatternBase var -> PDPatternBase var
PDConsPat (PrimitiveDataPattern
 -> PrimitiveDataPattern -> PrimitiveDataPattern)
-> (String -> PrimitiveDataPattern)
-> String
-> PrimitiveDataPattern
-> PrimitiveDataPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar) PrimitiveDataPattern
forall var. PDPatternBase var
PDEmptyPat [String]
symbols) Expr
indices'])

  subOrSupScripts :: VarIndex -> [Bool]
  subOrSupScripts :: VarIndex -> [Bool]
subOrSupScripts VSubscript{}          = [Bool
True]
  subOrSupScripts VSuperscript{}        = [Bool
False]
  subOrSupScripts (VGroupScripts [VarIndex]
xs)    = (VarIndex -> [Bool]) -> [VarIndex] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Bool]
subOrSupScripts [VarIndex]
xs
  subOrSupScripts (VSymmScripts [VarIndex]
xs)     = (VarIndex -> [Bool]) -> [VarIndex] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Bool]
subOrSupScripts [VarIndex]
xs
  subOrSupScripts (VAntiSymmScripts [VarIndex]
xs) = (VarIndex -> [Bool]) -> [VarIndex] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VarIndex -> [Bool]
subOrSupScripts [VarIndex]
xs

  genBindings :: VarIndex -> EvalM (Expr, [String], [BindingExpr])
  genBindings :: VarIndex -> EvalM (Expr, [String], [BindingExpr])
genBindings (VSubscript String
x)   = (Expr, [String], [BindingExpr])
-> EvalM (Expr, [String], [BindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Expr] -> Expr
CollectionExpr [String -> Expr
VarExpr String
x], [], [])
  genBindings (VSuperscript String
x) = (Expr, [String], [BindingExpr])
-> EvalM (Expr, [String], [BindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Expr] -> Expr
CollectionExpr [String -> Expr
VarExpr String
x], [], [])
  genBindings (VGroupScripts [VarIndex]
xs) = do
    ([Expr]
indices, [[String]]
signss, [[BindingExpr]]
bindingss) <- [(Expr, [String], [BindingExpr])]
-> ([Expr], [[String]], [[BindingExpr]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Expr, [String], [BindingExpr])]
 -> ([Expr], [[String]], [[BindingExpr]]))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(Expr, [String], [BindingExpr])]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Expr], [[String]], [[BindingExpr]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarIndex -> EvalM (Expr, [String], [BindingExpr]))
-> [VarIndex]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(Expr, [String], [BindingExpr])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM VarIndex -> EvalM (Expr, [String], [BindingExpr])
genBindings [VarIndex]
xs
    let newIndices :: Expr
newIndices =
          -- If indices are all CollectionExpr, we can calculate the concatenated result of them
          case [Expr] -> Maybe [Expr]
allCollections [Expr]
indices of
            Just [Expr]
xs -> [Expr] -> Expr
CollectionExpr [Expr]
xs
            Maybe [Expr]
Nothing -> String -> [Expr] -> Expr
makeApply String
"concat" [[Expr] -> Expr
CollectionExpr [Expr]
indices]
    (Expr, [String], [BindingExpr])
-> EvalM (Expr, [String], [BindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr
newIndices, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
signss, [[BindingExpr]] -> [BindingExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[BindingExpr]]
bindingss)
    where
      allCollections :: [Expr] -> Maybe [Expr]
allCollections []                          = [Expr] -> Maybe [Expr]
forall a. a -> Maybe a
Just []
      allCollections (CollectionExpr [Expr]
xs : [Expr]
exprs) = ([Expr]
xs [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++) ([Expr] -> [Expr]) -> Maybe [Expr] -> Maybe [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr] -> Maybe [Expr]
allCollections [Expr]
exprs
      allCollections [Expr]
_                           = Maybe [Expr]
forall a. Maybe a
Nothing
  genBindings (VSymmScripts [VarIndex]
xs) = do
    ([Expr]
indices, [[String]]
signss, [[BindingExpr]]
bindingss) <- [(Expr, [String], [BindingExpr])]
-> ([Expr], [[String]], [[BindingExpr]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Expr, [String], [BindingExpr])]
 -> ([Expr], [[String]], [[BindingExpr]]))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(Expr, [String], [BindingExpr])]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Expr], [[String]], [[BindingExpr]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarIndex -> EvalM (Expr, [String], [BindingExpr]))
-> [VarIndex]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(Expr, [String], [BindingExpr])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM VarIndex -> EvalM (Expr, [String], [BindingExpr])
genBindings [VarIndex]
xs
    let signs :: [String]
signs = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
signss
    let bindings :: [BindingExpr]
bindings = [[BindingExpr]] -> [BindingExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[BindingExpr]]
bindingss
    String
sortedCollectionName <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
    let newBindings :: [BindingExpr]
newBindings = [BindingExpr]
bindings [BindingExpr] -> [BindingExpr] -> [BindingExpr]
forall a. [a] -> [a] -> [a]
++ [PrimitiveDataPattern -> Expr -> BindingExpr
Bind ([PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. [PDPatternBase var] -> PDPatternBase var
PDTuplePat [PrimitiveDataPattern
forall var. PDPatternBase var
PDWildCard, String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
sortedCollectionName]) (String -> [Expr] -> Expr
makeApply String
"sortWithSign" [[Expr] -> Expr
CollectionExpr [Expr]
indices])]
    (Expr, [String], [BindingExpr])
-> EvalM (Expr, [String], [BindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Expr
VarExpr String
sortedCollectionName, [String]
signs, [BindingExpr]
newBindings)
  genBindings (VAntiSymmScripts [VarIndex]
xs) = do
    ([Expr]
indices, [[String]]
signss, [[BindingExpr]]
bindingss) <- [(Expr, [String], [BindingExpr])]
-> ([Expr], [[String]], [[BindingExpr]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Expr, [String], [BindingExpr])]
 -> ([Expr], [[String]], [[BindingExpr]]))
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(Expr, [String], [BindingExpr])]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     ([Expr], [[String]], [[BindingExpr]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarIndex -> EvalM (Expr, [String], [BindingExpr]))
-> [VarIndex]
-> StateT
     EvalState
     (ExceptT EgisonError RuntimeM)
     [(Expr, [String], [BindingExpr])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM VarIndex -> EvalM (Expr, [String], [BindingExpr])
genBindings [VarIndex]
xs
    let signs :: [String]
signs = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
signss
    let bindings :: [BindingExpr]
bindings = [[BindingExpr]] -> [BindingExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[BindingExpr]]
bindingss
    String
sortedCollectionName <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
    String
signName <- StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *). MonadRuntime m => m String
fresh
    let newBindings :: [BindingExpr]
newBindings = [BindingExpr]
bindings [BindingExpr] -> [BindingExpr] -> [BindingExpr]
forall a. [a] -> [a] -> [a]
++ [PrimitiveDataPattern -> Expr -> BindingExpr
Bind ([PrimitiveDataPattern] -> PrimitiveDataPattern
forall var. [PDPatternBase var] -> PDPatternBase var
PDTuplePat [String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
signName, String -> PrimitiveDataPattern
forall var. var -> PDPatternBase var
PDPatVar String
sortedCollectionName]) (String -> [Expr] -> Expr
makeApply String
"sortWithSign" [[Expr] -> Expr
CollectionExpr [Expr]
indices])]
    (Expr, [String], [BindingExpr])
-> EvalM (Expr, [String], [BindingExpr])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Expr
VarExpr String
sortedCollectionName, String
signName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
signs, [BindingExpr]
newBindings)

--
-- Utils
--

extractIndexExpr :: IndexExpr a -> a
extractIndexExpr :: IndexExpr a -> a
extractIndexExpr (Subscript a
x)    = a
x
extractIndexExpr (Superscript a
x)  = a
x
extractIndexExpr (SupSubscript a
x) = a
x
extractIndexExpr (Userscript a
x)   = a
x
extractIndexExpr IndexExpr a
_                = String -> a
forall a. HasCallStack => String -> a
error String
"extractIndexExpr: Not supported"

isExtendedIndice :: VarIndex -> Bool
isExtendedIndice :: VarIndex -> Bool
isExtendedIndice VSubscript{}       = Bool
False
isExtendedIndice VSuperscript{}     = Bool
False
isExtendedIndice (VGroupScripts [VarIndex]
xs) = VarIndex -> Bool
isExtendedIndice ([VarIndex] -> VarIndex
forall a. [a] -> a
head [VarIndex]
xs)
isExtendedIndice VarIndex
_                  = Bool
True