msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

now we can load PGF files as precompiled modules

Browse Source
This commit is contained in:
Krasimir Angelov
2024-01-30 13:02:40 +01:00
parent 021e271f29
commit c94d0f31bc
19 changed files with 161 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/compiler/api/GF/Command/Commands.hs
View File

@@ -247,6 +247,7 @@ pgfCommands = Map.fromList [
],
options = [
("retain","retain operations (used for cc command)"),
("resource","the grammar is loaded as a resource to a precompiled PGF"),
("src", "force compilation from source"),
("v", "be verbose - show intermediate status information")
],

4
src/compiler/api/GF/Command/Importing.hs
View File

@@ -79,8 +79,8 @@ importPGF opts (Just pgf) f = fmap Just (modifyPGF pgf (mergePGF f) `catc
readPGF f
else throwIO e))
importSource :: Options -> [FilePath] -> IO (ModuleName,SourceGrammar)
importSource opts files = fmap snd (batchCompile opts files)
importSource :: Options -> Maybe PGF -> [FilePath] -> IO (ModuleName,SourceGrammar)
importSource opts mb_pgf files = fmap snd (batchCompile opts mb_pgf files)
-- for different cf formats
importCF opts files get convert = impCF

34
src/compiler/api/GF/Compile.hs
View File

@@ -7,7 +7,7 @@ import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
import GF.CompileOne(compileOne)
import GF.Grammar.Grammar(Grammar,emptyGrammar,modules,mGrammar,
abstractOfConcrete,prependModule)--,msrc,modules
abstractOfConcrete,prependModule,ModuleInfo(..))
import GF.Infra.CheckM
import GF.Infra.Ident(ModuleName,moduleNameS)--,showIdent
@@ -19,17 +19,17 @@ import GF.Data.Operations(raise,(+++),err)
import Control.Monad(foldM,when,(<=<))
import GF.System.Directory(getCurrentDirectory,doesFileExist,getModificationTime)
import System.FilePath((</>),isRelative,dropFileName)
import qualified Data.Map as Map(empty,insert,elems) --lookup
import qualified Data.Map as Map(empty,singleton,insert,elems)
import Data.List(nub)
import Data.Time(UTCTime)
import GF.Text.Pretty(render,($$),(<+>),nest)
import PGF2(PGF,readProbabilitiesFromFile)
import PGF2(PGF,abstractName,pgfFilePath,readProbabilitiesFromFile)
-- | Compiles a number of source files and builds a 'PGF' structure for them.
-- This is a composition of 'link' and 'batchCompile'.
compileToPGF :: Options -> Maybe PGF -> [FilePath] -> IOE PGF
compileToPGF opts mb_pgf fs = link opts mb_pgf . snd =<< batchCompile opts fs
compileToPGF opts mb_pgf fs = link opts mb_pgf . snd =<< batchCompile opts mb_pgf fs
-- | Link a grammar into a 'PGF' that can be used to 'PGF.linearize' and
-- 'PGF.parse' with the "PGF" run-time system.
@@ -56,12 +56,15 @@ srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc
-- used, in which case tags files are produced instead).
-- Existing @.gfo@ files are reused if they are up-to-date
-- (unless the option @-src@ aka @-force-recomp@ is used).
batchCompile :: Options -> [FilePath] -> IOE (UTCTime,(ModuleName,Grammar))
batchCompile opts files = do
(gr,menv) <- foldM (compileModule opts) emptyCompileEnv files
batchCompile :: Options -> Maybe PGF -> [FilePath] -> IOE (UTCTime,(ModuleName,Grammar))
batchCompile opts mb_pgf files = do
menv <- emptyCompileEnv mb_pgf
(gr,menv) <- foldM (compileModule opts) menv files
let cnc = moduleNameS (justModuleName (last files))
t = maximum . map fst $ Map.elems menv
t = maximum . map snd3 $ Map.elems menv
return (t,(cnc,gr))
where
snd3 (_,y,_) = y
-- | compile with one module as starting point
-- command-line options override options (marked by --#) in the file
@@ -105,14 +108,23 @@ compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr
-- | The environment
type CompileEnv = (Grammar,ModEnv)
emptyCompileEnv :: CompileEnv
emptyCompileEnv = (emptyGrammar,Map.empty)
emptyCompileEnv :: Maybe PGF -> IOE CompileEnv
emptyCompileEnv mb_pgf = do
case mb_pgf of
Just pgf -> do let fpath = pgfFilePath pgf
abs_name = abstractName pgf
t <- getModificationTime fpath
return ( prependModule emptyGrammar (moduleNameS abs_name, ModPGF pgf)
, Map.singleton abs_name (fpath,t,[])
)
Nothing -> return (emptyGrammar,Map.empty)
extendCompileEnv (gr,menv) (mfile,mo) =
do menv2 <- case mfile of
Just file ->
do let (mod,imps) = importsOfModule mo
t <- getModificationTime file
return $ Map.insert mod (t,imps) menv
return $ Map.insert mod (file,t,imps) menv
_ -> return menv
return (prependModule gr mo,menv2)

24
src/compiler/api/GF/Compile/ReadFiles.hs
View File

@@ -50,7 +50,7 @@ import System.FilePath
import GF.Text.Pretty
type ModName = String
type ModEnv = Map.Map ModName (UTCTime,[ModName])
type ModEnv = Map.Map ModName (FilePath,UTCTime,[ModName])
-- | Returns a list of all files to be compiled in topological order i.e.
@@ -98,14 +98,17 @@ getAllFiles opts ps env file = do
-- returns 'ModuleInfo'. It fails if there is no such module
--findModule :: ModName -> IOE ModuleInfo
findModule name = do
(file,gfTime,gfoTime) <- findFile gfoDir ps name
(file,gfTime,gfoTime) <- findFile gfoDir ps env name
let mb_envmod = Map.lookup name env
(st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime
(st,t) = selectFormat opts (fmap snd3 mb_envmod) gfTime gfoTime
snd3 (_,y,_) = y
thd3 (_,_,z) = z
(st,(mname,imps)) <-
case st of
CSEnv -> return (st, (name, maybe [] snd mb_envmod))
CSEnv -> return (st, (name, maybe [] thd3 mb_envmod))
CSRead -> do let gfo = if isGFO file then file else gf2gfo opts file
t_imps <- gfoImports gfo
case t_imps of
@@ -121,8 +124,8 @@ getAllFiles opts ps env file = do
return (name,st,t,isJust gfTime,imps,dropFileName file)
--------------------------------------------------------------------------------
findFile gfoDir ps name =
maybe noSource haveSource =<< getFilePath ps (gfFile name)
findFile gfoDir ps env name =
maybe noSource haveSource =<< getFilePath ps (gfFile name)
where
haveSource gfFile =
do gfTime <- getModificationTime gfFile
@@ -130,7 +133,7 @@ findFile gfoDir ps name =
return (gfFile, Just gfTime, mb_gfoTime)
noSource =
maybe noGFO haveGFO =<< getFilePath gfoPath (gfoFile name)
maybe noGFO haveGFO =<< getFilePath gfoPath (gfoFile name)
where
gfoPath = maybe id (:) gfoDir ps
@@ -138,8 +141,11 @@ findFile gfoDir ps name =
do gfoTime <- getModificationTime gfoFile
return (gfoFile, Nothing, Just gfoTime)
noGFO = raise (render ("File" <+> gfFile name <+> "does not exist." $$
"searched in:" <+> vcat ps))
noGFO =
case Map.lookup name env of
Just (fpath,t,_) -> return (fpath, Nothing, Nothing)
Nothing -> raise (render ("File" <+> gfFile name <+> "does not exist." $$
"searched in:" <+> vcat ps <+> (show (env :: Map.Map ModName (FilePath,UTCTime,[ModName])))))
gfImports opts file = importsOfModule `fmap` parseModHeader opts file

105
src/compiler/api/GF/Compile/Rename.hs
View File

@@ -36,6 +36,7 @@ import GF.Grammar.Lookup
import GF.Grammar.Macros
import GF.Grammar.Printer
import GF.Data.Operations
import PGF2(abstractName,functionType,categoryContext)
import Control.Monad
import Data.List (nub,(\\))
@@ -58,10 +59,7 @@ renameModule cwd gr mo@(m,mi) = do
return (m, mi{jments = js})
type Status = (StatusMap, [(OpenSpec, StatusMap)])
type StatusMap = Map.Map Ident StatusInfo
type StatusInfo = Ident -> Term
type StatusMap = Ident -> Maybe Term
-- Delays errors, allowing many errors to be detected and reported
renameIdentTerm env = accumulateError (renameIdentTerm' env)
@@ -74,14 +72,12 @@ renameIdentTerm' env@(act,imps) t0 =
Cn c -> ident (\_ s -> checkError s) c
Q (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
Q (m',c) -> do
m <- lookupErr m' qualifs
f <- lookupIdent c m
return $ f c
f <- lookupErr m' qualifs
maybe (notFound c) return (f c)
QC (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
QC (m',c) -> do
m <- lookupErr m' qualifs
f <- lookupIdent c m
return $ f c
f <- lookupErr m' qualifs
maybe (notFound c) return (f c)
_ -> return t0
where
opens = [st | (OSimple _,st) <- imps]
@@ -95,67 +91,68 @@ renameIdentTerm' env@(act,imps) t0 =
| otherwise = checkError s
ident alt c =
case Map.lookup c act of
Just f -> return (f c)
_ -> case mapMaybe (Map.lookup c) opens of
[f] -> return (f c)
case act c of
Just t -> return t
_ -> case mapMaybe (\f -> f c) opens of
[t] -> return t
[] -> alt c ("constant not found:" <+> c $$
"given" <+> fsep (punctuate ',' (map fst qualifs)))
fs -> case nub [f c | f <- fs] of
[tr] -> return tr
ts -> case nub ts of
[t] -> return t
ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
"conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
"given" <+> fsep (punctuate ',' (map fst qualifs)))
return (bestTerm ts) -- Heuristic for resource grammar. Returns t for all others.
where
-- Hotfix for https://github.com/GrammaticalFramework/gf-core/issues/56
-- Real bug is probably somewhere deeper in recognising excluded functions. /IL 2020-06-06
notFromCommonModule :: Term -> Bool
notFromCommonModule term =
let t = render $ ppTerm Qualified 0 term :: String
in not $ any (\moduleName -> moduleName `L.isPrefixOf` t)
["CommonX", "ConstructX", "ExtendFunctor"
,"MarkHTMLX", "ParamX", "TenseX", "TextX"]
return t
-- If one of the terms comes from the common modules,
-- we choose the other one, because that's defined in the grammar.
bestTerm :: [Term] -> Term
bestTerm [] = error "constant not found" -- not reached: bestTerm is only called for case ts@(t:_)
bestTerm ts@(t:_) =
let notCommon = [t | t <- ts, notFromCommonModule t]
in case notCommon of
[] -> t -- All terms are from common modules, return first of original list
(u:_) -> u -- ≥1 terms are not from common modules, return first of those
info2status :: Maybe ModuleName -> Ident -> Info -> StatusInfo
info2status :: Maybe ModuleName -> Ident -> Info -> Term
info2status mq c i = case i of
AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq
ResValue _ _ -> maybe Con (curry QC) mq
ResParam _ _ -> maybe Con (curry QC) mq
AnyInd True m -> maybe Con (const (curry QC m)) mq
AnyInd False m -> maybe Cn (const (curry Q m)) mq
_ -> maybe Cn (curry Q) mq
AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq c
ResValue _ _ -> maybe Con (curry QC) mq c
ResParam _ _ -> maybe Con (curry QC) mq c
AnyInd True m -> maybe Con (const (curry QC m)) mq c
AnyInd False m -> maybe Cn (const (curry Q m)) mq c
_ -> maybe Cn (curry Q) mq c
tree2status :: OpenSpec -> Map.Map Ident Info -> StatusMap
tree2status o = case o of
OSimple i -> Map.mapWithKey (info2status (Just i))
OQualif i j -> Map.mapWithKey (info2status (Just j))
tree2status o map = case o of
OSimple i -> flip Map.lookup (Map.mapWithKey (info2status (Just i)) map)
OQualif i j -> flip Map.lookup (Map.mapWithKey (info2status (Just j)) map)
buildStatus :: FilePath -> Grammar -> Module -> Check Status
buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
let gr1 = prependModule gr mo
exts = [(OSimple m,mi) | (m,mi) <- allExtends gr1 m]
ops <- mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
let sts = map modInfo2status (exts++ops)
exts = [(o,modInfo2status o mi) | (m,mi) <- allExtends gr1 m, let o = OSimple m]
ops <- mapM (openSpec2status gr1) (mopens mi)
let sts = exts++ops
return (if isModCnc mi
then (Map.empty, reverse sts) -- the module itself does not define any names
else (self2status m mi,reverse sts)) -- so the empty ident is not needed
then (const Nothing, reverse sts) -- the module itself does not define any names
else (self2status m mi,reverse sts))
modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusMap)
modInfo2status (o,mo) = (o,tree2status o (jments mo))
openSpec2status gr o =
do mi <- lookupModule gr (openedModule o)
return (o,modInfo2status o mi)
where
mn = openedModule o
pgf2status o pgf id =
case functionType pgf sid of
Just _ -> Just (QC (mn, id))
Nothing -> case categoryContext pgf sid of
Just _ -> Just (QC (mn, id))
Nothing -> Nothing
where
sid = showIdent id
mn = case o of
OSimple i -> i
OQualif i j -> j
modInfo2status :: OpenSpec -> ModuleInfo -> StatusMap
modInfo2status o (ModInfo{jments=jments}) = tree2status o jments
modInfo2status o (ModPGF pgf) = pgf2status o pgf
self2status :: ModuleName -> ModuleInfo -> StatusMap
self2status c m = Map.mapWithKey (info2status (Just c)) (jments m)
self2status c m = flip Map.lookup (Map.mapWithKey (info2status (Just c)) (jments m))
renameInfo :: FilePath -> Status -> Module -> Ident -> Info -> Check Info

4
src/compiler/api/GF/Compile/Update.hs
View File

@@ -57,6 +57,10 @@ extendModule cwd gr (name,m)
extOne mo (n,cond) = do
m0 <- lookupModule gr n
case m0 of
ModPGF _ -> checkError ("cannot extend the precompiled module" <+> n)
_ -> return ()
-- test that the module types match, and find out if the old is complete
unless (sameMType (mtype m) (mtype mo))
(checkError ("illegal extension type to module" <+> name))

4
src/compiler/api/GF/CompileInParallel.hs
View File

@@ -110,12 +110,12 @@ batchCompile1 lib_dir (opts,filepaths) =
-- logStrLn $ "Finished "++show (length (modules gr'))++" modules."
return gr'
fcache <- liftIO $ newIOCache $ \ _ (imp,Hide (f,ps)) ->
do (file,_,_) <- findFile gfoDir ps imp
do (file,_,_) <- findFile gfoDir ps M.empty imp
return (file,(f,ps))
let find f ps imp =
do (file',(f',ps')) <- liftIO $ readIOCache fcache (imp,Hide (f,ps))
when (ps'/=ps) $
do (file,_,_) <- findFile gfoDir ps imp
do (file,_,_) <- findFile gfoDir ps M.empty imp
unless (file==file' || any fromPrelude [file,file']) $
do eq <- liftIO $ (==) <$> BS.readFile file <*> BS.readFile file'
unless eq $

4
src/compiler/api/GF/CompileOne.hs
View File

@@ -96,8 +96,8 @@ compileSourceModule opts cwd mb_gfFile gr =
else generateGFO <=< ifComplete (backend <=< middle) <=< frontend
where
-- Apply to all modules
frontend = runPass Extend "" . extendModule cwd gr
<=< runPass Rebuild "" . rebuildModule cwd gr
frontend = runPass Extend "extending" . extendModule cwd gr
<=< runPass Rebuild "rebuilding" . rebuildModule cwd gr
-- Apply to complete modules
middle = runPass TypeCheck "type checking" . checkModule opts cwd gr

2
src/compiler/api/GF/Compiler.hs
View File

@@ -54,7 +54,7 @@ compileSourceFiles opts fs =
linkGrammars opts output
where
batchCompile = maybe batchCompile' parallelBatchCompile (flag optJobs opts)
batchCompile' opts fs = do (t,cnc_gr) <- S.batchCompile opts fs
batchCompile' opts fs = do (t,cnc_gr) <- S.batchCompile opts Nothing fs
return (t,[cnc_gr])
exportCanonical (_time, canonical) =

12
src/compiler/api/GF/Grammar/Grammar.hs
View File

@@ -73,7 +73,7 @@ import GF.Infra.Location
import GF.Data.Operations
import PGF2(BindType(..))
import PGF2(BindType(..),PGF)
import PGF2.Transactions(SeqId,LIndex,LVar,LParam(..),PArg(..),Symbol(..),Production(..))
import Data.Array.IArray(Array)
@@ -86,13 +86,14 @@ import GF.Text.Pretty
-- | A grammar is a self-contained collection of grammar modules
data Grammar = MGrammar {
moduleMap :: Map.Map ModuleName ModuleInfo,
modules :: [Module]
modules :: [Module]
}
-- | Modules
type Module = (ModuleName, ModuleInfo)
data ModuleInfo = ModInfo {
data ModuleInfo
= ModInfo {
mtype :: ModuleType,
mstatus :: ModuleStatus,
mflags :: Options,
@@ -103,7 +104,10 @@ data ModuleInfo = ModInfo {
msrc :: FilePath,
mseqs :: Maybe (Seq.Seq [Symbol]),
jments :: Map.Map Ident Info
}
}
| ModPGF {
mpgf :: PGF
}
type SourceGrammar = Grammar
type SourceModule = Module

44
src/compiler/api/GF/Grammar/Lookup.hs
View File

@@ -16,7 +16,7 @@
-----------------------------------------------------------------------------
module GF.Grammar.Lookup (
lookupIdent,
lookupIdent, notFound,
lookupOrigInfo,
allOrigInfos,
lookupResDef,
@@ -43,6 +43,7 @@ import GF.Grammar.Lockfield
import Data.List (sortBy)
import GF.Text.Pretty
import qualified Data.Map as Map
import qualified PGF2
-- whether lock fields are added in reuse
lock c = lockRecType c -- return
@@ -53,13 +54,46 @@ lookupIdent :: ErrorMonad m => Ident -> Map.Map Ident b -> m b
lookupIdent c t =
case Map.lookup c t of
Just v -> return v
Nothing -> raise ("unknown identifier" +++ showIdent c)
Nothing -> notFound c
notFound c = raise ("unknown identifier" +++ showIdent c)
lookupIdentInfo :: ErrorMonad m => SourceModule -> Ident -> m Info
lookupIdentInfo (m,ModInfo{jments=js}) i = lookupIdent i js
lookupIdentInfo (m,ModPGF{mpgf=pgf}) i =
case PGF2.functionType pgf (showIdent i) of
Just ty -> return (ResValue (noLoc (cnvType [] ty)) 0)
Nothing -> case PGF2.categoryContext pgf (showIdent i) of
Just ctxt -> return (ResParam Nothing Nothing)
Nothing -> notFound i
where
cnvType xs (PGF2.DTyp hypos cat es) =
appHypos hypos xs (QC (m,identS cat)) es
appHypos [] xs t es =
foldl (appExpr xs) t es
appHypos ((bt, v, ty):hypos) xs t es =
let x = identS v in Prod bt x (cnvType xs ty) (appHypos hypos (x:xs) t es)
appExpr xs t e = App t (cnvExpr xs e)
cnvExpr xs (PGF2.EAbs bt v e) = let x = identS v in Abs bt x (cnvExpr (x:xs) e)
cnvExpr xs (PGF2.EApp e1 e2) = App (cnvExpr xs e1) (cnvExpr xs e2)
cnvExpr xs (PGF2.ELit (PGF2.LStr s)) = K s
cnvExpr xs (PGF2.ELit (PGF2.LInt n)) = EInt n
cnvExpr xs (PGF2.ELit (PGF2.LFlt n)) = EFloat n
cnvExpr xs (PGF2.EMeta i) = Meta i
cnvExpr xs (PGF2.EFun f) = QC (m,identS f)
cnvExpr xs (PGF2.EVar i) = Vr (xs !! i)
cnvExpr xs (PGF2.ETyped e ty) = Typed (cnvExpr xs e) (cnvType xs ty)
cnvExpr xs (PGF2.EImplArg e) = ImplArg (cnvExpr xs e)
lookupIdentInfo :: ErrorMonad m => SourceModInfo -> Ident -> m Info
lookupIdentInfo mo i = lookupIdent i (jments mo)
lookupQIdentInfo :: ErrorMonad m => Grammar -> QIdent -> m Info
lookupQIdentInfo gr (m,c) = flip lookupIdentInfo c =<< lookupModule gr m
lookupQIdentInfo gr (m,c) = do
mi <- lookupModule gr m
lookupIdentInfo (m,mi) c
lookupResDef :: ErrorMonad m => Grammar -> QIdent -> m Term
lookupResDef gr (m,c)

2
src/compiler/api/GF/Infra/Option.hs
View File

@@ -357,7 +357,7 @@ optDescr =
Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp))
"Never recompile from source, if there is already .gfo file.",
Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = RetainAll })) "Retain the source and well as the compiled grammar.",
Option [] ["resource"] (NoArg (set $ \o -> o { optRetainResource = RetainSource })) "Load the source grammar as a resource only.",
Option [] ["resource"] (NoArg (set $ \o -> o { optRetainResource = RetainSource })) "Load the source grammar as a resource to a precompiled PGF.",
Option [] ["probs"] (ReqArg probsFile "file.probs") "Read probabilities from file.",
Option ['n'] ["name"] (ReqArg name "NAME")
(unlines ["Use NAME as the name of the output. This is used in the output file names, ",

2
src/compiler/api/GF/Infra/SIO.hs
View File

@@ -134,7 +134,7 @@ newStdGen = lift0 IO.newStdGen
runInterruptibly = lift1 IO.runInterruptibly
importGrammar readNGF pgf opts files = lift0 $ GF.importGrammar readNGF pgf opts files
importSource opts files = lift0 $ GF.importSource opts files
importSource opts mb_pgf files = lift0 $ GF.importSource opts mb_pgf files
link opts pgf src = lift0 $ GF.link opts pgf src
modifyPGF gr t = lift0 (PGFT.modifyPGF gr t)

4
src/compiler/api/GF/Interactive.hs
View File

@@ -427,10 +427,10 @@ importInEnv :: ReadNGF -> Options -> [FilePath] -> ShellM ()
importInEnv readNGF opts files =
do (_,pgf0,mb_txnid) <- gets pgfenv
case (flag optRetainResource opts,mb_txnid) of
(RetainAll,Nothing) -> do src <- lift $ importSource opts files
(RetainAll,Nothing) -> do src <- lift $ importSource opts Nothing files
pgf <- lift $ link opts pgf0 src
modify $ \gfenv -> gfenv{pgfenv = (snd src,Just pgf,Nothing)}
(RetainSource,mb_txn) -> do src <- lift $ importSource opts files
(RetainSource,mb_txn) -> do src <- lift $ importSource opts pgf0 files
modify $ \gfenv -> gfenv{pgfenv = (snd src,pgf0,mb_txn)}
(RetainCompiled,Nothing) -> do pgf <- lift $ importPGF pgf0
modify $ \gfenv -> gfenv{pgfenv = (emptyGrammar,pgf,Nothing)}

1
src/runtime/c/pgf/db.h
View File

@@ -107,6 +107,7 @@ public:
PGF_INTERNAL_DECL static txn_t get_txn_id();
PGF_INTERNAL_DECL const char *get_file_path() { return filepath; };
PGF_INTERNAL_DECL void set_file_path(const char *filepath) { this->filepath = strdup(filepath); };
template<class A>
static ref<A> malloc(size_t extra_bytes=0) {

1
src/runtime/c/pgf/pgf.cxx
View File

@@ -58,6 +58,7 @@ PgfDB *pgf_read_pgf(const char* fpath, PgfRevision *revision,
size_t pgf_size = ftell(in);
fseek(in, 0, SEEK_SET);
db = new PgfDB(NULL, 0, 0, pgf_size*7);
db->set_file_path(fpath);
{
DB_scope scope(db, WRITER_SCOPE);

4
src/runtime/haskell/PGF2.hsc
View File

@@ -19,6 +19,7 @@ module PGF2 (-- * PGF
#if defined(__linux__) || defined(__APPLE__)
writePGF_,
#endif
pgfFilePath,
-- * Abstract syntax
AbsName,abstractName,globalFlag,abstractFlag,
@@ -278,6 +279,9 @@ cookie_write cookie buf size = do
fmap fromIntegral $ (callback :: Ptr Word8 -> Int -> IO Int) buf (fromIntegral size)
#endif
pgfFilePath :: PGF -> FilePath
pgfFilePath p = unsafePerformIO (pgf_file_path (a_db p) >>= peekCString)
showPGF :: PGF -> String
showPGF p =
render (text "abstract" <+> ppAbstractName p <+> char '{' $$

2
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -93,6 +93,8 @@ foreign import ccall pgf_write_pgf_cookie :: Ptr () -> FunPtr (Ptr () -> Ptr Wor
foreign import ccall pgf_write_pgf_cookie :: Ptr () -> FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO CInt) -> Ptr PgfDB -> Ptr PGF -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
#endif
foreign import ccall pgf_file_path :: Ptr PgfDB -> IO CString
foreign import ccall "pgf_free_revision" pgf_free_revision_ :: Ptr PgfDB -> Ptr PGF -> IO ()
foreign import ccall "&pgf_free_revision" pgf_free_revision :: FinalizerEnvPtr PgfDB PGF

6
src/runtime/python/pypgf.c
View File

@@ -1285,11 +1285,7 @@ PGF_embed(PGFObject* self, PyObject *modname)
py_embedding->grammar = self; Py_INCREF(self);
const char *fpath = pgf_file_path(self->db);
if (fpath == NULL) {
py_embedding->grammar_path = Py_None; Py_INCREF(Py_None);
} else {
py_embedding->grammar_path = PyUnicode_FromString(fpath);
}
py_embedding->grammar_path = PyUnicode_FromString(fpath);
if (module == NULL) {
py_embedding->package_path = PyList_New(0);