-- |
-- This module implements the desugaring pass which creates binding groups from sets of
-- mutually-recursive value declarations and mutually-recursive type declarations.
--
module Language.PureScript.Sugar.BindingGroups
  ( createBindingGroups
  , createBindingGroupsModule
  , collapseBindingGroups
  ) where

import Prelude
import Protolude (ordNub, swap)

import Control.Monad ((<=<), guard)
import Control.Monad.Error.Class (MonadError(..))

import Data.Graph
import Data.List (intersect, (\\))
import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)
import Data.Foldable (find)
import Data.Functor (($>))
import Data.Maybe (isJust, mapMaybe)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as M
import qualified Data.Set as S

import Language.PureScript.AST
import Language.PureScript.Crash
import Language.PureScript.Environment
import Language.PureScript.Errors hiding (nonEmpty)
import Language.PureScript.Names
import Language.PureScript.Types

data VertexType
  = VertexDefinition
  | VertexKindSignature
  | VertexRoleDeclaration
  deriving (VertexType -> VertexType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexType -> VertexType -> Bool
$c/= :: VertexType -> VertexType -> Bool
== :: VertexType -> VertexType -> Bool
$c== :: VertexType -> VertexType -> Bool
Eq, Eq VertexType
VertexType -> VertexType -> Bool
VertexType -> VertexType -> Ordering
VertexType -> VertexType -> VertexType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VertexType -> VertexType -> VertexType
$cmin :: VertexType -> VertexType -> VertexType
max :: VertexType -> VertexType -> VertexType
$cmax :: VertexType -> VertexType -> VertexType
>= :: VertexType -> VertexType -> Bool
$c>= :: VertexType -> VertexType -> Bool
> :: VertexType -> VertexType -> Bool
$c> :: VertexType -> VertexType -> Bool
<= :: VertexType -> VertexType -> Bool
$c<= :: VertexType -> VertexType -> Bool
< :: VertexType -> VertexType -> Bool
$c< :: VertexType -> VertexType -> Bool
compare :: VertexType -> VertexType -> Ordering
$ccompare :: VertexType -> VertexType -> Ordering
Ord, Int -> VertexType -> ShowS
[VertexType] -> ShowS
VertexType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexType] -> ShowS
$cshowList :: [VertexType] -> ShowS
show :: VertexType -> String
$cshow :: VertexType -> String
showsPrec :: Int -> VertexType -> ShowS
$cshowsPrec :: Int -> VertexType -> ShowS
Show)

-- |
-- Replace all sets of mutually-recursive declarations in a module with binding groups
--
createBindingGroupsModule
  :: (MonadError MultipleErrors m)
  => Module
  -> m Module
createBindingGroupsModule :: forall (m :: * -> *).
MonadError MultipleErrors m =>
Module -> m Module
createBindingGroupsModule (Module SourceSpan
ss [Comment]
coms ModuleName
name [Declaration]
ds Maybe [DeclarationRef]
exps) =
  SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
Module SourceSpan
ss [Comment]
coms ModuleName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName -> [Declaration] -> m [Declaration]
createBindingGroups ModuleName
name [Declaration]
ds forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [DeclarationRef]
exps

createBindingGroups
  :: forall m
   . (MonadError MultipleErrors m)
  => ModuleName
  -> [Declaration]
  -> m [Declaration]
createBindingGroups :: forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName -> [Declaration] -> m [Declaration]
createBindingGroups ModuleName
moduleName = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Declaration -> m Declaration
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Declaration] -> m [Declaration]
handleDecls

  where
  (Declaration -> m Declaration
f, Expr -> m Expr
_, Binder -> m Binder
_) = forall (m :: * -> *).
Monad m =>
(Declaration -> m Declaration)
-> (Expr -> m Expr)
-> (Binder -> m Binder)
-> (Declaration -> m Declaration, Expr -> m Expr,
    Binder -> m Binder)
everywhereOnValuesTopDownM forall (m :: * -> *) a. Monad m => a -> m a
return Expr -> m Expr
handleExprs forall (m :: * -> *) a. Monad m => a -> m a
return

  handleExprs :: Expr -> m Expr
  handleExprs :: Expr -> m Expr
handleExprs (Let WhereProvenance
w [Declaration]
ds Expr
val) = (\[Declaration]
ds' -> WhereProvenance -> [Declaration] -> Expr -> Expr
Let WhereProvenance
w [Declaration]
ds' Expr
val) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Declaration] -> m [Declaration]
handleDecls [Declaration]
ds
  handleExprs Expr
other = forall (m :: * -> *) a. Monad m => a -> m a
return Expr
other

  -- |
  -- Replace all sets of mutually-recursive declarations with binding groups
  --
  handleDecls :: [Declaration] -> m [Declaration]
  handleDecls :: [Declaration] -> m [Declaration]
