diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF.hs | 6 | ||||
| -rw-r--r-- | src/GF/API.hs | 20 | ||||
| -rw-r--r-- | src/GF/Compile/MkConcrete.hs | 38 |
3 files changed, 41 insertions, 23 deletions
@@ -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>*" ] diff --git a/src/GF/API.hs b/src/GF/API.hs index 20f32b59e..d9c9afe49 100644 --- a/src/GF/API.hs +++ b/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) diff --git a/src/GF/Compile/MkConcrete.hs b/src/GF/Compile/MkConcrete.hs index 6295e9851..be3d6f5b4 100644 --- a/src/GF/Compile/MkConcrete.hs +++ b/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 |