Merge pull request #494 from alimpfard/master

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

diff --git a/perl/step4_if_fn_do.pl b/perl/step4_if_fn_do.pl
index 8d025ec..be0611b 100644 (file)
--- a/perl/step4_if_fn_do.pl
+++ b/perl/step4_if_fn_do.pl
@@ -1,15 +1,16 @@
 use strict;
-use warnings FATAL => qw(all);
+use warnings;
 no if $] >= 5.018, warnings => "experimental::smartmatch";
+use feature qw(switch);
 use File::Basename;
 use lib dirname (__FILE__);
+
+use Data::Dumper;
 use List::Util qw(pairs pairmap);
 use Scalar::Util qw(blessed);
-use readline qw(mal_readline set_rl_mode);
-use feature qw(switch);
-use Data::Dumper;
 
-use types qw($nil $true $false _list_Q);
+use readline qw(mal_readline set_rl_mode);
+use types qw($nil $true $false);
 use reader;
 use printer;
 use env;
@@ -38,44 +39,47 @@ sub eval_ast {
 sub EVAL {
     my($ast, $env) = @_;
     #print "EVAL: " . printer::_pr_str($ast) . "\n";
-    if (! _list_Q($ast)) {
+    if (! $ast->isa('Mal::List')) {
         return eval_ast($ast, $env);
     }
 
     # apply list
-    my ($a0, $a1, $a2, $a3) = @$ast;
-    if (!$a0) { return $ast; }
+    unless (@$ast) { return $ast; }
+    my ($a0) = @$ast;
     given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) {
         when ('def!') {
-            my $res = EVAL($a2, $env);
-            return $env->set($a1, $res);
+           my (undef, $sym, $val) = @$ast;
+            return $env->set($sym, EVAL($val, $env));
         }
         when ('let*') {
+           my (undef, $bindings, $body) = @$ast;
             my $let_env = Mal::Env->new($env);
-           foreach my $pair (pairs @$a1) {
+           foreach my $pair (pairs @$bindings) {
                my ($k, $v) = @$pair;
                 $let_env->set($k, EVAL($v, $let_env));
             }
-            return EVAL($a2, $let_env);
+            return EVAL($body, $let_env);
         }
         when ('do') {
-            my $el = eval_ast($ast->rest(), $env);
-            return $el->[$#$el];
+           my (undef, @todo) = @$ast;
+            my $el = eval_ast(Mal::List->new(\@todo), $env);
+            return pop @$el;
         }
         when ('if') {
-            my $cond = EVAL($a1, $env);
+           my (undef, $if, $then, $else) = @$ast;
+            my $cond = EVAL($if, $env);
             if ($cond eq $nil || $cond eq $false) {
-                return $a3 ? EVAL($a3, $env) : $nil;
+                return $else ? EVAL($else, $env) : $nil;
             } else {
-                return EVAL($a2, $env);
+                return EVAL($then, $env);
             }
         }
         when ('fn*') {
-            return bless sub {
+           my (undef, $params, $body) = @$ast;
+            return Mal::Function->new(sub {
                 #print "running fn*\n";
-                my $args = \@_;
-                return EVAL($a2, Mal::Env->new($env, $a1, $args));
-            }, 'Mal::CoreFunction';
+                return EVAL($body, Mal::Env->new($env, $params, \@_));
+            });
         }
         default {
             my @el = @{eval_ast($ast, $env)};