diff --git a/doc/gf-history.html b/doc/gf-history.html
index 1e5555c11..c6de42c03 100644
--- a/doc/gf-history.html
+++ b/doc/gf-history.html
@@ -18,7 +18,7 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
grammar writing by examples . Files of this format are first
converted to .gf files by the command
- gf -makeconcrete File.gfe
+ gf -examples File.gfe
See
../lib/resource/doc/examples/QuestionsI.gfe
diff --git a/src/GF.hs b/src/GF.hs
index 2b7b6880d..96cf33661 100644
--- a/src/GF.hs
+++ b/src/GF.hs
@@ -5,9 +5,9 @@
-- Stability : (stability)
-- Portability : (portability)
--
--- > CVS $Date: 2005/06/02 17:31:56 $
+-- > CVS $Date: 2005/06/03 21:51:58 $
-- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
+-- > CVS $Revision: 1.27 $
--
-- The Main module of GF program.
-----------------------------------------------------------------------------
@@ -60,7 +60,7 @@ main = do
_ -> putStrLnFlush "expecting exactly one gf file to compile"
_ | opt makeConcrete -> do
- mapM_ mkConcrete fs
+ mkConcretes fs
_ | opt doBatch -> do
if opt beSilent then return () else putStrLnFlush ""
@@ -85,7 +85,7 @@ helpMsg = unlines [
" -noemit do not emit code when compiling",
" -v be verbose when compiling",
" -batch structure session by XML tags (use > to send into a file)",
- " -makeconcrete batch-compile .gfe file to concrete syntax using parser",
+ " -examples batch-compile .gfe file by parsing examples",
" -help show this message",
"To use the GUI: jgf * *"
]
diff --git a/src/GF/Compile/MkConcrete.hs b/src/GF/Compile/MkConcrete.hs
index 75b4f215e..061d76cc5 100644
--- a/src/GF/Compile/MkConcrete.hs
+++ b/src/GF/Compile/MkConcrete.hs
@@ -12,11 +12,14 @@
-- Compile a gfl file into a concrete syntax by using the parser on a resource grammar.
-----------------------------------------------------------------------------
-module GF.Compile.MkConcrete (mkConcrete) where
+module GF.Compile.MkConcrete (mkConcretes,mkCncLine) where
import GF.Grammar.Values (Tree,tree2exp)
import GF.Grammar.PrGrammar (prt_)
-import GF.Compile.ShellState (absId,firstStateGrammar)
+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.API
import qualified GF.Embed.EmbedAPI as EA
@@ -35,22 +38,32 @@ import Control.Monad
-- Format of resource path (on first line):
-- --# -resource=PATH
-- Other lines are copied verbatim.
--- Assumes: resource has been built with
+-- The resource has to be built with
-- i -src -optimize=share SOURCE
-- because mcfg parsing is used.
+-- A sequence of files can be processed with the same resource without
+-- rebuilding the grammar and parser.
-
-mkConcrete :: FilePath -> IO ()
-mkConcrete file = do
+mkConcretes :: [FilePath] -> IO ()
+mkConcretes [] = putStrLn "no files to process"
+mkConcretes files@(file:_) = do
cont <- liftM lines $ readFileIf file
let res = getResPath cont
egr <- appIOE $
- optFile2grammar (options [useOptimizer "share",fromSource,beSilent,notEmitCode]) res --- for -mcfg
+ optFile2grammar (options
+ [useOptimizer "share",fromSource,beSilent,notEmitCode]) res --- for -mcfg
gr <- err (\s -> putStrLn s >> error "resource file rejected") return egr
- let abs = prt_ $ absId gr
let parser cat = errVal ([],"No parse") .
optParseArgErrMsg (options [newMParser, firstCat cat, beVerbose]) gr
let morpho = isKnownWord gr
+ mapM_ (mkConcrete parser morpho) files
+
+type Parser = String -> String -> ([Tree],String)
+type Morpho = String -> Bool
+
+mkConcrete :: Parser -> Morpho -> FilePath -> IO ()
+mkConcrete parser morpho file = do
+ cont <- liftM lines $ readFileIf file
let out = suffixFile "gf" $ justModuleName file
writeFile out ""
mapM_ (mkCnc out parser morpho) cont
@@ -60,8 +73,7 @@ getResPath s = case head (dropWhile (all isSpace) s) of
'-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path))
_ -> error "first line must be --# -resource="
-mkCnc :: FilePath -> (String -> String -> ([Tree],String)) -> (String -> Bool) ->
- String -> IO ()
+mkCnc :: FilePath -> Parser -> Morpho -> String -> IO ()
mkCnc out parser morpho line = do
let (res,msg) = mkCncLine parser morpho line
appendFile out res
@@ -77,15 +89,15 @@ mkCncLine parser morpho line = case words line of
where
mkLinRule key s =
let
- (pre,str) = span (/= "in") s
+ (pre,str) = span (/= "in") s
([cat],rest) = splitAt 1 $ tail str
- lin = init (tail (unwords (init rest))) -- unquote
+ (lin,subst) = span (/= '"') $ tail $ unwords rest
def
| last pre /= "=" = line -- ordinary lin rule
| otherwise = case parser cat lin of
- ([t],_) -> ind ++ key +++ unwords pre +++ prt_ (tree2exp t) +++ ";"
- (t:_,_) -> ind ++ key +++ unwords pre +++ prt_ (tree2exp t) +++ ";"
- +++ "-- AMBIGUOUS"
+ (t:ts,_) -> ind ++ key +++ unwords pre +++
+ doSubst (init (tail subst)) (tree2exp t) +++ ";" ++
+ if null ts then [] else " -- AMBIGUOUS"
([],msg) -> "{-" ++ line ++++ morph lin ++++ "-}"
in
(def,def)
@@ -93,3 +105,13 @@ mkCncLine parser morpho line = case words line of
[] -> ""
ws -> "unknown words: " ++ unwords ws
ind = takeWhile isSpace line
+
+doSubst :: String -> Term -> String
+doSubst subst0 trm = prt_ $ subt subst trm where
+ subst
+ | all isSpace subst0 = []
+ | otherwise = err error id $ pTerm subst0 >>= record2subst
+ subt g t = case t of
+ Q _ c -> maybe t id $ lookup c g
+ QC _ c -> maybe t id $ lookup c g
+ _ -> composSafeOp (subt g) t
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 89866c6bd..746526c85 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/05/09 15:45:00 $
+-- > CVS $Date: 2005/06/03 21:51:58 $
-- > CVS $Author: aarne $
--- > CVS $Revision: 1.21 $
+-- > CVS $Revision: 1.22 $
--
-- Macros for constructing and analysing source code terms.
--
@@ -280,6 +280,11 @@ mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs]
mkRecType :: (Int -> Label) -> [Type] -> Type
mkRecType = mkRecTypeN 0
+record2subst :: Term -> Err Substitution
+record2subst t = case t of
+ R fs -> return [(zIdent x, t) | (LIdent x,(_,t)) <- fs]
+ _ -> prtBad "record expected, found" t
+
typeType, typePType, typeStr, typeTok, typeStrs :: Term
typeType = srt "Type"
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index d84c7ca7e..4962a9f20 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/06/02 10:23:52 $
+-- > CVS $Date: 2005/06/03 21:51:59 $
-- > CVS $Author: aarne $
--- > CVS $Revision: 1.28 $
+-- > CVS $Revision: 1.29 $
--
-- Options and flags used in GF shell commands and files.
--
@@ -244,7 +244,7 @@ nostripQualif = iOpt "nostrip"
showAll = iOpt "all"
showMulti = iOpt "multi"
fromSource = iOpt "src"
-makeConcrete = iOpt "makeconcrete"
+makeConcrete = iOpt "examples"
-- ** mainly for stand-alone
diff --git a/src/GF/UseGrammar/GetTree.hs b/src/GF/UseGrammar/GetTree.hs
index a8d5fcab2..e71475654 100644
--- a/src/GF/UseGrammar/GetTree.hs
+++ b/src/GF/UseGrammar/GetTree.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:23:47 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
+-- > CVS $Date: 2005/06/03 21:51:59 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.8 $
--
-- how to form linearizable trees from strings and from terms of different levels
--
@@ -39,6 +39,7 @@ string2tree :: StateGrammar -> String -> Tree
string2tree gr = errVal uTree . string2treeErr gr
string2treeErr :: StateGrammar -> String -> Err Tree
+string2treeErr _ "" = Bad "empty string"
string2treeErr gr s = do
t <- pTerm s
let t1 = refreshMetas [] t