diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc index d69722bf7..9de864fcc 100644 --- a/src/runtime/haskell-bind/PGF2/FFI.hsc +++ b/src/runtime/haskell-bind/PGF2/FFI.hsc @@ -213,6 +213,9 @@ type PgfBindType = (#type PgfBindType) foreign import ccall "pgf/pgf.h pgf_read" pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF) +foreign import ccall "pgf/pgf.h pgf_write" + pgf_write :: Ptr PgfPGF -> CString -> Ptr GuExn -> IO () + foreign import ccall "pgf/pgf.h pgf_abstract_name" pgf_abstract_name :: Ptr PgfPGF -> IO CString diff --git a/src/runtime/haskell-bind/PGF2/Internal.hsc b/src/runtime/haskell-bind/PGF2/Internal.hsc index a7b6a4271..d24b94bc4 100644 --- a/src/runtime/haskell-bind/PGF2/Internal.hsc +++ b/src/runtime/haskell-bind/PGF2/Internal.hsc @@ -10,7 +10,10 @@ module PGF2.Internal(-- * Access the internal structures -- * Building new PGFs in memory build, eAbs, eApp, eMeta, eFun, eVar, eTyped, eImplArg, dTyp, hypo, - newAbstr, newPGF + newAbstr, newPGF, + + -- * Write an in-memory PGF to a file + writePGF ) where #include @@ -24,6 +27,7 @@ import Foreign import Foreign.C import Data.IORef import qualified Data.Map as Map +import Control.Exception(Exception,throwIO) type Token = String data Symbol @@ -561,3 +565,23 @@ newMap elem_size pokeElem m pool = do pokeElems ptr ((key,value):xs) = do pokeElem ptr key value pokeElems (ptr `plusPtr` (fromIntegral elem_size)) xs + +writePGF :: FilePath -> PGF -> IO () +writePGF fpath p = do + pool <- gu_new_pool + exn <- gu_new_exn pool + withCString fpath $ \c_fpath -> + pgf_write (pgf p) c_fpath exn + touchPGF p + failed <- gu_exn_is_raised exn + if failed + then do is_errno <- gu_exn_caught exn gu_exn_type_GuErrno + if is_errno + then do perrno <- (#peek GuExn, data.data) exn + errno <- peek perrno + gu_pool_free pool + ioError (errnoToIOError "writePGF" (Errno errno) Nothing (Just fpath)) + else do gu_pool_free pool + throwIO (PGFError "The grammar cannot be stored") + else do gu_pool_free pool + return ()