git.iko.soy/elk
on master help sign in
style: improved indentation and naming
commit4b30b6ffffe85aa15a25a9519a6f2eb4103f095e authorEvan Czaplicki <info@elm-lang.org> dateMon 9 Feb 2015, 22:37 (12 years ago) parent40cc419
4 files changed+159−73
compare with master
unifiedsplit
src/AST/Pattern.hs+62−32 src/AST/PrettyPrint.hs+23−5 src/AST/Type.hs+68−33 src/AST/Variable.hs+6−3
src/AST/Pattern.hs+62−32
@@ -9,6 +9,7 @@ import qualified Data.Set as Set
99import qualified AST.Variable as Var
1010import AST.Literal as Literal
1111
12+
1213data Pattern var
1314 = Data var [Pattern var]
1415 | Record [String]
@@ -18,55 +19,84 @@ data Pattern var
1819 | Literal Literal.Literal
1920 deriving (Eq, Ord, Show)
2021
21−type RawPattern = Pattern Var.Raw
22−type CanonicalPattern = Pattern Var.Canonical
22+
23+type RawPattern =
24+ Pattern Var.Raw
25+
26+
27+type CanonicalPattern =
28+ Pattern Var.Canonical
29+
2330
2431cons :: RawPattern -> RawPattern -> RawPattern
25−cons h t = Data (Var.Raw "::") [h,t]
32+cons h t =
33+ Data (Var.Raw "::") [h,t]
34+
2635
2736nil :: RawPattern
28−nil = Data (Var.Raw "[]") []
37+nil =
38+ Data (Var.Raw "[]") []
39+
2940
3041list :: [RawPattern] -> RawPattern
31−list = foldr cons nil
42+list patterns =
43+ foldr cons nil patterns
44+
3245
3346tuple :: [RawPattern] -> RawPattern
34−tuple es = Data (Var.Raw ("_Tuple" ++ show (length es))) es
47+tuple patterns =
48+ Data (Var.Raw ("_Tuple" ++ show (length patterns))) patterns
49+
3550
3651boundVarList :: Pattern var -> [String]
37−boundVarList = Set.toList . boundVars
52+boundVarList pattern =
53+ Set.toList (boundVars pattern)
54+
3855
3956boundVars :: Pattern var -> Set.Set String
4057boundVars pattern =
41− case pattern of
42− Var x -> Set.singleton x
43− Alias x p -> Set.insert x (boundVars p)
44− Data _ ps -> Set.unions (map boundVars ps)
45− Record fields -> Set.fromList fields
46− Anything -> Set.empty
47− Literal _ -> Set.empty
58+ case pattern of
59+ Var x -> Set.singleton x
60+ Alias x p -> Set.insert x (boundVars p)
61+ Data _ ps -> Set.unions (map boundVars ps)
62+ Record fields -> Set.fromList fields
63+ Anything -> Set.empty
64+ Literal _ -> Set.empty
4865
4966
5067instance Var.ToString var => Pretty (Pattern var) where
5168 pretty pattern =
52− case pattern of
53− Var x -> variable x
54− Literal lit -> pretty lit
55− Record fs -> PP.braces (commaCat $ map variable fs)
56− Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
57− Anything -> PP.text "_"
58− Data name [hd,tl] | Var.toString name == "::" ->
59− parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
60− where
61− isCons = case hd of
62− Data ctor _ -> Var.toString ctor == "::"
63− _ -> False
64−
65− Data name ps
66− | Help.isTuple name' -> PP.parens . commaCat $ map pretty ps
67− | otherwise -> hsep (PP.text name' : map prettyParens ps)
68− where
69− name' = Var.toString name
69+ case pattern of
70+ Var x ->
71+ variable x
72+
73+ Literal literal ->
74+ pretty literal
75+
76+ Record fields ->
77+ PP.braces (commaCat (map variable fields))
78+
79+ Alias x p ->
80+ prettyParens p <+> PP.text "as" <+> variable x
81+
82+ Anything ->
83+ PP.text "_"
84+
85+ Data name [hd,tl] | Var.toString name == "::" ->
86+ parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
87+ where
88+ isCons =
89+ case hd of
90+ Data ctor _ -> Var.toString ctor == "::"
91+ _ -> False
92+
93+ Data name ps ->
94+ let name' = Var.toString name
95+ in
96+ if Help.isTuple name'
97+ then PP.parens (commaCat (map pretty ps))
98+ else hsep (PP.text name' : map prettyParens ps)
99+
70100
71101prettyParens :: Var.ToString var => Pattern var -> Doc
72102prettyParens pattern =
src/AST/PrettyPrint.hs+23−5
@@ -5,27 +5,43 @@ import Control.Monad.Trans.Error
55import Text.PrettyPrint as P
66import qualified AST.Helpers as Help
77
8+
89class Pretty a where
910 pretty :: a -> Doc
1011
12+
1113instance Pretty Doc where
1214 pretty doc = doc
1315
16+
1417instance Pretty String where
1518 pretty = P.text
1619
20+
1721renderPretty :: (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)
1934
20−commaCat docs = cat (punctuate comma docs)
21−commaSep docs = sep (punctuate comma docs)
2235
2336parensIf :: Bool -> Doc -> Doc
24−parensIf bool doc = if bool then parens doc else doc
37+parensIf bool doc =
38+ if bool then parens doc else doc
39+
2540
2641variable :: String -> Doc
2742variable 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+
2945
3046eightyCharLines :: Int -> String -> String
3147eightyCharLines indent message = answer
@@ -38,9 +54,11 @@ eightyCharLines indent message = answer
3854 | slen + wlen > 79 = (sentence ++ "\n" ++ spaces ++ word, indent + wlen, " ")
3955 | otherwise = (sentence ++ space ++ word, slen + wlen + length space, " ")
4056
57+
4158instance Error Doc where
4259 noMsg = P.empty
4360 strMsg = P.text
4461
62+
4563instance ErrorList Doc where
4664 listMsg str = [ P.text str ]
src/AST/Type.hs+68−33
@@ -9,6 +9,7 @@ import AST.PrettyPrint
99import qualified AST.Helpers as Help
1010import Text.PrettyPrint as P
1111
12+
1213data Type var
1314 = Lambda (Type var) (Type var)
1415 | Var String
@@ -18,47 +19,64 @@ data Type var
1819 | Aliased Var.Canonical (Type var)
1920 deriving (Eq,Show)
2021
21−type RawType = Type Var.Raw
22−type CanonicalType = Type Var.Canonical
22+
23+type RawType =
24+ Type Var.Raw
25+
26+
27+type CanonicalType =
28+ Type Var.Canonical
29+
2330
2431fieldMap :: [(String,a)] -> Map.Map String [a]
2532fieldMap 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+
2735
2836recordOf :: [(String, Type var)] -> Type var
29−recordOf fields = Record fields Nothing
37+recordOf fields =
38+ Record fields Nothing
39+
3040
3141listOf :: RawType -> RawType
32−listOf t = App (Type (Var.Raw "List")) [t]
42+listOf tipe =
43+ App (Type (Var.Raw "List")) [tipe]
44+
3345
3446tupleOf :: [RawType] -> RawType
35−tupleOf ts = App (Type t) ts
36− where
37− t = Var.Raw ("_Tuple" ++ show (length ts))
47+tupleOf types =
48+ let name = Var.Raw ("_Tuple" ++ show (length types))
49+ in
50+ App (Type name) types
51+
3852
3953instance (Var.ToString var, Pretty var) => Pretty (Type var) where
4054 pretty tipe =
4155 case tipe of
42− Lambda _ _ -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
56+ Lambda _ _ ->
57+ P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
4358 where
4459 t:ts = map prettyLambda (collectLambdas tipe)
45− prettyLambda t = case t of
46− Lambda _ _ -> P.parens (pretty t)
47− _ -> pretty t
60+ prettyLambda t =
61+ case t of
62+ Lambda _ _ -> P.parens (pretty t)
63+ _ -> pretty t
4864
49− Var x -> P.text x
65+ Var x ->
66+ P.text x
5067
5168 Type var ->
52− let v = Var.toString var in
53− P.text (if v == "_Tuple0" then "()" else v)
69+ let v = Var.toString var
70+ in
71+ P.text (if v == "_Tuple0" then "()" else v)
5472
5573 App f args ->
5674 case (f,args) of
5775 (Type name, _)
5876 | 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)))
6078
61− _ -> P.hang (pretty f) 2 (P.sep $ map prettyParens args)
79+ _ -> P.hang (pretty f) 2 (P.sep (map prettyParens args))
6280
6381 Record _ _ ->
6482 case flattenRecord tipe of
@@ -84,20 +102,26 @@ instance (Var.ToString var, Pretty var) => Pretty (Type var) where
84102 P.text field <+> P.text ":" <+> pretty tipe
85103
86104 Aliased name t ->
87− let t' = pretty t in
88− if show t' `elem` ["Int", "Float", "String", "Char", "Bool"]
89− then t'
90− else pretty name
105+ let t' = pretty t
106+ in
107+ if show t' `elem` ["Int", "Float", "String", "Char", "Bool"]
108+ then t'
109+ else pretty name
91110
92111
93112collectLambdas :: Type var -> [Type var]
94113collectLambdas tipe =
95114 case tipe of
96− Lambda arg body -> arg : collectLambdas body
97− _ -> [tipe]
115+ Lambda arg body ->
116+ arg : collectLambdas body
117+
118+ _ ->
119+ [tipe]
120+
98121
99122prettyParens :: (Var.ToString var, Pretty var) => Type var -> Doc
100−prettyParens tipe = parensIf (needed tipe) (pretty tipe)
123+prettyParens tipe =
124+ parensIf (needed tipe) (pretty tipe)
101125 where
102126 needed t =
103127 case t of
@@ -105,26 +129,37 @@ prettyParens tipe = parensIf (needed tipe) (pretty tipe)
105129
106130 Lambda _ _ -> True
107131
108− App (Type name) _ | Help.isTuple (Var.toString name) -> False
132+ App (Type name) _
133+ | Help.isTuple (Var.toString name) ->
134+ False
135+
109136 App t' [] -> needed t'
137+
110138 App _ _ -> True
111139
112140 _ -> False
113141
142+
114143flattenRecord :: Type var -> ( [(String, Type var)], Maybe String )
115144flattenRecord tipe =
116− case tipe of
117− Var x -> ([], Just x)
145+ case tipe of
146+ Var x ->
147+ ([], Just x)
148+
149+ Record fields Nothing ->
150+ (fields, Nothing)
118151
119− Record fields Nothing -> (fields, Nothing)
152+ Record fields (Just ext) ->
153+ let (fields',ext') = flattenRecord ext
154+ in
155+ (fields' ++ fields, ext')
120156
121− Record fields (Just ext) ->
122− let (fields',ext') = flattenRecord ext
123− in (fields' ++ fields, ext')
157+ Aliased _ tipe' ->
158+ flattenRecord tipe'
124159
125− Aliased _ tipe' -> flattenRecord tipe'
160+ _ ->
161+ error "Trying to flatten ill-formed record."
126162
127− _ -> error "Trying to flatten ill-formed record."
128163
129164instance Binary var => Binary (Type var) where
130165 put tipe =
src/AST/Variable.hs+6−3
@@ -101,7 +101,8 @@ class ToString a where
101101
102102
103103instance ToString Raw where
104− toString (Raw x) = x
104+ toString (Raw name) =
105+ name
105106
106107
107108instance ToString Canonical where
@@ -178,11 +179,13 @@ getUnion value =
178179-- PRETTY VARIABLES
179180
180181instance Pretty Raw where
181− pretty (Raw var) = variable var
182+ pretty (Raw name) =
183+ variable name
182184
183185
184186instance Pretty Canonical where
185− pretty var = P.text (toString var)
187+ pretty var =
188+ P.text (toString var)
186189
187190
188191instance Pretty a => Pretty (Listing a) where