diff options
| -rw-r--r-- | src/GF/Grammar/Lookup.hs | 31 | ||||
| -rw-r--r-- | src/GF/Shell.hs | 10 |
2 files changed, 27 insertions, 14 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 --- + ] diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 6aca6ff09..d20601844 100644 --- a/src/GF/Shell.hs +++ b/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 |