diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 5fe8f9b34..6c7a79c8e 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -118,31 +118,13 @@ PgfDB *pgf_read_ngf(const char *fpath, bool is_new = false; PGF_API_BEGIN { - db = new PgfDB(fpath, O_CREAT | O_RDWR, S_IRUSR | S_IWUSR); + db = new PgfDB(fpath, O_RDWR, 0); { DB_scope scope(db, WRITER_SCOPE); ref pgf = PgfDB::get_revision(&master); - if (pgf == 0) { - is_new = true; - pgf = PgfDB::malloc(master.size+1); - pgf->ref_count = 1; - pgf->major_version = PGF_MAJOR_VERSION; - pgf->minor_version = PGF_MINOR_VERSION; - pgf->gflags = 0; - pgf->abstract.name = PgfDB::malloc(); - pgf->abstract.name->size = 0; - pgf->abstract.aflags = 0; - pgf->abstract.funs = 0; - pgf->abstract.cats = 0; - pgf->prev = 0; - pgf->next = 0; - memcpy(&pgf->name, &master, sizeof(PgfText)+master.size+1); - PgfDB::set_revision(pgf); - } else { - Node::add_value_ref(pgf); - } + Node::add_value_ref(pgf); *revision = pgf.as_object(); } @@ -158,6 +140,49 @@ PgfDB *pgf_read_ngf(const char *fpath, return NULL; } +PGF_API +PgfDB *pgf_new_ngf(PgfText *abstract_name, + const char *fpath, + PgfRevision *revision, + PgfExn* err) +{ + PgfDB *db = NULL; + + PGF_API_BEGIN { + db = new PgfDB(fpath, O_CREAT | O_EXCL | O_RDWR, S_IRUSR | S_IWUSR); + + { + DB_scope scope(db, WRITER_SCOPE); + + ref pgf = PgfDB::malloc(master.size+1); + pgf->ref_count = 1; + pgf->major_version = PGF_MAJOR_VERSION; + pgf->minor_version = PGF_MINOR_VERSION; + pgf->gflags = 0; + pgf->abstract.name = PgfDB::malloc(abstract_name->size+1); + memcpy(&(*pgf->abstract.name), abstract_name, sizeof(PgfText)+abstract_name->size+1); + pgf->abstract.aflags = 0; + pgf->abstract.funs = 0; + pgf->abstract.cats = 0; + pgf->prev = 0; + pgf->next = 0; + memcpy(&pgf->name, &master, sizeof(PgfText)+master.size+1); + PgfDB::set_revision(pgf); + *revision = pgf.as_object(); + } + + return db; + } PGF_API_END + + if (db != NULL) { + delete db; + if (fpath != NULL) + remove(fpath); + } + + return NULL; +} + PGF_API void pgf_write_pgf(const char* fpath, PgfDB *db, PgfRevision revision, diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index f38dfaed6..d13d9ace8 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -237,15 +237,23 @@ PgfDB *pgf_boot_ngf(const char* pgf_path, const char* ngf_path, PgfExn* err); /* 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. The default grammar revision is stored - * in *revision. */ + * The function fails if the file does not exist. The default grammar + * revision is stored in *revision. */ PGF_API_DECL PgfDB *pgf_read_ngf(const char* fpath, PgfRevision *revision, PgfExn* err); +/* 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 NULL then + * the file is not stored on the disk but only in memory. */ +PGF_API +PgfDB *pgf_new_ngf(PgfText *abstract_name, + const char *fpath, + PgfRevision *revision, + PgfExn* err); + PGF_API_DECL void pgf_write_pgf(const char* fpath, PgfDB *db, PgfRevision revision, diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 857e99419..82e4941d5 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/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 @@ -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 -> diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 3d24a3825..c327269b8 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/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"