diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Command/Commands.hs | 25 | ||||
| -rw-r--r-- | src/PGF/Type.hs | 11 |
2 files changed, 31 insertions, 5 deletions
diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 7534554de..8f82b468f 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -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 diff --git a/src/PGF/Type.hs b/src/PGF/Type.hs index fec8c0ff2..8c513ffd4 100644 --- a/src/PGF/Type.hs +++ b/src/PGF/Type.hs @@ -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
|