merge GF.Grammar.API into GF.Grammar

This commit is contained in:
krasimir
2009-10-02 23:34:35 +00:00
parent d64419f2f2
commit 4c77dcf938
6 changed files with 49 additions and 91 deletions

View File

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

View File

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

View File

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

View File

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

View File

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