From 348c348e1443a01ffcfc5981b244014b21f65830 Mon Sep 17 00:00:00 2001
From: krangelov <kr.angelov@gmail.com>
Date: Fri, 17 Sep 2021 13:15:58 +0200
Subject: [PATCH] the compiler can now boot and load an .ngf file

---
 src/compiler/GF/Command/Importing.hs    |  2 ++
 src/compiler/GF/Compile/GrammarToPGF.hs | 17 ++++++++++++++++-
 src/compiler/GF/Compiler.hs             |  6 +++++-
 src/compiler/GF/Infra/Option.hs         |  4 ++++
 4 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/src/compiler/GF/Command/Importing.hs b/src/compiler/GF/Command/Importing.hs
index b7a591f89..670975fa3 100644
--- a/src/compiler/GF/Command/Importing.hs
+++ b/src/compiler/GF/Command/Importing.hs
@@ -39,6 +39,8 @@ importGrammar pgf0 opts files =
                       return pgf0
     ".pgf" -> do
       mapM readPGF files >>= foldM ioUnionPGF pgf0
+    ".ngf" -> do
+      mapM readNGF files >>= foldM ioUnionPGF pgf0
     ext -> die $ "Unknown filename extension: " ++ show ext
 
 ioUnionPGF :: Maybe PGF -> PGF -> IO (Maybe PGF)
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 54a09164b..faa609e11 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -25,6 +25,8 @@ import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import Data.Array.IArray
 import Data.Maybe(fromMaybe)
+import System.FilePath
+import System.Directory
 
 import GHC.Prim
 import GHC.Base(getTag)
@@ -47,7 +49,20 @@ grammar2PGF opts gr am probs = do
 
     mkAbstr :: ModuleName -> Map.Map PGF2.Fun Double -> IO PGF
     mkAbstr am probs = do
-      gr <- newNGF (mi2i am) Nothing
+      let abs_name = mi2i am
+      mb_ngf_path <-
+         if snd (flag optLinkTargets opts)
+           then do let fname = maybe id (</>)
+                                     (flag optOutputDir opts)
+                                     (fromMaybe abs_name (flag optName opts)<.>"ngf")
+                   exists <- doesFileExist fname
+                   if exists
+                     then removeFile fname
+                     else return ()
+                   putStr ("(Boot image "++fname++") ")
+                   return (Just fname)
+           else do return Nothing
+      gr <- newNGF abs_name mb_ngf_path
       modifyPGF gr $ do
         sequence_ [setAbstractFlag name value | (name,value) <- flags]
         sequence_ [createCategory c ctxt p | (c,ctxt,p) <- cats]
diff --git a/src/compiler/GF/Compiler.hs b/src/compiler/GF/Compiler.hs
index 6eac757ae..b5c7edec3 100644
--- a/src/compiler/GF/Compiler.hs
+++ b/src/compiler/GF/Compiler.hs
@@ -157,7 +157,11 @@ writeOutputs opts pgf = do
 -- A split PGF file is output if the @-split-pgf@ option is used.
 writeGrammar :: Options -> PGF -> IOE ()
 writeGrammar opts pgf =
-  if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
+  if fst (flag optLinkTargets opts)
+    then if flag optSplitPGF opts
+           then writeSplitPGF
+           else writeNormalPGF
+    else return ()
   where
     writeNormalPGF =
        do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index a2b76008f..0584a2716 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -152,6 +152,7 @@ data Flags = Flags {
       optVerbosity       :: Verbosity,
       optShowCPUTime     :: Bool,
       optOutputFormats   :: [OutputFormat],
+      optLinkTargets     :: (Bool,Bool), -- pgf,ngf files
       optSISR            :: Maybe SISRFormat,
       optHaskellOptions  :: Set HaskellOption,
       optLexicalCats     :: Set String,
@@ -262,6 +263,7 @@ defaultFlags = Flags {
       optVerbosity       = Normal,
       optShowCPUTime     = False,
       optOutputFormats   = [],
+      optLinkTargets     = (True,False),
       optSISR            = Nothing,
       optHaskellOptions  = Set.empty,
       optLiteralCats     = Set.fromList [cString,cInt,cFloat,cVar],
@@ -320,6 +322,8 @@ optDescr =
      Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",
      Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .",
      Option [] ["make"] (NoArg (liftM2 addOptions (mode ModeCompiler) (phase Link))) "Build .pgf file and other output files and exit.",
+     Option [] ["boot"] (NoArg (set $ \o -> o {optLinkTargets = (True,True)})) "Boot an .ngf database for fast grammar reloading",
+     Option [] ["boot-only"] (NoArg (set $ \o -> o {optLinkTargets = (False,True)})) "Boot the .ngf database and don't write a .pgf file",
      Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",
      Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",
 --   Option ['t'] ["trace"] (NoArg (trace True)) "Trace computations",