PrintJava.lhs 5.87 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\section{Generate Java}

\begin{code}
module PrintJava( compilationUnit ) where

import Java
import Outputable
import Char( toLower )
\end{code}

\begin{code}
indent :: SDoc -> SDoc
indent = nest 2
\end{code}
  
%************************************************************************
%*									*
\subsection{Pretty printer}
%*									*
%************************************************************************

\begin{code}
compilationUnit :: CompilationUnit -> SDoc
compilationUnit (Package n ds) = package n (decls ds)

package = \n -> \ds ->
andy's avatar
andy committed
30
  text "package" <+> packagename n <> text ";"
31 32 33 34 35 36 37 38
  $$
  ds
  
decls []     = empty
decls (d:ds) = decl d $$ decls ds
    
decl = \d ->
  case d of
andy's avatar
andy committed
39 40 41 42
    { Import n -> importDecl (packagename n)
    ; Field mfs n e -> field (modifiers mfs) (nameTy n) (name n) e  
    ; Constructor mfs n as ss -> constructor (modifiers mfs) (typename n) (parameters as) (statements ss)
    ; Method mfs n as ts ss -> method (modifiers mfs) (nameTy n) (name n) (parameters as) (throws ts) (statements ss)
43
    ; Comment s -> comment s
andy's avatar
andy committed
44 45
    ; Interface mfs n is ms -> interface (modifiers mfs) (typename n) (extends is) (decls ms)
    ; Class mfs n x is ms -> clazz (modifiers mfs) (typename n) (extends x) (implements is) (decls ms)
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
    }

importDecl n = text "import" <+> n <> text ";"
  
field = \mfs -> \t -> \n -> \e ->
  case e of
    { Nothing -> mfs <+> t <+> n <> text ";" 
    ; Just e  -> lay [mfs <+> t <+> n <+> text "=", indent (expr e <> text ";")]
	     where
		lay | isSimple e = hsep
		    | otherwise  = sep
    }

constructor = \mfs -> \n -> \as -> \ss ->
  mfs <+> n <+> parens (hsep (punctuate comma as)) <+> text "{"
  $$ indent ss 
  $$ text "}"

andy's avatar
andy committed
64 65
method = \mfs -> \t -> \n -> \as -> \ts -> \ss -> 
  mfs <+> t <+> n <+> parens (hsep (punctuate comma as)) <+> ts <+> text "{" 
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
  $$ indent ss 
  $$ text "}"

comment = \ss ->
  text "/**"
  $$ indent (vcat [ text s | s <- ss])
  $$ text "**/"

interface = \mfs -> \n -> \xs -> \ms -> 
  mfs <+> n <+> xs <+> text "{"
  $$ indent ms
  $$ text "}"
     
clazz = \mfs -> \n -> \x -> \is -> \ms ->
  mfs <+> text "class" <+> n <+> x <+> is <+> text "{" 
  $$ indent ms 
  $$ text "}"

modifiers mfs = hsep (map modifier mfs)
    
modifier mf = text $ map toLower (show mf)
  
extends [] = empty
andy's avatar
andy committed
89
extends xs = text "extends" <+> hsep (punctuate comma (map typename xs))
90 91

implements [] = empty
andy's avatar
andy committed
92
implements xs = text "implements" <+> hsep (punctuate comma (map typename xs))
93

andy's avatar
andy committed
94
throws [] = empty
andy's avatar
andy committed
95
throws xs = text "throws" <+> hsep (punctuate comma (map typename xs))
andy's avatar
andy committed
96

andy's avatar
andy committed
97 98 99 100 101 102
name (Name n t)   = text n

nameTy (Name n t) = typ t

typename n        = text n
packagename n     = text n
103 104 105

parameters as = map parameter as

andy's avatar
andy committed
106
parameter (Parameter mfs n) = modifiers mfs <+> nameTy n <+> name n
107

andy's avatar
andy committed
108
typ (PrimType s)  = primtype s
andy's avatar
andy committed
109
typ (Type n)      = typename n
andy's avatar
andy committed
110
typ (ArrayType t) = typ t <> text "[]"
111

