git.iko.soy/elk
on 50efcd0 help sign in
elk/src/AST/Pattern.hs
147 lines 3.4 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
41type Optimized =
42 Pattern () Var.Canonical
45list :: R.Position -> [RawPattern] -> RawPattern
46list end patterns =
47 case patterns of
48 [] ->
49 A.at end end (Data (Var.Raw "[]") [])
51 pattern@(A.A (R.Region start _) _) : rest ->
52 A.at start end (Data (Var.Raw "::") [pattern, list end rest])
55consMany :: R.Position -> [RawPattern] -> RawPattern
56consMany end patterns =
57 let cons hd@(A.A (R.Region start _) _) tl =
58 A.at start end (Data (Var.Raw "::") [hd, tl])
59 in
60 foldr1 cons patterns
63tuple :: [RawPattern] -> RawPattern'
64tuple patterns =
65 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
68-- FIND VARIABLES
70boundVars :: Pattern ann var -> [A.Annotated ann String]
71boundVars (A.A ann pattern) =
72 case pattern of
73 Var x ->
74 [A.A ann x]
76 Alias name realPattern ->
77 A.A ann name : boundVars realPattern
79 Data _ patterns ->
80 concatMap boundVars patterns
82 Record fields ->
83 map (A.A ann) fields
85 Anything ->
86 []
88 Literal _ ->
89 []
92member :: String -> Pattern ann var -> Bool
93member name pattern =
94 any (name==) (map A.drop (boundVars pattern))
97boundVarSet :: Pattern ann var -> Set.Set String
98boundVarSet pattern =
99 Set.fromList (map A.drop (boundVars pattern))
102boundVarList :: Pattern ann var -> [String]
103boundVarList pattern =
104 Set.toList (boundVarSet pattern)
107-- PRETTY PRINTING
109instance Var.ToString var => P.Pretty (Pattern' ann var) where
110 pretty dealiaser needsParens pattern =
111 case pattern of
112 Var name ->
113 P.text name
115 Literal literal ->
116 P.pretty dealiaser needsParens literal
118 Record fields ->
119 P.braces (P.commaCat (map P.text fields))
121 Alias x ptrn ->
122 P.parensIf needsParens $
123 P.pretty dealiaser True ptrn <+> P.text "as" <+> P.text x
125 Anything ->
126 P.text "_"
128 Data name [A.A _ hd, A.A _ tl]
129 | Var.toString name == "::" ->
130 P.parensIf isCons (P.pretty dealiaser False hd)
131 <+> P.text "::"
132 <+> P.pretty dealiaser False tl
133 where
134 isCons =
135 case hd of
136 Data ctor _ -> Var.toString ctor == "::"
137 _ -> False
139 Data name patterns ->
140 let name' = Var.toString name
141 in
142 if Help.isTuple name'
143 then
144 P.parens (P.commaCat (map (P.pretty dealiaser False) patterns))
145 else
146 P.parensIf needsParens $
147 P.hsep (P.text name' : map (P.pretty dealiaser True) patterns)