Use Inline::Perl5 directly instead of copying more and more code

Inline::Perl6 now uses Perl 6's Inline::Perl5 for interop implementation. This gives instant feature parity.
niner · Feb 7, 2015 · 6e0d5e8 · 6e0d5e8
1 parent 167cbae
commit 6e0d5e8
Show file tree

Hide file tree

Showing 6 changed files with 71 additions and 394 deletions.
diff --git a/Perl6.xs b/Perl6.xs
@@ -8,195 +8,21 @@
 #include <moar.h>
 #include "Perl6.h"
 
-void (*p5_callback)(PerlInterpreter *);
-SV *(*call_method_callback)(IV, char *);
-SV *(*call_function_callback)(char *, SV *args);
-SV *(*eval_code_callback)(char *);
+SV *(*p5_callback)(PerlInterpreter *);
 MVMInstance *instance;
 MVMCompUnit *cu;
+SV *perl6;
 const char *filename = PERL6_INSTALL_PATH "/languages/perl6/runtime/perl6.moarvm";
 
 static void toplevel_initial_invoke(MVMThreadContext *tc, void *data) {
     /* Create initial frame, which sets up all of the interpreter state also. */
     MVM_frame_invoke(tc, (MVMStaticFrame *)data, MVM_callsite_get_common(tc, MVM_CALLSITE_ID_NULL_ARGS), NULL, NULL, NULL, -1);
 }
 
