mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
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 gr = case allResources gr of
|
||||
[] -> 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
|
||||
allConcretes :: Eq i => MGrammar i a -> i -> [i]
|
||||
|
||||
@@ -5,7 +5,7 @@ import GF.Command.Importing
|
||||
import GF.Command.Commands
|
||||
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.Option ---- Haskell's option lib
|
||||
@@ -21,22 +21,28 @@ mainGFI :: [String] -> IO ()
|
||||
mainGFI xx = do
|
||||
putStrLn welcome
|
||||
env <- importInEnv emptyMultiGrammar xx
|
||||
loop (GFEnv emptySourceGrammar env [] 0)
|
||||
loop (GFEnv emptyGrammar env [] 0)
|
||||
return ()
|
||||
|
||||
loop :: GFEnv -> IO GFEnv
|
||||
loop gfenv0 = do
|
||||
let env = commandenv gfenv0
|
||||
let sgr = sourcegrammar gfenv0
|
||||
s <- fetchCommand (prompt env)
|
||||
let gfenv = gfenv0 {history = s : history gfenv0}
|
||||
case words s of
|
||||
|
||||
-- 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
|
||||
let (opts,files) = getOptions "-" args
|
||||
case opts of
|
||||
_ | oElem (iOpt "retain") opts -> do
|
||||
src <- importSource (sourcegrammar gfenv) opts files
|
||||
src <- importSource sgr opts files
|
||||
loopNewCPU $ gfenv {sourcegrammar = src}
|
||||
|
||||
-- other special commands, working on GFEnv
|
||||
@@ -89,7 +95,7 @@ prompt env = absname ++ "> " where
|
||||
n -> n
|
||||
|
||||
data GFEnv = GFEnv {
|
||||
sourcegrammar :: SourceGrammar, -- gfo grammar -retain
|
||||
sourcegrammar :: Grammar, -- gfo grammar -retain
|
||||
commandenv :: CommandEnv,
|
||||
history :: [String],
|
||||
cputime :: Integer
|
||||
|
||||
Reference in New Issue
Block a user