summaryrefslogtreecommitdiff
path: root/src/GF/Grammar
diff options
context:
space:
mode:
authoraarne <unknown>2005-10-27 12:21:53 +0000
committeraarne <unknown>2005-10-27 12:21:53 +0000
commitc9977d50bf23bfc06c741cd599505c8a76059020 (patch)
tree87bf3852ea45ca7f3f0c9f8cc9dbad4a5037201d /src/GF/Grammar
parent9dfa8a5032034a26f2f40c72ecf0744bf959c605 (diff)
so
Diffstat (limited to 'src/GF/Grammar')
-rw-r--r--src/GF/Grammar/Lookup.hs31
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 ---
+ ]