From: Marius Gavrilescu Date: Sat, 24 Mar 2018 11:52:43 +0000 (+0200) Subject: Make compiler output actually compatible with assembler X-Git-Tag: 0.005~6 X-Git-Url: http://git.ieval.ro/?a=commitdiff_plain;h=ab8f838ff57d83083716775abf1c121430da5e5e;p=app-scheme79asm.git Make compiler output actually compatible with assembler --- diff --git a/lib/App/Scheme79asm.pm b/lib/App/Scheme79asm.pm index 9b82af6..f76b834 100644 --- a/lib/App/Scheme79asm.pm +++ b/lib/App/Scheme79asm.pm @@ -70,11 +70,9 @@ sub process { die 'Computed addr is not a number: ', Dumper($addr), "\n" unless looks_like_number $addr; - if (ref $type eq 'Data::SExpression::Symbol') { + if (!looks_like_number $type) { die "No such type: $type\n" unless exists $TYPES{$type}; $type = $TYPES{$type}; - } elsif (!looks_like_number $type) { - die "Type is not a number or symbol: $type\n" } $addr += (1 << $self->{addr_bits}) if $addr < 0; diff --git a/lib/App/Scheme79asm/Compiler.pm b/lib/App/Scheme79asm/Compiler.pm index 9a28e1c..f476262 100644 --- a/lib/App/Scheme79asm/Compiler.pm +++ b/lib/App/Scheme79asm/Compiler.pm @@ -114,7 +114,7 @@ sub new { sub process_quoted { my ($self, $expr) = @_; if (!defined $expr) { # nil - [list => 0] + [LIST => 0] } elsif (scalarp $expr) { $expr = uc $expr; if (!exists $self->{symbol_map}{$expr}) { @@ -122,9 +122,9 @@ sub process_quoted { $self->{nsymbols}++; push @{$self->{symbols}}, $expr; } - [symbol => $self->{symbol_map}{$expr}] + [SYMBOL => $self->{symbol_map}{$expr}] } elsif (consp $expr) { - [list => $self->process_quoted($expr->cdr), $self->process_quoted($expr->car)] + [LIST => $self->process_quoted($expr->cdr), $self->process_quoted($expr->car)] } else { croak 'argument to process_quoted is not a scalar, cons, or nil: ', Dumper($expr); } @@ -132,7 +132,7 @@ sub process_quoted { sub process_proc { my ($self, $func_name, $func_args, $func_body, $env) = @_; - my $new_env = append $env, (cons $func_name, rev $func_args); + my $new_env = append cons($func_name, rev $func_args), $env; $self->process_toplevel($func_body, $new_env) } @@ -141,7 +141,7 @@ sub rest_of_funcall { if (!defined $args) { $func } else { - [more => $self->rest_of_funcall($func, $args->cdr), $args->car] + [MORE => $self->rest_of_funcall($func, $args->cdr), $args->car] } } @@ -154,28 +154,28 @@ sub process_funcall { if (!defined $processed_args) { croak "Cannot call primitive $func_name with no arguments"; } - [call => $self->rest_of_funcall([lc $func_name, 0], $processed_args->cdr), $processed_args->car] + [CALL => $self->rest_of_funcall([uc $func_name, 0], $processed_args->cdr), $processed_args->car] } else { 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] + [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] + [LIST => 0] } elsif (scalarp $expr) { if (looks_like_number $expr) { $self->process_quoted($expr); } elsif (uc $expr eq 'T') { - [symbol => 2] + [SYMBOL => 2] } elsif (uc $expr eq 'NIL') { - [list => 0] + [LIST => 0] } else { my $position = position $expr, $env; if (defined $position) { - [var => -1 - $position] + [VAR => -1 - $position] } else { croak "Variable $expr not in environment"; } @@ -188,12 +188,12 @@ sub process_toplevel { my $func_name = $expr->cdr->car; my $func_args = $expr->cdr->cdr->car; my $func_body = $expr->cdr->cdr->cdr->car; - [proc => $self->process_proc($func_name, $func_args, $func_body, $env)] + [PROC => $self->process_proc($func_name, $func_args, $func_body, $env)] } elsif ($func eq 'IF') { my ($if_cond, $if_then, $if_else) = map { $self->process_toplevel($_, $env) } ($expr->cdr->car, $expr->cdr->cdr->car, $expr->cdr->cdr->cdr->car); - [if => [list => $if_else, $if_then], $if_cond] + [IF => [LIST => $if_else, $if_then], $if_cond] } else { $self->process_funcall($expr->car, $expr->cdr, $env) } @@ -234,6 +234,7 @@ App::Scheme79asm::Compiler - compile Lisp code to SIMPLE assembly my $string = '(reverse-list 2 1)'; my $assembly_sexp = $compiler->compile_string($string); $asm->process($assembly_sexp); + $asm->finish; $asm->print_verilog =head1 DESCRIPTION diff --git a/t/Compiler.t b/t/Compiler.t index a73e341..d8f93a5 100644 --- a/t/Compiler.t +++ b/t/Compiler.t @@ -24,14 +24,14 @@ sub is_toplevel { is_sexp new->process_toplevel(to_sexp $string), $expected, "process_toplevel $string"; } -is_sexp new->process_quoted(to_sexp '5'), '(symbol 3)', 'process_quoted 5'; -is_sexp new->process_quoted(to_sexp '()'), '(list 0)', 'process_quoted ()'; -is_sexp new->process_quoted(to_sexp '(5 foo)'), '(list (list (list 0) (symbol 3)) (symbol 4))', 'process_quoted (5 foo)'; -is_sexp new->process_quoted(to_sexp '(((5)))'), '(list (list 0) (list (list 0) (list (list 0) (symbol 3))))', 'process_quoted (((5)))'; +is_sexp new->process_quoted(to_sexp '5'), '(SYMBOL 3)', 'process_quoted 5'; +is_sexp new->process_quoted(to_sexp '()'), '(LIST 0)', 'process_quoted ()'; +is_sexp new->process_quoted(to_sexp '(5 foo)'), '(LIST (LIST (LIST 0) (SYMBOL 3)) (SYMBOL 4))', 'process_quoted (5 foo)'; +is_sexp new->process_quoted(to_sexp '(((5)))'), '(LIST (LIST 0) (LIST (LIST 0) (LIST (LIST 0) (SYMBOL 3))))', 'process_quoted (((5)))'; -is_toplevel '(quote 5)', '(symbol 3)'; -is_toplevel '(if t \'(2 3) \'x)', '(if (list (symbol 5) (list (list (list 0) (symbol 3)) (symbol 4))) (symbol 2))'; -is_toplevel '(car \'(1 2))', '(call (car 0) (list (list (list 0) (symbol 3)) (symbol 4)))'; -is_toplevel '(lambda id (x) x)', '(proc (var -2))'; -is_toplevel '((lambda id (x) x) 5)', '(call (more (funcall 0) (proc (var -2))) (symbol 3))'; -is_toplevel '(lambda append (x y) (if (atom x) y (cons (car x) (append (cdr x) y))))', '(proc (if (list (call (more (cons 0) (call (more (more (funcall 0) (var -1)) (var -2)) (call (cdr 0) (var -3)))) (call (car 0) (var -3))) (var -2)) (call (atom 0) (var -3))))'; +is_toplevel '(quote 5)', '(SYMBOL 3)'; +is_toplevel '(if t \'(2 3) \'x)', '(IF (LIST (SYMBOL 5) (LIST (LIST (LIST 0) (SYMBOL 3)) (SYMBOL 4))) (SYMBOL 2))'; +is_toplevel '(car \'(1 2))', '(CALL (CAR 0) (LIST (LIST (LIST 0) (SYMBOL 3)) (SYMBOL 4)))'; +is_toplevel '(lambda id (x) x)', '(PROC (VAR -2))'; +is_toplevel '((lambda id (x) x) 5)', '(CALL (MORE (FUNCALL 0) (PROC (VAR -2))) (SYMBOL 3))'; +is_toplevel '(lambda append (x y) (if (atom x) y (cons (car x) (append (cdr x) y))))', '(PROC (IF (LIST (CALL (MORE (CONS 0) (CALL (MORE (MORE (FUNCALL 0) (VAR -1)) (VAR -2)) (CALL (CDR 0) (VAR -3)))) (CALL (CAR 0) (VAR -3))) (VAR -2)) (CALL (ATOM 0) (VAR -3))))';