1
0
forked from GitHub/gf-core
This commit is contained in:
aarne
2005-10-27 12:21:53 +00:00
parent 9dfa8a5032
commit c9977d50bf
2 changed files with 27 additions and 14 deletions

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/10/27 13:21:53 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.14 $ -- > CVS $Revision: 1.15 $
-- --
-- Lookup in source (concrete and resource) when compiling. -- Lookup in source (concrete and resource) when compiling.
-- --
@@ -173,10 +173,23 @@ lookupLincat gr m c = do
_ -> Bad $ prt m +++ "is not concrete" _ -> Bad $ prt m +++ "is not concrete"
opersForType :: SourceGrammar -> Type -> [(QIdent,Term)] -- The first type argument is uncomputed, usually a category symbol.
opersForType gr val = -- This is a hack to find implicit (= reused) opers.
[((i,f),ty) | (i,m) <- allModMod gr,
(f,ResOper (Yes ty) _) <- tree2list $ jments m, opersForType :: SourceGrammar -> Type -> Type -> [(QIdent,Term)]
Ok valt <- [valTypeCnc ty], opersForType gr orig val =
valt == 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 ---
]

View File

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