-- |
-- 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 (SCC(..), stronglyConnComp, stronglyConnCompR)
import Data.List (intersect, (\\))
import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)
import Data.Foldable (find)
import Data.Functor (($>))
import Data.Maybe (isJust, mapMaybe)
import Data.List.NonEmpty qualified as NEL
import Data.Map qualified as M
import Data.Set qualified as S

import Language.PureScript.AST
import Language.PureScript.Crash (internalError)
import Language.PureScript.Environment (NameKind)
import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors(..), SimpleErrorMessage(..), errorMessage', parU, positionedError)
import Language.PureScript.Names (pattern ByNullSourcePos, Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName)
import Language.PureScript.Types (Constraint(..), SourceConstraint, SourceType, Type(..), everythingOnTypes)

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"