git.iko.soy/elk
on ff0b05b help sign in
elk/src/AST/Pattern.hs
150 lines 2.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Pattern where
5import qualified Data.List as List
6import qualified Data.Set as Set
7import qualified Data.Text as Text
8import Data.Text (Text)
10import qualified AST.Literal as L
11import qualified AST.Variable as Var
12import qualified Reporting.Annotation as A
13import qualified Reporting.Region as R
16type Pattern ann var =
17 A.Annotated ann (Pattern' ann var)
20data Pattern' ann var
21 = Ctor var [Pattern ann var]
22 | Record [Text]
23 | Alias Text (Pattern ann var)
24 | Var Text
25 | Anything
26 | Literal L.Literal
29type Raw =
30 Pattern R.Region Var.Raw
33type Raw' =
34 Pattern' R.Region Var.Raw
37type Canonical =
38 Pattern R.Region Var.Canonical
41isVar :: Text -> Pattern ann var -> Bool
42isVar name (A.A _ pattern) =
43 case pattern of
44 Var pName ->
45 name == pName
47 _ ->
48 False
51list :: R.Position -> [Raw] -> Raw
52list end patterns =
53 case patterns of
54 [] ->
55 A.at end end (Ctor (Var.Raw "[]") [])
57 pattern@(A.A (R.Region start _) _) : rest ->
58 A.at start end (Ctor (Var.Raw "::") [pattern, list end rest])
61tuple :: [Raw] -> Raw'
62tuple patterns =
63 let
64 name =
65 Text.append "_Tuple" (Text.pack (show (length patterns)))
66 in
67 Ctor (Var.Raw name) patterns
71-- FIND VARIABLES
74boundVars :: Pattern ann var -> [A.Annotated ann Text]
75boundVars (A.A ann pattern) =
76 case pattern of
77 Var x ->
78 [A.A ann x]
80 Alias name realPattern ->
81 A.A ann name : boundVars realPattern
83 Ctor _ patterns ->
84 concatMap boundVars patterns
86 Record fields ->
87 map (A.A ann) fields
89 Anything ->
90 []
92 Literal _ ->
93 []
96member :: Text -> Pattern ann var -> Bool
97member name pattern =
98 elem name (map A.drop (boundVars pattern))
101boundVarSet :: Pattern ann var -> Set.Set Text
102boundVarSet pattern =
103 Set.fromList (map A.drop (boundVars pattern))
106boundVarList :: Pattern ann var -> [Text]
107boundVarList pattern =
108 Set.toList (boundVarSet pattern)
112-- TO STRING
115toString :: Bool -> Canonical -> String
116toString needsParens (A.A _ pattern) =
117 case pattern of
118 Var name ->
119 Text.unpack name
121 Ctor name [] ->
122 if Var.isTuple name then
123 "()"
124 else
125 Var.toString name
127 Ctor name args ->
128 if Var.isTuple name then
129 "( " ++ List.intercalate ", " (map (toString False) args) ++ " )"
130 else
131 parensIf needsParens $
132 Var.toString name ++ concatMap ((" "++) . toString True) args
134 Record fields ->
135 "{" ++ List.intercalate "," (map Text.unpack fields) ++ "}"
137 Alias alias subPattern ->
138 parensIf needsParens $
139 toString False subPattern ++ " as " ++ Text.unpack alias
141 Anything ->
142 "_"
144 Literal literal ->
145 L.toString literal
148parensIf :: Bool -> String -> String
149parensIf needsParens str =
150 if needsParens then "(" ++ str ++ ")" else str