git.iko.soy/elk
on efdc7a7 help sign in
elk/compiler/SourceSyntax/Pattern.hs
69 lines 1.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.Pattern where
4import qualified SourceSyntax.Helpers as Help
5import SourceSyntax.PrettyPrint
6import Text.PrettyPrint as PP
7import qualified Data.Set as Set
8import SourceSyntax.Literal as Literal
10data Pattern
11 = Data String [Pattern]
12 | Record [String]
13 | Alias String Pattern
14 | Var String
15 | Anything
16 | Literal Literal.Literal
17 deriving (Eq, Ord, Show)
19cons :: Pattern -> Pattern -> Pattern
20cons h t = Data "::" [h,t]
22nil :: Pattern
23nil = Data "[]" []
25list :: [Pattern] -> Pattern
26list = foldr cons nil
28tuple :: [Pattern] -> Pattern
29tuple es = Data ("_Tuple" ++ show (length es)) es
31boundVarList :: Pattern -> [String]
32boundVarList = Set.toList . boundVars
34boundVars :: Pattern -> Set.Set String
35boundVars pattern =
36 case pattern of
37 Var x -> Set.singleton x
38 Alias x p -> Set.insert x (boundVars p)
39 Data _ ps -> Set.unions (map boundVars ps)
40 Record fields -> Set.fromList fields
41 Anything -> Set.empty
42 Literal _ -> Set.empty
45instance Pretty Pattern where
46 pretty pattern =
47 case pattern of
48 Var x -> variable x
49 Literal lit -> pretty lit
50 Record fs -> PP.braces (commaCat $ map variable fs)
51 Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
52 Anything -> PP.text "_"
53 Data "::" [hd,tl] -> parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
54 where isCons = case hd of
55 Data "::" _ -> True
56 _ -> False
57 Data name ps ->
58 if Help.isTuple name then
59 PP.parens . commaCat $ map pretty ps
60 else hsep (PP.text name : map prettyParens ps)
62prettyParens :: Pattern -> Doc
63prettyParens pattern = parensIf needsThem (pretty pattern)
64 where
65 needsThem =
66 case pattern of
67 Data name (_:_) | not (Help.isTuple name) -> True
68 Alias _ _ -> True
69 _ -> False