remove empty dir

[ghc-hetmet.git] / ghc / compiler / javaGen / PrintJava.lhs

diff --git a/ghc/compiler/javaGen/PrintJava.lhs b/ghc/compiler/javaGen/PrintJava.lhs
index eb0e0f8..eb2811d 100644 (file)
--- a/ghc/compiler/javaGen/PrintJava.lhs
+++ b/ghc/compiler/javaGen/PrintJava.lhs
@@ -27,7 +27,7 @@ compilationUnit :: CompilationUnit -> SDoc
 compilationUnit (Package n ds) = package n (decls ds)
 
 package = \n -> \ds ->
-  text "package" <+> name n <> text ";"
+  text "package" <+> packagename n <> text ";"
   $$
   ds
   
@@ -36,13 +36,13 @@ decls (d:ds) = decl d $$ decls ds
     
 decl = \d ->
   case d of
-    { Import n -> importDecl (name n)
-    ; Field mfs t n e -> field (modifiers mfs) (typ t) (name n) e  
-    ; Constructor mfs n as ss -> constructor (modifiers mfs) (name n) (parameters as) (statements ss)
-    ; Method mfs t n as ss -> method (modifiers mfs) (typ t) (name n) (parameters as) (statements ss)
+    { 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)
     ; Comment s -> comment s
-    ; Interface mfs n is ms -> interface (modifiers mfs) (name n) (extends is) (decls ms)
-    ; Class mfs n x is ms -> clazz (modifiers mfs) (name n) (extends x) (implements is) (decls ms)
+    ; 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)
     }
 
 importDecl n = text "import" <+> n <> text ";"
@@ -61,8 +61,8 @@ constructor = \mfs -> \n -> \as -> \ss ->
   $$ indent ss 
   $$ text "}"
 
-method = \mfs -> \t -> \n -> \as -> \ss -> 
-  mfs <+> t <+> n <+> parens (hsep (punctuate comma as)) <+> text "{" 
+method = \mfs -> \t -> \n -> \as -> \ts -> \ss -> 
+  mfs <+> t <+> n <+> parens (hsep (punctuate comma as)) <+> ts <+> text "{" 
   $$ indent ss 
   $$ text "}"
 
@@ -81,29 +81,42 @@ clazz = \mfs -> \n -> \x -> \is -> \ms ->
   $$ indent ms 
   $$ text "}"
 
-staticblock = \ss ->
-  text "static" <+> text "{"
-  $$ indent ss
-  $$ text "}"
-    
 modifiers mfs = hsep (map modifier mfs)
     
 modifier mf = text $ map toLower (show mf)
   
 extends [] = empty
-extends xs = text "extends" <+> hsep (punctuate comma (map name xs))
+extends xs = text "extends" <+> hsep (punctuate comma (map typename xs))
 
 implements [] = empty
-implements xs = text "implements" <+> hsep (punctuate comma (map name xs))
+implements xs = text "implements" <+> hsep (punctuate comma (map typename xs))
+
+throws [] = empty
+throws xs = text "throws" <+> hsep (punctuate comma (map typename xs))
 
-name ns = hcat (punctuate dot (map text ns))
+name (Name n t)   = text n
+
+nameTy (Name n t) = typ t
+
+typename n        = text n
+packagename n     = text n
 
 parameters as = map parameter as
 
-parameter (Parameter mfs t n) = modifiers mfs <+> typ t <+> name n
+parameter (Parameter mfs n) = modifiers mfs <+> nameTy n <+> name n
+
+typ (PrimType s)  = primtype s
+typ (Type n)      = typename n
+typ (ArrayType t) = typ t <> text "[]"
 
-typ (Type n)  = name n
-typ (Array t) = typ t <> text "[]"
+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"
+primtype PrimVoid    = text "void"
 
 statements ss = vcat (map statement ss)
   
@@ -126,13 +139,11 @@ exprStatement e = e <> semi
 
 declStatement d = d
 
-ifthenelse ((e,s):ecs) ms = sep [text "if", 
-                               indent (parens e) <+> text "{", 
-                               indent s, 
-                             thenelse ecs ms]
+ifthenelse ((e,s):ecs) ms = sep [ text "if" <+> parens e <+> text "{", 
+                                 indent s, 
+                                 thenelse ecs ms]
 
-thenelse ((e,s):ecs) ms = sep [        text "} else if", 
-                               indent (parens e) <+> text "{", 
+thenelse ((e,s):ecs) ms = sep [        text "} else if" <+> parens e <+> text "{", 
                                indent s,
                                thenelse ecs ms]
 
@@ -162,11 +173,12 @@ expr = \e ->
    ; Cast t e -> cast (typ t) e
    ; Access e n -> expr e <> text "." <> name n
    ; Assign l r -> assign (expr l) r
-   ; New n es ds -> new (name n) es (maybeClass ds)
+   ; New n es ds -> new (typ n) es (maybeClass ds)
+   ; Raise n es  -> text "raise" <+> text n
+                       <+> parens (hsep (punctuate comma (map expr es)))
    ; 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
-   ; NewArray n es -> newArray (name n) es
    }
    
 op = \e1 -> \o -> \e2 ->
@@ -197,17 +209,14 @@ new n [] (Just ds) = sep [text "new" <+> n <+> text "()" <+> text "{",
                             text "}"]
 new n es Nothing = text "new" <+> n <> parens (hsep (punctuate comma (map expr es)))
 
-newArray n es = text "new" <+> n <> text "[]" <+> braces (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)
-    ; UIntLit i          -> text (show i)
-    ; CharLit c   -> text (show c)
-    ; UCharLit c  -> text (show c)
-    ; StringLit s -> text (show s)
+    ; CharLit c   -> text "(char)" <+> text (show c)
+    ; StringLit s -> text ("\"" ++ s ++ "\"")  -- strings are already printable
     }
 
 maybeClass Nothing   = Nothing