[Rt-commit] [svn] r1018 - in mzscheme: . Inline-MzScheme/lib/Inline

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Mon Jun  7 12:03:32 2004
New Revision: 1018

Modified:
   mzscheme/   (props changed)
   mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm
Log:
 ----------------------------------------------------------------------
 r5459 at not:  autrijus | 2004-06-07T16:03:44.979660Z
 
 * True type inflection from perl sode on passed args.
 ----------------------------------------------------------------------


Modified: mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm
==============================================================================
--- mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm	(original)
+++ mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm	Mon Jun  7 12:03:32 2004
@@ -4,8 +4,8 @@
 
 use strict;
 
+use B ();
 use Inline ();
-use Scalar::Util       ();
 use Language::MzScheme ();
 use Carp qw(croak confess);
 
@@ -93,24 +93,15 @@
 
 	# try to lookup a procedure object
         my $sym = Language::MzScheme::scheme_intern_symbol($name) or next;
-	my $proc = Language::MzScheme::scheme_eval($sym, $env) or next;
+	my $proc = Language::MzScheme::scheme_lookup_global($sym, $env) or next;
         Language::MzScheme::SCHEME_PROCP($proc) or next;
 
         no strict 'refs';
         *{"${pkg}::$name"} = sub {
-            my $list = join(
-                ' ',
-                map {
-                    Scalar::Util::looks_like_number($_) ? $_ : do {
-                        my $str = $_;
-                        $str =~ s/(?:["\\])/\\/g;
-                        qq("$str");
-                    };
-                } @_
-            );
+            my $list = [map $self->pscalar_to_sobject($_), @_];
 
             my $out = Language::MzScheme::scheme_make_string_output_port() or return;
-            my $rv = Language::MzScheme::scheme_eval_string("($name $list)", $env) or return;
+            my $rv = Language::MzScheme::scheme_apply($proc, scalar @$list, $list) or return;
 
             Language::MzScheme::scheme_display($rv, $out);
             return Language::MzScheme::scheme_get_string_output($out);
@@ -119,6 +110,24 @@
 
 }
 
+sub pscalar_to_sobject {
+    my $self = shift;
+    my $flags = B::svref_2object(\$_[0])->FLAGS;
+
+    if ($flags & B::SVf_IOK()) {
+        return Language::MzScheme::scheme_make_integer_value($_[0]);
+    }
+    elsif ($flags & B::SVf_NOK()) {
+        return Language::MzScheme::scheme_make_double($_[0]);
+    }
+    elsif ($flags & B::SVf_POK()) {
+        return Language::MzScheme::scheme_make_string($_[0]);
+    }
+    else {
+        die "Passing reference value into MzScheme is currently unsupported\n";
+    }
+}
+
 # no info implementation yet
 sub info { }