{-# LANGUAGE CPP #-}
module Transformations.CurryToIL (ilTrans, transType) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Monad.Extra (concatMapM)
import qualified Control.Monad.Reader as R
import Data.List (nub, partition)
import qualified Data.Map as Map (Map, empty, insert, lookup)
import qualified Data.Set as Set (Set, empty, insert, delete, toList)
import Curry.Base.Ident
import Curry.Syntax hiding (caseAlt)
import Base.CurryTypes (toType)
import Base.Expr
import Base.Messages (internalError)
import Base.Types
import Base.Typing
import Base.Utils (foldr2)
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
import qualified IL as IL
ilTrans :: ValueEnv -> Module Type -> IL.Module
ilTrans :: ValueEnv -> Module Type -> Module
ilTrans vEnv :: ValueEnv
vEnv (Module _ _ m :: ModuleIdent
m _ _ ds :: [Decl Type]
ds) = ModuleIdent -> [ModuleIdent] -> [Decl] -> Module
IL.Module ModuleIdent
m (ModuleIdent -> [Decl] -> [ModuleIdent]
imports ModuleIdent
m [Decl]
ds') [Decl]
ds'
where ds' :: [Decl]
ds' = Reader TransEnv [Decl] -> TransEnv -> [Decl]
forall r a. Reader r a -> r -> a
R.runReader ((Decl Type -> Reader TransEnv [Decl])
-> [Decl Type] -> Reader TransEnv [Decl]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Decl Type -> Reader TransEnv [Decl]
trDecl [Decl Type]
ds) (ModuleIdent -> ValueEnv -> TransEnv
TransEnv ModuleIdent
m ValueEnv
vEnv)
imports :: ModuleIdent -> [IL.Decl] -> [ModuleIdent]
imports :: ModuleIdent -> [Decl] -> [ModuleIdent]
imports m :: ModuleIdent
m = Set ModuleIdent -> [ModuleIdent]
forall a. Set a -> [a]
Set.toList (Set ModuleIdent -> [ModuleIdent])
-> ([Decl] -> Set ModuleIdent) -> [Decl] -> [ModuleIdent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> Set ModuleIdent -> Set ModuleIdent
forall a. Ord a => a -> Set a -> Set a
Set.delete ModuleIdent
m (Set ModuleIdent -> Set ModuleIdent)
-> ([Decl] -> Set ModuleIdent) -> [Decl] -> Set ModuleIdent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl -> Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent -> [Decl] -> Set ModuleIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Decl -> Set ModuleIdent -> Set ModuleIdent
mdlsDecl Set ModuleIdent
forall a. Set a
Set.empty
mdlsDecl :: IL.Decl -> Set.Set ModuleIdent -> Set.Set ModuleIdent
mdlsDecl :: Decl -> Set ModuleIdent -> Set ModuleIdent
mdlsDecl (IL.DataDecl _ _ cs :: [ConstrDecl]
cs) ms :: Set ModuleIdent
ms = (ConstrDecl -> Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent -> [ConstrDecl] -> Set ModuleIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ConstrDecl -> Set ModuleIdent -> Set ModuleIdent
mdlsConstrsDecl Set ModuleIdent
ms [ConstrDecl]
cs
where mdlsConstrsDecl :: ConstrDecl -> Set ModuleIdent -> Set ModuleIdent
mdlsConstrsDecl (IL.ConstrDecl _ tys :: [Type]
tys) ms' :: Set ModuleIdent
ms' = (Type -> Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent -> [Type] -> Set ModuleIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Set ModuleIdent
ms' [Type]
tys
mdlsDecl (IL.ExternalDataDecl _ _) ms :: Set ModuleIdent
ms = Set ModuleIdent
ms
mdlsDecl (IL.FunctionDecl _ _ ty :: Type
ty e :: Expression
e) ms :: Set ModuleIdent
ms = Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Type
ty (Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e Set ModuleIdent
ms)
mdlsDecl (IL.ExternalDecl _ ty :: Type
ty) ms :: Set ModuleIdent
ms = Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Type
ty Set ModuleIdent
ms
mdlsType :: IL.Type -> Set.Set ModuleIdent -> Set.Set ModuleIdent
mdlsType :: Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType (IL.TypeConstructor tc :: QualIdent
tc tys :: [Type]
tys) ms :: Set ModuleIdent
ms = QualIdent -> Set ModuleIdent -> Set ModuleIdent
modules QualIdent
tc ((Type -> Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent -> [Type] -> Set ModuleIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Set ModuleIdent
ms [Type]
tys)
mdlsType (IL.TypeVariable _) ms :: Set ModuleIdent
ms = Set ModuleIdent
ms
mdlsType (IL.TypeArrow ty1 :: Type
ty1 ty2 :: Type
ty2) ms :: Set ModuleIdent
ms = Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Type
ty1 (Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Type
ty2 Set ModuleIdent
ms)
mdlsType (IL.TypeForall _ ty :: Type
ty) ms :: Set ModuleIdent
ms = Type -> Set ModuleIdent -> Set ModuleIdent
mdlsType Type
ty Set ModuleIdent
ms
mdlsExpr :: IL.Expression -> Set.Set ModuleIdent -> Set.Set ModuleIdent
mdlsExpr :: Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr (IL.Function _ f :: QualIdent
f _) ms :: Set ModuleIdent
ms = QualIdent -> Set ModuleIdent -> Set ModuleIdent
modules QualIdent
f Set ModuleIdent
ms
mdlsExpr (IL.Constructor _ c :: QualIdent
c _) ms :: Set ModuleIdent
ms = QualIdent -> Set ModuleIdent -> Set ModuleIdent
modules QualIdent
c Set ModuleIdent
ms
mdlsExpr (IL.Apply e1 :: Expression
e1 e2 :: Expression
e2) ms :: Set ModuleIdent
ms = Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e1 (Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e2 Set ModuleIdent
ms)
mdlsExpr (IL.Case _ e :: Expression
e as :: [Alt]
as) ms :: Set ModuleIdent
ms = Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e ((Alt -> Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent -> [Alt] -> Set ModuleIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Alt -> Set ModuleIdent -> Set ModuleIdent
mdlsAlt Set ModuleIdent
ms [Alt]
as)
where
mdlsAlt :: Alt -> Set ModuleIdent -> Set ModuleIdent
mdlsAlt (IL.Alt t :: ConstrTerm
t e' :: Expression
e') = ConstrTerm -> Set ModuleIdent -> Set ModuleIdent
mdlsPattern ConstrTerm
t (Set ModuleIdent -> Set ModuleIdent)
-> (Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent
-> Set ModuleIdent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e'
mdlsPattern :: ConstrTerm -> Set ModuleIdent -> Set ModuleIdent
mdlsPattern (IL.ConstructorPattern _ c :: QualIdent
c _) = QualIdent -> Set ModuleIdent -> Set ModuleIdent
modules QualIdent
c
mdlsPattern _ = Set ModuleIdent -> Set ModuleIdent
forall a. a -> a
id
mdlsExpr (IL.Or e1 :: Expression
e1 e2 :: Expression
e2) ms :: Set ModuleIdent
ms = Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e1 (Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e2 Set ModuleIdent
ms)
mdlsExpr (IL.Exist _ _ e :: Expression
e) ms :: Set ModuleIdent
ms = Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e Set ModuleIdent
ms
mdlsExpr (IL.Let b :: Binding
b e :: Expression
e) ms :: Set ModuleIdent
ms = Binding -> Set ModuleIdent -> Set ModuleIdent
mdlsBinding Binding
b (Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e Set ModuleIdent
ms)
mdlsExpr (IL.Letrec bs :: [Binding]
bs e :: Expression
e) ms :: Set ModuleIdent
ms = (Binding -> Set ModuleIdent -> Set ModuleIdent)
-> Set ModuleIdent -> [Binding] -> Set ModuleIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Binding -> Set ModuleIdent -> Set ModuleIdent
mdlsBinding (Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e Set ModuleIdent
ms) [Binding]
bs
mdlsExpr _ ms :: Set ModuleIdent
ms = Set ModuleIdent
ms
mdlsBinding :: IL.Binding -> Set.Set ModuleIdent -> Set.Set ModuleIdent
mdlsBinding :: Binding -> Set ModuleIdent -> Set ModuleIdent
mdlsBinding (IL.Binding _ e :: Expression
e) = Expression -> Set ModuleIdent -> Set ModuleIdent
mdlsExpr Expression
e
modules :: QualIdent -> Set.Set ModuleIdent -> Set.Set ModuleIdent
modules :: QualIdent -> Set ModuleIdent -> Set ModuleIdent
modules x :: QualIdent
x ms :: Set ModuleIdent
ms = Set ModuleIdent
-> (ModuleIdent -> Set ModuleIdent)
-> Maybe ModuleIdent
-> Set ModuleIdent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set ModuleIdent
ms (ModuleIdent -> Set ModuleIdent -> Set ModuleIdent
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set ModuleIdent
ms) (QualIdent -> Maybe ModuleIdent
qidModule QualIdent
x)
data TransEnv = TransEnv
{ TransEnv -> ModuleIdent
moduleIdent :: ModuleIdent
, TransEnv -> ValueEnv
valueEnv :: ValueEnv
}
type TransM a = R.Reader TransEnv a
getValueEnv :: TransM ValueEnv
getValueEnv :: TransM ValueEnv
getValueEnv = (TransEnv -> ValueEnv) -> TransM ValueEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks TransEnv -> ValueEnv
valueEnv
trQualify :: Ident -> TransM QualIdent
trQualify :: Ident -> TransM QualIdent
trQualify i :: Ident
i = (ModuleIdent -> Ident -> QualIdent)
-> Ident -> ModuleIdent -> QualIdent
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleIdent -> Ident -> QualIdent
qualifyWith Ident
i (ModuleIdent -> QualIdent)
-> ReaderT TransEnv Identity ModuleIdent -> TransM QualIdent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TransEnv -> ModuleIdent) -> ReaderT TransEnv Identity ModuleIdent
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks TransEnv -> ModuleIdent
moduleIdent
varType :: QualIdent -> TransM Type
varType :: QualIdent -> TransM Type
varType f :: QualIdent
f = do
ValueEnv
tyEnv <- TransM ValueEnv
getValueEnv
case QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue QualIdent
f ValueEnv
tyEnv of
[Value _ _ _ (ForAll _ (PredType _ ty :: Type
ty))] -> Type -> TransM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty
[Label _ _ (ForAll _ (PredType _ ty :: Type
ty))] -> Type -> TransM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty
_ -> String -> TransM Type
forall a. String -> a
internalError (String -> TransM Type) -> String -> TransM Type
forall a b. (a -> b) -> a -> b
$ "CurryToIL.varType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
f
constrType :: QualIdent -> TransM Type
constrType :: QualIdent -> TransM Type
constrType c :: QualIdent
c = do
ValueEnv
vEnv <- TransM ValueEnv
getValueEnv
case QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue QualIdent
c ValueEnv
vEnv of
[DataConstructor _ _ _ (ForAll _ (PredType _ ty :: Type
ty))] -> Type -> TransM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty
[NewtypeConstructor _ _ (ForAll _ (PredType _ ty :: Type
ty))] -> Type -> TransM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty
_ -> String -> TransM Type
forall a. String -> a
internalError (String -> TransM Type) -> String -> TransM Type
forall a b. (a -> b) -> a -> b
$ "CurryToIL.constrType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
c
trDecl :: Decl Type -> TransM [IL.Decl]
trDecl :: Decl Type -> Reader TransEnv [Decl]
trDecl (DataDecl _ tc :: Ident
tc tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs _) = (Decl -> [Decl] -> [Decl]
forall a. a -> [a] -> [a]
:[]) (Decl -> [Decl])
-> ReaderT TransEnv Identity Decl -> Reader TransEnv [Decl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> [Ident] -> [ConstrDecl] -> ReaderT TransEnv Identity Decl
trData Ident
tc [Ident]
tvs [ConstrDecl]
cs
trDecl (ExternalDataDecl _ tc :: Ident
tc tvs :: [Ident]
tvs) = (Decl -> [Decl] -> [Decl]
forall a. a -> [a] -> [a]
:[]) (Decl -> [Decl])
-> ReaderT TransEnv Identity Decl -> Reader TransEnv [Decl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> [Ident] -> ReaderT TransEnv Identity Decl
trExternalData Ident
tc [Ident]
tvs
trDecl (FunctionDecl _ ty :: Type
ty f :: Ident
f eqs :: [Equation Type]
eqs) = (Decl -> [Decl] -> [Decl]
forall a. a -> [a] -> [a]
:[]) (Decl -> [Decl])
-> ReaderT TransEnv Identity Decl -> Reader TransEnv [Decl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> Type -> [Equation Type] -> ReaderT TransEnv Identity Decl
trFunction Ident
f Type
ty [Equation Type]
eqs
trDecl (ExternalDecl _ vs :: [Var Type]
vs) = (Var Type -> ReaderT TransEnv Identity Decl)
-> [Var Type] -> Reader TransEnv [Decl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Var Type -> ReaderT TransEnv Identity Decl
trExternal [Var Type]
vs
trDecl _ = [Decl] -> Reader TransEnv [Decl]
forall (m :: * -> *) a. Monad m => a -> m a
return []
trData :: Ident -> [Ident] -> [ConstrDecl] -> TransM IL.Decl
trData :: Ident -> [Ident] -> [ConstrDecl] -> ReaderT TransEnv Identity Decl
trData tc :: Ident
tc tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs = do
QualIdent
tc' <- Ident -> TransM QualIdent
trQualify Ident
tc
QualIdent -> Int -> [ConstrDecl] -> Decl
IL.DataDecl QualIdent
tc' ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs) ([ConstrDecl] -> Decl)
-> ReaderT TransEnv Identity [ConstrDecl]
-> ReaderT TransEnv Identity Decl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConstrDecl -> ReaderT TransEnv Identity ConstrDecl)
-> [ConstrDecl] -> ReaderT TransEnv Identity [ConstrDecl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ConstrDecl -> ReaderT TransEnv Identity ConstrDecl
trConstrDecl [ConstrDecl]
cs
trConstrDecl :: ConstrDecl -> TransM IL.ConstrDecl
trConstrDecl :: ConstrDecl -> ReaderT TransEnv Identity ConstrDecl
trConstrDecl d :: ConstrDecl
d = do
QualIdent
c' <- Ident -> TransM QualIdent
trQualify (ConstrDecl -> Ident
constr ConstrDecl
d)
[Type]
ty' <- Type -> [Type]
arrowArgs (Type -> [Type]) -> TransM Type -> ReaderT TransEnv Identity [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualIdent -> TransM Type
constrType QualIdent
c'
ConstrDecl -> ReaderT TransEnv Identity ConstrDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (ConstrDecl -> ReaderT TransEnv Identity ConstrDecl)
-> ConstrDecl -> ReaderT TransEnv Identity ConstrDecl
forall a b. (a -> b) -> a -> b
$ QualIdent -> [Type] -> ConstrDecl
IL.ConstrDecl QualIdent
c' ((Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
transType [Type]
ty')
where
constr :: ConstrDecl -> Ident
constr (ConstrDecl _ c :: Ident
c _) = Ident
c
constr (ConOpDecl _ _ op :: Ident
op _) = Ident
op
constr (RecordDecl _ c :: Ident
c _) = Ident
c
trExternalData :: Ident -> [Ident] -> TransM IL.Decl
trExternalData :: Ident -> [Ident] -> ReaderT TransEnv Identity Decl
trExternalData tc :: Ident
tc tvs :: [Ident]
tvs = (QualIdent -> Int -> Decl) -> Int -> QualIdent -> Decl
forall a b c. (a -> b -> c) -> b -> a -> c
flip QualIdent -> Int -> Decl
IL.ExternalDataDecl ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs) (QualIdent -> Decl)
-> TransM QualIdent -> ReaderT TransEnv Identity Decl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> TransM QualIdent
trQualify Ident
tc
trExternal :: Var Type -> TransM IL.Decl
trExternal :: Var Type -> ReaderT TransEnv Identity Decl
trExternal (Var ty :: Type
ty f :: Ident
f) = (QualIdent -> Type -> Decl) -> Type -> QualIdent -> Decl
forall a b c. (a -> b -> c) -> b -> a -> c
flip QualIdent -> Type -> Decl
IL.ExternalDecl (Type -> Type
transType Type
ty) (QualIdent -> Decl)
-> TransM QualIdent -> ReaderT TransEnv Identity Decl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> TransM QualIdent
trQualify Ident
f
transType :: Type -> IL.Type
transType :: Type -> Type
transType ty :: Type
ty = Type -> [Type] -> Type
transType' Type
ty []
transType' :: Type -> [IL.Type] -> IL.Type
transType' :: Type -> [Type] -> Type
transType' (TypeConstructor tc :: QualIdent
tc) = QualIdent -> [Type] -> Type
IL.TypeConstructor QualIdent
tc
transType' (TypeApply ty1 :: Type
ty1 ty2 :: Type
ty2) = Type -> [Type] -> Type
transType' Type
ty1 ([Type] -> Type) -> ([Type] -> [Type]) -> [Type] -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Type
transType Type
ty2 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:)
transType' (TypeVariable tv :: Int
tv) = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
applyType' (Int -> Type
IL.TypeVariable Int
tv)
transType' (TypeConstrained tys :: [Type]
tys _) = Type -> [Type] -> Type
transType' ([Type] -> Type
forall a. [a] -> a
head [Type]
tys)
transType' (TypeArrow ty1 :: Type
ty1 ty2 :: Type
ty2) =
(Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
applyType' (Type -> Type -> Type
IL.TypeArrow (Type -> Type
transType Type
ty1) (Type -> Type
transType Type
ty2))
transType' (TypeForall tvs :: [Int]
tvs ty :: Type
ty) =
(Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
applyType' ([Int] -> Type -> Type
IL.TypeForall [Int]
tvs (Type -> Type
transType Type
ty))
applyType' :: IL.Type -> IL.Type -> IL.Type
applyType' :: Type -> Type -> Type
applyType' ty1 :: Type
ty1 ty2 :: Type
ty2 =
QualIdent -> [Type] -> Type
IL.TypeConstructor (ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
preludeMIdent (String -> Ident
mkIdent "Apply")) [Type
ty1, Type
ty2]
trFunction :: Ident -> Type -> [Equation Type] -> TransM IL.Decl
trFunction :: Ident -> Type -> [Equation Type] -> ReaderT TransEnv Identity Decl
trFunction f :: Ident
f ty :: Type
ty eqs :: [Equation Type]
eqs = do
QualIdent
f' <- Ident -> TransM QualIdent
trQualify Ident
f
let ty' :: Type
ty' = Type -> Type
transType Type
ty
vs' :: [(Type, Ident)]
vs' = [Type] -> [Ident] -> [(Type, Ident)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Pattern Type -> Type) -> [Pattern Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Type -> Type
transType (Type -> Type) -> (Pattern Type -> Type) -> Pattern Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Type -> Type
forall a. Typeable a => a -> Type
typeOf) [Pattern Type]
ts) [Ident]
vs
[Match]
alts <- (Equation Type -> ReaderT TransEnv Identity Match)
-> [Equation Type] -> ReaderT TransEnv Identity [Match]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident]
-> [Ident] -> Equation Type -> ReaderT TransEnv Identity Match
trEquation [Ident]
vs [Ident]
ws) [Equation Type]
eqs
Decl -> ReaderT TransEnv Identity Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Decl -> ReaderT TransEnv Identity Decl)
-> Decl -> ReaderT TransEnv Identity Decl
forall a b. (a -> b) -> a -> b
$ QualIdent -> [(Type, Ident)] -> Type -> Expression -> Decl
IL.FunctionDecl QualIdent
f' [(Type, Ident)]
vs' Type
ty' ([(Type, Ident)] -> [Match] -> Expression
flexMatch [(Type, Ident)]
vs' [Match]
alts)
where
Equation _ lhs :: Lhs Type
lhs _ = [Equation Type] -> Equation Type
forall a. [a] -> a
head [Equation Type]
eqs
(_, ts :: [Pattern Type]
ts) = Lhs Type -> (Ident, [Pattern Type])
forall a. Lhs a -> (Ident, [Pattern a])
flatLhs Lhs Type
lhs
(vs :: [Ident]
vs, ws :: [Ident]
ws) = Int -> [Ident] -> ([Ident], [Ident])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Pattern Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern Type]
ts) (Ident -> [Ident]
argNames (String -> Ident
mkIdent ""))
trEquation :: [Ident]
-> [Ident]
-> Equation Type
-> TransM Match
trEquation :: [Ident]
-> [Ident] -> Equation Type -> ReaderT TransEnv Identity Match
trEquation vs :: [Ident]
vs vs' :: [Ident]
vs' (Equation _ (FunLhs _ _ ts :: [Pattern Type]
ts) rhs :: Rhs Type
rhs) = do
let patternRenaming :: RenameEnv
patternRenaming = (Ident -> Pattern Type -> RenameEnv -> RenameEnv)
-> RenameEnv -> [Ident] -> [Pattern Type] -> RenameEnv
forall a b c. (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 Ident -> Pattern Type -> RenameEnv -> RenameEnv
forall a. Ident -> Pattern a -> RenameEnv -> RenameEnv
bindRenameEnv RenameEnv
forall k a. Map k a
Map.empty [Ident]
vs [Pattern Type]
ts
Expression
rhs' <- [Ident] -> RenameEnv -> Rhs Type -> TransM Expression
trRhs [Ident]
vs' RenameEnv
patternRenaming Rhs Type
rhs
Match -> ReaderT TransEnv Identity Match
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ident -> Pattern Type -> NestedTerm)
-> [Ident] -> [Pattern Type] -> [NestedTerm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ident -> Pattern Type -> NestedTerm
trPattern [Ident]
vs [Pattern Type]
ts, Expression
rhs')
trEquation _ _ _
= String -> ReaderT TransEnv Identity Match
forall a. String -> a
internalError "Translation of non-FunLhs euqation not defined"
type RenameEnv = Map.Map Ident Ident
bindRenameEnv :: Ident -> Pattern a -> RenameEnv -> RenameEnv
bindRenameEnv :: Ident -> Pattern a -> RenameEnv -> RenameEnv
bindRenameEnv _ (LiteralPattern _ _ _) env :: RenameEnv
env = RenameEnv
env
bindRenameEnv v :: Ident
v (VariablePattern _ _ v' :: Ident
v') env :: RenameEnv
env = Ident -> Ident -> RenameEnv -> RenameEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
v' Ident
v RenameEnv
env
bindRenameEnv v :: Ident
v (ConstructorPattern _ _ _ ts :: [Pattern a]
ts) env :: RenameEnv
env
= (Ident -> Pattern a -> RenameEnv -> RenameEnv)
-> RenameEnv -> [Ident] -> [Pattern a] -> RenameEnv
forall a b c. (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 Ident -> Pattern a -> RenameEnv -> RenameEnv
forall a. Ident -> Pattern a -> RenameEnv -> RenameEnv
bindRenameEnv RenameEnv
env (Ident -> [Ident]
argNames Ident
v) [Pattern a]
ts
bindRenameEnv v :: Ident
v (AsPattern _ v' :: Ident
v' t :: Pattern a
t) env :: RenameEnv
env
= Ident -> Ident -> RenameEnv -> RenameEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
v' Ident
v (Ident -> Pattern a -> RenameEnv -> RenameEnv
forall a. Ident -> Pattern a -> RenameEnv -> RenameEnv
bindRenameEnv Ident
v Pattern a
t RenameEnv
env)
bindRenameEnv _ _ _
= String -> RenameEnv
forall a. String -> a
internalError "CurryToIL.bindRenameEnv"
trRhs :: [Ident] -> RenameEnv -> Rhs Type -> TransM IL.Expression
trRhs :: [Ident] -> RenameEnv -> Rhs Type -> TransM Expression
trRhs vs :: [Ident]
vs env :: RenameEnv
env (SimpleRhs _ e :: Expression Type
e _) = [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr [Ident]
vs RenameEnv
env Expression Type
e
trRhs _ _ (GuardedRhs _ _ _) = String -> TransM Expression
forall a. String -> a
internalError "CurryToIL.trRhs: GuardedRhs"
trExpr :: [Ident] -> RenameEnv -> Expression Type -> TransM IL.Expression
trExpr :: [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr _ _ (Literal _ ty :: Type
ty l :: Literal
l) = Expression -> TransM Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> TransM Expression)
-> Expression -> TransM Expression
forall a b. (a -> b) -> a -> b
$ Type -> Literal -> Expression
IL.Literal (Type -> Type
transType Type
ty) (Literal -> Literal
trLiteral Literal
l)
trExpr _ env :: RenameEnv
env (Variable _ ty :: Type
ty v :: QualIdent
v)
| QualIdent -> Bool
isQualified QualIdent
v = TransM Expression
fun
| Bool
otherwise = case Ident -> RenameEnv -> Maybe Ident
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (QualIdent -> Ident
unqualify QualIdent
v) RenameEnv
env of
Nothing -> TransM Expression
fun
Just v' :: Ident
v' -> Expression -> TransM Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> TransM Expression)
-> Expression -> TransM Expression
forall a b. (a -> b) -> a -> b
$ Type -> Ident -> Expression
IL.Variable (Type -> Type
transType Type
ty) Ident
v'
where fun :: TransM Expression
fun = (Type -> QualIdent -> Int -> Expression
IL.Function (Type -> Type
transType Type
ty) QualIdent
v (Int -> Expression) -> (Type -> Int) -> Type -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Int
arrowArity) (Type -> Expression) -> TransM Type -> TransM Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualIdent -> TransM Type
varType QualIdent
v
trExpr _ _ (Constructor _ ty :: Type
ty c :: QualIdent
c)
= (Type -> QualIdent -> Int -> Expression
IL.Constructor (Type -> Type
transType Type
ty) QualIdent
c (Int -> Expression) -> (Type -> Int) -> Type -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Int
arrowArity) (Type -> Expression) -> TransM Type -> TransM Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualIdent -> TransM Type
constrType QualIdent
c
trExpr vs :: [Ident]
vs env :: RenameEnv
env (Apply _ e1 :: Expression Type
e1 e2 :: Expression Type
e2)
= Expression -> Expression -> Expression
IL.Apply (Expression -> Expression -> Expression)
-> TransM Expression
-> ReaderT TransEnv Identity (Expression -> Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr [Ident]
vs RenameEnv
env Expression Type
e1 ReaderT TransEnv Identity (Expression -> Expression)
-> TransM Expression -> TransM Expression
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr [Ident]
vs RenameEnv
env Expression Type
e2
trExpr vs :: [Ident]
vs env :: RenameEnv
env (Let _ ds :: [Decl Type]
ds e :: Expression Type
e) = do
Expression
e' <- [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr [Ident]
vs RenameEnv
env' Expression Type
e
case [Decl Type]
ds of
[FreeDecl _ vs' :: [Var Type]
vs']
-> Expression -> TransM Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> TransM Expression)
-> Expression -> TransM Expression
forall a b. (a -> b) -> a -> b
$ (Var Type -> Expression -> Expression)
-> Expression -> [Var Type] -> Expression
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (Var ty :: Type
ty v :: Ident
v) -> Ident -> Type -> Expression -> Expression
IL.Exist Ident
v (Type -> Type
transType Type
ty)) Expression
e' [Var Type]
vs'
[d :: Decl Type
d] | (Ident -> Bool) -> [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Decl Type -> [Ident]
forall e. QuantExpr e => e -> [Ident]
bv Decl Type
d) (ModuleIdent -> Decl Type -> [Ident]
forall e. QualExpr e => ModuleIdent -> e -> [Ident]
qfv ModuleIdent
emptyMIdent Decl Type
d)
-> (Binding -> Expression -> Expression)
-> Expression -> Binding -> Expression
forall a b c. (a -> b -> c) -> b -> a -> c
flip Binding -> Expression -> Expression
IL.Let Expression
e' (Binding -> Expression)
-> ReaderT TransEnv Identity Binding -> TransM Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decl Type -> ReaderT TransEnv Identity Binding
trBinding Decl Type
d
_ -> ([Binding] -> Expression -> Expression)
-> Expression -> [Binding] -> Expression
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Binding] -> Expression -> Expression
IL.Letrec Expression
e' ([Binding] -> Expression)
-> ReaderT TransEnv Identity [Binding] -> TransM Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl Type -> ReaderT TransEnv Identity Binding)
-> [Decl Type] -> ReaderT TransEnv Identity [Binding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl Type -> ReaderT TransEnv Identity Binding
trBinding [Decl Type]
ds
where
env' :: RenameEnv
env' = (Ident -> Ident -> RenameEnv -> RenameEnv)
-> RenameEnv -> [Ident] -> [Ident] -> RenameEnv
forall a b c. (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 Ident -> Ident -> RenameEnv -> RenameEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RenameEnv
env [Ident]
bvs [Ident]
bvs
bvs :: [Ident]
bvs = [Decl Type] -> [Ident]
forall e. QuantExpr e => e -> [Ident]
bv [Decl Type]
ds
trBinding :: Decl Type -> ReaderT TransEnv Identity Binding
trBinding (PatternDecl _ (VariablePattern _ _ v :: Ident
v) rhs :: Rhs Type
rhs)
= Ident -> Expression -> Binding
IL.Binding Ident
v (Expression -> Binding)
-> TransM Expression -> ReaderT TransEnv Identity Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> RenameEnv -> Rhs Type -> TransM Expression
trRhs [Ident]
vs RenameEnv
env' Rhs Type
rhs
trBinding p :: Decl Type
p = String -> ReaderT TransEnv Identity Binding
forall a. HasCallStack => String -> a
error (String -> ReaderT TransEnv Identity Binding)
-> String -> ReaderT TransEnv Identity Binding
forall a b. (a -> b) -> a -> b
$ "unexpected binding: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Decl Type -> String
forall a. Show a => a -> String
show Decl Type
p
trExpr (v :: Ident
v:vs :: [Ident]
vs) env :: RenameEnv
env (Case _ ct :: CaseType
ct e :: Expression Type
e alts :: [Alt Type]
alts) = do
Expression
e' <- [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr [Ident]
vs RenameEnv
env Expression Type
e
let matcher :: [(Type, Ident)] -> [Match] -> Expression
matcher = if CaseType
ct CaseType -> CaseType -> Bool
forall a. Eq a => a -> a -> Bool
== CaseType
Flex then [(Type, Ident)] -> [Match] -> Expression
flexMatch else [(Type, Ident)] -> [Match] -> Expression
rigidMatch
ty' :: Type
ty' = Type -> Type
transType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Expression Type -> Type
forall a. Typeable a => a -> Type
typeOf Expression Type
e
Expression
expr <- [(Type, Ident)] -> [Match] -> Expression
matcher [(Type
ty', Ident
v)] ([Match] -> Expression)
-> ReaderT TransEnv Identity [Match] -> TransM Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Alt Type -> ReaderT TransEnv Identity Match)
-> [Alt Type] -> ReaderT TransEnv Identity [Match]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Ident] -> RenameEnv -> Alt Type -> ReaderT TransEnv Identity Match
trAlt (Ident
vIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
vs) RenameEnv
env) [Alt Type]
alts
Expression -> TransM Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> TransM Expression)
-> Expression -> TransM Expression
forall a b. (a -> b) -> a -> b
$ case Expression
expr of
IL.Case mode :: Eval
mode (IL.Variable _ v' :: Ident
v') alts' :: [Alt]
alts'
| Ident
v Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
v' Bool -> Bool -> Bool
&& Ident
v Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Alt] -> [Ident]
forall e. Expr e => e -> [Ident]
fv [Alt]
alts' -> Eval -> Expression -> [Alt] -> Expression
IL.Case Eval
mode Expression
e' [Alt]
alts'
_
| Ident
v Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Expression -> [Ident]
forall e. Expr e => e -> [Ident]
fv Expression
expr -> Binding -> Expression -> Expression
IL.Let (Ident -> Expression -> Binding
IL.Binding Ident
v Expression
e') Expression
expr
| Bool
otherwise -> Expression
expr
trExpr vs :: [Ident]
vs env :: RenameEnv
env (Typed _ e :: Expression Type
e (QualTypeExpr _ _ ty :: TypeExpr
ty)) =
(Expression -> Type -> Expression)
-> Type -> Expression -> Expression
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expression -> Type -> Expression
IL.Typed Type
ty' (Expression -> Expression)
-> TransM Expression -> TransM Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident] -> RenameEnv -> Expression Type -> TransM Expression
trExpr [Ident]
vs RenameEnv
env Expression Type
e
where ty' :: Type
ty' = Type -> Type
transType ([Ident] -> TypeExpr -> Type
toType [] TypeExpr
ty)
trExpr _ _ _ = String -> TransM Expression
forall a. String -> a
internalError "CurryToIL.trExpr"
trAlt :: [Ident] -> RenameEnv -> Alt Type -> TransM Match
trAlt :: [Ident] -> RenameEnv -> Alt Type -> ReaderT TransEnv Identity Match
trAlt ~(v :: Ident
v:vs :: [Ident]
vs) env :: RenameEnv
env (Alt _ t :: Pattern Type
t rhs :: Rhs Type
rhs) = do
Expression
rhs' <- [Ident] -> RenameEnv -> Rhs Type -> TransM Expression
trRhs [Ident]
vs (Ident -> Pattern Type -> RenameEnv -> RenameEnv
forall a. Ident -> Pattern a -> RenameEnv -> RenameEnv
bindRenameEnv Ident
v Pattern Type
t RenameEnv
env) Rhs Type
rhs
Match -> ReaderT TransEnv Identity Match
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ident -> Pattern Type -> NestedTerm
trPattern Ident
v Pattern Type
t], Expression
rhs')
trLiteral :: Literal -> IL.Literal
trLiteral :: Literal -> Literal
trLiteral (Char c :: Char
c) = Char -> Literal
IL.Char Char
c
trLiteral (Int i :: Integer
i) = Integer -> Literal
IL.Int Integer
i
trLiteral (Float f :: Double
f) = Double -> Literal
IL.Float Double
f
trLiteral _ = String -> Literal
forall a. String -> a
internalError "CurryToIL.trLiteral"
data NestedTerm = NestedTerm IL.ConstrTerm [NestedTerm] deriving Int -> NestedTerm -> String -> String
[NestedTerm] -> String -> String
NestedTerm -> String
(Int -> NestedTerm -> String -> String)
-> (NestedTerm -> String)
-> ([NestedTerm] -> String -> String)
-> Show NestedTerm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NestedTerm] -> String -> String
$cshowList :: [NestedTerm] -> String -> String
show :: NestedTerm -> String
$cshow :: NestedTerm -> String
showsPrec :: Int -> NestedTerm -> String -> String
$cshowsPrec :: Int -> NestedTerm -> String -> String
Show
pattern :: NestedTerm -> IL.ConstrTerm
pattern :: NestedTerm -> ConstrTerm
pattern (NestedTerm t :: ConstrTerm
t _) = ConstrTerm
t
arguments :: NestedTerm -> [NestedTerm]
arguments :: NestedTerm -> [NestedTerm]
arguments (NestedTerm _ ts :: [NestedTerm]
ts) = [NestedTerm]
ts
trPattern :: Ident -> Pattern Type -> NestedTerm
trPattern :: Ident -> Pattern Type -> NestedTerm
trPattern _ (LiteralPattern _ ty :: Type
ty l :: Literal
l)
= ConstrTerm -> [NestedTerm] -> NestedTerm
NestedTerm (Type -> Literal -> ConstrTerm
IL.LiteralPattern (Type -> Type
transType Type
ty) (Literal -> ConstrTerm) -> Literal -> ConstrTerm
forall a b. (a -> b) -> a -> b
$ Literal -> Literal
trLiteral Literal
l) []
trPattern v :: Ident
v (VariablePattern _ ty :: Type
ty _)
= ConstrTerm -> [NestedTerm] -> NestedTerm
NestedTerm (Type -> Ident -> ConstrTerm
IL.VariablePattern (Type -> Type
transType Type
ty) Ident
v) []
trPattern v :: Ident
v (ConstructorPattern _ ty :: Type
ty c :: QualIdent
c ts :: [Pattern Type]
ts)
= ConstrTerm -> [NestedTerm] -> NestedTerm
NestedTerm (Type -> QualIdent -> [(Type, Ident)] -> ConstrTerm
IL.ConstructorPattern (Type -> Type
transType Type
ty) QualIdent
c [(Type, Ident)]
vs')
((Ident -> Pattern Type -> NestedTerm)
-> [Ident] -> [Pattern Type] -> [NestedTerm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ident -> Pattern Type -> NestedTerm
trPattern [Ident]
vs [Pattern Type]
ts)
where vs :: [Ident]
vs = Ident -> [Ident]
argNames Ident
v
vs' :: [(Type, Ident)]
vs' = [Type] -> [Ident] -> [(Type, Ident)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Pattern Type -> Type) -> [Pattern Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Type -> Type
transType (Type -> Type) -> (Pattern Type -> Type) -> Pattern Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Type -> Type
forall a. Typeable a => a -> Type
typeOf) [Pattern Type]
ts) [Ident]
vs
trPattern v :: Ident
v (AsPattern _ _ t :: Pattern Type
t) = Ident -> Pattern Type -> NestedTerm
trPattern Ident
v Pattern Type
t
trPattern _ _ = String -> NestedTerm
forall a. String -> a
internalError "CurryToIL.trPattern"
argNames :: Ident -> [Ident]
argNames :: Ident -> [Ident]
argNames v :: Ident
v = [String -> Ident
mkIdent (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i) | Integer
i <- [1 :: Integer ..] ]
where prefix :: String
prefix = Ident -> String
idName Ident
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_"
type Match = ([NestedTerm], IL.Expression)
type Match' = (FunList NestedTerm, [NestedTerm], IL.Expression)
type FunList a = [a] -> [a]
flexMatch :: [(IL.Type, Ident)]
-> [Match]
-> IL.Expression
flexMatch :: [(Type, Ident)] -> [Match] -> Expression
flexMatch [] alts :: [Match]
alts = (Expression -> Expression -> Expression)
-> [Expression] -> Expression
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Expression -> Expression -> Expression
IL.Or ((Match -> Expression) -> [Match] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map Match -> Expression
forall a b. (a, b) -> b
snd [Match]
alts)
flexMatch (v :: (Type, Ident)
v:vs :: [(Type, Ident)]
vs) alts :: [Match]
alts
| Bool
notDemanded = Expression
varExp
| Bool
isInductive = Expression
conExp
| Bool
otherwise = Expression
-> FunList (Type, Ident)
-> [(Type, Ident)]
-> [Match']
-> Expression
optFlexMatch (Expression -> Expression -> Expression
IL.Or Expression
conExp Expression
varExp) ((Type, Ident)
v(Type, Ident) -> FunList (Type, Ident)
forall a. a -> [a] -> [a]
:) [(Type, Ident)]
vs ((Match -> Match') -> [Match] -> [Match']
forall a b. (a -> b) -> [a] -> [b]
map Match -> Match'
skipPat [Match]
alts)
where
isInductive :: Bool
isInductive = [(ConstrTerm, Match)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ConstrTerm, Match)]
varAlts
notDemanded :: Bool
notDemanded = [(ConstrTerm, Match)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ConstrTerm, Match)]
conAlts
(varAlts :: [(ConstrTerm, Match)]
varAlts, conAlts :: [(ConstrTerm, Match)]
conAlts) = ((ConstrTerm, Match) -> Bool)
-> [(ConstrTerm, Match)]
-> ([(ConstrTerm, Match)], [(ConstrTerm, Match)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ConstrTerm, Match) -> Bool
forall a. (ConstrTerm, a) -> Bool
isVarMatch ((Match -> (ConstrTerm, Match)) -> [Match] -> [(ConstrTerm, Match)]
forall a b. (a -> b) -> [a] -> [b]
map Match -> (ConstrTerm, Match)
tagAlt [Match]
alts)
varExp :: Expression
varExp = [(Type, Ident)] -> [Match] -> Expression
flexMatch [(Type, Ident)]
vs (((ConstrTerm, Match) -> Match) -> [(ConstrTerm, Match)] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map (ConstrTerm, Match) -> Match
forall a b. (a, b) -> b
snd [(ConstrTerm, Match)]
varAlts)
conExp :: Expression
conExp = FunList (Type, Ident)
-> (Type, Ident)
-> [(Type, Ident)]
-> [(ConstrTerm, Match')]
-> Expression
flexMatchInductive FunList (Type, Ident)
forall a. a -> a
id (Type, Ident)
v [(Type, Ident)]
vs (((ConstrTerm, Match) -> (ConstrTerm, Match'))
-> [(ConstrTerm, Match)] -> [(ConstrTerm, Match')]
forall a b. (a -> b) -> [a] -> [b]
map (ConstrTerm, Match) -> (ConstrTerm, Match')
forall a b c a. (a, (b, c)) -> (a, (a -> a, b, c))
prep [(ConstrTerm, Match)]
conAlts)
prep :: (a, (b, c)) -> (a, (a -> a, b, c))
prep (p :: a
p, (ts :: b
ts, e :: c
e)) = (a
p, (a -> a
forall a. a -> a
id, b
ts, c
e))
optFlexMatch :: IL.Expression
-> FunList (IL.Type, Ident)
-> [(IL.Type, Ident)]
-> [Match']
-> IL.Expression
optFlexMatch :: Expression
-> FunList (Type, Ident)
-> [(Type, Ident)]
-> [Match']
-> Expression
optFlexMatch def :: Expression
def _ [] _ = Expression
def
optFlexMatch def :: Expression
def prefix :: FunList (Type, Ident)
prefix (v :: (Type, Ident)
v:vs :: [(Type, Ident)]
vs) alts :: [Match']
alts
| Bool
isInductive = FunList (Type, Ident)
-> (Type, Ident)
-> [(Type, Ident)]
-> [(ConstrTerm, Match')]
-> Expression
flexMatchInductive FunList (Type, Ident)
prefix (Type, Ident)
v [(Type, Ident)]
vs [(ConstrTerm, Match')]
alts'
| Bool
otherwise = Expression
-> FunList (Type, Ident)
-> [(Type, Ident)]
-> [Match']
-> Expression
optFlexMatch Expression
def (FunList (Type, Ident)
prefix FunList (Type, Ident)
-> FunList (Type, Ident) -> FunList (Type, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Type, Ident)
v(Type, Ident) -> FunList (Type, Ident)
forall a. a -> [a] -> [a]
:)) [(Type, Ident)]
vs ((Match' -> Match') -> [Match'] -> [Match']
forall a b. (a -> b) -> [a] -> [b]
map Match' -> Match'
skipPat' [Match']
alts)
where
isInductive :: Bool
isInductive = Bool -> Bool
not (((ConstrTerm, Match') -> Bool) -> [(ConstrTerm, Match')] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ConstrTerm, Match') -> Bool
forall a. (ConstrTerm, a) -> Bool
isVarMatch [(ConstrTerm, Match')]
alts')
alts' :: [(ConstrTerm, Match')]
alts' = (Match' -> (ConstrTerm, Match'))
-> [Match'] -> [(ConstrTerm, Match')]
forall a b. (a -> b) -> [a] -> [b]
map Match' -> (ConstrTerm, Match')
tagAlt' [Match']
alts
flexMatchInductive :: FunList (IL.Type, Ident)
-> (IL.Type, Ident)
-> [(IL.Type, Ident)]
-> [(IL.ConstrTerm, Match')]
-> IL.Expression
flexMatchInductive :: FunList (Type, Ident)
-> (Type, Ident)
-> [(Type, Ident)]
-> [(ConstrTerm, Match')]
-> Expression
flexMatchInductive prefix :: FunList (Type, Ident)
prefix v :: (Type, Ident)
v vs :: [(Type, Ident)]
vs as :: [(ConstrTerm, Match')]
as
= Eval -> Expression -> [Alt] -> Expression
IL.Case Eval
IL.Flex ((Type -> Ident -> Expression) -> (Type, Ident) -> Expression
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Type -> Ident -> Expression
IL.Variable (Type, Ident)
v) ([(ConstrTerm, Match')] -> [Alt]
forall t.
[(ConstrTerm, (t -> [NestedTerm], t, Expression))] -> [Alt]
flexMatchAlts [(ConstrTerm, Match')]
as)
where
flexMatchAlts :: [(ConstrTerm, (t -> [NestedTerm], t, Expression))] -> [Alt]
flexMatchAlts [] = []
flexMatchAlts ((t :: ConstrTerm
t, e :: (t -> [NestedTerm], t, Expression)
e) : alts :: [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
alts) = ConstrTerm -> Expression -> Alt
IL.Alt ConstrTerm
t Expression
expr Alt -> [Alt] -> [Alt]
forall a. a -> [a] -> [a]
: [(ConstrTerm, (t -> [NestedTerm], t, Expression))] -> [Alt]
flexMatchAlts [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
others
where
expr :: Expression
expr = [(Type, Ident)] -> [Match] -> Expression
flexMatch (FunList (Type, Ident)
prefix (ConstrTerm -> [(Type, Ident)]
vars ConstrTerm
t [(Type, Ident)] -> FunList (Type, Ident)
forall a. [a] -> [a] -> [a]
++ [(Type, Ident)]
vs)) (((t -> [NestedTerm], t, Expression) -> Match)
-> [(t -> [NestedTerm], t, Expression)] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map (t -> [NestedTerm], t, Expression) -> Match
forall t a b. (t -> a, t, b) -> (a, b)
expandVars ((t -> [NestedTerm], t, Expression)
e (t -> [NestedTerm], t, Expression)
-> [(t -> [NestedTerm], t, Expression)]
-> [(t -> [NestedTerm], t, Expression)]
forall a. a -> [a] -> [a]
: ((ConstrTerm, (t -> [NestedTerm], t, Expression))
-> (t -> [NestedTerm], t, Expression))
-> [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
-> [(t -> [NestedTerm], t, Expression)]
forall a b. (a -> b) -> [a] -> [b]
map (ConstrTerm, (t -> [NestedTerm], t, Expression))
-> (t -> [NestedTerm], t, Expression)
forall a b. (a, b) -> b
snd [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
same))
expandVars :: (t -> a, t, b) -> (a, b)
expandVars (pref :: t -> a
pref, ts1 :: t
ts1, e' :: b
e') = (t -> a
pref t
ts1, b
e')
(same :: [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
same, others :: [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
others) = ((ConstrTerm, (t -> [NestedTerm], t, Expression)) -> Bool)
-> [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
-> ([(ConstrTerm, (t -> [NestedTerm], t, Expression))],
[(ConstrTerm, (t -> [NestedTerm], t, Expression))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ConstrTerm
t ConstrTerm -> ConstrTerm -> Bool
forall a. Eq a => a -> a -> Bool
==) (ConstrTerm -> Bool)
-> ((ConstrTerm, (t -> [NestedTerm], t, Expression)) -> ConstrTerm)
-> (ConstrTerm, (t -> [NestedTerm], t, Expression))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstrTerm, (t -> [NestedTerm], t, Expression)) -> ConstrTerm
forall a b. (a, b) -> a
fst) [(ConstrTerm, (t -> [NestedTerm], t, Expression))]
alts
rigidMatch :: [(IL.Type, Ident)] -> [Match] -> IL.Expression
rigidMatch :: [(Type, Ident)] -> [Match] -> Expression
rigidMatch vs :: [(Type, Ident)]
vs alts :: [Match]
alts = Expression
-> FunList (Type, Ident)
-> [(Type, Ident)]
-> [Match']
-> Expression
rigidOptMatch (Match -> Expression
forall a b. (a, b) -> b
snd (Match -> Expression) -> Match -> Expression
forall a b. (a -> b) -> a -> b
$ [Match] -> Match
forall a. [a] -> a
head [Match]
alts) FunList (Type, Ident)
forall a. a -> a
id [(Type, Ident)]
vs ((Match -> Match') -> [Match] -> [Match']
forall a b. (a -> b) -> [a] -> [b]
map Match -> Match'
forall b c a. (b, c) -> (a -> a, b, c)
prepare [Match]
alts)
where prepare :: (b, c) -> (a -> a, b, c)
prepare (ts :: b
ts, e :: c
e) = (a -> a
forall a. a -> a
id, b
ts, c
e)
rigidOptMatch :: IL.Expression
-> FunList (IL.Type, Ident)
-> [(IL.Type, Ident)]
-> [Match']
-> IL.Expression
rigidOptMatch :: Expression
-> FunList (Type, Ident)
-> [(Type, Ident)]
-> [Match']
-> Expression
rigidOptMatch def :: Expression
def _ [] _ = Expression
def
rigidOptMatch def :: Expression
def prefix :: FunList (Type, Ident)
prefix (v :: (Type, Ident)
v : vs :: [(Type, Ident)]
vs) alts :: [Match']
alts
| Bool
isDemanded = FunList (Type, Ident)
-> (Type, Ident)
-> [(Type, Ident)]
-> [(ConstrTerm, Match')]
-> Expression
rigidMatchDemanded FunList (Type, Ident)
prefix (Type, Ident)
v [(Type, Ident)]
vs [(ConstrTerm, Match')]
alts'
| Bool
otherwise = Expression
-> FunList (Type, Ident)
-> [(Type, Ident)]
-> [Match']
-> Expression
rigidOptMatch Expression
def (FunList (Type, Ident)
prefix FunList (Type, Ident)
-> FunList (Type, Ident) -> FunList (Type, Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Type, Ident)
v(Type, Ident) -> FunList (Type, Ident)
forall a. a -> [a] -> [a]
:)) [(Type, Ident)]
vs ((Match' -> Match') -> [Match'] -> [Match']
forall a b. (a -> b) -> [a] -> [b]
map Match' -> Match'
skipPat' [Match']
alts)
where
isDemanded :: Bool
isDemanded = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ConstrTerm, Match') -> Bool
forall a. (ConstrTerm, a) -> Bool
isVarMatch ([(ConstrTerm, Match')] -> (ConstrTerm, Match')
forall a. [a] -> a
head [(ConstrTerm, Match')]
alts')
alts' :: [(ConstrTerm, Match')]
alts' = (Match' -> (ConstrTerm, Match'))
-> [Match'] -> [(ConstrTerm, Match')]
forall a b. (a -> b) -> [a] -> [b]
map Match' -> (ConstrTerm, Match')
tagAlt' [Match']
alts
rigidMatchDemanded :: FunList (IL.Type, Ident)
-> (IL.Type, Ident)
-> [(IL.Type, Ident)]
-> [(IL.ConstrTerm, Match')]
-> IL.Expression
rigidMatchDemanded :: FunList (Type, Ident)
-> (Type, Ident)
-> [(Type, Ident)]
-> [(ConstrTerm, Match')]
-> Expression
rigidMatchDemanded prefix :: FunList (Type, Ident)
prefix v :: (Type, Ident)
v vs :: [(Type, Ident)]
vs alts :: [(ConstrTerm, Match')]
alts = Eval -> Expression -> [Alt] -> Expression
IL.Case Eval
IL.Rigid ((Type -> Ident -> Expression) -> (Type, Ident) -> Expression
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Type -> Ident -> Expression
IL.Variable (Type, Ident)
v)
([Alt] -> Expression) -> [Alt] -> Expression
forall a b. (a -> b) -> a -> b
$ (ConstrTerm -> Alt) -> [ConstrTerm] -> [Alt]
forall a b. (a -> b) -> [a] -> [b]
map ConstrTerm -> Alt
caseAlt ([ConstrTerm]
consPats [ConstrTerm] -> [ConstrTerm] -> [ConstrTerm]
forall a. [a] -> [a] -> [a]
++ [ConstrTerm]
varPats)
where
(varPats :: [ConstrTerm]
varPats, consPats :: [ConstrTerm]
consPats) = (ConstrTerm -> Bool)
-> [ConstrTerm] -> ([ConstrTerm], [ConstrTerm])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ConstrTerm -> Bool
isVarPattern ([ConstrTerm] -> ([ConstrTerm], [ConstrTerm]))
-> [ConstrTerm] -> ([ConstrTerm], [ConstrTerm])
forall a b. (a -> b) -> a -> b
$ [ConstrTerm] -> [ConstrTerm]
forall a. Eq a => [a] -> [a]
nub ([ConstrTerm] -> [ConstrTerm]) -> [ConstrTerm] -> [ConstrTerm]
forall a b. (a -> b) -> a -> b
$ ((ConstrTerm, Match') -> ConstrTerm)
-> [(ConstrTerm, Match')] -> [ConstrTerm]
forall a b. (a -> b) -> [a] -> [b]
map (ConstrTerm, Match') -> ConstrTerm
forall a b. (a, b) -> a
fst [(ConstrTerm, Match')]
alts
caseAlt :: ConstrTerm -> Alt
caseAlt t :: ConstrTerm
t = ConstrTerm -> Expression -> Alt
IL.Alt ConstrTerm
t Expression
expr
where
expr :: Expression
expr = [(Type, Ident)] -> [Match] -> Expression
rigidMatch (FunList (Type, Ident)
prefix FunList (Type, Ident) -> FunList (Type, Ident)
forall a b. (a -> b) -> a -> b
$ ConstrTerm -> [(Type, Ident)]
vars ConstrTerm
t [(Type, Ident)] -> FunList (Type, Ident)
forall a. [a] -> [a] -> [a]
++ [(Type, Ident)]
vs) ([(ConstrTerm, Match')] -> [Match]
forall a b.
[(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))] -> [(a, b)]
matchingCases [(ConstrTerm, Match')]
alts)
matchingCases :: [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))] -> [(a, b)]
matchingCases a :: [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))]
a = ((ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b)) -> (a, b))
-> [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ([(Type, Ident)]
-> (ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b)) -> (a, b)
forall a b.
[(Type, Ident)]
-> (ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b)) -> (a, b)
expandVars (ConstrTerm -> [(Type, Ident)]
vars ConstrTerm
t)) ([(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))] -> [(a, b)])
-> [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ ((ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b)) -> Bool)
-> [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))]
-> [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))]
forall a. (a -> Bool) -> [a] -> [a]
filter (ConstrTerm -> Bool
matches (ConstrTerm -> Bool)
-> ((ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))
-> ConstrTerm)
-> (ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b)) -> ConstrTerm
forall a b. (a, b) -> a
fst) [(ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b))]
a
matches :: ConstrTerm -> Bool
matches t' :: ConstrTerm
t' = ConstrTerm
t ConstrTerm -> ConstrTerm -> Bool
forall a. Eq a => a -> a -> Bool
== ConstrTerm
t' Bool -> Bool -> Bool
|| ConstrTerm -> Bool
isVarPattern ConstrTerm
t'
expandVars :: [(Type, Ident)]
-> (ConstrTerm, ([NestedTerm] -> a, [NestedTerm], b)) -> (a, b)
expandVars vs' :: [(Type, Ident)]
vs' (p :: ConstrTerm
p, (pref :: [NestedTerm] -> a
pref, ts1 :: [NestedTerm]
ts1, e :: b
e)) = ([NestedTerm] -> a
pref [NestedTerm]
ts2, b
e)
where ts2 :: [NestedTerm]
ts2 | ConstrTerm -> Bool
isVarPattern ConstrTerm
p = ((Type, Ident) -> NestedTerm) -> [(Type, Ident)] -> [NestedTerm]
forall a b. (a -> b) -> [a] -> [b]
map (Type, Ident) -> NestedTerm
var2Pattern [(Type, Ident)]
vs' [NestedTerm] -> [NestedTerm] -> [NestedTerm]
forall a. [a] -> [a] -> [a]
++ [NestedTerm]
ts1
| Bool
otherwise = [NestedTerm]
ts1
var2Pattern :: (Type, Ident) -> NestedTerm
var2Pattern v' :: (Type, Ident)
v' = ConstrTerm -> [NestedTerm] -> NestedTerm
NestedTerm ((Type -> Ident -> ConstrTerm) -> (Type, Ident) -> ConstrTerm
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Type -> Ident -> ConstrTerm
IL.VariablePattern (Type, Ident)
v') []
isVarPattern :: IL.ConstrTerm -> Bool
isVarPattern :: ConstrTerm -> Bool
isVarPattern (IL.VariablePattern _ _) = Bool
True
isVarPattern _ = Bool
False
isVarMatch :: (IL.ConstrTerm, a) -> Bool
isVarMatch :: (ConstrTerm, a) -> Bool
isVarMatch = ConstrTerm -> Bool
isVarPattern (ConstrTerm -> Bool)
-> ((ConstrTerm, a) -> ConstrTerm) -> (ConstrTerm, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstrTerm, a) -> ConstrTerm
forall a b. (a, b) -> a
fst
vars :: IL.ConstrTerm -> [(IL.Type, Ident)]
vars :: ConstrTerm -> [(Type, Ident)]
vars (IL.ConstructorPattern _ _ vs :: [(Type, Ident)]
vs) = [(Type, Ident)]
vs
vars _ = []
tagAlt :: Match -> (IL.ConstrTerm, Match)
tagAlt :: Match -> (ConstrTerm, Match)
tagAlt (t :: NestedTerm
t:ts :: [NestedTerm]
ts, e :: Expression
e) = (NestedTerm -> ConstrTerm
pattern NestedTerm
t, (NestedTerm -> [NestedTerm]
arguments NestedTerm
t [NestedTerm] -> [NestedTerm] -> [NestedTerm]
forall a. [a] -> [a] -> [a]
++ [NestedTerm]
ts, Expression
e))
tagAlt ([] , _) = String -> (ConstrTerm, Match)
forall a. HasCallStack => String -> a
error "CurryToIL.tagAlt: empty pattern list"
skipPat :: Match -> Match'
skipPat :: Match -> Match'
skipPat (t :: NestedTerm
t:ts :: [NestedTerm]
ts, e :: Expression
e) = ((NestedTerm
tNestedTerm -> [NestedTerm] -> [NestedTerm]
forall a. a -> [a] -> [a]
:), [NestedTerm]
ts, Expression
e)
skipPat ([] , _) = String -> Match'
forall a. HasCallStack => String -> a
error "CurryToIL.skipPat: empty pattern list"
tagAlt' :: Match' -> (IL.ConstrTerm, Match')
tagAlt' :: Match' -> (ConstrTerm, Match')
tagAlt' (pref :: [NestedTerm] -> [NestedTerm]
pref, t :: NestedTerm
t:ts :: [NestedTerm]
ts, e' :: Expression
e') = (NestedTerm -> ConstrTerm
pattern NestedTerm
t, ([NestedTerm] -> [NestedTerm]
pref, NestedTerm -> [NestedTerm]
arguments NestedTerm
t [NestedTerm] -> [NestedTerm] -> [NestedTerm]
forall a. [a] -> [a] -> [a]
++ [NestedTerm]
ts, Expression
e'))
tagAlt' (_ , [] , _ ) = String -> (ConstrTerm, Match')
forall a. HasCallStack => String -> a
error "CurryToIL.tagAlt': empty pattern list"
skipPat' :: Match' -> Match'
skipPat' :: Match' -> Match'
skipPat' (pref :: [NestedTerm] -> [NestedTerm]
pref, t :: NestedTerm
t:ts :: [NestedTerm]
ts, e' :: Expression
e') = ([NestedTerm] -> [NestedTerm]
pref ([NestedTerm] -> [NestedTerm])
-> ([NestedTerm] -> [NestedTerm]) -> [NestedTerm] -> [NestedTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedTerm
tNestedTerm -> [NestedTerm] -> [NestedTerm]
forall a. a -> [a] -> [a]
:), [NestedTerm]
ts, Expression
e')
skipPat' (_ , [] , _ ) = String -> Match'
forall a. HasCallStack => String -> a
error "CurryToIL.skipPat': empty pattern list"