diff options
| author | aarne <aarne@cs.chalmers.se> | 2005-12-05 18:31:15 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2005-12-05 18:31:15 +0000 |
| commit | 9db6f69d0a286b8d8234f64cc4918db5daa19644 (patch) | |
| tree | 48184980cc4997232fd7b7671cd595f2cd78b4d6 | |
| parent | 6c9b2bf6dff11d0eb2bcfd4f89f21649b48672fa (diff) | |
multimodal resource recreated for new API
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 14d4f9b93..fc77bb6fa 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -569,7 +569,8 @@ checkLType env trm typ0 = do trm' <- comp trm case trm' of RecType _ -> termWith trm $ return typeType - ExtR (Vr _) (RecType _) -> termWith trm $ return typeType -- ext t = t ** ... + ExtR (Vr _) (RecType _) -> termWith trm $ return typeType + -- ext t = t ** ... _ -> prtFail "invalid record type extension" trm RecType rr -> do (r',ty,s') <- checks [ @@ -585,7 +586,14 @@ checkLType env trm typ0 = do r2 <- justCheck r' rr0 s2 <- justCheck s' rr2 return $ (ExtR r2 s2, typ) - _ -> raise ("record type expected in extension of" +++ prt r +++ "but found" +++ prt ty) + _ -> raise ("record type expected in extension of" +++ prt r +++ + "but found" +++ prt ty) + + ExtR ty ex -> do + r' <- justCheck r ty + s' <- justCheck s ex + return $ (ExtR r' s', typ) --- is this all? + _ -> prtFail "record extension not meaningful for" typ FV vs -> do |