interpret.pl

#!/usr/bin/perl

use strict;
use Data::Dumper;


####################### INPUT DATA ####################### 

my $input = <<ENDOFINPUT;
sample_1() -> <<"(+ (* 4 4) (* 2 (- 7 5)) 1)">>.
sample_2() -> <<"10">>.
sample_3() -> <<"(* 10 (- 0 1))">>.
sample_4() -> <<"(- (+ 10 10) -5 0)">>.
sample_5() -> <<"(+ (- (* (+ (- (* 1))))))">>.
sample_6() -> <<"(* 2 (+ (- 10 9) (- 3 (* 2 1))) (+ (- 10 9) (- 3 (* 2 1))))">>.
sample_7() -> <<"(+ (* 2 1) (+ 8 8) (- (+ 4 3 2 1) (* 3 3) (* 2 2)) (* 5 7))">>.
sample_8() -> <<"(- (+ (+ 3 3) (- 3 3) (+ 3 3) (- 3 3)) (* 2 2))">>.
ENDOFINPUT

my %operations = map { $_ => 1 } qw( + - * );

################# FUNCTION DEFINITIONS ################### 

sub parse_sexp;
sub evaluate;
sub interpret;

sub parse_sexp {
	
	my $item = shift;
	#print "parsing some item starting with $item\n";
	
	# let's find out if it is a list
	if($item =~ /^\s*\((.*)/) {
		# okay, it is
		my $the_rest = $1;
		my @data;

		# now we go step by step through the remaining bytes
		while($the_rest) {
			
			if($the_rest =~ /^\s*\)(.*)/ ) {
				# wow, the list has come to the end
				return {
					data => \@data,
					the_rest => $1,
				};
			}
			else {
				# no right bracket yet, we still have something to do

				# then we take the rest of the string and parse again
				my $result = parse_sexp $the_rest;
				# we got the data and have some bytes behind 
				$the_rest = $result->{the_rest};
				push @data, $result->{data};


			}
			
		}

	}
	else {
		# apparently it's an atom
		$item =~ /^\s*([^\(\)\s]+)(.*)/ or die "nothing to do with $item";
		my $atom = $1;
		my $the_rest = $2;

		return {
			data => $atom,
			the_rest => $the_rest,
		};
	}
	
}

sub evaluate {

	my $data = shift;
	
	if(ref($data) eq "ARRAY") {
		my @items = @$data;
		my $operation = shift @items;
		die "Invalid operation '$operation'" unless ($operations{$operation});
		my @values;
		while(@items) {
			push @values, evaluate(shift @items);
		}
		my $exp = join($operation, map { "($_)" } @values);
		return eval($exp);
	}
	else {
		return $data;
	}
	
	
}

sub interpret {
	my $sexp = shift;
	
	my $parsed = parse_sexp $sexp;
	return evaluate $parsed->{data};	
}

######################## MAIN ############################

print $input;
my %samples = map { $_ =~ /(\w+)\(\)\s*->\s*<<"([^"]+)">>\./ ? ( $1 => $2 ) : die "Error parsing input" } split(/\n/, $input);

foreach my $sampleid (sort keys %samples) {
	my $value = interpret $samples{$sampleid};
	print "interpret($sampleid()). --> $value\n";
}