diff options
| author | aarne <aarne@chalmers.se> | 2009-06-20 13:50:34 +0000 |
|---|---|---|
| committer | aarne <aarne@chalmers.se> | 2009-06-20 13:50:34 +0000 |
| commit | beb8cad7d868b5ef1eb74d8f0d50cb689db613ab (patch) | |
| tree | 8c0f93c7f2d26e37d22aa3bac37732336d0614c6 /src/GF/Compile/CheckGrammar.hs | |
| parent | 48c755597598fc4656603a90997ebe484488a8f9 (diff) | |
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
Diffstat (limited to 'src/GF/Compile/CheckGrammar.hs')
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 24 |
1 files changed, 22 insertions, 2 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 8fa5d25b6..43abffa02 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/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 |
