all Expr classes: added _bound versions of to_string and to_simple

lib/PerLisp/Expr.pm

@@ -8,7 +8,17 @@ sub eval {
 
 sub to_string { die 'override!' }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+    die 'override!';
+}
+
 sub to_simple { die 'override!' }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    die 'override!';
+}
+
 1;
 __END__

lib/PerLisp/Expr/Boolean.pm

@@ -18,10 +18,20 @@ sub to_string {
     return $self->value ? 'true' : 'false';
 }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+    return $self->to_string;
+}
+
 sub to_simple {
     my $self = shift;
     return $self->value ? 'true' : 'false';
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    return $self->to_simple;
+}
+
 1;
 __END__

lib/PerLisp/Expr/Function.pm

@@ -20,6 +20,13 @@ sub to_string {
     return 'Function: ' . $param_string . ' -> ' . $body_string;
 }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+    my $param_string = '(' . join(' ' => @{$self->params}) . ')';
+    my $body_string  = $self->body->to_string_bound($context);
+    return 'Function: ' . $param_string . ' -> ' . $body_string;
+}
+
 sub to_simple {
     my $self = shift;
     return {function => {
@@ -29,6 +36,15 @@ sub to_simple {
     }};
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    return {function => {
+        params  => $self->params,
+        body    => $self->body->to_simple_bound($context),
+        context => $self->context->binds,
+    }};
+}
+
 sub apply {
     my ($self, $context, $args) = @_;
 

lib/PerLisp/Expr/List.pm

@@ -58,10 +58,21 @@ sub to_string {
     return '(' . join(' ' => @expr_strings) . ')';
 }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+    my @expr_strings = map { $_->to_string_bound($context) } @{$self->exprs};
+    return '(' . join(' ' => @expr_strings) . ')';
+}
+
 sub to_simple {
     my $self = shift;
     return [ map { $_->to_simple } @{$self->exprs} ];
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    return [ map { $_->to_simple_bound($context) } @{$self->exprs} ];
+}
+
 1;
 __END__

lib/PerLisp/Expr/Number.pm

@@ -15,10 +15,20 @@ sub to_string {
     return $self->value;
 }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+    return $self->to_string;
+}
+
 sub to_simple {
     my $self = shift;
     return $self->value;
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    return $self->to_simple;
+}
+
 1;
 __END__

lib/PerLisp/Expr/Operator.pm

