diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs | 9 |
1 files changed, 7 insertions, 2 deletions
diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs index badf8bd30..580029e3e 100644 --- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs +++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs @@ -63,7 +63,7 @@ tcRho ge scope t@(Q id) mb_ty = runTcA (tcOverloadFailed t) $ tcApp ge scope t `bindTcA` \(t,ty) -> instSigma ge scope t ty mb_ty -tcRho ge scope t@(QC id) mb_ty = +tcRho ge scope t@(QC id) mb_ty = runTcA (tcOverloadFailed t) $ tcApp ge scope t `bindTcA` \(t,ty) -> instSigma ge scope t ty mb_ty @@ -476,7 +476,12 @@ subsCheckRho ge scope t ty1@(VRecType rs1) ty2@(VRecType rs2) = do -- Rule return (l, (mb_ty,t)) (scope,mkProj,mkWrap) <- mkAccess scope t - rs <- sequence [mkField scope l t ty1 ty2 | (l,ty2) <- rs2, Just ty1 <- [lookup l rs1], Just t <- [mkProj l]] + + let fields = [(l,ty2,lookup l rs1) | (l,ty2) <- rs2] + case [l | (l,_,Nothing) <- fields] of + [] -> return () + missing -> tcError ("Missing fields:" <+> hsep missing) + rs <- sequence [mkField scope l t ty1 ty2 | (l,ty2,Just ty1) <- fields, Just t <- [mkProj l]] return (mkWrap (R rs)) subsCheckRho ge scope t tau1 tau2 = do -- Rule EQ unify ge scope tau1 tau2 -- Revert to ordinary unification |