2 -- These bindings are highly experimental and subject to change
3 -- without notice. You've been warned.
9 import Class_edu_berkeley_sbp_misc_HaskellHelper;
10 import Class_java_lang_Object;
11 import Class_java_lang_Class;
12 import Class_java_lang_String;
13 import Class_edu_berkeley_sbp_Tree;
14 import Header_edu_berkeley_sbp_Tree;
15 import JVM_edu_berkeley_sbp_misc_HaskellHelper;
16 import Header_edu_berkeley_sbp_misc_HaskellHelper;
23 import Text.PrettyPrint.HughesPJ
25 -- Why do I need this?
26 instance SubJavaClassMarker
27 Header_edu_berkeley_sbp_Tree.Class_Jedu_berkeley_sbp_Tree
28 Header_edu_berkeley_sbp_misc_HaskellHelper.Class_Jedu_berkeley_sbp_Tree
30 data Location = Location Int Int
31 data Region = Region Location Location
33 data Tree = Tree String [Tree] Region
36 show t@(Tree _ _ _) = show $ prettyPrintTree $ t
38 coalesceFlatHeadlessNodes t@(Tree s children r)
39 | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
40 | otherwise = Tree s (map coalesceFlatHeadlessNodes children) r
42 flat (Tree _ children _) = not (any id $ map notFlatComponent children)
43 notFlatComponent (Tree _ [] _) = False
44 notFlatComponent (Tree _ _ _) = True
46 prettyPrintTree (Tree "" [] _) = empty
47 prettyPrintTree (Tree s [] _) = text s
48 prettyPrintTree t@(Tree s children _)
49 | s==[] = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
50 | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
52 prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
54 nullRegion = (Region (Location 0 0) (Location 0 0))
57 [String] -> -- class path
58 String -> -- grammar *.g file
59 String -> -- file to be parsed
62 parseFile classPath grammarFile inputFile =
64 ((do class_JHaskellHelper
65 s1 <- new_JString_ArrayJchar $ toJavaString grammarFile
66 s2 <- new_JString_ArrayJchar $ toJavaString inputFile
67 tree <- main_JHaskellHelper_JString_JString (s1, s2)
73 ((do class_JHaskellHelper
75 head <- getHead_JTree t ()
76 isNull <- getIsNothing head
77 str <- if isNull then (return "") else (toString_JObject ((castTLRef head) :: Jjava_lang_Object) () >>= getStringUTF >>= \x -> return (showUTF8 x))
78 numChildren <- size_JTree t()
79 children <- if numChildren == 0
81 else do children <- mapM (\i -> child_JTree_Jint t ((fromIntegral i)::Int32))
82 $ take (fromIntegral numChildren)
84 h <- mapM (\c -> haskifyTree (castTLRef c)) children
86 return $ Tree str children nullRegion