From f2bc7ec7b64973bd8147d4394a937d6c491a71fd Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Thu, 28 Sep 2017 16:33:34 +0200
Subject: added exprSubstitute in the C runtime for substituting meta variables

---
 src/runtime/haskell-bind/PGF2.hsc          | 16 +++++++++++++++-
 src/runtime/haskell-bind/PGF2/FFI.hsc      | 26 +++++++++++++++++++++++++-
 src/runtime/haskell-bind/PGF2/Internal.hsc | 21 ---------------------
 3 files changed, 40 insertions(+), 23 deletions(-)

(limited to 'src/runtime/haskell-bind')

diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 0d1d46be6..733e29c74 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -39,7 +39,7 @@ module PGF2 (-- * PGF
              mkFloat,unFloat,
              mkMeta,unMeta,
              mkCId,
-             exprHash, exprSize, exprFunctions,
+             exprHash, exprSize, exprFunctions, exprSubstitute,
              treeProbability,
 
              -- ** Types
@@ -366,6 +366,20 @@ exprFunctions (Expr c_expr touch) =
     touch
     return funs
 
+exprSubstitute :: Expr -> [Expr] -> Expr
+exprSubstitute (Expr c_expr touch) meta_values =
+  unsafePerformIO $
+  withGuPool $ \tmpPl -> do
+    c_meta_values <- newSequence (#size PgfExpr) pokeExpr meta_values tmpPl
+    exprPl <- gu_new_pool
+    c_expr <- pgf_expr_substitute c_expr c_meta_values exprPl
+    touch
+    exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+    let touch' = sequence_ (touchForeignPtr exprFPl : map touchExpr meta_values)
+    return (Expr c_expr touch')
+  where
+    pokeExpr ptr (Expr c_expr _) = poke ptr c_expr
+
 -----------------------------------------------------------------------------
 -- Graphviz
 
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc
index c095e663f..71e4b488f 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hsc
+++ b/src/runtime/haskell-bind/PGF2/FFI.hsc
@@ -7,7 +7,7 @@ module PGF2.FFI where
 #include <gu/utf8.h>
 #include <pgf/pgf.h>
 
-import Foreign ( alloca, peek, poke )
+import Foreign ( alloca, peek, poke, peekByteOff )
 import Foreign.C
 import Foreign.Ptr
 import Foreign.ForeignPtr
@@ -216,6 +216,27 @@ utf8Length s = count 0 s
       where
         ucs = fromEnum x
 
+peekSequence peekElem size ptr = do
+  c_len <- (#peek GuSeq, len) ptr
+  peekElems (c_len :: CSizeT) (ptr `plusPtr` (#offset GuSeq, data))
+  where
+     peekElems 0   ptr = return []
+     peekElems len ptr = do
+       e  <- peekElem ptr
+       es <- peekElems (len-1) (ptr `plusPtr` size)
+       return (e:es)
+
+newSequence :: CSizeT -> (Ptr a -> v -> IO ()) -> [v] -> Ptr GuPool -> IO (Ptr GuSeq)
+newSequence elem_size pokeElem values pool = do
+  c_seq <- gu_make_seq elem_size (fromIntegral (length values)) pool
+  pokeElems (c_seq `plusPtr` (#offset GuSeq, data)) values
+  return c_seq
+  where
+    pokeElems ptr []     = return ()
+    pokeElems ptr (x:xs) = do
+      pokeElem  ptr x
+      pokeElems (ptr `plusPtr` (fromIntegral elem_size)) xs
+
 ------------------------------------------------------------------
 -- libpgf API
 
@@ -431,6 +452,9 @@ foreign import ccall "pgf/expr.h pgf_expr_size"
 foreign import ccall "pgf/expr.h pgf_expr_functions"
   pgf_expr_functions :: PgfExpr -> Ptr GuPool -> IO (Ptr GuSeq)
 
+foreign import ccall "pgf/expr.h pgf_expr_substitute"
+  pgf_expr_substitute :: PgfExpr -> Ptr GuSeq -> Ptr GuPool -> IO PgfExpr
+
 foreign import ccall "pgf/expr.h pgf_compute_tree_probability"
   pgf_compute_tree_probability :: Ptr PgfPGF -> PgfExpr -> IO CFloat
 
diff --git a/src/runtime/haskell-bind/PGF2/Internal.hsc b/src/runtime/haskell-bind/PGF2/Internal.hsc
index 259ea670d..c4aef323a 100644
--- a/src/runtime/haskell-bind/PGF2/Internal.hsc
+++ b/src/runtime/haskell-bind/PGF2/Internal.hsc
@@ -268,16 +268,6 @@ concrSequence c seqid = unsafePerformIO $ do
       forms <- peekForms (len-1) (ptr `plusPtr` (#size PgfAlternative))
       return ((form,prefixes):forms)
 
-peekSequence peekElem size ptr = do
-  c_len <- (#peek GuSeq, len) ptr
-  peekElems (c_len :: CSizeT) (ptr `plusPtr` (#offset GuSeq, data))
-  where
-     peekElems 0   ptr = return []
-     peekElems len ptr = do
-       e  <- peekElem ptr
-       es <- peekElems (len-1) (ptr `plusPtr` size)
-       return (e:es)
-
 deRef peekValue ptr = peek ptr >>= peekValue
 
 fidString, fidInt, fidFloat, fidVar, fidStart :: FId
@@ -901,17 +891,6 @@ pokeString pool c_elem str = do
   c_str <- newUtf8CString str pool
   poke c_elem c_str
 
-newSequence :: CSizeT -> (Ptr a -> v -> IO ()) -> [v] -> Ptr GuPool -> IO (Ptr GuSeq)
-newSequence elem_size pokeElem values pool = do
-  c_seq <- gu_make_seq elem_size (fromIntegral (length values)) pool
-  pokeElems (c_seq `plusPtr` (#offset GuSeq, data)) values
-  return c_seq
-  where
-    pokeElems ptr []     = return ()
-    pokeElems ptr (x:xs) = do
-      pokeElem  ptr x
-      pokeElems (ptr `plusPtr` (fromIntegral elem_size)) xs
-
 newMap key_size hasher newKey elem_size pokeElem values pool = do
   map <- gu_make_map key_size hasher
                      elem_size gu_null_struct
-- 
cgit v1.2.3