diff options
Diffstat (limited to 'src/GF/Canon')
| -rw-r--r-- | src/GF/Canon/GetGFC.hs | 7 | ||||
| -rw-r--r-- | src/GF/Canon/MkGFC.hs | 48 |
2 files changed, 32 insertions, 23 deletions
diff --git a/src/GF/Canon/GetGFC.hs b/src/GF/Canon/GetGFC.hs index cc22e4bff..a61228cb9 100644 --- a/src/GF/Canon/GetGFC.hs +++ b/src/GF/Canon/GetGFC.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/27 21:05:17 $ +-- > CVS $Date: 2005/05/30 18:39:43 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.8 $ +-- > CVS $Revision: 1.9 $ -- -- (Description of the module) ----------------------------------------------------------------------------- @@ -34,11 +34,13 @@ getCanonModule file = do _ -> ioeErr $ Bad "expected exactly one module in a file" getCanonGrammar :: FilePath -> IOE CanonGrammar +-- getCanonGrammar = getCanonGrammarByLine getCanonGrammar file = do s <- ioeIO $ readFileIf file c <- ioeErr $ pCanon $ myLexer s return $ canon2grammar c +{- -- the following surprisingly does not save memory so it is -- not in use @@ -74,3 +76,4 @@ getCanonGrammarByLine file = do isHash a b = a `div` step < b `div` step step = size `div` 50 +-} diff --git a/src/GF/Canon/MkGFC.hs b/src/GF/Canon/MkGFC.hs index 0868a2642..d727edd08 100644 --- a/src/GF/Canon/MkGFC.hs +++ b/src/GF/Canon/MkGFC.hs @@ -5,15 +5,15 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/27 21:05:17 $ +-- > CVS $Date: 2005/05/30 18:39:43 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.13 $ +-- > CVS $Revision: 1.14 $ -- -- (Description of the module) ----------------------------------------------------------------------------- module GF.Canon.MkGFC (prCanonModInfo, prCanon, prCanonMGr, - canon2grammar, grammar2canon, buildCanonGrammar, + canon2grammar, grammar2canon, -- buildCanonGrammar, info2mod, trExp, rtExp, rtQIdent) where @@ -173,6 +173,7 @@ rtIdent x | isWildIdent x = identC "h_" --- needed in declarations | otherwise = identC $ prt x --- +{- -- the following is called in GetGFC to read gfc files line -- by line. It does not save memory, though, and is therefore -- not used. @@ -184,7 +185,7 @@ buildCanonGrammar n gr0 line = mgr $ case line of LFlag f@(Flg (IC "modulesize") (IC n)) -> initModule f $ read $ tail n LFlag flag -> newFlag flag LDef def -> newDef $ def2info def - LEnd -> cleanNames +-- LEnd -> cleanNames _ -> M.modules gr0 where newModule mt ext op = mod2info (Mod mt ext op [] []) : mods @@ -198,10 +199,11 @@ buildCanonGrammar n gr0 line = mgr $ case line of (name, M.ModMod (M.Module mt com flags ee oo defs)) -> (name, M.ModMod (M.Module mt com flags ee oo (upd (padd 8 n) d defs))) : tmods - cleanNames = case actm of - (name, M.ModMod (M.Module mt com flags ee oo defs)) -> - (name, M.ModMod (M.Module mt com (reverse flags) ee oo - (mapTree (\ (IC f,t) -> (IC (drop 8 f),t)) defs))) : tmods + +-- cleanNames = case actm of +-- (name, M.ModMod (M.Module mt com flags ee oo defs)) -> +-- (name, M.ModMod (M.Module mt com (reverse flags) ee oo +-- (mapTree (\ (IC f,t) -> (IC (drop 8 f),t)) defs))) : tmods actm = head mods -- only used when a new mod has been created mods = M.modules gr0 @@ -214,16 +216,20 @@ buildCanonGrammar n gr0 line = mgr $ case line of ) -- create an initial tree with who-cares value - newtree (i :: Int) = sorted2tree [ - (padd 8 k, ResPar []) | - k <- [1..i]] --- padd (length (show i)) - - padd l k = let sk = show k in identC (replicate (l - length sk) '0' ++ sk) - - upd n d@(f,t) defs = case defs of - NT -> BT (merg n f,t) NT NT --- should not happen - BT c@(a,_) left right - | n < a -> let left' = upd n d left in BT c left' right - | n > a -> let right' = upd n d right in BT c left right' - | otherwise -> BT (merg n f,t) left right - merg (IC n) (IC f) = IC (n ++ f) + newtree (i :: Int) = emptyBinTree +-- newtree (i :: Int) = sorted2tree [ +-- (padd 8 k, ResPar []) | +-- k <- [1..i]] --- padd (length (show i)) + + padd l k = 0 +-- padd l k = let sk = show k in identC (replicate (l - length sk) '0' ++ sk) + + upd _ d defs = updateTree d defs +-- upd n d@(f,t) defs = case defs of +-- NT -> BT (merg n f,t) NT NT --- should not happen +-- BT c@(a,_) left right +-- | n < a -> let left' = upd n d left in BT c left' right +-- | n > a -> let right' = upd n d right in BT c left right' +-- | otherwise -> BT (merg n f,t) left right +-- merg (IC n) (IC f) = IC (n ++ f) +-} |