{-# LANGUAGE Strict #-}

-- | Internalising bindings.
module Futhark.Internalise.Bindings
  ( internaliseAttrs,
    internaliseAttr,
    bindingFParams,
    bindingLoopParams,
    bindingLambdaParams,
    stmPat,
  )
where

import Control.Monad.Reader hiding (mapM)
import Data.Bifunctor
import Data.Map.Strict qualified as M
import Data.Maybe
import Futhark.IR.SOACS qualified as I
import Futhark.Internalise.Monad
import Futhark.Internalise.TypesValues
import Futhark.Util
import Language.Futhark as E hiding (matchDims)

internaliseAttr :: E.AttrInfo VName -> InternaliseM I.Attr
internaliseAttr :: AttrInfo VName -> InternaliseM Attr
internaliseAttr (E.AttrAtom (E.AtomName Name
v) SrcLoc
_) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Attr
I.AttrName Name
v
internaliseAttr (E.AttrAtom (E.AtomInt Integer
x) SrcLoc
_) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Attr
I.AttrInt Integer
x
internaliseAttr (E.AttrComp Name
f [AttrInfo VName]
attrs SrcLoc
_) =
  Name -> [Attr] -> Attr
I.AttrComp Name
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttrInfo VName -> InternaliseM Attr
internaliseAttr [AttrInfo VName]
attrs

internaliseAttrs :: [E.AttrInfo VName] -> InternaliseM I.Attrs
internaliseAttrs :: [AttrInfo VName] -> InternaliseM Attrs
internaliseAttrs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Attr -> Attrs
I.oneAttr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttrInfo VName -> InternaliseM Attr
internaliseAttr

bindingFParams ::
  [E.TypeParam] ->
  [E.Pat] ->
  ([I.FParam I.SOACS] -> [[I.FParam I.SOACS]] -> InternaliseM a) ->
  InternaliseM a
bindingFParams :: forall a.
[TypeParam]
-> [Pat]
-> ([FParam SOACS] -> [[FParam SOACS]] -> InternaliseM a)
-> InternaliseM a
bindingFParams [TypeParam]
tparams [Pat]
params [FParam SOACS] -> [[FParam SOACS]] -> InternaliseM a
m = do
  [[(Ident, [AttrInfo VName])]]
flattened_params <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
MonadFreshNames m =>
Pat -> m [(Ident, [AttrInfo VName])]
flattenPat [Pat]
params
  let params_idents :: [(Ident, [AttrInfo VName])]
params_idents = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Ident, [AttrInfo VName])]]
flattened_params
  [[TypeBase Shape Uniqueness]]
params_ts <-
    [TypeBase Size ()] -> InternaliseM [[TypeBase Shape Uniqueness]]
internaliseParamTypes forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall dim asf ast. TypeBase dim asf -> ast -> TypeBase dim ast
E.setAliases () forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Info a -> a
E.unInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn.
IdentBase f vn -> f (TypeBase Size Aliasing)
E.identType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Ident, [AttrInfo VName])]
params_idents
  let num_param_idents :: [Int]
num_param_idents = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(Ident, [AttrInfo VName])]]
flattened_params
      num_param_ts :: [Int]
num_param_ts = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall a b. (a -> b) -> a -> b
$ forall a. [Int] -> [a] -> [[a]]
chunks [Int]
num_param_idents [[TypeBase Shape Uniqueness]]
params_ts

  let shape_params :: [Param (TypeBase shape u)]
shape_params = [forall dec. Attrs -> VName -> dec -> Param dec
I.Param forall a. Monoid a => a
mempty VName
v forall a b. (a -> b) -> a -> b
$ forall shape u. PrimType -> TypeBase shape u
I.Prim PrimType
I.int64 | E.TypeParamDim VName
v SrcLoc
_ <- [TypeParam]
tparams]
      shape_subst :: Map VName [SubExp]
shape_subst = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(forall dec. Param dec -> VName
I.paramName Param (TypeBase Any Any)
p, [VName -> SubExp
I.Var forall a b. (a -> b) -> a -> b
$ forall dec. Param dec -> VName
I.paramName Param (TypeBase Any Any)
p]) | Param (TypeBase Any Any)
p <- forall {shape} {u}. [Param (TypeBase shape u)]
shape_params]
  forall t a.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> ([[Param t]] -> InternaliseM a) -> InternaliseM a
