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