-- 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,coalesceFlatHeadlessNodes)
+module Edu.Berkeley.Sbp.Haskell.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,_); \
+type name = JObject CONCAT(name,_); \
foreign import jvm s CONCAT(_,name) :: JClass; \
instance JType_ CONCAT(name,_) where jClass_ _ = CONCAT(_,name);
#else
import Header_Java;
-import Class_edu_berkeley_sbp_misc_HaskellHelper;
+import Class_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 JVM_HaskellHelper;
+import Header_HaskellHelper;
import TypedString;
import JVMBridge;
import JavaText;
import JavaTypes;
import Data.Int;
import Invocation;
-import Text.PrettyPrint.HughesPJ
#endif
+--import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint.Leijen
data Location = Location Int Int
data Region = Region Location Location
notFlatComponent (Tree _ [] _) = False
notFlatComponent (Tree _ _ _) = True
+fsep = fillSep
prettyPrintTree (Tree "" [] _) = empty
prettyPrintTree (Tree s [] _) = text s
prettyPrintTree (Tree [] children _) = prettyPrintTreeList children
-prettyPrintTree (Tree s children _) = (text (s++":")) <+> (nest 4 $ prettyPrintTreeList children)
+prettyPrintTree (Tree s children _) = (text (s++":")) <$$> (prettyPrintTreeList children)
prettyPrintTreeList [] = text "{}"
-prettyPrintTreeList children = (text "{") <+> ((fsep $ map prettyPrintTree children) <+> (text "}"))
+prettyPrintTreeList children
+ | allsingles children = text $ "\"" ++ (concatMap (\(Tree s _ _) -> s) children) ++ "\""
+ | otherwise = hang 2 $
+ (text "{")
+ <+>
+ (group
+ ((fsep $ map (group . prettyPrintTree) children)
+ <+>
+ (text "}")))
+allsingles = all (\(Tree s c _) -> (length s)==1 && (length c)==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 "java.lang.Object" Object#
+data Object = Object Object#
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 "getHead" getHead :: JTree -> IO (Object a)
+foreign import jvm safe "HaskellHelper.help" haskellHelper :: JString -> IO JTree
+foreign import jvm safe "HaskellHelper.isNull" isNull :: Object -> IO Bool
+foreign import jvm safe "getHead" getHead :: JTree -> IO Object
foreign import jvm safe "child" getChild :: JTree -> Int32 -> IO JTree
foreign import jvm safe "size" size :: JTree -> IO Int32
-foreign import jvm safe "toString" jtoString :: (Object a) -> IO JString
+foreign import jvm safe "toString" jtoString :: Object -> IO JString
toString o = do isn <- isNull o
if isn then return ""
return $ Tree str children nullRegion
parseFile ::
- String -> -- grammar *.g file
String -> -- file to be parsed
IO Tree
-parseFile g f = do g' <- packJString g
- f' <- packJString f
- tree <- haskellHelper g' f'
- x <- haskify tree
- return x
+parseFile f = do f' <- packJString f
+ tree <- haskellHelper f'
+ x <- haskify tree
+ return x
------------------------------------------------------------------------------
#else
-- 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
+ Header_HaskellHelper.Class_Jedu_berkeley_sbp_Tree
parseFile ::
[String] -> -- class path