git.iko.soy/elk
on master help sign in
style: improved indentation and naming
4b30b6fEvan Czaplicki
src/AST/Pattern.hs+62−32
compare with master
unifiedsplit
@@ -9,6 +9,7 @@ import qualified Data.Set as Set
9import qualified AST.Variable as Var
9import qualified AST.Variable as Var
10import AST.Literal as Literal
10import AST.Literal as Literal
11
11
12+
12data Pattern var
13data Pattern var
13 = Data var [Pattern var]
14 = Data var [Pattern var]
14 | Record [String]
15 | Record [String]
@@ -18,55 +19,84 @@ data Pattern var
18 | Literal Literal.Literal
19 | Literal Literal.Literal
19 deriving (Eq, Ord, Show)
20 deriving (Eq, Ord, Show)
20
21
22+
21−type RawPattern = Pattern Var.Raw
23+type RawPattern =
24+ Pattern Var.Raw
25+
26+
22−type CanonicalPattern = Pattern Var.Canonical
27+type CanonicalPattern =
28+ Pattern Var.Canonical
29+
23
30
24cons :: RawPattern -> RawPattern -> RawPattern
31cons :: RawPattern -> RawPattern -> RawPattern
32+cons h t =
25−cons h t = Data (Var.Raw "::") [h,t]
33+ Data (Var.Raw "::") [h,t]
34+
26
35
27nil :: RawPattern
36nil :: RawPattern
37+nil =
28−nil = Data (Var.Raw "[]") []
38+ Data (Var.Raw "[]") []
39+
29
40
30list :: [RawPattern] -> RawPattern
41list :: [RawPattern] -> RawPattern
42+list patterns =
31−list = foldr cons nil
43+ foldr cons nil patterns
44+
32
45
33tuple :: [RawPattern] -> RawPattern
46tuple :: [RawPattern] -> RawPattern
47+tuple patterns =
34−tuple es = Data (Var.Raw ("_Tuple" ++ show (length es))) es
48+ Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
49+
35
50
36boundVarList :: Pattern var -> [String]
51boundVarList :: Pattern var -> [String]
52+boundVarList pattern =
37−boundVarList = Set.toList . boundVars
53+ Set.toList (boundVars pattern)
54+
38
55
39boundVars :: Pattern var -> Set.Set String
56boundVars :: Pattern var -> Set.Set String
40boundVars pattern =
57boundVars pattern =
41− case pattern of
58+ case pattern of
42− Var x -> Set.singleton x
59+ Var x -> Set.singleton x
43− Alias x p -> Set.insert x (boundVars p)
60+ Alias x p -> Set.insert x (boundVars p)
44− Data _ ps -> Set.unions (map boundVars ps)
61+ Data _ ps -> Set.unions (map boundVars ps)
45− Record fields -> Set.fromList fields
62+ Record fields -> Set.fromList fields
46− Anything -> Set.empty
63+ Anything -> Set.empty
47− Literal _ -> Set.empty
64+ Literal _ -> Set.empty
48
65
49
66
50instance Var.ToString var => Pretty (Pattern var) where
67instance Var.ToString var => Pretty (Pattern var) where
51 pretty pattern =
68 pretty pattern =
52− case pattern of
69+ case pattern of
70+ Var x ->
53− Var x -> variable x
71+ variable x
72+
54− Literal lit -> pretty lit
73+ Literal literal ->
74+ pretty literal
75+
76+ Record fields ->
55− Record fs -> PP.braces (commaCat $ map variable fs)
77+ PP.braces (commaCat (map variable fields))
78+
79+ Alias x p ->
56− Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
80+ prettyParens p <+> PP.text "as" <+> variable x
81+
57− Anything -> PP.text "_"
82+ Anything ->
83+ PP.text "_"
84+
58− Data name [hd,tl] | Var.toString name == "::" ->
85+ Data name [hd,tl] | Var.toString name == "::" ->
59− parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
86+ parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
60− where
87+ where
88+ isCons =
61− isCons = case hd of
89+ case hd of
62− Data ctor _ -> Var.toString ctor == "::"
90+ Data ctor _ -> Var.toString ctor == "::"
63− _ -> False
91+ _ -> False
64−
92+
65− Data name ps
93+ Data name ps ->
94+ let name' = Var.toString name
95+ in
96+ if Help.isTuple name'
66− | Help.isTuple name' -> PP.parens . commaCat $ map pretty ps
97+ then PP.parens (commaCat (map pretty ps))
67− | otherwise -> hsep (PP.text name' : map prettyParens ps)
98+ else hsep (PP.text name' : map prettyParens ps)
68− where
99+
69− name' = Var.toString name
70
100
71prettyParens :: Var.ToString var => Pattern var -> Doc
101prettyParens :: Var.ToString var => Pattern var -> Doc
72prettyParens pattern =
102prettyParens pattern =
src/AST/PrettyPrint.hs+23−5
@@ -5,27 +5,43 @@ import Control.Monad.Trans.Error
5import Text.PrettyPrint as P
5import Text.PrettyPrint as P
6import qualified AST.Helpers as Help
6import qualified AST.Helpers as Help
7
7
8+
8class Pretty a where
9class Pretty a where
9 pretty :: a -> Doc
10 pretty :: a -> Doc
10
11
12+
11instance Pretty Doc where
13instance Pretty Doc where
12 pretty doc = doc
14 pretty doc = doc
13
15
16+
14instance Pretty String where
17instance Pretty String where
15 pretty = P.text
18 pretty = P.text
16
19
20+
17renderPretty :: (Pretty a) => a -> String
21renderPretty :: (Pretty a) => a -> String
18−renderPretty e = render (pretty e)
22+renderPretty e =
23+ render (pretty e)
24+
25+
26+commaCat :: [Doc] -> Doc
27+commaCat docs =
28+ cat (punctuate comma docs)
29+
30+
31+commaSep :: [Doc] -> Doc
32+commaSep docs =
33+ sep (punctuate comma docs)
19
34
20−commaCat docs = cat (punctuate comma docs)
21−commaSep docs = sep (punctuate comma docs)
22
35
23parensIf :: Bool -> Doc -> Doc
36parensIf :: Bool -> Doc -> Doc
37+parensIf bool doc =
24−parensIf bool doc = if bool then parens doc else doc
38+ if bool then parens doc else doc
39+
25
40
26variable :: String -> Doc
41variable :: String -> Doc
27variable x =
42variable x =
28− if Help.isOp x then parens (text x) else text x
43+ if Help.isOp x then parens (text x) else text x
44+
29
45
30eightyCharLines :: Int -> String -> String
46eightyCharLines :: Int -> String -> String
31eightyCharLines indent message = answer
47eightyCharLines indent message = answer
@@ -38,9 +54,11 @@ eightyCharLines indent message = answer
38 | slen + wlen > 79 = (sentence ++ "\n" ++ spaces ++ word, indent + wlen, " ")
54 | slen + wlen > 79 = (sentence ++ "\n" ++ spaces ++ word, indent + wlen, " ")
39 | otherwise = (sentence ++ space ++ word, slen + wlen + length space, " ")
55 | otherwise = (sentence ++ space ++ word, slen + wlen + length space, " ")
40
56
57+
41instance Error Doc where
58instance Error Doc where
42 noMsg = P.empty
59 noMsg = P.empty
43 strMsg = P.text
60 strMsg = P.text
44
61
62+
45instance ErrorList Doc where
63instance ErrorList Doc where
46 listMsg str = [ P.text str ]
64 listMsg str = [ P.text str ]
src/AST/Type.hs+68−33
@@ -9,6 +9,7 @@ import AST.PrettyPrint
9import qualified AST.Helpers as Help
9import qualified AST.Helpers as Help
10import Text.PrettyPrint as P
10import Text.PrettyPrint as P
11
11
12+
12data Type var
13data Type var
13 = Lambda (Type var) (Type var)
14 = Lambda (Type var) (Type var)
14 | Var String
15 | Var String
@@ -18,47 +19,64 @@ data Type var
18 | Aliased Var.Canonical (Type var)
19 | Aliased Var.Canonical (Type var)
19 deriving (Eq,Show)
20 deriving (Eq,Show)
20
21
22+
21−type RawType = Type Var.Raw
23+type RawType =
24+ Type Var.Raw
25+
26+
22−type CanonicalType = Type Var.Canonical
27+type CanonicalType =
28+ Type Var.Canonical
29+
23
30
24fieldMap :: [(String,a)] -> Map.Map String [a]
31fieldMap :: [(String,a)] -> Map.Map String [a]
25fieldMap fields =
32fieldMap fields =
26− foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
33+ foldl (\r (field,tipe) -> Map.insertWith (++) field [tipe] r) Map.empty fields
34+
27
35
28recordOf :: [(String, Type var)] -> Type var
36recordOf :: [(String, Type var)] -> Type var
37+recordOf fields =
29−recordOf fields = Record fields Nothing
38+ Record fields Nothing
39+
30
40
31listOf :: RawType -> RawType
41listOf :: RawType -> RawType
42+listOf tipe =
32−listOf t = App (Type (Var.Raw "List")) [t]
43+ App (Type (Var.Raw "List")) [tipe]
44+
33
45
34tupleOf :: [RawType] -> RawType
46tupleOf :: [RawType] -> RawType
35−tupleOf ts = App (Type t) ts
47+tupleOf types =
36− where
37− t = Var.Raw ("_Tuple" ++ show (length ts))
48+ let name = Var.Raw ("_Tuple" ++ show (length types))
49+ in
50+ App (Type name) types
51+
38
52
39instance (Var.ToString var, Pretty var) => Pretty (Type var) where
53instance (Var.ToString var, Pretty var) => Pretty (Type var) where
40 pretty tipe =
54 pretty tipe =
41 case tipe of
55 case tipe of
56+ Lambda _ _ ->
42− Lambda _ _ -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
57+ P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
43 where
58 where
44 t:ts = map prettyLambda (collectLambdas tipe)
59 t:ts = map prettyLambda (collectLambdas tipe)
45− prettyLambda t = case t of
60+ prettyLambda t =
61+ case t of
46− Lambda _ _ -> P.parens (pretty t)
62+ Lambda _ _ -> P.parens (pretty t)
47− _ -> pretty t
63+ _ -> pretty t
48
64
65+ Var x ->
49− Var x -> P.text x
66+ P.text x
50
67
51 Type var ->
68 Type var ->
52− let v = Var.toString var in
69+ let v = Var.toString var
70+ in
53− P.text (if v == "_Tuple0" then "()" else v)
71+ P.text (if v == "_Tuple0" then "()" else v)
54
72
55 App f args ->
73 App f args ->
56 case (f,args) of
74 case (f,args) of
57 (Type name, _)
75 (Type name, _)
58 | Help.isTuple (Var.toString name) ->
76 | Help.isTuple (Var.toString name) ->
59− P.parens . P.sep . P.punctuate P.comma $ map pretty args
77+ P.parens (P.sep (P.punctuate P.comma (map pretty args)))
60
78
61− _ -> P.hang (pretty f) 2 (P.sep $ map prettyParens args)
79+ _ -> P.hang (pretty f) 2 (P.sep (map prettyParens args))
62
80
63 Record _ _ ->
81 Record _ _ ->
64 case flattenRecord tipe of
82 case flattenRecord tipe of
@@ -84,20 +102,26 @@ instance (Var.ToString var, Pretty var) => Pretty (Type var) where
84 P.text field <+> P.text ":" <+> pretty tipe
102 P.text field <+> P.text ":" <+> pretty tipe
85
103
86 Aliased name t ->
104 Aliased name t ->
87− let t' = pretty t in
105+ let t' = pretty t
106+ in
88− if show t' `elem` ["Int", "Float", "String", "Char", "Bool"]
107+ if show t' `elem` ["Int", "Float", "String", "Char", "Bool"]
89− then t'
108+ then t'
90− else pretty name
109+ else pretty name
91
110
92
111
93collectLambdas :: Type var -> [Type var]
112collectLambdas :: Type var -> [Type var]
94collectLambdas tipe =
113collectLambdas tipe =
95 case tipe of
114 case tipe of
115+ Lambda arg body ->
96− Lambda arg body -> arg : collectLambdas body
116+ arg : collectLambdas body
117+
118+ _ ->
97− _ -> [tipe]
119+ [tipe]
120+
98
121
99prettyParens :: (Var.ToString var, Pretty var) => Type var -> Doc
122prettyParens :: (Var.ToString var, Pretty var) => Type var -> Doc
123+prettyParens tipe =
100−prettyParens tipe = parensIf (needed tipe) (pretty tipe)
124+ parensIf (needed tipe) (pretty tipe)
101 where
125 where
102 needed t =
126 needed t =
103 case t of
127 case t of
@@ -105,26 +129,37 @@ prettyParens tipe = parensIf (needed tipe) (pretty tipe)
105
129
106 Lambda _ _ -> True
130 Lambda _ _ -> True
107
131
132+ App (Type name) _
108− App (Type name) _ | Help.isTuple (Var.toString name) -> False
133+ | Help.isTuple (Var.toString name) ->
134+ False
135+
109 App t' [] -> needed t'
136 App t' [] -> needed t'
137+
110 App _ _ -> True
138 App _ _ -> True
111
139
112 _ -> False
140 _ -> False
113
141
142+
114flattenRecord :: Type var -> ( [(String, Type var)], Maybe String )
143flattenRecord :: Type var -> ( [(String, Type var)], Maybe String )
115flattenRecord tipe =
144flattenRecord tipe =
116− case tipe of
145+ case tipe of
146+ Var x ->
117− Var x -> ([], Just x)
147+ ([], Just x)
148+
149+ Record fields Nothing ->
150+ (fields, Nothing)
118
151
119− Record fields Nothing -> (fields, Nothing)
152+ Record fields (Just ext) ->
153+ let (fields',ext') = flattenRecord ext
154+ in
155+ (fields' ++ fields, ext')
120
156
121− Record fields (Just ext) ->
157+ Aliased _ tipe' ->
122− let (fields',ext') = flattenRecord ext
158+ flattenRecord tipe'
123− in (fields' ++ fields, ext')
124
159
125− Aliased _ tipe' -> flattenRecord tipe'
160+ _ ->
161+ error "Trying to flatten ill-formed record."
126
162
127− _ -> error "Trying to flatten ill-formed record."
128
163
129instance Binary var => Binary (Type var) where
164instance Binary var => Binary (Type var) where
130 put tipe =
165 put tipe =
src/AST/Variable.hs+6−3
@@ -101,7 +101,8 @@ class ToString a where
101
101
102
102
103instance ToString Raw where
103instance ToString Raw where
104− toString (Raw x) = x
104+ toString (Raw name) =
105+ name
105
106
106
107
107instance ToString Canonical where
108instance ToString Canonical where
@@ -178,11 +179,13 @@ getUnion value =
178-- PRETTY VARIABLES
179-- PRETTY VARIABLES
179
180
180instance Pretty Raw where
181instance Pretty Raw where
181− pretty (Raw var) = variable var
182+ pretty (Raw name) =
183+ variable name
182
184
183
185
184instance Pretty Canonical where
186instance Pretty Canonical where
187+ pretty var =
185− pretty var = P.text (toString var)
188+ P.text (toString var)
186
189
187
190
188instance Pretty a => Pretty (Listing a) where
191instance Pretty a => Pretty (Listing a) where