summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2013-11-29 14:43:01 +0000
committerhallgren <hallgren@chalmers.se>2013-11-29 14:43:01 +0000
commit0a59f95d92223bae842323d582ec5d2eb3156a8d (patch)
tree9cb305da42da037dbbdbd467a2e39cbb790e63cc
parent1067d5960964995e92209354aecb4c4ed82e9b86 (diff)
Move checkPredefError from GF.Compile.Compute.ConcreteLazy to GF.Grammar.Macros
Also simplified its type.
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteLazy.hs6
-rw-r--r--src/compiler/GF/Compile/Optimize.hs4
-rw-r--r--src/compiler/GF/Grammar/Macros.hs6
-rw-r--r--src/compiler/GFI.hs2
4 files changed, 9 insertions, 9 deletions
diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
index cef4c398c..67d21768b 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
@@ -519,12 +519,6 @@ getArgType t = case t of
V ty _ -> return ty
T (TComp ty) _ -> return ty
_ -> 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
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index e5289fe7b..bd75cbc2c 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -119,7 +119,7 @@ partEval opts = if flag optNewComp opts
partEvalNew opts gr (context, val) 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
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
then computeTerm gr subst trm2 -- compute twice??
else recordExpand val trm2 >>= computeTerm gr subst
- trm4 <- checkPredefError gr trm3
+ trm4 <- checkPredefError trm3
return $ mkAbs [(Explicit,v) | v <- vars] trm4
where
-- don't eta expand records of right length (correct by type checking)
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index 6798b22d0..e516f0e47 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -225,6 +225,12 @@ isPredefConstant t = case t of
Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
_ -> False
+checkPredefError :: Monad m => Term -> m Term
+checkPredefError t =
+ case t of
+ Error s -> fail ("Error: "++s)
+ _ -> return t
+
cnPredef :: Ident -> Term
cnPredef f = Q (cPredef,f)
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index 8fdc97ecc..070a95384 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -332,7 +332,7 @@ checkComputeTerm' new sgr t = do
t1 <- if new
then return (CN.normalForm (CN.resourceValues sgr) (L NoLoc identW) t)
else computeConcrete sgr t
- checkPredefError sgr t1
+ checkPredefError t1
fetchCommand :: GFEnv -> IO String
fetchCommand gfenv = do