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

fix in CheckGrammar case exprs

Browse Source
This commit is contained in:
aarne
2005-05-09 08:45:23 +00:00
parent 73df27b409
commit 31873d5092
3 changed files with 14 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
examples/gfcc/ResImper.gf
View File

@@ -12,7 +12,7 @@ resource ResImper = open Predef in {
{s = f ; p = p ; a = a} ; {s = f ; p = p ; a = a} ;
usePrec : PrecExp -> Prec -> Str = \x,p -> usePrec : PrecExp -> Prec -> Str = \x,p ->
case <<x.p,p> : Prec * Prec> of { case <x.p,p> of {
<3,4> | <2,3> | <2,4> => paren x.s ; <3,4> | <2,3> | <2,4> => paren x.s ;
<1,1> | <1,0> | <0,0> => x.s ; <1,1> | <1,0> | <0,0> => x.s ;
<1,_> | <0,_> => paren x.s ; <1,_> | <0,_> => paren x.s ;

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

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/28 16:42:48 $ -- > CVS $Date: 2005/05/09 09:45:23 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.25 $ -- > CVS $Revision: 1.26 $
-- --
-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003 -- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
-- --
@@ -565,7 +565,7 @@ checkLType env trm typ0 = do
--- checkIfComplexVariantType trm typ --- checkIfComplexVariantType trm typ
return (FV (map fst ttys), typ) --- typ' ? return (FV (map fst ttys), typ) --- typ' ?
S tab arg -> do S tab arg -> checks [ do
(tab',ty) <- infer tab (tab',ty) <- infer tab
ty' <- comp ty ty' <- comp ty
case ty' of case ty' of
@@ -574,7 +574,12 @@ checkLType env trm typ0 = do
checkEq typ t trm checkEq typ t trm
return (S tab' arg', t) return (S tab' arg', t)
_ -> prtFail "table type expected for applied table instead of" ty' _ -> prtFail "table type expected for applied table instead of" ty'
, do
(arg',ty) <- infer arg
ty' <- comp ty
(tab',_) <- check tab (Table ty' typ)
return (S tab' arg', typ)
]
Let (x,(mty,def)) body -> case mty of Let (x,(mty,def)) body -> case mty of
Just ty -> do Just ty -> do
(def',ty') <- check def ty (def',ty') <- check def ty

7
src/GF/Grammar/Compute.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:22:19 $ -- > CVS $Date: 2005/05/09 09:45:23 $
-- > CVS $Author: bringert $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.15 $ -- > CVS $Revision: 1.16 $
-- --
-- Computation of source terms. Used in compilation and in @cc@ command. -- Computation of source terms. Used in compilation and in @cc@ command.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -168,6 +168,7 @@ computeTerm gr = comp where
(Empty,_) -> return y (Empty,_) -> return y
(K a, K b) -> return $ K (a ++ b) (K a, K b) -> return $ K (a ++ b)
(K a, Alts (d,vs)) -> do (K a, Alts (d,vs)) -> do
---- (_, Alts (d,vs)) -> do
let glx = Glue x let glx = Glue x
comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs]) comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs])
(Alts _, K a) -> checks [do (Alts _, K a) -> checks [do