summaryrefslogtreecommitdiff
path: root/src/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime')
-rw-r--r--src/runtime/haskell-bind/PGF2.hsc129
-rw-r--r--src/runtime/haskell-bind/PGF2/FFI.hs27
-rw-r--r--src/runtime/java/jpgf.c2
-rw-r--r--src/runtime/java/org/grammaticalframework/pgf/Expr.java2
-rw-r--r--src/runtime/python/pypgf.c2
5 files changed, 158 insertions, 4 deletions
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index e50fdd4b1..1d9d82f90 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -14,6 +14,7 @@
-------------------------------------------------
#include <pgf/pgf.h>
+#include <pgf/linearizer.h>
#include <gu/enum.h>
#include <gu/exn.h>
@@ -51,7 +52,7 @@ module PGF2 (-- * PGF
-- * Concrete syntax
ConcName,Concr,languages,
-- ** Linearization
- linearize,linearizeAll,
+ linearize,linearizeAll,tabularLinearize,bracketedLinearize,
FId, LIndex, BracketedString(..), showBracketedString, flattenBracketedString,
alignWords,
@@ -640,6 +641,54 @@ linearizeAll lang e = unsafePerformIO $
else do gu_pool_free pl
throwIO (PGFError "The abstract tree cannot be linearized")
+-- | Generates a table of linearizations for an expression
+tabularLinearize :: Concr -> Expr -> Map.Map String String
+tabularLinearize lang e = unsafePerformIO $
+ withGuPool $ \tmpPl -> do
+ exn <- gu_new_exn tmpPl
+ cts <- pgf_lzr_concretize (concr lang) (expr e) exn tmpPl
+ failed <- gu_exn_is_raised exn
+ if failed
+ then throwExn exn
+ else do ctree <- alloca $ \ptr -> do gu_enum_next cts ptr tmpPl
+ peek ptr
+ if ctree == nullPtr
+ then do touchExpr e
+ return Map.empty
+ else do labels <- alloca $ \p_n_lins ->
+ alloca $ \p_labels -> do
+ pgf_lzr_get_table (concr lang) ctree p_n_lins p_labels
+ n_lins <- peek p_n_lins
+ labels <- peek p_labels
+ labels <- peekArray (fromIntegral n_lins) labels
+ labels <- mapM peekCString labels
+ return labels
+ lins <- collect lang ctree 0 labels exn tmpPl
+ return (Map.fromList lins)
+ where
+ collect lang ctree lin_idx [] exn tmpPl = return []
+ collect lang ctree lin_idx (label:labels) exn tmpPl = do
+ (sb,out) <- newOut tmpPl
+ pgf_lzr_linearize_simple (concr lang) ctree lin_idx out exn tmpPl
+ failed <- gu_exn_is_raised exn
+ if failed
+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist
+ if is_nonexist
+ then collect lang ctree (lin_idx+1) labels exn tmpPl
+ else throwExn exn
+ else do lin <- gu_string_buf_freeze sb tmpPl
+ s <- peekUtf8CString lin
+ ss <- collect lang ctree (lin_idx+1) labels exn tmpPl
+ return ((label,s):ss)
+
+ throwExn exn = 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 do throwIO (PGFError "The abstract tree cannot be linearized")
+
type FId = Int
type LIndex = Int
@@ -677,6 +726,84 @@ flattenBracketedString :: BracketedString -> [String]
flattenBracketedString (Leaf w) = [w]
flattenBracketedString (Bracket _ _ _ _ bss) = concatMap flattenBracketedString bss
+bracketedLinearize :: Concr -> Expr -> [BracketedString]
+bracketedLinearize lang e = unsafePerformIO $
+ withGuPool $ \pl ->
+ do exn <- gu_new_exn pl
+ cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl
+ failed <- gu_exn_is_raised exn
+ if failed
+ then throwExn exn
+ else do ctree <- alloca $ \ptr -> do gu_enum_next cts ptr pl
+ peek ptr
+ if ctree == nullPtr
+ then do touchExpr e
+ return []
+ else do ctree <- pgf_lzr_wrap_linref ctree pl
+ ref <- newIORef ([],[])
+ allocaBytes (#size PgfLinFuncs) $ \pLinFuncs ->
+ alloca $ \ppLinFuncs -> do
+ fptr_symbol_token <- wrapSymbolTokenCallback (symbol_token ref)
+ fptr_begin_phrase <- wrapPhraseCallback (begin_phrase ref)
+ fptr_end_phrase <- wrapPhraseCallback (end_phrase ref)
+ fptr_symbol_ne <- wrapSymbolNonExistCallback (symbol_ne exn)
+ fptr_symbol_meta <- wrapSymbolMetaCallback (symbol_meta ref)
+ (#poke PgfLinFuncs, symbol_token) pLinFuncs fptr_symbol_token
+ (#poke PgfLinFuncs, begin_phrase) pLinFuncs fptr_begin_phrase
+ (#poke PgfLinFuncs, end_phrase) pLinFuncs fptr_end_phrase
+ (#poke PgfLinFuncs, symbol_ne) pLinFuncs fptr_symbol_ne
+ (#poke PgfLinFuncs, symbol_bind) pLinFuncs nullPtr
+ (#poke PgfLinFuncs, symbol_capit) pLinFuncs nullPtr
+ (#poke PgfLinFuncs, symbol_meta) pLinFuncs fptr_symbol_meta
+ poke ppLinFuncs pLinFuncs
+ pgf_lzr_linearize (concr lang) ctree 0 ppLinFuncs pl
+ freeHaskellFunPtr fptr_symbol_token
+ freeHaskellFunPtr fptr_begin_phrase
+ freeHaskellFunPtr fptr_end_phrase
+ freeHaskellFunPtr fptr_symbol_ne
+ freeHaskellFunPtr fptr_symbol_meta
+ failed <- gu_exn_is_raised exn
+ if failed
+ then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist
+ if is_nonexist
+ then return []
+ else throwExn exn
+ else do (_,bs) <- readIORef ref
+ return (reverse bs)
+ where
+ symbol_token ref _ c_token = do
+ (stack,bs) <- readIORef ref
+ token <- peekUtf8CString c_token
+ writeIORef ref (stack,Leaf token : bs)
+
+ begin_phrase ref _ c_cat c_fid c_lindex c_fun = do
+ (stack,bs) <- readIORef ref
+ writeIORef ref (bs:stack,[])
+
+ end_phrase ref _ c_cat c_fid c_lindex c_fun = do
+ (bs':stack,bs) <- readIORef ref
+ cat <- peekUtf8CString c_cat
+ let fid = fromIntegral c_fid
+ let lindex = fromIntegral c_lindex
+ fun <- peekUtf8CString c_fun
+ writeIORef ref (stack, Bracket cat fid lindex fun (reverse bs) : bs')
+
+ symbol_ne exn _ = do
+ gu_exn_raise exn gu_exn_type_PgfLinNonExist
+ return ()
+
+ symbol_meta ref _ meta_id = do
+ (stack,bs) <- readIORef ref
+ writeIORef ref (stack,Leaf "?" : bs)
+
+ throwExn exn = 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 do throwIO (PGFError "The abstract tree cannot be linearized")
+
alignWords :: Concr -> Expr -> [(String, [Int])]
alignWords lang e = unsafePerformIO $
withGuPool $ \pl ->
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 77e075495..d01084d62 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -55,6 +55,9 @@ foreign import ccall "gu/exn.h gu_exn_is_raised"
foreign import ccall "gu/exn.h gu_exn_caught_"
gu_exn_caught :: Ptr GuExn -> CString -> IO Bool
+foreign import ccall "gu/exn.h gu_exn_raise_"
+ gu_exn_raise :: Ptr GuExn -> CString -> IO (Ptr ())
+
gu_exn_type_GuErrno = Ptr "GuErrno"# :: CString
gu_exn_type_PgfLinNonExist = Ptr "PgfLinNonExist"# :: CString
@@ -144,6 +147,7 @@ type PgfType = Ptr ()
data PgfCallbacksMap
data PgfOracleCallback
data PgfCncTree
+data PgfLinFuncs
foreign import ccall "pgf/pgf.h pgf_read"
pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF)
@@ -202,6 +206,29 @@ foreign import ccall "pgf/pgf.h pgf_lzr_wrap_linref"
foreign import ccall "pgf/pgf.h pgf_lzr_linearize_simple"
pgf_lzr_linearize_simple :: Ptr PgfConcr -> Ptr PgfCncTree -> CInt -> Ptr GuOut -> Ptr GuExn -> Ptr GuPool -> IO ()
+foreign import ccall "pgf/pgf.h pgf_lzr_linearize"
+ pgf_lzr_linearize :: Ptr PgfConcr -> Ptr PgfCncTree -> CInt -> Ptr (Ptr PgfLinFuncs) -> Ptr GuPool -> IO ()
+
+foreign import ccall "pgf/pgf.h pgf_lzr_get_table"
+ pgf_lzr_get_table :: Ptr PgfConcr -> Ptr PgfCncTree -> Ptr CInt -> Ptr (Ptr CString) -> IO ()
+
+type SymbolTokenCallback = Ptr (Ptr PgfLinFuncs) -> CString -> IO ()
+type PhraseCallback = Ptr (Ptr PgfLinFuncs) -> CString -> CInt -> CInt -> CString -> IO ()
+type NonExistCallback = Ptr (Ptr PgfLinFuncs) -> IO ()
+type MetaCallback = Ptr (Ptr PgfLinFuncs) -> CInt -> IO ()
+
+foreign import ccall "wrapper"
+ wrapSymbolTokenCallback :: SymbolTokenCallback -> IO (FunPtr SymbolTokenCallback)
+
+foreign import ccall "wrapper"
+ wrapPhraseCallback :: PhraseCallback -> IO (FunPtr PhraseCallback)
+
+foreign import ccall "wrapper"
+ wrapSymbolNonExistCallback :: NonExistCallback -> IO (FunPtr NonExistCallback)
+
+foreign import ccall "wrapper"
+ wrapSymbolMetaCallback :: MetaCallback -> IO (FunPtr MetaCallback)
+
foreign import ccall "pgf/pgf.h pgf_align_words"
pgf_align_words :: Ptr PgfConcr -> PgfExpr -> Ptr GuExn -> Ptr GuPool -> IO (Ptr GuSeq)
diff --git a/src/runtime/java/jpgf.c b/src/runtime/java/jpgf.c
index 6e3d07d72..7e0c9b39e 100644
--- a/src/runtime/java/jpgf.c
+++ b/src/runtime/java/jpgf.c
@@ -1371,7 +1371,7 @@ Java_org_grammaticalframework_pgf_Expr_initApp__Ljava_lang_String_2_3Lorg_gramma
}
JNIEXPORT jobject JNICALL
-Java_org_grammaticalframework_pgf_Expr_unApply(JNIEnv* env, jobject self)
+Java_org_grammaticalframework_pgf_Expr_unApp(JNIEnv* env, jobject self)
{
jclass expr_class = (*env)->FindClass(env, "org/grammaticalframework/pgf/Expr");
if (!expr_class)
diff --git a/src/runtime/java/org/grammaticalframework/pgf/Expr.java b/src/runtime/java/org/grammaticalframework/pgf/Expr.java
index 0b52e02ef..8462cb30f 100644
--- a/src/runtime/java/org/grammaticalframework/pgf/Expr.java
+++ b/src/runtime/java/org/grammaticalframework/pgf/Expr.java
@@ -87,7 +87,7 @@ public class Expr implements Serializable {
* a function application, then it is decomposed into
* a function name and a list of arguments. If this is not
* an application then the result is null. */
- public native ExprApplication unApply();
+ public native ExprApplication unApp();
/** If the method is called on an expression which is
* a meta variable, then it will return the variable's id.
diff --git a/src/runtime/python/pypgf.c b/src/runtime/python/pypgf.c
index cf4242882..70728f1c7 100644
--- a/src/runtime/python/pypgf.c
+++ b/src/runtime/python/pypgf.c
@@ -1990,7 +1990,7 @@ static PyMemberDef Bracket_members[] = {
{"fun", T_OBJECT_EX, offsetof(BracketObject, fun), 0,
"the abstract function for this bracket"},
{"fid", T_INT, offsetof(BracketObject, fid), 0,
- "an unique id which identifies this bracket in the whole bracketed string"},
+ "an id which identifies this bracket in the bracketed string. If there are discontinuous phrases this id will be shared for all brackets belonging to the same phrase."},
{"lindex", T_INT, offsetof(BracketObject, lindex), 0,
"the constituent index"},
{"children", T_OBJECT_EX, offsetof(BracketObject, children), 0,
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 13:13:16 +0000