perl: Rename all mal classes to begin with "Mal::".
[jackhill/mal.git] / perl / step2_eval.pl
CommitLineData
a3b0621d 1use strict;
60f2b363 2use warnings FATAL => qw(all);
f26bc011
JM
3use File::Basename;
4use lib dirname (__FILE__);
7a17c605 5use List::Util qw(pairmap);
b8ee29b2 6use readline qw(mal_readline set_rl_mode);
a3b0621d
JM
7use Data::Dumper;
8
89bd4de1 9use types qw(_list_Q);
a3b0621d
JM
10use reader;
11use printer;
12
13# read
14sub READ {
15 my $str = shift;
16 return reader::read_str($str);
17}
18
19# eval
20sub eval_ast {
21 my($ast, $env) = @_;
6708078b 22 if ($ast->isa('Mal::Symbol')) {
74d12000 23 return $env->{$$ast} // die "'$$ast' not found\n";
6708078b 24 } elsif ($ast->isa('Mal::Sequence')) {
7a17c605 25 return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]);
6708078b
BH
26 } elsif ($ast->isa('Mal::HashMap')) {
27 return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast });
7b341cf0
BH
28 } else {
29 return $ast;
a3b0621d
JM
30 }
31}
32
33sub EVAL {
34 my($ast, $env) = @_;
35 #print "EVAL: " . printer::_pr_str($ast) . "\n";
89bd4de1 36 if (! _list_Q($ast)) {
a3b0621d
JM
37 return eval_ast($ast, $env);
38 }
39
40 # apply list
e8fe22b0 41 unless (@$ast) { return $ast; }
f3e7214c
BH
42 my @el = @{eval_ast($ast, $env)};
43 my $f = shift @el;
44 return &$f(@el);
a3b0621d
JM
45}
46
47# print
48sub PRINT {
49 my $exp = shift;
50 return printer::_pr_str($exp);
51}
52
53# repl
c566afcb 54my $repl_env = {
6708078b
BH
55 '+' => sub { Mal::Integer->new(${$_[0]} + ${$_[1]}) },
56 '-' => sub { Mal::Integer->new(${$_[0]} - ${$_[1]}) },
57 '*' => sub { Mal::Integer->new(${$_[0]} * ${$_[1]}) },
58 '/' => sub { Mal::Integer->new(${$_[0]} / ${$_[1]}) },
c566afcb
BH
59};
60
a3b0621d
JM
61sub REP {
62 my $str = shift;
63 return PRINT(EVAL(READ($str), $repl_env));
64}
65
e8fe22b0 66if (@ARGV && $ARGV[0] eq "--raw") {
b8ee29b2
JM
67 set_rl_mode("raw");
68}
a3b0621d 69while (1) {
89bd4de1 70 my $line = mal_readline("user> ");
a3b0621d 71 if (! defined $line) { last; }
89bd4de1
JM
72 do {
73 local $@;
74 my $ret;
75 eval {
76 use autodie; # always "throw" errors
77 print(REP($line), "\n");
78 1;
79 } or do {
80 my $err = $@;
6708078b 81 if ($err->isa('Mal::BlankException')) {
2634021c
BH
82 # ignore and continue
83 } else {
84 chomp $err;
85 print "Error: $err\n";
89bd4de1
JM
86 }
87 };
88 };
a3b0621d 89}