GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3

src-3.0/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