+ 27/6 (AR) The flag flags optimize=noexpand placed in a resource module prevents the optimization phase of the compiler when the .gfr file is created. This can prevent serious code diff --git a/lib/resource/finnish/BasicFin.gf b/lib/resource/finnish/BasicFin.gf index a323c37e6..6a0db6fda 100644 --- a/lib/resource/finnish/BasicFin.gf +++ b/lib/resource/finnish/BasicFin.gf @@ -113,7 +113,7 @@ lin leather_N = regN "nahka" ; --- nahan leave_V2 = dirV2 (regV "jättää") ; like_V2 = caseV2 (regV "pitää") elative ; - listen_V2 = caseV2 (reg3V "kuunnella" "kuuntelen" "kuuntelin") partitive ; + listen_V2 = caseV2 (reg3V "kuunnella" "kuuntelen" "kuunteli") partitive ; live_V = regV "elää" ; long_ADeg = mkADeg (regN "pitkä") "pitempi" "pisin" ; lose_V2 = dirV2 (regV "hävitä") ; --- hukata @@ -200,7 +200,7 @@ lin tree_N = regN "puu" ; ---- trousers_N = regN "trousers" ; ugly_ADeg = mkADeg (regN "ruma") "rumempi" "rumin" ; - understand_V2 = dirV2 (reg3V "ymmärtää" "ymmärrän" "ymmärsin") ; + understand_V2 = dirV2 (reg3V "ymmärtää" "ymmärrän" "ymmärsi") ; university_N = regN "yliopisto" ; village_N = regN "kylä" ; wait_V2 = caseV2 (regV "odottaa") partitive ; diff --git a/lib/resource/finnish/MorphoFin.gf b/lib/resource/finnish/MorphoFin.gf index 82c330cbc..b786db6cb 100644 --- a/lib/resource/finnish/MorphoFin.gf +++ b/lib/resource/finnish/MorphoFin.gf @@ -921,7 +921,7 @@ caseTable : Number -> CommonNoun -> Case => Str = \n,cn -> vOttaa : (_,_ : Str) -> Verb = \ottaa,otan -> let - i = if_then_Str (pbool2bool (Predef.occurs "ou" ottaa)) "i" "oi" + i = "i" ; --- wrong rule if_then_Str (pbool2bool (Predef.occurs "ou" ottaa)) "i" "oi" in vHuoltaa ottaa otan (Predef.tk 2 ottaa + i) (Predef.tk 2 otan + i + "n") ; diff --git a/lib/resource/finnish/ParadigmsFin.gf b/lib/resource/finnish/ParadigmsFin.gf index 83d8b3f6a..1c8e0be23 100644 --- a/lib/resource/finnish/ParadigmsFin.gf +++ b/lib/resource/finnish/ParadigmsFin.gf @@ -402,8 +402,7 @@ regV soutaa = u = ifTok Str a "a" "u" "y" ; joi = Predef.tk 2 juo + (o + "i") in case ta of { - "st" => vJuosta soutaa soudan (juo + "s"+u+"t") (juo + "t"+u) ; - "nn" | "rr" | "ll" => vJuosta soutaa soudan (juo + o+u+"t") (juo + "t"+u) ; + "st" | "nn" | "rr" | "ll" => vJuosta soutaa soudan (juo + o+u+"t") (juo + "t"+u) ; _ => case aa of { "aa" | "ää" => vOttaa soutaa (souda + "n") ; "da" | "dä" => vJuoda soutaa joi ; @@ -429,7 +428,7 @@ reg2V : (soutaa,souti : Str) -> V = \soutaa,souti -> _ => soudat } ** {lock_V = <>} ; -reg3V soutaa soudan soudin = +reg3V soutaa soudan souti = let taa = Predef.dp 3 soutaa ; ta = init taa ; @@ -439,15 +438,14 @@ reg3V soutaa soudan soudin = o = last juo ; a = last aa ; u = ifTok Str a "a" "u" "y" ; - joi = init soudin + soudin = weakGrade souti + "n" ; + soudat = reg2V soutaa souti ; in case ta of { - "st" => vJuosta soutaa soudan (juo + "s"+u+"t") (juo + "t"+u) ; - "nn" | "rr" | "ll" => vJuosta soutaa soudan (juo + o+u+"t") (juo + "t"+u) ; + "ll" => vJuosta soutaa soudan (juo + o+u+"t") (juo + "t"+u) ; _ => case aa of { - "aa" | "ää" => vHuoltaa soutaa soudan (init soudin) soudin ; - "da" | "dä" => vJuoda soutaa joi ; - "ta" | "tä" => vOsata soutaa ; - _ => vHukkua soudan souda + "aa" | "ää" => vHuoltaa soutaa soudan souti soudin ; + "da" | "dä" => vJuoda soutaa souti ; + _ => soudat }} ** {lock_V = <>} ; vValua v = vSanoa v ** {lock_V = <>} ; diff --git a/lib/resource/finnish/SwadeshLexFin.gf b/lib/resource/finnish/SwadeshLexFin.gf index 4130f5456..1e7250ad4 100644 --- a/lib/resource/finnish/SwadeshLexFin.gf +++ b/lib/resource/finnish/SwadeshLexFin.gf @@ -211,7 +211,7 @@ concrete SwadeshLexFin of SwadeshLex = CategoriesFin hunt_V = regV "metsästää" ; kill_V = regV "tappaa" ; know_V =reg2V "tietää" "tiesin" ; - laugh_V = reg3V "nauraa" "nauran" "nauroin" ; + laugh_V = reg3V "nauraa" "nauran" "nauroi" ; lie_V = regV "maata" ; live_V = live_V ; play_V = UseV2 play_V2 ; @@ -235,8 +235,8 @@ concrete SwadeshLexFin of SwadeshLex = CategoriesFin suck_V = regV "imeä" ; swell_V = mkV "turvota" "turpoaa" "turpoan" "turpoavat" "turvotkaa" "turvotaan" "turposi" "turposin" "turpoaisi" "turvonnut" "turvottu" "turvotun" ; - swim_V = reg3V "uida" "uin" "uin" ; - think_V = reg3V "ajatella" "ajattelen" "ajattelin" ; + swim_V = reg3V "uida" "uin" "ui" ; + think_V = reg3V "ajatella" "ajattelen" "ajatteli" ; throw_V = regV "heittää" ; tie_V = regV "sitoa" ; turn_V = regV "kääntyä" ; diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 40c625612..b04875e56 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/06/23 14:32:44 $ +-- > CVS $Date: 2005/06/29 16:27:56 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.65 $ +-- > CVS $Revision: 1.66 $ -- -- A database for customizable GF shell commands. -- @@ -39,6 +39,7 @@ import qualified GF.Grammar.MMacros as MM import GF.Grammar.AbsCompute import GF.Grammar.TypeCheck import GF.UseGrammar.Generate +import GF.UseGrammar.Linear (unoptimizeCanon) ------import Compile import GF.Compile.ShellState import GF.UseGrammar.Editing @@ -282,7 +283,7 @@ customMultiGrammarPrinter = customData "Printers for multiple grammars, selected by option -printer=x" $ [ (strCI "gfcm", const MC.prCanon) - ,(strCI "header", const MC.prCanonMGr) + ,(strCI "header", const (MC.prCanonMGr . unoptimizeCanon)) ,(strCI "cfgm", prCanonAsCFGM) ,(strCI "graph", visualizeCanonGrammar) ] diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs index 3899aa48f..6de767a06 100644 --- a/src/GF/UseGrammar/Linear.hs +++ b/src/GF/UseGrammar/Linear.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/06/23 14:32:44 $ +-- > CVS $Date: 2005/06/29 16:27:56 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.17 $ +-- > CVS $Revision: 1.18 $ -- -- Linearization for canonical GF. AR 7\/6\/2003 ----------------------------------------------------------------------------- @@ -31,6 +31,7 @@ import GF.Text.Text import GF.Data.Operations import GF.Data.Zipper +import qualified GF.Infra.Modules as M import Control.Monad import Data.List (intersperse) @@ -104,6 +105,11 @@ expandLinTables gr t = case t of ps <- mapM term2patt vs ts' <- mapM (comp . S t') $ vs return $ T ty [Cas [p] t | (p,t) <- zip ps ts'] + V ty ts0 -> do + ts <- mapM exp ts0 -- expand from inside-out + vs <- alls ty + ps <- mapM term2patt vs + return $ T ty [Cas [p] t | (p,t) <- zip ps ts] FV ts -> liftM FV $ mapM exp ts _ -> composOp exp t where @@ -111,6 +117,39 @@ expandLinTables gr t = case t of exp = expandLinTables gr comp = ccompute gr [] +-- Do this for an entire grammar: + +unoptimizeCanon :: CanonGrammar -> CanonGrammar +unoptimizeCanon g@(M.MGrammar ms) = M.MGrammar $ map convMod ms where + convMod (m, M.ModMod (M.Module (M.MTConcrete a) x flags me os defs)) = + (m, M.ModMod (M.Module (M.MTConcrete a) x flags me os (mapTree convDef defs))) + convMod mm = mm + convDef (c,CncCat ty df pr) = (c,CncCat ty (convT df) (convT pr)) + convDef (f,CncFun c xs li pr) = (f,CncFun c xs (convT li) (convT pr)) + convDef cd = cd + convT = err error id . exp + -- a version of expandLinTables that does not destroy share optimization + exp t = case t of + R rs -> liftM (R . map (uncurry Ass)) $ mapPairsM exp [(l,r) | Ass l r <- rs] + T ty rs@[Cas [_] _] -> do + rs' <- mapPairsM exp [(l,r) | Cas l r <- rs] -- expand from inside-out + let t' = T ty $ map (uncurry Cas) rs' + vs <- alls ty + ps <- mapM term2patt vs + ts' <- mapM (comp . S t') $ vs + return $ T ty [Cas [p] t | (p,t) <- zip ps ts'] + V ty ts0 -> do + ts <- mapM exp ts0 -- expand from inside-out + vs <- alls ty + ps <- mapM term2patt vs + return $ T ty [Cas [p] t | (p,t) <- zip ps ts] + FV ts -> liftM FV $ mapM exp ts + _ -> composOp exp t + where + alls = allParamValues g + comp = ccompute g [] + + -- | from records, one can get to records of tables of strings rec2strTables :: Term -> Err [[(Label,[([Patt],[Str])])]] rec2strTables r = do