mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
Predef.error surfaces as error message in compilation and cc command
This commit is contained in:
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user