better MkConcrete and example in lib/resource/doc/example

lib/resource/doc/example/QuestionsEng.gf

@@ -1,2 +1,2 @@
-concrete QuestionsEng of Questions = QuestionsI with 
+concrete QuestionsEng of Questions = QuestionsExI with 
   (Resource = ResourceEng) ;

lib/resource/doc/example/QuestionsExI.gfe

@@ -0,0 +1,15 @@
+--# -resource=../../langeng.gfcm
+
+-- to compile: gf -makeconcrete QuestionsExI.gfe
+
+incomplete concrete QuestionsExI of Questions = open Resource in {
+  lincat
+    Phrase = Phr ;
+    Entity = N ;
+    Action = V2 ;
+
+  lin Who  love_V2 man_N           = in Phr "who loves the men?" ;
+  lin Whom man_N love_V2           = in Phr "whom does the man love?" ;
+  lin Answer woman_N love_V2 man_N = in Phr "the woman loves the man." ;
+
+}

src/GF.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stability)
 -- Portability : (portability)
 --
--- > CVS $Date: 2005/06/02 10:23:52 $ 
+-- > CVS $Date: 2005/06/02 17:31:56 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.25 $
+-- > CVS $Revision: 1.26 $
 --
 -- The Main module of GF program.
 -----------------------------------------------------------------------------
@@ -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 .gfp file to concrete syntax using parser",
+  "  -makeconcrete batch-compile .gfe file to concrete syntax using parser",
   "  -help         show this message",
   "To use the GUI: jgf <option>* <file>*"
   ]

src/GF/API.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/17 11:20:25 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.36 $
+-- > CVS $Date: 2005/06/02 17:31:57 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.37 $
 --
 -- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001
 -----------------------------------------------------------------------------
@@ -55,6 +55,7 @@ import qualified GF.Infra.Ident as I
 import qualified GF.Compile.GrammarToCanon as GC
 import qualified GF.Canon.CanonToGrammar as CG
 import qualified GF.Canon.MkGFC as MC
+import qualified GF.Embed.EmbedAPI as EA
 
 import GF.UseGrammar.Editing
 
@@ -145,9 +146,11 @@ string2GFCat = string2CFCat
 -- then stg for customizable and internal use
 
 optFile2grammar :: Options -> FilePath -> IOE GFGrammar
-optFile2grammar os f = do
-  ((_,_,gr),_) <- compileModule os emptyShellState f
-  ioeErr $ grammar2stateGrammar os gr
+optFile2grammar os f  
+  | fileSuffix f == "gfcm" = ioeIO $ liftM firstStateGrammar $ EA.file2grammar f
+  | otherwise = do
+      ((_,_,gr),_) <- compileModule os emptyShellState f
+      ioeErr $ grammar2stateGrammar os gr
 
 optFile2grammarE :: Options -> FilePath -> IOE GFGrammar
 optFile2grammarE = optFile2grammar
@@ -292,6 +295,11 @@ morphoAnalyse opts gr
  where
   mo = morpho gr
 
+isKnownWord :: GFGrammar -> String -> Bool
+isKnownWord gr s = case morphoAnalyse (options [beShort]) gr s of
+  a@(_:_:_) -> last (init a) /= '*'  -- [word *]
+  _ -> False
+
 {-
 prExpXML :: StateGrammar -> Term -> [String]
 prExpXML gr = prElementX . term2elemx (stateAbstract gr) 

src/GF/Compile/MkConcrete.hs

@@ -16,11 +16,13 @@ module GF.Compile.MkConcrete (mkConcrete) where
 
 import GF.Grammar.Values (Tree,tree2exp)
 import GF.Grammar.PrGrammar (prt_)
-import GF.Compile.ShellState (absId,stateGrammarWords)
+import GF.Compile.ShellState (absId,firstStateGrammar)
 import GF.API
+import qualified GF.Embed.EmbedAPI as EA
 
 import GF.Data.Operations
 import GF.Infra.UseIO
+import GF.Infra.Option
 
 import Data.Char
 import Control.Monad
@@ -33,26 +35,31 @@ import Control.Monad
 -- Format of resource path (on first line):
 --    --# -resource=PATH
 -- Other lines are copied verbatim.
+-- Assumes: resource has been built with 
+--    i -src -optimize=share SOURCE
+-- because mcfg parsing is used.
 
 
 mkConcrete :: FilePath -> IO ()
 mkConcrete file = do
   cont <- liftM lines $ readFileIf file
   let res = getResPath cont
-  gr   <- file2grammar res
+  egr <- appIOE $ optFile2grammar (options [useOptimizer "share"]) res --- for -mcfg
+  gr  <- err (\s -> putStrLn s >> error "resource file rejected") return egr
   let abs = prt_ $ absId gr
-  let parser cat = parse gr (string2GFCat abs cat)
-  let mor = \w -> isInBinTree w $ sorted2tree [(w,()) | w <- stateGrammarWords gr]
+  let parser cat = errVal ([],"No parse") . 
+                   optParseArgErrMsg (options [newMParser, firstCat cat, beVerbose]) gr
+  let morpho = isKnownWord gr
   writeFile (suffixFile "gf" (justModuleName file)) $ unlines $ 
-    map (mkCnc parser mor) cont
+    map (mkCnc parser morpho) cont
 
 getResPath :: [String] -> String
 getResPath s = case head (dropWhile (all isSpace) s) of
   '-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path))
   _ -> error "first line must be --# -resource=<PATH>" 
 
-mkCnc :: (String -> String -> [Tree]) -> (String -> Bool) -> String -> String
-mkCnc parser morph line = case words line of
+mkCnc :: (String -> String -> ([Tree],String)) -> (String -> Bool) -> String -> String
+mkCnc parser morpho line = case words line of
   "lin" : rest -> mkLinRule rest
   _ -> line
  where
@@ -61,11 +68,14 @@ mkCnc parser morph line = case words line of
        (pre,str)  = span (/= "in") s
        ([cat],rest) = splitAt 1 $ tail str
        lin        = init (tail (unwords (init rest))) -- unquote
-       def = case parser cat lin of 
-         [t] -> prt_ $ tree2exp t 
-         t:_ -> prt_ (tree2exp t) +++ "{- AMBIGUOUS -}"
-         []  -> ""
+       def 
+        | last pre /= "=" = line  -- ordinary lin rule
+        | otherwise  = case parser cat lin of 
+           ([t],_)  -> "lin " ++ unwords pre +++ prt_ (tree2exp t) +++ ";" 
+           (t:_,_)  -> "lin " ++ unwords pre +++ prt_ (tree2exp t) +++ "{- AMBIGUOUS -} ;"
+           ([],msg) -> "{-" ++ line ++++ morph lin ++++ "-}" 
     in
-     if null def
-       then "-- NO PARSE " ++ line
-       else "lin " ++ unwords pre +++ def +++ ";"
+     def
+   morph s = case [w | w <- words s, not (morpho w)] of
+     [] -> ""
+     ws -> "unknown words: " ++ unwords ws