Perl: add step2_eval.

5 files changed, 95 insertions, 3 deletions

diff --git a/docs/step_notes.txt b/docs/step_notes.txt
index 951ab3c..3773517 100644
--- a/docs/step_notes.txt
+++ b/docs/step_notes.txt
@@ -30,7 +30,7 @@ Step Notes:
         - read_list
             - read_form until ')'
             - return array (boxed)
-        - read_atom
+        - read_atom (not atom type)
             - return scalar boxed type:
                 - nil, true, false, symbol, integer, string
     - printer module:
@@ -73,6 +73,7 @@ Step Notes:
 
 - step2_eval
     - types module:
+        - symbol?, list? (if no simple idiomatic impl type check)
         - first, rest, nth on list
     - eval_ast:
         - if symbol, return value of looking up in env
diff --git a/perl/printer.pm b/perl/printer.pm
index 9741eda..94219d4 100644
--- a/perl/printer.pm
+++ b/perl/printer.pm
@@ -26,6 +26,7 @@ sub _pr_str {
             return '{' . join(' ', @elems) . '}';
         }
         when(/^String/) { return '"' . $$obj . '"'; }
+        when(/^CODE/)   { return '<builtin_fn* ' . $obj . '>'; }
         default         { return $$obj; }
     }
 }
diff --git a/perl/reader.pm b/perl/reader.pm
index 52b1a76..ecbf522 100644
--- a/perl/reader.pm
+++ b/perl/reader.pm
@@ -22,7 +22,7 @@ use Data::Dumper;
 sub tokenize {
     my($str) = @_;
     my @tokens = $str =~ /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"|;.*|[^\s\[\]{}('"`,;)]*)/g;
-    return grep {not /^;|^$/} @tokens;
+    return grep {! /^;|^$/} @tokens;
 }
 
 sub read_atom {
diff --git a/perl/step2_eval.pl b/perl/step2_eval.pl
new file mode 100644
index 0000000..c3910bd
--- /dev/null
+++ b/perl/step2_eval.pl
@@ -0,0 +1,80 @@
+use strict;
+use warnings;
+use readline qw(readline);
+use feature qw(switch);
+use Data::Dumper;
+
+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;
+            return List->new(\@lst);
+        }
+        default {
+            return $ast;
+        }
+    }
+}
+
+sub EVAL {
+    my($ast, $env) = @_;
+    #print "EVAL: " . printer::_pr_str($ast) . "\n";
+    if (! ((ref $ast) =~ /^List/)) {
+        return eval_ast($ast, $env);
+    }
+
+    # apply list
+    my $el = eval_ast($ast, $env);
+    my $f = $el->[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][0]} + ${$_[0][1]}) };
+$repl_env->{'-'} = sub { Integer->new(${$_[0][0]} - ${$_[0][1]}) };
+$repl_env->{'*'} = sub { Integer->new(${$_[0][0]} * ${$_[0][1]}) };
+$repl_env->{'/'} = sub { Integer->new(${$_[0][0]} / ${$_[0][1]}) };
+
+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";
+    }
+}
diff --git a/perl/types.pm b/perl/types.pm
index 500a1d3..054c303 100644
--- a/perl/types.pm
+++ b/perl/types.pm
@@ -6,7 +6,6 @@ our @EXPORT_OK = qw( $nil $true $false);
 
 {
     package Nil;
-    #sub new { my $class = shift; bless {type=>'nil'} => $class } 
     sub new { my $class = shift; my $s = 'nil'; bless \$s => $class }
 }
 {
@@ -27,26 +26,37 @@ our $false = False->new();
     sub new  { my $class = shift; bless \$_[0] => $class }
 }
 
+
 {
     package Symbol;
     sub new  { my $class = shift; bless \$_[0] => $class }
 }
 
+sub _symbol_Q { ref $_[0] =~ /^Symbol/ }
+
+
 {
     package String;
     sub new  { my $class = shift; bless \$_[0] => $class }
 }
 
+
 {
     package List;
+    use Data::Dumper;
     sub new  { my $class = shift; bless $_[0], $class }
+    sub rest { my @arr = @{$_[0]}; List->new([@arr[1..$#arr]]); }
 }
 
+sub _list_Q { ref $_[0] =~ /^Symbol/ }
+
+
 {
     package Vector;
     sub new  { my $class = shift; bless $_[0], $class }
 }
 
+
 {
     package HashMap;
     sub new  { my $class = shift; bless $_[0], $class }