Repository: lucy-clownfish
Updated Branches:
  refs/heads/iface_exp1 [created] b9aea8cb4


Proof-of-concept host interface for Perl.


Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/b9aea8cb
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/b9aea8cb
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/b9aea8cb

Branch: refs/heads/iface_exp1
Commit: b9aea8cb463a7cf738ee821fdc7c9a98dfee677a
Parents: 61067b8
Author: Marvin Humphrey <[email protected]>
Authored: Thu Jun 25 17:58:04 2015 -0700
Committer: Marvin Humphrey <[email protected]>
Committed: Thu Jun 25 18:43:21 2015 -0700

----------------------------------------------------------------------
 runtime/core/Clownfish/Hash.c                   | 13 ++++++++
 runtime/core/Clownfish/Hash.cfh                 | 26 +++++++++++++++
 .../perl/buildlib/Clownfish/Build/Binding.pm    | 13 ++++++++
 runtime/perl/t/binding/017-hash.t               | 20 +++++++++++-
 runtime/perl/xs/XSBind.c                        | 34 ++++++++++++++++++++
 runtime/perl/xs/XSBind.h                        |  3 ++
 6 files changed, 108 insertions(+), 1 deletion(-)
----------------------------------------------------------------------


http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b9aea8cb/runtime/core/Clownfish/Hash.c
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Hash.c b/runtime/core/Clownfish/Hash.c
index 54a4c26..30dc956 100644
--- a/runtime/core/Clownfish/Hash.c
+++ b/runtime/core/Clownfish/Hash.c
@@ -28,6 +28,8 @@
 #include "Clownfish/Vector.h"
 #include "Clownfish/Util/Memory.h"
 
+size_t Stringable_Stringify_OFFSET = 0;
+
 // TOMBSTONE is shared across threads, so it must never be incref'd or
 // decref'd.
 static String *TOMBSTONE;
@@ -198,6 +200,17 @@ Hash_Fetch_IMP(Hash *self, String *key) {
 }
 
 Obj*
