optimized peeking from GuStringBuf

src/runtime/haskell-bind/PGF2.hsc

@@ -146,8 +146,7 @@ showPGF p =
          exn <- gu_new_exn tmpPl
          pgf_print (pgf p) out exn
          touchPGF p
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
 
 -- | List of all languages available in the grammar.
 languages :: PGF -> Map.Map ConcName Concr
@@ -418,9 +417,7 @@ graphvizAbstractTree p opts e =
          c_opts <- newGraphvizOptions tmpPl opts
          pgf_graphviz_abstract_tree (pgf p) (expr e) c_opts out exn
          touchExpr e
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
-
 
 graphvizParseTree :: Concr -> GraphvizOptions -> Expr -> String
 graphvizParseTree c opts e =
@@ -431,8 +428,7 @@ graphvizParseTree c opts e =
          c_opts <- newGraphvizOptions tmpPl opts
          pgf_graphviz_parse_tree (concr c) (expr e) c_opts out exn
          touchExpr e
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
 
 graphvizWordAlignment :: [Concr] -> GraphvizOptions -> Expr -> String
 graphvizWordAlignment cs opts e =
@@ -444,8 +440,7 @@ graphvizWordAlignment cs opts e =
          c_opts <- newGraphvizOptions tmpPl opts
          pgf_graphviz_word_alignment ptr (fromIntegral n_concrs) (expr e) c_opts out exn
          touchExpr e
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
 
 newGraphvizOptions :: Ptr GuPool -> GraphvizOptions -> IO (Ptr PgfGraphvizOptions)
 newGraphvizOptions pool opts = do
@@ -750,8 +745,7 @@ linearize lang e = unsafePerformIO $
                                      msg <- peekUtf8CString c_msg
                                      throwIO (PGFError msg)
                              else throwIO (PGFError "The abstract tree cannot be linearized")
-         else do lin <- gu_string_buf_freeze sb pl
+         else do peekUtf8CStringBuf sb
-                 peekUtf8CString lin
 
 -- | Generates all possible linearizations of an expression
 linearizeAll :: Concr -> Expr -> [String]
@@ -780,8 +774,7 @@ linearizeAll lang e = unsafePerformIO $
                           if is_nonexist
                             then collect cts exn pl
                             else throwExn exn pl
-                  else do lin <- gu_string_buf_freeze sb tmpPl
+                  else do s  <- peekUtf8CStringBuf sb
-                          s <- peekUtf8CString lin
                           ss <- collect cts exn pl
                           return (s:ss)
 
@@ -841,8 +834,7 @@ tabularLinearizeAll lang e = unsafePerformIO $
                 if is_nonexist
                   then collectTable lang ctree (lin_idx+1) labels exn tmpPl
                   else throwExn exn
-        else do lin <- gu_string_buf_freeze sb tmpPl
+        else do s  <- peekUtf8CStringBuf sb
-                s  <- peekUtf8CString lin
                 ss <- collectTable lang ctree (lin_idx+1) labels exn tmpPl
                 return ((label,s):ss)
 

src/runtime/haskell-bind/PGF2/Expr.hsc

@@ -259,8 +259,7 @@ showExpr scope e =
          exn <- gu_new_exn tmpPl
          pgf_print_expr (expr e) printCtxt 1 out exn
          touchExpr e
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
 
 newPrintCtxt :: [String] -> Ptr GuPool -> IO (Ptr PgfPrintContext)
 newPrintCtxt []     pool = return nullPtr

src/runtime/haskell-bind/PGF2/FFI.hsc

@@ -106,6 +106,12 @@ foreign import ccall unsafe "gu/enum.h gu_enum_next"
 foreign import ccall unsafe "gu/string.h gu_string_buf_freeze"
   gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
 
+foreign import ccall unsafe "gu/string.h gu_string_buf_data"
+  gu_string_buf_data :: Ptr GuStringBuf -> IO CString
+
+foreign import ccall unsafe "gu/string.h gu_string_buf_length"
+  gu_string_buf_length :: Ptr GuStringBuf -> IO CSizeT
+
 foreign import ccall unsafe "gu/utf8.h gu_utf8_decode"
   gu_utf8_decode :: Ptr CString -> IO GuUCS
 
@@ -186,6 +192,12 @@ peekUtf8CStringLen ptr len =
                 cs <- decode pptr end
                 return (((toEnum . fromEnum) x) : cs)
 
+peekUtf8CStringBuf :: Ptr GuStringBuf -> IO String
+peekUtf8CStringBuf sbuf = do
+  ptr <- gu_string_buf_data sbuf
+  len <- gu_string_buf_length sbuf
+  peekUtf8CStringLen ptr (fromIntegral len)
+
 pokeUtf8CString :: String -> CString -> IO ()
 pokeUtf8CString s ptr =
   alloca $ \pptr ->

src/runtime/haskell-bind/PGF2/Type.hsc

@@ -52,8 +52,7 @@ showType scope (Type ty touch) =
          exn <- gu_new_exn tmpPl
          pgf_print_type ty printCtxt 0 out exn
          touch
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
 
 -- | creates a type from a list of hypothesises, a category and 
 -- a list of arguments for the category. The operation 
@@ -137,5 +136,4 @@ showContext scope hypos =
          exn <- gu_new_exn tmpPl
          pgf_print_context c_hypos printCtxt out exn
          mapM_ touchHypo hypos
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s

src/runtime/haskell-bind/SG.hsc

@@ -206,8 +206,7 @@ showTriple (Expr expr1 touch1) (Expr expr2 touch2) (Expr expr3 touch3) =
          pokeElemOff triple 2 expr3
          pgf_print_expr_tuple 3 triple printCtxt out exn
          touch1 >> touch2 >> touch3
-         s <- gu_string_buf_freeze sb tmpPl
+         peekUtf8CStringBuf sb
-         peekUtf8CString s
 
 insertTriple :: SG -> Expr -> Expr -> Expr -> IO SgId
 insertTriple (SG sg) (Expr expr1 touch1) (Expr expr2 touch2) (Expr expr3 touch3) =