-- |
-- 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

import Language.PureScript.AST
import Language.PureScript.Crash
import Language.PureScript.Environment
import Language.PureScript.Errors
import Language.PureScript.Names
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