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)
9 #if defined(java_HOST_OS)
11 #define CONCAT(x,y) x/**/y
12 #define DEFINE_OBJECT(s,name) \
13 data CONCAT(name,_); \
14 type name = Object CONCAT(name,_); \
15 foreign import jvm s CONCAT(_,name) :: JClass; \
16 instance JType_ CONCAT(name,_) where jClass_ _ = CONCAT(_,name);
20 import Text.PrettyPrint.HughesPJ
22 data Location = Location Int Int
23 data Region = Region Location Location
25 data Tree = Tree String [Tree] Region
28 show t@(Tree _ _ _) = show $ prettyPrintTree $ t
30 coalesceFlatHeadlessNodes t@(Tree s children r)
31 | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
32 | otherwise = Tree s (map coalesceFlatHeadlessNodes children) r
34 flat (Tree _ children _) = not (any id $ map notFlatComponent children)
35 notFlatComponent (Tree _ [] _) = False
36 notFlatComponent (Tree _ _ _) = True
38 prettyPrintTree (Tree "" [] _) = empty
39 prettyPrintTree (Tree s [] _) = text s
40 prettyPrintTree t@(Tree s children _)
41 | s==[] = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
42 | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
44 prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
46 nullRegion = (Region (Location 0 0) (Location 0 0))
48 foreign import jvm type "edu.berkeley.sbp.Tree" JTree#
49 data JTree = JTree JTree#
51 foreign import jvm safe "edu.berkeley.sbp.misc.RegressionTests.main" regressionTests :: IO ()
52 foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.help" haskellHelper :: JString -> JString -> IO JTree
53 foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.isNull" isNull :: (Object a) -> IO Bool
54 foreign import jvm safe "getHead" getHead :: JTree -> IO (Object a)
55 foreign import jvm safe "child" getChild :: JTree -> Int32 -> IO JTree
56 foreign import jvm safe "size" size :: JTree -> IO Int32
57 foreign import jvm safe "toString" jtoString :: (Object a) -> IO JString
59 toString o = do isn <- isNull o
61 else do str <- jtoString o
62 return (unpackJString str)
65 haskify :: JTree -> IO Tree
70 children <- if numChildren == 0
72 else do children <- mapM (\i -> getChild t i)
73 $ take (fromIntegral numChildren)
75 h <- mapM haskify children
77 return $ Tree str children nullRegion
80 String -> -- grammar *.g file
81 String -> -- file to be parsed
84 parseFile g f = do g' <- packJString g
86 tree <- haskellHelper g' f'
92 import Class_edu_berkeley_sbp_misc_HaskellHelper;
93 import Class_java_lang_Object;
94 import Class_java_lang_Class;
95 import Class_java_lang_String;
96 import Class_edu_berkeley_sbp_Tree;
97 import Header_edu_berkeley_sbp_Tree;
98 import JVM_edu_berkeley_sbp_misc_HaskellHelper;
99 import Header_edu_berkeley_sbp_misc_HaskellHelper;
106 import Text.PrettyPrint.HughesPJ
108 -- Why do I need this?
109 instance SubJavaClassMarker
110 Header_edu_berkeley_sbp_Tree.Class_Jedu_berkeley_sbp_Tree
111 Header_edu_berkeley_sbp_misc_HaskellHelper.Class_Jedu_berkeley_sbp_Tree
113 data Location = Location Int Int
114 data Region = Region Location Location
116 data Tree = Tree String [Tree] Region
119 show t@(Tree _ _ _) = show $ prettyPrintTree $ t
121 coalesceFlatHeadlessNodes t@(Tree s children r)
122 | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
123 | otherwise = Tree s (map coalesceFlatHeadlessNodes children) r
125 flat (Tree _ children _) = not (any id $ map notFlatComponent children)
126 notFlatComponent (Tree _ [] _) = False
127 notFlatComponent (Tree _ _ _) = True
129 prettyPrintTree (Tree "" [] _) = empty
130 prettyPrintTree (Tree s [] _) = text s
131 prettyPrintTree t@(Tree s children _)
132 | s==[] = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
133 | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
135 prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
137 nullRegion = (Region (Location 0 0) (Location 0 0))
140 [String] -> -- class path
141 String -> -- grammar *.g file
142 String -> -- file to be parsed
145 parseFile classPath grammarFile inputFile =
147 ((do class_JHaskellHelper
148 s1 <- new_JString_ArrayJchar $ toJavaString grammarFile
149 s2 <- new_JString_ArrayJchar $ toJavaString inputFile
150 tree <- main_JHaskellHelper_JString_JString (s1, s2)
151 t <- haskifyTree tree
156 ((do class_JHaskellHelper
158 head <- getHead_JTree t ()
159 isNull <- getIsNothing head
160 str <- if isNull then (return "") else (toString_JObject ((castTLRef head) :: Jjava_lang_Object) () >>= getStringUTF >>= \x -> return (showUTF8 x))
161 numChildren <- size_JTree t()
162 children <- if numChildren == 0
164 else do children <- mapM (\i -> child_JTree_Jint t ((fromIntegral i)::Int32))
165 $ take (fromIntegral numChildren)
167 h <- mapM (\c -> haskifyTree (castTLRef c)) children
169 return $ Tree str children nullRegion