diff options
Diffstat (limited to 'compiler/javaGen/PrintJava.lhs')
| -rw-r--r-- | compiler/javaGen/PrintJava.lhs | 231 |
1 files changed, 0 insertions, 231 deletions
diff --git a/compiler/javaGen/PrintJava.lhs b/compiler/javaGen/PrintJava.lhs deleted file mode 100644 index 7ed295ca68..0000000000 --- a/compiler/javaGen/PrintJava.lhs +++ /dev/null @@ -1,231 +0,0 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 -% -\section{Generate Java} - -\begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - -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 -> - text "package" <+> packagename n <> text ";" - $$ - ds - -decls [] = empty -decls (d:ds) = decl d $$ decls ds - -decl = \d -> - case d of - { 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) (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 ";" - -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 "}" - -method = \mfs -> \t -> \n -> \as -> \ts -> \ss -> - mfs <+> t <+> n <+> parens (hsep (punctuate comma as)) <+> ts <+> text "{" - $$ 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 -extends xs = text "extends" <+> hsep (punctuate comma (map typename xs)) - -implements [] = empty -implements xs = text "implements" <+> hsep (punctuate comma (map typename xs)) - -throws [] = empty -throws xs = text "throws" <+> hsep (punctuate comma (map typename xs)) - -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 n) = modifiers mfs <+> nameTy n <+> name n - -typ (PrimType s) = primtype s -typ (Type n) = typename n -typ (ArrayType 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) - -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 - -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, - 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 - { 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 - } - -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) - ; CharLit c -> text "(char)" <+> text (show c) - ; StringLit s -> text ("\"" ++ s ++ "\"") -- strings are already printable - } - -maybeClass Nothing = Nothing -maybeClass (Just ds) = Just (decls ds) -\end{code} |