more helpful error when lin X is missing

This commit is contained in:
Krasimir Angelov
2025-11-14 12:05:11 +01:00
parent 08bd669200
commit 6c9a197b37
4 changed files with 18 additions and 8 deletions
+2 -1
View File
@@ -31,6 +31,7 @@ import qualified GF.Grammar.Macros as C
import GF.Data.ErrM(fromErr)
import Control.Monad.State.Strict(State,evalState,get,put)
import Data.Maybe(isJust)
import Data.Map (Map)
import qualified Data.Map as Map
@@ -136,6 +137,6 @@ operIdent :: Int -> Ident
operIdent i = identC (operPrefix `prefixRawIdent` (rawIdentS (show i))) ---
isOperIdent :: Ident -> Bool
isOperIdent id = isPrefixOf operPrefix (ident2raw id)
isOperIdent id = isJust (isPrefixOf operPrefix (ident2raw id))
operPrefix = rawIdentS ("A''")
@@ -6,6 +6,7 @@ module GF.Compile.TypeCheck.Concrete ( checkLType, checkLType', inferLType, infe
-- Practical type inference for arbitrary-rank types.
-- 14 September 2011
import Prelude hiding ((<>))
import GF.Grammar hiding (Env, VGen, VApp, VRecType, ppValue)
import GF.Grammar.Lookup
import GF.Grammar.Predef
@@ -1083,15 +1084,21 @@ subsCheckRho scope t ty1@(VRecType rs1 ext1) ty2@(VRecType rs2 ext2) = do -
mkField scope l (mb_ty,t) (Just ty1) ty2 = do
(t,ty1,ty2) <- subsCheckRho scope t ty1 ty2
return ((l, (mb_ty,t)), (l, True, ty1))
mkField scope l (mb_ty,t) Nothing ty2
| isLockLabel l = return ((l, (Just (RecType []),R [])), (l, True, ty2))
| otherwise = return ((l, (mb_ty,t)), (l, True, ty2))
mkField scope l (mb_ty,t) Nothing ty2 =
case isLockLabel l of
Just _ -> return ((l, (Just (RecType []),R [])), (l, True, ty2))
Nothing -> return ((l, (mb_ty,t)), (l, True, ty2))
(scope,mkProj,wrap) <- mkAccess scope t
let fields = [(l,o2,ty2,lookup3 l rs1) | (l,o2,ty2) <- rs2]
case [l | (l,_,_,Nothing) <- fields, not ext1] of
[] -> return ()
[field] -> evalError ("In the term" <+> pp t $$
"there is no value for field" <+> field <>
case isLockLabel field of
Just cat -> ", try wrapping with lin"<+>pp cat
Nothing -> empty)
missing -> evalError ("In the term" <+> pp t $$
"there are no values for fields:" <+> hsep missing)
rs <- sequence [mkField scope l t mb_ty1 ty2 | (l,_,ty2,mb_ty1) <- fields, Just t <- [mkProj l]]
+2 -2
View File
@@ -40,9 +40,9 @@ lock c t = t
lockLabel :: Ident -> Label
lockLabel c = LIdent $! prefixRawIdent lockPrefix (ident2raw c)
isLockLabel :: Label -> Bool
isLockLabel :: Label -> Maybe RawIdent
isLockLabel l = case l of
LIdent c -> isPrefixOf lockPrefix c
_ -> False
_ -> Nothing
lockPrefix = rawIdentS "lock_"
+4 -2
View File
@@ -26,7 +26,7 @@ module GF.Infra.Ident (-- ** Identifiers
) where
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
import qualified Data.ByteString.Char8 as BS(append,isPrefixOf,drop,length)
-- Limit use of BS functions to the ones that work correctly on
-- UTF-8-encoded bytestrings!
import Data.Char(isDigit)
@@ -75,7 +75,9 @@ rawIdentC = Id
showRawIdent = unpack . rawId2utf8
prefixRawIdent (Id x) (Id y) = Id (BS.append x y)
isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y
isPrefixOf (Id x) (Id y)
| BS.isPrefixOf x y = Just (Id (BS.drop (BS.length x) y))
| otherwise = Nothing
instance Binary Ident where
put id = put (ident2utf8 id)