msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

an almost complete ai command in the C shell

Browse Source
This commit is contained in:
Krasimir Angelov
2017-08-30 19:44:10 +02:00
parent 13a854d349
commit 070d00a20c
1 changed files with 24 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
src/compiler/GF/Command/Commands2.hs
View File

@@ -641,44 +641,37 @@ pgfCommands = Map.fromList [
("ai", emptyCommandInfo { ("ai", emptyCommandInfo {
longname = "abstract_info", longname = "abstract_info",
-- syntax = "ai IDENTIFIER or ai EXPR", syntax = "ai IDENTIFIER or ai EXPR",
syntax = "ai IDENTIFIER", synopsis = "Provides an information about a function, an expression or a category from the abstract syntax",
-- synopsis = "Provides an information about a function, an expression or a category from the abstract syntax",
synopsis = "Provides information about a function, or a category from the abstract syntax",
explanation = unlines [ explanation = unlines [
-- "The command has one argument which is either function, expression or", "The command has one argument which is either function, expression or",
"The command has one argument which is either function or",
"a category defined in the abstract syntax of the current grammar. ", "a category defined in the abstract syntax of the current grammar. ",
"If the argument is a function then its type is printed out.", "If the argument is a function then its type is printed out.",
"If it is a category then the category definition is printed."{-, "If it is a category then the category definition is printed.",
"If a whole expression is given it prints the expression with refined", "If a whole expression is given it prints the expression with refined",
"metavariables and the type of the expression."-} "metavariables and the type of the expression."
], ],
exec = needPGF $ \ opts arg env@(pgf,cncs) -> do exec = needPGF $ \opts args env@(pgf,cncs) ->
case toExprs arg of case map cExpr (toExprs args) of
[H.EFun cid] [e] -> case unApp e of
| id `elem` funs -> return (fromString (showFun pgf id)) Just (id,[]) | id `elem` funs -> return (fromString (showFun pgf id))
| id `elem` cats -> return (fromString (showCat id)) | id `elem` cats -> return (fromString (showCat id))
where where
id = H.showCId cid funs = functions pgf
funs = functions pgf cats = categories pgf
cats = categories pgf
showCat c = "cat "++c -- TODO: show categoryContext showCat c = "cat "++c -- TODO: show categoryContext
++"\n\n"++ ++"\n\n"++
unlines [showFun' f ty|f<-funs, unlines [showFun' f ty|f<-funs,
let ty=functionType pgf f, let ty=functionType pgf f,
target ty == c] target ty == c]
--target (C.DTyp _ c _) = c target t = case unType t of (_,c,_) -> c
target t = case unType t of (_,c,_) -> c _ -> case inferExpr pgf e of
{- Left msg -> error msg
[e] -> case H.inferExpr pgf e of Right (e,ty) -> do putStrLn ("Expression: "++PGF2.showExpr [] e)
Left tcErr -> error $ render (H.ppTcError tcErr) putStrLn ("Type: "++PGF2.showType [] ty)
Right (e,ty) -> do putStrLn ("Expression: "++H.showExpr [] e) -- putStrLn ("Probability: "++show (H.probTree pgf e))
putStrLn ("Type: "++H.showType [] ty)
putStrLn ("Probability: "++show (H.probTree pgf e))
return void return void
-}
_ -> do putStrLn "a single function name or category name is expected" _ -> do putStrLn "a single function name or category name is expected"
return void, return void,
needsTypeCheck = False needsTypeCheck = False