<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[PatSyntax]{Abstract Haskell syntax---patterns}

\begin{code}
#include "HsVersions.h"

module HsPat (
	InPat(..),
	OutPat(..),

	irrefutablePat, irrefutablePats,
	failureFreePat,
	patsAreAllCons, isConPat,
	patsAreAllLits,	isLitPat,
	collectPatBinders
    ) where

IMP_Ubiq()

-- friends:
-- IMPORT_DELOOPER(IdLoop)
import HsBasic		( HsLit )
import HsExpr		( HsExpr )
import BasicTypes	( Fixity )

-- others:
import Id		( SYN_IE(Id), dataConTyCon, GenId )
import Maybes		( maybeToBool )
import Outputable	( PprStyle(..), userStyle, interppSP, 
			  interpp'SP, ifPprShowAll, Outputable(..) 
			)
import Pretty
import TyCon		( maybeTyConSingleCon )
import PprType		( GenType )
import CmdLineOpts      ( opt_PprUserLength )
#if __GLASGOW_HASKELL__ >= 202
import Name
#endif
\end{code}

Patterns come in distinct before- and after-typechecking flavo(u)rs.
\begin{code}
data InPat name
  = WildPatIn				-- wild card
  | VarPatIn	    name		-- variable
  | LitPatIn	    HsLit		-- literal
  | LazyPatIn	    (InPat name)	-- lazy pattern
  | AsPatIn	    name		-- as pattern
		    (InPat name)
  | ConPatIn	    name		-- constructed type
		    [InPat name]
  | ConOpPatIn	    (InPat name)
		    name
		    Fixity		-- c.f. OpApp in HsExpr
		    (InPat name)

  | NPlusKPatIn	    name		--  n+k pattern
		    HsLit

  -- We preserve prefix negation and parenthesis for the precedence parser.

  | NegPatIn	    (InPat name)	-- negated pattern
  | ParPatIn        (InPat name)	-- parenthesised pattern

  | ListPatIn	    [InPat name]	-- syntactic list
					-- must have >= 1 elements
  | TuplePatIn	    [InPat name]	-- tuple

  | RecPatIn	    name 		-- record
		    [(name, InPat name, Bool)]	-- True <=> source used punning

data OutPat tyvar uvar id
  = WildPat	    (GenType tyvar uvar)	-- wild card

  | VarPat	    id				-- variable (type is in the Id)

  | LazyPat	    (OutPat tyvar uvar id)	-- lazy pattern

  | AsPat	    id				-- as pattern
		    (OutPat tyvar uvar id)

  | ConPat	    Id				-- Constructor is always an Id
		    (GenType tyvar uvar)    	-- the type of the pattern
		    [OutPat tyvar uvar id]

  | ConOpPat	    (OutPat tyvar uvar id)	-- just a special case...
		    Id
		    (OutPat tyvar uvar id)
		    (GenType tyvar uvar)
  | ListPat		 	    		-- syntactic list
		    (GenType tyvar uvar)	-- the type of the elements
   	    	    [OutPat tyvar uvar id]

  | TuplePat	    [OutPat tyvar uvar id]	-- tuple
						-- UnitPat is TuplePat []

  | RecPat	    Id 				-- record constructor
		    (GenType tyvar uvar)    	-- the type of the pattern
		    [(Id, OutPat tyvar uvar id, Bool)]	-- True <=> source used punning

  | LitPat	    -- Used for *non-overloaded* literal patterns:
		    -- Int#, Char#, Int, Char, String, etc.
		    HsLit
		    (GenType tyvar uvar) 	-- type of pattern

  | NPat	    -- Used for *overloaded* literal patterns
		    HsLit			-- the literal is retained so that
						-- the desugarer can readily identify
						-- equations with identical literal-patterns
		    (GenType tyvar uvar) 	-- type of pattern, t
   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id))
						-- of type t -> Bool; detects match

  | NPlusKPat	    id
		    HsLit			-- Same reason as for LitPat
						-- (This could be an Integer, but then
						-- it's harder to partitionEqnsByLit
						-- in the desugarer.)
		    (GenType tyvar uvar)    	-- Type of pattern, t
   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id)) 	-- Of type t -> Bool; detects match
   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id)) 	-- Of type t -> t; subtracts k

  | DictPat	    -- Used when destructing Dictionaries with an explicit case
		    [id]			-- superclass dicts
		    [id]			-- methods
\end{code}

\begin{code}
instance (Outputable name, NamedThing name) => Outputable (InPat name) where
    ppr = pprInPat

pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Doc

pprInPat sty (WildPatIn)	= char '_'
pprInPat sty (VarPatIn var)	= ppr sty var
pprInPat sty (LitPatIn s)	= ppr sty s
pprInPat sty (LazyPatIn pat)	= (<>) (char '~') (ppr sty pat)
pprInPat sty (AsPatIn name pat)
    = parens (hcat [ppr sty name, char '@', ppr sty pat])

pprInPat sty (ConPatIn c pats)
 = if null pats then
      ppr sty c<commit_msg>[project @ 1997-12-02 18:08:00 by quintela] Deleted NAmedThing Constraint of Outputable InPat<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[PatSyntax]{Abstract Haskell syntax---patterns}

\begin{code}
#include "HsVersions.h"