+Hash_Stringify_And_Fetch_IMP(Hash *self, Stringable_t key) {
+    Stringable_Stringify_t stringify
+        = (Stringable_Stringify_t)cfish_method(key.itable,
+                                               Stringable_Stringify_OFFSET);
+    String *string = stringify(key.obj);
+    HashEntry *entry = SI_fetch_entry(self, string, Str_Hash_Sum(string));
+    DECREF(string);
+    return entry ? entry->value : NULL;
+}
+
+Obj*
 Hash_Delete_IMP(Hash *self, String *key) {
     HashEntry *entry = SI_fetch_entry(self, key, Str_Hash_Sum(key));
     if (entry) {

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b9aea8cb/runtime/core/Clownfish/Hash.cfh
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Hash.cfh b/runtime/core/Clownfish/Hash.cfh
index 95f4779..900e900 100644
--- a/runtime/core/Clownfish/Hash.cfh
+++ b/runtime/core/Clownfish/Hash.cfh
@@ -16,6 +16,29 @@
 
 parcel Clownfish;
 
+__C__
+
+typedef struct StringableITable {
+    cfish_method_t methods[1];
+} StringableITable;
+
+typedef struct Stringable_t {
+    cfish_Obj *obj;
+    StringableITable *itable;
+} Stringable_t;
+
+typedef cfish_String*
+(*Stringable_Stringify_t)(cfish_Obj *self);
+extern size_t Stringable_Stringify_OFFSET;
+
+typedef struct HostStringable {
+    CFISH_OBJ_HEAD
+    cfish_Class *klass;
+    void *host_obj;
+} HostStringable;
+
+__END_C__
+
 /**
  * Hashtable.
  *
@@ -71,6 +94,9 @@ public final class Clownfish::Hash inherits Clownfish::Obj {
     public nullable Obj*
     Fetch_Utf8(Hash *self, const char *key, size_t key_len);
 
+    public nullable Obj*
+    Stringify_And_Fetch(Hash *self, Stringable_t key);
+
     /** Attempt to delete a key-value pair from the hash.
      *
      * @return the value if `key` exists and thus deletion

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b9aea8cb/runtime/perl/buildlib/Clownfish/Build/Binding.pm
----------------------------------------------------------------------
diff --git a/runtime/perl/buildlib/Clownfish/Build/Binding.pm 
b/runtime/perl/buildlib/Clownfish/Build/Binding.pm
index 309f7e8..7c26f60 100644
--- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm
+++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm
@@ -312,6 +312,19 @@ PPCODE:
     if (value) { CFISH_INCREF(value); }
     CFISH_Hash_Store_IMP(self, key, value);
 }
+
+SV*
+stringify_and_fetch(self, key_sv)
+    cfish_Hash *self;
+    SV *key_sv;
+CODE:
+    HostStringable wrapper = {{1}, NULL, key_sv};
+    Stringable_t stringable = {(cfish_Obj*)&wrapper,
+                               XSBind_hoststringable_itable()};
+    cfish_Obj *value = CFISH_Hash_Stringify_And_Fetch(self, stringable);
+    RETVAL = CFISH_OBJ_TO_SV(value);
+OUTPUT:
+    RETVAL
 END_XS_CODE
 
     my $binding = Clownfish::CFC::Binding::Perl::Class->new(

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b9aea8cb/runtime/perl/t/binding/017-hash.t
----------------------------------------------------------------------
diff --git a/runtime/perl/t/binding/017-hash.t 
b/runtime/perl/t/binding/017-hash.t
index 1843198..c0d6f42 100644
--- a/runtime/perl/t/binding/017-hash.t
+++ b/runtime/perl/t/binding/017-hash.t
@@ -16,13 +16,30 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2;
+package MyStringable;
+use Clownfish;
+
+sub new {
+    my ($class, $value) = @_;
+    return bless {
+        value => Clownfish::String->new($value)
+    }, $class;
+}
+
+sub stringify {shift->{value}}
+
+package main;
+use Test::More tests => 3;
 use Clownfish qw( to_perl to_clownfish );
 
 my $hash = Clownfish::Hash->new( capacity => 10 );
 $hash->store( "foo", Clownfish::String->new("bar") );
 $hash->store( "baz", Clownfish::String->new("banana") );
 
+my $host_stringer = MyStringable->new("foo");
+my $value = $hash->stringify_and_fetch($host_stringer);
+is(to_perl($value), "bar", "Implement Stringable interface in host");
+
 ok( !defined( $hash->fetch("blah") ),
     "fetch for a non-existent key returns undef" );
 
@@ -30,3 +47,4 @@ my %hash_with_utf8_keys = ( "\x{263a}" => "foo" );
 my $round_tripped = to_perl( to_clownfish( \%hash_with_utf8_keys ) );
 is_deeply( $round_tripped, \%hash_with_utf8_keys,
     "Round trip conversion of hash with UTF-8 keys" );
+

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b9aea8cb/runtime/perl/xs/XSBind.c
----------------------------------------------------------------------
diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c
index 20cd377..bcb71f5 100644
--- a/runtime/perl/xs/XSBind.c
+++ b/runtime/perl/xs/XSBind.c
@@ -1045,6 +1045,40 @@ CFISH_Bool_To_Host_IMP(cfish_BoolNum *self) {
     return newSViv((IV)self->value);
 }
 
+/******************** HostStringable *********************/
+
+static cfish_String*
+S_call_stringify(HostStringable *self) {
+    dTHX;
+    dSP;
+    EXTEND(SP, 1);
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    mPUSHs((SV*)self->host_obj);
+    PUTBACK;
+
+    int count = call_method("stringify", G_SCALAR);
+    if (count != 1) {
+        CFISH_THROW(CFISH_ERR, "Bad callback to 'stringify': %i32",
+                    (int32_t)count);
+    }
+    SV *return_sv = POPs;
+    cfish_String *retval = (cfish_String*)XSBind_perl_to_cfish(aTHX_ 
return_sv);
+    FREETMPS;
+    LEAVE;
+
+    return retval;
+}
+
+StringableITable stringable_itable;
+
+StringableITable*
+XSBind_hoststringable_itable(void) {
+    stringable_itable.methods[0] = (cfish_method_t)S_call_stringify;
+    return &stringable_itable;
+}
+
 /********************* Clownfish::TestHarness::TestUtils ********************/
 
 

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b9aea8cb/runtime/perl/xs/XSBind.h
----------------------------------------------------------------------
diff --git a/runtime/perl/xs/XSBind.h b/runtime/perl/xs/XSBind.h
index 465574d..c1f7038 100644
--- a/runtime/perl/xs/XSBind.h
+++ b/runtime/perl/xs/XSBind.h
@@ -288,6 +288,9 @@ cfish_XSBind_allot_params(pTHX_ SV** stack, int32_t start,
 #define XSBIND_ALLOT_SV(ptr, key, keylen, required) \
     ptr, key, keylen, required, XSBIND_WANT_SV, NULL, NULL
 
+StringableITable*
+XSBind_hoststringable_itable(void);
+
 /* Define short names for most of the symbols in this file.  Note that these
  * short names are ALWAYS in effect, since they are only used for Perl and we
  * can be confident they don't conflict with anything.  (It's prudent to use

Reply via email to