-- |
-- This module implements the desugaring pass which replaces top-level binders with
-- case expressions.
--
module Language.PureScript.Sugar.CaseDeclarations
  ( desugarCases
  , desugarCasesModule
  , desugarCaseGuards
  ) where

import Prelude
import Protolude (ordNub)

import Data.List (groupBy, foldl1')
import Data.Maybe (catMaybes, mapMaybe)

import Control.Monad ((<=<), forM, replicateM, join, unless)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Supply.Class (MonadSupply)

import Language.PureScript.AST
import Language.PureScript.Crash (internalError)
import Language.PureScript.Environment (NameKind(..))
import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors(..), SimpleErrorMessage(..), addHint, errorMessage', parU, rethrow, withPosition)
import Language.PureScript.Names (pattern ByNullSourcePos, Ident, Qualified(..), freshIdent')
import Language.PureScript.TypeChecker.Monad (guardWith)

-- |
-- Replace all top-level binders in a module with case expressions.
--
desugarCasesModule
  :: (MonadSupply m, MonadError MultipleErrors m)
  => Module
  -> m Module
desugarCasesModule :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
Module -> m Module
desugarCasesModule (Module SourceSpan
ss [Comment]
coms ModuleName
name [Declaration]
ds Maybe [DeclarationRef]
exps) =
  forall e (m :: * -> *) a. MonadError e m => (e -> e) -> m a -> m a
rethrow (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
name)) forall a b. (a -> b) -> a -> b
$
    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 :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarCases forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarAbs forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
validateCases forall a b. (a -> b) -> a -> b
$ [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

desugarCaseGuards
  :: forall m. (MonadSupply m, MonadError MultipleErrors m)
  => [Declaration]
  -> m [Declaration]
desugarCaseGuards :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarCaseGuards [Declaration]
declarations = forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU [Declaration]
declarations forall {m :: * -> *}. MonadSupply m => Declaration -> m Declaration
go
  where
    go :: Declaration -> m Declaration
go Declaration
d =
      let (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)
everywhereOnValuesM forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). MonadSupply m => SourceSpan -> Expr -> m Expr
desugarGuardedExprs (Declaration -> SourceSpan
declSourceSpan Declaration
d)) forall (m :: * -> *) a. Monad m => a -> m a
return
      in Declaration -> m Declaration
f Declaration
d

-- |
-- Desugar case with pattern guards and pattern clauses to a
-- series of nested case expressions.
--
desugarGuardedExprs
  :: forall m. (MonadSupply m)
  => SourceSpan
  -> Expr
  -> m Expr
desugarGuardedExprs :: forall (m :: * -> *). MonadSupply m => SourceSpan -> Expr -> m Expr
desugarGuardedExprs SourceSpan
ss (Case [Expr]
scrut [CaseAlternative]
alternatives)
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expr -> Bool
isTrivialExpr [Expr]
scrut = do
    -- in case the scrutinee is non trivial (e.g. not a Var or Literal)
    -- we may evaluate the scrutinee more than once when a guard occurs.
    -- We bind the scrutinee to Vars here to mitigate this case.
    ([Expr]
scrut', [Declaration]
scrut_decls) <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Expr]
scrut (\Expr
e -> do
      Ident
scrut_id <- forall (m :: * -> *). MonadSupply m => m Ident
freshIdent'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ( SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos Ident
scrut_id)
           , SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl (SourceSpan
ss, []) Ident
scrut_id NameKind
Private [] [Expr -> GuardedExpr
MkUnguarded Expr
e]
           )
      )
    WhereProvenance -> [Declaration] -> Expr -> Expr
Let WhereProvenance
FromLet [Declaration]
scrut_decls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadSupply m => SourceSpan -> Expr -> m Expr
desugarGuardedExprs SourceSpan
ss ([Expr] -> [CaseAlternative] -> Expr
Case [Expr]
scrut' [CaseAlternative]
alternatives)
  where
    isTrivialExpr :: Expr -> Bool
