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

More woek on interfaces

Browse Source
This commit is contained in:
aarne
2003-10-24 18:19:47 +00:00
parent e620ffbd94
commit 8cce874f8b
8 changed files with 161 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -54,7 +54,7 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
MTInstance a -> do
ModMod abs <- checkErr $ lookupModule gr a
checkCompleteInstance abs mo
-- checkCompleteInstance abs mo -- this is done in Rebuild
mapMTree (checkResInfo gr) js
return $ (name, ModMod (Module mt st fs me ops js')) : ms
@@ -91,18 +91,6 @@ checkCompleteGrammar abs cnc = mapM_ checkWarn $
then id
else (("Warning: no linearization of" +++ prt f):)
checkCompleteInstance :: SourceRes -> SourceRes -> Check ()
checkCompleteInstance abs cnc = mapM_ checkWarn $
checkComplete [f | (f, ResOper (Yes _) _) <- abs'] cnc'
where
abs' = tree2list $ jments abs
cnc' = mapTree fst $ jments cnc
checkComplete sought given = foldr ckOne [] sought
where
ckOne f = if isInBinTree f given
then id
else (("Warning: no definition given to" +++ prt f):)
-- General Principle: only Yes-values are checked.
-- A May-value has always been checked in its origin module.
@@ -623,14 +611,14 @@ checkEqLType env t u trm = do
(Prod x a b, Prod y c d) -> alpha g a c && alpha ((x,y):g) b d
---- this should be made in Rename
(Q m a, Q n b) | a == b -> elem m (allExtends env n)
|| elem n (allExtends env m)
(QC m a, QC n b) | a == b -> elem m (allExtends env n)
|| elem n (allExtends env m)
(QC m a, Q n b) | a == b -> elem m (allExtends env n)
|| elem n (allExtends env m)
(Q m a, QC n b) | a == b -> elem m (allExtends env n)
|| elem n (allExtends env m)
(Q m a, Q n b) | a == b -> elem m (allExtendsPlus env n)
|| elem n (allExtendsPlus env m)
(QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n)
|| elem n (allExtendsPlus env m)
(QC m a, Q n b) | a == b -> elem m (allExtendsPlus env n)
|| elem n (allExtendsPlus env m)
(Q m a, QC n b) | a == b -> elem m (allExtendsPlus env n)
|| elem n (allExtendsPlus env m)
(RecType rs, RecType ts) -> and [alpha g a b && l == k --- too strong req
| ((l,a),(k,b)) <- zip rs ts]