bindingFlatPat [(Ident, [AttrInfo VName])]
params_idents (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TypeBase Shape Uniqueness]]
params_ts) forall a b. (a -> b) -> a -> b
$ \[[Param (TypeBase Shape Uniqueness)]]
valueparams -> do
    let ([Maybe (Param (TypeBase shape u))]
certparams, [Param (TypeBase Shape Uniqueness)]
valueparams') = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {shape} {u} {shape} {u}.
Param (TypeBase shape u)
-> (Maybe (Param (TypeBase shape u)), Param (TypeBase shape u))
fixAccParam (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Param (TypeBase Shape Uniqueness)]]
valueparams)
    forall {k} (rep :: k) (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
I.localScope (forall {k} (rep :: k) dec.
(FParamInfo rep ~ dec) =>
[Param dec] -> Scope rep
I.scopeOfFParams forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall {shape} {u}. [Maybe (Param (TypeBase shape u))]
certparams forall a. [a] -> [a] -> [a]
++ forall {shape} {u}. [Param (TypeBase shape u)]
shape_params forall a. [a] -> [a] -> [a]
++ [Param (TypeBase Shape Uniqueness)]
valueparams') forall a b. (a -> b) -> a -> b
$
      forall a. Map VName [SubExp] -> InternaliseM a -> InternaliseM a
substitutingVars Map VName [SubExp]
shape_subst forall a b. (a -> b) -> a -> b
$
        [FParam SOACS] -> [[FParam SOACS]] -> InternaliseM a
m (forall a. [Maybe a] -> [a]
catMaybes forall {shape} {u}. [Maybe (Param (TypeBase shape u))]
certparams forall a. [a] -> [a] -> [a]
++ forall {shape} {u}. [Param (TypeBase shape u)]
shape_params) forall a b. (a -> b) -> a -> b
$
          forall a. [Int] -> [a] -> [[a]]
chunks [Int]
num_param_ts [Param (TypeBase Shape Uniqueness)]
valueparams'
  where
    fixAccParam :: Param (TypeBase shape u)
-> (Maybe (Param (TypeBase shape u)), Param (TypeBase shape u))
fixAccParam (I.Param Attrs
attrs VName
pv (I.Acc VName
acc Shape
ispace [Type]
ts u
u)) =
      ( forall a. a -> Maybe a
Just (forall dec. Attrs -> VName -> dec -> Param dec
I.Param Attrs
attrs VName
acc forall a b. (a -> b) -> a -> b
$ forall shape u. PrimType -> TypeBase shape u
I.Prim PrimType
I.Unit),
        forall dec. Attrs -> VName -> dec -> Param dec
I.Param Attrs
attrs VName
pv (forall shape u. VName -> Shape -> [Type] -> u -> TypeBase shape u
I.Acc VName
acc Shape
ispace [Type]
ts u
u)
      )
    fixAccParam Param (TypeBase shape u)
p = (forall a. Maybe a
Nothing, Param (TypeBase shape u)
p)

bindingLoopParams ::
  [E.TypeParam] ->
  E.Pat ->
  [I.Type] ->
  ([I.FParam I.SOACS] -> [I.FParam I.SOACS] -> InternaliseM a) ->
  InternaliseM a
bindingLoopParams :: forall a.
[TypeParam]
-> Pat
-> [Type]
-> ([FParam SOACS] -> [FParam SOACS] -> InternaliseM a)
-> InternaliseM a
bindingLoopParams [TypeParam]
tparams Pat
pat [Type]
ts [FParam SOACS] -> [FParam SOACS] -> InternaliseM a
m = do
  [(Ident, [AttrInfo VName])]
pat_idents <- forall (m :: * -> *).
MonadFreshNames m =>
Pat -> m [(Ident, [AttrInfo VName])]
flattenPat Pat
pat
  [TypeBase Shape Uniqueness]
pat_ts <- forall shape u.
TypeBase Size ()
-> [TypeBase shape u] -> InternaliseM [TypeBase Shape Uniqueness]
internaliseLoopParamType (Pat -> TypeBase Size ()
E.patternStructType Pat
pat) [Type]
ts

  let shape_params :: [Param (TypeBase shape u)]
shape_params = [forall dec. Attrs -> VName -> dec -> Param dec
I.Param forall a. Monoid a => a
mempty VName
v forall a b. (a -> b) -> a -> b
$ forall shape u. PrimType -> TypeBase shape u
I.Prim PrimType
I.int64 | E.TypeParamDim VName
v SrcLoc
_ <- [TypeParam]
tparams]
      shape_subst :: Map VName [SubExp]
shape_subst = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(forall dec. Param dec -> VName
I.paramName Param (TypeBase Any Any)
p, [VName -> SubExp
I.Var forall a b. (a -> b) -> a -> b
$ forall dec. Param dec -> VName
I.paramName Param (TypeBase Any Any)
p]) | Param (TypeBase Any Any)
p <- forall {shape} {u}. [Param (TypeBase shape u)]
shape_params]

  forall t a.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> ([[Param t]] -> InternaliseM a) -> InternaliseM a
bindingFlatPat [(Ident, [AttrInfo VName])]
pat_idents [TypeBase Shape Uniqueness]
pat_ts forall a b. (a -> b) -> a -> b
$ \[[Param (TypeBase Shape Uniqueness)]]
valueparams ->
    forall {k} (rep :: k) (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
I.localScope (forall {k} (rep :: k) dec.
(FParamInfo rep ~ dec) =>
[Param dec] -> Scope rep
I.scopeOfFParams forall a b. (a -> b) -> a -> b
$ forall {shape} {u}. [Param (TypeBase shape u)]
shape_params forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Param (TypeBase Shape Uniqueness)]]
valueparams) forall a b. (a -> b) -> a -> b
$
      forall a. Map VName [SubExp] -> InternaliseM a -> InternaliseM a
