the parser for abstract expressions in the C runtime now supports partial parses

1 files changed, 44 insertions, 1 deletions

diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc
index 90f702462..096d15bfa 100644
--- a/src/runtime/haskell-bind/PGF2/Expr.hsc
+++ b/src/runtime/haskell-bind/PGF2/Expr.hsc
@@ -5,6 +5,7 @@ module PGF2.Expr where
 import System.IO.Unsafe(unsafePerformIO)
 import Foreign hiding (unsafePerformIO)
 import Foreign.C
+import Data.IORef
 import PGF2.FFI
 
 -- | An data type that represents
@@ -195,7 +196,7 @@ readExpr str =
          do c_str <- newUtf8CString str tmpPl
             guin <- gu_string_in c_str tmpPl
             exn <- gu_new_exn tmpPl
-            c_expr <- pgf_read_expr guin exprPl exn
+            c_expr <- pgf_read_expr guin exprPl tmpPl exn
             status <- gu_exn_is_raised exn
             if (not status && c_expr /= nullPtr)
               then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
@@ -203,6 +204,48 @@ readExpr str =
               else do gu_pool_free exprPl
                       return Nothing
 
+pExpr :: ReadS Expr
+pExpr str =
+  unsafePerformIO $
+    do exprPl <- gu_new_pool
+       withGuPool $ \tmpPl ->
+         do ref <- newIORef (str,str,str)
+            exn <- gu_new_exn tmpPl
+            c_fetch_char <- wrapParserGetc (fetch_char ref)
+            c_parser <- pgf_new_parser nullPtr c_fetch_char exprPl tmpPl exn
+            c_expr <- pgf_expr_parser_expr c_parser 1
+            status <- gu_exn_is_raised exn
+            if (not status && c_expr /= nullPtr)
+              then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+                      (str,_,_) <- readIORef ref
+                      return [(Expr c_expr (touchForeignPtr exprFPl),str)]
+              else do gu_pool_free exprPl
+                      return []
+  where
+    fetch_char :: IORef (String,String,String) -> Ptr () -> (#type bool) -> Ptr GuExn -> IO (#type GuUCS)
+    fetch_char ref _ mark exn = do
+      (str1,str2,str3) <- readIORef ref
+      let str1' = if mark /= 0
+                    then str2
+                    else str1
+      case str3 of
+        []     -> do writeIORef ref (str1',str3,[])
+                     gu_exn_raise exn gu_exn_type_GuEOF
+                     return (-1)
+        (c:cs) -> do writeIORef ref (str1',str3,cs)
+                     return ((fromIntegral . fromEnum) c)
+
+foreign import ccall "pgf/expr.h pgf_new_parser"
+  pgf_new_parser :: Ptr () -> (FunPtr ParserGetc) -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfExprParser)
+
+foreign import ccall "pgf/expr.h pgf_expr_parser_expr"
+  pgf_expr_parser_expr :: Ptr PgfExprParser -> (#type bool) -> IO PgfExpr
+
+type ParserGetc = Ptr () -> (#type bool) -> Ptr GuExn -> IO (#type GuUCS)
+
+foreign import ccall "wrapper"
+  wrapParserGetc :: ParserGetc -> IO (FunPtr ParserGetc)
+
 -- | renders an expression as a 'String'. The list
 -- of identifiers is the list of all free variables
 -- in the expression in order reverse to the order