Merge pull request #158 from dubek/first-rest-nil

[jackhill/mal.git] / perl / step6_file.pl

diff --git a/perl/step6_file.pl b/perl/step6_file.pl
index 4606297..70ec3dd 100644 (file)
--- a/perl/step6_file.pl
+++ b/perl/step6_file.pl
@@ -1,10 +1,13 @@
 use strict;
 use warnings FATAL => qw(all);
-use readline qw(readline);
+no if $] >= 5.018, warnings => "experimental::smartmatch";
+use File::Basename;
+use lib dirname (__FILE__);
+use readline qw(mal_readline set_rl_mode);
 use feature qw(switch);
 use Data::Dumper;
 
-use types qw($nil $true $false);
+use types qw($nil $true $false _list_Q);
 use reader;
 use printer;
 use env;
@@ -21,12 +24,23 @@ sub eval_ast {
     my($ast, $env) = @_;
     given (ref $ast) {
         when (/^Symbol/) {
-            $env->get($$ast);
+            $env->get($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;
         }
@@ -39,27 +53,30 @@ sub EVAL {
     while (1) {
 
     #print "EVAL: " . printer::_pr_str($ast) . "\n";
-    if (! ((ref $ast) =~ /^List/)) {
+    if (! _list_Q($ast)) {
         return eval_ast($ast, $env);
     }
 
     # apply list
-    my ($a0, $a1, $a2, $a3) = @$ast;
+    my ($a0, $a1, $a2, $a3) = @{$ast->{val}};
     given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) {
         when (/^def!$/) {
             my $res = EVAL($a2, $env);
-            return $env->set($$a1, $res);
+            return $env->set($a1, $res);
         }
         when (/^let\*$/) {
             my $let_env = Env->new($env);
-            for(my $i=0; $i < scalar(@{$a1}); $i+=2) {
-                $let_env->set(${$a1->[$i]}, EVAL($a1->[$i+1], $let_env));
+            for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) {
+                $let_env->set($a1->nth($i), EVAL($a1->nth($i+1), $let_env));
             }
-            return EVAL($a2, $let_env);
+            $ast = $a2;
+            $env = $let_env;
+            # Continue loop (TCO)
         }
         when (/^do$/) {
-            eval_ast($ast->slice(1, $#{$ast}-1), $env);
-            $ast = $ast->[$#{$ast}];
+            eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env);
+            $ast = $ast->nth($#{$ast->{val}});
+            # Continue loop (TCO)
         }
         when (/^if$/) {
             my $cond = EVAL($a1, $env);
@@ -68,16 +85,18 @@ sub EVAL {
             } else {
                 $ast = $a2;
             }
+            # Continue loop (TCO)
         }
         when (/^fn\*$/) {
             return Function->new(\&EVAL, $a2, $env, $a1);
         }
         default {
             my $el = eval_ast($ast, $env);
-            my $f = $el->[0];
+            my $f = $el->nth(0);
             if ((ref $f) =~ /^Function/) {
                 $ast = $f->{ast};
                 $env = $f->gen_env($el->rest());
+                # Continue loop (TCO)
             } else {
                 return &{ $f }($el->rest());
             }
@@ -101,29 +120,46 @@ sub REP {
 }
 
 # core.pl: defined using perl
-foreach my $n (%$core_ns) { $repl_env->set($n, $core_ns->{$n}); }
-$repl_env->set('eval', sub { EVAL($_[0][0], $repl_env); });
+foreach my $n (%$core_ns) {
+    $repl_env->set(Symbol->new($n), $core_ns->{$n});
+}
+$repl_env->set(Symbol->new('eval'), sub { EVAL($_[0]->nth(0), $repl_env); });
 my @_argv = map {String->new($_)}  @ARGV[1..$#ARGV];
-$repl_env->set('*ARGV*', List->new(\@_argv));
+$repl_env->set(Symbol->new('*ARGV*'), List->new(\@_argv));
 
 # core.mal: defined using the language itself
 REP("(def! not (fn* (a) (if a false true)))");
 REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
 
-if ($#ARGV > 0) {
+if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") {
+    set_rl_mode("raw");
+    shift @ARGV;
+}
+if (scalar(@ARGV) > 0) {
     REP("(load-file \"" . $ARGV[0] . "\")");
     exit 0;
 }
 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";
+                }
+            }
+        };
+    };
 }