gfe as preprocessing to compiler

doc/gf-history.html

@@ -14,6 +14,24 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
 
 <p>
 
+10/6 (AR) Preprocessor of <tt>.gfe</tt> files can now be performed as part of
+any grammar compilation. The flag <tt>-ex</tt> causes GF to look for
+the <tt>.gfe</tt> files and preprocess those that are younger
+than the corresponding <tt>.gf</tt> files. The files are first sorted
+and group by the resource, so that each resource only need be compiled once.
+
+<p>
+
+10/6 (AR) Editor GUI can now be alternatively invoked by the shell
+command <tt>gf -edit</tt> (equivalent to <tt>jgf</tt>).
+
+<p>
+
+10/6 (AR) Editor GUI command <tt>pc Int</tt> to pop <tt>Int</tt>
+items from the clip board.
+
+<p>
+
 4/6 (AR) Sequence of commands in the Java editor GUI now possible.
 The commands are separated by <tt> ;; </tt> (notice the space on
 both sides of the two semicolons). Such a sequence can be sent

src/GF.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stability)
 -- Portability : (portability)
 --
--- > CVS $Date: 2005/06/03 21:51:58 $ 
+-- > CVS $Date: 2005/06/10 21:04:01 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.27 $
+-- > CVS $Revision: 1.28 $
 --
 -- The Main module of GF program.
 -----------------------------------------------------------------------------
@@ -20,6 +20,7 @@ import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.API.IOGrammar
 import GF.Compile.ShellState
+import GF.Compile.Compile
 import GF.Compile.MkConcrete
 import GF.Shell
 import GF.Shell.SubShell
@@ -30,19 +31,22 @@ import GF.Text.UTF8
 
 import GF.Today (today,version)
 import GF.System.Arch
-import System (getArgs)
+import System (getArgs,system)
-import Control.Monad (foldM)
+import Control.Monad (foldM,liftM)
+import Data.List (nub)
 
 -- AR 19/4/2000 -- 28/4/2005
 
 main :: IO ()
 main = do
   xs <- getArgs
-  let (os,fs) = getOptions "-" xs
+  let 
-      opt j   = oElem j os
+   (os,fs) = getOptions "-" xs
-      st0     = optInitShellState os
+   opt j   = oElem j os
-      ifNotSil c = if oElem beSilent os then return () else c 
+   st0     = optInitShellState os
-  case 0 of
+   ifNotSil c = if oElem beSilent os then return () else c 
+
+   doGF os fs = case 0 of
 
     _ | opt getHelp -> do
       putStrLnFlush $ encodeUTF8 helpMsg
@@ -62,6 +66,10 @@ main = do
     _ | opt makeConcrete -> do
         mkConcretes fs
 
+    _ | opt openEditor -> do
+        system $ "jgf" +++ unwords xs
+        return ()
+
     _ | opt doBatch -> do
       if opt beSilent then return () else putStrLnFlush "<gfbatch>"
       st <- useIOE st0 $ 
@@ -77,17 +85,26 @@ main = do
       if null fs then return () else (ifNotSil putCPU) 
       gfInteract (initHState st) 
       return ()
+  -- preprocessing gfe
+  if opt fromExamples 
+    then do
+        es <- liftM (nub . concat) $ mapM (getGFEFiles os) fs
+        mkConcretes es
+        doGF (removeOption fromExamples os) fs
+    else doGF os fs
 
 helpMsg = unlines [
   "Usage: gf <option>* <file>*",
   "Options:",
+  "  -batch        structure session by XML tags (use > to send into a file)",
+  "  -edit         start the editor GUI (same as command 'jgf')",
+  "  -ex           first compile .gfe files as needed, then .gf files",
+  "  -examples     batch-compile .gfe files by parsing examples",
+  "  -help         show this message",
   "  -make         batch-compile files",
   "     -noemit      do not emit code when compiling",
   "     -v           be verbose when compiling",
-  "  -batch        structure session by XML tags (use > to send into a file)",
+  "Also all flags for import (i) are interpreted; see 'help i'."
-  "  -examples     batch-compile .gfe file by parsing examples",
-  "  -help         show this message",
-  "To use the GUI: jgf <option>* <file>*"
   ]
 
 welcomeMsg = 

src/GF/Compile/Compile.hs

@@ -5,16 +5,16 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/30 21:08:14 $
+-- > CVS $Date: 2005/06/10 21:04:01 $
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.40 $
+-- > CVS $Revision: 1.41 $
 --
 -- The top-level compilation chain from source file to gfc\/gfr.
 -----------------------------------------------------------------------------
 
 module GF.Compile.Compile (compileModule, compileEnvShSt, compileOne,
-		CompileEnv, TimedCompileEnv
+		CompileEnv, TimedCompileEnv,gfGrammarPathVar,pathListOpts,
-	       ) where
+	       getGFEFiles) where
 
 import GF.Grammar.Grammar
 import GF.Infra.Ident
