mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
Move checkPredefError from GF.Compile.Compute.ConcreteLazy to GF.Grammar.Macros
Also simplified its type.
This commit is contained in:
@@ -519,12 +519,6 @@ getArgType t = case t of
|
|||||||
V ty _ -> return ty
|
V ty _ -> return ty
|
||||||
T (TComp ty) _ -> return ty
|
T (TComp ty) _ -> return ty
|
||||||
_ -> fail (render (text "cannot get argument type of table" $$ nest 2 (ppTerm Unqualified 0 t)))
|
_ -> fail (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
|
|
||||||
Error s -> fail ("Error: "++s)
|
|
||||||
_ -> return t
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
-- Old
|
-- Old
|
||||||
|
|||||||
@@ -119,7 +119,7 @@ partEval opts = if flag optNewComp opts
|
|||||||
|
|
||||||
partEvalNew opts gr (context, val) trm =
|
partEvalNew opts gr (context, val) trm =
|
||||||
errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $
|
errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $
|
||||||
checkPredefError gr trm
|
checkPredefError trm
|
||||||
|
|
||||||
partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $ do
|
partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation" <+> ppTerm Qualified 0 trm)) $ do
|
||||||
let vars = map (\(bt,x,t) -> x) context
|
let vars = map (\(bt,x,t) -> x) context
|
||||||
@@ -130,7 +130,7 @@ partEvalOld opts gr (context, val) trm = errIn (render (text "partial evaluation
|
|||||||
trm3 <- if rightType trm2
|
trm3 <- if rightType trm2
|
||||||
then computeTerm gr subst trm2 -- compute twice??
|
then computeTerm gr subst trm2 -- compute twice??
|
||||||
else recordExpand val trm2 >>= computeTerm gr subst
|
else recordExpand val trm2 >>= computeTerm gr subst
|
||||||
trm4 <- checkPredefError gr trm3
|
trm4 <- checkPredefError trm3
|
||||||
return $ mkAbs [(Explicit,v) | v <- vars] trm4
|
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)
|
||||||
|
|||||||
@@ -225,6 +225,12 @@ isPredefConstant t = case t of
|
|||||||
Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
|
Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
|
checkPredefError :: Monad m => Term -> m Term
|
||||||
|
checkPredefError t =
|
||||||
|
case t of
|
||||||
|
Error s -> fail ("Error: "++s)
|
||||||
|
_ -> return t
|
||||||
|
|
||||||
cnPredef :: Ident -> Term
|
cnPredef :: Ident -> Term
|
||||||
cnPredef f = Q (cPredef,f)
|
cnPredef f = Q (cPredef,f)
|
||||||
|
|
||||||
|
|||||||
@@ -332,7 +332,7 @@ checkComputeTerm' new sgr t = do
|
|||||||
t1 <- if new
|
t1 <- if new
|
||||||
then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
|
then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
|
||||||
else computeConcrete sgr t
|
else computeConcrete sgr t
|
||||||
checkPredefError sgr t1
|
checkPredefError t1
|
||||||
|
|
||||||
fetchCommand :: GFEnv -> IO String
|
fetchCommand :: GFEnv -> IO String
|
||||||
fetchCommand gfenv = do
|
fetchCommand gfenv = do
|
||||||
|
|||||||
Reference in New Issue
Block a user