forked from kanaka/mal
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
perl: backport all recent style changes from stepA to previous steps
- Loading branch information
1 parent
922ff02
commit 1f9d1d0
Showing
10 changed files
with
1,065 additions
and
918 deletions.
There are no files selected for viewing
This file contains 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
This file contains 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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,58 +1,52 @@ | ||
| #!/usr/bin/perl | ||
|
|
||
| use strict; | ||
| use warnings; | ||
| use File::Basename; | ||
| use lib dirname (__FILE__); | ||
| use File::Basename 'dirname'; | ||
| use lib dirname(__FILE__); | ||
|
|
||
| use Scalar::Util qw(blessed); | ||
| use English '-no_match_vars'; | ||
|
|
||
| use readline qw(mal_readline set_rl_mode); | ||
| use reader; | ||
| use printer; | ||
| use Readline qw(mal_readline set_rl_mode); | ||
| use Reader qw(read_str); | ||
| use Printer qw(pr_str); | ||
|
|
||
| # read | ||
| sub READ { | ||
| my $str = shift; | ||
| return reader::read_str($str); | ||
| return read_str($str); | ||
| } | ||
|
|
||
| # eval | ||
| sub EVAL { | ||
| my($ast, $env) = @_; | ||
| my ($ast) = @_; | ||
| return $ast; | ||
| } | ||
|
|
||
| sub PRINT { | ||
| my $exp = shift; | ||
| return printer::_pr_str($exp); | ||
| return pr_str($exp); | ||
| } | ||
|
|
||
| # repl | ||
| sub REP { | ||
| my $str = shift; | ||
| return PRINT(EVAL(READ($str), {})); | ||
| return PRINT( EVAL( READ($str) ) ); | ||
| } | ||
|
|
||
| if (@ARGV && $ARGV[0] eq "--raw") { | ||
| set_rl_mode("raw"); | ||
| # Command line arguments | ||
| if ( $ARGV[0] eq '--raw' ) { | ||
| set_rl_mode('raw'); | ||
| shift @ARGV; | ||
| } | ||
| while (1) { | ||
| my $line = mal_readline("user> "); | ||
| if (! defined $line) { last; } | ||
| do { | ||
| local $@; | ||
| my $ret; | ||
| eval { | ||
| print(REP($line), "\n"); | ||
| 1; | ||
| } or do { | ||
| my $err = $@; | ||
| if (defined(blessed $err) && $err->isa('Mal::BlankException')) { | ||
| # ignore and continue | ||
| } else { | ||
| chomp $err; | ||
| print "Error: $err\n"; | ||
| } | ||
| }; | ||
|
|
||
| while ( defined( my $line = mal_readline('user> ') ) ) { | ||
| eval { | ||
| print REP($line), "\n" or die $ERRNO; | ||
| 1; | ||
| } or do { | ||
| my $err = $EVAL_ERROR; | ||
| print 'Error: ', $err or die $ERRNO; | ||
| }; | ||
| } |
This file contains 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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,86 +1,79 @@ | ||
| #!/usr/bin/perl | ||
|
|
||
| use strict; | ||
| use warnings; | ||
| use File::Basename; | ||
| use lib dirname (__FILE__); | ||
| use File::Basename 'dirname'; | ||
| use lib dirname(__FILE__); | ||
|
|
||
| use Data::Dumper; | ||
| use English '-no_match_vars'; | ||
| use List::Util qw(pairmap); | ||
| use Scalar::Util qw(blessed); | ||
|
|
||
| use readline qw(mal_readline set_rl_mode); | ||
| use types; | ||
| use reader; | ||
| use printer; | ||
| use Readline qw(mal_readline set_rl_mode); | ||
| use Types qw(); | ||
| use Reader qw(read_str); | ||
| use Printer qw(pr_str); | ||
|
|
||
| # read | ||
| sub READ { | ||
| my $str = shift; | ||
| return reader::read_str($str); | ||
| return read_str($str); | ||
| } | ||
|
|
||
| # eval | ||
| sub EVAL { | ||
| my($ast, $env) = @_; | ||
| #print "EVAL: " . printer::_pr_str($ast) . "\n"; | ||
|
|
||
| if ($ast->isa('Mal::Symbol')) { | ||
| return $env->{$$ast} // die "'$$ast' not found\n"; | ||
| } elsif ($ast->isa('Mal::Vector')) { | ||
| return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); | ||
| } elsif ($ast->isa('Mal::HashMap')) { | ||
| return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); | ||
| } elsif (! $ast->isa('Mal::List')) { | ||
| return $ast; | ||
| } | ||
| my ( $ast, $env ) = @_; | ||
|
|
||
| # apply list | ||
| #print 'EVAL: ', pr_str($ast), "\n" or die $ERRNO; | ||
|
|
||
| unless (@$ast) { return $ast; } | ||
| my ($a0) = @$ast; | ||
| my $f = EVAL($a0, $env); | ||
| my (undef, @args) = @$ast; | ||
| return &$f(map { EVAL($_, $env) } @args); | ||
| if ( $ast->isa('Mal::Symbol') ) { | ||
| return $env->{ ${$ast} } // die "'${$ast}' not found\n"; | ||
| } | ||
| if ( $ast->isa('Mal::Vector') ) { | ||
| return Mal::Vector->new( [ map { EVAL( $_, $env ) } @{$ast} ] ); | ||
| } | ||
| if ( $ast->isa('Mal::HashMap') ) { | ||
| return Mal::HashMap->new( | ||
| { pairmap { $a => EVAL( $b, $env ) } %{$ast} } ); | ||
| } | ||
| if ( $ast->isa('Mal::List') and @{$ast} ) { | ||
| my ( $a0, @args ) = @{$ast}; | ||
| my $f = EVAL( $a0, $env ); | ||
| return $f->( map { EVAL( $_, $env ) } @args ); | ||
| } | ||
| return $ast; | ||
| } | ||
|
|
||
| sub PRINT { | ||
| my $exp = shift; | ||
| return printer::_pr_str($exp); | ||
| return pr_str($exp); | ||
| } | ||
|
|
||
| # repl | ||
| my $repl_env = { | ||
| '+' => sub { Mal::Integer->new(${$_[0]} + ${$_[1]}) }, | ||
| '-' => sub { Mal::Integer->new(${$_[0]} - ${$_[1]}) }, | ||
| '*' => sub { Mal::Integer->new(${$_[0]} * ${$_[1]}) }, | ||
| '/' => sub { Mal::Integer->new(${$_[0]} / ${$_[1]}) }, | ||
| q{+} => sub { Mal::Integer->new( ${ $_[0] } + ${ $_[1] } ) }, | ||
| q{-} => sub { Mal::Integer->new( ${ $_[0] } - ${ $_[1] } ) }, | ||
| q{*} => sub { Mal::Integer->new( ${ $_[0] } * ${ $_[1] } ) }, | ||
| q{/} => sub { Mal::Integer->new( ${ $_[0] } / ${ $_[1] } ) }, | ||
| }; | ||
|
|
||
| sub REP { | ||
| my $str = shift; | ||
| return PRINT(EVAL(READ($str), $repl_env)); | ||
| return PRINT( EVAL( READ($str), $repl_env ) ); | ||
| } | ||
|
|
||
| if (@ARGV && $ARGV[0] eq "--raw") { | ||
| set_rl_mode("raw"); | ||
| # Command line arguments | ||
| if ( $ARGV[0] eq '--raw' ) { | ||
| set_rl_mode('raw'); | ||
| shift @ARGV; | ||
| } | ||
| while (1) { | ||
| my $line = mal_readline("user> "); | ||
| if (! defined $line) { last; } | ||
| do { | ||
| local $@; | ||
| my $ret; | ||
| eval { | ||
| print(REP($line), "\n"); | ||
| 1; | ||
| } or do { | ||
| my $err = $@; | ||
| if (defined(blessed $err) && $err->isa('Mal::BlankException')) { | ||
| # ignore and continue | ||
| } else { | ||
| chomp $err; | ||
| print "Error: $err\n"; | ||
| } | ||
| }; | ||
|
|
||
| while ( defined( my $line = mal_readline('user> ') ) ) { | ||
| eval { | ||
| print REP($line), "\n" or die $ERRNO; | ||
| 1; | ||
| } or do { | ||
| my $err = $EVAL_ERROR; | ||
| print 'Error: ', $err or die $ERRNO; | ||
| }; | ||
| } |
Oops, something went wrong.