mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
restored Int size and last ; added lib/prelude to be the last in any grammar path
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user