@@ -14,14 +14,24 @@ sub eval {
 
 sub to_string {
     my $self = shift;
-    return 'Operator[' . $self->name . ']';
+    return $self->name;
+}
+
+sub to_string_bound {
+    my ($self, $context) = @_;
+    return $self->to_string;
 }
 
 sub to_simple {
     my $self = shift;
     return {operator => $self->name};
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    return $self->to_simple;
+}
+
 sub apply {
     my ($self, $context, $args) = @_;
     return $self->code->($context, @$args);

lib/PerLisp/Expr/String.pm

@@ -15,10 +15,20 @@ sub to_string {
     return '"' . $self->value . '"';
 }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+    return $self->to_string;
+}
+
 sub to_simple {
     my $self = shift;
     return '"' . $self->value . '"';
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+    return $self->to_simple;
+}
+
 1;
 __END__

lib/PerLisp/Expr/Symbol.pm

@@ -15,10 +15,32 @@ sub to_string {
     return $self->name;
 }
 
+sub to_string_bound {
+    my ($self, $context) = @_;
+
+    # bound?
+    return $self->eval($context)->to_string_bound($context)
+        if $context->bound($self->name);
+
+    # unbound
+    return $self->to_string;
+}
+
 sub to_simple {
     my $self = shift;
     return $self->name;
 }
 
+sub to_simple_bound {
+    my ($self, $context) = @_;
+
+    # bound?
+    return $self->eval($context)->to_simple_bound($context)
+        if $context->bound($self->name);
+
+    # unbound
+    return $self->to_simple;
+}
+
 1;
 __END__

t/30-operators.t

@@ -24,8 +24,7 @@ my @operators = qw(
 # right stringifications
 foreach my $operator (@operators) {
     is(
-        $pl->context->get($operator)->to_string,
-        "Operator[$operator]",
+        $pl->context->get($operator)->to_string, $operator,
         "right operator $operator stringification",
     );
 }

t/39-string-simple-bound.t

@@ -0,0 +1,101 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 40;
+
+use PerLisp;
+use PerLisp::Expr::Boolean;
+
+my $pl = PerLisp->new->init;
+
+# prepare some bound stuff
+$pl->eval('(bind a 17)');
+ok($pl->context->bound('a'), '"a" is bound');
+
+# boolean
+my $boolean = $pl->eval('(= 42 42)');
+isa_ok($boolean, 'PerLisp::Expr::Boolean', 'the value');
+is($boolean->to_string, 'true', 'Boolean->to_string');
+is($boolean->to_string_bound($pl->context), 'true', 'Boolean->to_string_bound');
+is($boolean->to_simple, 'true', 'Boolean->to_simple');
+is($boolean->to_simple_bound($pl->context), 'true', 'Boolean->to_simple_bound');
+
+# number
+my $number = $pl->eval('37');
+isa_ok($number, 'PerLisp::Expr::Number', 'the value');
+is($number->to_string, '37', 'Number->to_string');
+is($number->to_string_bound($pl->context), '37', 'Number->to_string_bound');
+is($number->to_simple, '37', 'Number->to_simple');
+is($number->to_simple_bound($pl->context), '37', 'Number->to_simple_bound');
+
+# string
+my $string = $pl->eval('"YOLO"');
+isa_ok($string, 'PerLisp::Expr::String', 'the value');
+is($string->to_string, '"YOLO"', 'String->to_string');
+is($string->to_string_bound($pl->context), '"YOLO"', 'String->to_string_bound');
+is($string->to_simple, '"YOLO"', 'String->to_simple');
+is($string->to_simple_bound($pl->context), '"YOLO"', 'String->to_simple_bound');
+
+# operator
+my $operator = $pl->eval('*');
+isa_ok($operator, 'PerLisp::Expr::Operator', 'the value');
+is($operator->to_string, '*', 'Operator->to_string');
+is($operator->to_string_bound($pl->context), '*', 'Operator->to_string_bound');
+is_deeply($operator->to_simple, {operator => '*'},
+    'Operator->to_simple'
+);
+is_deeply($operator->to_simple_bound($pl->context), {operator => '*'},
+    'Operator->to_simple_bound'
+);
+
+# symbol
+my $symbol = $pl->eval("'a");
+isa_ok($symbol, 'PerLisp::Expr::Symbol', 'the value');
+is($symbol->to_string, 'a', 'Symbol->to_string');
+is($symbol->to_string_bound($pl->context), '17', 'Symbol->to_string_bound');
+is($symbol->to_simple, 'a', 'Symbol->to_simple');
+is($symbol->to_simple_bound($pl->context), '17', 'Symbol->to_simple_bound');
+
+# list
+my $list = $pl->eval("(list 37 'a (= 1 2))");
+isa_ok($list, 'PerLisp::Expr::List', 'the value');
+is($list->to_string, '(37 a false)', 'List->to_string');
+is($list->to_string_bound($pl->context), '(37 17 false)',
+    'List->to_string_bound'
+);
+is_deeply($list->to_simple, [qw(37 a false)], 'List->to_simple');
+is_deeply($list->to_simple_bound($pl->context), [qw(37 17 false)],
+    'List->to_simple_bound'
+);
+
+# function
+my $function = $pl->eval('(lambda (x) (+ x a))');
+isa_ok($function, 'PerLisp::Expr::Function', 'the value');
+is($function->to_string, 'Function: (x) -> (+ x a)',
+    'Function->to_string'
+);
+is($function->to_string_bound($pl->context), 'Function: (x) -> (+ x 17)',
+    'Function->to_string_bound'
+);
+my $function_simple = $function->to_simple->{function};
+is_deeply($function_simple->{params}, ['x'],
+    'Function->simple params'
+);
+is_deeply($function_simple->{body}, [qw(+ x a)],
+    'Function->simple body'
+);
+is($function_simple->{context}, $pl->context->binds,
+    'Function->simple context'
+);
+my $function_sb = $function->to_simple_bound($pl->context)->{function};
+is_deeply($function_sb->{params}, ['x'], 'Function->simple_bound params');
+is_deeply($function_sb->{body}, [{operator => '+'}, 'x', 17],
+    'Function->simple_bound body'
+);
+is($function_sb->{context}, $pl->context->binds,
+    'Function->simple_bound context'
+);
+
+__END__