msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests 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>
<pre class="haskell"> <pre class="haskell">
Prelude PGF2> print (functionType gr "DetCN") Prelude PGF2> print (functionType gr "DetCN")
Det -> CN -> NP Just (Det -> CN -> NP)
</pre> </pre>
<pre class="java"> <pre class="java">
System.out.println(gr.getFunctionType("DetCN")); 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) -> exec = needPGF $ \opts args env@(pgf,cncs) ->
case map cExpr (toExprs args) of case map cExpr (toExprs args) of
[e] -> case unApp e of [e] -> case unApp e of
Just (id,[]) | id `elem` funs -> return (fromString (showFun pgf id)) Just (id,[]) -> return (fromString
| id `elem` cats -> return (fromString (showCat id)) (case functionType pgf id of
where Just ty -> showFun id ty
funs = functions pgf Nothing -> let funs = functionsByCat pgf id
cats = categories pgf in showCat id funs))
where
showCat c = "cat "++c -- TODO: show categoryContext showCat c funs = "cat "++showCategory pgf c++
++"\n\n"++ " ;\n\n"++
unlines [showFun' f ty|f<-funs, unlines [showFun f ty| f<-funs,
let ty=functionType pgf f, Just ty <- [functionType pgf f]]
target ty == c] showFun f ty = "fun "++f++" : "++showType [] ty++" ;"
target t = case unType t of (_,c,_) -> c
_ -> case inferExpr pgf e of _ -> case inferExpr pgf e of
Left msg -> error msg Left msg -> error msg
Right (e,ty) -> do putStrLn ("Expression: "++PGF2.showExpr [] e) Right (e,ty) -> do putStrLn ("Expression: "++PGF2.showExpr [] e)
@@ -758,8 +757,7 @@ pgfCommands = Map.fromList [
prGrammar env@(pgf,cncs) opts prGrammar env@(pgf,cncs) opts
| isOpt "langs" opts = return . fromString . unwords $ (map fst (optConcs env opts)) | isOpt "langs" opts = return . fromString . unwords $ (map fst (optConcs env opts))
| isOpt "cats" opts = return . fromString . unwords $ categories pgf | isOpt "cats" opts = return . fromString . unwords $ categories pgf
| isOpt "funs" opts = return . fromString . unlines . map (showFun pgf) $ | isOpt "funs" opts = return . fromString . unwords $ functions pgf
functions pgf
| isOpt "missing" opts = return . fromString . unwords $ | isOpt "missing" opts = return . fromString . unwords $
[f | f <- functions pgf, not (and [hasLinearization concr f | (_,concr) <- optConcs env opts])] [f | f <- functions pgf, not (and [hasLinearization concr f | (_,concr) <- optConcs env opts])]
| isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . snd) $ 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 | isOpt "lexc" opts = return $ fromString $ concatMap (prLexcLexicon . snd) $ optConcs env opts
| otherwise = return void | 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 = gizaAlignment pgf src_cnc tgt_cnc e =
let src_res = alignWords src_cnc e let src_res = alignWords src_cnc e
tgt_res = alignWords tgt_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); 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_API bool
pgf_type_eq(PgfType* t1, PgfType* t2) 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, pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,
GuOut* out, GuExn* err); GuOut* out, GuExn* err);
PGF_API_DECL void
pgf_print_category(PgfPGF *gr, PgfCId catname,
GuOut* out, GuExn *err);
PGF_API prob_t PGF_API prob_t
pgf_compute_tree_probability(PgfPGF *gr, PgfExpr expr); 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 -- * Abstract syntax
AbsName,abstractName, AbsName,abstractName,
-- ** Categories -- ** Categories
Cat,categories, Cat,categories,showCategory,
-- ** Functions -- ** Functions
Fun,functions, functionsByCat, functionType, hasLinearization, Fun,functions, functionsByCat, functionType, hasLinearization,
-- ** Expressions -- ** Expressions
@@ -212,15 +212,15 @@ unloadConcr :: Concr -> IO ()
unloadConcr c = pgf_concrete_unload (concr c) unloadConcr c = pgf_concrete_unload (concr c)
-- | The type of a function -- | The type of a function
functionType :: PGF -> Fun -> Type functionType :: PGF -> Fun -> Maybe Type
functionType p fn = functionType p fn =
unsafePerformIO $ unsafePerformIO $
withGuPool $ \tmpPl -> do withGuPool $ \tmpPl -> do
c_fn <- newUtf8CString fn tmpPl c_fn <- newUtf8CString fn tmpPl
c_type <- pgf_function_type (pgf p) c_fn c_type <- pgf_function_type (pgf p) c_fn
if c_type == nullPtr return (if c_type == nullPtr
then throwIO (PGFError ("Function '"++fn++"' is not defined")) then Nothing
else return (Type c_type (touchPGF p)) else Just (Type c_type (touchPGF p)))
-- | Checks an expression against a specified type. -- | Checks an expression against a specified type.
checkExpr :: PGF -> Expr -> Type -> Either String Expr checkExpr :: PGF -> Expr -> Type -> Either String Expr
@@ -974,8 +974,25 @@ categories p =
name <- peekUtf8CString (castPtr key) name <- peekUtf8CString (castPtr key)
writeIORef ref $! (name : names) writeIORef ref $! (name : names)
categoryContext :: PGF -> Cat -> Maybe [Hypo] showCategory :: PGF -> Cat -> String
categoryContext pgf cat = Nothing -- !!! not implemented yet TODO 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 -- Helper functions
@@ -1032,7 +1049,7 @@ nerc pgf (lang,concr) sentence lin_idx offset =
((lemma,cat),_) = maximumBy (compare `on` snd) (reverse ls) ((lemma,cat),_) = maximumBy (compare `on` snd) (reverse ls)
ls = [((fun,cat),p) ls = [((fun,cat),p)
|(fun,_,p)<-lookupMorpho concr name, |(fun,_,p)<-lookupMorpho concr name,
let cat=functionCat fun, Just cat <- [functionCat fun],
cat/="Nationality"] cat/="Nationality"]
name = trimRight (concat capwords) name = trimRight (concat capwords)
_ -> Nothing _ -> Nothing
@@ -1044,7 +1061,7 @@ nerc pgf (lang,concr) sentence lin_idx offset =
Just (y,xs') -> (y:ys,xs'') Just (y,xs') -> (y:ys,xs'')
where (ys,xs'') = consume munch 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 -- | Callback to parse arbitrary words as chunks (from
-- ../java/org/grammaticalframework/pgf/UnknownLiteralCallback.java) -- ../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" foreign import ccall "pgf/expr.h pgf_print_expr_tuple"
pgf_print_expr_tuple :: CInt -> Ptr PgfExpr -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO () 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" foreign import ccall "pgf/expr.h pgf_print_type"
pgf_print_type :: PgfType -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO () pgf_print_type :: PgfType -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO ()