GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

checking name conflicts; some RGs don't work now

Browse Source
This commit is contained in:
aarne
2007-06-17 21:56:27 +00:00
parent adf0f8e83e
commit 3adf824e8e
13 changed files with 101 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/prelude/Coordination.gf
View File

@@ -4,8 +4,6 @@ param
ListSize = TwoElem | ManyElem ;
oper
SS = {s : Str} ; ----
ListX = {s1,s2 : Str} ;
twoStr : (x,y : Str) -> ListX = \x,y ->

10
lib/resource-1.0/english/CatEng.gf
View File

@@ -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 ;

34
lib/resource-1.0/english/LexiconEng.gf
View File

@@ -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 ;

8
lib/resource-1.0/finnish/CatFin.gf
View File

@@ -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

6
lib/resource-1.0/finnish/NumeralFin.gf
View File

@@ -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" ;

3
lib/resource-1.0/finnish/ParadigmsFin.gf
View File

@@ -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 ;

24
lib/resource-1.0/finnish/StructuralFin.gf
View File

@@ -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 <n,c> of {
<Sg,Nom> => "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" ;

26
lib/resource-1.0/italian/LexiconIta.gf
View File

@@ -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") ;

8
lib/resource-1.0/scandinavian/CatScand.gf
View File

@@ -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

18
lib/resource-1.0/swedish/IdiomSwe.gf
View File

@@ -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 ;

2
lib/resource-1.0/swedish/NumeralSwe.gf
View File

@@ -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} ;

33
src/GF/Compile/Rename.hs
View File

@@ -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

8
src/GF/Data/Operations.hs
View File

@@ -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