so

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 ---
+        ]

src/GF/Shell.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/06 14:21:34 $ 
+-- > CVS $Date: 2005/10/27 13:21:53 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.45 $
+-- > CVS $Revision: 1.46 $
 --
 -- GF shell command interpreter.
 -----------------------------------------------------------------------------
@@ -286,9 +286,9 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
            maybe (resourceOfShellState st) (return . I.identC) $ -- topmost res
              getOptVal opts useResource             -- flag -res=m
     justOutput opts (putStrLn (err id (unlines . map prOperSignature) (
-                string2srcTerm src m t >>= 
-                Co.computeConcrete src >>= 
-                return . L.opersForType src))) sa
+                string2srcTerm src m t >>= (\t' -> 
+                Co.computeConcrete src t' >>=  (\v -> 
+                return (L.opersForType src t' v)))))) sa
 
 
   CTranslationQuiz il ol -> do