isTrivialExpr (Var SourceSpan
_ Qualified Ident
_) = Bool
True
    isTrivialExpr (Literal SourceSpan
_ Literal Expr
_) = Bool
True
    isTrivialExpr (Accessor PSString
_ Expr
e) = Expr -> Bool
isTrivialExpr Expr
e
    isTrivialExpr (Parens Expr
e) = Expr -> Bool
isTrivialExpr Expr
e
    isTrivialExpr (PositionedValue SourceSpan
_ [Comment]
_ Expr
e) = Expr -> Bool
isTrivialExpr Expr
e
    isTrivialExpr (TypedValue Bool
_ Expr
e SourceType
_) = Expr -> Bool
isTrivialExpr Expr
e
    isTrivialExpr Expr
_ = Bool
False

desugarGuardedExprs SourceSpan
ss (Case [Expr]
scrut [CaseAlternative]
alternatives) =
  let
    -- Alternatives which do not have guards are
    -- left as-is. Alternatives which
    --
    --   1) have multiple clauses of the form
    --      binder | g_1
    --             , g_2
    --             , ...
    --             , g_n
    --             -> expr
    --
    --   2) and/or contain pattern guards of the form
    --      binder | pat_bind <- e
    --             , ...
    --
    -- are desugared to a sequence of nested case expressions.
    --
    -- Consider an example case expression:
    --
    --   case e of
    --    (T s) | Just info <- Map.lookup s names
    --          , is_used info
    --          -> f info
    --
    -- We desugar this to
    --
    --   case e of
    --    (T s) -> case Map.lookup s names of
    --               Just info -> case is_used info of
    --                              True -> f info
    --                              (_    -> <partial>)
    --               (_ -> <partial>)
    --
    -- Note that if the original case is partial the desugared
    -- case is also partial.
    --
    -- Consider an exhaustive case expression:
    --
    --   case e of
    --    (T s) | Just info <- Map.lookup s names
    --          , is_used info
    --          -> f info
    --    _     -> Nothing
    --
    -- desugars to:
    --
    --    case e of
    --      _ -> let
    --                v _ = Nothing
    --           in
    --             case e of
    --                (T s) -> case Map.lookup s names of
    --                          Just info -> f info
    --                          _ -> v true
    --                _  -> v true
    --
    -- This might look strange but simplifies the algorithm a lot.
    --
    desugarAlternatives :: [CaseAlternative]
                        -> m [CaseAlternative]
    desugarAlternatives :: [CaseAlternative] -> m [CaseAlternative]
desugarAlternatives [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    -- the trivial case: no guards
    desugarAlternatives (a :: CaseAlternative
a@(CaseAlternative [Binder]
_ [MkUnguarded Expr
_]) : [CaseAlternative]
as) =
      (CaseAlternative
a forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CaseAlternative] -> m [CaseAlternative]
desugarAlternatives [CaseAlternative]
as

    -- Special case: CoreFn understands single condition guards on
    -- binders right hand side.
    desugarAlternatives (CaseAlternative [Binder]
ab [GuardedExpr]
ge : [CaseAlternative]
as)
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardedExpr]
cond_guards) =
          ([Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder]
ab [GuardedExpr]
cond_guards forall a. a -> [a] -> [a]
:)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binder]
-> [GuardedExpr] -> [CaseAlternative] -> m [CaseAlternative]
desugarGuardedAlternative [Binder]
ab [GuardedExpr]
rest [CaseAlternative]
as
      | Bool
