X-Git-Url: http://git.megacz.com/?p=sbp.git;a=blobdiff_plain;f=src%2Fedu%2Fberkeley%2Fsbp%2Fhaskell%2FSBP.lhs;fp=src%2FSBP.lhs;h=b43bea3a3bf7bddd52bd572ceb494b98702456af;hp=c7bb5db4334fe08b79ec9a30b55e09dadb3ae33f;hb=60b00d51a5d05ba33ae283577fa5a84899430641;hpb=7c4b661233195baede48356f594ebb15f4aa210d

diff --git a/src/SBP.lhs b/src/edu/berkeley/sbp/haskell/SBP.lhs
similarity index 74%
rename from src/SBP.lhs
rename to src/edu/berkeley/sbp/haskell/SBP.lhs
index c7bb5db..b43bea3 100644
--- a/src/SBP.lhs
+++ b/src/edu/berkeley/sbp/haskell/SBP.lhs
@@ -3,37 +3,38 @@
 -- 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
@@ -51,12 +52,22 @@ coalesceFlatHeadlessNodes t@(Tree s children r)
   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))
 
@@ -66,13 +77,15 @@ 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 ""
@@ -95,22 +108,20 @@ haskify t =
      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