msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

bug fix in with-modules and gr checker; factoring out cats to Common

Browse Source
This commit is contained in:
aarne
2006-05-23 22:20:00 +00:00
parent 00e7c3225e
commit 750ef2ca30
4 changed files with 7 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -346,7 +346,7 @@ inferLType gr trm = case trm of
Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident) Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
Q m ident -> checks [ Q m ident -> checks [
termWith trm $ checkErr (lookupResType gr m ident) termWith trm $ checkErr (lookupResType gr m ident) >>= comp
, ,
checkErr (lookupResDef gr m ident) >>= infer checkErr (lookupResDef gr m ident) >>= infer
, ,
@@ -356,7 +356,7 @@ inferLType gr trm = case trm of
QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident) QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
QC m ident -> checks [ QC m ident -> checks [
termWith trm $ checkErr (lookupResType gr m ident) termWith trm $ checkErr (lookupResType gr m ident) >>= comp
, ,
checkErr (lookupResDef gr m ident) >>= infer checkErr (lookupResDef gr m ident) >>= infer
, ,
@@ -825,7 +825,7 @@ checkEqLType env t u trm = do
not (any (\ (k,b) -> alpha g a b && l == k) ts)] not (any (\ (k,b) -> alpha g a b && l == k) ts)]
(locks,others) = partition isLockLabel ls (locks,others) = partition isLockLabel ls
in case others of in case others of
_:_ -> Bad $ "missing record fieds" +++ unwords (map prt others) _:_ -> Bad $ "missing record fields" +++ unwords (map prt others)
_ -> return locks _ -> return locks
_ -> Bad "" _ -> Bad ""

4
src/GF/Compile/Rebuild.hs
View File

@@ -72,8 +72,8 @@ rebuildModule ms mo@(i,mi) = do
++ [oQualif i i | i <- map snd insts] ---- ++ [oQualif i i | i <- map snd insts] ----
++ [oSimple i | i <- map snd insts] ---- ++ [oSimple i | i <- map snd insts] ----
---- ++ [oSimple ext] ---- to encode dependence ---- ++ [oSimple ext] ---- to encode dependence
--- check if me is incomplete; --- why inherit all forced by syntax --- check if me is incomplete
return $ ModMod $ Module mt0 stat' fs (map inheritAll me) ops1 js return $ ModMod $ Module mt0 stat' fs me ops1 js
---- (mapTree (qualifInstanceInfo insts) js) -- not needed ---- (mapTree (qualifInstanceInfo insts) js) -- not needed
_ -> return mi _ -> return mi

2
src/GF/Infra/Modules.hs
View File

@@ -58,7 +58,7 @@ data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
data ModInfo i f a = data ModInfo i f a =
ModMainGrammar (MainGrammar i) ModMainGrammar (MainGrammar i)
| ModMod (Module i f a) | ModMod (Module i f a)
| ModWith (ModuleType i) ModuleStatus i [i] [OpenSpec i] | ModWith (ModuleType i) ModuleStatus i [(i,MInclude i)] [OpenSpec i]
deriving Show deriving Show
data Module i f a = Module { data Module i f a = Module {

2
src/GF/Source/SourceToGrammar.hs
View File

@@ -112,7 +112,7 @@ transModDef x = case x of
opens' <- mapM transOpen opens opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' [] opens') return (id', GM.ModWith mtyp' mstat' m' [] opens')
MWithE extends m opens -> do MWithE extends m opens -> do
extends' <- liftM (map fst) $ mapM transIncludedExt extends extends' <- mapM transIncludedExt extends
m' <- transIdent m m' <- transIdent m
opens' <- mapM transOpen opens opens' <- mapM transOpen opens
return (id', GM.ModWith mtyp' mstat' m' extends' opens') return (id', GM.ModWith mtyp' mstat' m' extends' opens')