-void init_p5_callback(void (*new_p5_callback)(PerlInterpreter *)) {
+void init_inline_perl6_new_callback(SV *(*new_p5_callback)(PerlInterpreter *)) {
     p5_callback = new_p5_callback;
 }
 
-void init_callbacks(SV *(*eval_p6_code)(char *), SV *(*call_p6_method)(IV, char *), SV *(*call_p6_function)(char *, SV *)) {
-    eval_code_callback = eval_p6_code;
-    call_method_callback = call_p6_method;
-    call_function_callback = call_p6_function;
-}
-
-U32 p5_SvIOK(PerlInterpreter *my_perl, SV* sv) {
-    return SvIOK(sv);
-}
-
-U32 p5_SvNOK(PerlInterpreter *my_perl, SV* sv) {
-    return SvNOK(sv);
-}
-
-U32 p5_SvPOK(PerlInterpreter *my_perl, SV* sv) {
-    return SvPOK(sv);
-}
-
-U32 p5_sv_utf8(PerlInterpreter *my_perl, SV* sv) {
-    if (SvUTF8(sv)) { // UTF-8 flag set -> can use string as-is
-        return 1;
-    }
-    else { // pure 7 bit ASCII is valid UTF-8 as well
-        STRLEN len;
-        char * const pv  = SvPV(sv, len);
-        STRLEN i;
-        for (i = 0; i < len; i++)
-            if (pv[i] < 0) // signed char!
-                return 0;
-        return 1;
-    }
-}
-
-IV p5_sv_iv(PerlInterpreter *my_perl, SV* sv) {
-    return SvIV(sv);
-}
-
-double p5_sv_nv(PerlInterpreter *my_perl, SV* sv) {
-    return (double)SvNV(sv);
-}
-
-int p5_is_object(PerlInterpreter *my_perl, SV* sv) {
-    return sv_isobject(sv);
-}
-
-int p5_is_sub_ref(PerlInterpreter *my_perl, SV* sv) {
-    return (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV);
-}
-
-int p5_is_array(PerlInterpreter *my_perl, SV* sv) {
-    return (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV);
-}
-
-int p5_is_hash(PerlInterpreter *my_perl, SV* sv) {
-    return (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV);
-}
-
-int p5_is_undef(PerlInterpreter *my_perl, SV* sv) {
-    return !SvOK(sv);
-}
-
-AV *p5_sv_to_av(PerlInterpreter *my_perl, SV* sv) {
-    return (AV *) SvRV(sv);
-}
-
-HV *p5_sv_to_hv(PerlInterpreter *my_perl, SV* sv) {
-    return (HV *) SvRV(sv);
-}
-
-char *p5_sv_to_char_star(PerlInterpreter *my_perl, SV *sv) {
-    STRLEN len;
-    char * const pv  = SvPV(sv, len);
-    return pv;
-}
-
-STRLEN p5_sv_to_buf(PerlInterpreter *my_perl, SV *sv, char **buf) {
-    STRLEN len;
-    *buf  = SvPV(sv, len);
-    return len;
-}
-
-void p5_sv_refcnt_dec(PerlInterpreter *my_perl, SV *sv) {
-    SvREFCNT_dec(sv);
-}
-
-void p5_sv_refcnt_inc(PerlInterpreter *my_perl, SV *sv) {
-    SvREFCNT_inc(sv);
-}
-
-SV *p5_int_to_sv(PerlInterpreter *my_perl, IV value) {
-    return newSViv(value);
-}
-
-SV *p5_float_to_sv(PerlInterpreter *my_perl, double value) {
-    return newSVnv((NV)value);
-}
-
-SV *p5_str_to_sv(PerlInterpreter *my_perl, char* value) {
-    SV * const sv = newSVpv(value, 0);
-    SvUTF8_on(sv);
-    return sv;
-}
-
-SV *p5_buf_to_sv(PerlInterpreter *my_perl, STRLEN len, char* value) {
-    SV * const sv = newSVpv(value, len);
-    return sv;
-}
-
-I32 p5_av_top_index(PerlInterpreter *my_perl, AV *av) {
-    return av_top_index(av);
-}
-
-SV *p5_av_fetch(PerlInterpreter *my_perl, AV *av, I32 key) {
-    SV ** const item = av_fetch(av, key, 0);
-    if (item)
-        return *item;
-    return NULL;
-}
-
-void p5_av_push(PerlInterpreter *my_perl, AV *av, SV *sv) {
-    av_push(av, sv);
-}
-
-I32 p5_hv_iterinit(PerlInterpreter *my_perl, HV *hv) {
-    return hv_iterinit(hv);
-}
-
-HE *p5_hv_iternext(PerlInterpreter *my_perl, HV *hv) {
-    return hv_iternext(hv);
-}
-
-SV *p5_hv_iterkeysv(PerlInterpreter *my_perl, HE *entry) {
-    return hv_iterkeysv(entry);
-}
-
-SV *p5_hv_iterval(PerlInterpreter *my_perl, HV *hv, HE *entry) {
-    return hv_iterval(hv, entry);
-}
-
-void p5_hv_store(PerlInterpreter *my_perl, HV *hv, const char *key, SV *val) {
-    hv_store(hv, key, strlen(key), val, 0);
-}
-
-SV *p5_undef(PerlInterpreter *my_perl) {
-    return &PL_sv_undef;
-}
-
-HV *p5_newHV(PerlInterpreter *my_perl) {
-    return newHV();
-}
-
-AV *p5_newAV(PerlInterpreter *my_perl) {
-    return newAV();
-}
-
-SV *p5_newRV_noinc(PerlInterpreter *my_perl, SV *sv) {
-    return newRV_noinc(sv);
-}
-
-const char *p5_sv_reftype(PerlInterpreter *my_perl, SV *sv) {
-    return sv_reftype(SvRV(sv), 1);
-}
-
-SV *p5_eval_pv(PerlInterpreter *my_perl, const char* p, I32 croak_on_error) {
-    PERL_SET_CONTEXT(my_perl);
-    return eval_pv(p, croak_on_error);
-}
-
-SV *p5_err_sv(PerlInterpreter *my_perl) {
-    return ERRSV;
-}
-
 char *library_location;
 
 MODULE = Inline::Perl6		PACKAGE = Inline::Perl6		
@@ -276,42 +102,10 @@ initialize()
         tc->interp_cu             = &cu;
         toplevel_initial_invoke(tc, cu->body.main_frame);
 
-        p5_callback(my_perl);
+        perl6 = p5_callback(my_perl);
 
 void
-destroy()
+p6_destroy()
     CODE:
+    	SvREFCNT_dec(perl6);
         MVM_vm_destroy_instance(instance);
-
-SV *
-run(code)
-        char *code
-    CODE:
-        RETVAL = eval_code_callback(code);
-    OUTPUT:
-        RETVAL
-
-SV *
-call(name, ...)
-        char *name
-    CODE:
-        AV * args = newAV();
-        av_extend(args, items - 1);
-        int i;
-        for (i = 0; i < items - 1; i++) {
-            SV * const next = SvREFCNT_inc(ST(i + 1));
-            if (av_store(args, i, next) == NULL)
-                SvREFCNT_dec(next); /* see perlguts Working with AVs */
-        }
-
-        RETVAL = call_function_callback(name, newRV_noinc((SV *) args));
-    OUTPUT:
-        RETVAL
-
-SV *
-invoke(name)
-        char *name
-    CODE:
-        RETVAL = call_method_callback(0, name);
-    OUTPUT:
-        RETVAL
diff --git a/inline.pl6 b/inline.pl6
@@ -1,4 +1,3 @@
 use v6;
-use lib <lib>;
-use Inline::Perl6Helper;
-Inline::Perl6Helper.new;
+use Inline::Perl5;
+Inline::Perl5::init_inline_perl6_callback(@*ARGS[0]);
diff --git a/lib/Inline/Perl6.pm b/lib/Inline/Perl6.pm
@@ -32,7 +32,19 @@ __PACKAGE__->bootstrap($VERSION);
 
 setup_library_location($DynaLoader::dl_shared_objects[-1]);
 
-# Preloaded methods go here.
+sub run {
+    my ($code) = @_;
+    return v6::run($code);
+}
+
+sub call {
+    return v6::call(@_);
+}
+
+sub destroy {
+    v6::uninit();
+    p6_destroy();
+}
 
 1;
 __END__