From eb10ccbe7c4d087360f2d6f9d0b8ec02a5887501 Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 16 Dec 2007 22:24:36 +0000 Subject: [PATCH] restored Int size and last ; added lib/prelude to be the last in any grammar path --- lib/resource/english/NounEng.gf | 3 ++- src/GF/Compile/CheckGrammar.hs | 5 +---- src/GF/Devel/CheckGrammar.hs | 5 +---- src/GF/Devel/GrammarToGFCC.hs | 15 ++++++++++----- src/GF/Devel/UseIO.hs | 2 +- src/GF/GFCC/Linearize.hs | 3 ++- src/GF/Grammar/Lookup.hs | 18 +++++++++--------- src/GF/Infra/UseIO.hs | 2 +- src/GF/UseGrammar/Linear.hs | 6 +++--- 9 files changed, 30 insertions(+), 29 deletions(-) diff --git a/lib/resource/english/NounEng.gf b/lib/resource/english/NounEng.gf index 7d718ceda..003839fb7 100644 --- a/lib/resource/english/NounEng.gf +++ b/lib/resource/english/NounEng.gf @@ -46,7 +46,8 @@ concrete NounEng of Noun = CatEng ** open ResEng, Prelude in { NumInt n = {s = n.s; n = table (Predef.Ints 1 * Predef.Ints 9) { <0,1> => Sg ; _ => Pl - } ! <1,2> ---- parser bug (AR 2/6/2007) + } ! ---- <1,2> ---- parser bug (AR 2/6/2007) + } ; OrdInt n = {s = n.s ++ "th"} ; --- diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 302663baf..81ac891ad 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -340,10 +340,7 @@ computeLType gr t = do Q m c | elem c [cPredef,cPredefAbs] -> return ty Q m c | elem c [zIdent "Int"] -> - return $ defLinType ----- let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in ----- RecType [ ----- (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)] + return $ linTypeInt Q m c | elem c [zIdent "Float",zIdent "String"] -> return defLinType ---- Q m ident -> checkIn ("module" +++ prt m) $ do diff --git a/src/GF/Devel/CheckGrammar.hs b/src/GF/Devel/CheckGrammar.hs index c3fde011d..9502bbec1 100644 --- a/src/GF/Devel/CheckGrammar.hs +++ b/src/GF/Devel/CheckGrammar.hs @@ -340,10 +340,7 @@ computeLType gr t = do Q m c | elem c [cPredef,cPredefAbs] -> return ty Q m c | elem c [zIdent "Int"] -> - return $ defLinType ----- let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in ----- RecType [ ----- (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)] + return $ linTypeInt Q m c | elem c [zIdent "Float",zIdent "String"] -> return defLinType ---- Q m ident -> checkIn ("module" +++ prt m) $ do diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs index 0ae0129ad..a61a2ec49 100644 --- a/src/GF/Devel/GrammarToGFCC.hs +++ b/src/GF/Devel/GrammarToGFCC.hs @@ -221,9 +221,11 @@ reorder abs cg = M.MGrammar $ (i,mo) <- mos, M.isModCnc mo, Just r <- [lookup i (M.allExtendSpecs cg la)]] - predefCDefs = [(IC c, CncCat (Yes GM.defLinType) Nope Nope) | - ---- lindef,printname - c <- ["Float","Int","String"]] + predefCDefs = + (IC "Int", CncCat (Yes Look.linTypeInt) Nope Nope) : + [(IC c, CncCat (Yes GM.defLinType) Nope Nope) | + ---- lindef,printname + c <- ["Float","String"]] sortIds = sortBy (\ (f,_) (g,_) -> compare f g) nubFlags = nubBy (\ (Opt (f,_)) (Opt (g,_)) -> f == g) @@ -304,7 +306,9 @@ type ParamEnv = --- gathers those param types that are actually used in lincats and lin terms paramValues :: SourceGrammar -> ParamEnv paramValues cgr = (labels,untyps,typs) where - partyps = nub $ [ty | + partyps = nub $ + [App (Q (IC "Predef") (IC "Ints")) (EInt i) | i <- [1,9]] ---linTypeInt + ++ [ty | (_,(_,CncCat (Yes (RecType ls)) _ _)) <- jments, ty0 <- [ty | (_, ty) <- unlockTyp ls], ty <- typsFrom ty0 @@ -342,7 +346,8 @@ paramValues cgr = (labels,untyps,typs) where untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs] lincats = - [(IC cat,[(LIdent "s",GM.typeStr)]) | cat <- ["Int", "Float", "String"]] ++ + [(IC "Int",[f | let RecType fs = Look.linTypeInt, f <- fs])] ++ + [(IC cat,[(LIdent "s",GM.typeStr)]) | cat <- ["Float", "String"]] ++ reverse ---- TODO: really those lincats that are reached ---- reverse is enough to expel overshadowed ones... [(cat,(unlockTyp ls)) | (_,(cat,CncCat (Yes (RecType ls)) _ _)) <- jments] diff --git a/src/GF/Devel/UseIO.hs b/src/GF/Devel/UseIO.hs index 21842724d..134f2f3d0 100644 --- a/src/GF/Devel/UseIO.hs +++ b/src/GF/Devel/UseIO.hs @@ -131,7 +131,7 @@ extendPathEnv lib var ps = do s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH let fs = pFilePaths s let ss = ps ++ fs - liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss] + liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss ++ ["prelude"]] pFilePaths :: String -> [FilePath] pFilePaths s = case break isPathSep s of diff --git a/src/GF/GFCC/Linearize.hs b/src/GF/GFCC/Linearize.hs index 826d3597b..d087384bf 100644 --- a/src/GF/GFCC/Linearize.hs +++ b/src/GF/GFCC/Linearize.hs @@ -31,7 +31,8 @@ linExp mcfg lang tree@(DTr _ at trees) = ---- bindings TODO case at of AC fun -> comp (lmap lin trees) $ look fun AS s -> R [kks (show s)] -- quoted - AI i -> R [kks (show i)] + AI i -> R [C lst, kks (show i), C size] where + lst = mod (fromInteger i) 10 ; size = if i < 10 then 0 else 1 AF d -> R [kks (show d)] AM _ -> TM where diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs index 2acfa5f26..481512751 100644 --- a/src/GF/Grammar/Lookup.hs +++ b/src/GF/Grammar/Lookup.hs @@ -28,7 +28,8 @@ module GF.Grammar.Lookup ( allParamValues, lookupAbsDef, lookupLincat, - opersForType + opersForType, + linTypeInt ) where import GF.Data.Operations @@ -229,16 +230,15 @@ lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do _ -> return Nothing _ -> Bad $ prt m +++ "is not an abstract module" +linTypeInt :: Type +linTypeInt = + let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in + RecType [ + (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)] lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type -{- ---- -lookupLincat gr m c | elem c [zIdent "Int"] = - let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in - return $ - RecType [ - (LIdent "last",ints 9),(LIdent "s", typeStr),(LIdent "size",ints 1)] --} -lookupLincat gr m c | elem c [zIdent "String", zIdent "Float", zIdent "Int"] = +lookupLincat gr m c | elem c [zIdent "Int"] = return linTypeInt +lookupLincat gr m c | elem c [zIdent "String", zIdent "Float"] = return defLinType --- ad hoc; not needed? lookupLincat gr m c = do diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 101f09c54..6c15ee6e5 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -130,7 +130,7 @@ extendPathEnv lib var ps = do s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH let fs = pFilePaths s let ss = ps ++ fs - liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss] + liftM concat $ mapM allSubdirs $ ss ++ [b ++ "/" ++ s | s <- ss ++ ["prelude"]] pFilePaths :: String -> [FilePath] pFilePaths s = case break isPathSep s of diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs index 8b71fbc29..c9b94ccb0 100644 --- a/src/GF/UseGrammar/Linear.hs +++ b/src/GF/UseGrammar/Linear.hs @@ -81,9 +81,9 @@ linearizeToRecord gr mk m = lin [] where recS t = R [Ass (L (identC "s")) t] ---- recInt i = R [ - ----Ass (L (identC "last")) (EInt (rem i 10)), - Ass (L (identC "s")) (tK $ show i) ----, - ----Ass (L (identC "size")) (EInt (if i > 9 then 1 else 0)) + Ass (L (identC "last")) (EInt (rem i 10)), + Ass (L (identC "s")) (tK $ show i), + Ass (L (identC "size")) (EInt (if i > 9 then 1 else 0)) ] lookCat = return . errVal defLindef . look