App-Scheme79asm

 view release on metacpan or  search on metacpan

lib/App/Scheme79asm.pm  view on Meta::CPAN

package App::Scheme79asm;

use 5.014000;
use strict;
use warnings;
use re '/s';
use Carp qw/croak/;

use Data::Dumper qw/Dumper/;
use Data::SExpression qw/consp scalarp/;
use Scalar::Util qw/looks_like_number/;

our $VERSION = '1.000';

our %TYPES = (
	LIST => 0,
	SYMBOL => 1,
	NUMBER => 1,
	VAR => 2,
	VARIABLE => 2,
	CLOSURE => 3,

lib/App/Scheme79asm.pm  view on Meta::CPAN

		$addr = $self->{freeptr} + 1;
		$self->{freeptr} += @addrs;
		$self->process($addrs[$_], $addr + $_) for 0 .. $#addrs;
	} else {
		$addr = $addrs[0];
	}

	$addr = $self->process($addr) if ref $addr eq 'ARRAY';
	die 'Addr of toplevel is not atom: ', Dumper($addr), "\n" unless scalarp($addr);
	my ($comment_type, $comment_addr) = ($type, $addr);
	die 'Computed addr is not a number: ', Dumper($addr), "\n" unless looks_like_number $addr;

	if (!looks_like_number $type) {
		die "No such type: $type\n" unless exists $TYPES{$type};
		$type = $TYPES{$type};
	}

	$addr += (1 << $self->{addr_bits}) if $addr < 0;
	die "Type too large: $type\n" if $type >= (1 << $self->{type_bits});
	die "Addr too large: $addr\n" if $addr >= (1 << $self->{addr_bits});
	my $result = ($type << $self->{addr_bits}) + $addr;

	unless ($location) {

lib/App/Scheme79asm/Compiler.pm  view on Meta::CPAN

package App::Scheme79asm::Compiler;

use 5.014000;
use strict;
use warnings;

our $VERSION = '1.000';

use Carp qw/croak/;
use Data::Dumper qw/Dumper/;
use Scalar::Util qw/looks_like_number/;

use Data::SExpression qw/cons consp scalarp/;
use List::MoreUtils qw/firstidx/;

our @PRIMOPS = qw/car cdr cons atom progn reverse-list/;

sub make_symbol { Data::SExpression::Symbol->new(shift) }

# types
our $LIST   = make_symbol 'LIST';

lib/App/Scheme79asm/Compiler.pm  view on Meta::CPAN

		my $final_args = append $processed_args, cons ($self->process_toplevel($func_name, $env), undef);
		[$CALL => $self->rest_of_funcall([$FUNCALL => 0], $final_args->cdr), $final_args->car]
	}
}

sub process_toplevel {
	my ($self, $expr, $env) = @_;
	if (!defined $expr) {
		[$LIST => 0]
	} elsif (scalarp $expr) {
		if (looks_like_number $expr) {
			$self->process_quoted($expr);
		} elsif (uc $expr eq 'T') {
			[$SYMBOL => 2]
		} elsif (uc $expr eq 'NIL') {
			[$LIST => 0]
		} else {
			my $position = position $expr, $env;
			if (defined $position) {
				[$VAR => -1 - $position]
			} else {