+ 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))
+
+foreign import jvm type "edu.berkeley.sbp.Tree" JTree#
+data JTree = JTree JTree#
+
+foreign import jvm safe "edu.berkeley.sbp.misc.RegressionTests.main" regressionTests :: IO ()
+foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.help" haskellHelper :: JString -> JString -> IO JTree
+foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.isNull" isNull :: (Object a) -> IO Bool
+foreign import jvm safe "getHead" getHead :: JTree -> IO (Object a)
+foreign import jvm safe "child" getChild :: JTree -> Int32 -> IO JTree
+foreign import jvm safe "size" size :: JTree -> IO Int32
+foreign import jvm safe "toString" jtoString :: (Object a) -> IO JString
+
+toString o = do isn <- isNull o
+ if isn then return ""
+ else do str <- jtoString o
+ return (unpackJString str)
+
+
+haskify :: JTree -> IO Tree
+haskify t =
+ do head <- getHead t
+ str <- toString head
+ numChildren <- size t
+ children <- if numChildren == 0
+ then do return []
+ else do children <- mapM (\i -> getChild t i)
+ $ take (fromIntegral numChildren)
+ $ iterate (+1) 0
+ h <- mapM haskify children
+ return h
+ return $ Tree str children nullRegion
+
+parseFile ::
+ String -> -- grammar *.g file
+ String -> -- file to be parsed
+ IO Tree
+
+parseFile g f = do g' <- packJString g
+ f' <- packJString f
+ tree <- haskellHelper g' f'
+ x <- haskify tree
+ return x
+
+#else