blob: 335757cf4727367c4ce53b1dae18f0e9cc9922dd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
----------------------------------------------------------------------
-- |
-- 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)
-- | 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 fileSuffix 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
|
