diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-05-20 11:47:44 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-05-20 11:47:44 +0000 |
| commit | 31bf84122b21efb444aa8d055472e166ffb90783 (patch) | |
| tree | 1f051909336f1534346bcccde8dda59beab02f64 /src-2.9/GF/API/IOGrammar.hs | |
| parent | 74f048dcf41de3540778de54dfa7541fa5b39c46 (diff) | |
moved all old source code to src-2.9 ; src will be for GF 3 development
Diffstat (limited to 'src-2.9/GF/API/IOGrammar.hs')
| -rw-r--r-- | src-2.9/GF/API/IOGrammar.hs | 96 |
1 files changed, 96 insertions, 0 deletions
diff --git a/src-2.9/GF/API/IOGrammar.hs b/src-2.9/GF/API/IOGrammar.hs new file mode 100644 index 000000000..bd7fc5648 --- /dev/null +++ b/src-2.9/GF/API/IOGrammar.hs @@ -0,0 +1,96 @@ +---------------------------------------------------------------------- +-- | +-- Module : IOGrammar +-- Maintainer : Aarne Ranta +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/14 16:03:40 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.20 $ +-- +-- for reading grammars and terms from strings and files +----------------------------------------------------------------------------- + +module GF.API.IOGrammar (shellStateFromFiles, + getShellStateFromFiles) where + +import GF.Grammar.Abstract +import qualified GF.Canon.GFC as GFC +import GF.Compile.PGrammar +import GF.Grammar.TypeCheck +import GF.Compile.Compile +import GF.Compile.ShellState +import GF.Compile.NoParse +import GF.Probabilistic.Probabilistic +import GF.UseGrammar.Treebank + +import GF.Infra.Modules +import GF.Infra.ReadFiles (isOldFile) +import GF.Infra.Option +import GF.Data.Operations +import GF.Infra.UseIO +import GF.System.Arch + +import qualified Transfer.InterpreterAPI as T + +import Control.Monad (liftM) +import System.FilePath + +-- | a heuristic way of renaming constants is used +string2absTerm :: String -> String -> Term +string2absTerm m = renameTermIn m . pTrm + +renameTermIn :: String -> Term -> Term +renameTermIn m = refreshMetas [] . rename [] where + rename vs t = case t of + Abs x b -> Abs x (rename (x:vs) b) + Vr c -> if elem c vs then t else Q (zIdent m) c + App f a -> App (rename vs f) (rename vs a) + _ -> t + +string2annotTree :: GFC.CanonGrammar -> Ident -> String -> Err Tree +string2annotTree gr m = annotate gr . string2absTerm (prt m) ---- prt + +----string2paramList :: ConcreteST -> String -> [Term] +---string2paramList st = map (renameTrm (lookupConcrete st) . patt2term) . pPattList + +shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState +shellStateFromFiles opts st file = do + ign <- ioeIO $ getNoparseFromFile opts file + let top = identC $ justModuleName file + sh <- case takeExtensions file of + ".trc" -> do + env <- ioeIO $ T.loadFile file + return $ addTransfer (top,env) st + ".gfcm" -> do + cenv <- compileOne opts (compileEnvShSt st []) file + ioeErr $ updateShellState opts ign Nothing st cenv + s | elem s [".cf",".ebnf"] -> do + let osb = addOptions (options []) opts + grts <- compileModule osb st file + ioeErr $ updateShellState opts ign Nothing st grts + s | oElem (iOpt "treebank") opts -> do + tbs <- ioeIO $ readUniTreebanks file + return $ addTreebanks tbs st + _ -> do + b <- ioeIO $ isOldFile file + let opts' = if b then (addOption showOld opts) else opts + + let osb = if oElem showOld opts' + then addOptions (options []) opts' -- for old no emit + else addOptions (options [emitCode]) opts' + grts <- compileModule osb st file + let mtop = if oElem showOld opts' then Nothing else Just top + ioeErr $ updateShellState opts' ign mtop st grts + if (isSetFlag opts probFile || oElem (iOpt "prob") opts) + then do + probs <- ioeIO $ getProbsFromFile opts file + let lang = maybe top id $ concrete sh --- to work with cf, too + ioeErr $ addProbs (lang,probs) sh + else return sh + +getShellStateFromFiles :: Options -> FilePath -> IO ShellState +getShellStateFromFiles os = + useIOE emptyShellState . + shellStateFromFiles os emptyShellState |
