restored Int size and last ; added lib/prelude to be the last in any grammar path

This commit is contained in:
aarne
2007-12-16 22:24:36 +00:00
parent 49b3ffb7a0
commit 7551c70db6
8 changed files with 28 additions and 28 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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]

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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