[Rt-commit] [svn] r1070 - in mzscheme: . Language-MzScheme Language-MzScheme/lib/Language Language-MzScheme/lib/Language/MzScheme Language-MzScheme/script

autrijus at pallas.eruditorum.org autrijus at pallas.eruditorum.org
Mon Jun 14 17:25:06 EDT 2004


Author: autrijus
Date: Mon Jun 14 17:25:06 2004
New Revision: 1070

Modified:
   mzscheme/   (props changed)
   mzscheme/Language-MzScheme/Changes
   mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
   mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm
   mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm
   mzscheme/Language-MzScheme/script/mzperl
Log:
 ----------------------------------------------------------------------
 r5597 at not:  autrijus | 2004-06-14T21:18:30.831307Z
 
 * 0.07.
 * mzperl now correctly supports eof as end of ;__PERL__;.
 * all mzscheme code are now evaluated in Language::MzScheme::Env::__eval;
   this made Spiffy-based modules (eg. IO::All) work better.
 * avoids importing invalid symbols.
 ----------------------------------------------------------------------


Modified: mzscheme/Language-MzScheme/Changes
==============================================================================
--- mzscheme/Language-MzScheme/Changes	(original)
+++ mzscheme/Language-MzScheme/Changes	Mon Jun 14 17:25:06 2004
@@ -1,3 +1,16 @@
+[Changes for 0.07 - June 15, 2004]
+
+MzPerl now correctly supports end-of-file as end of ";__PERL__;" regions.
+
+All MzScheme code are now evaluated in Language::MzScheme::Env::__eval;
+this made Spiffy-based modules (eg. IO::All) work better.
+
+Avoid importing invalid symbols, such as '(OVERLOAD', into MzScheme space.
+
+Adds nifty call/cc example to bin/mzperl's POD.
+
+Suppressed harmless warnings under -w.
+
 [Changes for 0.06 - June 14, 2004]
 
 Beginning of at least some module documentations.

Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme.pm	(original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme.pm	Mon Jun 14 17:25:06 2004
@@ -1,5 +1,5 @@
 package Language::MzScheme;
-$Language::MzScheme::VERSION = '0.06';
+$Language::MzScheme::VERSION = '0.07';
 
 use strict;
 use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -19,8 +19,8 @@
 
 =head1 VERSION
 
-This document describes version 0.06 of Language::MzScheme, released
-June 14, 2004.
+This document describes version 0.07 of Language::MzScheme, released
+June 15, 2004.
 
 =head1 SYNOPSIS
 
@@ -58,7 +58,8 @@
         my $idx = index(lc($func), 'scheme_');
         $idx > -1 or next;
         my $sym = substr($func, $idx + 7);
-        *$sym = sub { shift; goto &$func }
+        my $code = __PACKAGE__->can($func);
+        *$sym = sub { shift; goto &$code }
             unless defined &$sym or defined $$sym;
     }
 
@@ -66,7 +67,8 @@
         my $idx = index(lc($func), 'mzscheme_');
         $idx > -1 or next;
         my $sym = substr($func, $idx + 9);
-        *$sym = sub { shift; goto &$func }
+        my $code = __PACKAGE__->can($func);
+        *$sym = sub { shift; goto &$code }
             unless defined &$sym or defined $$sym;
     }
 

Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm	(original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme/Env.pm	Mon Jun 14 17:25:06 2004
@@ -79,7 +79,7 @@
 
     if (!defined($code)) {
         no strict 'refs';
-        foreach my $sym (sort keys %{"$name\::"}) {
+        foreach my $sym (grep !/^[^a-z]|\W/, sort keys %{"$name\::"}) {
             my $code = *{${"$name\::"}{$sym}}{CODE} or next;
             $sym =~ tr/_/-/;
             $self->define("$name\::$sym", $code);
@@ -143,9 +143,14 @@
 
 sub eval {
     my $self = shift;
-    my $obj = UNIVERSAL::isa($_[0], S."::Object")
-        ? S->do_eval($_[0], $self)
-        : S->do_eval_string_all($_[0], $self, 1);
+
+    my $obj = do {
+        package Language::MzScheme::Env::__eval;
+        UNIVERSAL::isa($_[0], "Language::MzScheme::Object")
+            ? Language::MzScheme::mzscheme_do_eval($_[0], $self)
+            : Language::MzScheme::mzscheme_do_eval_string_all($_[0], $self, 1);
+    };
+
     $Objects{S->REFADDR($obj)} ||= $self if ref($obj);
     return $obj;
 }
@@ -209,7 +214,7 @@
 
 sub _init_perl_wrappers {
     my $self = shift;
-    my $env_pkg = ref($self).(0+$self);
+    my $env_pkg = __PACKAGE__.'::__eval'; #(0+$self);
 
     no strict 'refs';
     *{"$env_pkg\::mz_eval"} = sub { $self->eval(@_) };
@@ -249,15 +254,17 @@
         my %seen = map ( ( $_ => 1 ), keys %{"$env_pkg\::"} );
 
         local $@;
-        eval "package $env_pkg;\nuse $pkg ".(
+        my @args;
+        my $eval = "package $env_pkg;\nuse $pkg ".(
             @_ ? do {
-                @_ = map { $_->isa('ARRAY') ? @$_ : $_ } @_;
-                '@_;';
+                @args = map { $_->isa('ARRAY') ? @$_ : $_ } @_;
+                '@args;';
             } : ';'
         );
+        eval $eval;
         die $@ if $@;
 
-        foreach my $sym (sort keys %{"$env_pkg\::"}) {
+        foreach my $sym (grep !/^[^a-z]|\W/, sort keys %{"$env_pkg\::"}) {
             next if $seen{$sym};
             my $code = *{${"$pkg\::"}{$sym}}{CODE} or next;
             $self->define($sym, $code);

Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm	(original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme/Object.pm	Mon Jun 14 17:25:06 2004
@@ -120,7 +120,8 @@
 sub env {
     my $self = shift;
     $Language::MzScheme::Env::Objects{S->REFADDR($self)}
-        or die "Cannot find associated environment";
+        ||= $Language::MzScheme::Env::Objects{0}
+            or die "Cannot find associated environment";
 }
 
 sub bless {

Modified: mzscheme/Language-MzScheme/script/mzperl
==============================================================================
--- mzscheme/Language-MzScheme/script/mzperl	(original)
+++ mzscheme/Language-MzScheme/script/mzperl	Mon Jun 14 17:25:06 2004
@@ -42,7 +42,7 @@
     };
 
     $code =~ s{^\s*#!.*}{};
-    $code =~ s{\;\s*__PERL__\s*;(.*?);\s*__END__\s*;}{
+    $code =~ s{\;\s*__PERL__\s*;(.*?)(?:;\s*__END__\s*;|\z)}{
         '(perl-eval "'.$escape->($1).'")'
     }egs;
     $code;
@@ -103,6 +103,16 @@
 
 Scheme has no CPAN.  Perl5 has no macros and no continuations.  So... :-)
 
+=head2 Continuations?  In Perl?
+
+Yes.  To wit:
+
+    #!/usr/local/bin/mzperl
+    (let* ((yin ((perl-eval "sub { print $/; @_ }")
+                 (call/cc (perl-eval "sub { @_ }"))))
+           (yang ((perl-eval "sub { print '*'; @_ }")
+                  (call/cc (perl-eval "sub { @_ }"))))) (yin yang))
+
 =head1 AUTHORS
 
 Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>


More information about the Rt-commit mailing list