otherwise = [Binder]
-> [GuardedExpr] -> [CaseAlternative] -> m [CaseAlternative]
desugarGuardedAlternative [Binder]
ab [GuardedExpr]
ge [CaseAlternative]
as
      where
        ([GuardedExpr]
cond_guards, [GuardedExpr]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span GuardedExpr -> Bool
isSingleCondGuard [GuardedExpr]
ge

        isSingleCondGuard :: GuardedExpr -> Bool
isSingleCondGuard (GuardedExpr [ConditionGuard Expr
_] Expr
_) = Bool
True
        isSingleCondGuard GuardedExpr
_ = Bool
False

    desugarGuardedAlternative :: [Binder]
                              -> [GuardedExpr]
                              -> [CaseAlternative]
                              -> m [CaseAlternative]
    desugarGuardedAlternative :: [Binder]
-> [GuardedExpr] -> [CaseAlternative] -> m [CaseAlternative]
desugarGuardedAlternative [Binder]
_vb [] [CaseAlternative]
rem_alts =
      [CaseAlternative] -> m [CaseAlternative]
desugarAlternatives [CaseAlternative]
rem_alts

    desugarGuardedAlternative [Binder]
vb (GuardedExpr [Guard]
gs Expr
e : [GuardedExpr]
ge) [CaseAlternative]
rem_alts = do
      Expr
rhs <- [Binder]
-> [GuardedExpr]
-> [CaseAlternative]
-> ((Int -> [CaseAlternative]) -> Expr)
-> m Expr
desugarAltOutOfLine [Binder]
vb [GuardedExpr]
ge [CaseAlternative]
rem_alts forall a b. (a -> b) -> a -> b
$ \Int -> [CaseAlternative]
alt_fail ->
        let
          -- if the binder is a var binder we must not add
          -- the fail case as it results in unreachable
          -- alternative
          alt_fail' :: Int -> [CaseAlternative]
alt_fail' Int
n | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Binder -> Bool
isIrrefutable [Binder]
vb = []
                      | Bool
otherwise = Int -> [CaseAlternative]
alt_fail Int
n


          -- we are here:
          --
          -- case scrut of
          --   ...
          --   _ -> let
          --         v _ = <out of line case>
          --        in case scrut of -- we are here
          --            ...
          --
        in [Expr] -> [CaseAlternative] -> Expr
Case [Expr]
scrut
            ([Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder]
vb [Expr -> GuardedExpr
MkUnguarded ([Guard] -> Expr -> (Int -> [CaseAlternative]) -> Expr
desugarGuard [Guard]
gs Expr
e Int -> [CaseAlternative]
alt_fail)]
              forall a. a -> [a] -> [a]
: Int -> [CaseAlternative]
alt_fail' (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
scrut))

      forall (m :: * -> *) a. Monad m => a -> m a
return [ [Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder]
scrut_nullbinder [Expr -> GuardedExpr
MkUnguarded Expr
rhs]]

    desugarGuard :: [Guard] -> Expr -> (Int ->[CaseAlternative]) -> Expr
    desugarGuard :: [Guard] -> Expr -> (Int -> [CaseAlternative]) -> Expr
desugarGuard [] Expr
e Int -> [CaseAlternative]
_ = Expr
e
    desugarGuard (ConditionGuard Expr
c : [Guard]
gs) Expr
e Int -> [CaseAlternative]
match_failed
      | Expr -> Bool
isTrueExpr Expr
c = [Guard] -> Expr -> (Int -> [CaseAlternative]) -> Expr
desugarGuard [Guard]
gs Expr
e Int -> [CaseAlternative]
match_failed
      | Bool
otherwise =
        [Expr] -> [CaseAlternative] -> Expr
