Perl: add vector, hash-map, metadata, atom support. TCO let*

- Changes all collections to be one level of inderection where the top
  level is always a hash containing 'meta' and 'val'.

1 files changed, 41 insertions, 18 deletions

diff --git a/perl/step2_eval.pl b/perl/step2_eval.pl
index a448385..1655a29 100644
--- a/perl/step2_eval.pl
+++ b/perl/step2_eval.pl
@@ -1,9 +1,10 @@
 use strict;
 use warnings FATAL => qw(all);
-use readline qw(readline);
+use readline qw(mal_readline);
 use feature qw(switch);
 use Data::Dumper;
 
+use types qw(_list_Q);
 use reader;
 use printer;
 
@@ -25,9 +26,20 @@ sub eval_ast {
             }
         }
         when (/^List/) {
-            my @lst = map {EVAL($_, $env)} @$ast;
+            my @lst = map {EVAL($_, $env)} @{$ast->{val}};
             return List->new(\@lst);
         }
+        when (/^Vector/) {
+            my @lst = map {EVAL($_, $env)} @{$ast->{val}};
+            return Vector->new(\@lst);
+        }
+        when (/^HashMap/) {
+            my $new_hm = {};
+            foreach my $k (keys($ast->{val})) {
+                $new_hm->{$k} = EVAL($ast->get($k), $env);
+            }
+            return HashMap->new($new_hm);
+        }
         default {
             return $ast;
         }
@@ -37,13 +49,13 @@ sub eval_ast {
 sub EVAL {
     my($ast, $env) = @_;
     #print "EVAL: " . printer::_pr_str($ast) . "\n";
-    if (! ((ref $ast) =~ /^List/)) {
+    if (! _list_Q($ast)) {
         return eval_ast($ast, $env);
     }
 
     # apply list
     my $el = eval_ast($ast, $env);
-    my $f = $el->[0];
+    my $f = $el->nth(0);
     return &{ $f }($el->rest());
 }
 
@@ -60,21 +72,32 @@ sub REP {
     return PRINT(EVAL(READ($str), $repl_env));
 }
 
-$repl_env->{'+'} = sub { Integer->new(${$_[0][0]} + ${$_[0][1]}) };
-$repl_env->{'-'} = sub { Integer->new(${$_[0][0]} - ${$_[0][1]}) };
-$repl_env->{'*'} = sub { Integer->new(${$_[0][0]} * ${$_[0][1]}) };
-$repl_env->{'/'} = sub { Integer->new(${$_[0][0]} / ${$_[0][1]}) };
+$repl_env->{'+'} = sub { Integer->new(${$_[0]->nth(0)} + ${$_[0]->nth(1)}) };
+$repl_env->{'-'} = sub { Integer->new(${$_[0]->nth(0)} - ${$_[0]->nth(1)}) };
+$repl_env->{'*'} = sub { Integer->new(${$_[0]->nth(0)} * ${$_[0]->nth(1)}) };
+$repl_env->{'/'} = sub { Integer->new(${$_[0]->nth(0)} / ${$_[0]->nth(1)}) };
 
 while (1) {
-    my $line = readline("user> ");
+    my $line = mal_readline("user> ");
     if (! defined $line) { last; }
-    eval {
-        use autodie; # always "throw" errors
-        print(REP($line), "\n");
-        1;
-    }; 
-    if (my $err = $@) {
-        chomp $err;
-        print "Error: $err\n";
-    }
+    do {
+        local $@;
+        my $ret;
+        eval {
+            use autodie; # always "throw" errors
+            print(REP($line), "\n");
+            1;
+        } or do {
+            my $err = $@;
+            given (ref $err) {
+                when (/^BlankException/) {
+                    # ignore and continue
+                }
+                default {
+                    chomp $err;
+                    print "Error: $err\n";
+                }
+            }
+        };
+    };
 }