| 1 | package core; |
| 2 | use strict; |
| 3 | use warnings FATAL => qw(all); |
| 4 | use Exporter 'import'; |
| 5 | our @EXPORT_OK = qw($core_ns); |
| 6 | |
| 7 | use types qw(_sequential_Q _equal_Q $nil $true $false _list_Q); |
| 8 | use printer qw(_pr_str); |
| 9 | |
| 10 | use Data::Dumper; |
| 11 | |
| 12 | # String functions |
| 13 | |
| 14 | sub pr_str { |
| 15 | return String->new(join(" ", map {_pr_str($_, 1)} @{$_[0]})); |
| 16 | } |
| 17 | |
| 18 | sub str { |
| 19 | return String->new(join("", map {_pr_str($_, 0)} @{$_[0]})); |
| 20 | } |
| 21 | |
| 22 | sub prn { |
| 23 | print join(" ", map {_pr_str($_, 1)} @{$_[0]}) . "\n"; |
| 24 | return $nil |
| 25 | } |
| 26 | |
| 27 | sub println { |
| 28 | print join(" ", map {_pr_str($_, 0)} @{$_[0]}) . "\n"; |
| 29 | return $nil |
| 30 | } |
| 31 | |
| 32 | |
| 33 | our $core_ns = { |
| 34 | '=' => sub { _equal_Q($_[0][0], $_[0][1]) ? $true : $false }, |
| 35 | |
| 36 | 'pr-str' => sub { pr_str($_[0]) }, |
| 37 | 'str' => sub { str($_[0]) }, |
| 38 | 'prn' => sub { prn($_[0]) }, |
| 39 | 'println' => sub { println($_[0]) }, |
| 40 | '<' => sub { ${$_[0][0]} < ${$_[0][1]} ? $true : $false }, |
| 41 | '<=' => sub { ${$_[0][0]} <= ${$_[0][1]} ? $true : $false }, |
| 42 | '>' => sub { ${$_[0][0]} > ${$_[0][1]} ? $true : $false }, |
| 43 | '>=' => sub { ${$_[0][0]} >= ${$_[0][1]} ? $true : $false }, |
| 44 | '+' => sub { Integer->new(${$_[0][0]} + ${$_[0][1]})}, |
| 45 | '-' => sub { Integer->new(${$_[0][0]} - ${$_[0][1]})}, |
| 46 | '*' => sub { Integer->new(${$_[0][0]} * ${$_[0][1]})}, |
| 47 | '/' => sub { Integer->new(${$_[0][0]} / ${$_[0][1]})}, |
| 48 | |
| 49 | 'list' => sub { $_[0] }, |
| 50 | 'list?' => sub { _list_Q($_[0][0]) ? $true : $false }, |
| 51 | 'empty?' => sub { scalar(@{$_[0][0]}) == 0 ? $true : $false }, |
| 52 | 'count' => sub { Integer->new(scalar(@{$_[0][0]})) }, |
| 53 | }; |
| 54 | |
| 55 | 1; |