handleDecls [Declaration]
ds = do
    let values :: [ValueDeclarationData Expr]
values = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GuardedExpr] -> Expr
extractGuardedExpr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
getValueDeclaration) [Declaration]
ds
        kindDecls :: [(Declaration, VertexType)]
kindDecls = (,VertexType
VertexKindSignature) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isKindDecl [Declaration]
ds
        dataDecls :: [(Declaration, VertexType)]
dataDecls = (,VertexType
VertexDefinition) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (\Declaration
a -> Declaration -> Bool
isDataDecl Declaration
a Bool -> Bool -> Bool
|| Declaration -> Bool
isExternDataDecl Declaration
a Bool -> Bool -> Bool
|| Declaration -> Bool
isTypeSynonymDecl Declaration
a Bool -> Bool -> Bool
|| Declaration -> Bool
isTypeClassDecl Declaration
a) [Declaration]
ds
        roleDecls :: [(Declaration, VertexType)]
roleDecls = (,VertexType
VertexRoleDeclaration) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isRoleDecl [Declaration]
ds
        roleAnns :: [ProperName 'TypeName]
roleAnns = Declaration -> ProperName 'TypeName
declTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Declaration, VertexType)]
roleDecls
        kindSigs :: [ProperName 'TypeName]
kindSigs = Declaration -> ProperName 'TypeName
declTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Declaration, VertexType)]
kindDecls
        typeSyns :: [ProperName 'TypeName]
typeSyns = Declaration -> ProperName 'TypeName
declTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isTypeSynonymDecl [Declaration]
ds
        nonTypeSynKindSigs :: [ProperName 'TypeName]
nonTypeSynKindSigs = [ProperName 'TypeName]
kindSigs forall a. Eq a => [a] -> [a] -> [a]
\\ [ProperName 'TypeName]
typeSyns
        allDecls :: [(Declaration, VertexType)]
allDecls = [(Declaration, VertexType)]
kindDecls forall a. [a] -> [a] -> [a]
++ [(Declaration, VertexType)]
dataDecls forall a. [a] -> [a] -> [a]
++ [(Declaration, VertexType)]
roleDecls
        allProperNames :: [ProperName 'TypeName]
allProperNames = Declaration -> ProperName 'TypeName
declTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Declaration, VertexType)]
allDecls
        mkVert :: (Declaration, VertexType)
-> (Declaration, (ProperName 'TypeName, VertexType),
    [(ProperName 'TypeName, VertexType)])
mkVert (Declaration
d, VertexType
vty) =
          let names :: [ProperName 'TypeName]
names = ModuleName -> Declaration -> [ProperName 'TypeName]
usedTypeNames ModuleName
moduleName Declaration
d forall a. Eq a => [a] -> [a] -> [a]
`intersect` [ProperName 'TypeName]
allProperNames
              name :: ProperName 'TypeName
name = Declaration -> ProperName 'TypeName
declTypeName Declaration
d
              -- If a dependency of a kind signature has a kind signature, than that's all we need to
              -- depend on, except in the case that we are using a type synonym. In order to expand
              -- the type synonym, we must depend on the synonym declaration itself.
              --
              -- Arguably, type declarations (as opposed to just kind signatures) could also depend
              -- on kind signatures when present. Attempting this caused one known issue (#4038); the
              -- type checker might not expect type declarations not to be preceded or grouped by
              -- their actual dependencies in all cases. But in principle, if done carefully, this
              -- approach could be used to reduce the number or size of data binding group cycles.
              -- (It's critical that kind signatures not appear in groups, which is why they get
              -- special treatment.)
              vtype :: ProperName 'TypeName -> VertexType
vtype ProperName 'TypeName
n
                | VertexType
vty forall a. Eq a => a -> a -> Bool
== VertexType
VertexKindSignature Bool -> Bool -> Bool
&& ProperName 'TypeName
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ProperName 'TypeName]
nonTypeSynKindSigs = VertexType
VertexKindSignature
                | Bool
otherwise = VertexType
VertexDefinition
              deps :: [(ProperName 'TypeName, VertexType)]
deps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ProperName 'TypeName
n -> (ProperName 'TypeName
n, ProperName 'TypeName -> VertexType
vtype ProperName 'TypeName
n)) [ProperName 'TypeName]
names
              self :: [(ProperName 'TypeName, VertexType)]
self
                | VertexType
vty forall a. Eq a => a -> a -> Bool
== VertexType
VertexDefinition =
                       (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ProperName 'TypeName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ProperName 'TypeName]
kindSigs) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (ProperName 'TypeName
name, VertexType
VertexKindSignature))
                    forall a. [a] -> [a] -> [a]
++ (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ProperName 'TypeName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ProperName 'TypeName]
roleAnns Bool -> Bool -> Bool
&& Bool -> Bool
not (Declaration -> Bool
isExternDataDecl Declaration
d)) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (ProperName 'TypeName
name, VertexType
VertexRoleDeclaration))
                | VertexType
vty forall a. Eq a => a -> a -> Bool
== VertexType
VertexRoleDeclaration = [(ProperName 'TypeName
name, VertexType
VertexDefinition)]
                | Bool
otherwise = []
          in (Declaration
d, (ProperName 'TypeName
name, VertexType
vty), [(ProperName 'TypeName, VertexType)]
self forall a. [a] -> [a] -> [a]
++ [(ProperName 'TypeName, VertexType)]
deps)
        dataVerts :: [(Declaration, (ProperName 'TypeName, VertexType),
  [(ProperName 'TypeName, VertexType)])]
dataVerts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Declaration, VertexType)
-> (Declaration, (ProperName 'TypeName, VertexType),
    [(ProperName 'TypeName, VertexType)])
mkVert [(Declaration, VertexType)]
allDecls
    [Declaration]
dataBindingGroupDecls <- forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU (forall key node.
Ord key =>
[(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR [(Declaration, (ProperName 'TypeName, VertexType),
  [(ProperName 'TypeName, VertexType)])]
dataVerts) forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SCC
  (Declaration, (ProperName 'TypeName, a),
   [(ProperName 'TypeName, a)])
-> m Declaration
toDataBindingGroup
    let
      -- #4437
      --
      -- The idea here is to create a `Graph` whose `key` is a tuple: `(Bool, Ident)`,
      -- where the `Bool` encodes the absence of a type hole. This relies on an implementation
      -- detail for `stronglyConnComp` which allows identifiers with no type holes to "float"
      -- and get checked before those that do, while preserving reverse topological sorting.
      makeValueDeclarationKey :: ValueDeclarationData Expr -> (Bool, Ident)
makeValueDeclarationKey = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Bool
exprHasNoTypeHole forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ValueDeclarationData a -> a
valdeclExpression forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ValueDeclarationData a -> Ident
valdeclIdent
      valueDeclarationKeys :: [(Bool, Ident)]
valueDeclarationKeys = ValueDeclarationData Expr -> (Bool, Ident)
makeValueDeclarationKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ValueDeclarationData Expr]
values

      valueDeclarationInfo :: Map Ident Bool
valueDeclarationInfo = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, Ident)]
valueDeclarationKeys
      findDeclarationInfo :: Ident -> (Bool, Ident)
findDeclarationInfo Ident
i = (forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
False Ident
i Map Ident Bool
valueDeclarationInfo, Ident
i)
      computeValueDependencies :: ValueDeclarationData Expr -> [(Bool, Ident)]
computeValueDependencies = (forall a. Eq a => [a] -> [a] -> [a]
`intersect` [(Bool, Ident)]
valueDeclarationKeys) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ident -> (Bool, Ident)
findDeclarationInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> ValueDeclarationData Expr -> [Ident]
usedIdents ModuleName
moduleName 
  
      makeValueDeclarationVert :: ValueDeclarationData Expr
-> (ValueDeclarationData Expr, (Bool, Ident), [(Bool, Ident)])
makeValueDeclarationVert = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> a
id forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ValueDeclarationData Expr -> (Bool, Ident)
makeValueDeclarationKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ValueDeclarationData Expr -> [(Bool, Ident)]
computeValueDependencies
      valueDeclarationVerts :: [(ValueDeclarationData Expr, (Bool, Ident), [(Bool, Ident)])]
valueDeclarationVerts = ValueDeclarationData Expr
-> (ValueDeclarationData Expr, (Bool, Ident), [(Bool, Ident)])
makeValueDeclarationVert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ValueDeclarationData Expr]
values

    [Declaration]
bindingGroupDecls <- forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU (forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [(ValueDeclarationData Expr, (Bool, Ident), [(Bool, Ident)])]
valueDeclarationVerts) (forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName -> SCC (ValueDeclarationData Expr) -> m Declaration
toBindingGroup ModuleName
moduleName)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isImportDecl [Declaration]
ds forall a. [a] -> [a] -> [a]
++
             [Declaration]
dataBindingGroupDecls forall a. [a] -> [a] -> [a]
++
             forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isTypeClassInstanceDecl [Declaration]
ds forall a. [a] -> [a] -> [a]
++
             forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isFixityDecl [Declaration]
ds forall a. [a] -> [a] -> [a]
++
             forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isExternDecl [Declaration]
ds forall a. [a] -> [a] -> [a]
++
             [Declaration]
bindingGroupDecls
    where
      extractGuardedExpr :: [GuardedExpr] -> Expr
extractGuardedExpr [MkUnguarded Expr
expr] = Expr
expr
      extractGuardedExpr [GuardedExpr]
_ = forall a. HasCallStack => String -> a
internalError String
"Expected Guards to have been desugared in handleDecls."

      exprHasNoTypeHole :: Expr -> Bool
      exprHasNoTypeHole :: Expr -> Bool
exprHasNoTypeHole = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Bool
exprHasTypeHole
        where
        exprHasTypeHole :: Expr -> Bool
        (Declaration -> Bool
_, Expr -> Bool
exprHasTypeHole, Binder -> Bool
_, CaseAlternative -> Bool
_, DoNotationElement -> Bool
_) = forall r.
(r -> r -> r)
-> (Declaration -> r)
-> (Expr -> r)
-> (Binder -> r)
-> (CaseAlternative -> r)
-> (DoNotationElement -> r)
-> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r,
    DoNotationElement -> r)
everythingOnValues Bool -> Bool -> Bool
(||) forall a. a -> Bool
goDefault Expr -> Bool
goExpr forall a. a -> Bool
goDefault forall a. a -> Bool
goDefault forall a. a -> Bool
goDefault
          where
          goExpr :: Expr -> Bool
          goExpr :: Expr -> Bool
goExpr (Hole Text
_) = Bool
True
          goExpr Expr
_ = Bool
False

          goDefault :: forall a. a -> Bool
          goDefault :: forall a. a -> Bool
goDefault = forall a b. a -> b -> a
const Bool
False

-- |
-- Collapse all binding groups to individual declarations
--
collapseBindingGroups :: [Declaration] -> [Declaration]
collapseBindingGroups :: [Declaration] -> [Declaration]
collapseBindingGroups =
  let (Declaration -> Declaration
f, Expr -> Expr
_, Binder -> Binder
_) = (Declaration -> Declaration)
-> (Expr -> Expr)
-> (Binder -> Binder)
-> (Declaration -> Declaration, Expr -> Expr, Binder -> Binder)
everywhereOnValues forall a. a -> a
id Expr -> Expr
flattenBindingGroupsForValue forall a. a -> a
id
  in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Declaration -> Declaration
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Declaration] -> [Declaration]
flattenBindingGroups

flattenBindingGroupsForValue :: Expr -> Expr
flattenBindingGroupsForValue :: Expr -> Expr
flattenBindingGroupsForValue (Let WhereProvenance
w [Declaration]
ds Expr
val) = WhereProvenance -> [Declaration] -> Expr -> Expr
Let WhereProvenance
w ([Declaration] -> [Declaration]
flattenBindingGroups [Declaration]
ds) Expr
val
flattenBindingGroupsForValue Expr
other = Expr
other

flattenBindingGroups :: [Declaration] -> [Declaration]
flattenBindingGroups :: [Declaration] -> [Declaration]
flattenBindingGroups = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [Declaration]
go
  where
  go :: Declaration -> [Declaration]
go (DataBindingGroupDeclaration NonEmpty Declaration
ds) = forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Declaration
ds
  go (BindingGroupDeclaration NonEmpty ((SourceAnn, Ident), NameKind, Expr)
ds) =
    forall a. NonEmpty a -> [a]
NEL.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((SourceAnn
sa, Ident
ident), NameKind
nameKind, Expr
val) ->
      SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
ident NameKind
nameKind [] [Expr -> GuardedExpr
MkUnguarded Expr
val]) NonEmpty ((SourceAnn, Ident), NameKind, Expr)
ds
  go Declaration
other = [Declaration
other]

usedIdents :: ModuleName -> ValueDeclarationData Expr -> [Ident]
usedIdents :: ModuleName -> ValueDeclarationData Expr -> [Ident]
usedIdents ModuleName
moduleName = forall a. Ord a => [a] -> [a]
ordNub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ScopedIdent -> Expr -> [Ident]
usedIdents' forall a. Set a
S.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ValueDeclarationData a -> a
valdeclExpression
  where
  def :: p -> p -> [a]
def p
_ p
_ = []

  (Set ScopedIdent -> Declaration -> [Ident]
_, Set ScopedIdent -> Expr -> [Ident]
usedIdents', Set ScopedIdent -> Binder -> [Ident]
_, Set ScopedIdent -> CaseAlternative -> [Ident]
_, Set ScopedIdent -> DoNotationElement -> [Ident]
_) = forall r.
Monoid r =>
(Set ScopedIdent -> Declaration -> r)
-> (Set ScopedIdent -> Expr -> r)
-> (Set ScopedIdent -> Binder -> r)
-> (Set ScopedIdent -> CaseAlternative -> r)
-> (Set ScopedIdent -> DoNotationElement -> r)
-> (Set ScopedIdent -> Declaration -> r,
    Set ScopedIdent -> Expr -> r, Set ScopedIdent -> Binder -> r,
    Set ScopedIdent -> CaseAlternative -> r,
    Set ScopedIdent -> DoNotationElement -> r)
everythingWithScope forall {p} {p} {a}. p -> p -> [a]
def Set ScopedIdent -> Expr -> [Ident]
usedNamesE forall {p} {p} {a}. p -> p -> [a]
def forall {p} {p} {a}. p -> p -> [a]
def forall {p} {p} {a}. p -> p -> [a]
def

  usedNamesE :: S.Set ScopedIdent -> Expr -> [Ident]
  usedNamesE :: Set ScopedIdent -> Expr -> [Ident]
usedNamesE Set ScopedIdent
scope (Var SourceSpan
_ (Qualified (BySourcePos SourcePos
_) Ident
name))
    | Ident -> ScopedIdent
LocalIdent Ident
name forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set ScopedIdent
scope = [Ident
name]
  usedNamesE Set ScopedIdent
scope (Var SourceSpan
_ (Qualified (ByModuleName ModuleName
moduleName') Ident
name))
    | ModuleName
moduleName forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName' Bool -> Bool -> Bool
&& Ident -> ScopedIdent
ToplevelIdent Ident
name forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set ScopedIdent
scope = [Ident
name]
  usedNamesE Set ScopedIdent
_ Expr
_ = []

usedImmediateIdents :: ModuleName -> Declaration -> [Ident]
usedImmediateIdents :: ModuleName -> Declaration -> [Ident]
usedImmediateIdents ModuleName
moduleName =
  let (Declaration -> [Ident]
f, Expr -> [Ident]
_, Binder -> [Ident]
_, CaseAlternative -> [Ident]
_, DoNotationElement -> [Ident]
_) = forall s r.
s
-> r
-> (r -> r -> r)
-> (s -> Declaration -> (s, r))
-> (s -> Expr -> (s, r))
-> (s -> Binder -> (s, r))
-> (s -> CaseAlternative -> (s, r))
-> (s -> DoNotationElement -> (s, r))
-> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r,
    DoNotationElement -> r)
everythingWithContextOnValues Bool
True [] forall a. [a] -> [a] -> [a]
(++) forall {a} {p} {a}. a -> p -> (a, [a])
def Bool -> Expr -> (Bool, [Ident])
usedNamesE forall {a} {p} {a}. a -> p -> (a, [a])
def forall {a} {p} {a}. a -> p -> (a, [a])
def forall {a} {p} {a}. a -> p -> (a, [a])
def
  in forall a. Ord a => [a] -> [a]
ordNub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> [Ident]
f
  where
  def :: a -> p -> (a, [a])
def a
s p
_ = (a
s, [])

  usedNamesE :: Bool -> Expr -> (Bool, [Ident])
  usedNamesE :: Bool -> Expr -> (Bool, [Ident])
usedNamesE Bool
True (Var SourceSpan
_ (Qualified (BySourcePos SourcePos
_) Ident
name)) = (Bool
True, [Ident
name])
  usedNamesE Bool
True (Var SourceSpan
_ (Qualified (ByModuleName ModuleName
moduleName') Ident
name))
    | ModuleName
moduleName forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName' = (Bool
True, [Ident
name])
  usedNamesE Bool
True (Abs Binder
_ Expr
_) = (Bool
False, [])
  usedNamesE Bool
scope Expr
_ = (Bool
scope, [])

usedTypeNames :: ModuleName -> Declaration -> [ProperName 'TypeName]
usedTypeNames :: ModuleName -> Declaration -> [ProperName 'TypeName]
usedTypeNames ModuleName
moduleName = Declaration -> [ProperName 'TypeName]
go
  where
  (Declaration -> [ProperName 'TypeName]
f, Expr -> [ProperName 'TypeName]
_, Binder -> [ProperName 'TypeName]
_, CaseAlternative -> [ProperName 'TypeName]
_, DoNotationElement -> [ProperName 'TypeName]
_) = forall r.
Monoid r =>
(SourceType -> r)
-> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r,
    DoNotationElement -> r)
accumTypes (forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes forall a. [a] -> [a] -> [a]
(++) SourceType -> [ProperName 'TypeName]
usedNames)

  go :: Declaration -> [ProperName 'TypeName]
  go :: Declaration -> [ProperName 'TypeName]
go Declaration
decl = forall a. Ord a => [a] -> [a]
ordNub (Declaration -> [ProperName 'TypeName]
f Declaration
decl forall a. Semigroup a => a -> a -> a
<> Declaration -> [ProperName 'TypeName]
usedNamesForTypeClassDeps Declaration
decl)

  usedNames :: SourceType -> [ProperName 'TypeName]
  usedNames :: SourceType -> [ProperName 'TypeName]
usedNames (ConstrainedType SourceAnn
_ Constraint SourceAnn
con SourceType
_) = Constraint SourceAnn -> [ProperName 'TypeName]
usedConstraint Constraint SourceAnn
con
  usedNames (TypeConstructor SourceAnn
_ (Qualified (ByModuleName ModuleName
moduleName') ProperName 'TypeName
name))
    | ModuleName
moduleName forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName' = [ProperName 'TypeName
name]
  usedNames SourceType
_ = []

  usedConstraint :: SourceConstraint -> [ProperName 'TypeName]
  usedConstraint :: Constraint SourceAnn -> [ProperName 'TypeName]
usedConstraint (Constraint SourceAnn
_ (Qualified (ByModuleName ModuleName
moduleName') ProperName 'ClassName
name) [SourceType]
_ [SourceType]
_ Maybe ConstraintData
_)
    | ModuleName
moduleName forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName' = [forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
name]
  usedConstraint Constraint SourceAnn
_ = []

  usedNamesForTypeClassDeps :: Declaration -> [ProperName 'TypeName]
  usedNamesForTypeClassDeps :: Declaration -> [ProperName 'TypeName]
usedNamesForTypeClassDeps (TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
_ [(Text, Maybe SourceType)]
_ [Constraint SourceAnn]
deps [FunctionalDependency]
_ [Declaration]
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Constraint SourceAnn -> [ProperName 'TypeName]
usedConstraint [Constraint SourceAnn]
deps
  usedNamesForTypeClassDeps Declaration
_ = []

declTypeName :: Declaration -> ProperName 'TypeName
declTypeName :: Declaration -> ProperName 'TypeName
declTypeName (DataDeclaration SourceAnn
_ DataDeclType
_ ProperName 'TypeName
pn [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
_) = ProperName 'TypeName
pn
declTypeName (ExternDataDeclaration SourceAnn
_ ProperName 'TypeName
pn SourceType
_) = ProperName 'TypeName
pn
declTypeName (TypeSynonymDeclaration SourceAnn
_ ProperName 'TypeName
pn [(Text, Maybe SourceType)]
_ SourceType
_) = ProperName 'TypeName
pn
declTypeName (TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
pn [(Text, Maybe SourceType)]
_ [Constraint SourceAnn]
_ [FunctionalDependency]
_ [Declaration]
_) = forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName ProperName 'ClassName
pn
declTypeName (KindDeclaration SourceAnn
_ KindSignatureFor
_ ProperName 'TypeName
pn SourceType
_) = ProperName 'TypeName
pn
declTypeName (RoleDeclaration (RoleDeclarationData SourceAnn
_ ProperName 'TypeName
pn [Role]
_)) = ProperName 'TypeName
pn
declTypeName Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Expected DataDeclaration"

-- |
-- Convert a group of mutually-recursive dependencies into a BindingGroupDeclaration (or simple ValueDeclaration).
--
--
toBindingGroup
  :: forall m
   . (MonadError MultipleErrors m)
   => ModuleName
   -> SCC (ValueDeclarationData Expr)
   -> m Declaration
toBindingGroup :: forall (m :: * -> *).
MonadError MultipleErrors m =>
ModuleName -> SCC (ValueDeclarationData Expr) -> m Declaration
toBindingGroup ModuleName
_ (AcyclicSCC ValueDeclarationData Expr
d) = forall (m :: * -> *) a. Monad m => a -> m a
return (ValueDeclarationData Expr -> Declaration
mkDeclaration ValueDeclarationData Expr
d)
toBindingGroup ModuleName
moduleName (CyclicSCC [ValueDeclarationData Expr]
ds') = do
  -- Once we have a mutually-recursive group of declarations, we need to sort
  -- them further by their immediate dependencies (those outside function
  -- bodies). In particular, this is relevant for type instance dictionaries
  -- whose members require other type instances (for example, functorEff
  -- defines (<$>) = liftA1, which depends on applicativeEff). Note that
  -- superclass references are still inside functions, so don't count here.
  -- If we discover declarations that still contain mutually-recursive
  -- immediate references, we're guaranteed to get an undefined reference at
  -- runtime, so treat this as an error. See also github issue #365.
  NonEmpty ((SourceAnn, Ident), NameKind, Expr) -> Declaration
BindingGroupDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NEL.fromList 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 SCC (ValueDeclarationData Expr)
-> m ((SourceAnn, Ident), NameKind, Expr)
toBinding (forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [(ValueDeclarationData Expr, Ident, [Ident])]
valueVerts)
  where
  idents :: [Ident]
  idents :: [Ident]
idents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ValueDeclarationData Expr
_, Ident
i, [Ident]
_) -> Ident
i) [(ValueDeclarationData Expr, Ident, [Ident])]
valueVerts

  valueVerts :: [(ValueDeclarationData Expr, Ident, [Ident])]
  valueVerts :: [(ValueDeclarationData Expr, Ident, [Ident])]
valueVerts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ValueDeclarationData Expr
d -> (ValueDeclarationData Expr
d, forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData Expr
d, ModuleName -> Declaration -> [Ident]
usedImmediateIdents ModuleName
moduleName (ValueDeclarationData Expr -> Declaration
mkDeclaration ValueDeclarationData Expr
d) forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Ident]
idents)) [ValueDeclarationData Expr]
ds'

  toBinding :: SCC (ValueDeclarationData Expr) -> m ((SourceAnn, Ident), NameKind, Expr)
  toBinding :: SCC (ValueDeclarationData Expr)
-> m ((SourceAnn, Ident), NameKind, Expr)
toBinding (AcyclicSCC ValueDeclarationData Expr
d) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ValueDeclarationData Expr -> ((SourceAnn, Ident), NameKind, Expr)
fromValueDecl ValueDeclarationData Expr
d
  toBinding (CyclicSCC [ValueDeclarationData Expr]
ds) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ValueDeclarationData Expr -> MultipleErrors
cycleError [ValueDeclarationData Expr]
ds

  cycleError :: ValueDeclarationData Expr -> MultipleErrors
  cycleError :: ValueDeclarationData Expr -> MultipleErrors
cycleError (ValueDeclarationData (SourceSpan
ss, [Comment]
_) Ident
n NameKind
_ [Binder]
_ Expr
_) = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$ Ident -> SimpleErrorMessage
CycleInDeclaration Ident
n

toDataBindingGroup
  :: MonadError MultipleErrors m
  => Ord a
  => SCC (Declaration, (ProperName 'TypeName, a), [(ProperName 'TypeName, a)])
  -> m Declaration
toDataBindingGroup :: forall (m :: * -> *) a.
(MonadError MultipleErrors m, Ord a) =>
SCC
  (Declaration, (ProperName 'TypeName, a),
   [(ProperName 'TypeName, a)])
-> m Declaration
toDataBindingGroup (AcyclicSCC (Declaration
d, (ProperName 'TypeName, a)
_, [(ProperName 'TypeName, a)]
_)) = forall (m :: * -> *) a. Monad m => a -> m a
return Declaration
d
toDataBindingGroup (CyclicSCC [(Declaration, (ProperName 'TypeName, a),
  [(ProperName 'TypeName, a)])]
ds')
  | Just kds :: NonEmpty (SourceSpan, Qualified (ProperName 'TypeName))
kds@((SourceSpan
ss, Qualified (ProperName 'TypeName)
_):|[(SourceSpan, Qualified (ProperName 'TypeName))]
_) <- forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Declaration -> [(SourceSpan, Qualified (ProperName 'TypeName))]
kindDecl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> a
getDecl) [(Declaration, (ProperName 'TypeName, a),
  [(ProperName 'TypeName, a)])]
ds' = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified (ProperName 'TypeName)) -> SimpleErrorMessage
CycleInKindDeclaration forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd NonEmpty (SourceSpan, Qualified (ProperName 'TypeName))
kds
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NonEmpty
   (Declaration, (ProperName 'TypeName, a),
    [(ProperName 'TypeName, a)])]
typeSynonymCycles) =
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorMessage] -> MultipleErrors
MultipleErrors
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty
  (Declaration, (ProperName 'TypeName, a),
   [(ProperName 'TypeName, a)])
syns -> [ErrorMessageHint] -> SimpleErrorMessage -> ErrorMessage
ErrorMessage [SourceSpan -> ErrorMessageHint
positionedError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> SourceSpan
declSourceSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> a
getDecl forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NEL.head NonEmpty
  (Declaration, (ProperName 'TypeName, a),
   [(ProperName 'TypeName, a)])
syns] forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ProperName 'TypeName) -> SimpleErrorMessage
CycleInTypeSynonym forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> b
getName) NonEmpty
  (Declaration, (ProperName 'TypeName, a),
   [(ProperName 'TypeName, a)])
syns)
        forall a b. (a -> b) -> a -> b
$ [NonEmpty
   (Declaration, (ProperName 'TypeName, a),
    [(ProperName 'TypeName, a)])]
typeSynonymCycles
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Declaration -> Declaration
DataBindingGroupDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NEL.fromList forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c}. (a, b, c) -> a
getDecl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Declaration, (ProperName 'TypeName, a),
  [(ProperName 'TypeName, a)])]
ds'
  where
  kindDecl :: Declaration -> [(SourceSpan, Qualified (ProperName 'TypeName))]
kindDecl (KindDeclaration SourceAnn
sa KindSignatureFor
_ ProperName 'TypeName
pn SourceType
_) = [(forall a b. (a, b) -> a
fst SourceAnn
sa, forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos ProperName 'TypeName
pn)]
  kindDecl (ExternDataDeclaration SourceAnn
sa ProperName 'TypeName
pn SourceType
_) = [(forall a b. (a, b) -> a
fst SourceAnn
sa, forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos ProperName 'TypeName
pn)]
  kindDecl Declaration
_ = []

  getDecl :: (a, b, c) -> a
getDecl (a
decl, b
_, c
_) = a
decl
  getName :: (a, b, c) -> b
getName (a
_, b
name, c
_) = b
name
  lookupVert :: (ProperName 'TypeName, a)
-> Maybe
     (Declaration, (ProperName 'TypeName, a),
      [(ProperName 'TypeName, a)])
lookupVert (ProperName 'TypeName, a)
name = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) (ProperName 'TypeName, a)
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> b
getName) [(Declaration, (ProperName 'TypeName, a),
  [(ProperName 'TypeName, a)])]
ds'

  onlySynonyms :: (Declaration, (ProperName 'TypeName, a),
 [(ProperName 'TypeName, a)])
-> Maybe
     (Declaration, (ProperName 'TypeName, a),
      [(ProperName 'TypeName, a)])
onlySynonyms (Declaration
decl, (ProperName 'TypeName, a)
name, [(ProperName 'TypeName, a)]
deps) = do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Declaration -> Maybe (ProperName 'TypeName)
isTypeSynonym Declaration
decl
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Declaration
decl, (ProperName 'TypeName, a)
name, forall a. (a -> Bool) -> [a] -> [a]
filter (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe (ProperName 'TypeName)
isTypeSynonym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> a
getDecl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProperName 'TypeName, a)
-> Maybe
     (Declaration, (ProperName 'TypeName, a),
      [(ProperName 'TypeName, a)])
lookupVert) [(ProperName 'TypeName, a)]
deps)

  isCycle :: SCC a -> Maybe (NonEmpty a)
isCycle (CyclicSCC [a]
c) = forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
c
  isCycle SCC a
_ = forall a. Maybe a
Nothing

  typeSynonymCycles :: [NonEmpty
   (Declaration, (ProperName 'TypeName, a),
    [(ProperName 'TypeName, a)])]
typeSynonymCycles =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. SCC a -> Maybe (NonEmpty a)
isCycle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key node.
Ord key =>
[(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Declaration, (ProperName 'TypeName, a),
 [(ProperName 'TypeName, a)])
-> Maybe
     (Declaration, (ProperName 'TypeName, a),
      [(ProperName 'TypeName, a)])
onlySynonyms forall a b. (a -> b) -> a -> b
$ [(Declaration, (ProperName 'TypeName, a),
  [(ProperName 'TypeName, a)])]
ds'

isTypeSynonym :: Declaration -> Maybe (ProperName 'TypeName)
isTypeSynonym :: Declaration -> Maybe (ProperName 'TypeName)
isTypeSynonym (TypeSynonymDeclaration SourceAnn
_ ProperName 'TypeName
pn [(Text, Maybe SourceType)]
_ SourceType
_) = forall a. a -> Maybe a
Just ProperName 'TypeName
pn
isTypeSynonym Declaration
_ = forall a. Maybe a
Nothing

mkDeclaration :: ValueDeclarationData Expr -> Declaration
mkDeclaration :: ValueDeclarationData Expr -> Declaration
mkDeclaration = ValueDeclarationData [GuardedExpr] -> Declaration
ValueDeclaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> GuardedExpr
MkUnguarded)

fromValueDecl :: ValueDeclarationData Expr -> ((SourceAnn, Ident), NameKind, Expr)
fromValueDecl :: ValueDeclarationData Expr -> ((SourceAnn, Ident), NameKind, Expr)
fromValueDecl (ValueDeclarationData SourceAnn
sa Ident
ident NameKind
nameKind [] Expr
val) = ((SourceAnn
sa, Ident
ident), NameKind
nameKind, Expr
val)
fromValueDecl ValueDeclarationData{} = forall a. HasCallStack => String -> a
internalError String
"Binders should have been desugared"