mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 18:18:51 +03:00
c9de2e82ed
- tests/docker/Dockerfile: specifies full docker image containing all
tools/languages (except matlab).
- tests/docker-build.sh: build above image.
- tests/docker-run.sh: launch above image.
Example: ./tests/docker-run.sh make test^js^step2
- Various fixes across multiple languages:
- Unicode fixes for bash and R on Ubuntu Utopic
- readline history fixes for when ~/.mal-history is not available
or readable/writable. No fatal errors.
- fixes to work with perl 5.20 (and still perl 5.18)
110 lines
2.6 KiB
Perl
110 lines
2.6 KiB
Perl
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";
|
|
}
|
|
}
|
|
};
|
|
};
|
|
}
|