forked from GitHub/gf-core
added command ai which prints information about given identifier
This commit is contained in:
@@ -35,6 +35,7 @@ import GF.Text.Coding
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import System.Cmd
|
import System.Cmd
|
||||||
|
import Text.PrettyPrint
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
@@ -586,6 +587,30 @@ allCommands cod env@(pgf, mos) = Map.fromList [
|
|||||||
("append","append to file, instead of overwriting it")
|
("append","append to file, instead of overwriting it")
|
||||||
],
|
],
|
||||||
flags = [("file","the output filename")]
|
flags = [("file","the output filename")]
|
||||||
|
}),
|
||||||
|
("ai", emptyCommandInfo {
|
||||||
|
longname = "abstract_info",
|
||||||
|
syntax = "ai IDENTIFIER",
|
||||||
|
synopsis = "provides an information about a function or a category from the abstract syntax",
|
||||||
|
explanation = unlines [
|
||||||
|
"The command has one argument which is either function or a category defined in",
|
||||||
|
"the abstract syntax of the current grammar. If the argument is a function then",
|
||||||
|
"its type is printed out. If it is a category then the category definition is printed"
|
||||||
|
],
|
||||||
|
exec = \opts arg -> do
|
||||||
|
case arg of
|
||||||
|
[Fun id []] -> case Map.lookup id (funs (abstract pgf)) of
|
||||||
|
Just (ty,def) -> putStrLn (render (text "fun" <+> text (prCId id) <+> colon <+> ppType 0 ty $$
|
||||||
|
if def == EEq []
|
||||||
|
then empty
|
||||||
|
else text "def" <+> text (prCId id) <+> char '=' <+> ppExpr 0 def))
|
||||||
|
Nothing -> case Map.lookup id (cats (abstract pgf)) of
|
||||||
|
Just hyps -> putStrLn (render (text "cat" <+>
|
||||||
|
text (prCId id) <+>
|
||||||
|
hsep (map ppHypo hyps)))
|
||||||
|
Nothing -> putStrLn "unknown identifier"
|
||||||
|
_ -> putStrLn "a single identifier is expected from the command"
|
||||||
|
return void
|
||||||
})
|
})
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
module PGF.Type ( Type(..), Hypo(..),
|
module PGF.Type ( Type(..), Hypo(..),
|
||||||
readType, showType,
|
readType, showType,
|
||||||
pType, ppType ) where
|
pType, ppType, ppHypo ) where
|
||||||
|
|
||||||
import PGF.CId
|
import PGF.CId
|
||||||
import PGF.Expr
|
import PGF.Expr
|
||||||
@@ -67,12 +67,13 @@ ppType d (DTyp ctxt cat args)
|
|||||||
| null ctxt = ppRes cat args
|
| null ctxt = ppRes cat args
|
||||||
| otherwise = ppParens (d > 0) (foldr ppCtxt (ppRes cat args) ctxt)
|
| otherwise = ppParens (d > 0) (foldr ppCtxt (ppRes cat args) ctxt)
|
||||||
where
|
where
|
||||||
ppCtxt (Hyp x typ) doc
|
ppCtxt hyp doc = ppHypo hyp PP.<+> PP.text "->" PP.<+> doc
|
||||||
| x == wildCId = ppType 1 typ PP.<+> PP.text "->" PP.<+> doc
|
|
||||||
| otherwise = PP.parens (PP.text (prCId x) PP.<+> PP.char ':' PP.<+> ppType 0 typ) PP.<+> PP.text "->" PP.<+> doc
|
|
||||||
|
|
||||||
ppRes cat es = PP.text (prCId cat) PP.<+> PP.hsep (map (ppExpr 2) es)
|
ppRes cat es = PP.text (prCId cat) PP.<+> PP.hsep (map (ppExpr 2) es)
|
||||||
|
|
||||||
|
ppHypo (Hyp x typ)
|
||||||
|
| x == wildCId = ppType 1 typ
|
||||||
|
| otherwise = PP.parens (PP.text (prCId x) PP.<+> PP.char ':' PP.<+> ppType 0 typ)
|
||||||
|
|
||||||
ppParens :: Bool -> PP.Doc -> PP.Doc
|
ppParens :: Bool -> PP.Doc -> PP.Doc
|
||||||
ppParens True = PP.parens
|
ppParens True = PP.parens
|
||||||
ppParens False = id
|
ppParens False = id
|
||||||
|
|||||||
Reference in New Issue
Block a user