andy's avatar
andy committed
112 113 114 115 116 117 118
primtype PrimInt     = text "int"
primtype PrimBoolean = text "boolean"
primtype PrimChar    = text "char"
primtype PrimLong    = text "long"
primtype PrimFloat   = text "float"
primtype PrimDouble  = text "double"
primtype PrimByte    = text "byte"
andy's avatar
andy committed
119
primtype PrimVoid    = text "void"
andy's avatar
andy committed
120

121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
statements ss = vcat (map statement ss)
  
statement = \s ->
  case s of
    { Skip -> skip
    ; Return e -> returnStat (expr e)
    ; Block ss -> vcat [statement s | s <- ss]
    ; ExprStatement e -> exprStatement (expr e)
    ; Declaration d -> declStatement (decl d)
    ; IfThenElse ecs s -> ifthenelse [ (expr e, statement s) | (e,s) <- ecs ] (maybe Nothing (Just .statement) s)
    ; Switch e as d -> switch (expr e) (arms as) (deflt d)
    } 

skip = empty
  
returnStat e = sep [text "return", indent e <> semi]

exprStatement e = e <> semi

declStatement d = d

andy's avatar
andy committed
142 143 144
ifthenelse ((e,s):ecs) ms = sep [ text "if" <+> parens e <+> text "{", 
			          indent s, 
				  thenelse ecs ms]
145

andy's avatar
andy committed
146
thenelse ((e,s):ecs) ms = sep [	text "} else if" <+> parens e <+> text "{", 
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
				indent s,
				thenelse ecs ms]

thenelse [] Nothing  = text "}"
thenelse [] (Just s) = sep [text "} else {", indent s, text "}"]
    
switch = \e -> \as -> \d ->
  text "switch" <+> parens e <+> text "{" 
  $$ indent (as $$ d)
  $$ text "}"
  
deflt Nothing   = empty
deflt (Just ss) = text "default:" $$ indent (statements ss)  
    
arms [] = empty
arms ((e,ss):as) = text "case" <+> expr e <> colon
                   $$ indent (statements ss)
                   $$ arms as

maybeExpr Nothing  = Nothing
maybeExpr (Just e) = Just (expr e)
           
expr = \e ->
 case e of
andy's avatar
andy committed
171 172
   { Var n -> name n
   ; Literal l -> literal l
173 174 175
   ; Cast t e -> cast (typ t) e
   ; Access e n -> expr e <> text "." <> name n
   ; Assign l r -> assign (expr l) r
andy's avatar
andy committed
176
   ; New n es ds -> new (typ n) es (maybeClass ds)
andy's avatar
andy committed
177 178
   ; Raise n es  -> text "raise" <+> text n
			<+> parens (hsep (punctuate comma (map expr es)))
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
   ; Call e n es -> call (expr e) (name n) es
   ; Op e1 o e2 -> op e1 o e2
   ; InstanceOf e t -> expr e <+> text "instanceof" <+> typ t
   }
   
op = \e1 -> \o -> \e2 ->
  ( if isSimple e1 
    then expr e1 
    else parens (expr e1)
  ) 
  <+> 
  text o
  <+>
  ( if isSimple e2
    then expr e2 
    else parens (expr e2)
  )
  
assign = \l -> \r ->
  if isSimple r
  then l <+> text "=" <+> (expr r)
  else l <+> text "=" $$ indent (expr r)

cast = \t -> \e ->
  if isSimple e
  then parens (parens t <> expr e)
  else parens (parens t $$ indent (expr e))

new n [] (Just ds) = sep [text "new" <+> n <+> text "()" <+> text "{",
			     indent ds,
			     text "}"]
new n es Nothing = text "new" <+> n <> parens (hsep (punctuate comma (map expr es)))

      
call e n es = e <> dot <> n <> parens (hsep (punctuate comma (map expr es)))

literal = \l ->
  case l of
    { IntLit i    -> text (show i)
218
    ; CharLit c   -> text "(char)" <+> text (show c)
andy's avatar
andy committed
219
    ; StringLit s -> text ("\"" ++ s ++ "\"")	-- strings are already printable
220 221 222 223 224
    }

maybeClass Nothing   = Nothing
maybeClass (Just ds) = Just (decls ds)
\end{code}