GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-20 00:22:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

multimodal resource recreated for new API

Browse Source
This commit is contained in:
aarne
2005-12-05 18:31:15 +00:00
parent 6c9b2bf6df
commit 9db6f69d0a
1 changed files with 10 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/GF/Compile/CheckGrammar.hs
View File

@@ -569,7 +569,8 @@ checkLType env trm typ0 = do
trm' <- comp trm trm' <- comp trm
case trm' of case trm' of
RecType _ -> termWith trm $ return typeType 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 _ -> prtFail "invalid record type extension" trm
RecType rr -> do RecType rr -> do
(r',ty,s') <- checks [ (r',ty,s') <- checks [
@@ -585,7 +586,14 @@ checkLType env trm typ0 = do
r2 <- justCheck r' rr0 r2 <- justCheck r' rr0
s2 <- justCheck s' rr2 s2 <- justCheck s' rr2
return $ (ExtR r2 s2, typ) 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 _ -> prtFail "record extension not meaningful for" typ
FV vs -> do FV vs -> do