mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-08-19 10:46:22 -06:00
more helpful error when lin X is missing
This commit is contained in:
@@ -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]]
|
||||
|
||||
@@ -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_"
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user