+--
+-- 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;
+
+ -- 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 (Tree "" [] region) = ""
+ show (Tree tag [] region) = tag
+ show (Tree tag children region) = tag ++ ":" ++ "{" ++ (unwords $ map show 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 ()
+ strx <- toString_JObject ((castTLRef head) :: Jjava_lang_Object) ()
+ str <- getStringUTF strx
+ 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 (showUTF8 str) children nullRegion
+ ) :: JVM Tree)
+
+