module HsPat (
	InPat(..),
	OutPat(..),

	irrefutablePat, irrefutablePats,
	failureFreePat,
	patsAreAllCons, isConPat,
	patsAreAllLits,	isLitPat,
	collectPatBinders
    ) where

IMP_Ubiq()

-- friends:
-- IMPORT_DELOOPER(IdLoop)
import HsBasic		( HsLit )
import HsExpr		( HsExpr )
import BasicTypes	( Fixity )

-- others:
import Id		( SYN_IE(Id), dataConTyCon, GenId )
import Maybes		( maybeToBool )
import Outputable	( PprStyle(..), userStyle, interppSP, 
			  interpp'SP, ifPprShowAll, Outputable(..) 
			)
import Pretty
import TyCon		( maybeTyConSingleCon )
import PprType		( GenType )
import CmdLineOpts      ( opt_PprUserLength )
#if __GLASGOW_HASKELL__ >= 202
import Name
#endif
\end{code}

Patterns come in distinct before- and after-typechecking flavo(u)rs.
\begin{code}
data InPat name
  = WildPatIn				-- wild card
  | VarPatIn	    name		-- variable
  | LitPatIn	    HsLit		-- literal
  | LazyPatIn	    (InPat name)	-- lazy pattern
  | AsPatIn	    name		-- as pattern
		    (InPat name)
  | ConPatIn	    name		-- constructed type
		    [InPat name]
  | ConOpPatIn	    (InPat name)
		    name
		    Fixity		-- c.f. OpApp in HsExpr
		    (InPat name)

  | NPlusKPatIn	    name		--  n+k pattern
		    HsLit

  -- We preserve prefix negation and parenthesis for the precedence parser.

  | NegPatIn	    (InPat name)	-- negated pattern
  | ParPatIn        (InPat name)	-- parenthesised pattern

  | ListPatIn	    [InPat name]	-- syntactic list
					-- must have >= 1 elements
  | TuplePatIn	    [InPat name]	-- tuple

  | RecPatIn	    name 		-- record
		    [(name, InPat name, Bool)]	-- True <=> source used punning

data OutPat tyvar uvar id
  = WildPat	    (GenType tyvar uvar)	-- wild card

  | VarPat	    id				-- variable (type is in the Id)

  | LazyPat	    (OutPat tyvar uvar id)	-- lazy pattern

  | AsPat	    id				-- as pattern
		    (OutPat tyvar uvar id)

  | ConPat	    Id				-- Constructor is always an Id
		    (GenType tyvar uvar)    	-- the type of the pattern
		    [OutPat tyvar uvar id]

  | ConOpPat	    (OutPat tyvar uvar id)	-- just a special case...
		    Id
		    (OutPat tyvar uvar id)
		    (GenType tyvar uvar)
  | ListPat		 	    		-- syntactic list
		    (GenType tyvar uvar)	-- the type of the elements
   	    	    [OutPat tyvar uvar id]

  | TuplePat	    [OutPat tyvar uvar id]	-- tuple
						-- UnitPat is TuplePat []

  | RecPat	    Id 				-- record constructor
		    (GenType tyvar uvar)    	-- the type of the pattern
		    [(Id, OutPat tyvar uvar id, Bool)]	-- True <=> source used punning

  | LitPat	    -- Used for *non-overloaded* literal patterns:
		    -- Int#, Char#, Int, Char, String, etc.
		    HsLit
		    (GenType tyvar uvar) 	-- type of pattern

  | NPat	    -- Used for *overloaded* literal patterns
		    HsLit			-- the literal is retained so that
						-- the desugarer can readily identify
						-- equations with identical literal-patterns
		    (GenType tyvar uvar) 	-- type of pattern, t
   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id))
						-- of type t -> Bool; detects match

  | NPlusKPat	    id
		    HsLit			-- Same reason as for LitPat
						-- (This could be an Integer, but then
						-- it's harder to partitionEqnsByLit
						-- in the desugarer.)
		    (GenType tyvar uvar)    	-- Type of pattern, t
   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id)) 	-- Of type t -> Bool; detects match
   	    	    (HsExpr tyvar uvar id (OutPat tyvar uvar id)) 	-- Of type t -> t; subtracts k

  | DictPat	    -- Used when destructing Dictionaries with an explicit case
		    [id]			-- superclass dicts
		    [id]			-- methods
\end{code}

Now name in Inpat is not need to be in NAmedThing to be Outputable.
Needed by ../deSugar/Check.lhs

JJQC-2-12-97

\begin{code}
instance (Outputable name) => Outputable (InPat name) where
    ppr = pprInPat

pprInPat :: (Outputable name) => PprStyle -> InPat name -> Doc

pprInPat sty (WildPatIn)	= char '_'
pprInPat sty (VarPatIn var)	= ppr sty var
pprInPat sty (LitPatIn s)	= ppr sty s
pprInPat sty (LazyPatIn pat)	= (<>) (char '~') (ppr sty pat)
pprInPat sty (AsPatIn name pat)
    = parens (hcat [ppr sty name, char '@', ppr sty pat])

pprInPat sty (ConPatIn c pats)
 = if null pats then
      ppr sty c
{'fraction_non_alphanumeric': 0.09771026978009521, 'fraction_numerical': 0.00487417819088642, 'mean_word_length': 2.3560289083301638, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 27, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2201362', 'n_tokens_mistral': 3513, 'n_tokens_neox': 3141, 'n_words': 1013}