src/SBP.hs

   1 --
   2 -- These bindings are highly experimental and subject to change
   3 -- without notice.  You've been warned.
   4 --
   5
   6 module SBP
   7  where
   8   import Header_Java;
   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;
  17   import TypedString;
  18   import JVMBridge;
  19   import JavaText;
  20   import JavaTypes;
  21   import Data.Int;
  22   import Invocation;
  23
  24   -- Why do I need this?
  25   instance SubJavaClassMarker
  26       Header_edu_berkeley_sbp_Tree.Class_Jedu_berkeley_sbp_Tree
  27       Header_edu_berkeley_sbp_misc_HaskellHelper.Class_Jedu_berkeley_sbp_Tree
  28
  29   data Location = Location Int Int
  30   data Region   = Region Location Location
  31
  32   data Tree     = Tree String [Tree] Region
  33   instance Show Tree
  34    where
  35     show (Tree ""  []       region) = ""
  36     show (Tree tag []       region) = tag
  37     show (Tree tag children region) = tag ++ ":" ++ "{" ++ (unwords $ map show children) ++ "}"
  38
  39   nullRegion = (Region (Location 0 0) (Location 0 0))
  40
  41   parseFile ::
  42    [String] ->   -- class path
  43    String   ->   -- grammar *.g file
  44    String   ->   -- file to be parsed
  45    IO Tree
  46
  47   parseFile classPath grammarFile inputFile =
  48      runJVM classPath
  49         ((do class_JHaskellHelper
  50              s1   <- new_JString_ArrayJchar $ toJavaString grammarFile
  51              s2   <- new_JString_ArrayJchar $ toJavaString inputFile
  52              tree <- main_JHaskellHelper_JString_JString (s1, s2)
  53              t <- haskifyTree tree
  54              return t
  55           ) :: JVM Tree)
  56
  57   haskifyTree t =
  58     ((do class_JHaskellHelper
  59          class_JTree
  60          head <- getHead_JTree t ()
  61          isNull <- getIsNothing head
  62          str  <- if isNull then (return "") else (toString_JObject ((castTLRef head) :: Jjava_lang_Object) () >>= getStringUTF >>= \x -> return (showUTF8 x))
  63          numChildren <- size_JTree t()
  64          children    <- if numChildren == 0
  65                         then do return []
  66                         else do children <- mapM (\i -> child_JTree_Jint t ((fromIntegral i)::Int32))
  67                                               $ take (fromIntegral numChildren)
  68                                                 $ iterate (+1) 0
  69                                 h        <- mapM (\c -> haskifyTree (castTLRef c)) children
  70                                 return h
  71          return $ Tree str children nullRegion
  72       ) :: JVM Tree)
  73
  74