Commit | Line | Data |
---|---|---|
b6955321 | 1 | use strict; |
60f2b363 | 2 | use warnings FATAL => qw(all); |
f26bc011 JM |
3 | use File::Basename; |
4 | use lib dirname (__FILE__); | |
89bd4de1 | 5 | use readline qw(mal_readline); |
b6955321 JM |
6 | use feature qw(switch); |
7 | use Data::Dumper; | |
8 | ||
89bd4de1 | 9 | use types qw(_list_Q); |
b6955321 JM |
10 | use reader; |
11 | use printer; | |
12 | use env; | |
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 | $env->get($$ast); | |
26 | } | |
27 | when (/^List/) { | |
89bd4de1 | 28 | my @lst = map {EVAL($_, $env)} @{$ast->{val}}; |
b6955321 JM |
29 | return List->new(\@lst); |
30 | } | |
89bd4de1 JM |
31 | when (/^Vector/) { |
32 | my @lst = map {EVAL($_, $env)} @{$ast->{val}}; | |
33 | return Vector->new(\@lst); | |
34 | } | |
35 | when (/^HashMap/) { | |
36 | my $new_hm = {}; | |
37 | foreach my $k (keys($ast->{val})) { | |
38 | $new_hm->{$k} = EVAL($ast->get($k), $env); | |
39 | } | |
40 | return HashMap->new($new_hm); | |
41 | } | |
b6955321 JM |
42 | default { |
43 | return $ast; | |
44 | } | |
45 | } | |
46 | } | |
47 | ||
48 | sub EVAL { | |
49 | my($ast, $env) = @_; | |
50 | #print "EVAL: " . printer::_pr_str($ast) . "\n"; | |
89bd4de1 | 51 | if (! _list_Q($ast)) { |
b6955321 JM |
52 | return eval_ast($ast, $env); |
53 | } | |
54 | ||
55 | # apply list | |
89bd4de1 | 56 | my ($a0, $a1, $a2, $a3) = @{$ast->{val}}; |
b6955321 JM |
57 | given ($$a0) { |
58 | when (/^def!$/) { | |
59 | my $res = EVAL($a2, $env); | |
60 | return $env->set($$a1, $res); | |
61 | } | |
62 | when (/^let\*$/) { | |
63 | my $let_env = Env->new($env); | |
89bd4de1 JM |
64 | for(my $i=0; $i < scalar(@{$a1->{val}}); $i+=2) { |
65 | $let_env->set(${$a1->nth($i)}, EVAL($a1->nth($i+1), $let_env)); | |
b6955321 JM |
66 | } |
67 | return EVAL($a2, $let_env); | |
68 | } | |
69 | default { | |
70 | my $el = eval_ast($ast, $env); | |
89bd4de1 | 71 | my $f = $el->nth(0); |
b6955321 JM |
72 | return &{ $f }($el->rest()); |
73 | } | |
74 | } | |
75 | } | |
76 | ||
77 | ||
78 | sub PRINT { | |
79 | my $exp = shift; | |
80 | return printer::_pr_str($exp); | |
81 | } | |
82 | ||
83 | # repl | |
84 | my $repl_env = Env->new(); | |
85 | sub REP { | |
86 | my $str = shift; | |
87 | return PRINT(EVAL(READ($str), $repl_env)); | |
88 | } | |
89 | ||
89bd4de1 JM |
90 | $repl_env->set('+', sub { Integer->new(${$_[0]->nth(0)} + ${$_[0]->nth(1)}) } ); |
91 | $repl_env->set('-', sub { Integer->new(${$_[0]->nth(0)} - ${$_[0]->nth(1)}) } ); | |
92 | $repl_env->set('*', sub { Integer->new(${$_[0]->nth(0)} * ${$_[0]->nth(1)}) } ); | |
93 | $repl_env->set('/', sub { Integer->new(${$_[0]->nth(0)} / ${$_[0]->nth(1)}) } ); | |
b6955321 JM |
94 | |
95 | while (1) { | |
89bd4de1 | 96 | my $line = mal_readline("user> "); |
b6955321 | 97 | if (! defined $line) { last; } |
89bd4de1 JM |
98 | do { |
99 | local $@; | |
100 | my $ret; | |
101 | eval { | |
102 | use autodie; # always "throw" errors | |
103 | print(REP($line), "\n"); | |
104 | 1; | |
105 | } or do { | |
106 | my $err = $@; | |
107 | given (ref $err) { | |
108 | when (/^BlankException/) { | |
109 | # ignore and continue | |
110 | } | |
111 | default { | |
112 | chomp $err; | |
113 | print "Error: $err\n"; | |
114 | } | |
115 | } | |
116 | }; | |
117 | }; | |
b6955321 | 118 | } |