From 0e49c28e5bfcf438818aca731071fdf707a3e2ce Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Thu, 26 Jan 2017 18:41:07 +0000
Subject: API for computing the Haskell binding

---
 src/runtime/haskell-bind/PGF2.hsc | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

(limited to 'src/runtime/haskell-bind/PGF2.hsc')

diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index e87bc901b..0c976db37 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -45,6 +45,9 @@ module PGF2 (-- * PGF
              -- ** Type checking
              checkExpr, inferExpr, checkType,
 
+             -- ** Computing
+             compute,
+
              -- * Concrete syntax
              ConcName,Concr,languages,
              -- ** Linearization
@@ -279,6 +282,22 @@ checkType (PGF p _) (Type c_ty _) =
                 then return (Left msg)
                 else throwIO (PGFError msg)
 
+compute :: PGF -> Expr -> Expr
+compute (PGF p _) (Expr c_expr _) =
+  unsafePerformIO $
+  withGuPool $ \tmpPl -> do
+    exn <- gu_new_exn tmpPl
+    exprPl <- gu_new_pool
+    c_expr <- pgf_compute p c_expr exn tmpPl exprPl
+    status <- gu_exn_is_raised exn
+    if not status
+      then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+              return (Expr c_expr exprFPl)
+      else do c_msg <- (#peek GuExn, data.data) exn
+              msg <- peekUtf8CString c_msg
+              gu_pool_free exprPl
+              throwIO (PGFError msg)
+
 -----------------------------------------------------------------------------
 -- Graphviz
 
-- 
cgit v1.2.3