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

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Tue Jun 15 03:20:00 2004
New Revision: 1079

Modified:
   mzscheme/   (props changed)
   mzscheme/Language-MzScheme/Changes
   mzscheme/Language-MzScheme/META.yml
   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/t/1-basic.t
Log:
 ----------------------------------------------------------------------
 r5608 at not:  autrijus | 2004-06-15T07:16:50.104049Z
 
 * This be 0.08.
 * properly implements and tests ->sym and ->val.
 ----------------------------------------------------------------------


Modified: mzscheme/Language-MzScheme/Changes
==============================================================================
--- mzscheme/Language-MzScheme/Changes	(original)
+++ mzscheme/Language-MzScheme/Changes	Tue Jun 15 03:20:00 2004
@@ -1,3 +1,10 @@
+[Changes for 0.08 - June 15, 2004]
+
+Object and Environment now has ->val and ->sym to easily create
+MzScheme objects from Perl.
+
+Fixed building and eliminated segmentation faults on Mac OS X.
+
 [Changes for 0.07 - June 15, 2004]
 
 MzPerl now correctly supports end-of-file as end of ";__PERL__;" regions.

Modified: mzscheme/Language-MzScheme/META.yml
==============================================================================
--- mzscheme/Language-MzScheme/META.yml	(original)
+++ mzscheme/Language-MzScheme/META.yml	Tue Jun 15 03:20:00 2004
@@ -1,5 +1,5 @@
 name: Language-MzScheme
-version: 0.07
+version: 0.08
 abstract: Perl bindings to PLT MzScheme
 author: Autrijus Tang <autrijus at autrijus.org>
 license: perl

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 15 03:20:00 2004
@@ -1,5 +1,5 @@
 package Language::MzScheme;
-$Language::MzScheme::VERSION = '0.07';
+$Language::MzScheme::VERSION = '0.08';
 
 use strict;
 use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -19,7 +19,7 @@
 
 =head1 VERSION
 
-This document describes version 0.07 of Language::MzScheme, released
+This document describes version 0.08 of Language::MzScheme, released
 June 15, 2004.
 
 =head1 SYNOPSIS

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	Tue Jun 15 03:20:00 2004
@@ -170,6 +170,33 @@
     return $obj;
 }
 
+=head2 val($scalar)
+
+Return a MzScheme object that represents the content of C<$scalar>,
+which may be a simple scalar or a reference.
+
+=cut
+
+sub val {
+    my $self = shift;
+    my $obj = S->from_perl_scalar($_[0]);
+    $Objects{S->REFADDR($obj)} ||= $self if ref($obj);
+    return $obj;
+}
+
+=head2 sym($string)
+
+Returns a MzScheme symbol object named C<$string>.
+
+=cut
+
+sub sym {
+    my $self = shift;
+    my $obj = S->intern_symbol("$_[0]");
+    $Objects{S->REFADDR($obj)} ||= $self if ref($obj);
+    return $obj;
+}
+
 =head1 CONTEXTS
 
 There are 10 different sigils, each representing a way to interpret

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	Tue Jun 15 03:20:00 2004
@@ -84,7 +84,7 @@
 }
 
 foreach my $proc (qw(
-    eval apply lambda lookup
+    eval apply lambda lookup val sym
     perl_do perl_eval perl_require perl_use perl_no
 )) {
     no strict 'refs';
@@ -159,11 +159,13 @@
 sub to_arrayref {
     my $self = shift;
 
+    # XXX - rewrite in XS
     if (S->VECTORP($self)) {
-        my $vec = S->VEC_BASE($self);
-        my $env = $self->env;
-        $Language::MzScheme::Env::Objects{+$_}||=$env for @$vec;
-        return $vec;
+        $self = S->vector_to_list($self);
+        #my $vec = S->VEC_BASE($self);
+        #my $env = $self->env;
+        #$Language::MzScheme::Env::Objects{+$_}||=$env for @$vec;
+        #return $vec;
     }
 
     return [

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 15 03:20:00 2004
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 use strict;
-use Test::More tests => 32;
+use Test::More tests => 34;
 
 use_ok('Language::MzScheme');
 
@@ -48,6 +48,11 @@
 is($port->read, '!/usr/bin/perl', 'read, port');
 is(<$port>, 'use', '<>, port');
 
+my $sym = $env->sym('symbol');
+ok($env->S->SYMBOLP($sym), 'new symbol with ->sym');
+my $str = $env->val('value');
+ok($env->S->STRINGP($str), 'new value with ->val');
+
 my $code = $env->lookup('square');
 isa_ok($code, 'CODE', 'to_coderef');
 is($code->(4), 16, '->(), scheme-lambda');