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

normalize record types in overload resolution

Browse Source
This commit is contained in:
aarne
2006-11-18 20:54:10 +00:00
parent 9d3fd3c9cf
commit 8a55561cbf
2 changed files with 21 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
lib/resource-1.0/common/Overload.gf
View File

@@ -17,21 +17,22 @@ incomplete resource Overload = open Grammar in {
mod = overload { mod = overload {
mod : A -> N -> CN mod : A -> N -> CN
= \a,n -> AdjCN (PositA a) (UseN n) ; = \a,n -> AdjCN (PositA a) (UseN n) ;
mod : AP -> N -> CN mod : AP -> N -> CN
= \a,n -> AdjCN a (UseN n) ; = \a,n -> AdjCN a (UseN n) ;
mod : AP -> CN -> CN mod : AP -> CN -> CN
= \a,n -> AdjCN a n ; = \a,n -> AdjCN a n ;
mod : AdA -> A -> AP mod : AdA -> A -> AP
= \m,a -> AdAP m (PositA a) ; = \m,a -> AdAP m (PositA a) ;
mod : Quant -> N -> NP mod : Quant -> N -> NP
= \q,n -> DetCN (DetSg (SgQuant q) NoOrd) = \q,n -> DetCN (DetSg (SgQuant q)
(UseN n) ; NoOrd) (UseN n) ;
mod : Quant -> CN -> NP mod : Quant -> CN -> NP
= \q,n -> DetCN (DetSg (SgQuant q) NoOrd) n ; = \q,n -> DetCN (DetSg
(SgQuant q) NoOrd) n ;
mod : Predet -> N -> NP mod : Predet -> N -> NP
= \q,n -> PredetNP q (DetCN (DetPl = \q,n -> PredetNP q (DetCN (DetPl
(PlQuant IndefArt) NoNum NoOrd) (UseN n)) ; (PlQuant IndefArt) NoNum NoOrd) (UseN n)) ;
mod : Num -> N -> NP mod : Num -> N -> NP
= \nu,n -> DetCN (DetPl (PlQuant = \nu,n -> DetCN (DetPl (PlQuant
IndefArt) nu NoOrd) (UseN n) IndefArt) nu NoOrd) (UseN n)

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

@@ -339,9 +339,13 @@ computeLType gr t = do
r' <- comp r r' <- comp r
s' <- comp s s' <- comp s
case (r',s') of case (r',s') of
(RecType rs, RecType ss) -> checkErr $ plusRecType r' s' (RecType rs, RecType ss) -> checkErr (plusRecType r' s') >>= comp
_ -> return $ ExtR r' s' _ -> return $ ExtR r' s'
RecType fs -> do
let fs' = sortBy (\x y -> compare (fst x) (fst y)) fs
liftM RecType $ mapPairsM comp fs'
_ | isPredefConstant ty -> return ty _ | isPredefConstant ty -> return ty
_ -> composOp comp ty _ -> composOp comp ty
@@ -585,8 +589,8 @@ inferLType gr trm = case trm of
_ -> raise $ "no overload instance of" +++ prt f +++ _ -> raise $ "no overload instance of" +++ prt f +++
"for" +++ unwords (map prtType tys) +++ "among" ++++ "for" +++ unwords (map prtType tys) +++ "among" ++++
unlines [unwords (map prtType ty) | (ty,_) <- typs] unlines [unwords (map prtType ty) | (ty,_) <- typs]
++++ "DEBUG" +++ unwords (map show tys) +++ ";" ++++ ++++ "DEBUG" +++ unwords (map show tys) +++ ";"
unlines (map (show . fst) typs) ---- ++++ unlines (map (show . fst) typs) ----
lookupOverloadInstance tys typs = lookup tys typs ---- use Map lookupOverloadInstance tys typs = lookup tys typs ---- use Map
@@ -822,8 +826,10 @@ checkEqLType env t u trm = do
checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo) checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo)
return t' return t'
Bad s -> raise (s +++ "type of" +++ prt trm +++ Bad s -> raise (s +++ "type of" +++ prt trm +++
": expected" ++++ prtType t' ++++ ": expected:" +++ prtType t' ++++
"inferred" ++++ prtType u' ++++ show u') "inferred:" +++ prtType u'
---- +++++ "DEBUG:" ++++ show t' ++++ show u'
)
where where
-- t is a subtype of u -- t is a subtype of u