Lisp in 45 lines of Perl

Lisp.pm

package Lisp;
use strict;
use warnings;
use Scalar::Util qw/looks_like_number/;
use List::MoreUtils qw/zip/;

sub new {
    my $env; $env = {
        ':label'  => sub { my ($name, $val) = @_ ; $env->{$name} = $val;},
        ':quote'  => sub { $_[0] },
        ':car'    => sub { $_[0]->[0] },
        ':cdr'    => sub { [ @{$_[0]}[1..(scalar(@{$_[0]}) - 1)] ]; },
        ':cons'   => sub { [ $_[0], @{$_[1]} ]},
        ':eq'     => sub { $_[0] == $_[1] },
        ':if'     => sub {
            my ($cond, $then, $else, $ctx, $self) = @_;
            $self->eval($cond, $ctx) ? $self->eval($then, $ctx) : $self->eval($else, $ctx);
        },
        ':atom'   => sub { $_[0] =~ m/^:/ || looks_like_number($_[0]) },
    };
    bless { env => $env }, shift;
}

sub apply {
    my ($self, $fn, $args, $context) = @_;
    $context ||= $self->{env};
    return $self->{env}->{$fn}->(@{$args}, $context, $self) if ref $self->{env}->{$fn} eq "CODE";

    my $lambda = $self->{env}->{$fn};
    return $self->eval($lambda->[2], {%{$self->{env}}, zip(@{$lambda->[1]}, @{$args})});
}

sub eval {
    my ($self, $sexp, $context) = @_;
    $context ||= $self->{env};

    if ($self->{env}->{":atom"}->($sexp, $context)) {
        return $context->{$sexp} if exists $context->{$sexp};
        return $sexp;
    }

    my ($fn, @args) = @{$sexp};
    @args = map { $self->eval($_, $context) } @args unless $fn =~ m{^:(quote|if)$};
    return $self->apply($fn, [ @args ], $context);
}

main.pl

use Lisp;

sub say {
    if (ref $_[0] eq "ARRAY") {
        printf "(%s)\n", join ' ', @{$_[0]};
    } else {
        print $_[0], "\n";
    }
}

my $l = Lisp->new;
say $l->eval( [':quote', 10] );
say $l->eval( [':label', ':a', 42] );
say $l->eval( [':eq', ':a', 42] );
say $l->eval( [":quote", [1, 2]] );
say $l->eval( [":car", [":quote", [1, 2]]] );
say $l->eval( [":cdr", [":quote", [1, 2]]] );
say $l->eval( [":cons", 1, [":quote", [2, 3]]] );
say $l->eval( [":if", [":eq", 1, 2], "42", "43"] );
say $l->eval( [":label", ":second", [":quote", [":lambda", [":x"], [":car", [":cdr", ":x"]]]]] );
say $l->eval( [":second", [":quote", [1, 2, 3]]] );

Inspired by Lisp in Ruby