substitutingVars Map VName [SubExp]
shape_subst forall a b. (a -> b) -> a -> b
$
        [FParam SOACS] -> [FParam SOACS] -> InternaliseM a
m forall {shape} {u}. [Param (TypeBase shape u)]
shape_params forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Param (TypeBase Shape Uniqueness)]]
valueparams

bindingLambdaParams ::
  [E.Pat] ->
  [I.Type] ->
  ([I.LParam I.SOACS] -> InternaliseM a) ->
  InternaliseM a
bindingLambdaParams :: forall a.
[Pat]
-> [Type] -> ([LParam SOACS] -> InternaliseM a) -> InternaliseM a
bindingLambdaParams [Pat]
params [Type]
ts [LParam SOACS] -> InternaliseM a
m = do
  [(Ident, [AttrInfo VName])]
params_idents <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
MonadFreshNames m =>
Pat -> m [(Ident, [AttrInfo VName])]
flattenPat [Pat]
params

  forall t a.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> ([[Param t]] -> InternaliseM a) -> InternaliseM a
bindingFlatPat [(Ident, [AttrInfo VName])]
params_idents [Type]
ts forall a b. (a -> b) -> a -> b
$ \[[Param Type]]
params' ->
    forall {k} (rep :: k) (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
I.localScope (forall {k} (rep :: k) dec.
(LParamInfo rep ~ dec) =>
[Param dec] -> Scope rep
I.scopeOfLParams forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Param Type]]
params') forall a b. (a -> b) -> a -> b
$ [LParam SOACS] -> InternaliseM a
m forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Param Type]]
params'

processFlatPat ::
  Show t =>
  [(E.Ident, [E.AttrInfo VName])] ->
  [t] ->
  InternaliseM ([[I.Param t]], VarSubsts)
processFlatPat :: forall t.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> InternaliseM ([[Param t]], Map VName [SubExp])
processFlatPat [(Ident, [AttrInfo VName])]
x [t]
y = forall {dec}.
[([Param dec], (VName, [SubExp]))]
-> [(Ident, [AttrInfo VName])]
-> [dec]
-> InternaliseM ([[Param dec]], Map VName [SubExp])
processFlatPat' [] [(Ident, [AttrInfo VName])]
x [t]
y
  where
    processFlatPat' :: [([Param dec], (VName, [SubExp]))]
-> [(Ident, [AttrInfo VName])]
-> [dec]
-> InternaliseM ([[Param dec]], Map VName [SubExp])
processFlatPat' [([Param dec], (VName, [SubExp]))]
pat [] [dec]
_ = do
      let ([[Param dec]]
vs, [(VName, [SubExp])]
substs) = forall a b. [(a, b)] -> ([a], [b])
unzip [([Param dec], (VName, [SubExp]))]
pat
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> [a]
reverse [[Param dec]]
vs, forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(VName, [SubExp])]
substs)
    processFlatPat' [([Param dec], (VName, [SubExp]))]
