-
-
Save CodeDmitry/5d4d8637d69ee4919eee38e784f4c4d8 to your computer and use it in GitHub Desktop.
Lisp in 45 lines of Perl
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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); | |
| } |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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]]] ); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment