Commit | Line | Data |
---|---|---|
a3b0621d | 1 | use strict; |
60f2b363 | 2 | use warnings FATAL => qw(all); |
01c97316 | 3 | no if $] >= 5.018, warnings => "experimental::smartmatch"; |
f26bc011 JM |
4 | use File::Basename; |
5 | use lib dirname (__FILE__); | |
b8ee29b2 | 6 | use readline qw(mal_readline set_rl_mode); |
a3b0621d JM |
7 | use feature qw(switch); |
8 | use Data::Dumper; | |
9 | ||
89bd4de1 | 10 | use types qw(_list_Q); |
a3b0621d JM |
11 | use reader; |
12 | use printer; | |
13 | ||
14 | # read | |
15 | sub READ { | |
16 | my $str = shift; | |
17 | return reader::read_str($str); | |
18 | } | |
19 | ||
20 | # eval | |
21 | sub eval_ast { | |
22 | my($ast, $env) = @_; | |
23 | given (ref $ast) { | |
24 | when (/^Symbol/) { | |
25 | if (exists $env->{$$ast}) { | |
26 | return $env->{$$ast}; | |
27 | } else { | |
28 | die "'" . $$ast . "' not found"; | |
29 | } | |
30 | } | |
31 | when (/^List/) { | |
89bd4de1 | 32 | my @lst = map {EVAL($_, $env)} @{$ast->{val}}; |
a3b0621d JM |
33 | return List->new(\@lst); |
34 | } | |
89bd4de1 JM |
35 | when (/^Vector/) { |
36 | my @lst = map {EVAL($_, $env)} @{$ast->{val}}; | |
37 | return Vector->new(\@lst); | |
38 | } | |
39 | when (/^HashMap/) { | |
40 | my $new_hm = {}; | |
c9de2e82 | 41 | foreach my $k (keys( %{ $ast->{val} })) { |
89bd4de1 JM |
42 | $new_hm->{$k} = EVAL($ast->get($k), $env); |
43 | } | |
44 | return HashMap->new($new_hm); | |
45 | } | |
a3b0621d JM |
46 | default { |
47 | return $ast; | |
48 | } | |
49 | } | |
50 | } | |
51 | ||
52 | sub EVAL { | |
53 | my($ast, $env) = @_; | |
54 | #print "EVAL: " . printer::_pr_str($ast) . "\n"; | |
89bd4de1 | 55 | if (! _list_Q($ast)) { |
a3b0621d JM |
56 | return eval_ast($ast, $env); |
57 | } | |
58 | ||
59 | # apply list | |
60 | my $el = eval_ast($ast, $env); | |
89bd4de1 | 61 | my $f = $el->nth(0); |
a3b0621d JM |
62 | return &{ $f }($el->rest()); |
63 | } | |
64 | ||
65 | ||
66 | sub PRINT { | |
67 | my $exp = shift; | |
68 | return printer::_pr_str($exp); | |
69 | } | |
70 | ||
71 | # repl | |
72 | my $repl_env = {}; | |
73 | sub REP { | |
74 | my $str = shift; | |
75 | return PRINT(EVAL(READ($str), $repl_env)); | |
76 | } | |
77 | ||
89bd4de1 JM |
78 | $repl_env->{'+'} = sub { Integer->new(${$_[0]->nth(0)} + ${$_[0]->nth(1)}) }; |
79 | $repl_env->{'-'} = sub { Integer->new(${$_[0]->nth(0)} - ${$_[0]->nth(1)}) }; | |
80 | $repl_env->{'*'} = sub { Integer->new(${$_[0]->nth(0)} * ${$_[0]->nth(1)}) }; | |
81 | $repl_env->{'/'} = sub { Integer->new(${$_[0]->nth(0)} / ${$_[0]->nth(1)}) }; | |
a3b0621d | 82 | |
b8ee29b2 JM |
83 | if (scalar(@ARGV) > 0 && $ARGV[0] eq "--raw") { |
84 | set_rl_mode("raw"); | |
85 | } | |
a3b0621d | 86 | while (1) { |
89bd4de1 | 87 | my $line = mal_readline("user> "); |
a3b0621d | 88 | if (! defined $line) { last; } |
89bd4de1 JM |
89 | do { |
90 | local $@; | |
91 | my $ret; | |
92 | eval { | |
93 | use autodie; # always "throw" errors | |
94 | print(REP($line), "\n"); | |
95 | 1; | |
96 | } or do { | |
97 | my $err = $@; | |
98 | given (ref $err) { | |
99 | when (/^BlankException/) { | |
100 | # ignore and continue | |
101 | } | |
102 | default { | |
103 | chomp $err; | |
104 | print "Error: $err\n"; | |
105 | } | |
106 | } | |
107 | }; | |
108 | }; | |
a3b0621d | 109 | } |