git.iko.soy/elk
on bb35d68 help sign in
elk/src/AST/Pattern.hs
160 lines 3.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Pattern where
5import qualified Data.List as List
6import Data.Monoid ((<>))
7import qualified Data.Set as Set
8import Data.Text (Text)
9import qualified Data.Text as Text
10import qualified Data.Text.Lazy as LazyText
11import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
13import qualified AST.Literal as L
14import qualified AST.Variable as Var
15import qualified Reporting.Annotation as A
16import qualified Reporting.Region as R
19type Pattern ann var =
20 A.Annotated ann (Pattern' ann var)
23data Pattern' ann var
24 = Ctor var [Pattern ann var]
25 | Record [Text]
26 | Alias Text (Pattern ann var)
27 | Var Text
28 | Anything
29 | Literal L.Literal
32type Raw =
33 Pattern R.Region Var.Raw
36type Raw' =
37 Pattern' R.Region Var.Raw
40type Canonical =
41 Pattern R.Region Var.Canonical
44isVar :: Text -> Pattern ann var -> Bool
45isVar name (A.A _ pattern) =
46 case pattern of
47 Var pName ->
48 name == pName
50 _ ->
51 False
54list :: R.Position -> [Raw] -> Raw
55list end patterns =
56 case patterns of
57 [] ->
58 A.at end end (Ctor (Var.Raw "[]") [])
60 pattern@(A.A (R.Region start _) _) : rest ->
61 A.at start end (Ctor (Var.Raw "::") [pattern, list end rest])
64tuple :: [Raw] -> Raw'
65tuple patterns =
66 let
67 name =
68 Text.append "_Tuple" (Text.pack (show (length patterns)))
69 in
70 Ctor (Var.Raw name) patterns
74-- FIND VARIABLES
77boundVars :: Pattern ann var -> [A.Annotated ann Text]
78boundVars (A.A ann pattern) =
79 case pattern of
80 Var x ->
81 [A.A ann x]
83 Alias name realPattern ->
84 A.A ann name : boundVars realPattern
86 Ctor _ patterns ->
87 concatMap boundVars patterns
89 Record fields ->
90 map (A.A ann) fields
92 Anything ->
93 []
95 Literal _ ->
96 []
99member :: Text -> Pattern ann var -> Bool
100member name pattern =
101 elem name (map A.drop (boundVars pattern))
104boundVarSet :: Pattern ann var -> Set.Set Text
105boundVarSet pattern =
106 Set.fromList (map A.drop (boundVars pattern))
109boundVarList :: Pattern ann var -> [Text]
110boundVarList pattern =
111 Set.toList (boundVarSet pattern)
115-- TO BUILDER
118toString :: Canonical -> String
119toString var =
120 LazyText.unpack (toLazyText (toBuilder False var))
123toText :: Canonical -> Text
124toText var =
125 LazyText.toStrict (toLazyText (toBuilder False var))
128toBuilder :: Bool -> Canonical -> Builder
129toBuilder needsParens (A.A _ pattern) =
130 case pattern of
131 Var name ->
132 fromText name
134 Ctor name [] ->
135 if Var.isTuple name then "()" else fromText (Var.toText name)
137 Ctor name args ->
138 if Var.isTuple name then
139 "( " <> mconcat (List.intersperse ", " (map (toBuilder False) args)) <> " )"
140 else
141 parensIf needsParens $
142 fromText (Var.toText name) <> mconcat (map (\arg -> " " <> toBuilder True arg) args)
144 Record fields ->
145 "{" <> mconcat (List.intersperse "," (map fromText fields)) <> "}"
147 Alias alias subPattern ->
148 parensIf needsParens $
149 toBuilder False subPattern <> " as " <> fromText alias
151 Anything ->
152 "_"
154 Literal literal ->
155 L.toBuilder literal
158parensIf :: Bool -> Builder -> Builder
159parensIf needsParens builder =
160 if needsParens then "(" <> builder <> ")" else builder