Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

SCORBOT "acl" language compiler

by fglock (Vicar)
on Apr 01, 2005 at 14:37 UTC ( #444192=snippet: print w/ replies, xml ) Need Help??

Description:

The SCORBOT is a robot for laboratory and training applications. This program allows a student to try out programs written for the SCORBOT using "acl" (Advanced Control Language).

The script takes an "acl" file and translates it to Perl, and then (optionally) executes it.

Only the program logic and user interaction are implemented. The parts of the language that deal with hardware will be implemented in a GUI (not included here) - something like a "virtual robot".

To run an "acl" program:

  $ ./acl test.acl

To show the Perl program that was generated:

  $ ./acl --perl test.acl

This is the sample ACL program I used for testing:

*** ACL test *** global k l m program teste2 define x for x=1 to 10 print "[" print k print "]" delay 10 endfor end program teste define x y set x = 10 set k = x + 1 print "k=" println k for x=1 to 2 for y=5 to 4 print x print " " println y if y = 4 andif x = 1 println " y = 4 && x = 1 " else println " ... " endif set k = k + 1 delay 10 endfor endfor stop teste2 goto 1 println "nada" label 1 end run teste2 gosub teste gosub teste read "type a value" k println k stop run teste2 println "end"
#!/usr/bin/perl
use strict;

use threads;
use threads::shared;
$|=1;

use Getopt::Long;

{

my $debug = 0;
my $preprocess = 0;
my $help = 0;
my $result = GetOptions ( 
    "debug" => \$debug, "perl" => \$preprocess, "help" => \$help );
my $source_name = shift;
my $source;
open ( $source, '<', $source_name ) 
    or die "$!";
my $program;

sub _val {  ( $_[0] =~ /^[a-z]/ ) ? "\$@_" : "@_" }
sub _op { local $_ = shift; s/^=$/==/; $_ }

my %_interpreta = (
    '' =>      sub { },
    '*' =>     sub { },
    quiet =>   sub { },
    if =>      sub { "if ( ( " . join( ' ', map { _op(_val($_)) } @_ )
+ . " )" },
    andif =>   sub { "  && ( " . join( ' ', map { _op(_val($_)) } @_ )
+ . " )" },
    orif =>    sub { "  || ( " . join( ' ', map { _op(_val($_)) } @_ )
+ . " )" },
    __fi =>    sub { "   ) {\n" }, 
    else =>    sub { "} else {" },
    endif =>   sub { "}" },
    program => sub { $program = $_[0]; "sub @_ {"; },
    end =>     sub { undef $program; "}"; },
    gosub =>   sub { "undef \$thread{$_[0]}; @_();" },
    run =>     sub { 'undef $thread{' . $_[0] . '}; threads->new(\&' .
+ $_[0] . ');' },
    priority => sub { "" },
    label =>   sub { "L@_: ;" },
    goto =>    sub { "goto L@_;" },
    print =>   sub { 'print ' . _val(@_) . ";" },
    println => sub { 'print ' . _val(@_) . ', "\n"' . ";" },
    define =>  sub { 
        "my (" . join( ",", map { _val($_) } @_ )  . ");\n" .
        join( "\n", map { _val($_) . " = 0;" } @_ ) 
    },
    global =>  sub { 
        "use vars qw(" . join( " ", map { _val($_) } @_ )  . ");\n" .
        join( "\n", map { _val($_) . " = 0;" } @_ ) . "\n" .
        join( "\n", map { "share(" . _val($_) . ");" } @_ )
    },
    set =>     sub { join( ' ', map { _val($_) } @_ ) . ";" },
    delay =>   sub { 'select( undef, undef, undef, ' . _val(@_) . "/10
+0.0 );" },
    for =>     sub {
        my ( $nome, $igual, $ini, $to, $end ) = @_;
        $nome = _val( $nome );
        $ini =  _val( $ini );
        $end =  _val( $end );
        "for ( $nome = $ini; " .
            "( $ini <= $end ? $nome <= $end : $nome >= $end ); " .
            "$nome += ( $ini <= $end ? 1 : -1 ) ) {";
    },
    endfor =>  sub { "}"; },
    read =>    sub { 
        join( "\n", map {
            /^[a-z]/ ?
            'print " > ";' . "\n" . _val($_) . " = <>; chomp "  . _val
+($_) . ";" :
            'print ' . _val($_) . ";"
        } @_ )
    },
    stop =>    sub {
        return "\$thread{$_[0]} = 1;" if $_[0];
        '$thread{$_} = 1 for keys %thread;'
    }
);

if ( $help )
{
    print "acl - interpreter for the ACL (Advanced Control Language) r
+obot control language\n";
    print "\n";
    print "  ./acl [--perl] [--debug] program.acl\n";
    print "\n";
    print "  ACL commands:\n";
    print "    " . $_ . "\n" for grep { $_ ne '' && $_ !~ /_/ } sort k
+eys %_interpreta;
    exit;
}

my $out = <<'EOT';
#!/usr/bin/perl
use strict; 
use threads;
use threads::shared;
$|=1;
use vars qw( %thread );
share( %thread );
EOT

my $if = 0;
while (<$source>)
{
    chomp;
    my $src = $_;
    lc;
    $_ =~ s/([=\*])/ $1 /;
    s/^\s+|\s+$//g;

    # perlfaq -  How can I split a [character] delimited string ...
    my @t;
    push(@t, defined($1) ? $1:$3) 
    while m/("[^"\\]*(\\.[^"\\]*)*")|([^\s]+)/g;
    my $cmd = shift @t;

    die "Unknown command $cmd" unless exists $_interpreta{$cmd};
    if ( $if && $cmd ne 'andif' && $cmd ne 'orif' ) {
        $if = 0;
        $out .= $_interpreta{__fi}();
    }
    $if = 1 if $cmd eq 'if';
    $out .= $_interpreta{$cmd}(@t);
    $out .= " return if \$thread{$program};" if $program && $cmd && ! 
+$if;
    $out .= "    \t# $src" if $cmd && $debug;
    $out .= "\n";
}
$out .= <<'EOT';
           foreach my $thr (threads->list) {
               # Don't join the main thread or ourselves
               if ($thr->tid && !threads::equal($thr, threads->self)) 
+{
                   $thr->join;
               }
           }
EOT

close ( $source );

print $out if $preprocess;
print STDERR $out if $debug && ! $preprocess;
if ( ! $preprocess )
{
    eval {
        eval $out or die "$!";
    };
    if ( $@ )
    {
        print STDERR "Run time error: $@\n"
            unless $@ =~ /ioctl/;
    }
}

}

__END__

=head1 NAME

acl - interpreter for the ACL (Advanced Control Language) robot contro
+l language

=head1 SYNOPSIS

Run a program

  $ ./acl test.acl    

Show how Perl would execute a program

  $ ./acl --perl test.acl

=head1 AUTHOR

Flavio S. Glock <fglock@pucrs.br>

=head1 COPYRIGHT

Copyright (c) 2005 Flavio S. Glock.  All rights reserved.  This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
Comment on SCORBOT "acl" language compiler
Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://444192]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (13)
As of 2014-10-23 21:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (129 votes), past polls