mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-11 13:59:31 -06:00
97 lines
3.2 KiB
Haskell
97 lines
3.2 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- 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
|