summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/GF/Compile/CheckGrammar.hs5
-rw-r--r--src/GF/Devel/CheckGrammar.hs5
-rw-r--r--src/GF/Devel/GrammarToGFCC.hs15
-rw-r--r--src/GF/Devel/UseIO.hs2
-rw-r--r--src/GF/GFCC/Linearize.hs3
-rw-r--r--src/GF/Grammar/Lookup.hs18
-rw-r--r--src/GF/Infra/UseIO.hs2
-rw-r--r--src/GF/UseGrammar/Linear.hs6
8 files changed, 28 insertions, 28 deletions
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"
-
-lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type
-{- ----
-lookupLincat gr m c | elem c [zIdent "Int"] =
+linTypeInt :: Type
+linTypeInt =
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"] =
+ (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"] = 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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:29:34 +0000