GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 18:02:54 -06:00
Code Issues Packages Projects Releases Wiki Activity

fix in etaexpand optimization

Browse Source
This commit is contained in:
aarne
2007-01-11 11:42:39 +00:00
parent 575a49620f
commit 2f9319d7fd
2 changed files with 6 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/resource-1.0/finnish/ExtraFin.gf
View File

@@ -35,7 +35,7 @@ concrete ExtraFin of ExtraFinAbs = CatFin ** open ResFin, MorphoFin, Coordinatio
i_implicPron = mkPronoun [] "minun" "minua" "minuna" "minuun" Sg P1 ; i_implicPron = mkPronoun [] "minun" "minua" "minuna" "minuun" Sg P1 ;
whatPart_IP = { whatPart_IP = {
s = table { s = table {
NPCase Nom | NPAcc => "mitä" ; NPCase Nom | NPAcc => "mitä" ;
c => whatSg_IP.s ! c c => whatSg_IP.s ! c
} ; } ;
n = Sg n = Sg

6
src/GF/Compile/Optimize.hs
View File

@@ -167,8 +167,12 @@ partEval opts gr (context, val) trm = errIn ("parteval" +++ prt_ trm) $ do
etaExpand su t = do etaExpand su t = do
t' <- comp su t t' <- comp su t
case t' of case t' of
R _ -> comp su t' --- return t' wo noexpand... R _ | rightType t' -> comp su t' --- return t' wo noexpand...
_ -> recordExpand val t' >>= comp su _ -> recordExpand val t' >>= comp su
-- don't eta expand records of right length (correct by type checking)
rightType t = case (t,val) of
(R rs, RecType ts) -> length rs == length ts
_ -> False
outCase subst t = do outCase subst t = do
pts <- getParams context pts <- getParams context