X-Git-Url: http://git.megacz.com/?p=sbp.git;a=blobdiff_plain;f=src%2FSBP.lhs;h=c7bb5db4334fe08b79ec9a30b55e09dadb3ae33f;hp=61a30a53b080902907a1760cf5930af03e5dd437;hb=eee310fc34d114be6b366f1a94fe6fe49da8b99b;hpb=0f9676168fa7384f8cf66ed02c1c8caa22381206

diff --git a/src/SBP.lhs b/src/SBP.lhs
index 61a30a5..c7bb5db 100644
--- a/src/SBP.lhs
+++ b/src/SBP.lhs
@@ -3,21 +3,37 @@
 -- These bindings are highly experimental and subject to change
 -- without notice.  You've been warned.
 --
-module SBP(Tree(Tree),Location(Location),Region(Region),parseFile,prettyPrintTree)
- where
+module SBP(Tree(Tree),Location(Location),Region(Region),parseFile,prettyPrintTree,coalesceFlatHeadlessNodes)
+where
 
 #if defined(java_HOST_OS)
-
+import Foreign
+import Foreign.Java
+import Text.PrettyPrint.HughesPJ
 #define CONCAT(x,y) x/**/y
 #define DEFINE_OBJECT(s,name) \
 data CONCAT(name,_); \
 type name = Object CONCAT(name,_); \
 foreign import jvm s CONCAT(_,name) :: JClass; \
 instance JType_ CONCAT(name,_) where jClass_ _ = CONCAT(_,name);
-
-import Foreign
-import Foreign.Java
+#else
+import Header_Java;
+import Class_edu_berkeley_sbp_misc_HaskellHelper;
+import Class_java_lang_Object;
+import Class_java_lang_Class;
+import Class_java_lang_String;
+import Class_edu_berkeley_sbp_Tree;
+import Header_edu_berkeley_sbp_Tree;
+import JVM_edu_berkeley_sbp_misc_HaskellHelper;
+import Header_edu_berkeley_sbp_misc_HaskellHelper;
+import TypedString;
+import JVMBridge;
+import JavaText;
+import JavaTypes;
+import Data.Int;
+import Invocation;
 import Text.PrettyPrint.HughesPJ
+#endif
 
 data Location = Location Int Int
 data Region   = Region Location Location
@@ -37,17 +53,19 @@ coalesceFlatHeadlessNodes t@(Tree s children r)
 
 prettyPrintTree (Tree "" []       _) = empty
 prettyPrintTree (Tree s  []       _) = text s
-prettyPrintTree t@(Tree s children _)
-  | s==[]     = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
-  | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
-   where
-    prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
+prettyPrintTree (Tree [] children _) = prettyPrintTreeList children
+prettyPrintTree (Tree s  children _) = (text (s++":")) <+> (nest 4 $ prettyPrintTreeList children)
+prettyPrintTreeList []               = text "{}"
+prettyPrintTreeList children         = (text "{") <+> ((fsep $ map prettyPrintTree children) <+> (text "}"))
 
 nullRegion = (Region (Location 0 0) (Location 0 0))
 
+
+
+------------------------------------------------------------------------------
+#if defined(java_HOST_OS)
 foreign import jvm type "edu.berkeley.sbp.Tree" JTree#
 data JTree = JTree JTree#
-
 foreign import jvm safe "edu.berkeley.sbp.misc.RegressionTests.main" regressionTests :: IO ()
 foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.help" haskellHelper :: JString -> JString -> IO JTree
 foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.isNull" isNull :: (Object a) -> IO Bool
@@ -87,55 +105,13 @@ parseFile g f = do g' <- packJString g
                    x <- haskify tree
                    return x
 
+------------------------------------------------------------------------------
 #else
-  import Header_Java;
-  import Class_edu_berkeley_sbp_misc_HaskellHelper;
-  import Class_java_lang_Object;
-  import Class_java_lang_Class;
-  import Class_java_lang_String;
-  import Class_edu_berkeley_sbp_Tree;
-  import Header_edu_berkeley_sbp_Tree;
-  import JVM_edu_berkeley_sbp_misc_HaskellHelper;
-  import Header_edu_berkeley_sbp_misc_HaskellHelper;
-  import TypedString;
-  import JVMBridge;
-  import JavaText;
-  import JavaTypes;
-  import Data.Int;
-  import Invocation;
-  import Text.PrettyPrint.HughesPJ
-
   -- Why do I need this?
   instance SubJavaClassMarker
       Header_edu_berkeley_sbp_Tree.Class_Jedu_berkeley_sbp_Tree
       Header_edu_berkeley_sbp_misc_HaskellHelper.Class_Jedu_berkeley_sbp_Tree
 
-  data Location = Location Int Int
-  data Region   = Region Location Location
-
-  data Tree     = Tree String [Tree] Region
-  instance Show Tree
-   where
-    show t@(Tree _ _ _) = show $ prettyPrintTree $ t
-
-  coalesceFlatHeadlessNodes t@(Tree s children r)
-    | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
-    | otherwise     = Tree s (map coalesceFlatHeadlessNodes children) r
-   where
-    flat (Tree _ children _) = not (any id $ map notFlatComponent children)
-    notFlatComponent (Tree _ [] _) = False
-    notFlatComponent (Tree _ _  _) = True
-
-  prettyPrintTree (Tree "" []       _) = empty
-  prettyPrintTree (Tree s  []       _) = text s
-  prettyPrintTree t@(Tree s children _)
-    | s==[]     = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
-    | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
-     where
-      prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
-
-  nullRegion = (Region (Location 0 0) (Location 0 0))
-
   parseFile ::
    [String] ->   -- class path
    String   ->   -- grammar *.g file