on bc71d83 help sign in
elk/src/Nitpick/Pattern.hs
105 lines 2.3 kB history raw
1module Nitpick.Pattern where
3import qualified Data.List as List
4import qualified Data.Set as Set
6import qualified AST.Literal as L
7import qualified AST.Pattern as P
8import qualified AST.Variable as Var
9import qualified Reporting.Annotation as A
12data Pattern
13 = Data Var.Canonical [Pattern]
14 | Record [String]
15 | Alias String Pattern
16 | Var String
17 | Anything
18 | Literal L.Literal
19 | AnythingBut (Set.Set L.Literal)
20 deriving (Show, Eq)
23fromCanonicalPattern :: P.CanonicalPattern -> Pattern
24fromCanonicalPattern (A.A _ pattern) =
25 case pattern of
26 P.Data tag patterns ->
27 Data tag (map fromCanonicalPattern patterns)
29 P.Record fields ->
30 Record fields
32 P.Alias name pattern ->
33 Alias name (fromCanonicalPattern pattern)
35 P.Var name ->
36 Var name
38 P.Anything ->
39 Anything
41 P.Literal (L.Boolean True) ->
42 Data (Var.builtin "True") []
44 P.Literal (L.Boolean False) ->
45 Data (Var.builtin "False") []
47 P.Literal literal ->
48 Literal literal
51-- TO STRING
53toString :: Bool -> Pattern -> String
54toString needsParens pattern =
55 case pattern of
56 Data tag [first,rest] | Var.toString tag == "::" ->
57 toString (isCons first) first
58 ++ " :: "
59 ++ toString False rest
61 Data tag args ->
62 if Var.isTuple tag then
63 "(" ++ List.intercalate ", " (map (toString False) args) ++ ")"
65 else
66 addParensIf (needsParens && not (null args)) $
67 List.intercalate " " (Var.toString tag : map (toString True) args)
69 Record fields ->
70 "{ " ++ List.intercalate ", " fields ++ " }"
72 Alias alias realPattern ->
73 addParensIf needsParens $
74 toString False realPattern ++ " as " ++ alias
76 Var name ->
77 name
79 Anything ->
80 "_"
82 Literal literal ->
83 L.toString literal
85 AnythingBut literalSet ->
86 List.intercalate " " ("<values besides:" : map L.toString (Set.toList literalSet) ++ [">"])
89addParensIf :: Bool -> String -> String
90addParensIf needsParens str =
91 if needsParens then
92 "(" ++ str ++ ")"
94 else
95 str
98isCons :: Pattern -> Bool
99isCons pattern =
100 case pattern of
101 Data tag [_,_] ->
102 Var.toString tag == "::"
104 _ ->
105 False