From 6d0adbb2cbf82a057f093df8ea3371e84813c098 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Sat, 24 May 2008 16:13:27 +0000
Subject: [PATCH] started source grammar API ; used it for a first implem. of
 cc command

---
 src-3.0/GF/Grammar/API.hs   | 52 +++++++++++++++++++++++++++++++++++++
 src-3.0/GF/Infra/Modules.hs |  2 +-
 src-3.0/GFI.hs              | 14 +++++++---
 3 files changed, 63 insertions(+), 5 deletions(-)
 create mode 100644 src-3.0/GF/Grammar/API.hs

diff --git a/src-3.0/GF/Grammar/API.hs b/src-3.0/GF/Grammar/API.hs
new file mode 100644
index 000000000..be8094228
--- /dev/null
+++ b/src-3.0/GF/Grammar/API.hs
@@ -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
+
+
diff --git a/src-3.0/GF/Infra/Modules.hs b/src-3.0/GF/Infra/Modules.hs
index fe44a5fe4..971d52054 100644
--- a/src-3.0/GF/Infra/Modules.hs
+++ b/src-3.0/GF/Infra/Modules.hs
@@ -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]
diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs
index ceb7fa6f9..ae2c2440d 100644
--- a/src-3.0/GFI.hs
+++ b/src-3.0/GFI.hs
@@ -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