on c18189b help sign in
elk/src/AST/Pattern.hs
99 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Pattern where
4import qualified Data.Set as Set
6import qualified AST.Literal as L
7import qualified AST.Variable as Var
8import qualified Reporting.Annotation as A
9import qualified Reporting.Region as R
12type Pattern ann var =
13 A.Annotated ann (Pattern' ann var)
16data Pattern' ann var
17 = Data var [Pattern ann var]
18 | Record [String]
19 | Alias String (Pattern ann var)
20 | Var String
21 | Anything
22 | Literal L.Literal
25type RawPattern =
26 Pattern R.Region Var.Raw
29type RawPattern' =
30 Pattern' R.Region Var.Raw
33type CanonicalPattern =
34 Pattern R.Region Var.Canonical
37list :: R.Position -> [RawPattern] -> RawPattern
38list end patterns =
39 case patterns of
40 [] ->
41 A.at end end (Data (Var.Raw "[]") [])
43 pattern@(A.A (R.Region start _) _) : rest ->
44 A.at start end (Data (Var.Raw "::") [pattern, list end rest])
47consMany :: R.Position -> [RawPattern] -> RawPattern
48consMany end patterns =
49 let cons hd@(A.A (R.Region start _) _) tl =
50 A.at start end (Data (Var.Raw "::") [hd, tl])
51 in
52 foldr1 cons patterns
55tuple :: [RawPattern] -> RawPattern'
56tuple patterns =
57 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
61-- FIND VARIABLES
64boundVars :: Pattern ann var -> [A.Annotated ann String]
65boundVars (A.A ann pattern) =
66 case pattern of
67 Var x ->
68 [A.A ann x]
70 Alias name realPattern ->
71 A.A ann name : boundVars realPattern
73 Data _ patterns ->
74 concatMap boundVars patterns
76 Record fields ->
77 map (A.A ann) fields
79 Anything ->
80 []
82 Literal _ ->
83 []
86member :: String -> Pattern ann var -> Bool
87member name pattern =
88 any (name==) (map A.drop (boundVars pattern))
91boundVarSet :: Pattern ann var -> Set.Set String
92boundVarSet pattern =
93 Set.fromList (map A.drop (boundVars pattern))
96boundVarList :: Pattern ann var -> [String]
97boundVarList pattern =
98 Set.toList (boundVarSet pattern)