aboutsummaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Makefile2
-rw-r--r--perl/interop.pm1
-rw-r--r--perl/printer.pm1
-rw-r--r--perl/reader.pm1
-rw-r--r--perl/step1_read_print.pl1
-rw-r--r--perl/step2_eval.pl1
-rw-r--r--perl/step3_env.pl1
-rw-r--r--perl/step4_if_fn_do.pl1
-rw-r--r--perl/step5_tco.pl1
-rw-r--r--perl/step6_file.pl1
-rw-r--r--perl/step7_quote.pl1
-rw-r--r--perl/step8_macros.pl1
-rw-r--r--perl/step9_try.pl (renamed from perl/step9_interop.pl)34
-rw-r--r--perl/stepA_interop.pl (renamed from perl/stepA_more.pl)1
-rw-r--r--perl/tests/stepA_interop.mal (renamed from perl/tests/step9_interop.mal)0
-rw-r--r--perl/types.pm1
16 files changed, 46 insertions, 3 deletions
diff --git a/perl/Makefile b/perl/Makefile
index 772bba7..d8e95a0 100644
--- a/perl/Makefile
+++ b/perl/Makefile
@@ -2,7 +2,7 @@ TESTS =
SOURCES_BASE = readline.pm types.pm reader.pm printer.pm \
interop.pm
-SOURCES_LISP = env.pm core.pm stepA_more.pl
+SOURCES_LISP = env.pm core.pm stepA_interop.pl
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#all: mal.pl
diff --git a/perl/interop.pm b/perl/interop.pm
index 44657ec..ffa379f 100644
--- a/perl/interop.pm
+++ b/perl/interop.pm
@@ -1,6 +1,7 @@
package interop;
use strict;
use warnings FATAL => qw(all);
+no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw(switch);
use Exporter 'import';
our @EXPORT_OK = qw( pl_to_mal );
diff --git a/perl/printer.pm b/perl/printer.pm
index e31bed5..9ce6707 100644
--- a/perl/printer.pm
+++ b/perl/printer.pm
@@ -1,6 +1,7 @@
package printer;
use strict;
use warnings FATAL => qw(all);
+no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw(switch);
use Exporter 'import';
our @EXPORT_OK = qw( _pr_str );
diff --git a/perl/reader.pm b/perl/reader.pm
index e49d5a1..cd4c565 100644
--- a/perl/reader.pm
+++ b/perl/reader.pm
@@ -2,6 +2,7 @@ package reader;
use feature qw(switch);
use strict;
use warnings FATAL => qw(all);
+no if $] >= 5.018, warnings => "experimental::smartmatch";
use Exporter 'import';
our @EXPORT_OK = qw( read_str );
diff --git a/perl/step1_read_print.pl b/perl/step1_read_print.pl
index 14675b9..8288336 100644
--- a/perl/step1_read_print.pl
+++ b/perl/step1_read_print.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step2_eval.pl b/perl/step2_eval.pl
index 0cbd697..c3759a5 100644
--- a/perl/step2_eval.pl
+++ b/perl/step2_eval.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step3_env.pl b/perl/step3_env.pl
index 9a7efa4..f63443d 100644
--- a/perl/step3_env.pl
+++ b/perl/step3_env.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step4_if_fn_do.pl b/perl/step4_if_fn_do.pl
index 4a4a8d5..abf0c67 100644
--- a/perl/step4_if_fn_do.pl
+++ b/perl/step4_if_fn_do.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step5_tco.pl b/perl/step5_tco.pl
index a225d79..60dc13a 100644
--- a/perl/step5_tco.pl
+++ b/perl/step5_tco.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step6_file.pl b/perl/step6_file.pl
index 86ac3f3..a95197a 100644
--- a/perl/step6_file.pl
+++ b/perl/step6_file.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step7_quote.pl b/perl/step7_quote.pl
index 2e08c1a..5ce9199 100644
--- a/perl/step7_quote.pl
+++ b/perl/step7_quote.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step8_macros.pl b/perl/step8_macros.pl
index d723651..d95e032 100644
--- a/perl/step8_macros.pl
+++ b/perl/step8_macros.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/step9_interop.pl b/perl/step9_try.pl
index 4f53b6a..5862ef1 100644
--- a/perl/step9_interop.pl
+++ b/perl/step9_try.pl
@@ -1,5 +1,6 @@
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);
@@ -137,8 +138,32 @@ sub EVAL {
when (/^macroexpand$/) {
return macroexpand($a1, $env);
}
- when (/^pl\*$/) {
- return pl_to_mal(eval(${$a1}));
+ when (/^try\*$/) {
+ do {
+ local $@;
+ my $ret;
+ eval {
+ use autodie; # always "throw" errors
+ $ret = EVAL($a1, $env);
+ 1;
+ } or do {
+ my $err = $@;
+ if ($a2 && ${$a2->nth(0)} eq "catch\*") {
+ my $exc;
+ if (ref $err) {
+ $exc = $err;
+ } else {
+ $exc = String->new(substr $err, 0, -1);
+ }
+ return EVAL($a2->nth(2), Env->new($env,
+ List->new([$a2->nth(1)]),
+ List->new([$exc])));
+ } else {
+ die $err;
+ }
+ };
+ return $ret;
+ };
}
when (/^do$/) {
eval_ast($ast->slice(1, $#{$ast->{val}}-1), $env);
@@ -193,13 +218,18 @@ my @_argv = map {String->new($_)} @ARGV[1..$#ARGV];
$repl_env->set('*ARGV*', List->new(\@_argv));
# core.mal: defined using the language itself
+REP("(def! *host-language* \"javascript\")");
REP("(def! not (fn* (a) (if a false true)))");
REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
+REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
+REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
+
if (scalar(@ARGV) > 0) {
REP("(load-file \"" . $ARGV[0] . "\")");
exit 0;
}
+REP("(println (str \"Mal [\" *host-language* \"]\"))");
while (1) {
my $line = mal_readline("user> ");
if (! defined $line) { last; }
diff --git a/perl/stepA_more.pl b/perl/stepA_interop.pl
index 3703c47..0605d57 100644
--- a/perl/stepA_more.pl
+++ b/perl/stepA_interop.pl
@@ -1,5 +1,6 @@
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);
diff --git a/perl/tests/step9_interop.mal b/perl/tests/stepA_interop.mal
index 1335be4..1335be4 100644
--- a/perl/tests/step9_interop.mal
+++ b/perl/tests/stepA_interop.mal
diff --git a/perl/types.pm b/perl/types.pm
index e551e11..356f8c6 100644
--- a/perl/types.pm
+++ b/perl/types.pm
@@ -1,6 +1,7 @@
package types;
use strict;
use warnings FATAL => qw(all);
+no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw(switch);
use Exporter 'import';
our @EXPORT_OK = qw(_sequential_Q _equal_Q _clone
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-15 08:04:51 +0000