diff options
| -rw-r--r-- | docs/step_notes.txt | 15 | ||||
| -rw-r--r-- | perl/core.pm | 10 | ||||
| -rw-r--r-- | perl/printer.pm | 2 | ||||
| -rw-r--r-- | perl/step6_file.pl | 129 |
4 files changed, 150 insertions, 6 deletions
diff --git a/docs/step_notes.txt b/docs/step_notes.txt index 4bdbb61..897fb56 100644 --- a/docs/step_notes.txt +++ b/docs/step_notes.txt @@ -142,9 +142,12 @@ Step Notes: on the function - step6_file - - add read-string, eval, slurp platform wrappers - - define load-file function - - if files on command line, use load-file to run + - core module: + - read-string, slurp functions + - define eval and load-file functions + - set *ARGV* + - if files on command line, use load-file to run first argument + using rest as arguments - step7_quote - add is_pair and quasiquote functions @@ -152,7 +155,7 @@ Step Notes: - if vectors, use sequential? instead of list? in is_pair - EVAL: - add 'quote', 'quasiquote' cases - - types module: + - core module: - add cons and concat functions - reader module: - add reader macros to read_form for quote, unquote, @@ -173,13 +176,15 @@ Step Notes: - step9_interop - stepA_more - - types module: + - core module: - throw function - apply, map functions: should not directly call EVAL, which requires the function object to be runnable + - readline - EVAL: - try*/catch*: for normal exceptions, extracts string otherwise extracts full value + - set and print *host-language* - Extra defintions needed for self-hosting - types module: diff --git a/perl/core.pm b/perl/core.pm index 3f2215e..a529d21 100644 --- a/perl/core.pm +++ b/perl/core.pm @@ -5,6 +5,7 @@ use Exporter 'import'; our @EXPORT_OK = qw($core_ns); use types qw(_sequential_Q _equal_Q $nil $true $false _list_Q); +use reader qw(read_str); use printer qw(_pr_str); use Data::Dumper; @@ -29,6 +30,13 @@ sub println { return $nil } +sub slurp { + my ($fname) = ${$_[0]}; + open my $F, '<', $fname or die "error opening '$fname'"; + my $data = do { local $/; <$F> }; + String->new($data) +} + our $core_ns = { '=' => sub { _equal_Q($_[0][0], $_[0][1]) ? $true : $false }, @@ -37,6 +45,8 @@ our $core_ns = { 'str' => sub { str($_[0]) }, 'prn' => sub { prn($_[0]) }, 'println' => sub { println($_[0]) }, + 'read-string' => sub { read_str(${$_[0][0]}) }, + 'slurp' => sub { slurp($_[0][0]) }, '<' => sub { ${$_[0][0]} < ${$_[0][1]} ? $true : $false }, '<=' => sub { ${$_[0][0]} <= ${$_[0][1]} ? $true : $false }, '>' => sub { ${$_[0][0]} > ${$_[0][1]} ? $true : $false }, diff --git a/perl/printer.pm b/perl/printer.pm index 7880798..4240ff0 100644 --- a/perl/printer.pm +++ b/perl/printer.pm @@ -31,7 +31,7 @@ sub _pr_str { my $str = $$obj; $str =~ s/\\/\\\\/g; $str =~ s/"/\\"/g; - $str =~ s/\n/\\n"/g; + $str =~ s/\n/\\n/g; return '"' . $str . '"'; } else { return $$obj; diff --git a/perl/step6_file.pl b/perl/step6_file.pl new file mode 100644 index 0000000..4606297 --- /dev/null +++ b/perl/step6_file.pl @@ -0,0 +1,129 @@ +use strict; +use warnings FATAL => qw(all); +use readline qw(readline); +use feature qw(switch); +use Data::Dumper; + +use types qw($nil $true $false); +use reader; +use printer; +use env; +use core qw($core_ns); + +# read +sub READ { + my $str = shift; + return reader::read_str($str); +} + +# eval +sub eval_ast { + my($ast, $env) = @_; + given (ref $ast) { + when (/^Symbol/) { + $env->get($$ast); + } + when (/^List/) { + my @lst = map {EVAL($_, $env)} @$ast; + return List->new(\@lst); + } + default { + return $ast; + } + } +} + +sub EVAL { + my($ast, $env) = @_; + + while (1) { + + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if (! ((ref $ast) =~ /^List/)) { + return eval_ast($ast, $env); + } + + # apply list + my ($a0, $a1, $a2, $a3) = @$ast; + given ((ref $a0) =~ /^Symbol/ ? $$a0 : $a0) { + when (/^def!$/) { + my $res = EVAL($a2, $env); + return $env->set($$a1, $res); + } + when (/^let\*$/) { + my $let_env = Env->new($env); + for(my $i=0; $i < scalar(@{$a1}); $i+=2) { + $let_env->set(${$a1->[$i]}, EVAL($a1->[$i+1], $let_env)); + } + return EVAL($a2, $let_env); + } + when (/^do$/) { + eval_ast($ast->slice(1, $#{$ast}-1), $env); + $ast = $ast->[$#{$ast}]; + } + when (/^if$/) { + my $cond = EVAL($a1, $env); + if ($cond eq $nil || $cond eq $false) { + $ast = $a3 ? $a3 : $nil; + } else { + $ast = $a2; + } + } + when (/^fn\*$/) { + return Function->new(\&EVAL, $a2, $env, $a1); + } + default { + my $el = eval_ast($ast, $env); + my $f = $el->[0]; + if ((ref $f) =~ /^Function/) { + $ast = $f->{ast}; + $env = $f->gen_env($el->rest()); + } else { + return &{ $f }($el->rest()); + } + } + } + + } # TCO while loop +} + +# print +sub PRINT { + my $exp = shift; + return printer::_pr_str($exp); +} + +# repl +my $repl_env = Env->new(); +sub REP { + my $str = shift; + return PRINT(EVAL(READ($str), $repl_env)); +} + +# core.pl: defined using perl +foreach my $n (%$core_ns) { $repl_env->set($n, $core_ns->{$n}); } +$repl_env->set('eval', sub { EVAL($_[0][0], $repl_env); }); +my @_argv = map {String->new($_)} @ARGV[1..$#ARGV]; +$repl_env->set('*ARGV*', List->new(\@_argv)); + +# core.mal: defined using the language itself +REP("(def! not (fn* (a) (if a false true)))"); +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); + +if ($#ARGV > 0) { + REP("(load-file \"" . $ARGV[0] . "\")"); + exit 0; +} +while (1) { + my $line = readline("user> "); + if (! defined $line) { last; } + eval { + use autodie; # always "throw" errors + print(REP($line), "\n"); + 1; + }; + if (my $err = $@) { + chomp $err; + print "Error: $err\n"; + } +} |