From a786f1c80913c6df64292caad258d7daca4b03da Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 28 Feb 2011 13:31:04 +0000 Subject: [PATCH] the command show_operations to inspect opers in scope --- src/compiler/GF/Command/Commands.hs | 23 +++++++++++++++ src/compiler/GF/Grammar/Lookup.hs | 40 ++++++++++++++++++++++++- src/compiler/GF/Grammar/Macros.hs | 1 + src/compiler/GFI.hs | 46 ++++++++++++++++++++++------- 4 files changed, 98 insertions(+), 12 deletions(-) diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index f7a34ee27..0161818f8 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -781,6 +781,29 @@ allCommands env@(pgf, mos) = Map.fromList [ "gt | l | sp -command=\"grep \\\"who\\\"\" | sp -command=\"wc\"" ] }), + + ("so", emptyCommandInfo { + longname = "show_operations", + syntax = "so (-grep=STRING)* TYPE?", + synopsis = "show all operations in scope, possibly restricted to a value type", + explanation = unlines [ + "Show the names and type signatures of all operations available in the current resource.", + "This command requires a source grammar to be in scope, imported with 'import -retain'.", + "The operations include the parameter constructors that are in scope.", + "The optional TYPE filters according to the value type.", + "The grep STRINGs filter according to other substrings of the type signatures.", + "This command must be a line of its own, and thus cannot be a part", + "of a pipe." + ], + flags = [ + ("grep","substring used for filtering (the command can have many of these)") + ], + options = [ + ("raw","show the types in computed forms (instead of category names)") + ], + needsTypeCheck = False + }), + ("ut", emptyCommandInfo { longname = "unicode_table", synopsis = "show a transliteration table for a unicode character set", diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs index 80dabef1b..b5959cf03 100644 --- a/src/compiler/GF/Grammar/Lookup.hs +++ b/src/compiler/GF/Grammar/Lookup.hs @@ -28,7 +28,8 @@ module GF.Grammar.Lookup ( lookupAbsDef, lookupLincat, lookupFunType, - lookupCatContext + lookupCatContext, + allOpers, allOpersTo ) where import GF.Data.Operations @@ -43,6 +44,7 @@ import GF.Grammar.Lockfield import Data.List (nub,sortBy) import Control.Monad import Text.PrettyPrint +import qualified Data.Map as Map -- whether lock fields are added in reuse lock c = lockRecType c -- return @@ -189,3 +191,39 @@ lookupCatContext gr m c = do AbsCat (Just (L _ co)) -> return co AnyInd _ n -> lookupCatContext gr n c _ -> Bad (render (text "unknown category" <+> ppIdent c)) + + +-- this gives all opers and param constructors, also overloaded opers and funs, and the types, and locations +-- notice that it only gives the modules that are reachable and the opers that are included + +allOpers :: SourceGrammar -> [((Ident,Ident),Type,(Int,Int))] +allOpers gr = + [((mo,op),typ,loc) | + (mo,minc) <- reachable, + Ok minfo <- [lookupModule gr mo], + (op,info) <- Map.toList $ jments minfo, + isInherited minc op, + L loc typ <- typesIn info + ] + where + typesIn info = case info of + AbsFun (Just ltyp) _ _ _ -> [ltyp] + ResOper (Just ltyp) _ -> [ltyp] + ResValue ltyp -> [ltyp] + ResOverload _ tytrs -> [ltyp | (ltyp,_) <- tytrs] + _ -> [] + reachable = case greatestResource gr of + Just r -> allExtendSpecs gr r + _ -> [] + +--- not for dependent types +allOpersTo :: SourceGrammar -> Type -> [((Ident,Ident),Type,(Int,Int))] +allOpersTo gr ty = [op | op@(_,typ,_) <- allOpers gr, isProdTo ty typ] where + isProdTo t typ = eqProd typ t || case typ of + Prod _ _ a b -> isProdTo t b + _ -> False + eqProd f g = case (f,g) of + (Prod _ _ a1 b1, Prod _ _ a2 b2) -> eqProd a1 a2 && eqProd b1 b2 + _ -> f == g + + diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs index b40041e83..fb9979c31 100644 --- a/src/compiler/GF/Grammar/Macros.hs +++ b/src/compiler/GF/Grammar/Macros.hs @@ -621,6 +621,7 @@ allDependencies ism b = opty _ = [] pts i = case i of ResOper pty pt -> [pty,pt] +--- ResOverload _ tyts -> concat [[Just ty, Just tr] | (ty,tr) <- tyts] ResParam (Just ps) _ -> [Just (L loc t) | L loc (_,cont) <- ps, (_,_,t) <- cont] CncCat pty _ _ -> [pty] CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type)) diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs index 665d843cb..a7ae2d07c 100644 --- a/src/compiler/GFI.hs +++ b/src/compiler/GFI.hs @@ -7,13 +7,14 @@ import GF.Command.Commands import GF.Command.Abstract import GF.Command.Parse import GF.Data.ErrM -import GF.Data.Operations (chunks) +import GF.Data.Operations (chunks,err) import GF.Grammar hiding (Ident) import GF.Grammar.Parser (runP, pExp) import GF.Grammar.ShowTerm +import GF.Grammar.Lookup (allOpers,allOpersTo) import GF.Compile.Rename import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError) -import GF.Compile.TypeCheck.Concrete (inferLType) +import GF.Compile.TypeCheck.Concrete (inferLType,ppType) import GF.Infra.Dependencies import GF.Infra.CheckM import GF.Infra.UseIO @@ -30,7 +31,7 @@ import PGF.Macros import Data.Char import Data.Maybe -import Data.List(isPrefixOf) +import Data.List(isPrefixOf,isInfixOf,partition) import qualified Data.Map as Map import qualified Data.ByteString.Char8 as BS import qualified Text.ParserCombinators.ReadP as RP @@ -41,6 +42,7 @@ import System.Directory import Control.Exception import Control.Monad import Data.Version +import Text.PrettyPrint (render) import GF.System.Signal --import System.IO.Error (try) #ifdef mingw32_HOST_OS @@ -120,19 +122,34 @@ loop opts gfenv0 = do (style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0)) - checkComputeTerm gr (L _ t) = do - mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr - ((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t - inferLType gr [] t - t1 <- computeConcrete sgr t - checkPredefError sgr t1 - case runP pExp (encodeUnicode utf8 s) of Left (_,msg) -> putStrLn msg - Right t -> case checkComputeTerm sgr (codeTerm (decodeUnicode utf8 . BS.pack) (L (0,0) t)) of + Right t -> case checkComputeTerm sgr (unLoc (codeTerm (decodeUnicode utf8 . BS.pack) (L (0,0) t))) of Ok x -> putStrLn $ showTerm sgr style q x Bad s -> putStrLn $ s loopNewCPU gfenv + + "so":ws -> case greatestResource sgr of + Nothing -> putStrLn "no source grammar in scope" >> loopNewCPU gfenv + Just mo -> do + let (os,ts) = partition (isPrefixOf "-") ws + let greps = [drop 6 o | o <- os, take 6 o == "-grep="] + let isRaw = elem "-raw" os + ops <- case ts of + _:_ -> do + let Right t = runP pExp (encodeUnicode utf8 (unwords ts)) + ty <- err error return $ checkComputeTerm sgr t + return $ allOpersTo sgr ty + _ -> return $ allOpers sgr + let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops] + let printer = if isRaw + then showTerm sgr TermPrintDefault Qualified + else (render . GF.Compile.TypeCheck.Concrete.ppType) + let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs] + mapM_ putStrLn [l | l <- printed, all (flip isInfixOf l) greps] + loopNewCPU gfenv + + "dg":ws -> do let stop = case ws of ('-':'o':'n':'l':'y':'=':fs):_ -> Just $ chunks ',' fs @@ -206,6 +223,13 @@ loop opts gfenv0 = do gfenv' <- either (\e -> (print e >> return gfenv)) return r loop opts gfenv' +checkComputeTerm sgr t = do + mo <- maybe (Bad "no source grammar in scope") return $ greatestResource sgr + ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t + inferLType sgr [] t + t1 <- computeConcrete sgr t + checkPredefError sgr t1 + fetchCommand :: GFEnv -> IO String fetchCommand gfenv = do path <- getAppUserDataDirectory "gf_history"