Case [Expr
c]
          ([Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [SourceSpan -> Literal Binder -> Binder
LiteralBinder SourceSpan
ss (forall a. Bool -> Literal a
BooleanLiteral Bool
True)]
            [Expr -> GuardedExpr
MkUnguarded ([Guard] -> Expr -> (Int -> [CaseAlternative]) -> Expr
desugarGuard [Guard]
gs Expr
e Int -> [CaseAlternative]
match_failed)] forall a. a -> [a] -> [a]
: Int -> [CaseAlternative]
match_failed Int
1)

    desugarGuard (PatternGuard Binder
vb Expr
g : [Guard]
gs) Expr
e Int -> [CaseAlternative]
match_failed =
      [Expr] -> [CaseAlternative] -> Expr
Case [Expr
g]
        ([Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder
vb] [Expr -> GuardedExpr
MkUnguarded ([Guard] -> Expr -> (Int -> [CaseAlternative]) -> Expr
desugarGuard [Guard]
gs Expr
e Int -> [CaseAlternative]
match_failed)]
          forall a. a -> [a] -> [a]
: [CaseAlternative]
match_failed')
      where
        -- don't consider match_failed case if the binder is irrefutable
        match_failed' :: [CaseAlternative]
match_failed' | Binder -> Bool
isIrrefutable Binder
vb = []
                      | Bool
otherwise        = Int -> [CaseAlternative]
match_failed Int
1

    -- we generate a let-binding for the remaining guards
    -- and alternatives. A CaseAlternative is passed (or in
    -- fact the original case is partial non is passed) to
    -- mk_body which branches to the generated let-binding.
    desugarAltOutOfLine :: [Binder]
                        -> [GuardedExpr]
                        -> [CaseAlternative]
                        -> ((Int -> [CaseAlternative]) -> Expr)
                        -> m Expr
    desugarAltOutOfLine :: [Binder]
-> [GuardedExpr]
-> [CaseAlternative]
-> ((Int -> [CaseAlternative]) -> Expr)
-> m Expr
desugarAltOutOfLine [Binder]
alt_binder [GuardedExpr]
rem_guarded [CaseAlternative]
rem_alts (Int -> [CaseAlternative]) -> Expr
mk_body
      | Just Expr
rem_case <- Maybe Expr
mkCaseOfRemainingGuardsAndAlts = do

        Expr
desugared     <- forall (m :: * -> *). MonadSupply m => SourceSpan -> Expr -> m Expr
desugarGuardedExprs SourceSpan
ss Expr
rem_case
        Ident
rem_case_id   <- forall (m :: * -> *). MonadSupply m => m Ident
freshIdent'
        Ident
unused_binder <- forall (m :: * -> *). MonadSupply m => m Ident
freshIdent'

        let
          goto_rem_case :: Expr
          goto_rem_case :: Expr
goto_rem_case = SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos Ident
rem_case_id)
            Expr -> Expr -> Expr
`App` SourceSpan -> Literal Expr -> Expr
Literal SourceSpan
ss (forall a. Bool -> Literal a
BooleanLiteral Bool
True)
          alt_fail :: Int -> [CaseAlternative]
          alt_fail :: Int -> [CaseAlternative]
alt_fail Int
n = [[Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative (forall a. Int -> a -> [a]
replicate Int
n Binder
NullBinder) [Expr -> GuardedExpr
MkUnguarded Expr
goto_rem_case]]

        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WhereProvenance -> [Declaration] -> Expr -> Expr
Let WhereProvenance
FromLet [
          SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl (SourceSpan
ss, []) Ident
rem_case_id NameKind
Private []
            [Expr -> GuardedExpr
MkUnguarded (Binder -> Expr -> Expr
Abs (SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss Ident
unused_binder) Expr
desugared)]
          ] ((Int -> [CaseAlternative]) -> Expr
mk_body Int -> [CaseAlternative]
alt_fail)

      | Bool
otherwise
      = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int -> [CaseAlternative]) -> Expr
mk_body (forall a b. a -> b -> a
const [])
      where
        mkCaseOfRemainingGuardsAndAlts :: Maybe Expr
mkCaseOfRemainingGuardsAndAlts
          | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GuardedExpr]
rem_guarded)
          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Expr] -> [CaseAlternative] -> Expr
Case [Expr]
scrut ([Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder]
alt_binder [GuardedExpr]
rem_guarded forall a. a -> [a] -> [a]
: [CaseAlternative]
rem_alts)
          | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CaseAlternative]
rem_alts)
          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Expr] -> [CaseAlternative] -> Expr
Case [Expr]
scrut [CaseAlternative]
rem_alts
          | Bool
otherwise
          = forall a. Maybe a
Nothing

    scrut_nullbinder :: [Binder]
    scrut_nullbinder :: [Binder]
scrut_nullbinder = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
scrut) Binder
NullBinder

    -- case expressions with a single alternative which have
    -- a NullBinder occur frequently after desugaring
    -- complex guards. This function removes these superfluous
    -- cases.
    optimize :: Expr -> Expr
    optimize :: Expr -> Expr
optimize (Case [Expr]
_ [CaseAlternative [Binder]
vb [MkUnguarded Expr
v]])
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Binder -> Bool
isNullBinder [Binder]
vb = Expr
v
      where
        isNullBinder :: Binder -> Bool
isNullBinder Binder
NullBinder = Bool
True
        isNullBinder (PositionedBinder SourceSpan
_ [Comment]
_ Binder
b) = Binder -> Bool
isNullBinder Binder
b
        isNullBinder (TypedBinder SourceType
_ Binder
b) = Binder -> Bool
isNullBinder Binder
b
        isNullBinder Binder
_ = Bool
False
    optimize Expr
e = Expr
e
  in do
    [CaseAlternative]
