[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