[Rt-commit] [svn] r1032 - in mzscheme: . Language-MzScheme Language-MzScheme/lib/Language Language-MzScheme/t

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Tue Jun  8 02:36:10 2004
New Revision: 1032

Modified:
   mzscheme/   (props changed)
   mzscheme/Language-MzScheme/MANIFEST
   mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
   mzscheme/Language-MzScheme/mzscheme.c
   mzscheme/Language-MzScheme/mzscheme.h
   mzscheme/Language-MzScheme/mzscheme.i
   mzscheme/Language-MzScheme/t/1-basic.t
Log:
 ----------------------------------------------------------------------
 r5484 at not:  autrijus | 2004-06-08T06:36:17.097539Z
 
 * The first working sample of eval-perl.  Not great (no arg passing) but works.
 ----------------------------------------------------------------------


Modified: mzscheme/Language-MzScheme/MANIFEST
==============================================================================
--- mzscheme/Language-MzScheme/MANIFEST	(original)
+++ mzscheme/Language-MzScheme/MANIFEST	Tue Jun  8 02:36:10 2004
@@ -13,6 +13,8 @@
 MANIFEST			This list of files
 MANIFEST.SKIP
 META.yml
+mzscheme.c
+mzscheme.h
 mzscheme.i
 README
 SIGNATURE

Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme.pm	(original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme.pm	Tue Jun  8 02:36:10 2004
@@ -36,8 +36,10 @@
 
 =cut
 
-mzscheme_init() unless $Language::MzScheme::Initialized;
-$Language::MzScheme::Initialized++;
+if (!$Language::MzScheme::Initialized) {
+    mzscheme_init() if defined &mzscheme_init;
+    $Language::MzScheme::Initialized++;
+}
 
 1;
 

Modified: mzscheme/Language-MzScheme/mzscheme.c
==============================================================================
--- mzscheme/Language-MzScheme/mzscheme.c	(original)
+++ mzscheme/Language-MzScheme/mzscheme.c	Tue Jun  8 02:36:10 2004
@@ -7,20 +7,20 @@
     scheme_set_stack_base(&dummy, 1);
 }
 
-Scheme_Object
-*mzscheme_make_perl_prim_w_arity (SV *cv_ref, const char *name, int mina, int maxa) {
-    scheme_make_closed_prim_w_arity(
+Scheme_Object *
+mzscheme_make_perl_prim_w_arity (const char *cv_ref, const char *name, int mina, int maxa) {
+    return scheme_make_closed_prim_w_arity(
         &_mzscheme_closed_prim_CV,
-        cv_ref, name, mina, maxa
+        (void *)cv_ref, name, mina, maxa
     );
 }
 
 Scheme_Object *
 _mzscheme_closed_prim_CV (void *callback, int argc, Scheme_Object **argv) {
     dSP ;
-    PUSHs((SV *)newRV((SV*)_mzscheme_objects_AV(argv)));
-    call_sv((SV *)callback, G_SCALAR);
-    return (Scheme_Object *)SvIV((SV*)SvRV(POPs));
+    PUSHMARK(SP) ;
+    call_pv((const char*)callback, G_DISCARD|G_NOARGS) ;
+    return scheme_undefined;
 }
 
 AV *

Modified: mzscheme/Language-MzScheme/mzscheme.h
==============================================================================
--- mzscheme/Language-MzScheme/mzscheme.h	(original)
+++ mzscheme/Language-MzScheme/mzscheme.h	Tue Jun  8 02:36:10 2004
@@ -1,6 +1,3 @@
 
-void            mzscheme_init ();
-Scheme_Object*  mzscheme_make_perl_prim_w_arity (SV *cv_ref, const char *name, int mina, int maxa);
-AV*             _mzscheme_objects_AV (Scheme_Object ** objects);
-Scheme_Object*  _mzscheme_closed_prim_CV (void *d, int argc, Scheme_Object **argv);
-
+AV*                 _mzscheme_objects_AV (Scheme_Object ** objects);
+Scheme_Object*      _mzscheme_closed_prim_CV (void *d, int argc, Scheme_Object **argv);

Modified: mzscheme/Language-MzScheme/mzscheme.i
==============================================================================
--- mzscheme/Language-MzScheme/mzscheme.i	(original)
+++ mzscheme/Language-MzScheme/mzscheme.i	Tue Jun  8 02:36:10 2004
@@ -5,7 +5,7 @@
 %}
 
 void            mzscheme_init();
-Scheme_Object*  mzscheme_make_perl_prim_w_arity(SV *cv_ref, const char *name, int mina, int maxa);
+Scheme_Object*  mzscheme_make_perl_prim_w_arity(const char *cv_ref, const char *name, int mina, int maxa);
 
 %typemap(in) Scheme_Object ** {
     AV *tempav;

Modified: mzscheme/Language-MzScheme/t/1-basic.t
==============================================================================
--- mzscheme/Language-MzScheme/t/1-basic.t	(original)
+++ mzscheme/Language-MzScheme/t/1-basic.t	Tue Jun  8 02:36:10 2004
@@ -5,13 +5,19 @@
 use FindBin;
 use Language::MzScheme;
 
-BEGIN { plan tests => 1 }
+BEGIN { plan tests => 3 }
 
 my $env = scheme_basic_env();
 ok(eval_scheme('(+ 1 2)'), 3);
 
-my $code = sub { "Hello from Perl!" };
-#mzscheme_make_perl_prim_w_arity($code, 'hello', 0, 0); # XXX FIXME
+my $hello;
+sub perl_hello { $hello = "Hello from Perl!" };
+my $prim = mzscheme_make_perl_prim_w_arity('perl_hello', 'perl-hello', 0, 0);
+scheme_add_global('perl-hello', $prim, $env);
+ok(eval_scheme('perl-hello'), '#<primitive:perl-hello>');
+
+eval_scheme('(perl-hello)');
+ok($hello, "Hello from Perl!");
 
 sub eval_scheme {
     my $out = scheme_make_string_output_port();