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

record extension typs checking fixed

Browse Source
This commit is contained in:
aarne
2005-04-25 17:19:32 +00:00
parent 6c9c095c9a
commit e601bc4e43
9 changed files with 31 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
lib/resource/danish/SyntaxDan.gf
View File

@@ -113,9 +113,7 @@ instance SyntaxDan of SyntaxScand = TypesDan **
progressiveClause : NounPhrase -> VerbPhrase -> Clause = \np,vp ->
predVerbGroupClause np
(complVerbVerb
(verbVara **
{isAux = False} ----- {s3 = ["ved at"]}
)
{s = verbVara.s ; s1 = "ved" ; isAux = False}
vp) ;
}

1
lib/resource/english/CategoriesEng.gf
View File

@@ -68,6 +68,7 @@ lincat
V2S = TransVerb ;
V2Q = TransVerb ;
V2V = TransVerb ** {s4 : Str} ;
----V2V = {s : VForm => Str ; s1 : Particle ; s3, s4 : Str} ;
V2A = TransVerb ;
V0 = Verb ;

2
lib/resource/english/RulesEng.gf
View File

@@ -86,7 +86,7 @@ lin
AdjPart = adjPastPart ;
UseV2V x = x ** {isAux = False} ;
UseV2V x = verb2aux x ** {isAux = False} ;
UseV2S x = x ;
UseV2Q x = x ;
UseA2S x = x ;

2
lib/resource/french/ParadigmsFre.gf
View File

@@ -329,7 +329,7 @@ oper
mkV0 v = v ** {lock_V0 = <>} ;
mkVS v = v ** {mn,mp = Ind ; lock_VS = <>} ; ---- more moods
mkV2S v p = mkV2 v p ** {mn,mp = Ind ; lock_V2S = <>} ;
mkVV v = v ** {c = accusative ; lock_VV = <>} ;
mkVV v = v ** {c = accusative.p1 ; lock_VV = <>} ;
deVV v = v ** {c = genitive.p1 ; lock_VV = <>} ;
aVV v = v ** {c = dative.p1 ; lock_VV = <>} ;
mkV2V v p t = mkV2 v p ** {c3 = t.p1 ; s3 = p.p2 ; lock_V2V = <>} ;

2
lib/resource/italian/ParadigmsIta.gf
View File

@@ -347,7 +347,7 @@ oper
mkV0 v = v ** {lock_V0 = <>} ;
mkVS v = v ** {mn,mp = Ind ; lock_VS = <>} ; ---- more moods
mkV2S v p = mkV2 v p ** {mn,mp = Ind ; lock_V2S = <>} ;
mkVV v = v ** {c = accusative ; lock_VV = <>} ;
mkVV v = v ** {c = accusative.p1 ; lock_VV = <>} ;
deVV v = v ** {c = genitive.p1 ; lock_VV = <>} ;
aVV v = v ** {c = dative.p1 ; lock_VV = <>} ;
mkV2V v p t = mkV2 v p ** {c3 = t.p1 ; s3 = p.p2 ; lock_V2V = <>} ;

4
lib/resource/norwegian/SyntaxNor.gf
View File

@@ -114,8 +114,6 @@ instance SyntaxNor of SyntaxScand = TypesNor **
progressiveClause : NounPhrase -> VerbPhrase -> Clause = \np,vp ->
predVerbGroupClause np
(complVerbVerb
(verbVara **
{isAux = False} ----- {s3 = ["ved at"]}
)
({s = verbVara.s ; s1 = "ved" ; isAux = False})
vp) ;
}

6
lib/resource/scandinavian/SyntaxScand.gf
View File

@@ -637,7 +637,7 @@ oper
mkVerbGroupCopula : (Gender => Number => Person => Str) -> VerbGroup =
\obj ->
mkVerbGroupObject (verbVara ** {s1 = []}) obj ;
mkVerbGroupObject verbVara obj ;
-----------------------
@@ -688,7 +688,7 @@ oper
-- on semantic grounds.
vara : (Gender => Number => Person => Str) -> VerbGroup =
useVerb (verbVara ** {s1 = []}) ;
useVerb verbVara ;
predAdjective : Adjective -> VerbGroup = \arg ->
vara (\\g,n,_ => arg.s ! predFormAdj g n ! Nom) ;
@@ -1016,7 +1016,7 @@ oper
insertObject (mkSats subj verb) obj ;
mkSatsCopula : NounPhrase -> Str -> Sats = \subj,obj ->
mkSatsObject subj (verbVara ** {s1 = []}) obj ;
mkSatsObject subj verbVara obj ;
--3 Sentence-complement verbs

2
lib/resource/spanish/ParadigmsSpa.gf
View File

@@ -338,7 +338,7 @@ oper
mkV0 v = v ** {lock_V0 = <>} ;
mkVS v = v ** {mn,mp = Ind ; lock_VS = <>} ; ---- more moods
mkV2S v p = mkV2 v p ** {mn,mp = Ind ; lock_V2S = <>} ;
mkVV v = v ** {c = accusative ; lock_VV = <>} ;
mkVV v = v ** {c = accusative.p1 ; lock_VV = <>} ;
deVV v = v ** {c = genitive.p1 ; lock_VV = <>} ;
aVV v = v ** {c = dative.p1 ; lock_VV = <>} ;
mkV2V v p t = mkV2 v p ** {c3 = t.p1 ; s3 = p.p2 ; lock_V2V = <>} ;

41
src/GF/Compile/CheckGrammar.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:21:34 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.23 $
-- > CVS $Date: 2005/04/25 18:19:32 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.24 $
--
-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
--
@@ -429,7 +429,7 @@ inferLType gr trm = case trm of
case (rT', sT') of
(RecType rs, RecType ss) -> do
rt <- checkErr $ plusRecType rT' sT'
return (trm', rt)
check trm' rt ---- return (trm', rt)
_ | rT' == typeType && sT' == typeType -> return (trm', typeType)
_ -> prtFail "records or record types expected in" trm
@@ -543,21 +543,21 @@ checkLType env trm typ0 = do
case trm' of
RecType _ -> termWith trm $ return typeType
_ -> prtFail "invalid record type extension" trm
RecType rr -> checks [
do (r',ty) <- infer r
case ty of
RecType rr1 -> do
s' <- justCheck s (minusRecType rr rr1)
return $ (ExtR r' s', typ)
_ -> prtFail "record type expected in extension of" r
,
do (s',ty) <- infer s
case ty of
RecType rr2 -> do
r' <- justCheck r (minusRecType rr rr2)
return $ (ExtR r' s', typ)
_ -> prtFail "record type expected in extension with" s
]
RecType rr -> do
(r',ty,s') <- checks [
do (r',ty) <- infer r
return (r',ty,s)
,
do (s',ty) <- infer s
return (s',ty,r)
]
case ty of
RecType rr1 -> do
let (rr0,rr2) = recParts rr rr1
r2 <- justCheck r' rr0
s2 <- justCheck s' rr2
return $ (ExtR r2 s2, typ)
_ -> raise ("record type expected in extension of" +++ prt r +++ "but found" +++ prt ty)
_ -> prtFail "record extension not meaningful for" typ
FV vs -> do
@@ -600,7 +600,8 @@ checkLType env trm typ0 = do
checkEq = checkEqLType env
minusRecType rr rr1 = RecType [(l,v) | (l,v) <- rr, notElem l (map fst rr1)]
recParts rr t = (RecType rr1,RecType rr2) where
(rr1,rr2) = partition (flip elem (map fst t) . fst) rr
checkM rms (l,ty) = case lookup l rms of
Just (Just ty0,t) -> do