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

generate and store the ranges for all linearization rules

Browse Source
This commit is contained in:
krangelov
2021-11-26 14:05:03 +01:00
parent 794e15aca3
commit 4a68ea93b3
18 changed files with 203 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -179,7 +179,7 @@ foreign import ccall "dynamic" callLinBuilder1 :: Dynamic (Ptr PgfLinBuilderIfac
foreign import ccall "dynamic" callLinBuilder2 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> Ptr PgfExn -> IO ())
foreign import ccall "dynamic" callLinBuilder3 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> Ptr CSize -> Ptr PgfExn -> IO ())
foreign import ccall "dynamic" callLinBuilder3 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> CSize -> Ptr CSize -> Ptr PgfExn -> IO ())
foreign import ccall "dynamic" callLinBuilder4 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> CSize -> Ptr CSize -> Ptr PgfExn -> IO ())

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

@@ -212,7 +212,7 @@ data Symbol
data PArg = PArg [(LIndex,LIndex)] {-# UNPACK #-} !LParam
deriving (Eq,Show)
data Production = Production [PArg] LParam [[Symbol]]
data Production = Production [(LVar,LIndex)] [PArg] LParam [[Symbol]]
deriving (Eq,Show)
createLincat :: Cat -> [String] -> Transaction Concr ()
@@ -253,14 +253,17 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn ->
build _ c_builder c_exn = do
vtbl <- (#peek PgfLinBuilderIface, vtbl) c_builder
forM_ prods c_exn $ \(Production args res seqs) -> do
forM_ prods c_exn $ \(Production vars args res seqs) -> do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_production) vtbl
callLinBuilder0 fun c_builder c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, add_argument) vtbl
forM_ args c_exn $ \(PArg _ param) ->
callLParam (callLinBuilder3 fun c_builder) param c_exn
forM_ args c_exn $ \(PArg hypos param) ->
callLParam (callLinBuilder3 fun c_builder (fromIntegral (length hypos))) param c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, set_result) vtbl
callLParam (callLinBuilder3 fun c_builder) res c_exn
callLParam (callLinBuilder3 fun c_builder (fromIntegral (length vars))) res c_exn
fun <- (#peek PgfLinBuilderIfaceVtbl, add_variable) vtbl
forM_ vars c_exn $ \(v,r) ->
callLinBuilder2 fun c_builder (fromIntegral v) (fromIntegral r) c_exn
forM_ seqs c_exn $ \syms -> do
fun <- (#peek PgfLinBuilderIfaceVtbl, start_sequence) vtbl
callLinBuilder1 fun c_builder (fromIntegral (length syms)) c_exn

BIN
src/runtime/haskell/tests/basic.pgf
View File

Binary file not shown.

4
src/runtime/haskell/tests/basic.pmcfg
View File

@@ -19,10 +19,10 @@ concrete basic_cnc {
lincat S = [
""
]
lin c : N(j) -> S(0) = [
lin c : ∀{j<2} . N(j) -> S(0) = [
<0,0>
]
lin ind : P(0) * P(0) * N(j) -> P(0) = [
lin ind : ∀{j<2} . P(0) * P(0) * N(j) -> P(0) = [
]
lin s : N(0) -> N(0) = [
<0,0> "+" "1"