-- 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
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
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