69 lines
1.9 KiB
Haskell
69 lines
1.9 KiB
Haskell
{-# OPTIONS_GHC -Wall #-}
|
|
module SourceSyntax.Pattern where
|
|
|
|
import qualified SourceSyntax.Helpers as Help
|
|
import SourceSyntax.PrettyPrint
|
|
import Text.PrettyPrint as PP
|
|
import qualified Data.Set as Set
|
|
import SourceSyntax.Literal as Literal
|
|
|
|
data Pattern
|
|
= Data String [Pattern]
|
|
| Record [String]
|
|
| Alias String Pattern
|
|
| Var String
|
|
| Anything
|
|
| Literal Literal.Literal
|
|
deriving (Eq, Ord, Show)
|
|
|
|
cons :: Pattern -> Pattern -> Pattern
|
|
cons h t = Data "::" [h,t]
|
|
|
|
nil :: Pattern
|
|
nil = Data "[]" []
|
|
|
|
list :: [Pattern] -> Pattern
|
|
list = foldr cons nil
|
|
|
|
tuple :: [Pattern] -> Pattern
|
|
tuple es = Data ("_Tuple" ++ show (length es)) es
|
|
|
|
boundVarList :: Pattern -> [String]
|
|
boundVarList = Set.toList . boundVars
|
|
|
|
boundVars :: Pattern -> Set.Set String
|
|
boundVars pattern =
|
|
case pattern of
|
|
Var x -> Set.singleton x
|
|
Alias x p -> Set.insert x (boundVars p)
|
|
Data _ ps -> Set.unions (map boundVars ps)
|
|
Record fields -> Set.fromList fields
|
|
Anything -> Set.empty
|
|
Literal _ -> Set.empty
|
|
|
|
|
|
instance Pretty Pattern where
|
|
pretty pattern =
|
|
case pattern of
|
|
Var x -> variable x
|
|
Literal lit -> pretty lit
|
|
Record fs -> PP.braces (commaCat $ map variable fs)
|
|
Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
|
|
Anything -> PP.text "_"
|
|
Data "::" [hd,tl] -> parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
|
|
where isCons = case hd of
|
|
Data "::" _ -> True
|
|
_ -> False
|
|
Data name ps ->
|
|
if Help.isTuple name then
|
|
PP.parens . commaCat $ map pretty ps
|
|
else hsep (PP.text name : map prettyParens ps)
|
|
|
|
prettyParens :: Pattern -> Doc
|
|
prettyParens pattern = parensIf needsThem (pretty pattern)
|
|
where
|
|
needsThem =
|
|
case pattern of
|
|
Data name (_:_) | not (Help.isTuple name) -> True
|
|
Alias _ _ -> True
|
|
_ -> False
|