1
0
forked from GitHub/gf-core

restored lock fields with a clearer warning

This commit is contained in:
aarne
2006-06-18 19:23:00 +00:00
parent 4204b3e4eb
commit d1dc04747b
2 changed files with 11 additions and 7 deletions

View File

@@ -771,12 +771,12 @@ checkEqLType env t u trm = do
case t' == u' || alpha [] t' u' of
True -> return t'
-- forgive missing lock fields by only generating a warning.
--- better: use a flag to forgive (AR 31/1/2006)
--- better: use a flag to forgive? (AR 31/1/2006)
_ -> case missingLock [] t' u' of
Ok lo -> do
checkWarn $ "missing lock field" +++ unwords (map prt lo)
checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo)
return t'
Bad s -> raise (s ++ "type of" +++ prt trm +++
Bad s -> raise (s +++ "type of" +++ prt trm +++
": expected" ++++ prt t' ++++ "inferred" ++++ prt u')
where

View File

@@ -33,6 +33,10 @@ import GF.Grammar.Lockfield
import Data.List (nub)
import Control.Monad
-- whether lock fields are added in reuse
lock c = lockRecType c -- return
unlock c = unlockRecord c -- return
lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term
lookupResDef gr m c = look True m c where
look isTop m c = do
@@ -45,9 +49,9 @@ lookupResDef gr m c = look True m c where
ResOper _ Nope -> return (Q m c) ---- if isTop then lookExt m c
---- else prtBad "cannot find in exts" c
CncCat (Yes ty) _ _ -> return ty ---- lockRecType c $ ty
CncCat _ _ _ -> return defLinType ---- lockRecType c $ defLinType
CncFun _ (Yes tr) _ -> return tr ---- unlockRecord c tr
CncCat (Yes ty) _ _ -> lock c ty
CncCat _ _ _ -> lock c defLinType
CncFun _ (Yes tr) _ -> unlock c tr
AnyInd _ n -> look False n c
ResParam _ -> return $ QC m c
@@ -70,7 +74,7 @@ lookupResType gr m c = do
-- used in reused concrete
CncCat _ _ _ -> return typeType
CncFun (Just (cat,(cont,val))) _ _ -> do
val' <- return val ---- lockRecType cat val
val' <- lock cat val
return $ mkProd (cont, val', [])
CncFun _ _ _ -> lookFunType m m c
AnyInd _ n -> lookupResType gr n c