forked from GitHub/gf-core
started source grammar API ; used it for a first implem. of cc command
This commit is contained in:
52
src-3.0/GF/Grammar/API.hs
Normal file
52
src-3.0/GF/Grammar/API.hs
Normal file
@@ -0,0 +1,52 @@
|
|||||||
|
module GF.Grammar.API (
|
||||||
|
Grammar,
|
||||||
|
emptyGrammar,
|
||||||
|
pTerm,
|
||||||
|
prTerm,
|
||||||
|
checkTerm,
|
||||||
|
computeTerm
|
||||||
|
) where
|
||||||
|
|
||||||
|
import GF.Source.ParGF
|
||||||
|
import GF.Source.SourceToGrammar (transExp)
|
||||||
|
import GF.Grammar.Grammar
|
||||||
|
import GF.Infra.Ident
|
||||||
|
import GF.Infra.Modules (greatestResource)
|
||||||
|
import GF.Compile.GetGrammar
|
||||||
|
import GF.Grammar.Macros
|
||||||
|
import GF.Grammar.PrGrammar
|
||||||
|
|
||||||
|
import GF.Compile.Rename (renameSourceTerm)
|
||||||
|
import GF.Compile.CheckGrammar (justCheckLTerm)
|
||||||
|
import GF.Compile.Compute (computeConcreteRec)
|
||||||
|
|
||||||
|
import GF.Data.Operations
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
|
||||||
|
type Grammar = SourceGrammar
|
||||||
|
|
||||||
|
emptyGrammar :: Grammar
|
||||||
|
emptyGrammar = emptySourceGrammar
|
||||||
|
|
||||||
|
pTerm :: String -> Err Term
|
||||||
|
pTerm s = do
|
||||||
|
e <- pExp $ myLexer (BS.pack s)
|
||||||
|
transExp e
|
||||||
|
|
||||||
|
prTerm :: Term -> String
|
||||||
|
prTerm = prt
|
||||||
|
|
||||||
|
checkTerm :: Grammar -> Term -> Err Term
|
||||||
|
checkTerm gr t = do
|
||||||
|
mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
|
||||||
|
checkTermAny gr mo t
|
||||||
|
|
||||||
|
checkTermAny :: Grammar -> Ident -> Term -> Err Term
|
||||||
|
checkTermAny gr m t = do
|
||||||
|
t1 <- renameSourceTerm gr m t
|
||||||
|
justCheckLTerm gr t1
|
||||||
|
|
||||||
|
computeTerm :: Grammar -> Term -> Err Term
|
||||||
|
computeTerm = computeConcreteRec
|
||||||
|
|
||||||
|
|
||||||
@@ -403,7 +403,7 @@ allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
|
|||||||
greatestResource :: MGrammar i a -> Maybe i
|
greatestResource :: MGrammar i a -> Maybe i
|
||||||
greatestResource gr = case allResources gr of
|
greatestResource gr = case allResources gr of
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
a -> return $ head a
|
a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
|
||||||
|
|
||||||
-- | all concretes for a given abstract
|
-- | all concretes for a given abstract
|
||||||
allConcretes :: Eq i => MGrammar i a -> i -> [i]
|
allConcretes :: Eq i => MGrammar i a -> i -> [i]
|
||||||
|
|||||||
@@ -5,7 +5,7 @@ import GF.Command.Importing
|
|||||||
import GF.Command.Commands
|
import GF.Command.Commands
|
||||||
import GF.GFCC.API
|
import GF.GFCC.API
|
||||||
|
|
||||||
import GF.Grammar.Grammar (SourceGrammar,emptySourceGrammar) -- for cc command
|
import GF.Grammar.API -- for cc command
|
||||||
|
|
||||||
import GF.Infra.UseIO
|
import GF.Infra.UseIO
|
||||||
import GF.Infra.Option ---- Haskell's option lib
|
import GF.Infra.Option ---- Haskell's option lib
|
||||||
@@ -21,22 +21,28 @@ mainGFI :: [String] -> IO ()
|
|||||||
mainGFI xx = do
|
mainGFI xx = do
|
||||||
putStrLn welcome
|
putStrLn welcome
|
||||||
env <- importInEnv emptyMultiGrammar xx
|
env <- importInEnv emptyMultiGrammar xx
|
||||||
loop (GFEnv emptySourceGrammar env [] 0)
|
loop (GFEnv emptyGrammar env [] 0)
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
loop :: GFEnv -> IO GFEnv
|
loop :: GFEnv -> IO GFEnv
|
||||||
loop gfenv0 = do
|
loop gfenv0 = do
|
||||||
let env = commandenv gfenv0
|
let env = commandenv gfenv0
|
||||||
|
let sgr = sourcegrammar gfenv0
|
||||||
s <- fetchCommand (prompt env)
|
s <- fetchCommand (prompt env)
|
||||||
let gfenv = gfenv0 {history = s : history gfenv0}
|
let gfenv = gfenv0 {history = s : history gfenv0}
|
||||||
case words s of
|
case words s of
|
||||||
|
|
||||||
-- special commands, requiring source grammar in env
|
-- special commands, requiring source grammar in env
|
||||||
|
"cc":ws -> do
|
||||||
|
let t = pTerm (unwords ws) >>= checkTerm sgr >>= computeTerm sgr
|
||||||
|
err putStrLn (putStrLn . prTerm) t ---- make pipable
|
||||||
|
loopNewCPU gfenv
|
||||||
|
|
||||||
"i":args -> do
|
"i":args -> do
|
||||||
let (opts,files) = getOptions "-" args
|
let (opts,files) = getOptions "-" args
|
||||||
case opts of
|
case opts of
|
||||||
_ | oElem (iOpt "retain") opts -> do
|
_ | oElem (iOpt "retain") opts -> do
|
||||||
src <- importSource (sourcegrammar gfenv) opts files
|
src <- importSource sgr opts files
|
||||||
loopNewCPU $ gfenv {sourcegrammar = src}
|
loopNewCPU $ gfenv {sourcegrammar = src}
|
||||||
|
|
||||||
-- other special commands, working on GFEnv
|
-- other special commands, working on GFEnv
|
||||||
@@ -89,7 +95,7 @@ prompt env = absname ++ "> " where
|
|||||||
n -> n
|
n -> n
|
||||||
|
|
||||||
data GFEnv = GFEnv {
|
data GFEnv = GFEnv {
|
||||||
sourcegrammar :: SourceGrammar, -- gfo grammar -retain
|
sourcegrammar :: Grammar, -- gfo grammar -retain
|
||||||
commandenv :: CommandEnv,
|
commandenv :: CommandEnv,
|
||||||
history :: [String],
|
history :: [String],
|
||||||
cputime :: Integer
|
cputime :: Integer
|
||||||
|
|||||||
Reference in New Issue
Block a user