the construct lin C t now replaces lock fields (in source code; still tempor used internally); lock fields removed from english resource as an example

src/GF/Compile/CheckGrammar.hs

@@ -38,7 +38,7 @@ import GF.Grammar.Predef
 import GF.Grammar.Macros
 import GF.Grammar.PatternMatch
 import GF.Grammar.AppPredefined
-import GF.Grammar.Lockfield (isLockLabel)
+import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)
 
 import GF.Data.Operations
 import GF.Infra.CheckM
@@ -396,6 +396,10 @@ computeLType gr t = do
       let fs' = sortRec fs
       liftM RecType $ mapPairsM comp fs'
 
+    ELincat c t -> do
+      t' <- comp t
+      checkErr $ lockRecType c t' ---- locking to be removed AR 20/6/2009
+
     _ | ty == typeTok -> return typeStr
     _ | isPredefConstant ty -> return ty
 
@@ -599,6 +603,11 @@ inferLType gr trm = case trm of
      ty <- inferPatt p
      return (trm, EPattType ty)
 
+   ELin c trm -> do
+     (trm',ty) <- infer trm
+     ty' <- checkErr $ lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
+     return $ (ELin c trm', ty') 
+
    _ -> prtFail "cannot infer lintype of" trm
 
  where
@@ -861,6 +870,10 @@ checkLType env trm typ0 = do
         (def',ty) <- infer def  -- tries to infer type of local constant
         check (Let (x,(Just ty,def')) body) typ
 
+    ELin c tr -> do
+      tr1 <- checkErr $ unlockRecord c tr
+      check tr1 typ
+
     _ -> do
       (trm',ty') <- infer trm
       termWith trm' $ checkEq typ ty' trm'
@@ -886,7 +899,14 @@ checkLType env trm typ0 = do
      Just (_,t) -> do
        (t',ty') <- check t ty
        return (l,(Just ty',t'))
-     _ -> raise $ "cannot find value for label" +++ prt l +++ "in" +++ prt_ (R rms)
+     _ -> raise $ 
+       if isLockLabel l 
+       then
+         let cat = drop 5 (prt l) in
+         prt_ (R rms) +++ "is not in the lincat of" +++ cat ++ 
+         "; try wrapping it with lin " ++ cat
+       else
+         "cannot find value for label" +++ prt l +++ "in" +++ prt_ (R rms)
 
    checkCase arg val (p,t) = do
      cont <- pattContext env arg p

src/GF/Compile/Compute.hs

@@ -26,7 +26,7 @@ import GF.Grammar.Macros
 import GF.Grammar.Lookup
 import GF.Compile.Refresh
 import GF.Grammar.PatternMatch
-import GF.Grammar.Lockfield (isLockLabel) ----
+import GF.Grammar.Lockfield (isLockLabel,unlockRecord) ----
 
 import GF.Grammar.AppPredefined
 
@@ -219,6 +219,10 @@ computeTermOpt rec gr = comput True where
          (RecType rs, RecType ss) -> plusRecType r' s'
          _ -> return $ ExtR r' s'
 
+     ELin c r -> do
+       r' <- comp g r
+       unlockRecord c r'
+
      T _ _ -> compTable g t
      V _ _ -> compTable g t
 

src/GF/Grammar/Binary.hs

@@ -148,6 +148,8 @@ instance Binary Term where
   put (FV x)        = putWord8 35 >> put x
   put (Alts x)      = putWord8 36 >> put x
   put (Strs x)      = putWord8 37 >> put x
+  put (ELin x y)    = putWord8 38 >> put (x,y)
+
   get = do tag <- getWord8
            case tag of
              0  -> get >>= \x       -> return (Vr x)
@@ -186,6 +188,7 @@ instance Binary Term where
              35 -> get >>= \x       -> return (FV x)
              36 -> get >>= \x       -> return (Alts x)
              37 -> get >>= \x       -> return (Strs x)
+             38 -> get >>= \(x,y)   -> return (ELin x y)
              _  -> decodingError
 
 instance Binary Patt where

src/GF/Grammar/Grammar.hs

@@ -147,6 +147,9 @@ data Term =
  | EPatt Patt     -- ^ pattern (in macro definition): # p
  | EPattType Term -- ^ pattern type: pattern T
 
+ | ELincat Ident Term -- ^ boxed linearization type of Ident
+ | ELin Ident Term    -- ^ boxed linearization of type Ident
+
  | FV [Term]      -- ^ alternatives in free variation: @variants { s ; ... }@
 
  | Alts (Term, [(Term, Term)]) -- ^ alternatives by prefix: @pre {t ; s\/c ; ...}@

src/GF/Grammar/Lockfield.hs

@@ -36,8 +36,10 @@ lockRecType c t = plusRecType t $ RecType [(lockLabel c,  RecType [])]
 unlockRecord :: Ident -> Term -> Err Term
 unlockRecord c ft = do
   let (xs,t) = termFormCnc ft
-  t' <- plusRecord t $ R [(lockLabel c,  (Just (RecType []),R []))]
-  return $ mkAbs xs t'
+  let lock = R [(lockLabel c,  (Just (RecType []),R []))]
+  case plusRecord t lock of
+    Ok t' -> return $ mkAbs xs t'
+    _ -> return $ mkAbs xs (ExtR t lock)
 
 lockLabel :: Ident -> Label
 lockLabel c = LIdent $! BS.append lockPrefix (ident2bs c)

src/GF/Grammar/Macros.hs

@@ -634,6 +634,14 @@ composOp co trm =
      do ty' <- co ty
         return (EPattType ty')
 
+   ELincat c ty -> 
+     do ty' <- co ty
+        return (ELincat c ty')
+
+   ELin c ty -> 
+     do ty' <- co ty
+        return (ELin c ty')
+
    _ -> return trm -- covers K, Vr, Cn, Sort, EPatt
 
 getTableType :: TInfo -> Err Type

src/GF/Grammar/Parser.y

@@ -423,6 +423,8 @@ Exp4
   | 'strs' '{' ListExp '}'           { Strs $3       }
   | '#' Patt2                        { EPatt $2      }
   | 'pattern' Exp5                   { EPattType $2  }
+  | 'lincat' Ident Exp5              { ELincat $2 $3 }
+  | 'lin' Ident Exp5                 { ELin $2 $3 }
   | Exp5                             { $1            }
 
 Exp5 :: { Term }