Reorganisation of the source tree

Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.

The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level.  The build system now makes no
pretense at being multi-project, it is just the GHC build system.

No doubt this will break many things, and there will be a period of
instability while we fix the dependencies.  A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.

1 files changed, 224 insertions, 0 deletions

diff --git a/compiler/javaGen/PrintJava.lhs b/compiler/javaGen/PrintJava.lhs
new file mode 100644
index 0000000000..eb2811d38f
--- /dev/null
+++ b/compiler/javaGen/PrintJava.lhs
@@ -0,0 +1,224 @@
+%
+% (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 ->
+  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}