git.iko.soy/elk
on 5111919 help sign in
elk/src/AST/Pattern.hs
109 lines 2.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Pattern where
4import qualified AST.Helpers as Help
5import AST.PrettyPrint
6import Text.PrettyPrint as PP
7import qualified Data.Set as Set
9import qualified AST.Variable as Var
10import AST.Literal as Literal
13data Pattern var
14 = Data var [Pattern var]
15 | Record [String]
16 | Alias String (Pattern var)
17 | Var String
18 | Anything
19 | Literal Literal.Literal
20 deriving (Eq, Ord, Show)
23type RawPattern =
24 Pattern Var.Raw
27type CanonicalPattern =
28 Pattern Var.Canonical
31cons :: RawPattern -> RawPattern -> RawPattern
32cons h t =
33 Data (Var.Raw "::") [h,t]
36nil :: RawPattern
37nil =
38 Data (Var.Raw "[]") []
41list :: [RawPattern] -> RawPattern
42list patterns =
43 foldr cons nil patterns
46tuple :: [RawPattern] -> RawPattern
47tuple patterns =
48 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
51boundVarList :: Pattern var -> [String]
52boundVarList pattern =
53 Set.toList (boundVars pattern)
56boundVars :: Pattern var -> Set.Set String
57boundVars pattern =
58 case pattern of
59 Var x -> Set.singleton x
60 Alias x p -> Set.insert x (boundVars p)
61 Data _ ps -> Set.unions (map boundVars ps)
62 Record fields -> Set.fromList fields
63 Anything -> Set.empty
64 Literal _ -> Set.empty
67instance Var.ToString var => Pretty (Pattern var) where
68 pretty pattern =
69 case pattern of
70 Var x ->
71 variable x
73 Literal literal ->
74 pretty literal
76 Record fields ->
77 PP.braces (commaCat (map variable fields))
79 Alias x p ->
80 prettyParens p <+> PP.text "as" <+> variable x
82 Anything ->
83 PP.text "_"
85 Data name [hd,tl] | Var.toString name == "::" ->
86 parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
87 where
88 isCons =
89 case hd of
90 Data ctor _ -> Var.toString ctor == "::"
91 _ -> False
93 Data name ps ->
94 let name' = Var.toString name
95 in
96 if Help.isTuple name'
97 then PP.parens (commaCat (map pretty ps))
98 else hsep (PP.text name' : map prettyParens ps)
101prettyParens :: Var.ToString var => Pattern var -> Doc
102prettyParens pattern =
103 parensIf needsThem (pretty pattern)
104 where
105 needsThem =
106 case pattern of
107 Data name (_:_) | not (Help.isTuple (Var.toString name)) -> True
108 Alias _ _ -> True
109 _ -> False