compiler/javaGen/PrintJava.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section{Generate Java}
   5
   6 \begin{code}
   7 module PrintJava( compilationUnit ) where
   8
   9 import Java
  10 import Outputable
  11 import Char( toLower )
  12 \end{code}
  13
  14 \begin{code}
  15 indent :: SDoc -> SDoc
  16 indent = nest 2
  17 \end{code}
  18
  19 %************************************************************************
  20 %*                                                                      *
  21 \subsection{Pretty printer}
  22 %*                                                                      *
  23 %************************************************************************
  24
  25 \begin{code}
  26 compilationUnit :: CompilationUnit -> SDoc
  27 compilationUnit (Package n ds) = package n (decls ds)
  28
  29 package = \n -> \ds ->
  30   text "package" <+> packagename n <> text ";"
  31   $$
  32   ds
  33
  34 decls []     = empty
  35 decls (d:ds) = decl d $$ decls ds
  36
  37 decl = \d ->
  38   case d of
  39     { Import n -> importDecl (packagename n)
  40     ; Field mfs n e -> field (modifiers mfs) (nameTy n) (name n) e
  41     ; Constructor mfs n as ss -> constructor (modifiers mfs) (typename n) (parameters as) (statements ss)
  42     ; Method mfs n as ts ss -> method (modifiers mfs) (nameTy n) (name n) (parameters as) (throws ts) (statements ss)
  43     ; Comment s -> comment s
  44     ; Interface mfs n is ms -> interface (modifiers mfs) (typename n) (extends is) (decls ms)
  45     ; Class mfs n x is ms -> clazz (modifiers mfs) (typename n) (extends x) (implements is) (decls ms)
  46     }
  47
  48 importDecl n = text "import" <+> n <> text ";"
  49
  50 field = \mfs -> \t -> \n -> \e ->
  51   case e of
  52     { Nothing -> mfs <+> t <+> n <> text ";"
  53     ; Just e  -> lay [mfs <+> t <+> n <+> text "=", indent (expr e <> text ";")]
  54              where
  55                 lay | isSimple e = hsep
  56                     | otherwise  = sep
  57     }
  58
  59 constructor = \mfs -> \n -> \as -> \ss ->
  60   mfs <+> n <+> parens (hsep (punctuate comma as)) <+> text "{"
  61   $$ indent ss
  62   $$ text "}"
  63
  64 method = \mfs -> \t -> \n -> \as -> \ts -> \ss ->
  65   mfs <+> t <+> n <+> parens (hsep (punctuate comma as)) <+> ts <+> text "{"
  66   $$ indent ss
  67   $$ text "}"
  68
  69 comment = \ss ->
  70   text "/**"
  71   $$ indent (vcat [ text s | s <- ss])
  72   $$ text "**/"
  73
  74 interface = \mfs -> \n -> \xs -> \ms ->
  75   mfs <+> n <+> xs <+> text "{"
  76   $$ indent ms
  77   $$ text "}"
  78
  79 clazz = \mfs -> \n -> \x -> \is -> \ms ->
  80   mfs <+> text "class" <+> n <+> x <+> is <+> text "{"
  81   $$ indent ms
  82   $$ text "}"
  83
  84 modifiers mfs = hsep (map modifier mfs)
  85
  86 modifier mf = text $ map toLower (show mf)
  87
  88 extends [] = empty
  89 extends xs = text "extends" <+> hsep (punctuate comma (map typename xs))
  90
  91 implements [] = empty
  92 implements xs = text "implements" <+> hsep (punctuate comma (map typename xs))
  93
  94 throws [] = empty
  95 throws xs = text "throws" <+> hsep (punctuate comma (map typename xs))
  96
  97 name (Name n t)   = text n
  98
  99 nameTy (Name n t) = typ t
 100
 101 typename n        = text n
 102 packagename n     = text n
 103
 104 parameters as = map parameter as
 105
 106 parameter (Parameter mfs n) = modifiers mfs <+> nameTy n <+> name n
 107
 108 typ (PrimType s)  = primtype s
 109 typ (Type n)      = typename n
 110 typ (ArrayType t) = typ t <> text "[]"
 111
 112 primtype PrimInt     = text "int"
 113 primtype PrimBoolean = text "boolean"
 114 primtype PrimChar    = text "char"
 115 primtype PrimLong    = text "long"
 116 primtype PrimFloat   = text "float"
 117 primtype PrimDouble  = text "double"
 118 primtype PrimByte    = text "byte"
 119 primtype PrimVoid    = text "void"
 120
 121 statements ss = vcat (map statement ss)
 122
 123 statement = \s ->
 124   case s of
 125     { Skip -> skip
 126     ; Return e -> returnStat (expr e)
 127     ; Block ss -> vcat [statement s | s <- ss]
 128     ; ExprStatement e -> exprStatement (expr e)
 129     ; Declaration d -> declStatement (decl d)
 130     ; IfThenElse ecs s -> ifthenelse [ (expr e, statement s) | (e,s) <- ecs ] (maybe Nothing (Just .statement) s)
 131     ; Switch e as d -> switch (expr e) (arms as) (deflt d)
 132     }
 133
 134 skip = empty
 135
 136 returnStat e = sep [text "return", indent e <> semi]
 137
 138 exprStatement e = e <> semi
 139
 140 declStatement d = d
 141
 142 ifthenelse ((e,s):ecs) ms = sep [ text "if" <+> parens e <+> text "{",
 143                                   indent s,
 144                                   thenelse ecs ms]
 145
 146 thenelse ((e,s):ecs) ms = sep [ text "} else if" <+> parens e <+> text "{",
 147                                 indent s,
 148                                 thenelse ecs ms]
 149
 150 thenelse [] Nothing  = text "}"
 151 thenelse [] (Just s) = sep [text "} else {", indent s, text "}"]
 152
 153 switch = \e -> \as -> \d ->
 154   text "switch" <+> parens e <+> text "{"
 155   $$ indent (as $$ d)
 156   $$ text "}"
 157
 158 deflt Nothing   = empty
 159 deflt (Just ss) = text "default:" $$ indent (statements ss)
 160
 161 arms [] = empty
 162 arms ((e,ss):as) = text "case" <+> expr e <> colon
 163                    $$ indent (statements ss)
 164                    $$ arms as
 165
 166 maybeExpr Nothing  = Nothing
 167 maybeExpr (Just e) = Just (expr e)
 168
 169 expr = \e ->
 170  case e of
 171    { Var n -> name n
 172    ; Literal l -> literal l
 173    ; Cast t e -> cast (typ t) e
 174    ; Access e n -> expr e <> text "." <> name n
 175    ; Assign l r -> assign (expr l) r
 176    ; New n es ds -> new (typ n) es (maybeClass ds)
 177    ; Raise n es  -> text "raise" <+> text n
 178                         <+> parens (hsep (punctuate comma (map expr es)))
 179    ; Call e n es -> call (expr e) (name n) es
 180    ; Op e1 o e2 -> op e1 o e2
 181    ; InstanceOf e t -> expr e <+> text "instanceof" <+> typ t
 182    }
 183
 184 op = \e1 -> \o -> \e2 ->
 185   ( if isSimple e1
 186     then expr e1
 187     else parens (expr e1)
 188   )
 189   <+>
 190   text o
 191   <+>
 192   ( if isSimple e2
 193     then expr e2
 194     else parens (expr e2)
 195   )
 196
 197 assign = \l -> \r ->
 198   if isSimple r
 199   then l <+> text "=" <+> (expr r)
 200   else l <+> text "=" $$ indent (expr r)
 201
 202 cast = \t -> \e ->
 203   if isSimple e
 204   then parens (parens t <> expr e)
 205   else parens (parens t $$ indent (expr e))
 206
 207 new n [] (Just ds) = sep [text "new" <+> n <+> text "()" <+> text "{",
 208                              indent ds,
 209                              text "}"]
 210 new n es Nothing = text "new" <+> n <> parens (hsep (punctuate comma (map expr es)))
 211
 212
 213 call e n es = e <> dot <> n <> parens (hsep (punctuate comma (map expr es)))
 214
 215 literal = \l ->
 216   case l of
 217     { IntLit i    -> text (show i)
 218     ; CharLit c   -> text "(char)" <+> text (show c)
 219     ; StringLit s -> text ("\"" ++ s ++ "\"")   -- strings are already printable
 220     }
 221
 222 maybeClass Nothing   = Nothing
 223 maybeClass (Just ds) = Just (decls ds)
 224 \end{code}