1
0
forked from GitHub/gf-core

started source grammar API ; used it for a first implem. of cc command

This commit is contained in:
aarne
2008-05-24 16:13:27 +00:00
parent f1fd6260e0
commit 6d0adbb2cb
3 changed files with 63 additions and 5 deletions

52
src-3.0/GF/Grammar/API.hs Normal file
View 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

View File

@@ -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]

View File

@@ -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