GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-02 07:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

implement pre {..}

Browse Source
This commit is contained in:
krangelov
2021-11-25 19:04:35 +01:00
parent 3fd668e525
commit 857e85c8a1
11 changed files with 282 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/runtime/haskell/PGF2.hsc
View File

@@ -275,6 +275,7 @@ showPGF p =
nest 2 (vcat syms) $$
char ']')
modifyIORef ref $ (\doc -> doc $$ def)
return ()
-- | The abstract language name is the name of the top-level
-- abstract module

2
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -185,6 +185,8 @@ foreign import ccall "dynamic" callLinBuilder4 :: Dynamic (Ptr PgfLinBuilderIfac
foreign import ccall "dynamic" callLinBuilder5 :: Dynamic (Ptr PgfLinBuilderIface -> Ptr PgfText -> Ptr PgfExn -> IO ())
foreign import ccall "dynamic" callLinBuilder6 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ())
foreign import ccall pgf_create_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO ()

24
src/runtime/haskell/PGF2/Transactions.hsc
View File

@@ -264,7 +264,7 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn ->
forM_ seqs c_exn $ \syms -> do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_sequence) vtbl
callLinBuilder1 fun c_builder (fromIntegral (length syms)) c_exn
mapM_ (addSymbol c_builder vtbl c_exn) syms
forM_ syms c_exn (addSymbol c_builder vtbl c_exn)
fun <- (#peek PgfLinBuilderIfaceVtbl, end_sequence) vtbl
callLinBuilder0 fun c_builder c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, end_production) vtbl
@@ -283,6 +283,28 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn ->
fun <- (#peek PgfLinBuilderIfaceVtbl, add_symks) vtbl
withText tok $ \c_tok ->
callLinBuilder5 fun c_builder c_tok c_exn
addSymbol c_builder vtbl c_exn (SymKP def alts) = do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_symkp) vtbl
callLinBuilder2 fun c_builder (fromIntegral (length def)) (fromIntegral (length alts)) c_exn
forM_ def c_exn (addSymbol c_builder vtbl c_exn)
forM_ alts c_exn $ \(form,ps) -> do
let n_ps = length ps
(allocaBytes (n_ps*(#size PgfText*)) $ \c_ps ->
withTexts c_ps 0 ps $ do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_symkp_alt) vtbl
callLinBuilder6 fun c_builder (fromIntegral (length form)) (fromIntegral n_ps) c_ps c_exn)
forM_ form c_exn (addSymbol c_builder vtbl c_exn)
fun <- (#peek PgfLinBuilderIfaceVtbl, end_symkp_alt) vtbl
callLinBuilder0 fun c_builder c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, end_symkp) vtbl
callLinBuilder0 fun c_builder c_exn
where
withTexts p i [] f = f
withTexts p i (s:ss) f =
withText s $ \c_s -> do
pokeElemOff p i c_s
withTexts p (i+1) ss f
addSymbol c_builder vtbl c_exn SymBIND = do
fun <- (#peek PgfLinBuilderIfaceVtbl, add_symbind) vtbl
callLinBuilder0 fun c_builder c_exn