2013-06-14 01:00:24 +00:00
|
|
|
module SourceSyntax.Pattern where
|
|
|
|
|
|
|
|
import Data.List (intercalate)
|
2013-07-23 13:43:21 +00:00
|
|
|
import SourceSyntax.Helpers as Help
|
2013-07-07 10:56:34 +00:00
|
|
|
import SourceSyntax.PrettyPrint
|
|
|
|
import Text.PrettyPrint as PP
|
2014-01-03 07:23:11 +00:00
|
|
|
import qualified Data.Set as Set
|
2013-07-07 10:56:34 +00:00
|
|
|
import SourceSyntax.Literal as Literal
|
2013-06-14 01:00:24 +00:00
|
|
|
|
|
|
|
data Pattern = PData String [Pattern]
|
|
|
|
| PRecord [String]
|
|
|
|
| PAlias String Pattern
|
|
|
|
| PVar String
|
|
|
|
| PAnything
|
|
|
|
| PLiteral Literal.Literal
|
2013-12-21 00:41:02 +00:00
|
|
|
deriving (Eq, Ord, Show)
|
2013-06-14 01:00:24 +00:00
|
|
|
|
2013-06-21 04:25:10 +00:00
|
|
|
cons h t = PData "::" [h,t]
|
|
|
|
nil = PData "[]" []
|
2013-06-14 01:00:24 +00:00
|
|
|
list = foldr cons nil
|
2013-07-14 17:52:50 +00:00
|
|
|
tuple es = PData ("_Tuple" ++ show (length es)) es
|
2013-06-14 01:00:24 +00:00
|
|
|
|
2014-01-03 07:23:11 +00:00
|
|
|
boundVars :: Pattern -> Set.Set String
|
|
|
|
boundVars pattern =
|
|
|
|
case pattern of
|
|
|
|
PVar x -> Set.singleton x
|
|
|
|
PAlias x p -> Set.insert x (boundVars p)
|
|
|
|
PData _ ps -> Set.unions (map boundVars ps)
|
|
|
|
PRecord fields -> Set.fromList fields
|
|
|
|
PAnything -> Set.empty
|
|
|
|
PLiteral _ -> Set.empty
|
|
|
|
|
2013-06-14 01:00:24 +00:00
|
|
|
|
2013-07-07 10:56:34 +00:00
|
|
|
instance Pretty Pattern where
|
|
|
|
pretty pattern =
|
|
|
|
case pattern of
|
2013-07-23 13:43:21 +00:00
|
|
|
PVar x -> variable x
|
2013-07-07 10:56:34 +00:00
|
|
|
PLiteral lit -> pretty lit
|
2013-08-14 07:44:29 +00:00
|
|
|
PRecord fs -> PP.braces (commaCat $ map variable fs)
|
|
|
|
PAlias x p -> prettyParens p <+> PP.text "as" <+> variable x
|
2013-07-07 10:56:34 +00:00
|
|
|
PAnything -> PP.text "_"
|
|
|
|
PData "::" [hd,tl] -> parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
|
|
|
|
where isCons = case hd of
|
|
|
|
PData "::" _ -> True
|
|
|
|
_ -> False
|
2013-06-14 01:00:24 +00:00
|
|
|
PData name ps ->
|
2013-07-07 10:56:34 +00:00
|
|
|
if isTuple name then
|
|
|
|
PP.parens . commaCat $ map pretty ps
|
2013-12-30 02:19:21 +00:00
|
|
|
else hsep (PP.text name : map prettyParens ps)
|
2013-07-07 10:56:34 +00:00
|
|
|
|
|
|
|
prettyParens pattern = parensIf needsThem (pretty pattern)
|
|
|
|
where
|
|
|
|
needsThem =
|
|
|
|
case pattern of
|
|
|
|
PData name (_:_) | not (isTuple name) -> True
|
|
|
|
PAlias _ _ -> True
|
2013-12-30 02:19:21 +00:00
|
|
|
_ -> False
|