on cca69cf help sign in
65 lines 1.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.Pattern where
4import SourceSyntax.Helpers as Help
5import SourceSyntax.PrettyPrint
6import Text.PrettyPrint as PP
7import qualified Data.Set as Set
8import SourceSyntax.Literal as Literal
10data Pattern = PData String [Pattern]
11 | PRecord [String]
12 | PAlias String Pattern
13 | PVar String
14 | PAnything
15 | PLiteral Literal.Literal
16 deriving (Eq, Ord, Show)
18cons :: Pattern -> Pattern -> Pattern
19cons h t = PData "::" [h,t]
21nil :: Pattern
22nil = PData "[]" []
24list :: [Pattern] -> Pattern
25list = foldr cons nil
27tuple :: [Pattern] -> Pattern
28tuple es = PData ("_Tuple" ++ show (length es)) es
30boundVars :: Pattern -> Set.Set String
31boundVars pattern =
32 case pattern of
33 PVar x -> Set.singleton x
34 PAlias x p -> Set.insert x (boundVars p)
35 PData _ ps -> Set.unions (map boundVars ps)
36 PRecord fields -> Set.fromList fields
37 PAnything -> Set.empty
38 PLiteral _ -> Set.empty
41instance Pretty Pattern where
42 pretty pattern =
43 case pattern of
44 PVar x -> variable x
45 PLiteral lit -> pretty lit
46 PRecord fs -> PP.braces (commaCat $ map variable fs)
47 PAlias x p -> prettyParens p <+> PP.text "as" <+> variable x
48 PAnything -> PP.text "_"
49 PData "::" [hd,tl] -> parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
50 where isCons = case hd of
51 PData "::" _ -> True
52 _ -> False
53 PData name ps ->
54 if isTuple name then
55 PP.parens . commaCat $ map pretty ps
56 else hsep (PP.text name : map prettyParens ps)
58prettyParens :: Pattern -> Doc
59prettyParens pattern = parensIf needsThem (pretty pattern)
60 where
61 needsThem =
62 case pattern of
63 PData name (_:_) | not (isTuple name) -> True
64 PAlias _ _ -> True
65 _ -> False