pat ((Ident
p, [AttrInfo VName]
attrs) : [(Ident, [AttrInfo VName])]
rest) [dec]
ts = do
      Attrs
attrs' <- [AttrInfo VName] -> InternaliseM Attrs
internaliseAttrs [AttrInfo VName]
attrs
      ([Param dec]
ps, [dec]
rest_ts) <- forall {dec}. Attrs -> [dec] -> [VName] -> ([Param dec], [dec])
handleMapping Attrs
attrs' [dec]
ts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> InternaliseM [VName]
internaliseBindee Ident
p
      [([Param dec], (VName, [SubExp]))]
-> [(Ident, [AttrInfo VName])]
-> [dec]
-> InternaliseM ([[Param dec]], Map VName [SubExp])
processFlatPat' (([Param dec]
ps, (forall (f :: * -> *) vn. IdentBase f vn -> vn
E.identName Ident
p, forall a b. (a -> b) -> [a] -> [b]
map (VName -> SubExp
I.Var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. Param dec -> VName
I.paramName) [Param dec]
ps)) forall a. a -> [a] -> [a]
: [([Param dec], (VName, [SubExp]))]
pat) [(Ident, [AttrInfo VName])]
rest [dec]
rest_ts

    handleMapping :: Attrs -> [dec] -> [VName] -> ([Param dec], [dec])
handleMapping Attrs
_ [dec]
ts [] =
      ([], [dec]
ts)
    handleMapping Attrs
