1
0
forked from GitHub/gf-core

the command show_operations to inspect opers in scope

This commit is contained in:
aarne
2011-02-28 13:31:04 +00:00
parent 66f95c2cb7
commit 0dfbc9b730
4 changed files with 98 additions and 12 deletions

View File

@@ -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",

View File

@@ -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

View File

@@ -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))

View File

@@ -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"