mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
restored lock fields with a clearer warning
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user