diff --git a/doc/gf-history.html b/doc/gf-history.html index 22961e7ec..9450c8d99 100644 --- a/doc/gf-history.html +++ b/doc/gf-history.html @@ -14,6 +14,24 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2

+1/3 (AR) Added option -trees to the command tree_bank = tb. +By this option, the command just returns the trees in the treebank. It can be +used for producing new treebanks with the same trees: +

+  rf old.xml | tb -trees | tb -xml | wf new.xml
+
+Recall that only treebanks in the XML format can be read with the -trees +and -c flags. + +

+ +1/3 (AR) A .gfe file can have a --# -path=PATH on its +second line. The file given on the first line (--# -resource=FILE) +is then read w.r.t. this path. This is useful if the resource file has +no path itself, which happens when it is gfc-only. + +

+ 25/2 (AR) The flag preproc of the i command (and thereby to gf itself) causes GF to apply a preprocessor to each sourcefile it reads. diff --git a/examples/animal/QuestionsI.gf b/examples/animal/QuestionsI.gf index f1f549283..e79b2e0c2 100644 --- a/examples/animal/QuestionsI.gf +++ b/examples/animal/QuestionsI.gf @@ -1,5 +1,6 @@ -- File generated by GF from QuestionsI.gfe --# -resource=../../lib/resource-1.0/english/LangEng.gf +--# -path=.:present:prelude -- to compile: gf -examples QuestionsI.gfe -- or use directly gf fst a == fst b) $ sortBy (\a b -> compare (fst a) (fst b)) $ zip ress files - mapM_ mkCncGroups [(r,map snd gs) | gs@((r,_):_) <- grps] + mapM_ mkCncGroups [(rp,map snd gs) | gs@((rp,_):_) <- grps] -mkCncGroups (res,files) = do +mkCncGroups ((res,path),files) = do putStrLnFlush $ "Going to preprocess examples in " ++ unwords files putStrLn $ "Compiling resource " ++ res - egr <- appIOE $ shellStateFromFiles (options [beSilent]) emptyShellState res + let opts = options [beSilent,pathList path] + egr <- appIOE $ shellStateFromFiles opts emptyShellState res gr <- err (\s -> putStrLn s >> error "resource grammar rejected") (return . firstStateGrammar) egr let parser cat = @@ -81,12 +82,18 @@ mkConcrete parser morpho file = do appendFile out "\n" mapM_ (mkCnc out parser morpho) cont -getResPath :: FilePath -> IO String +getResPath :: FilePath -> IO (String,String) getResPath file = do s <- liftM lines $ readFileIf file - return $ case head (dropWhile (all isSpace) s) of - '-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path)) - _ -> error "first line must be --# -resource=" + case filter (not . all isSpace) s of + res:path:_ | is "resource" res && is "path" path -> return (val res, val path) + res:_ | is "resource" res -> return (val res, "") + _ -> error "expected --# -resource=FILE and optional --# -path=PATH" + where + val = dropWhile (isSpace) . tail . dropWhile (not . (=='=')) + is tag s = case words s of + "--#":w:_ -> isPrefixOf ('-':tag) w + _ -> False getExLines :: String -> [Either String String] getExLines = getl . lines where diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index ab9beea36..33e20b03b 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -372,6 +372,10 @@ morphoOfLang st = stateMorpho . stateGrammarOfLang st probsOfLang st = stateProbs . stateGrammarOfLang st optionsOfLang st = stateOptions . stateGrammarOfLang st +removeLang :: Language -> ShellState -> ShellState +removeLang lang st = purgeShellState $ st{concretes = concs1} where + concs1 = filter ((/=lang) . snd . fst) $ concretes st + -- | the last introduced grammar, stored in options, is the default for operations firstStateGrammar :: ShellState -> StateGrammar firstStateGrammar st = errVal (stateAbstractGrammar st) $ do diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index 81ddd44af..0d0e7ad35 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -256,7 +256,8 @@ showMulti = iOpt "multi" fromSource = iOpt "src" makeConcrete = iOpt "examples" fromExamples = iOpt "ex" -openEditor = iOpt "edit" +openEditor = iOpt "edit" +getTrees = iOpt "trees" -- ** mainly for stand-alone diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 7bf9edaf1..76563b5ad 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -88,8 +88,11 @@ isSep :: Char -> Bool isSep c = c == '/' || c == '\\' getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) -getFilePath paths file = get paths where - get [] = putStrLnFlush ("file" +++ file +++ "not found") >> return Nothing +getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file + +getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath) +getFilePathMsg msg paths file = get paths where + get [] = putStrFlush msg >> return Nothing get (p:ps) = let pfile = prefixPathName p file in catch (readFile pfile >> return (Just pfile)) (\_ -> get ps) @@ -104,7 +107,7 @@ readFileIfPath paths file = do doesFileExistPath :: [FilePath] -> String -> IOE Bool doesFileExistPath paths file = do - mpfile <- ioeIO $ getFilePath paths file + mpfile <- ioeIO $ getFilePathMsg "" paths file return $ maybe False (const True) mpfile -- | first var is lib prefix, second is like class path diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 9eab757b7..0d5332fb8 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -193,8 +193,8 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com CChangeMain ma -> changeStateErr (changeMain ma) sa CStripState -> changeState purgeShellState sa + CRemoveLanguage lan -> changeState (removeLang lan) sa {- - CRemoveLanguage lan -> changeState (removeLanguage lan) sa CTransformGrammar file -> do s <- transformGrammarFile opts file returnArg (AString s) sa @@ -293,6 +293,11 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com CTreeBank | oElem doCompute opts -> do -- -c let bank = prCommandArg a returnArg (AString $ unlines $ testTreebank opts st bank) sa + CTreeBank | oElem getTrees opts -> do -- -trees + let bank = prCommandArg a + tes = map (string2treeErr gro) $ treesTreebank opts bank + terms = [t | Ok t <- tes] + returnArg (ATrms terms) sa CTreeBank -> do let ts = strees $ s2t $ snd sa comm = "command" ---- diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs index e61c5cc6a..2f21184f1 100644 --- a/src/GF/Shell/HelpFile.hs +++ b/src/GF/Shell/HelpFile.hs @@ -80,7 +80,7 @@ txtHelpFile = "\n i English.gf -- ordinary import of Concrete" ++ "\n i -retain german/ParadigmsGer.gf -- import of Resource to test" ++ "\n " ++ - "\n* rl, remove_language: rl Language" ++ + "\nrl, remove_language: rl Language" ++ "\n Takes away the language from the state." ++ "\n" ++ "\ne, empty: e" ++ @@ -236,10 +236,12 @@ txtHelpFile = "\n to an existing treebank." ++ "\n options:" ++ "\n -c compare to existing xml-formatted treebank" ++ + "\n -trees return the trees of the treebank" ++ "\n -xml wrap the treebank (or comparison results) with XML tags" ++ "\n examples:" ++ "\n gr -cat=S -number=100 | tb -xml | wf tb.xml -- random treebank into file" ++ - "\n rf tb.txt | tb -c -- read comparison treebank from file" ++ + "\n rf tb.xml | tb -c -- compare-test treebank from file" ++ + "\n rf old.xml | tb -trees | tb -xml -- create new treebank from old" ++ "\n" ++ "\ntt, test_tokenizer: tt String" ++ "\n Show the token list sent to the parser when String is parsed." ++ diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index 56c172037..1351e8784 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -183,7 +183,7 @@ optionsOfCommand co = case co of CGenerateRandom -> both "cf prob" "cat lang number depth" CGenerateTrees -> both "metas" "atoms depth alts cat lang number" CPutTerm -> flags "transform number" - CTreeBank -> opts "c xml" + CTreeBank -> opts "c xml trees" CWrapTerm _ -> opts "c" CApplyTransfer _ -> flags "lang transfer" CMorphoAnalyse -> both "short" "lang" diff --git a/src/GF/UseGrammar/Treebank.hs b/src/GF/UseGrammar/Treebank.hs index 12dc598f2..8f5fd71a7 100644 --- a/src/GF/UseGrammar/Treebank.hs +++ b/src/GF/UseGrammar/Treebank.hs @@ -12,7 +12,7 @@ -- Purpose: to generate treebanks. ----------------------------------------------------------------------------- -module GF.UseGrammar.Treebank (mkTreebank,testTreebank) where +module GF.UseGrammar.Treebank (mkTreebank,testTreebank,treesTreebank) where import GF.Compile.ShellState import GF.UseGrammar.Linear (linTree2string) @@ -49,7 +49,9 @@ mkTreebank opts sh com trees = putInXML opts "treebank" comm (concatMap mkItem t tris = zip trees [1..] testTreebank :: Options -> ShellState -> String -> Res -testTreebank opts sh = putInXML opts "testtreebank" [] . concatMap testOne . getTreebank . lines +testTreebank opts sh = putInXML opts "testtreebank" [] . + concatMap testOne . + getTreebanks . lines where testOne (e,lang,str0) = do let tr = annot gr e @@ -61,6 +63,10 @@ testTreebank opts sh = putInXML opts "testtreebank" [] . concatMap testOne . get ] gr = firstStateGrammar sh +treesTreebank :: Options -> String -> [String] +treesTreebank _ = terms . getTreebank . lines where + terms ts = [t | (t,_) <- ts] + -- string vs. IO type Res = [String] -- IO () puts :: String -> Res @@ -68,18 +74,23 @@ puts = return -- putStrLn ret = [] -- return () -- -getTreebank :: [String] -> [(String,String,String)] +getTreebanks :: [String] -> [(String,String,String)] +getTreebanks = concatMap grps . getTreebank where + grps (t,lls) = [(t,x,y) | (x,y) <- lls] + +getTreebank :: [String] -> [(String,[(String,String)])] getTreebank ll = case ll of - [] -> [] - l:ls -> + l:ls@(_:_:_) -> let (l1,l2) = getItem ls (tr,lins) = getTree l1 lglins = getLins lins - in [(tr,lang,str) | (lang,str) <- lglins] ++ getTreebank l2 + in (tr,lglins) : getTreebank l2 + _ -> [] where getItem = span ((/="