{-# LANGUAGE DeriveAnyClass #-}
-- |
-- Case binders
--
module Language.PureScript.AST.Binders where

import Prelude

import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
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, forall x. Rep Binder x -> Binder
forall x. Binder -> Rep Binder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Binder x -> Binder
$cfrom :: forall x. Binder -> Rep Binder x
Generic, Binder -> ()
forall a. (a -> ()) -> NFData a
rnf :: Binder -> ()
$crnf :: Binder -> ()
NFData)

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