diff options
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 6 | ||||
| -rw-r--r-- | src/GF/Compile/GrammarToCanon.hs | 3 |
2 files changed, 7 insertions, 2 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 0359c0679..0ef79123e 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -288,6 +288,7 @@ computeLType gr t = do App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed Q (IC "Predef") (IC "Int") -> return ty ---- shouldn't be needed Q (IC "Predef") (IC "Float") -> return ty ---- shouldn't be needed + Q (IC "Predef") (IC "Error") -> return ty ---- shouldn't be needed Q m c | elem c [cPredef,cPredefAbs] -> return ty Q m c | elem c [zIdent "Int"] -> @@ -777,13 +778,16 @@ checkEqLType env t u trm = do checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo) return t' Bad s -> raise (s +++ "type of" +++ prt trm +++ - ": expected" ++++ prt t' ++++ "inferred" ++++ prt u') + ": expected" ++++ prt t' ++++ "inferred" ++++ prt u' ++++ show u') where -- t is a subtype of u --- quick hack version of TC.eqVal alpha g t u = case (t,u) of + -- error (the empty type!) is subtype of any other type + (_,Q (IC "Predef") (IC "Error")) -> True + -- contravariance (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs index de6427e82..8ca328032 100644 --- a/src/GF/Compile/GrammarToCanon.hs +++ b/src/GF/Compile/GrammarToCanon.hs @@ -194,11 +194,12 @@ redCTerm t = case t of Vr x -> checkAgain (liftM G.Arg $ redArgvar x) (liftM G.LI $ redIdent x) --- for parametrize optimization - App _ _ -> do -- only constructor applications can remain + App _ s -> do -- only constructor applications can remain (_,c,xx) <- termForm t xx' <- mapM redCTerm xx case c of QC p c -> liftM2 G.Par (redQIdent (p,c)) (return xx') + Q (IC "Predef") (IC "error") -> fail $ "error: " ++ stringFromTerm s _ -> prtBad "expected constructor head instead of" c Q p c -> liftM G.I (redQIdent (p,c)) QC p c -> liftM2 G.Par (redQIdent (p,c)) (return []) |