From 3adf824e8ed51606c11284e286da06afaea22f9a Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 17 Jun 2007 21:56:27 +0000 Subject: [PATCH] checking name conflicts; some RGs don't work now --- lib/prelude/Coordination.gf | 2 -- lib/resource-1.0/english/CatEng.gf | 10 +++---- lib/resource-1.0/english/LexiconEng.gf | 34 +++++++++++------------ lib/resource-1.0/finnish/CatFin.gf | 8 +++--- lib/resource-1.0/finnish/NumeralFin.gf | 6 ++-- lib/resource-1.0/finnish/ParadigmsFin.gf | 3 +- lib/resource-1.0/finnish/StructuralFin.gf | 24 ++++++++-------- lib/resource-1.0/italian/LexiconIta.gf | 26 ++++++++--------- lib/resource-1.0/scandinavian/CatScand.gf | 8 +++--- lib/resource-1.0/swedish/IdiomSwe.gf | 18 +++++++----- lib/resource-1.0/swedish/NumeralSwe.gf | 2 +- src/GF/Compile/Rename.hs | 33 ++++++++++++++-------- src/GF/Data/Operations.hs | 8 +++++- 13 files changed, 101 insertions(+), 81 deletions(-) diff --git a/lib/prelude/Coordination.gf b/lib/prelude/Coordination.gf index bbc027048..499b45306 100644 --- a/lib/prelude/Coordination.gf +++ b/lib/prelude/Coordination.gf @@ -4,8 +4,6 @@ param ListSize = TwoElem | ManyElem ; oper - SS = {s : Str} ; ---- - ListX = {s1,s2 : Str} ; twoStr : (x,y : Str) -> ListX = \x,y -> diff --git a/lib/resource-1.0/english/CatEng.gf b/lib/resource-1.0/english/CatEng.gf index 11533f9a2..851e1b47a 100644 --- a/lib/resource-1.0/english/CatEng.gf +++ b/lib/resource-1.0/english/CatEng.gf @@ -12,29 +12,29 @@ concrete CatEng of Cat = CommonX ** open ResEng, Prelude in { -- Sentence - Cl = {s : Tense => Anteriority => CPolarity => Order => Str} ; + Cl = {s : ResEng.Tense => Anteriority => CPolarity => Order => Str} ; Slash = { - s : Tense => Anteriority => CPolarity => Order => Str ; + s : ResEng.Tense => Anteriority => CPolarity => Order => Str ; c2 : Str } ; Imp = {s : CPolarity => ImpForm => Str} ; -- Question - QCl = {s : Tense => Anteriority => CPolarity => QForm => Str} ; + QCl = {s : ResEng.Tense => Anteriority => CPolarity => QForm => Str} ; IP = {s : Case => Str ; n : Number} ; IComp = {s : Str} ; IDet = {s : Str ; n : Number} ; -- Relative - RCl = {s : Tense => Anteriority => CPolarity => Agr => Str ; c : Case} ; + RCl = {s : ResEng.Tense => Anteriority => CPolarity => Agr => Str ; c : Case} ; RP = {s : RCase => Str ; a : RAgr} ; -- Verb VP = { - s : Tense => Anteriority => CPolarity => Order => Agr => {fin, inf : Str} ; + s : ResEng.Tense => Anteriority => CPolarity => Order => Agr => {fin, inf : Str} ; prp : Str ; -- present participle inf : Str ; -- infinitive ad : Str ; diff --git a/lib/resource-1.0/english/LexiconEng.gf b/lib/resource-1.0/english/LexiconEng.gf index 4c9af6354..eee1f4eee 100644 --- a/lib/resource-1.0/english/LexiconEng.gf +++ b/lib/resource-1.0/english/LexiconEng.gf @@ -302,34 +302,34 @@ lin wing_N = regN "wing" ; worm_N = regN "worm" ; year_N = regN "year" ; - blow_V = blow_V ; + blow_V = IrregEng.blow_V ; breathe_V = dirV2 (regV "breathe") ; - burn_V = burn_V ; - dig_V = dig_V ; - fall_V = fall_V ; + burn_V = IrregEng.burn_V ; + dig_V = IrregEng.dig_V ; + fall_V = IrregEng.fall_V ; float_V = regV "float" ; flow_V = regV "flow" ; - fly_V = fly_V ; - freeze_V = freeze_V ; + fly_V = IrregEng.fly_V ; + freeze_V = IrregEng.freeze_V ; give_V3 = dirV3 give_V toP ; laugh_V = regV "laugh" ; - lie_V = lie_V ; + lie_V = IrregEng.lie_V ; play_V = regV "play" ; - sew_V = sew_V ; - sing_V = sing_V ; - sit_V = sit_V ; + sew_V = IrregEng.sew_V ; + sing_V = IrregEng.sing_V ; + sit_V = IrregEng.sit_V ; smell_V = regV "smell" ; - spit_V = spit_V ; - stand_V = stand_V ; - swell_V = swell_V ; - swim_V = swim_V ; - think_V = think_V ; + spit_V = IrregEng.spit_V ; + stand_V = IrregEng.stand_V ; + swell_V = IrregEng.swell_V ; + swim_V = IrregEng.swim_V ; + think_V = IrregEng.think_V ; turn_V = regV "turn" ; vomit_V = regV "vomit" ; - bite_V2 = dirV2 bite_V ; + bite_V2 = dirV2 IrregEng.bite_V ; count_V2 = dirV2 (regV "count") ; - cut_V2 = dirV2 cut_V ; + cut_V2 = dirV2 IrregEng.cut_V ; fear_V2 = dirV2 (regV "fear") ; fight_V2 = dirV2 fight_V ; hit_V2 = dirV2 hit_V ; diff --git a/lib/resource-1.0/finnish/CatFin.gf b/lib/resource-1.0/finnish/CatFin.gf index c00d6589f..2b7c7ef0b 100644 --- a/lib/resource-1.0/finnish/CatFin.gf +++ b/lib/resource-1.0/finnish/CatFin.gf @@ -12,20 +12,20 @@ concrete CatFin of Cat = CommonX ** open ResFin, Prelude in { -- Sentence - Cl = {s : Tense => Anteriority => Polarity => SType => Str} ; - Slash = {s : Tense => Anteriority => Polarity => Str ; c2 : Compl} ; + Cl = {s : ResFin.Tense => Anteriority => Polarity => SType => Str} ; + Slash = {s : ResFin.Tense => Anteriority => Polarity => Str ; c2 : Compl} ; Imp = {s : Polarity => Number => Str} ; -- Question - QCl = {s : Tense => Anteriority => Polarity => Str} ; + QCl = {s : ResFin.Tense => Anteriority => Polarity => Str} ; IP = {s : NPForm => Str ; n : Number} ; IComp = {s : Agr => Str} ; IDet = {s : Case => Str ; n : Number} ; -- Relative - RCl = {s : Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ; + RCl = {s : ResFin.Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ; RP = {s : Number => NPForm => Str ; a : RAgr} ; -- Verb diff --git a/lib/resource-1.0/finnish/NumeralFin.gf b/lib/resource-1.0/finnish/NumeralFin.gf index 6ac0f3c6e..e868af284 100644 --- a/lib/resource-1.0/finnish/NumeralFin.gf +++ b/lib/resource-1.0/finnish/NumeralFin.gf @@ -6,9 +6,9 @@ concrete NumeralFin of Numeral = CatFin ** open Prelude, ParadigmsFin, MorphoFi flags optimize = all_subs ; lincat - Sub1000000 = {s : CardOrd => Str ; n : Number} ; + Sub1000000 = {s : CardOrd => Str ; n : MorphoFin.Number} ; Digit = {s : CardOrd => Str} ; - Sub10, Sub100, Sub1000 = {s : NumPlace => CardOrd => Str ; n : Number} ; + Sub10, Sub100, Sub1000 = {s : NumPlace => CardOrd => Str ; n : MorphoFin.Number} ; lin num x = x ; @@ -120,7 +120,7 @@ oper } } ; - sataaN : {s : Number => CardOrd => Str} = {s = table { + sataaN : {s : MorphoFin.Number => CardOrd => Str} = {s = table { Sg => sataN.s ; Pl => table { NCard (NCase Sg Nom) => "sataa" ; diff --git a/lib/resource-1.0/finnish/ParadigmsFin.gf b/lib/resource-1.0/finnish/ParadigmsFin.gf index df83ed1f9..63c69cab4 100644 --- a/lib/resource-1.0/finnish/ParadigmsFin.gf +++ b/lib/resource-1.0/finnish/ParadigmsFin.gf @@ -202,7 +202,6 @@ oper regPN : Str -> PN ; mkPN : N -> PN ; - mkNP : N -> Number -> NP ; --2 Adjectives @@ -475,6 +474,8 @@ reg3N = \vesi,veden,vesi genN2 = \n -> mkN2 n (casePrep genitive) ; regPN m = mkPN (regN m) ; mkPN n = mkProperName n ** {lock_PN = <>} ; + + mkNP : N -> Number -> CatFin.NP ; mkNP noun num = { s = \\c => noun.s ! NCase num (npform2case num c) ; a = agrP3 num ; diff --git a/lib/resource-1.0/finnish/StructuralFin.gf b/lib/resource-1.0/finnish/StructuralFin.gf index 7c034b260..1f93cca77 100644 --- a/lib/resource-1.0/finnish/StructuralFin.gf +++ b/lib/resource-1.0/finnish/StructuralFin.gf @@ -99,11 +99,11 @@ concrete StructuralFin of Structural = CatFin ** } ; somewhere_Adv = ss "jossain" ; that_Quant = { - s1 = table Number [ - table Case { + s1 = table (MorphoFin.Number) [ + table (MorphoFin.Case) { c => (mkPronoun "tuo" "tuon" "tuota" "tuona" "tuohon" Sg P3).s ! NPCase c } ; - table Case { + table (MorphoFin.Case) { c => (mkPronoun "nuo" "noiden" "noita" "noina" "noihin" Sg P3).s ! NPCase c } ] ; @@ -121,11 +121,11 @@ concrete StructuralFin of Structural = CatFin ** {isPron = False} ; they_Pron = mkPronoun "he" "heidän" "heitä" "heinä" "heihin" Pl P3 ; --- ne this_Quant = { - s1 = table Number [ - table Case { + s1 = table (MorphoFin.Number) [ + table (MorphoFin.Case) { c => (mkPronoun "tämä" "tämän" "tätä" "tänä" "tähän" Sg P3).s ! NPCase c } ; - table Case { + table (MorphoFin.Case) { c => (mkPronoun "nuo" "noiden" "noita" "noina" "noihin" Sg P3).s ! NPCase c } ] ; @@ -181,7 +181,7 @@ concrete StructuralFin of Structural = CatFin ** oper - jokuPron : Number => Case => Str = + jokuPron : MorphoFin.Number => (MorphoFin.Case) => Str = let ku = nhn (sPuu "ku") ; kui = nhn (sPuu "kuu") @@ -198,7 +198,7 @@ oper } } ; - jokinPron : Number => Case => Str = + jokinPron : MorphoFin.Number => (MorphoFin.Case) => Str = table { Sg => table { Nom => "jokin" ; @@ -211,7 +211,7 @@ oper } } ; - mikaInt : Number => Case => Str = + mikaInt : MorphoFin.Number => (MorphoFin.Case) => Str = let { mi = nhn (sSuo "mi") } in @@ -228,7 +228,7 @@ oper } } ; - kukaInt : Number => Case => Str = + kukaInt : MorphoFin.Number => (MorphoFin.Case) => Str = let { ku = nhn (sRae "kuka" "kenenä") ; ket = nhn (sRae "kuka" "keinä")} in @@ -245,7 +245,7 @@ oper c => ket.s ! NCase Pl c } } ; - mikaanPron : Number => Case => Str = \\n,c => + mikaanPron : MorphoFin.Number => (MorphoFin.Case) => Str = \\n,c => case of { => "mikään" ; <_,Part> => "mitään" ; @@ -260,7 +260,7 @@ oper _ => mikaInt ! n ! c + "kään" } ; - kukaanPron : Number => Case => Str = + kukaanPron : MorphoFin.Number => (MorphoFin.Case) => Str = table { Sg => table { Nom => "kukaan" ; diff --git a/lib/resource-1.0/italian/LexiconIta.gf b/lib/resource-1.0/italian/LexiconIta.gf index 6cc618ef0..cb06d40df 100644 --- a/lib/resource-1.0/italian/LexiconIta.gf +++ b/lib/resource-1.0/italian/LexiconIta.gf @@ -8,18 +8,18 @@ flags lin airplane_N = regN "aereo" ; - answer_V2S = mkV2S (verboV (rispondere_76 "rispondere")) dative ; + answer_V2S = mkV2S (verboV (rispondere_76 "rispondere")) ParadigmsIta.dative ; apartment_N = regN "apartamento" ; apple_N = regN "mela" ; art_N = femN (regN "arte") ; - ask_V2Q = mkV2Q (verboV (rispondere_76 "chiedere")) dative ; + ask_V2Q = mkV2Q (verboV (rispondere_76 "chiedere")) ParadigmsIta.dative ; baby_N = regN "bambino" ; bad_A = prefA (mkADeg (regA "cattivo") (regA "peggio")) ; bank_N = regN "banca" ; beautiful_A = prefA (regADeg "bello") ; become_VA = essereV (regV "diventare") ; beer_N = regN "birra" ; - beg_V2V = mkV2V (regV "pregare") accusative dative ; + beg_V2V = mkV2V (regV "pregare") ParadigmsIta.accusative ParadigmsIta.dative ; big_A = prefA (regADeg "grande") ; bike_N = regN "bicicletta" ; bird_N = regN "uccello" ; @@ -60,12 +60,12 @@ lin cow_N = regN "vacca" ; die_V = verboV (morire_105 "morire") ; dirty_A = regADeg "sporco" ; - distance_N3 = mkN3 (regN "distanza") genitive dative ; + distance_N3 = mkN3 (regN "distanza") ParadigmsIta.genitive ParadigmsIta.dative ; doctor_N = mkN "medico" "medici" masculine ; dog_N = regN "cane" ; door_N = regN "porta" ; drink_V2 = dirV2 (verboV (bere_27 "bere")) ; - easy_A2V = mkA2V (regA "facile") dative genitive ; + easy_A2V = mkA2V (regA "facile") ParadigmsIta.dative ParadigmsIta.genitive ; eat_V2 = dirV2 (regV "mangiare") ; empty_A = regADeg "vuoto" ; enemy_N = regN "nemico" ; @@ -79,7 +79,7 @@ lin fridge_N = regN "frigorifero" ; friend_N = regN "amico" ; fruit_N = regN "frutta" ; - fun_AV = mkAV (regA "divertente") genitive ; + fun_AV = mkAV (regA "divertente") ParadigmsIta.genitive ; garden_N = regN "giardino" ; girl_N = regN "ragazza" ; glove_N = regN "guanto" ; @@ -116,7 +116,7 @@ lin love_N = regN "amore" ; love_V2 = dirV2 (regV "amare") ; man_N = mkN "uomo" "uomini" masculine ; - married_A2 = mkA2 (regA "sposato") dative ; + married_A2 = mkA2 (regA "sposato") ParadigmsIta.dative ; meat_N = femN (regN "carne") ; milk_N = regN "latte" ; moon_N = regN "luna" ; @@ -130,7 +130,7 @@ lin old_A = prefA (regADeg "vecchio") ; open_V2 = dirV2 (verboV (aprire_102 "aprire")) ; paint_V2A = - mkV2A (verboV (cingere_31 "pingere")) accusative (mkPrep "in") ; ---- + mkV2A (verboV (cingere_31 "pingere")) ParadigmsIta.accusative (mkPrep "in") ; ---- paper_N = regN "carta" ; paris_PN = mkPN "Parigi" masculine ; peace_N = femN (regN "pace") ; @@ -159,8 +159,8 @@ lin sea_N = regN "mare" ; seek_V2 = dirV2 (regV "cercare") ; see_V2 = dirV2 (verboV (vedere_93 "vedere")) ; - sell_V3 = dirV3 (verboV (scendere_80 "vendere")) dative ; ---- except some forms - send_V3 = dirV3 (regV "mandare") dative ; + sell_V3 = dirV3 (verboV (scendere_80 "vendere")) ParadigmsIta.dative ; ---- except some forms + send_V3 = dirV3 (regV "mandare") ParadigmsIta.dative ; sheep_N = regN "agnello" ; ship_N = femN (regN "nave") ; shirt_N = regN "camicia" ; @@ -184,7 +184,7 @@ lin switch8off_V2 = dirV2 (verboV (cingere_31 "spingere")) ; switch8on_V2 = dirV2 (regV "allumare") ; ---- table_N = regN "tavola" ; --- tavolo - talk_V3 = mkV3 (regV "parlare") dative genitive ; + talk_V3 = mkV3 (regV "parlare") ParadigmsIta.dative ParadigmsIta.genitive ; teacher_N = regN "professore" ; teach_V2 = dirV2 (regV "insegnare") ; television_N = femN (regN "televisione") ; @@ -198,7 +198,7 @@ lin understand_V2 = dirV2 (regV "capire") ; university_N = regN "università" ; village_N = regN "paese" ; - wait_V2 = mkV2 (regV "aspettare") dative ; + wait_V2 = mkV2 (regV "aspettare") ParadigmsIta.dative ; walk_V = regV "camminare" ; warm_A = regADeg "caldo" ; war_N = regN "guerra" ; @@ -219,7 +219,7 @@ lin now_Adv = mkAdv "adesso" ; already_Adv = mkAdv "già" ; song_N = femN (regN "canzone") ; - add_V3 = dirV3 (verboV (giungere_55 "aggiungere")) dative ; + add_V3 = dirV3 (verboV (giungere_55 "aggiungere")) ParadigmsIta.dative ; number_N = regN "numero" ; put_V2 = dirV2 (verboV (mettere_57 "mettere")) ; stop_V = reflV (regV "fermare") ; diff --git a/lib/resource-1.0/scandinavian/CatScand.gf b/lib/resource-1.0/scandinavian/CatScand.gf index ccb651eea..ce4eb614a 100644 --- a/lib/resource-1.0/scandinavian/CatScand.gf +++ b/lib/resource-1.0/scandinavian/CatScand.gf @@ -13,20 +13,20 @@ incomplete concrete CatScand of Cat = -- Sentence - Cl = {s : Tense => Anteriority => Polarity => Order => Str} ; - Slash = {s : Tense => Anteriority => Polarity => Order => Str} ** {c2 : Str} ; + Cl = {s : R.Tense => Anteriority => Polarity => Order => Str} ; + Slash = {s : R.Tense => Anteriority => Polarity => Order => Str} ** {c2 : Str} ; Imp = {s : Polarity => Number => Str} ; -- Question - QCl = {s : Tense => Anteriority => Polarity => QForm => Str} ; + QCl = {s : R.Tense => Anteriority => Polarity => QForm => Str} ; IP = {s : NPForm => Str ; gn : GenNum} ; IComp = {s : AFormPos => Str} ; IDet = {s : Gender => Str ; n : Number ; det : DetSpecies} ; -- Relative; the case $c$ is for "det" clefts. - RCl = {s : Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ; + RCl = {s : R.Tense => Anteriority => Polarity => Agr => Str ; c : NPForm} ; RP = {s : GenNum => RCase => Str ; a : RAgr} ; -- Verb diff --git a/lib/resource-1.0/swedish/IdiomSwe.gf b/lib/resource-1.0/swedish/IdiomSwe.gf index 412391529..88d360a77 100644 --- a/lib/resource-1.0/swedish/IdiomSwe.gf +++ b/lib/resource-1.0/swedish/IdiomSwe.gf @@ -3,28 +3,32 @@ concrete IdiomSwe of Idiom = CatSwe ** flags optimize=all_subs ; - lin - ImpersCl vp = mkClause "det" (agrP3 neutrum Sg) vp ; - GenericCl vp = mkClause "man" (agrP3 utrum Sg) vp ; + oper + utr = ParadigmsSwe.utrum ; + neutr = ParadigmsSwe.neutrum ; - CleftNP np rs = mkClause "det" (agrP3 neutrum Sg) + lin + ImpersCl vp = mkClause "det" (agrP3 neutr Sg) vp ; + GenericCl vp = mkClause "man" (agrP3 utr Sg) vp ; + + CleftNP np rs = mkClause "det" (agrP3 neutr Sg) (insertObj (\\_ => rs.s ! np.a) (insertObj (\\_ => np.s ! rs.c) (predV verbBe))) ; - CleftAdv ad s = mkClause "det" (agrP3 neutrum Sg) + CleftAdv ad s = mkClause "det" (agrP3 neutr Sg) (insertObj (\\_ => "som" ++ s.s ! Sub) (insertObj (\\_ => ad.s) (predV verbBe))) ; ExistNP np = - mkClause "det" (agrP3 neutrum Sg) (insertObj + mkClause "det" (agrP3 neutr Sg) (insertObj (\\_ => np.s ! accusative) (predV (depV finna_V))) ; ExistIP ip = { s = \\t,a,p => let cls = - (mkClause "det" (agrP3 neutrum Sg) (predV (depV finna_V))).s ! t ! a ! p ; + (mkClause "det" (agrP3 neutr Sg) (predV (depV finna_V))).s ! t ! a ! p ; who = ip.s ! accusative in table { QDir => who ++ cls ! Inv ; diff --git a/lib/resource-1.0/swedish/NumeralSwe.gf b/lib/resource-1.0/swedish/NumeralSwe.gf index aeed5da97..0885bb180 100644 --- a/lib/resource-1.0/swedish/NumeralSwe.gf +++ b/lib/resource-1.0/swedish/NumeralSwe.gf @@ -1,4 +1,4 @@ -concrete NumeralSwe of Numeral = CatSwe ** open ResScand, MorphoSwe in { +concrete NumeralSwe of Numeral = CatSwe ** open ResSwe, MorphoSwe in { lincat Digit = {s : DForm => CardOrd => Str} ; diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs index f7d6c87d1..d5561fcc6 100644 --- a/src/GF/Compile/Rename.hs +++ b/src/GF/Compile/Rename.hs @@ -39,6 +39,7 @@ import GF.Compile.Extend import GF.Data.Operations import Control.Monad +import Data.List (nub) renameGrammar :: SourceGrammar -> Err SourceGrammar renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g) @@ -69,12 +70,22 @@ renameIdentTerm :: Status -> Term -> Err Term renameIdentTerm env@(act,imps) t = errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $ case t of - Vr c -> do - f <- err (predefAbs c) return $ lookupTreeMany prt opens c - return $ f c - Cn c -> do - f <- lookupTreeMany prt opens c - return $ f c + Vr c -> case lookupTree prt c act of + Ok f -> return $ f c + _ -> case lookupTreeManyAll prt opens c of + [f] -> return $ f c + [] -> predefAbs c ("constant not found:" +++ prt c) + fs -> case nub [f c | f <- fs] of + [tr] -> return tr + ts -> Bad $ "conflicting imports:" +++ unwords (map prt ts) + Cn c -> case lookupTree prt c act of + Ok f -> return $ f c + _ -> case lookupTreeManyAll prt opens c of + [f] -> return $ f c + [] -> Bad ("constant not found:" +++ prt c) + fs -> case nub [f c | f <- fs] of + [tr] -> return tr + ts -> Bad $ "conflicting imports:" +++ unwords (map prt ts) Q m' c | m' == cPredef {- && isInPredefined c -} -> return t Q m' c -> do m <- lookupErr m' qualifs @@ -87,15 +98,15 @@ renameIdentTerm env@(act,imps) t = return $ f c _ -> return t where - opens = act : [st | (OSimple _ _,st) <- imps] + opens = [st | (OSimple _ _,st) <- imps] qualifs = [(m, st) | (OQualif _ m _, st) <- imps] ++ [(m, st) | (OSimple _ m, st) <- imps] -- qualif is always possible -- this facility is mainly for BWC with GF1: you need not import PredefAbs predefAbs c s = case c of - IC "Int" -> return $ const $ Q cPredefAbs cInt - IC "Float" -> return $ const $ Q cPredefAbs cFloat - IC "String" -> return $ const $ Q cPredefAbs cString + IC "Int" -> return $ Q cPredefAbs cInt + IC "Float" -> return $ Q cPredefAbs cFloat + IC "String" -> return $ Q cPredefAbs cString _ -> Bad s --- | would it make sense to optimize this by inlining? @@ -124,7 +135,7 @@ buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status buildStatus gr c mo = let mo' = self2status c mo in case mo of ModMod m -> do let gr1 = MGrammar $ (c,mo) : modules gr - ops = [OSimple OQNormal e | e <- allExtendsPlus gr1 c] ++ allOpens m + ops = [OSimple OQNormal e | e <- allExtends gr1 c] ++ allOpens m mods <- mapM (lookupModule gr1 . openedModule) ops let sts = map modInfo2status $ zip ops mods return $ if isModCnc m diff --git a/src/GF/Data/Operations.hs b/src/GF/Data/Operations.hs index ac1ec85bb..c6def01a8 100644 --- a/src/GF/Data/Operations.hs +++ b/src/GF/Data/Operations.hs @@ -34,7 +34,7 @@ module GF.Data.Operations (-- * misc functions -- * binary search trees; now with FiniteMap BinTree, emptyBinTree, isInBinTree, justLookupTree, - lookupTree, lookupTreeMany, updateTree, + lookupTree, lookupTreeMany, lookupTreeManyAll, updateTree, buildTree, filterBinTree, sorted2tree, mapTree, mapMTree, tree2list, @@ -318,6 +318,12 @@ lookupTreeMany pr (t:ts) x = case lookupTree pr x t of _ -> lookupTreeMany pr ts x lookupTreeMany pr [] x = Bad $ "failed to find" +++ pr x +lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b] +lookupTreeManyAll pr (t:ts) x = case lookupTree pr x t of + Ok v -> v : lookupTreeManyAll pr ts x + _ -> lookupTreeManyAll pr ts x +lookupTreeManyAll pr [] x = [] + -- | destructive update updateTree :: (Ord a) => (a,b) -> BinTree a b -> BinTree a b -- updateTree (a,b) tr = addToFM tr a b