attrs (dec
t : [dec]
ts) (VName
r : [VName]
rs) =
      let ([Param dec]
ps, [dec]
ts') = Attrs -> [dec] -> [VName] -> ([Param dec], [dec])
handleMapping Attrs
attrs [dec]
ts [VName]
rs
       in (forall dec. Attrs -> VName -> dec -> Param dec
I.Param Attrs
attrs VName
r dec
t forall a. a -> [a] -> [a]
: [Param dec]
ps, [dec]
ts')
    handleMapping Attrs
_ [] [VName]
_ =
      forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"handleMapping: insufficient identifiers in pattern." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ([(Ident, [AttrInfo VName])]
x, [t]
y)

    internaliseBindee :: E.Ident -> InternaliseM [VName]
    internaliseBindee :: Ident -> InternaliseM [VName]
internaliseBindee Ident
bindee = do
      let name :: VName
name = forall (f :: * -> *) vn. IdentBase f vn -> vn
E.identName Ident
bindee
      case forall als. TypeBase Size als -> Int
internalisedTypeSize forall a b. (a -> b) -> a -> b
$ forall a. Info a -> a
E.unInfo forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn.
IdentBase f vn -> f (TypeBase Size Aliasing)
E.identType Ident
bindee of
        Int
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [VName
name]
        Int
n -> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFreshNames m => [Char] -> m VName
newVName forall a b. (a -> b) -> a -> b
$ VName -> [Char]
baseString VName
name

bindingFlatPat ::
  Show t =>
  [(E.Ident, [E.AttrInfo VName])] ->
  [t] ->
  ([[I.Param t]] -> InternaliseM a) ->
  InternaliseM a
bindingFlatPat :: forall t a.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> ([[Param t]] -> InternaliseM a) -> InternaliseM a
bindingFlatPat [(Ident, [AttrInfo VName])]
idents [t]
ts [[Param t]] -> InternaliseM a
m = do
  ([[Param t]]
ps, Map VName [SubExp]
substs) <- forall t.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> InternaliseM ([[Param t]], Map VName [SubExp])
processFlatPat [(Ident, [AttrInfo VName])]
idents [t]
ts
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\InternaliseEnv
env -> InternaliseEnv
env {envSubsts :: Map VName [SubExp]
envSubsts = Map VName [SubExp]
substs forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` InternaliseEnv -> Map VName [SubExp]
envSubsts InternaliseEnv
env}) forall a b. (a -> b) -> a -> b
$
    [[Param t]] -> InternaliseM a
m [[Param t]]
ps

-- | Flatten a pattern.  Returns a list of identifiers.
flattenPat :: MonadFreshNames m => E.Pat -> m [(E.Ident, [E.AttrInfo VName])]
flattenPat :: forall (m :: * -> *).
MonadFreshNames m =>
Pat -> m [(Ident, [AttrInfo VName])]
flattenPat = forall (m :: * -> *).
MonadFreshNames m =>
Pat -> m [(Ident, [AttrInfo VName])]
flattenPat'
  where
    flattenPat' :: Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' (E.PatParens Pat
p SrcLoc
_) =
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' Pat
p
    flattenPat' (E.PatAttr AttrInfo VName
attr Pat
p SrcLoc
_) =
      forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AttrInfo VName
attr :)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' Pat
p
    flattenPat' (E.Wildcard Info (TypeBase Size Aliasing)
t SrcLoc
loc) = do
      VName
name <- forall (m :: * -> *). MonadFreshNames m => [Char] -> m VName
newVName [Char]
"nameless"
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn.
vn -> f (TypeBase Size Aliasing) -> SrcLoc -> PatBase f vn
E.Id VName
name Info (TypeBase Size Aliasing)
t SrcLoc
loc
    flattenPat' (E.Id VName
v (Info TypeBase Size Aliasing
t) SrcLoc
loc) =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [(forall (f :: * -> *) vn.
vn -> f (TypeBase Size Aliasing) -> SrcLoc -> IdentBase f vn
E.Ident VName
v (forall a. a -> Info a
Info TypeBase Size Aliasing
t) SrcLoc
loc, forall a. Monoid a => a
mempty)]
    flattenPat' (E.TuplePat [] SrcLoc
loc) =
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' (forall (f :: * -> *) vn.
f (TypeBase Size Aliasing) -> SrcLoc -> PatBase f vn
E.Wildcard (forall a. a -> Info a
Info forall a b. (a -> b) -> a -> b
$ forall dim as. ScalarTypeBase dim as -> TypeBase dim as
E.Scalar forall a b. (a -> b) -> a -> b
$ forall dim as. Map Name (TypeBase dim as) -> ScalarTypeBase dim as
E.Record forall a. Monoid a => a
mempty) SrcLoc
loc)
    flattenPat' (E.RecordPat [] SrcLoc
loc) =
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' (forall (f :: * -> *) vn.
f (TypeBase Size Aliasing) -> SrcLoc -> PatBase f vn
E.Wildcard (forall a. a -> Info a
Info forall a b. (a -> b) -> a -> b
$ forall dim as. ScalarTypeBase dim as -> TypeBase dim as
E.Scalar forall a b. (a -> b) -> a -> b
$ forall dim as. Map Name (TypeBase dim as) -> ScalarTypeBase dim as
E.Record forall a. Monoid a => a
mempty) SrcLoc
loc)
    flattenPat' (E.TuplePat [Pat]
pats SrcLoc
_) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' [Pat]
pats
    flattenPat' (E.RecordPat [(Name, Pat)]
fs SrcLoc
loc) =
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. [PatBase f vn] -> SrcLoc -> PatBase f vn
E.TuplePat (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Map Name a -> [(Name, a)]
sortFields forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Pat)]
fs) SrcLoc
loc
    flattenPat' (E.PatAscription Pat
p TypeExp VName
_ SrcLoc
_) =
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' Pat
p
    flattenPat' (E.PatLit PatLit
_ Info (TypeBase Size Aliasing)
t SrcLoc
loc) =
      Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn.
f (TypeBase Size Aliasing) -> SrcLoc -> PatBase f vn
E.Wildcard Info (TypeBase Size Aliasing)
t SrcLoc
loc
    flattenPat' (E.PatConstr Name
_ Info (TypeBase Size Aliasing)
_ [Pat]
ps SrcLoc
_) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pat -> f [(Ident, [AttrInfo VName])]
flattenPat' [Pat]
ps

stmPat ::
  E.Pat ->
  [I.Type] ->
  ([VName] -> InternaliseM a) ->
  InternaliseM a
stmPat :: forall a.
Pat -> [Type] -> ([VName] -> InternaliseM a) -> InternaliseM a
stmPat Pat
pat [Type]
ts [VName] -> InternaliseM a
m = do
  [(Ident, [AttrInfo VName])]
pat' <- forall (m :: * -> *).
MonadFreshNames m =>
Pat -> m [(Ident, [AttrInfo VName])]
flattenPat Pat
pat
  forall t a.
Show t =>
[(Ident, [AttrInfo VName])]
-> [t] -> ([[Param t]] -> InternaliseM a) -> InternaliseM a
bindingFlatPat [(Ident, [AttrInfo VName])]
pat' [Type]
ts forall a b. (a -> b) -> a -> b
$ [VName] -> InternaliseM a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall dec. Param dec -> VName
I.paramName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat