merge GF.Grammar.API into GF.Grammar

src/GF/Compile/AbsCompute.hs

@@ -36,10 +36,10 @@ import Text.PrettyPrint
 tracd m t = t 
 -- tracd = trace
 
-compute :: Grammar -> Exp -> Err Exp
+compute :: SourceGrammar -> Exp -> Err Exp
 compute = computeAbsTerm
 
-computeAbsTerm :: Grammar -> Exp -> Err Exp
+computeAbsTerm :: SourceGrammar -> Exp -> Err Exp
 computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
 
 -- | a hack to make compute work on source grammar as well

src/GF/Compile/TypeCheck.hs

@@ -49,7 +49,7 @@ cont2val = type2val . cont2exp
 
 -- some top-level batch-mode checkers for the compiler
 
-justTypeCheck :: Grammar -> Exp -> Val -> Err Constraints
+justTypeCheck :: SourceGrammar -> Exp -> Val -> Err Constraints
 justTypeCheck gr e v = do
   (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v
   (constrs1,_) <- unifyVal constrs0
@@ -59,25 +59,25 @@ notJustMeta (c,k) = case (c,k) of
     (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False
     _ -> True
 
-grammar2theory :: Grammar -> Theory
+grammar2theory :: SourceGrammar -> Theory
 grammar2theory gr (m,f) = case lookupFunType gr m f of
   Ok t -> return $ type2val t
   Bad s -> case lookupCatContext gr m f of
     Ok cont -> return $ cont2val cont
     _ -> Bad s
 
-checkContext :: Grammar -> Context -> [Message]
+checkContext :: SourceGrammar -> Context -> [Message]
 checkContext st = checkTyp st . cont2exp
 
-checkTyp :: Grammar -> Type -> [Message]
+checkTyp :: SourceGrammar -> Type -> [Message]
 checkTyp gr typ = err (\x -> [text x]) ppConstrs $ justTypeCheck gr typ vType
 
-checkDef :: Grammar -> Fun -> Type -> [Equation] -> [Message]
+checkDef :: SourceGrammar -> Fun -> Type -> [Equation] -> [Message]
 checkDef gr (m,fun) typ eqs = err (\x -> [text x]) ppConstrs $ do
   bcs <- mapM (\b -> checkBranch (grammar2theory gr) (initTCEnv []) b (type2val typ)) eqs
   let (bs,css) = unzip bcs
   (constrs,_) <- unifyVal (concat css)
   return $ filter notJustMeta constrs
 
-checkConstrs :: Grammar -> Cat -> [Ident] -> [String]
+checkConstrs :: SourceGrammar -> Cat -> [Ident] -> [String]
 checkConstrs gr cat _ = [] ---- check constructors!

src/GF/Grammar.hs

@@ -12,27 +12,18 @@
 -- (Description of the module)
 -----------------------------------------------------------------------------
 
-module GF.Grammar (
-
-module GF.Infra.Ident,
-module GF.Grammar.Grammar,
-module GF.Grammar.Values,
-module GF.Grammar.Macros,
-module GF.Grammar.MMacros,
-module GF.Grammar.Printer,
-
-Grammar
-
- ) where
+module GF.Grammar 
+           ( module GF.Infra.Ident,
+             module GF.Grammar.Grammar,
+             module GF.Grammar.Values,
+             module GF.Grammar.Macros,
+             module GF.Grammar.MMacros,
+             module GF.Grammar.Printer
+           ) where
 
+import GF.Infra.Ident
 import GF.Grammar.Grammar
 import GF.Grammar.Values
 import GF.Grammar.Macros
-import GF.Infra.Ident
 import GF.Grammar.MMacros
 import GF.Grammar.Printer
-
-type Grammar = SourceGrammar ---
-
-
-

src/GF/Grammar/API.hs

@@ -1,58 +0,0 @@
-module GF.Grammar.API (
-  Grammar,
-  emptyGrammar,
-  checkTerm,
-  computeTerm,
-  showTerm,
-  TermPrintStyle(..), TermPrintQual(..),
-  ) where
-
-import GF.Infra.Ident
-import GF.Infra.CheckM
-import GF.Infra.Modules (greatestResource)
-import GF.Compile.GetGrammar
-import GF.Grammar.Macros
-import GF.Grammar.Parser
-import GF.Grammar.Printer
-import GF.Grammar.Grammar
-
-import GF.Compile.Rename (renameSourceTerm)
-import GF.Compile.CheckGrammar (inferLType)
-import GF.Compile.Compute (computeConcrete)
-
-import GF.Data.Operations
-import GF.Infra.Option
-
-import qualified Data.ByteString.Char8 as BS
-import Text.PrettyPrint
-
-type Grammar = SourceGrammar
-
-emptyGrammar :: Grammar
-emptyGrammar = emptySourceGrammar
-
-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 = (fmap fst . runCheck) $ do
-  t <- renameSourceTerm gr m t
-  (t,_) <- inferLType gr [] t
-  return t
-
-computeTerm :: Grammar -> Term -> Err Term
-computeTerm = computeConcrete
-
-showTerm :: TermPrintStyle -> TermPrintQual -> Term -> String
-showTerm style q t = render $
-  case style of
-    TermPrintTable   -> vcat [p <+> s | (p,s) <- ppTermTabular q t]
-    TermPrintAll     -> vcat [      s | (p,s) <- ppTermTabular q t]
-    TermPrintDefault -> ppTerm q 0 t
-
-data TermPrintStyle
-  = TermPrintTable
-  | TermPrintAll
-  | TermPrintDefault

src/GF/Grammar/Printer.hs

@@ -18,6 +18,8 @@ module GF.Grammar.Printer
            , ppPatt
            , ppValue
            , ppConstrs
+           
+           , showTerm, TermPrintStyle(..)
            ) where
 
 import GF.Infra.Ident
@@ -301,3 +303,15 @@ getLet :: Term -> ([LocalDef], Term)
 getLet (Let l e) = let (ls,e') = getLet e
                    in (l:ls,e')
 getLet e         = ([],e)
+
+showTerm :: TermPrintStyle -> TermPrintQual -> Term -> String
+showTerm style q t = render $
+  case style of
+    TermPrintTable   -> vcat [p <+> s | (p,s) <- ppTermTabular q t]
+    TermPrintAll     -> vcat [      s | (p,s) <- ppTermTabular q t]
+    TermPrintDefault -> ppTerm q 0 t
+
+data TermPrintStyle
+  = TermPrintTable
+  | TermPrintAll
+  | TermPrintDefault

src/GFI.hs

@@ -7,12 +7,16 @@ import GF.Command.Commands
 import GF.Command.Abstract
 import GF.Command.Parse
 import GF.Data.ErrM
-import GF.Grammar.API
-import GF.Grammar.Lexer
-import GF.Grammar.Parser
+import GF.Grammar hiding (Ident)
+import GF.Grammar.Parser (runP, pExp)
+import GF.Compile.Rename
+import GF.Compile.CheckGrammar
+import GF.Compile.Compute (computeConcrete)
 import GF.Infra.Dependencies
+import GF.Infra.CheckM
 import GF.Infra.UseIO
 import GF.Infra.Option
+import GF.Infra.Modules (greatestResource)
 import GF.System.Readline
 
 import GF.Text.Coding
@@ -107,9 +111,16 @@ loop opts gfenv0 = do
                pOpts style q             ws  = (style,q,unwords ws)
                
                (style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0))
+
+               checkComputeTerm gr t = do
+                 mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
+                 ((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t
+                                            inferLType gr [] t
+                 computeConcrete sgr t
+
              case runP pExp (BS.pack s) of
                Left (_,msg) -> putStrLn msg
-               Right t      -> case checkTerm sgr (codeTerm (decode gfenv) t) >>= computeTerm sgr of
+               Right t      -> case checkComputeTerm sgr (codeTerm (decode gfenv) t) of
                                  Ok  x -> putStrLn $ enc (showTerm style q x)
                                  Bad s -> putStrLn $ enc s
              loopNewCPU gfenv
@@ -128,7 +139,7 @@ loop opts gfenv0 = do
 
   -- other special commands, working on GFEnv
           "e":_ -> loopNewCPU $ gfenv {
-             commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar
+             commandenv=emptyCommandEnv, sourcegrammar = emptySourceGrammar
              }
 
           "dc":f:ws -> do
@@ -220,7 +231,7 @@ prompt env
     abs = abstractName (multigrammar env)
 
 data GFEnv = GFEnv {
-  sourcegrammar :: Grammar, -- gfo grammar -retain
+  sourcegrammar :: SourceGrammar, -- gfo grammar -retain
   commandenv :: CommandEnv,
   history    :: [String],
   cputime    :: Integer,
@@ -235,7 +246,7 @@ emptyGFEnv = do
 #else
   let coding = UTF_8
 #endif
-  return $ GFEnv emptyGrammar (mkCommandEnv coding emptyPGF) [] 0 coding
+  return $ GFEnv emptySourceGrammar (mkCommandEnv coding emptyPGF) [] 0 coding
 
 encode = encodeUnicode . coding 
 decode = decodeUnicode . coding