#!/usr/bin/perl use strict; my $debug= 0; my $lisp= ""; # # S -> ( Op Opd* ) # Op -> + | * | - | / # Opd -> S | Number # my @tokens; my $pos= 0; sub lisp { print "lisp_eval [$pos] token [$tokens[$pos]]\n" if $debug; # throw away ( $pos ++; my $op= $tokens[$pos++]; my @operands= (); while( $pos < scalar( @tokens ) ) { last if( $tokens[$pos] eq ")" ); push @operands, operand(); } return [$op, @operands]; } sub operand { print "operand_eval [$pos] token [$tokens[$pos]]\n" if $debug; my $next= $tokens[$pos]; if( $next =~ m/\d+/ ) { $pos ++; return $next; } else { return lisp(); } } sub rewrite_perl { my @root= @{ shift() }; my $op= $root[0]; my @opds= (); foreach( 1 .. @root - 1 ) { if( ref $root[$_] eq "ARRAY" ) { push @opds, rewrite_perl( $root[$_] ); } else { push @opds, $root[$_]; } } my $code= $opds[0]; foreach( 1 .. @opds - 1 ) { $code= "( $code $op $opds[$_] )"; } return $code; } sub myread { $pos= 0; my $line= ; @tokens= split /\s+/, $line; } LOOP: print eval ( rewrite_perl lisp( myread ) ), $/; goto LOOP;