C++ (Cpp) gtk2hs_value_as_haskellobjの例

コード例 #1

ファイル: hsgvalue.c プロジェクト: abarbu/Clutterhs

HsStablePtr g_value_to_haskellobj(const GValue *value)
{
    Capability *cap;
    HaskellObj obj;
    HsStablePtr ret;

    cap = rts_lock();
    obj = gtk2hs_value_as_haskellobj(cap, value);
    rts_unlock(cap);

    ret = (HsStablePtr) getStablePtr((StgPtr) obj);

    return ret;
}

コード例 #2

ファイル: hsgclosure.c プロジェクト: Javran/gtk2hs

static void
gtk2hs_closure_marshal(GClosure *closure,
                       GValue *return_value,
                       guint n_param_values,
                       const GValue *param_values,
                       gpointer invocation_hint,
                       gpointer marshal_data)
{

    Gtk2HsClosure *hc = (Gtk2HsClosure *)closure;
    HaskellObj call, ret;
#ifdef GHC_RTS_USES_CAPABILITY
    Capability *cap;
#else
    SchedulerStatus cap;
#endif
    guint i;

    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to run callback, n_param_values=%d", hc->callback, n_param_values));
#ifdef GHC_RTS_USES_CAPABILITY
    cap = rts_lock();
#else
    rts_lock();
#endif

    call = (StgClosure *)deRefStablePtr(hc->callback);

    /* construct the function call */
    for (i = 0; i < n_param_values; i++) {
        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): param_values[%d]=%s :: %s",
                           hc->callback,
                           i,
                           g_strdup_value_contents(&param_values[i]),
                           g_type_name(G_VALUE_TYPE(&param_values[i]))));
        call = rts_apply(CAP call, gtk2hs_value_as_haskellobj(CAP &param_values[i]));
    }

    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_evalIO", hc->callback));

    /* perform the call */
#if __GLASGOW_HASKELL__>=704
    rts_evalIO(&cap, rts_apply(CAP (HaskellObj)runIO_closure, call),&ret);
#else
    cap=rts_evalIO(CAP rts_apply(CAP (HaskellObj)runIO_closure, call),&ret);
#endif

    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_checkSchedStatus", hc->callback));

    /* barf if anything went wrong */
    /* TODO: pass a sensible value for call site so we get better error messages */
    /* or perhaps we can propogate any error? */
    rts_checkSchedStatus("gtk2hs_closure_marshal", cap);
    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): ret=%p", hc->callback, ret));

    if (return_value) {
        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): return_value :: %s, ret=%p, UNTAG_CLOSURE(ret)=%p",
                           hc->callback,
                           /*                           g_strdup_value_contents(return_value), */
                           g_type_name(G_VALUE_TYPE(return_value)),
                           ret,
                           UNTAG_CLOSURE(ret)));
        gtk2hs_value_from_haskellobj(return_value, ret);
    }

#ifdef GHC_RTS_USES_CAPABILITY
    rts_unlock(cap);
#else
    rts_unlock();
#endif
    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): done running callback", hc->callback));
}