@@ -50,6 +50,7 @@ import GF.Infra.UseIO
 import GF.System.Arch
 
 import Control.Monad
+import System.Directory
 
 -- | environment variable for grammar search path
 gfGrammarPathVar = "GF_GRAMMAR_PATH"
@@ -335,3 +336,27 @@ writeNewGF m@(i,_) = do
   ioeIO $ writeFile file $ prGrammar (MGrammar [m])
   ioeIO $ putStrLn $ "wrote file" +++ file
   return file
+
+--- this function duplicates a lot of code from compileModule.
+--- It does not really belong here either.
+-- It selects those .gfe files that a grammar depends on and that
+-- are younger than corresponding gf
+
+getGFEFiles :: Options -> FilePath -> IO [FilePath]
+getGFEFiles opts1 file = useIOE [] $ do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = justInitPath file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (map (prefixPathName fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv gfLibraryPath gfGrammarPathVar ps1
+  let file' = if useFileOpt then justFileName file else file -- to find file itself
+  files <- getAllFiles opts ps [] file'
+  efiles <- ioeIO $ filterM doesFileExist [suffixFile "gfe" (unsuffixFile f) | f <- files]
+  es <- ioeIO $ mapM (uncurry selectLater) [(f, init f) | f <- efiles] -- init gfe == gf
+  return $ filter ((=='e') . last) es

src/GF/Compile/MkConcrete.hs

@@ -20,15 +20,20 @@ import GF.Grammar.Grammar (Term(Q,QC)) ---
 import GF.Grammar.Macros (composSafeOp, record2subst)
 import GF.Compile.ShellState (firstStateGrammar)
 import GF.Compile.PGrammar (pTerm)
+import GF.Compile.Compile
 import GF.API
 import qualified GF.Embed.EmbedAPI as EA
 
 import GF.Data.Operations
 import GF.Infra.UseIO
 import GF.Infra.Option
+import GF.Infra.ReadFiles
+import GF.System.Arch
 
+import System.Directory
 import Data.Char
 import Control.Monad
+import Data.List
 
 -- translate strings into lin rules by parsing in a resource
 -- grammar. AR 2/6/2005
@@ -47,12 +52,16 @@ import Control.Monad
 -- notice: we use a hand-crafted lexer and parser in order to preserve
 -- the layout and comments in the rest of the file.
 
-
 mkConcretes :: [FilePath] -> IO ()
-mkConcretes [] = putStrLn "no files to process"
+mkConcretes files = do
-mkConcretes files@(file:_) = do
+  ress <- mapM getResPath files
-  cont <- liftM lines $ readFileIf file
+  let grps = groupBy (\a b -> fst a == fst b) $ 
-  let res = getResPath cont
+               sortBy (\a b -> compare (fst a) (fst b)) $ zip ress files
+  mapM_ mkCncGroups [(r,map snd gs) | gs@((r,_):_) <- grps]
+
+mkCncGroups (res,files) = do
+  putStrLnFlush $ "Going to preprocess examples in " ++ unwords files
+  putStrLn $ "Compiling resource " ++ res
   egr <- appIOE $ 
     optFile2grammar (options 
       [useOptimizer "share",fromSource,beSilent,notEmitCode]) res --- for -mcfg
@@ -60,6 +69,7 @@ mkConcretes files@(file:_) = do
   let parser cat = errVal ([],"No parse") . 
                    optParseArgErrMsg (options [newMParser, firstCat cat, beVerbose]) gr
   let morpho = isKnownWord gr
+  putStrLn "Building parser"
   mapM_ (mkConcrete parser morpho) files
 
 type Parser = String -> String -> ([Tree],String)
@@ -69,13 +79,16 @@ mkConcrete :: Parser -> Morpho -> FilePath -> IO ()
 mkConcrete parser morpho file = do
   cont <- liftM getExLines $ readFileIf file
   let out = suffixFile "gf" $ justModuleName file
-  writeFile out ""
+  writeFile out $ "-- File generated by GF from " ++ file
+  appendFile out "\n"
   mapM_ (mkCnc out parser morpho) cont
 
-getResPath :: [String] -> String
+getResPath :: FilePath -> IO String
-getResPath s = case head (dropWhile (all isSpace) s) of
+getResPath file = do
-  '-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path))
+  s <- liftM lines $ readFileIf file
-  _ -> error "first line must be --# -resource=<PATH>" 
+  return $ case head (dropWhile (all isSpace) s) of
+    '-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path))
+    _ -> error "first line must be --# -resource=<PATH>" 
 
 getExLines :: String -> [Either String String]
 getExLines = getl . lines where
@@ -135,3 +148,4 @@ doSubst subst0 trm = prt_ $ subt subst trm where
     Q  _ c -> maybe t id $ lookup c g
     QC _ c -> maybe t id $ lookup c g
     _      -> composSafeOp (subt g) t
+

src/GF/Infra/Option.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/06/03 21:51:59 $ 
+-- > CVS $Date: 2005/06/10 21:04:01 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.29 $
+-- > CVS $Revision: 1.30 $
 --
 -- Options and flags used in GF shell commands and files.
 --
@@ -245,6 +245,8 @@ showAll      = iOpt "all"
 showMulti    = iOpt "multi"
 fromSource   = iOpt "src"
 makeConcrete = iOpt "examples"
+fromExamples = iOpt "ex"
+openEditor = iOpt "edit"
 
 -- ** mainly for stand-alone
 

src/GF/Shell.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/17 12:37:17 $ 
+-- > CVS $Date: 2005/06/10 21:04:01 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.38 $
+-- > CVS $Revision: 1.39 $
 --
 -- GF shell command interpreter.
 -----------------------------------------------------------------------------
@@ -50,6 +50,7 @@ import GF.Grammar.PrGrammar
 import Control.Monad (foldM,liftM)
 import System (system)
 import System.Random (newStdGen) ----
+import Data.List (nub)
 import GF.Data.Zipper ----
 
 import GF.Data.Operations
@@ -126,9 +127,14 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do
 execC :: CommandOpt -> ShellIO
 execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
 
+  CImport file | oElem fromExamples opts -> do
+    es <- liftM nub $ getGFEFiles opts file
+    system $ "gf -examples" +++ unlines es
+    execC (comm, removeOption fromExamples opts) sa
   CImport file -> useIOE sa $ do
     st1 <- shellStateFromFiles opts st file
     ioeIO $ changeState (const st1) sa --- \ ((_,h),a) -> ((st,h), a))
+
   CEmptyState    -> changeState reinitShellState sa
   CChangeMain ma -> changeStateErr (changeMain ma) sa
   CStripState    -> changeState purgeShellState sa

src/GF/Shell/HelpFile.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/17 12:37:17 $
+-- > CVS $Date: 2005/06/10 21:04:01 $
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- Help on shell commands. Generated from HelpFile by 'make help'.
 -- PLEASE DON'T EDIT THIS FILE.
@@ -27,7 +27,7 @@ txtHelpCommand c =
     _ -> "Command not found."
 
 txtHelpFile =
-  "\n-- GF help file updated for GF 2.0, 24/3/2004." ++
+  "\n-- GF help file updated for GF 2.2, 17/5/2005." ++
   "\n-- *: Commands and options marked with * are not yet implemented." ++
   "\n--" ++
   "\n-- Each command has a long and a short name, options, and zero or more" ++
@@ -48,6 +48,7 @@ txtHelpFile =
   "\n        .gfc   canonical GF" ++
   "\n        .gfr   precompiled GF resource  " ++
   "\n        .gfcm  multilingual canonical GF" ++
+  "\n        .gfe   example-based grammar files (only with the -ex option)" ++
   "\n        .ebnf  Extended BNF format" ++
   "\n        .cf    Context-free (BNF) format" ++
   "\n  options:" ++
@@ -61,6 +62,7 @@ txtHelpFile =
   "\n      -cflexer      build an optimized parser with separate lexer trie" ++
   "\n      -noemit       do not emit code (default with old grammar format)" ++
   "\n      -o            do emit code (default with new grammar format)" ++
+  "\n      -ex           preprocess .gfe files if needed" ++
   "\n  flags:" ++
   "\n      -abs          set the name used for abstract syntax (with -old option)" ++
   "\n      -cnc          set the name used for concrete syntax (with -old option)" ++

src/GF/Shell/ShellCommands.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/17 13:38:46 $ 
+-- > CVS $Date: 2005/06/10 21:04:01 $ 
--- > CVS $Author: peb $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.36 $
+-- > CVS $Revision: 1.37 $
 --
 -- The datatype of shell commands and the list of their options.
 -----------------------------------------------------------------------------
@@ -160,7 +160,7 @@ optionsOfCommand co = case co of
   CSetFlag -> both "utf8 table struct record all multi"
 	           "cat lang lexer parser number depth rawtrees unlexer optimize path conversion printer"
 
-  CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o"
+  CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o ex"
                     "abs cnc res path optimize conversion cat"
   CRemoveLanguage _ -> none
   CEmptyState -> none

src/HelpFile

@@ -19,6 +19,7 @@ i,  import: i File
         .gfc   canonical GF
         .gfr   precompiled GF resource  
         .gfcm  multilingual canonical GF
+        .gfe   example-based grammar files (only with the -ex option)
         .ebnf  Extended BNF format
         .cf    Context-free (BNF) format
   options:
@@ -32,6 +33,7 @@ i,  import: i File
       -cflexer      build an optimized parser with separate lexer trie
       -noemit       do not emit code (default with old grammar format)
       -o            do emit code (default with new grammar format)
+      -ex           preprocess .gfe files if needed
   flags:
       -abs          set the name used for abstract syntax (with -old option)
       -cnc          set the name used for concrete syntax (with -old option)