on 0c8da23 help sign in
elk/src/AST/Pattern.hs
151 lines 3.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module AST.Pattern where
4import qualified Data.List as List
5import qualified Data.Set as Set
7import qualified AST.Literal as L
8import qualified AST.Variable as Var
9import qualified Reporting.Annotation as A
10import qualified Reporting.Region as R
13type Pattern ann var =
14 A.Annotated ann (Pattern' ann var)
17data Pattern' ann var
18 = Data var [Pattern ann var]
19 | Record [String]
20 | Alias String (Pattern ann var)
21 | Var String
22 | Anything
23 | Literal L.Literal
26type Raw =
27 Pattern R.Region Var.Raw
30type Raw' =
31 Pattern' R.Region Var.Raw
34type Canonical =
35 Pattern R.Region Var.Canonical
38isVar :: String -> Pattern ann var -> Bool
39isVar name (A.A _ pattern) =
40 case pattern of
41 Var pName ->
42 name == pName
44 _ ->
45 False
48list :: R.Position -> [Raw] -> Raw
49list end patterns =
50 case patterns of
51 [] ->
52 A.at end end (Data (Var.Raw "[]") [])
54 pattern@(A.A (R.Region start _) _) : rest ->
55 A.at start end (Data (Var.Raw "::") [pattern, list end rest])
58consMany :: R.Position -> [Raw] -> Raw
59consMany end patterns =
60 let cons hd@(A.A (R.Region start _) _) tl =
61 A.at start end (Data (Var.Raw "::") [hd, tl])
62 in
63 foldr1 cons patterns
66tuple :: [Raw] -> Raw'
67tuple patterns =
68 Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
72-- FIND VARIABLES
75boundVars :: Pattern ann var -> [A.Annotated ann String]
76boundVars (A.A ann pattern) =
77 case pattern of
78 Var x ->
79 [A.A ann x]
81 Alias name realPattern ->
82 A.A ann name : boundVars realPattern
84 Data _ patterns ->
85 concatMap boundVars patterns
87 Record fields ->
88 map (A.A ann) fields
90 Anything ->
91 []
93 Literal _ ->
94 []
97member :: String -> Pattern ann var -> Bool
98member name pattern =
99 any (name==) (map A.drop (boundVars pattern))
102boundVarSet :: Pattern ann var -> Set.Set String
103boundVarSet pattern =
104 Set.fromList (map A.drop (boundVars pattern))
107boundVarList :: Pattern ann var -> [String]
108boundVarList pattern =
109 Set.toList (boundVarSet pattern)
113-- TO STRING
116toString :: Bool -> Canonical -> String
117toString needsParens (A.A _ pattern) =
118 case pattern of
119 Var name ->
120 name
122 Data name [] ->
123 if Var.isTuple name then
124 "()"
125 else
126 Var.toString name
128 Data name args ->
129 if Var.isTuple name then
130 "( " ++ List.intercalate ", " (map (toString False) args) ++ " )"
131 else
132 parensIf needsParens $
133 Var.toString name ++ concatMap ((" "++) . toString True) args
135 Record fields ->
136 "{" ++ List.intercalate "," fields ++ "}"
138 Alias alias subPattern ->
139 parensIf needsParens $
140 toString False subPattern ++ " as " ++ alias
142 Anything ->
143 "_"
145 Literal literal ->
146 L.toString literal
149parensIf :: Bool -> String -> String
150parensIf needsParens str =
151 if needsParens then "(" ++ str ++ ")" else str