readNGF now fails if the file doesn't exist. Instead there is newNGF

src/runtime/haskell/PGF2.hsc

@@ -14,7 +14,7 @@
 -------------------------------------------------
 
 module PGF2 (-- * PGF
-             PGF,readPGF,bootNGF,readNGF,writePGF,showPGF,
+             PGF,readPGF,bootNGF,readNGF,newNGF,writePGF,showPGF,
 
              -- * Abstract syntax
              AbsName,abstractName,globalFlag,abstractFlag,
@@ -101,6 +101,7 @@ import qualified Data.Map as Map
 import Data.IORef
 import Data.List(intersperse,groupBy)
 import Data.Char(isUpper,isSpace,isPunctuation)
+import Data.Maybe(maybe)
 import Text.PrettyPrint
 
 #include <pgf/pgf.h>
@@ -133,10 +134,8 @@ bootNGF pgf_path ngf_path =
     fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
     return (PGF fptr1 fptr2 Map.empty)
 
--- | Tries to read the grammar from an already booted NGF file.
--- If the file does not exist then a new one is created, and the
--- grammar is set to be empty. It can later be populated with
--- rules dynamically.
+-- | Reads the grammar from an already booted NGF file.
+-- The function fails if the file does not exist.
 readNGF :: FilePath -> IO PGF
 readNGF fpath =
   withCString fpath $ \c_fpath ->
@@ -148,6 +147,22 @@ readNGF fpath =
     fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
     return (PGF fptr1 fptr2 Map.empty)
 
+-- | Creates a new NGF file with a grammar with the given abstract_name.
+-- Aside from the name, the grammar is otherwise empty but can be later
+-- populated with new functions and categories. If fpath is Nothing then
+-- the file is not stored on the disk but only in memory.
+newNGF :: AbsName -> Maybe FilePath -> IO PGF
+newNGF abs_name mb_fpath =
+  withText abs_name $ \c_abs_name ->
+  maybe (\f -> f nullPtr) withCString mb_fpath $ \c_fpath ->
+  alloca $ \p_revision ->
+  mask_ $ do
+    c_db <- withPgfExn (pgf_new_ngf c_abs_name c_fpath p_revision)
+    c_revision <- peek p_revision
+    fptr1 <- newForeignPtr pgf_free_fptr c_db
+    fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision))
+    return (PGF fptr1 fptr2 Map.empty)
+
 writePGF :: FilePath -> PGF -> IO ()
 writePGF fpath p =
   withCString fpath $ \c_fpath ->

src/runtime/haskell/PGF2/FFI.hsc

@@ -58,6 +58,8 @@ foreign import ccall "pgf_boot_ngf"
 foreign import ccall "pgf_read_ngf"
   pgf_read_ngf :: CString -> Ptr (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)
 
+foreign import ccall pgf_new_ngf :: Ptr PgfText -> CString -> Ptr (Ptr PgfRevision) -> Ptr PgfExn -> IO (Ptr PgfDB)
+
 foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO ()
 
 foreign import ccall "&pgf_free"