alts' <- [CaseAlternative] -> m [CaseAlternative]
desugarAlternatives [CaseAlternative]
alternatives
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Expr -> Expr
optimize ([Expr] -> [CaseAlternative] -> Expr
Case [Expr]
scrut [CaseAlternative]
alts')

desugarGuardedExprs SourceSpan
ss (TypedValue Bool
inferred Expr
e SourceType
ty) =
  Bool -> Expr -> SourceType -> Expr
TypedValue Bool
inferred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadSupply m => SourceSpan -> Expr -> m Expr
desugarGuardedExprs SourceSpan
ss Expr
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceType
ty

desugarGuardedExprs SourceSpan
_ (PositionedValue SourceSpan
ss [Comment]
comms Expr
e) =
  SourceSpan -> [Comment] -> Expr -> Expr
PositionedValue SourceSpan
ss [Comment]
comms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadSupply m => SourceSpan -> Expr -> m Expr
desugarGuardedExprs SourceSpan
ss Expr
e

desugarGuardedExprs SourceSpan
_ Expr
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
v

-- |
-- Validates that case head and binder lengths match.
--
validateCases :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]
validateCases :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
validateCases = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU Declaration -> m Declaration
f
  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)
everywhereOnValuesM forall (m :: * -> *) a. Monad m => a -> m a
return Expr -> m Expr
validate forall (m :: * -> *) a. Monad m => a -> m a
return

  validate :: Expr -> m Expr
  validate :: Expr -> m Expr
validate c :: Expr
c@(Case [Expr]
vs [CaseAlternative]
alts) = do
    let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
vs
        alts' :: [CaseAlternative]
alts' = forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
l forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseAlternative -> [Binder]
caseAlternativeBinders) [CaseAlternative]
alts
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CaseAlternative]
alts') forall a b. (a -> b) -> a -> b
$
      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 a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Binder] -> ErrorMessage
altError Int
l) (CaseAlternative -> [Binder]
caseAlternativeBinders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CaseAlternative]
alts')
    forall (m :: * -> *) a. Monad m => a -> m a
return Expr
c
  validate Expr
other = forall (m :: * -> *) a. Monad m => a -> m a
return Expr
other

  altError :: Int -> [Binder] -> ErrorMessage
  altError :: Int -> [Binder] -> ErrorMessage
altError Int
l [Binder]
bs = SourceSpan -> ErrorMessage -> ErrorMessage
withPosition SourceSpan
pos forall a b. (a -> b) -> a -> b
$ [ErrorMessageHint] -> SimpleErrorMessage -> ErrorMessage
ErrorMessage [] forall a b. (a -> b) -> a -> b
$ Int -> [Binder] -> SimpleErrorMessage
CaseBinderLengthDiffers Int
l [Binder]
bs
    where
    pos :: SourceSpan
pos = forall a. (a -> a -> a) -> [a] -> a
foldl1' SourceSpan -> SourceSpan -> SourceSpan
widenSpan (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Binder -> Maybe SourceSpan
positionedBinder [Binder]
bs)

    widenSpan :: SourceSpan -> SourceSpan -> SourceSpan
widenSpan (SourceSpan String
n SourcePos
start SourcePos
end) (SourceSpan String
_ SourcePos
start' SourcePos
end') =
      String -> SourcePos -> SourcePos -> SourceSpan
SourceSpan String
n (forall a. Ord a => a -> a -> a
min SourcePos
start SourcePos
start') (forall a. Ord a => a -> a -> a
max SourcePos
end SourcePos
end')

    positionedBinder :: Binder -> Maybe SourceSpan
positionedBinder (PositionedBinder SourceSpan
p [Comment]
_ Binder
_) = forall a. a -> Maybe a
Just SourceSpan
p
    positionedBinder Binder
_ = forall a. Maybe a
Nothing

desugarAbs :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]
desugarAbs :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarAbs = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU Declaration -> m Declaration
f
  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)
everywhereOnValuesM forall (m :: * -> *) a. Monad m => a -> m a
return Expr -> m Expr
replace forall (m :: * -> *) a. Monad m => a -> m a
return

  replace :: Expr -> m Expr
  replace :: Expr -> m Expr
replace (Abs (Binder -> Binder
stripPositioned -> (VarBinder SourceSpan
ss Ident
i)) Expr
val) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binder -> Expr -> Expr
Abs (SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss Ident
i) Expr
val)
  replace (Abs Binder
binder Expr
val) = do
    Ident
