removed TibDoc/Haskell stuff

[sbp.git] / src / SBP.lhs

diff --git a/src/SBP.lhs b/src/SBP.lhs
index 61a30a5..c7bb5db 100644 (file)
--- 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.
 --
 -- 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)
 
 #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);
 #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
 import Text.PrettyPrint.HughesPJ

+#endif

 
 data Location = Location Int Int
 data Region   = Region Location Location
 
 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 (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))
 
 
 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 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
 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
 
                    x <- haskify tree
                    return x
 

+------------------------------------------------------------------------------

 #else
 #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
 
   -- 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
   parseFile ::
    [String] ->   -- class path
    String   ->   -- grammar *.g file