---
--- These bindings are highly experimental and subject to change
--- without notice. You've been warned.
---
-
-module SBP
- where
- import Header_Java;
- import Class_edu_berkeley_sbp_misc_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 TypedString;
- import JVMBridge;
- import JavaText;
- import JavaTypes;
- import Data.Int;
- import Invocation;
- import Text.PrettyPrint.HughesPJ
-
- -- 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
-
- data Location = Location Int Int
- data Region = Region Location Location
-
- data Tree = Tree String [Tree] Region
- instance Show Tree
- where
- show t@(Tree _ _ _) = show $ prettyPrintTree $ t
-
- coalesceFlatHeadlessNodes t@(Tree s children r)
- | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r
- | otherwise = Tree s (map coalesceFlatHeadlessNodes children) r
- where
- flat (Tree _ children _) = not (any id $ map notFlatComponent children)
- notFlatComponent (Tree _ [] _) = False
- notFlatComponent (Tree _ _ _) = True
-
- prettyPrintTree (Tree "" [] _) = empty
- prettyPrintTree (Tree s [] _) = text s
- prettyPrintTree t@(Tree s children _)
- | s==[] = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}"))
- | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children
- where
- prettyPrintTreeList children = (vcat $ map prettyPrintTree children)
-
- nullRegion = (Region (Location 0 0) (Location 0 0))
-
- parseFile ::
- [String] -> -- class path
- String -> -- grammar *.g file
- String -> -- file to be parsed
- IO Tree
-
- parseFile classPath grammarFile inputFile =
- runJVM classPath
- ((do class_JHaskellHelper
- s1 <- new_JString_ArrayJchar $ toJavaString grammarFile
- s2 <- new_JString_ArrayJchar $ toJavaString inputFile
- tree <- main_JHaskellHelper_JString_JString (s1, s2)
- t <- haskifyTree tree
- return t
- ) :: JVM Tree)
-
- haskifyTree t =
- ((do class_JHaskellHelper
- class_JTree
- head <- getHead_JTree t ()
- isNull <- getIsNothing head
- str <- if isNull then (return "") else (toString_JObject ((castTLRef head) :: Jjava_lang_Object) () >>= getStringUTF >>= \x -> return (showUTF8 x))
- numChildren <- size_JTree t()
- children <- if numChildren == 0
- then do return []
- else do children <- mapM (\i -> child_JTree_Jint t ((fromIntegral i)::Int32))
- $ take (fromIntegral numChildren)
- $ iterate (+1) 0
- h <- mapM (\c -> haskifyTree (castTLRef c)) children
- return h
- return $ Tree str children nullRegion
- ) :: JVM Tree)
-
-