blob: 858a385d127703d1837e0299e2c949cae53fda3b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
use strict;
use warnings FATAL => qw(all);
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(_list_Q);
use reader;
use printer;
# read
sub READ {
my $str = shift;
return reader::read_str($str);
}
# eval
sub eval_ast {
my($ast, $env) = @_;
given (ref $ast) {
when (/^Symbol/) {
if (exists $env->{$$ast}) {
return $env->{$$ast};
} else {
die "'" . $$ast . "' not found";
}
}
when (/^List/) {
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;
}
}
}
sub EVAL {
my($ast, $env) = @_;
#print "EVAL: " . printer::_pr_str($ast) . "\n";
if (! _list_Q($ast)) {
return eval_ast($ast, $env);
}
# apply list
my $el = eval_ast($ast, $env);
my $f = $el->nth(0);
return &{ $f }($el->rest());
}
# print
sub PRINT {
my $exp = shift;
return printer::_pr_str($exp);
}
# repl
my $repl_env = {};
sub REP {
my $str = shift;
return PRINT(EVAL(READ($str), $repl_env));
}
$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)}) };
if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") {
set_rl_mode("raw");
}
while (1) {
my $line = mal_readline("user> ");
if (! defined $line) { last; }
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";
}
}
};
};
}
|
