msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

cf for restricted import; new API funs

Browse Source
This commit is contained in:
aarne
2005-05-31 11:47:51 +00:00
parent 3a3342a0f9
commit d4c1a0f09d
3 changed files with 17 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
src/GF/CF/CanonToCF.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:21:11 $ -- > CVS $Date: 2005/05/31 12:47:52 $
-- > CVS $Author: bringert $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.13 $ -- > CVS $Revision: 1.14 $
-- --
-- AR 27\/1\/2000 -- 3\/12\/2001 -- 8\/6\/2003 -- AR 27\/1\/2000 -- 3\/12\/2001 -- 8\/6\/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -42,17 +42,22 @@ canon2cf opts gr c = tracePrt "#size of CF" (err id (show.length.rulesOfCF)) $ d
a <- M.abstractOfConcrete gr c a <- M.abstractOfConcrete gr c
let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms] let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms]
let mms = [(a, tree2list (M.jments m)) | m <- cncs] let mms = [(a, tree2list (M.jments m)) | m <- cncs]
rules0 <- liftM concat $ mapM (uncurry (cnc2cfCond opts)) mms cnc <- liftM M.jments $ M.lookupModMod gr c
rules0 <- liftM concat $ mapM (uncurry (cnc2cfCond opts cnc)) mms
let bindcats = map snd $ allBindCatsOf gr let bindcats = map snd $ allBindCatsOf gr
let rules = filter (not . isCircularCF) rules0 ---- temporarily here let rules = filter (not . isCircularCF) rules0 ---- temporarily here
let grules = groupCFRules rules let grules = groupCFRules rules
let predef = mkCFPredef opts bindcats grules let predef = mkCFPredef opts bindcats grules
return $ CF predef return $ CF predef
cnc2cfCond :: Options -> Ident -> [(Ident,Info)] -> Err [CFRule] cnc2cfCond :: Options -> BinTree Ident Info ->
cnc2cfCond opts m gr = Ident -> [(Ident,Info)] -> Err [CFRule]
cnc2cfCond opts cnc m gr =
liftM concat $ liftM concat $
mapM lin2cf [(m,fun,cat,args,lin) | (fun, CncFun cat args lin _) <- gr] mapM lin2cf [(m,fun,cat,args,lin) |
(fun, CncFun cat args lin _) <- gr, is fun]
where
is f = isInBinTree f cnc
type IFun = Ident type IFun = Ident
type ICat = CIdent type ICat = CIdent

2
src/GF/Embed/EmbedParsing.hs
View File

@@ -83,7 +83,7 @@ trees2trms opts sg cn as ts0 info = do
,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return [] ,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return []
] ]
_ -> do _ -> do
let num = optIntOrN opts flagRawtrees 99999 let num = optIntOrN opts flagRawtrees 999999
let (ts01,rest) = splitAt num ts0 let (ts01,rest) = splitAt num ts0
if null rest then return () if null rest then return ()
else checkWarn ("Warning: only" +++ show num +++ "raw parses out of" +++ else checkWarn ("Warning: only" +++ show num +++ "raw parses out of" +++

8
src/GF/UseGrammar/Parsing.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/05/11 10:28:16 $ -- > CVS $Date: 2005/05/31 12:47:52 $
-- > CVS $Author: peb $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.23 $ -- > CVS $Revision: 1.24 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -104,7 +104,7 @@ trees2trms opts sg cn as ts0 info = do
,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return [] ,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return []
] ]
_ -> do _ -> do
let num = optIntOrN opts flagRawtrees 99999 let num = optIntOrN opts flagRawtrees 999999
let (ts01,rest) = splitAt num ts0 let (ts01,rest) = splitAt num ts0
if null rest then return () if null rest then return ()
else raise ("Warning: only" +++ show num +++ "raw parses out of" +++ else raise ("Warning: only" +++ show num +++ "raw parses out of" +++