@@ -1,160 +1,112 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
3−module AST.Pattern where
3+module AST.Pattern
4+ ( Raw
5+ , Raw_(..)
6+ , Canonical
7+ , Canonical_(..)
8+ , boundVars
9+ , member
10+ , boundVarSet
11+ , boundVarList
12+ )
13+ where
14+
415
5−import qualified Data.List as List
6−import Data.Monoid ((<>))
716import qualified Data.Set as Set
817import Data.Text (Text)
9−import qualified Data.Text.Lazy as LazyText
10−import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
1118
12−import qualified AST.Helpers as Help
1319import qualified AST.Literal as L
1420import qualified AST.Variable as Var
1521import qualified Reporting.Annotation as A
16−import qualified Reporting.Region as R
1722
1823
19−type Pattern ann var =
20− A.Annotated ann (Pattern' ann var)
2124
25+-- RAW
2226
23−data 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
3027
28+type Raw = A.Located Raw_
3129
32−type Raw =
33− Pattern R.Region Var.Raw
3430
31+data Raw_
32+ = RCtor (Maybe Text) Text [Raw]
33+ | RRecord [Text]
34+ | RUnit
35+ | RTuple Raw Raw [Raw]
36+ | RList [Raw]
37+ | RCons Raw Raw
38+ | RAlias Text Raw
39+ | RVar Text
40+ | RAnything
41+ | RLiteral L.Literal
3542
36−type Raw' =
37− Pattern' R.Region Var.Raw
3843
3944
40−type Canonical =
41− Pattern R.Region Var.Canonical
45+-- CANONICAL
4246
4347
44−isVar :: Text -> Pattern ann var -> Bool
45−isVar name (A.A _ pattern) =
46− case pattern of
47− Var pName ->
48− name == pName
48+type Canonical = A.Located Canonical_
4949
50− _ ->
51− False
5250
51+data Canonical_
52+ = Ctor Var.Canonical [Canonical]
53+ | Record [Text]
54+ | Unit
55+ | Tuple Canonical Canonical [Canonical]
56+ | Alias Text Canonical
57+ | Var Text
58+ | Anything
59+ | Literal L.Literal
5360
54−list :: R.Position -> [Raw] -> Raw
55−list end patterns =
56− case patterns of
57− [] ->
58− A.at end end (Ctor (Var.Raw "[]") [])
5961
60− pattern@(A.A (R.Region start _) _) : rest ->
61− A.at start end (Ctor (Var.Raw "::") [pattern, list end rest])
6262
63+-- FIND VARIABLES
6364
64−tuple :: [Raw] -> Raw'
65−tuple patterns =
66− let
67− name =
68− Help.makeTuple (length patterns)
69− in
70− Ctor (Var.Raw name) patterns
7165
66+boundVars :: Raw -> [A.Located Text]
67+boundVars (A.A region pattern) =
68+ case pattern of
69+ RVar name ->
70+ [ A.A region name ]
7271
72+ RAlias name realPattern ->
73+ A.A region name : boundVars realPattern
7374
74−-- FIND VARIABLES
75+ RCtor _ _ patterns ->
76+ concatMap boundVars patterns
7577
78+ RRecord fields ->
79+ map (A.A region) fields
7680
77−boundVars :: Pattern ann var -> [A.Annotated ann Text]
78−boundVars (A.A ann pattern) =
79− case pattern of
80− Var x ->
81− [A.A ann x]
81+ RUnit ->
82+ []
8283
83− Alias name realPattern ->
84− A.A ann name : boundVars realPattern
84+ RTuple a b cs ->
85+ concatMap boundVars (a:b:cs)
8586
86− Ctor _ patterns ->
87− concatMap boundVars patterns
87+ RList xs ->
88+ concatMap boundVars xs
8889
89− Record fields ->
90− map (A.A ann) fields
90+ RCons a b ->
91+ boundVars a ++ boundVars b
9192
92− Anything ->
93+ RAnything ->
9394 []
9495
95− Literal _ ->
96+ RLiteral _ ->
9697 []
9798
9899
99−member :: Text -> Pattern ann var -> Bool
100+member :: Text -> Raw -> Bool
100101member name pattern =
101102 elem name (map A.drop (boundVars pattern))
102103
103104
104−boundVarSet :: Pattern ann var -> Set.Set Text
105+boundVarSet :: Raw -> Set.Set Text
105106boundVarSet pattern =
106107 Set.fromList (map A.drop (boundVars pattern))
107108
108109
109−boundVarList :: Pattern ann var -> [Text]
110+boundVarList :: Raw -> [Text]
110111boundVarList pattern =
111112 Set.toList (boundVarSet pattern)
112−
113−
114−
115−-- TO BUILDER
116−
117−
118−toString :: Canonical -> String
119−toString var =
120− LazyText.unpack (toLazyText (toBuilder False var))
121−
122−
123−toText :: Canonical -> Text
124−toText var =
125− LazyText.toStrict (toLazyText (toBuilder False var))
126−
127−
128−toBuilder :: Bool -> Canonical -> Builder
129−toBuilder needsParens (A.A _ pattern) =
130− case pattern of
131− Var name ->
132− fromText name
133−
134− Ctor name [] ->
135− if Var.isTuple name then "()" else fromText (Var.toText name)
136−
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)
143−
144− Record fields ->
145− "{" <> mconcat (List.intersperse "," (map fromText fields)) <> "}"
146−
147− Alias alias subPattern ->
148− parensIf needsParens $
149− toBuilder False subPattern <> " as " <> fromText alias
150−
151− Anything ->
152− "_"
153−
154− Literal literal ->
155− L.toBuilder literal
156−
157−
158−parensIf :: Bool -> Builder -> Builder
159−parensIf needsParens builder =
160− if needsParens then "(" <> builder <> ")" else builder