diff options
| author | aarne <unknown> | 2004-06-21 08:53:58 +0000 |
|---|---|---|
| committer | aarne <unknown> | 2004-06-21 08:53:58 +0000 |
| commit | b248e6e25e5b58163cc9b897be7eb0b4bf6dbdc6 (patch) | |
| tree | 74d74c06998903a16c5909eafc9835e1ca68491d /src/GF | |
| parent | a134a1fd65c80bae1e37d304fc674453e126c504 (diff) | |
for release meeting
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/API.hs | 7 | ||||
| -rw-r--r-- | src/GF/Compile/Compile.hs | 11 | ||||
| -rw-r--r-- | src/GF/Infra/UseIO.hs | 7 | ||||
| -rw-r--r-- | src/GF/Shell/TeachYourself.hs | 8 |
4 files changed, 24 insertions, 9 deletions
diff --git a/src/GF/API.hs b/src/GF/API.hs index c3d160bcd..ca97af146 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -148,8 +148,9 @@ string2srcTerm gr m s = do randomTreesIO :: Options -> GFGrammar -> Int -> IO [Tree] randomTreesIO opts gr n = do gen <- myStdGen mx - t <- err (\s -> putStrLnFlush s >> return []) (return . singleton) $ - mkRandomTree gen mx g catfun + t <- err (\s -> putS s >> return []) + (return . singleton) $ + mkRandomTree gen mx g catfun ts <- if n==1 then return [] else randomTreesIO opts gr (n-1) return $ t ++ ts where @@ -158,6 +159,8 @@ randomTreesIO opts gr n = do _ -> Left $ firstAbsCat opts gr g = grammar gr mx = optIntOrN opts flagDepth 41 + putS s = if oElem beSilent opts then return () else putStrLnFlush s + generateTrees :: Options -> GFGrammar -> Maybe Tree -> [Tree] generateTrees opts gr mt = diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index fa2e65a3c..78f3a1bb1 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -35,6 +35,10 @@ import Arch import Monad +-- environment variable for grammar search path + +gfGrammarPathVar = "GF_LIB_PATH" + -- in batch mode: write code in a file batchCompile f = liftM fst $ compileModule defOpts emptyShellState f @@ -86,9 +90,10 @@ compileModule opts1 st0 file = do let opts = addOptions opts1 opts0 let ps0 = pathListOpts opts let fpath = justInitPath file - let ps = if useFileOpt - then (map (prefixPathName fpath) ps0) - else ps0 + let ps1 = if useFileOpt + then (map (prefixPathName fpath) ps0) + else ps0 + ps <- ioeIO $ extendPathEnv gfGrammarPathVar ps1 let ioeIOIf = if oElem beSilent opts then (const (return ())) else ioeIO ioeIOIf $ putStrLn $ "module search path:" +++ show ps ---- let putp = putPointE opts diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 243ead306..3dc41fadc 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -81,6 +81,13 @@ doesFileExistPath paths file = do mpfile <- ioeIO $ getFilePath paths file return $ maybe False (const True) mpfile +-- path in environment variable has lower priority +extendPathEnv :: String -> [FilePath] -> IO [FilePath] +extendPathEnv var ps = do + s <- catch (getEnv var) (const (return "")) + let fs = pFilePaths s + return $ ps ++ fs + pFilePaths :: String -> [FilePath] pFilePaths s = case span (/=':') s of (f,_:cs) -> f : pFilePaths cs diff --git a/src/GF/Shell/TeachYourself.hs b/src/GF/Shell/TeachYourself.hs index 623bd7b72..e3576e7ed 100644 --- a/src/GF/Shell/TeachYourself.hs +++ b/src/GF/Shell/TeachYourself.hs @@ -24,7 +24,7 @@ teachTranslation opts ig og = do transTrainList :: Options -> GFGrammar -> GFGrammar -> Integer -> IO [(String,[String])] transTrainList opts ig og number = do - ts <- randomTreesIO opts ig (fromInteger number) + ts <- randomTreesIO (addOption beSilent opts) ig (fromInteger number) return $ map mkOne $ ts where cat = firstCatOpts opts ig @@ -39,7 +39,7 @@ teachMorpho opts ig = useIOE () $ do morphoTrainList :: Options -> GFGrammar -> Integer -> IOE [(String,[String])] morphoTrainList opts ig number = do - ts <- ioeIO $ randomTreesIO opts ig (fromInteger number) + ts <- ioeIO $ randomTreesIO (addOption beSilent opts) ig (fromInteger number) gen <- ioeIO $ myStdGen (fromInteger number) mkOnes gen ts where @@ -49,9 +49,9 @@ morphoTrainList opts ig number = do let (i,gen') = randomR (0, length pss - 1) gen (ps,ss) <- ioeErr $ pss !? i (_,ss0) <- ioeErr $ pss !? 0 - let bas = concat $ take 1 ss0 + let bas = unwords ss0 --- concat $ take 1 ss0 more <- mkOnes gen' ts - return $ (bas +++ ":" +++ unwords (map prt_ ps), return (concat ss)) : more + return $ (bas +++ ":" +++ unwords (map prt_ ps), return (unwords ss)) : more mkOnes gen [] = return [] gr = grammar ig |
