-- |
-- Case binders
--
module Language.PureScript.AST.Binders where

import Prelude

import Language.PureScript.AST.SourcePos (SourceSpan)
import Language.PureScript.AST.Literals (Literal(..))
import Language.PureScript.Names (Ident, OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified)
import Language.PureScript.Comments (Comment)
import Language.PureScript.Types (SourceType)

-- |
-- Data type for binders
--
data Binder
  -- |
  -- Wildcard binder
  --
  = NullBinder
  -- |
  -- A binder which matches a literal
  --
  | LiteralBinder SourceSpan (Literal Binder)
  -- |
  -- A binder which binds an identifier
  --
  | VarBinder SourceSpan Ident
  -- |
  -- A binder which matches a data constructor
  --
  | ConstructorBinder SourceSpan (Qualified (ProperName 'ConstructorName)) [Binder]
  -- |
  -- A operator alias binder. During the rebracketing phase of desugaring,
  -- this data constructor will be removed.
  --
  | OpBinder SourceSpan (Qualified (OpName 'ValueOpName))
  -- |
  -- Binary operator application. During the rebracketing phase of desugaring,
  -- this data constructor will be removed.
  --
  | BinaryNoParensBinder Binder Binder Binder
  -- |
  -- Explicit parentheses. During the rebracketing phase of desugaring, this
  -- data constructor will be removed.
  --
  -- Note: although it seems this constructor is not used, it _is_ useful,
  -- since it prevents certain traversals from matching.
  --
  | ParensInBinder Binder
  -- |
  -- A binder which binds its input to an identifier
  --
  | NamedBinder SourceSpan Ident Binder
  -- |
  -- A binder with source position information
  --
  | PositionedBinder SourceSpan [Comment] Binder
  -- |
  -- A binder with a type annotation
  --
  | TypedBinder SourceType Binder
  deriving (Int -> Binder -> ShowS
[Binder] -> ShowS
Binder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binder] -> ShowS
$cshowList :: [Binder] -> ShowS
show :: Binder -> String
$cshow :: Binder -> String
showsPrec :: Int -> Binder -> ShowS
$cshowsPrec :: Int -> Binder -> ShowS
Show)

-- Manual Eq and Ord instances for `Binder` were added on 2018-03-05. Comparing
-- the `SourceSpan` values embedded in some of the data constructors of `Binder`
-- was expensive. This made exhaustiveness checking observably slow for code
-- such as the `explode` function in `test/purs/passing/LargeSumTypes.purs`.
-- Custom instances were written to skip comparing the `SourceSpan` values. Only
-- the `Ord` instance was needed for the speed-up, but I did not want the `Eq`
-- to have mismatched behavior.
instance Eq Binder where
  Binder
NullBinder == :: Binder -> Binder -> Bool
== Binder
NullBinder =
    Bool
True
  (LiteralBinder SourceSpan
_ Literal Binder
lb) == (LiteralBinder SourceSpan
_ Literal Binder
lb') =
    Literal Binder
lb forall a. Eq a => a -> a -> Bool
== Literal Binder
lb'
  (VarBinder SourceSpan
_ Ident
ident) == (VarBinder SourceSpan
_ Ident
ident') =
    Ident
ident forall a. Eq a => a -> a -> Bool
== Ident
ident'
  (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
qpc [Binder]
bs) == (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
qpc' [Binder]
bs') =
    Qualified (ProperName 'ConstructorName)
qpc forall a. Eq a => a -> a -> Bool
== Qualified (ProperName 'ConstructorName)
qpc' Bool -> Bool -> Bool
&& [Binder]
bs forall a. Eq a => a -> a -> Bool
== [Binder]
bs'
  (OpBinder SourceSpan
_ Qualified (OpName 'ValueOpName)
qov) == (OpBinder SourceSpan
_ Qualified (OpName 'ValueOpName)
qov') =
    Qualified (OpName 'ValueOpName)
qov forall a. Eq a => a -> a -> Bool
== Qualified (OpName 'ValueOpName)
qov'
  (BinaryNoParensBinder Binder
b1 Binder
b2 Binder
b3) == (BinaryNoParensBinder Binder
b1' Binder
b2' Binder
b3') =
    Binder
b1 forall a. Eq a => a -> a -> Bool
== Binder
b1' Bool -> Bool -> Bool
&& Binder
b2 forall a. Eq a => a -> a -> Bool
== Binder
b2' Bool -> Bool -> Bool
&& Binder
b3 forall a. Eq a => a -> a -> Bool
== Binder
b3'
  (ParensInBinder Binder
b) == (ParensInBinder Binder
b') =
    Binder
b forall a. Eq a => a -> a -> Bool
== Binder
b'
  (NamedBinder SourceSpan
_ Ident
ident Binder
b) == (NamedBinder SourceSpan
_ Ident
ident' Binder
b') =
    Ident
ident forall a. Eq a => a -> a -> Bool
== Ident
ident' Bool -> Bool -> Bool
&& Binder
b forall a. Eq a => a -> a -> Bool
== Binder
b'
  (PositionedBinder SourceSpan
_ [Comment]
comments Binder
b) == (PositionedBinder SourceSpan
_ [Comment]
comments' Binder
b') =
    [Comment]
comments forall a. Eq a => a -> a -> Bool
== [Comment]
comments' Bool -> Bool -> Bool
&& Binder
b forall a. Eq a => a -> a -> Bool
== Binder
b'
  (TypedBinder SourceType
ty Binder
b) == (TypedBinder SourceType
ty' Binder
b') =
    SourceType
ty forall a. Eq a => a -> a -> Bool
== SourceType
ty' Bool -> Bool -> Bool
&& Binder
b forall a. Eq a => a -> a -> Bool
== Binder
b'
  Binder
_ == Binder
_ = Bool
False

instance Ord Binder where
  compare :: Binder -> Binder -> Ordering
compare Binder
NullBinder Binder
NullBinder = Ordering
EQ
  compare (LiteralBinder SourceSpan
_ Literal Binder
lb) (LiteralBinder SourceSpan
_ Literal Binder
lb') =
    forall a. Ord a => a -> a -> Ordering
compare Literal Binder
lb Literal Binder
lb'
  compare (VarBinder SourceSpan
_ Ident
ident) (VarBinder SourceSpan
_ Ident
ident') =
    forall a. Ord a => a -> a -> Ordering
compare Ident
ident Ident
ident'
  compare (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
qpc [Binder]
bs) (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
qpc' [Binder]
bs') =
    forall a. Ord a => a -> a -> Ordering
compare Qualified (ProperName 'ConstructorName)
qpc Qualified (ProperName 'ConstructorName)
qpc' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare [Binder]
bs [Binder]
bs'
  compare (OpBinder SourceSpan
_ Qualified (OpName 'ValueOpName)
qov) (OpBinder SourceSpan
_ Qualified (OpName 'ValueOpName)
qov') =
    forall a. Ord a => a -> a -> Ordering
compare Qualified (OpName 'ValueOpName)
qov Qualified (OpName 'ValueOpName)
qov'
  compare (BinaryNoParensBinder Binder
b1 Binder
b2 Binder
b3) (BinaryNoParensBinder Binder
b1' Binder
b2' Binder
b3') =
    forall a. Ord a => a -> a -> Ordering
compare Binder
b1 Binder
b1' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Binder
b2 Binder
b2' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Binder
b3 Binder
b3'
  compare (ParensInBinder Binder
b) (ParensInBinder Binder
b') =
    forall a. Ord a => a -> a -> Ordering
compare Binder
b Binder
b'
  compare (NamedBinder SourceSpan
_ Ident
ident Binder
b) (NamedBinder SourceSpan
_ Ident
ident' Binder
b') =
    forall a. Ord a => a -> a -> Ordering
compare Ident
ident Ident
ident' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Binder
b Binder
b'
  compare (PositionedBinder SourceSpan
_ [Comment]
comments Binder
b) (PositionedBinder SourceSpan
_ [Comment]
comments' Binder
b') =
    forall a. Ord a => a -> a -> Ordering
compare [Comment]
comments [Comment]
comments' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Binder
b Binder
b'
  compare (TypedBinder SourceType
ty Binder
b) (TypedBinder SourceType
ty' Binder
b') =
    forall a. Ord a => a -> a -> Ordering
compare SourceType
ty SourceType
ty' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Binder
b Binder
b'
  compare Binder
binder Binder
binder' =
    forall a. Ord a => a -> a -> Ordering
compare (Binder -> Int
orderOf Binder
binder) (Binder -> Int
orderOf Binder
binder')
      where
        orderOf :: Binder -> Int
        orderOf :: Binder -> Int
orderOf Binder
NullBinder = Int
0
        orderOf LiteralBinder{} = Int
1
        orderOf VarBinder{} = Int
2
        orderOf ConstructorBinder{} = Int
3
        orderOf OpBinder{} = Int
4
        orderOf BinaryNoParensBinder{} = Int
5
        orderOf ParensInBinder{} = Int
6
        orderOf NamedBinder{} = Int
7
        orderOf PositionedBinder{} = Int
8
        orderOf TypedBinder{} = Int
9

-- |
-- Collect all names introduced in binders in an expression
--
binderNames :: Binder -> [Ident]
binderNames :: Binder -> [Ident]
binderNames = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans

binderNamesWithSpans :: Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans :: Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans = [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go []
  where
  go :: [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns (LiteralBinder SourceSpan
_ Literal Binder
b) = [(SourceSpan, Ident)] -> Literal Binder -> [(SourceSpan, Ident)]
lit [(SourceSpan, Ident)]
ns Literal Binder
b
  go [(SourceSpan, Ident)]
ns (VarBinder SourceSpan
ss Ident
name) = (SourceSpan
ss, Ident
name) forall a. a -> [a] -> [a]
: [(SourceSpan, Ident)]
ns
  go [(SourceSpan, Ident)]
ns (ConstructorBinder SourceSpan
_ Qualified (ProperName 'ConstructorName)
_ [Binder]
bs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns [Binder]
bs
  go [(SourceSpan, Ident)]
ns (BinaryNoParensBinder Binder
b1 Binder
b2 Binder
b3) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns [Binder
b1, Binder
b2, Binder
b3]
  go [(SourceSpan, Ident)]
ns (ParensInBinder Binder
b) = [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns Binder
b
  go [(SourceSpan, Ident)]
ns (NamedBinder SourceSpan
ss Ident
name Binder
b) = [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go ((SourceSpan
ss, Ident
name) forall a. a -> [a] -> [a]
: [(SourceSpan, Ident)]
ns) Binder
b
  go [(SourceSpan, Ident)]
ns (PositionedBinder SourceSpan
_ [Comment]
_ Binder
b) = [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns Binder
b
  go [(SourceSpan, Ident)]
ns (TypedBinder SourceType
_ Binder
b) = [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns Binder
b
  go [(SourceSpan, Ident)]
ns Binder
_ = [(SourceSpan, Ident)]
ns
  lit :: [(SourceSpan, Ident)] -> Literal Binder -> [(SourceSpan, Ident)]
lit [(SourceSpan, Ident)]
ns (ObjectLiteral [(PSString, Binder)]
bs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(PSString, Binder)]
bs)
  lit [(SourceSpan, Ident)]
ns (ArrayLiteral [Binder]
bs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(SourceSpan, Ident)] -> Binder -> [(SourceSpan, Ident)]
go [(SourceSpan, Ident)]
ns [Binder]
bs
  lit [(SourceSpan, Ident)]
ns Literal Binder
_ = [(SourceSpan, Ident)]
ns


isIrrefutable :: Binder -> Bool
isIrrefutable :: Binder -> Bool
isIrrefutable Binder
NullBinder = Bool
True
isIrrefutable (VarBinder SourceSpan
_ Ident
_) = Bool
True
isIrrefutable (PositionedBinder SourceSpan
_ [Comment]
_ Binder
b) = Binder -> Bool
isIrrefutable Binder
b
isIrrefutable (TypedBinder SourceType
_ Binder
b) = Binder -> Bool
isIrrefutable Binder
b
isIrrefutable Binder
_ = Bool
False