diff options
Diffstat (limited to 'src/GF/Grammar')
| -rw-r--r-- | src/GF/Grammar/Lookup.hs | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs index a634bdfc6..57806fc05 100644 --- a/src/GF/Grammar/Lookup.hs +++ b/src/GF/Grammar/Lookup.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/28 16:42:48 $ +-- > CVS $Date: 2005/10/27 13:21:53 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.14 $ +-- > CVS $Revision: 1.15 $ -- -- Lookup in source (concrete and resource) when compiling. -- @@ -173,10 +173,23 @@ lookupLincat gr m c = do _ -> Bad $ prt m +++ "is not concrete" -opersForType :: SourceGrammar -> Type -> [(QIdent,Term)] -opersForType gr val = - [((i,f),ty) | (i,m) <- allModMod gr, - (f,ResOper (Yes ty) _) <- tree2list $ jments m, - Ok valt <- [valTypeCnc ty], - valt == val - ] +-- The first type argument is uncomputed, usually a category symbol. +-- This is a hack to find implicit (= reused) opers. + +opersForType :: SourceGrammar -> Type -> Type -> [(QIdent,Term)] +opersForType gr orig val = + [((i,f),ty) | (i,m) <- allModMod gr, (f,ty) <- opers i m val] where + opers i m val = + [(f,ty) | + (f,ResOper (Yes ty) _) <- tree2list $ jments m, + Ok valt <- [valTypeCnc ty], + elem valt [val,orig] + ] ++ + let cat = err zIdent snd (valCat orig) in --- ignore module + [(f,ty) | + Ok a <- [abstractOfConcrete gr i >>= lookupModMod gr], + (f, AbsFun (Yes ty0) _) <- tree2list $ jments a, + let ty = redirectTerm i ty0, + Ok valt <- [valCat ty], + cat == snd valt --- + ] |