git.iko.soy/elk
on bbb6583 help sign in
elk/src/Nitpick/Pattern.hs
118 lines 2.6 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 (Eq)
23fromCanonicalPattern :: P.Canonical -> 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 case map L.toString (Set.toList literalSet) of
87 [] ->
88 error "should not have an AnythingBut with no literals"
90 [x] ->
91 "<values besides " ++ x ++ ">"
93 [x,y] ->
94 "<values besides " ++ x ++ " and " ++ y ++ ">"
96 literals ->
97 "<values besides "
98 ++ List.intercalate ", " (init literals)
99 ++ ", and " ++ last literals ++ ">"
102addParensIf :: Bool -> String -> String
103addParensIf needsParens str =
104 if needsParens then
105 "(" ++ str ++ ")"
107 else
108 str
111isCons :: Pattern -> Bool
112isCons pattern =
113 case pattern of
114 Data tag [_,_] ->
115 Var.toString tag == "::"
117 _ ->
118 False