ident <- forall (m :: * -> *). MonadSupply m => m Ident
freshIdent'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Binder -> Expr -> Expr
Abs (SourceSpan -> Ident -> Binder
VarBinder SourceSpan
nullSourceSpan Ident
ident) forall a b. (a -> b) -> a -> b
$ [Expr] -> [CaseAlternative] -> Expr
Case [SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
nullSourceSpan (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos Ident
ident)] [[Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder
binder] [Expr -> GuardedExpr
MkUnguarded Expr
val]]
  replace Expr
other = forall (m :: * -> *) a. Monad m => a -> m a
return Expr
other

stripPositioned :: Binder -> Binder
stripPositioned :: Binder -> Binder
stripPositioned (PositionedBinder SourceSpan
_ [Comment]
_ Binder
binder) = Binder -> Binder
stripPositioned Binder
binder
stripPositioned Binder
binder = Binder
binder

-- |
-- Replace all top-level binders with case expressions.
--
desugarCases :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]
desugarCases :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarCases = [Declaration] -> m [Declaration]
desugarRest forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
toDecls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Declaration -> Declaration -> Bool
inSameGroup
  where
    desugarRest :: [Declaration] -> m [Declaration]
    desugarRest :: [Declaration] -> m [Declaration]
desugarRest (TypeInstanceDeclaration SourceAnn
sa SourceAnn
na ChainId
cd Integer
idx Either Text Ident
name [SourceConstraint]
constraints Qualified (ProperName 'ClassName)
className [SourceType]
tys TypeInstanceBody
ds : [Declaration]
rest) =
      (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceAnn
-> SourceAnn
-> ChainId
-> Integer
-> Either Text Ident
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> TypeInstanceBody
-> Declaration
TypeInstanceDeclaration SourceAnn
sa SourceAnn
na ChainId
cd Integer
idx Either Text Ident
name [SourceConstraint]
constraints Qualified (ProperName 'ClassName)
className [SourceType]
tys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *).
Applicative f =>
([Declaration] -> f [Declaration])
-> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarCases TypeInstanceBody
ds) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Declaration] -> m [Declaration]
desugarRest [Declaration]
rest
    desugarRest (ValueDecl SourceAnn
sa Ident
name NameKind
nameKind [Binder]
bs [GuardedExpr]
result : [Declaration]
rest) =
      let (Declaration -> m Declaration
_, Expr -> m Expr
f, 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 forall {f :: * -> *}.
(MonadSupply f, MonadError MultipleErrors f) =>
Expr -> f Expr
go forall (m :: * -> *) a. Monad m => a -> m a
return
          f' :: [GuardedExpr] -> m [GuardedExpr]
f' = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(GuardedExpr [Guard]
gs Expr
e) -> [Guard] -> Expr -> GuardedExpr
GuardedExpr [Guard]
gs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
f Expr
e)
      in (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
name NameKind
nameKind [Binder]
bs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardedExpr] -> m [GuardedExpr]
f' [GuardedExpr]
result) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Declaration] -> m [Declaration]
desugarRest [Declaration]
rest
      where
      go :: Expr -> f Expr
go (Let WhereProvenance
w [Declaration]
ds Expr
val') = WhereProvenance -> [Declaration] -> Expr -> Expr
Let WhereProvenance
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarCases [Declaration]
ds forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
val'
      go Expr
other = forall (m :: * -> *) a. Monad m => a -> m a
return Expr
other
    desugarRest (Declaration
d : [Declaration]
ds) = (:) Declaration
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Declaration] -> m [Declaration]
desugarRest [Declaration]
ds
    desugarRest [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

inSameGroup :: Declaration -> Declaration -> Bool
inSameGroup :: Declaration -> Declaration -> Bool
inSameGroup (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd1) (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd2) = forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd1 forall a. Eq a => a -> a -> Bool
== forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd2
inSameGroup Declaration
_ Declaration
_ = Bool
False

toDecls :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]
toDecls :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
toDecls [ValueDecl sa :: SourceAnn
sa@(SourceSpan
ss, [Comment]
_) Ident
ident NameKind
nameKind [Binder]
bs [MkUnguarded Expr
val]] | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Binder -> Bool
isIrrefutable [Binder]
bs = do
  [Ident]
args <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binder -> m Ident
fromVarBinder [Binder]
bs
  let body :: Expr
body = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Binder -> Expr -> Expr
Abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss) Expr
val [Ident]
args
  forall e (m :: * -> *). MonadError e m => e -> Bool -> m ()
