GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

complete details for the "ai" command in the C shell

Browse Source
This commit is contained in:
Krasimir Angelov
2017-09-01 09:57:00 +02:00
parent 1a27ddfabb
commit d5a7945ba0
6 changed files with 70 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
doc/runtime-api.html
View File

@@ -894,7 +894,7 @@ Det -> CN -> NP
</pre>
<pre class="haskell">
Prelude PGF2> print (functionType gr "DetCN")
Det -> CN -> NP
Just (Det -> CN -> NP)
</pre>
<pre class="java">
System.out.println(gr.getFunctionType("DetCN"));

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

@@ -634,18 +634,17 @@ pgfCommands = Map.fromList [
exec = needPGF $ \opts args env@(pgf,cncs) ->
case map cExpr (toExprs args) of
[e] -> case unApp e of
Just (id,[]) | id `elem` funs -> return (fromString (showFun pgf id))
| id `elem` cats -> return (fromString (showCat id))
where
funs = functions pgf
cats = categories pgf
showCat c = "cat "++c -- TODO: show categoryContext
++"\n\n"++
unlines [showFun' f ty|f<-funs,
let ty=functionType pgf f,
target ty == c]
target t = case unType t of (_,c,_) -> c
Just (id,[]) -> return (fromString
(case functionType pgf id of
Just ty -> showFun id ty
Nothing -> let funs = functionsByCat pgf id
in showCat id funs))
where
showCat c funs = "cat "++showCategory pgf c++
" ;\n\n"++
unlines [showFun f ty| f<-funs,
Just ty <- [functionType pgf f]]
showFun f ty = "fun "++f++" : "++showType [] ty++" ;"
_ -> case inferExpr pgf e of
Left msg -> error msg
Right (e,ty) -> do putStrLn ("Expression: "++PGF2.showExpr [] e)
@@ -758,8 +757,7 @@ pgfCommands = Map.fromList [
prGrammar env@(pgf,cncs) opts
| isOpt "langs" opts = return . fromString . unwords $ (map fst (optConcs env opts))
| isOpt "cats" opts = return . fromString . unwords $ categories pgf
| isOpt "funs" opts = return . fromString . unlines . map (showFun pgf) $
functions pgf
| isOpt "funs" opts = return . fromString . unwords $ functions pgf
| isOpt "missing" opts = return . fromString . unwords $
[f | f <- functions pgf, not (and [hasLinearization concr f | (_,concr) <- optConcs env opts])]
| isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . snd) $ optConcs env opts
@@ -767,9 +765,6 @@ pgfCommands = Map.fromList [
| isOpt "lexc" opts = return $ fromString $ concatMap (prLexcLexicon . snd) $ optConcs env opts
| otherwise = return void
showFun pgf f = showFun' f (functionType pgf f)
showFun' f ty = "fun "++f++" : "++showType [] ty
gizaAlignment pgf src_cnc tgt_cnc e =
let src_res = alignWords src_cnc e
tgt_res = alignWords tgt_cnc e

24
src/runtime/c/pgf/expr.c
View File

@@ -1467,6 +1467,30 @@ pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,
gu_putc('>', out, err);
}
PGF_API_DECL void
pgf_print_category(PgfPGF *gr, PgfCId catname,
GuOut* out, GuExn *err)
{
PgfAbsCat* abscat =
gu_seq_binsearch(gr->abstract.cats, pgf_abscat_order, PgfAbsCat, catname);
if (abscat == NULL) {
GuExnData* exn = gu_raise(err, PgfExn);
exn->data = "Unknown category";
return;
}
gu_puts(abscat->name, out, err);
PgfPrintContext* ctxt = NULL;
size_t n_hypos = gu_seq_length(abscat->context);
for (size_t i = 0; i < n_hypos; i++) {
PgfHypo *hypo = gu_seq_index(abscat->context, PgfHypo, i);
gu_putc(' ', out, err);
ctxt = pgf_print_hypo(hypo, ctxt, 4, out, err);
}
}
PGF_API bool
pgf_type_eq(PgfType* t1, PgfType* t2)
{

4
src/runtime/c/pgf/expr.h
View File

@@ -226,6 +226,10 @@ PGF_API_DECL void
pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,
GuOut* out, GuExn* err);
PGF_API_DECL void
pgf_print_category(PgfPGF *gr, PgfCId catname,
GuOut* out, GuExn *err);
PGF_API prob_t
pgf_compute_tree_probability(PgfPGF *gr, PgfExpr expr);

35
src/runtime/haskell-bind/PGF2.hsc
View File

@@ -27,7 +27,7 @@ module PGF2 (-- * PGF
-- * Abstract syntax
AbsName,abstractName,
-- ** Categories
Cat,categories,
Cat,categories,showCategory,
-- ** Functions
Fun,functions, functionsByCat, functionType, hasLinearization,
-- ** Expressions
@@ -212,15 +212,15 @@ unloadConcr :: Concr -> IO ()
unloadConcr c = pgf_concrete_unload (concr c)
-- | The type of a function
functionType :: PGF -> Fun -> Type
functionType :: PGF -> Fun -> Maybe Type
functionType p fn =
unsafePerformIO $
withGuPool $ \tmpPl -> do
c_fn <- newUtf8CString fn tmpPl
c_type <- pgf_function_type (pgf p) c_fn
if c_type == nullPtr
then throwIO (PGFError ("Function '"++fn++"' is not defined"))
else return (Type c_type (touchPGF p))
return (if c_type == nullPtr
then Nothing
else Just (Type c_type (touchPGF p)))
-- | Checks an expression against a specified type.
checkExpr :: PGF -> Expr -> Type -> Either String Expr
@@ -974,8 +974,25 @@ categories p =
name <- peekUtf8CString (castPtr key)
writeIORef ref $! (name : names)
categoryContext :: PGF -> Cat -> Maybe [Hypo]
categoryContext pgf cat = Nothing -- !!! not implemented yet TODO
showCategory :: PGF -> Cat -> String
showCategory p cat =
unsafePerformIO $
withGuPool $ \tmpPl ->
do (sb,out) <- newOut tmpPl
exn <- gu_new_exn tmpPl
c_cat <- newUtf8CString cat tmpPl
pgf_print_category (pgf p) c_cat out exn
touchPGF p
failed <- gu_exn_is_raised exn
if failed
then do is_exn <- gu_exn_caught exn gu_exn_type_PgfExn
if is_exn
then do c_msg <- (#peek GuExn, data.data) exn
msg <- peekUtf8CString c_msg
throwIO (PGFError msg)
else throwIO (PGFError "The abstract tree cannot be linearized")
else do s <- gu_string_buf_freeze sb tmpPl
peekUtf8CString s
-----------------------------------------------------------------------------
-- Helper functions
@@ -1032,7 +1049,7 @@ nerc pgf (lang,concr) sentence lin_idx offset =
((lemma,cat),_) = maximumBy (compare `on` snd) (reverse ls)
ls = [((fun,cat),p)
|(fun,_,p)<-lookupMorpho concr name,
let cat=functionCat fun,
Just cat <- [functionCat fun],
cat/="Nationality"]
name = trimRight (concat capwords)
_ -> Nothing
@@ -1044,7 +1061,7 @@ nerc pgf (lang,concr) sentence lin_idx offset =
Just (y,xs') -> (y:ys,xs'')
where (ys,xs'') = consume munch xs'
functionCat f = case unType (functionType pgf f) of (_,cat,_) -> cat
functionCat f = fmap ((\(_,c,_) -> c) . unType) (functionType pgf f)
-- | Callback to parse arbitrary words as chunks (from
-- ../java/org/grammaticalframework/pgf/UnknownLiteralCallback.java)

3
src/runtime/haskell-bind/PGF2/FFI.hs
View File

@@ -346,6 +346,9 @@ foreign import ccall "pgf/expr.h pgf_print_expr"
foreign import ccall "pgf/expr.h pgf_print_expr_tuple"
pgf_print_expr_tuple :: CInt -> Ptr PgfExpr -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO ()
foreign import ccall "pgf/expr.h pgf_print_category"
pgf_print_category :: Ptr PgfPGF -> CString -> Ptr GuOut -> Ptr GuExn -> IO ()
foreign import ccall "pgf/expr.h pgf_print_type"
pgf_print_type :: PgfType -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO ()