2 Copyright(C) 1999 Erik Meijer and Arjan van Yzendoorn
4 module SimpleMondrianPrinter where
13 compilationUnit :: CompilationUnit -> Doc
14 compilationUnit = \m ->
16 { Package n ds -> package m (name n) (decls ds)
19 package = \(Package n' ds') -> \n -> \ds ->
21 { True -> text "package" <+> n <+> row ds
22 ; False -> text "package" <+> n <-> nest (-mondrianIndent) (column ds)
25 decls = \ds -> [ decl d | d <- ds ]
29 { ImportDecl ns -> importDecl d (name ns)
30 ; ClassDecl n xs ds -> classDecl d (name n) (extends xs) (decls ds)
31 ; SigDecl n t -> sigDecl (name n) (expr t)
32 ; VarDecl v (Lambda ns e) -> varDecl d (name v) (lambdas ns) (expr e)
33 ; VarDecl v e -> decl (VarDecl v (Lambda [] e))
39 ; [x] -> text "extends" <+> name x <+> empty
40 ; xs -> text "multiple inheritance not supported" <+> row [name x | x <- xs]
43 classDecl = \(ClassDecl n' xs' ds') -> \n -> \xs -> \ds ->
45 { [] -> text "class" <+> n <+> xs
46 ; otherwise -> text "class" <+> n <+> xs <-> column ds
49 sigDecl = \n -> \t -> n <+> text "::" <+> t
51 importDecl = \d -> \n -> text "import" <+> n
53 varDecl = \(VarDecl v' (Lambda ns' e')) -> \v -> \ns -> \e ->
55 then v <+> text "=" <+> ns <|> e
56 else v <+> text "=" <+> ns <-> nest mondrianIndent e
58 names = \ns -> horizontal (text " ") [ name n | n <- ns ]
60 name = \ns -> horizontal (text ".") [text n | n <- ns]
65 ; [n] -> text "\\" <|> name n <+> text "->" <+> empty
66 ; n:ns -> text "\\" <|> name n <+> text "->" <+> lambdas ns
73 ; App f a -> application (expr f) (expr a)
74 ; Lambda ns b -> lambdaExpr e (lambdas ns) (expr b)
75 ; New n ds -> newExpr e (name n) (decls ds)
76 ; Case e1 as -> caseExpr e (expr e1) (arms as)
77 ; Let ds e1 -> letExpr e (decls ds) (expr e1)
78 ; Chain e1 oes -> chain e1 oes
81 application = \f -> \a -> text "(" <|> f <+> a <|> text ")"
83 newExpr = \(New n' ds') -> \n -> \ds ->
85 { [] -> text "new" <+> n
88 then text "new" <+> n <+> row ds
89 else text "new" <+> n <-> column ds
92 lambdaExpr = \(Lambda ns' e') -> \ns -> \e ->
95 else ns <-> nest mondrianIndent e
97 caseExpr :: Expr -> Doc -> [Doc] -> Doc
98 caseExpr = \(Case e' as') -> \e -> \as ->
99 case (isSimpleExpr e', isSimpleArms as') of
100 { (True, True) -> text "case" <+> e <+> text "of" <+> row as
101 ; (True, False)-> text "case" <+> e <+> text "of" <-> column as
102 ; (False, True) -> text "case" <-> nest mondrianIndent e <-> text "of" <+> row as
103 ; (False, False) -> text "case" <-> nest mondrianIndent e <-> text "of" <-> column as
106 letExpr = \(Let ds' e') -> \ds -> \e ->
107 case (length ds' == 1 && isSimpleDecls ds', isSimpleExpr e') of
108 { (True, True) -> text "let" <+> row ds <+> text "in" <+> e
109 ; (True, False) -> text "let" <+> row ds <-> text "in" <-> nest mondrianIndent e
110 ; (False, True) -> text "let" <-> column ds <-> text "in" <+> e
111 ; (False, False) -> text "let" <-> column ds <-> text "in" <-> nest mondrianIndent e
114 arms = \as -> [ arm (p,e) (pattern p) (expr e) | (p,e) <- as ]
116 arm = \(p',e') -> \p -> \e ->
117 if isSimplePattern p' && isSimpleExpr e'
118 then p <+> text "->" <+> e
119 else p <+> text "->" <-> nest mondrianIndent e
121 -- This is a dirty hack!
123 chain = \e -> \oes ->
126 ; ([""],f):oes -> if (isSimpleExpr f)
127 then (bracket e) <+> chain f oes
128 else (bracket e) <-> nest 2 (chain f oes)
129 ; (o,f):oes -> if (isSimpleExpr f)
130 then (bracket e) <+> name o <+> chain f oes
131 else (bracket e) <-> name o <+> chain f oes
139 ; otherwise -> name n <+> row (decls ds)
141 ; Default -> text "default"
146 { IntLit i -> text (show i)
147 ; CharLit c -> text (show c)
148 ; StringLit s -> text (show s)
158 par = \e -> text "(" <|> e <|> text ")"
160 column = \ds -> nest mondrianIndent (block (text "{ ", text ";" <+> empty, text "}") ds)
162 row = \ds -> text "{" <|> horizontal (text ";" <+> empty) ds <|> text "}"