guardWith (SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss (Maybe Ident -> SimpleErrorMessage
OverlappingArgNames (forall a. a -> Maybe a
Just Ident
ident))) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => [a] -> [a]
ordNub [Ident]
args) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
args
  forall (m :: * -> *) a. Monad m => a -> m a
return [SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
ident NameKind
nameKind [] [Expr -> GuardedExpr
MkUnguarded Expr
body]]
  where
  fromVarBinder :: Binder -> m Ident
  fromVarBinder :: Binder -> m Ident
fromVarBinder Binder
NullBinder = forall (m :: * -> *). MonadSupply m => m Ident
freshIdent'
  fromVarBinder (VarBinder SourceSpan
_ Ident
name) = forall (m :: * -> *) a. Monad m => a -> m a
return Ident
name
  fromVarBinder (PositionedBinder SourceSpan
_ [Comment]
_ Binder
b) = Binder -> m Ident
fromVarBinder Binder
b
  fromVarBinder (TypedBinder SourceType
_ Binder
b) = Binder -> m Ident
fromVarBinder Binder
b
  fromVarBinder Binder
_ = forall a. HasCallStack => String -> a
internalError String
"fromVarBinder: Invalid argument"
toDecls ds :: [Declaration]
ds@(ValueDecl (SourceSpan
ss, [Comment]
_) Ident
ident NameKind
_ [Binder]
bs (GuardedExpr
result : [GuardedExpr]
_) : [Declaration]
_) = do
  let tuples :: [([Binder], [GuardedExpr])]
tuples = forall a b. (a -> b) -> [a] -> [b]
map Declaration -> ([Binder], [GuardedExpr])
toTuple [Declaration]
ds

      isGuarded :: GuardedExpr -> Bool
isGuarded (MkUnguarded Expr
_) = Bool
False
      isGuarded GuardedExpr
_               = Bool
True

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [Binder]
bs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Binder], [GuardedExpr])]
tuples) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    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 a b. (a -> b) -> a -> b
$ Ident -> SimpleErrorMessage
ArgListLengthsDiffer Ident
ident
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Binder]
bs) Bool -> Bool -> Bool
|| GuardedExpr -> Bool
isGuarded GuardedExpr
result) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    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 a b. (a -> b) -> a -> b
$ Ident -> SimpleErrorMessage
DuplicateValueDeclaration Ident
ident
  Declaration
caseDecl <- forall (m :: * -> *).
MonadSupply m =>
SourceSpan -> Ident -> [([Binder], [GuardedExpr])] -> m Declaration
makeCaseDeclaration SourceSpan
ss Ident
ident [([Binder], [GuardedExpr])]
tuples
  forall (m :: * -> *) a. Monad m => a -> m a
return [Declaration
caseDecl]
toDecls [Declaration]
ds = forall (m :: * -> *) a. Monad m => a -> m a
return [Declaration]
ds

toTuple :: Declaration -> ([Binder], [GuardedExpr])
toTuple :: Declaration -> ([Binder], [GuardedExpr])
toTuple (ValueDecl SourceAnn
_ Ident
_ NameKind
_ [Binder]
bs [GuardedExpr]
result) = ([Binder]
bs, [GuardedExpr]
result)
toTuple Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Not a value declaration"

makeCaseDeclaration :: forall m. (MonadSupply m) => SourceSpan -> Ident -> [([Binder], [GuardedExpr])] -> m Declaration
makeCaseDeclaration :: forall (m :: * -> *).
MonadSupply m =>
SourceSpan -> Ident -> [([Binder], [GuardedExpr])] -> m Declaration
makeCaseDeclaration SourceSpan
ss Ident
ident [([Binder], [GuardedExpr])]
alternatives = do
  let namedArgs :: [[Maybe (SourceSpan, Ident)]]
namedArgs = forall a b. (a -> b) -> [a] -> [b]
map Binder -> Maybe (SourceSpan, Ident)
findName 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
<$> [([Binder], [GuardedExpr])]
alternatives
      argNames :: [Maybe (SourceSpan, Ident)]
argNames = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 [Maybe (SourceSpan, Ident)]
-> [Maybe (SourceSpan, Ident)] -> [Maybe (SourceSpan, Ident)]
resolveNames [[Maybe (SourceSpan, Ident)]]
namedArgs
  [(SourceSpan, Ident)]
