3 -- These bindings are highly experimental and subject to change
4 -- without notice. You've been warned.
6 module SBP(Tree(Tree),Location(Location),Region(Region),parseFile,prettyPrintTree,coalesceFlatHeadlessNodes)
9 #if defined(java_HOST_OS)
12 #define CONCAT(x,y) x/**/y
13 #define DEFINE_OBJECT(s,name) \
14 data CONCAT(name,_); \
15 type name = JObject CONCAT(name,_); \
16 foreign import jvm s CONCAT(_,name) :: JClass; \
17 instance JType_ CONCAT(name,_) where jClass_ _ = CONCAT(_,name);
20 import Class_HaskellHelper;
21 import Class_java_lang_Object;
22 import Class_java_lang_Class;
23 import Class_java_lang_String;
24 import Class_edu_berkeley_sbp_Tree;
25 import Header_edu_berkeley_sbp_Tree;
26 import JVM_HaskellHelper;
27 import Header_HaskellHelper;
35 --import Text.PrettyPrint.HughesPJ
36 import Text.PrettyPrint.Leijen
38 data Location = Location Int Int
39 data Region = Region Location Location
41 data Tree = Tree String [Tree] Region
44 show t@(Tree _ _ _) = show $ prettyPrintTree $ t
46 coalesceFlatHeadlessNodes t@(Tree s children r)
47 | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
48 | otherwise = Tree s (map coalesceFlatHeadlessNodes children) r
50 flat (Tree _ children _) = not (any id $ map notFlatComponent children)
51 notFlatComponent (Tree _ [] _) = False
52 notFlatComponent (Tree _ _ _) = True
55 prettyPrintTree (Tree "" [] _) = empty
56 prettyPrintTree (Tree s [] _) = text s
57 prettyPrintTree (Tree [] children _) = prettyPrintTreeList children
58 prettyPrintTree (Tree s children _) = (text (s++":")) <$$> (prettyPrintTreeList children)
59 prettyPrintTreeList [] = text "{}"
60 prettyPrintTreeList children
61 | allsingles children = text $ "\"" ++ (concatMap (\(Tree s _ _) -> s) children) ++ "\""
62 | otherwise = hang 2 $
66 ((fsep $ map (group . prettyPrintTree) children)
69 allsingles = all (\(Tree s c _) -> (length s)==1 && (length c)==0)
71 nullRegion = (Region (Location 0 0) (Location 0 0))
75 ------------------------------------------------------------------------------
76 #if defined(java_HOST_OS)
77 foreign import jvm type "edu.berkeley.sbp.Tree" JTree#
78 data JTree = JTree JTree#
79 foreign import jvm type "java.lang.Object" Object#
80 data Object = Object Object#
81 foreign import jvm safe "edu.berkeley.sbp.misc.RegressionTests.main" regressionTests :: IO ()
82 foreign import jvm safe "HaskellHelper.help" haskellHelper :: JString -> IO JTree
83 foreign import jvm safe "HaskellHelper.isNull" isNull :: Object -> IO Bool
84 foreign import jvm safe "getHead" getHead :: JTree -> IO Object
85 foreign import jvm safe "child" getChild :: JTree -> Int32 -> IO JTree
86 foreign import jvm safe "size" size :: JTree -> IO Int32
87 foreign import jvm safe "toString" jtoString :: Object -> IO JString
89 toString o = do isn <- isNull o
91 else do str <- jtoString o
92 return (unpackJString str)
95 haskify :: JTree -> IO Tree
100 children <- if numChildren == 0
102 else do children <- mapM (\i -> getChild t i)
103 $ take (fromIntegral numChildren)
105 h <- mapM haskify children
107 return $ Tree str children nullRegion
110 String -> -- file to be parsed
113 parseFile f = do f' <- packJString f
114 tree <- haskellHelper f'
118 ------------------------------------------------------------------------------
120 -- Why do I need this?
121 instance SubJavaClassMarker
122 Header_edu_berkeley_sbp_Tree.Class_Jedu_berkeley_sbp_Tree
123 Header_HaskellHelper.Class_Jedu_berkeley_sbp_Tree
126 [String] -> -- class path
127 String -> -- grammar *.g file
128 String -> -- file to be parsed
131 parseFile classPath grammarFile inputFile =
133 ((do class_JHaskellHelper
134 s1 <- new_JString_ArrayJchar $ toJavaString grammarFile
135 s2 <- new_JString_ArrayJchar $ toJavaString inputFile
136 tree <- main_JHaskellHelper_JString_JString (s1, s2)
137 t <- haskifyTree tree
142 ((do class_JHaskellHelper
144 head <- getHead_JTree t ()
145 isNull <- getIsNothing head
146 str <- if isNull then (return "") else (toString_JObject ((castTLRef head) :: Jjava_lang_Object) () >>= getStringUTF >>= \x -> return (showUTF8 x))
147 numChildren <- size_JTree t()
148 children <- if numChildren == 0
150 else do children <- mapM (\i -> child_JTree_Jint t ((fromIntegral i)::Int32))
151 $ take (fromIntegral numChildren)
153 h <- mapM (\c -> haskifyTree (castTLRef c)) children
155 return $ Tree str children nullRegion