Exporting a empty sub using :from<perl5> works.

sorear · Feb 21, 2012 · 3da37be · 3da37be
1 parent ea24f5c
commit 3da37be
Show file tree

Hide file tree

Showing 4 changed files with 42 additions and 2 deletions.
diff --git a/lib/CodeGen.cs b/lib/CodeGen.cs
@@ -3692,6 +3692,12 @@ public class DowncallReceiver : CallReceiver {
                 return new string[0];
             return Builtins.UnboxLoS(bv.v);
         }
+        public static object unit_use_from_perl5(object[] args) {
+		string name = (string)args[2];
+		Variable code = Kernel.BoxAnyMO<string>("Niecza::Interoperability::use_module('"+name+"')", Kernel.StrMO);
+		string sub = Kernel.UnboxAny<string>(Builtins.eval_perl5(code).Fetch());
+		return sub;
+	}
         public static object unit_need_unit(object[] args) {
             // LinkUnit state is owned by the root
             RuntimeUnit ru = (RuntimeUnit)Handle.Unbox(args[1]);

diff --git a/lib/p5embed.c b/lib/p5embed.c
@@ -28,7 +28,7 @@ void p5embed_initialize()
   char *embedding[] = { "", "-e", "0" };
   perl_parse(my_perl, xs_init, 3, embedding, NULL);
   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
-//  eval_pv("use lib 'perl5';use Niecza::Interoperability",TRUE);
+  eval_pv("use lib 'perl5';use Niecza::Interoperability",TRUE);
 }
 
 SV* p5embed_eval(char* code) { 

diff --git a/perl5/Niecza/Interoperability.pm b/perl5/Niecza/Interoperability.pm
@@ -1,3 +1,16 @@
 package Niecza::Interoperability;
-#BEGIN {print "ok 1 # loaded Niecza::Interoperability\n"}
+use v5.10;
+use Package::Stash;
+my $id = 0;
+sub use_module {
+    my ($module) = @_; 
+    my $stash = Package::Stash->new('Niecza::Stash::Interopability::TMP'.$id++);
+    eval("package ".$stash->name.";use $module;");
+    warn $@ if $@;
+    my @subs = $stash->list_all_symbols('CODE');
+    for my $symbol (@subs) {
+	say "importing sub $symbol from $module";
+    }
+    $subs[0];
+}
 1;
diff --git a/src/NieczaActions.pm6 b/src/NieczaActions.pm6
@@ -3383,6 +3383,27 @@ method statement_control:use ($/) {
     my $name = $<module_name>.ast<name>;
     my $args = $<arglist> ?? $<arglist>.ast !! [];
 
+    my $sub = $*CURLEX<!sub>;
+    my $placeholder = $*unit.create_sub(
+        outer      => $sub,
+        cur_pkg    => $sub.cur_pkg,
+        name       => "placeholder",
+        class      => 'Code');
+    $placeholder.finish($OpStatementList.new);
+
+    # support loading modules from perl5
+    if $<module_name><longname><colonpair> -> $pairs {
+	if $pairs[0].<identifier> eq 'from' && $pairs[0].<coloncircumfix><circumfix><nibble> eq 'perl5' {
+	    my $func = $*unit.use_from_perl5($name);
+	    say "importing $func from p5 land";
+            $*CURLEX<!sub>.add_my_sub($func,$placeholder);
+	    return;
+	} else {
+		$/.CURSOR.sorry("NYI");
+	}
+    } else {
+    }
+
     if defined $<module_name>.ast.<args> {
         $/.CURSOR.sorry("'use' of an instantiated role not yet understood");
         return;