args <- if forall a. Ord a => [a] -> Bool
allUnique (forall a. [Maybe a] -> [a]
catMaybes [Maybe (SourceSpan, Ident)]
argNames)
            then forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe (SourceSpan, Ident) -> m (SourceSpan, Ident)
argName [Maybe (SourceSpan, Ident)]
argNames
            else forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe (SourceSpan, Ident)]
argNames) ((SourceSpan
nullSourceSpan, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadSupply m => m Ident
freshIdent')
  let vars :: [Expr]
vars = forall a b. (a -> b) -> [a] -> [b]
map (SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SourceSpan, Ident)]
args
      binders :: [CaseAlternative]
binders = [ [Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder]
bs [GuardedExpr]
result | ([Binder]
bs, [GuardedExpr]
result) <- [([Binder], [GuardedExpr])]
alternatives ]
  let value :: Expr
value = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Binder -> Expr -> Expr
Abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> Ident -> Binder
VarBinder) ([Expr] -> [CaseAlternative] -> Expr
Case [Expr]
vars [CaseAlternative]
binders) [(SourceSpan, Ident)]
args

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl (SourceSpan
ss, []) Ident
ident NameKind
Public [] [Expr -> GuardedExpr
MkUnguarded Expr
value]
  where
  -- We will construct a table of potential names.
  -- VarBinders will become Just _ which is a potential name.
  -- Everything else becomes Nothing, which indicates that we
  -- have to generate a name.
  findName :: Binder -> Maybe (SourceSpan, Ident)
  findName :: Binder -> Maybe (SourceSpan, Ident)
findName (VarBinder SourceSpan
ss' Ident
name) = forall a. a -> Maybe a
Just (SourceSpan
ss', Ident
name)
  findName (PositionedBinder SourceSpan
_ [Comment]
_ Binder
binder) = Binder -> Maybe (SourceSpan, Ident)
findName Binder
binder
  findName Binder
_ = forall a. Maybe a
Nothing

  -- We still have to make sure the generated names are unique, or else
  -- we will end up constructing an invalid function.
  allUnique :: (Ord a) => [a] -> Bool
  allUnique :: forall a. Ord a => [a] -> Bool
allUnique [a]
xs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => [a] -> [a]
ordNub [a]
xs)

  argName :: Maybe (SourceSpan, Ident) -> m (SourceSpan, Ident)
  argName :: Maybe (SourceSpan, Ident) -> m (SourceSpan, Ident)
argName (Just (SourceSpan
ss', Ident
name)) = forall (m :: * -> *) a. Monad m => a -> m a
return (SourceSpan
ss', Ident
name)
  argName Maybe (SourceSpan, Ident)
_ = (SourceSpan
nullSourceSpan, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadSupply m => m Ident
freshIdent'

  -- Combine two lists of potential names from two case alternatives
  -- by zipping corresponding columns.
  resolveNames :: [Maybe (SourceSpan, Ident)] -> [Maybe (SourceSpan, Ident)] -> [Maybe (SourceSpan, Ident)]
  resolveNames :: [Maybe (SourceSpan, Ident)]
-> [Maybe (SourceSpan, Ident)] -> [Maybe (SourceSpan, Ident)]
resolveNames = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe (SourceSpan, Ident)
-> Maybe (SourceSpan, Ident) -> Maybe (SourceSpan, Ident)
resolveName

  -- Resolve a pair of names. VarBinder beats NullBinder, and everything
  -- else results in Nothing.
  resolveName :: Maybe (SourceSpan, Ident) -> Maybe (SourceSpan, Ident) -> Maybe (SourceSpan, Ident)
  resolveName :: Maybe (SourceSpan, Ident)
-> Maybe (SourceSpan, Ident) -> Maybe (SourceSpan, Ident)
resolveName (Just (SourceSpan, Ident)
a) (Just (SourceSpan, Ident)
b)
    | (SourceSpan, Ident)
a forall a. Eq a => a -> a -> Bool
== (SourceSpan, Ident)
b = forall a. a -> Maybe a
Just (SourceSpan, Ident)
a
    | Bool
otherwise = forall a. Maybe a
Nothing
  resolveName Maybe (SourceSpan, Ident)
_ Maybe (SourceSpan, Ident)
_ = forall a. Maybe a
Nothing