X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FjavaGen%2FPrintJava.lhs;h=edaf8e594fd8b38564485c9363b675116a7ee193;hb=403bcbb47a992484fdf805d2e9d0c538758abb01;hp=29eebd940031b53b960f0572e6fa2fcfd5db8f5d;hpb=9a2de9c08132edca3a63011afd28009408188a1c;p=ghc-hetmet.git

diff --git a/ghc/compiler/javaGen/PrintJava.lhs b/ghc/compiler/javaGen/PrintJava.lhs
index 29eebd9..edaf8e5 100644
--- 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 ts ss -> method (modifiers mfs) (typ t) (name n) (parameters as) (throws ts) (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 ";"
@@ -91,22 +91,27 @@ 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 name xs))
+throws xs = text "throws" <+> hsep (punctuate comma (map typename xs))
 
-name n = text n
+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)      = name n
+typ (Type n)      = typename n
 typ (ArrayType t) = typ t <> text "[]"
 
 primtype PrimInt     = text "int"
@@ -116,8 +121,7 @@ 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)
   
@@ -140,9 +144,9 @@ exprStatement e = e <> semi
 
 declStatement d = d
 
-ifthenelse ((e,s):ecs) ms = sep [text "if" <+> 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" <+> parens e <+> text "{", 
 				indent s,
@@ -169,12 +173,14 @@ maybeExpr (Just e) = Just (expr e)
            
 expr = \e ->
  case e of
-   { Var n _ -> name n
-   ; Literal l _ -> literal l
+   { Var n -> name n
+   ; Literal l -> literal l
    ; 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 (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
@@ -214,10 +220,8 @@ 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