diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 6 | ||||
| -rw-r--r-- | src/GF/Grammar/Lookup.hs | 12 |
2 files changed, 11 insertions, 7 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index d01d2b097..0359c0679 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -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 diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs index 630b9c204..337329d44 100644 --- a/src/GF/Grammar/Lookup.hs +++ b/src/GF/Grammar/Lookup.hs @@ -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 |