1
0
forked from GitHub/gf-core

added command ai which prints information about given identifier

This commit is contained in:
krasimir
2009-05-12 20:52:18 +00:00
parent f283944f5c
commit b037cbc361
2 changed files with 31 additions and 5 deletions

View File

@@ -35,6 +35,7 @@ import GF.Text.Coding
import Data.Maybe
import qualified Data.Map as Map
import System.Cmd
import Text.PrettyPrint
import Debug.Trace
@@ -586,6 +587,30 @@ allCommands cod env@(pgf, mos) = Map.fromList [
("append","append to file, instead of overwriting it")
],
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

View File

@@ -1,6 +1,6 @@
module PGF.Type ( Type(..), Hypo(..),
readType, showType,
pType, ppType ) where
pType, ppType, ppHypo ) where
import PGF.CId
import PGF.Expr
@@ -67,12 +67,13 @@ ppType d (DTyp ctxt cat args)
| null ctxt = ppRes cat args
| otherwise = ppParens (d > 0) (foldr ppCtxt (ppRes cat args) ctxt)
where
ppCtxt (Hyp x typ) 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
ppCtxt hyp doc = ppHypo hyp PP.<+> PP.text "->" PP.<+> doc
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 True = PP.parens
ppParens False = id