From 80b61f716c33504a060903b9c66020d487e6f5c8 Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Wed, 13 Sep 2017 10:32:39 +0200 Subject: added PGF2.Internal.writePGF in the Haskell binding --- src/runtime/haskell-bind/PGF2/Internal.hsc | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) (limited to 'src/runtime/haskell-bind/PGF2/Internal.hsc') 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 () -- cgit v1.2.3