git.iko.soy/elk
on 2297bbf help sign in
elk/src/AST/Pattern.hs
143 lines 3.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Pattern where
4import qualified Data.Set as Set
5import Text.PrettyPrint as P
7import qualified AST.Helpers as Help
8import qualified AST.Literal as L
9import qualified AST.Variable as Var
10import qualified Reporting.Annotation as A
11import qualified Reporting.PrettyPrint as P
12import qualified Reporting.Region as R
15type Pattern ann var =
16 A.Annotated ann (Pattern' ann var)
19data Pattern' ann var
20 = Data var [Pattern ann var]
21 | Record [String]
22 | Alias String (Pattern ann var)
23 | Var String
24 | Anything
25 | Literal L.Literal
26 deriving (Show)
29type RawPattern =
30 Pattern R.Region Var.Raw
33type RawPattern' =
34 Pattern' R.Region Var.Raw
37type CanonicalPattern =
38 Pattern R.Region Var.Canonical
41list :: R.Position -> [RawPattern] -> RawPattern
42list end patterns =
43 case patterns of
44 [] ->
45 A.at end end (Data (Var.Raw "[]") [])
47 pattern@(A.A (R.Region start _) _) : rest ->
48 A.at start end (Data (Var.Raw "::") [pattern, list end rest])
51consMany :: R.Position -> [RawPattern] -> RawPattern
52consMany end patterns =
53 let cons hd@(A.A (R.Region start _) _) tl =
54 A.at start end (Data (Var.Raw "::") [hd, tl])
55 in
56 foldr1 cons patterns
59tuple :: [RawPattern] -> RawPattern'
60tuple patterns =
61 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
64-- FIND VARIABLES
66boundVars :: Pattern ann var -> [A.Annotated ann String]
67boundVars (A.A ann pattern) =
68 case pattern of
69 Var x ->
70 [A.A ann x]
72 Alias name realPattern ->
73 A.A ann name : boundVars realPattern
75 Data _ patterns ->
76 concatMap boundVars patterns
78 Record fields ->
79 map (A.A ann) fields
81 Anything ->
82 []
84 Literal _ ->
85 []
88member :: String -> Pattern ann var -> Bool
89member name pattern =
90 any (name==) (map A.drop (boundVars pattern))
93boundVarSet :: Pattern ann var -> Set.Set String
94boundVarSet pattern =
95 Set.fromList (map A.drop (boundVars pattern))
98boundVarList :: Pattern ann var -> [String]
99boundVarList pattern =
100 Set.toList (boundVarSet pattern)
103-- PRETTY PRINTING
105instance Var.ToString var => P.Pretty (Pattern' ann var) where
106 pretty dealiaser needsParens pattern =
107 case pattern of
108 Var name ->
109 P.text name
111 Literal literal ->
112 P.pretty dealiaser needsParens literal
114 Record fields ->
115 P.braces (P.commaCat (map P.text fields))
117 Alias x ptrn ->
118 P.parensIf needsParens $
119 P.pretty dealiaser True ptrn <+> P.text "as" <+> P.text x
121 Anything ->
122 P.text "_"
124 Data name [A.A _ hd, A.A _ tl]
125 | Var.toString name == "::" ->
126 P.parensIf isCons (P.pretty dealiaser False hd)
127 <+> P.text "::"
128 <+> P.pretty dealiaser False tl
129 where
130 isCons =
131 case hd of
132 Data ctor _ -> Var.toString ctor == "::"
133 _ -> False
135 Data name patterns ->
136 let name' = Var.toString name
137 in
138 if Help.isTuple name'
139 then
140 P.parens (P.commaCat (map (P.pretty dealiaser False) patterns))
141 else
142 P.parensIf needsParens $
143 P.hsep (P.text name' : map (P.pretty dealiaser True) patterns)