git.iko.soy/elk
on 70998ea help sign in
elk/src/AST/Pattern.hs
135 lines 3.1 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])
51tuple :: [RawPattern] -> RawPattern'
52tuple patterns =
53 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
56-- FIND VARIABLES
58boundVars :: Pattern ann var -> [A.Annotated ann String]
59boundVars (A.A ann pattern) =
60 case pattern of
61 Var x ->
62 [A.A ann x]
64 Alias name realPattern ->
65 A.A ann name : boundVars realPattern
67 Data _ patterns ->
68 concatMap boundVars patterns
70 Record fields ->
71 map (A.A ann) fields
73 Anything ->
74 []
76 Literal _ ->
77 []
80member :: String -> Pattern ann var -> Bool
81member name pattern =
82 any (name==) (map A.drop (boundVars pattern))
85boundVarSet :: Pattern ann var -> Set.Set String
86boundVarSet pattern =
87 Set.fromList (map A.drop (boundVars pattern))
90boundVarList :: Pattern ann var -> [String]
91boundVarList pattern =
92 Set.toList (boundVarSet pattern)
95-- PRETTY PRINTING
97instance Var.ToString var => P.Pretty (Pattern' ann var) where
98 pretty needsParens pattern =
99 case pattern of
100 Var name ->
101 P.text name
103 Literal literal ->
104 P.pretty needsParens literal
106 Record fields ->
107 P.braces (P.commaCat (map P.text fields))
109 Alias x ptrn ->
110 P.parensIf needsParens $
111 P.pretty True ptrn <+> P.text "as" <+> P.text x
113 Anything ->
114 P.text "_"
116 Data name [A.A _ hd, A.A _ tl]
117 | Var.toString name == "::" ->
118 P.parensIf isCons (P.pretty False hd)
119 <+> P.text "::"
120 <+> P.pretty False tl
121 where
122 isCons =
123 case hd of
124 Data ctor _ -> Var.toString ctor == "::"
125 _ -> False
127 Data name patterns ->
128 let name' = Var.toString name
129 in
130 if Help.isTuple name'
131 then
132 P.parens (P.commaCat (map (P.pretty False) patterns))
133 else
134 P.parensIf needsParens $
135 P.hsep (P.text name' : map (P.pretty True) patterns)