perl: Use a proper Mal::Keyword type.

Representing a keyword as a Mal::String with a magic first character was
beginning to annoy me, so instead create a proper Mal::Keyword class.
To support using both Mal::String and Mal::Keyword as hash keys,
overload stringification on all Mal::Scalar subclasses.

This means that now instead of a Mal::String stringifying to something
like "Mal::String=SCALAR(0x5744ea58)", it will stringify to something
more like "Mal::String abc", which is readable, has the correct
properties for a hash-map key, and is easy to convert back into a
Mal::String.

This turns out to work perfectly well, and entirely accidentally
arranges that 'keyword' now works properly when fed a keyword as input.

diff --git a/perl/core.pm b/perl/core.pm
index f7b5aed..2e462eb 100644 (file)
--- a/perl/core.pm
+++ b/perl/core.pm
@@ -8,7 +8,7 @@ use List::Util qw(pairmap);
 use Time::HiRes qw(time);
 
 use readline;
-use types qw(_equal_Q $nil $true $false);
+use types qw(_equal_Q thaw_key $nil $true $false);
 use reader qw(read_str);
 use printer qw(_pr_str);
 use interop qw(pl_to_mal);
@@ -49,28 +49,28 @@ sub slurp {
 
 sub assoc {
     my $src_hsh = shift;
-    return Mal::HashMap->new( { %$src_hsh, pairmap { $$a => $b } @_ } );
+    return Mal::HashMap->new( { %$src_hsh, @_ } );
 }
 
 sub dissoc {
     my $new_hsh = { %{shift @_} };
-    delete @{$new_hsh}{map $$_, @_};
+    delete @{$new_hsh}{@_};
     return Mal::HashMap->new($new_hsh);
 }
 
 
 sub get {
     my ($hsh, $key) = @_;
-    return $hsh->{$$key} // $nil;
+    return $hsh->{$key} // $nil;
 }
 
 sub contains_Q {
     my ($hsh, $key) = @_;
-    return (exists $hsh->{$$key}) ? $true : $false;
+    return (exists $hsh->{$key}) ? $true : $false;
 }
 
 sub mal_keys {
-    my @ks = map { Mal::String->new($_) } keys %{$_[0]};
+    my @ks = map { thaw_key($_) } keys %{$_[0]};
     return Mal::List->new(\@ks);
 }
 
@@ -130,7 +130,7 @@ sub seq {
     } elsif ($arg->isa('Mal::Vector')) {
         return $nil unless @$arg;
         return Mal::List->new([@$arg]);
-    } elsif ($arg->isa('Mal::String') && !$arg->isa('Mal::Keyword')) {
+    } elsif ($arg->isa('Mal::String')) {
         return $nil if length($$arg) == 0;
         my @chars = map { Mal::String->new($_) } split(//, $$arg);
         return Mal::List->new(\@chars);
@@ -175,7 +175,7 @@ sub pl_STAR {
     'number?'     => sub { $_[0]->isa('Mal::Integer') ? $true : $false },
     'symbol'      => sub { Mal::Symbol->new(${$_[0]}) },
     'symbol?'     => sub { $_[0]->isa('Mal::Symbol') ? $true : $false },
-    'string?'     => sub { $_[0]->isa('Mal::String') && !$_[0]->isa('Mal::Keyword') ? $true : $false },
+    'string?'     => sub { $_[0]->isa('Mal::String') ? $true : $false },
     'keyword'     => sub { Mal::Keyword->new(${$_[0]}) },
     'keyword?'    => sub { $_[0]->isa('Mal::Keyword') ? $true : $false },
     'fn?'         => sub { $_[0]->isa('Mal::Function') ? $true : $false },

diff --git a/perl/interop.pm b/perl/interop.pm
index c38cf41..3c068f9 100644 (file)
--- a/perl/interop.pm
+++ b/perl/interop.pm
@@ -4,6 +4,7 @@ use warnings;
 
 use Exporter 'import';
 our @EXPORT_OK = qw( pl_to_mal );
+use List::Util qw(pairmap);
 use Scalar::Util qw(looks_like_number);
 
 use types qw($nil);
@@ -15,11 +16,8 @@ sub pl_to_mal {
             my @arr = map {pl_to_mal($_)} @$obj;
             return Mal::List->new(\@arr);
         } elsif (/^HASH/) {
-            my $hsh = {};
-            foreach my $key (keys %$obj) {
-                $hsh->{$key} = pl_to_mal($obj->{$key});
-            }
-            return Mal::HashMap->new($hsh)
+            my %hsh = map { pl_to_mal($_) } %$obj;
+            return Mal::HashMap->new(\%hsh)
         } else {
            if (!defined($obj)) {
                return $nil;

diff --git a/perl/printer.pm b/perl/printer.pm
index ace531f..3397065 100644 (file)
--- a/perl/printer.pm
+++ b/perl/printer.pm
@@ -5,7 +5,7 @@ use warnings;
 use Exporter 'import';
 our @EXPORT_OK = qw( _pr_str );
 
-use types qw($nil $true $false);
+use types qw(thaw_key $nil $true $false);
 
 use Data::Dumper;
 use List::Util qw(pairmap);
@@ -18,12 +18,12 @@ sub _pr_str {
     } elsif ($obj->isa('Mal::Vector')) {
        return '[' . join(' ', map { _pr_str($_, $_r) } @$obj) . ']';
     } elsif ($obj->isa('Mal::HashMap')) {
-       return '{' . join(' ', pairmap { _pr_str(Mal::String->new($a), $_r) =>
+       return '{' . join(' ', pairmap { _pr_str(thaw_key($a), $_r) =>
                                         _pr_str($b, $_r) } %$obj) . '}';
+    } elsif ($obj->isa('Mal::Keyword')) {
+       return ":$$obj";
     } elsif ($obj->isa('Mal::String')) {
-       if ($$obj =~ /^\x{029e}/) {
-           return ":$'";
-       } elsif ($_r) {
+       if ($_r) {
            my $str = $$obj;
            $str =~ s/\\/\\\\/g;
            $str =~ s/"/\\"/g;

diff --git a/perl/types.pm b/perl/types.pm
index 94ccdfa..e24b73e 100644 (file)
--- a/perl/types.pm
+++ b/perl/types.pm
@@ -4,7 +4,7 @@ use warnings;
 
 use Data::Dumper;
 use Exporter 'import';
-our @EXPORT_OK = qw(_equal_Q
+our @EXPORT_OK = qw(_equal_Q thaw_key
                     $nil $true $false);
 
 # General functions
@@ -60,9 +60,22 @@ sub _equal_Q {
 {
     package Mal::Scalar;
     use parent -norequire, 'Mal::Type';
+    # Overload stringification so that its result is something
+    # suitable for use as a hash-map key.  The important thing here is
+    # that strings and keywords are distinct: support for other kinds
+    # of scalar is a bonus.
+    use overload '""' => sub { my $self = shift; ref($self) . " " . $$self },
+       fallback => 1;
     sub new { my ($class, $value) = @_; bless \$value, $class }
 }
 
+# This function converts hash-map keys back into full objects
+
+sub thaw_key ($) {
+    my ($class, $value) = split(/ /, $_[0], 2);
+    return $class->new($value);
+}
+
 {
     package Mal::Nil;
     use parent -norequire, 'Mal::Scalar';
@@ -99,14 +112,12 @@ our $false = Mal::False->new('false');
 {
     package Mal::String;
     use parent -norequire, 'Mal::Scalar';
-    # "isa" can distinguish keywords from other strings.
-    sub isa {
-       my $self = shift;
-       return 1 if ($_[0] eq 'Mal::Keyword' && $$self =~ /^\x{029e}/);
-       return $self->SUPER::isa(@_);
-    }
-    # Pseudo-constructor for making keywords.
-    sub Mal::Keyword::new { shift; Mal::String->new("\x{029e}" . $_[0]) }
+}
+
+
+{
+    package Mal::Keyword;
+    use parent -norequire, 'Mal::Scalar';
 }
 
 
@@ -147,7 +158,7 @@ our $false = Mal::False->new('false');
     sub new  {
         my ($class, $src) = @_;
         if (reftype($src) eq 'ARRAY') {
-            $src = {pairmap { $$a => $b } @$src};
+            $src = {@$src};
        }
         return bless $src, $class;
     }