Predef.error surfaces as error message in compilation and cc command

This commit is contained in:
aarne
2011-02-25 17:01:10 +00:00
parent 77b02544fb
commit 445a3aafeb
3 changed files with 15 additions and 4 deletions

View File

@@ -12,7 +12,7 @@
-- Computation of source terms. Used in compilation and in @cc@ command. -- Computation of source terms. Used in compilation and in @cc@ command.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Compile.Compute.Concrete (computeConcrete, computeTerm,computeConcreteRec) where module GF.Compile.Compute.Concrete (computeConcrete, computeTerm,computeConcreteRec,checkPredefError) where
import GF.Data.Operations import GF.Data.Operations
import GF.Grammar.Grammar import GF.Grammar.Grammar
@@ -20,6 +20,7 @@ import GF.Infra.Ident
import GF.Infra.Option import GF.Infra.Option
import GF.Infra.Modules import GF.Infra.Modules
import GF.Data.Str import GF.Data.Str
import GF.Grammar.ShowTerm
import GF.Grammar.Printer import GF.Grammar.Printer
import GF.Grammar.Predef import GF.Grammar.Predef
import GF.Grammar.Macros import GF.Grammar.Macros
@@ -466,3 +467,10 @@ getArgType t = case t of
V ty _ -> return ty V ty _ -> return ty
T (TComp ty) _ -> return ty T (TComp ty) _ -> return ty
_ -> Bad (render (text "cannot get argument type of table" $$ nest 2 (ppTerm Unqualified 0 t))) _ -> Bad (render (text "cannot get argument type of table" $$ nest 2 (ppTerm Unqualified 0 t)))
checkPredefError :: SourceGrammar -> Term -> Err Term
checkPredefError sgr t = case t of
App (Q (mod,f)) s | mod == cPredef && f == cError -> Bad $ showTerm sgr TermPrintOne Unqualified s
_ -> composOp (checkPredefError sgr) t

View File

@@ -112,7 +112,8 @@ partEval opts gr (context, val) trm = errIn (render (text "partial evaluation" <
trm3 <- if rightType trm2 trm3 <- if rightType trm2
then computeTerm gr subst trm2 then computeTerm gr subst trm2
else recordExpand val trm2 >>= computeTerm gr subst else recordExpand val trm2 >>= computeTerm gr subst
return $ mkAbs [(Explicit,v) | v <- vars] trm3 trm4 <- checkPredefError gr trm3
return $ mkAbs [(Explicit,v) | v <- vars] trm4
where where
-- don't eta expand records of right length (correct by type checking) -- don't eta expand records of right length (correct by type checking)
rightType (R rs) = case val of rightType (R rs) = case val of
@@ -199,3 +200,4 @@ replace old new trm =
R _ | trm == old -> new R _ | trm == old -> new
App x y -> App (replace old new x) (replace old new y) App x y -> App (replace old new x) (replace old new y)
_ -> composSafeOp (replace old new) trm _ -> composSafeOp (replace old new) trm

View File

@@ -12,7 +12,7 @@ import GF.Grammar hiding (Ident)
import GF.Grammar.Parser (runP, pExp) import GF.Grammar.Parser (runP, pExp)
import GF.Grammar.ShowTerm import GF.Grammar.ShowTerm
import GF.Compile.Rename import GF.Compile.Rename
import GF.Compile.Compute.Concrete (computeConcrete) import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
import GF.Compile.TypeCheck.Concrete (inferLType) import GF.Compile.TypeCheck.Concrete (inferLType)
import GF.Infra.Dependencies import GF.Infra.Dependencies
import GF.Infra.CheckM import GF.Infra.CheckM
@@ -124,7 +124,8 @@ loop opts gfenv0 = do
mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t ((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t
inferLType gr [] t inferLType gr [] t
computeConcrete sgr t t1 <- computeConcrete sgr t
checkPredefError sgr t1
case runP pExp (encodeUnicode utf8 s) of case runP pExp (encodeUnicode utf8 s) of
Left (_,msg) -> putStrLn msg Left (_,msg) -> putStrLn msg