#! /usr/bin/perl -w
### lbl2cmp_txt2m
## Creates _cmp.m from _lbl.txt
## Copyright (C) 2004 by Geraint Paul Bevan
######################################
##### Model Transformation Tools #####
######################################
use strict;
use Getopt::Long;
sub usage;
sub read_lbl;
sub read_cmp;
sub write_header;
sub write_body;
my (@component_name,
%component_type,
%component_cr,
%component_arg,
%component_rep);
my $sys = '';
GetOptions ('sys=s' => \$sys);
die usage() if ($sys eq '');
my $lbl = "${sys}_lbl.txt";
my $cmp = "${sys}_cmp.txt";
my $out = "${sys}_cmp.m_TEST";
my $debug;
read_cmp();
read_lbl();
write_header();
write_body();
sub usage() {
return "Usage: lbl2cmp_txt2m --sys=<sys>\n";
}
sub read_lbl() {
my (@line, $name, $type, $cr, $arg, $i);
$i = 0;
open (LBL, $lbl) or die ("MTT: __FILE__, cannot open $lbl");
while (<LBL>) {
chomp;
# skip blank lines
next if (/^(\s)*$/);
# skip comments
next if (/^(\s)*[%\#]/);
# remove leading and trailing whitespace
s/^\s*(\S.*\S)\s*$/$1/;
@line = split (/\s+/);
$name = shift (@line);
die ("MTT: __FILE__, cannot parse $lbl") if (! defined ($name));
# strip repetitions from name, if any
$name =~ s/\([^\*]*\)\*.*/$1/;
$cr = shift (@line);
$arg = shift (@line);
$cr = '' unless defined ($cr);
$arg = '' unless defined ($arg);
$i++;
$component_cr{$name} = $cr;
$component_arg{$name} = $arg;
}
close (LBL);
}
sub read_cmp() {
my ($line, $name, $type, $type_rep, $name_rep, $rep, $i, %anon_index);
open (CMP, $cmp) or die ("MTT: __FILE__, cannot open $cmp");
$i = 0;
while (<CMP>) {
chomp;
# skip blank lines
next if (/^(\s)*$/);
# skip comments
next if (/^(\s)*[%\#]/);
# remove leading and trailing whitespace
s/^\s*(\S.*\S)\s*$/$1/;
$line = $_;
print ("Processing: $line\n") if defined ($debug);
($type, $name_rep) = split (/:/, $line);
if (! defined ($name_rep)) {# anonymous component
$type_rep = $line;
($type, $rep) = split (/\*/, $type_rep);
if (! defined ($rep)) {
$type = $type_rep;
$rep = 1;
}
if (! defined ($anon_index{$type})) {
$anon_index{$type} = 1;
} else {
$anon_index{$type}++;
}
my $index = $anon_index{$type};
$name = "mtt${type}_${index}";
$rep = 1;
} else { # named component
($name, $rep) = split (/\*/, $name_rep);
if (! defined ($rep)) {
$name = $name_rep;
$rep = 1;
}
}
$i++;
print "i=$i : NAME='$name' TYPE='$type' REP='$rep'\n" if defined ($debug);
$component_name[$i] = $name;
$component_type{$name} = $type;
$component_rep{$name} = $rep;
# place holders
$component_cr{$name} = '';
$component_arg{$name} = '';
}
close (CMP);
}
sub write_header() {
my $date = `date`;
chomp ($date);
open (OUT, ">$out") or
die "MTT: cannot open $out for writing.\n";
print OUT << "EOF";
## $out -*-octave-*-
## Generated by MTT on $date
# writing header
function [comp_type, name, cr, arg, repetitions] = ${sys}_cmp(i)
EOF
close (OUT);
}
sub write_body() {
my ($name, $i);
open (OUT, ">>$out") or
die "MTT: cannot open $out for writing.\n";
$i = 0;
foreach $name (@component_name) {
if (defined ($name)) {
$i++;
print "#Name: \"$name\"\n" if defined ($debug);
print OUT
"if (i == $i)\n" .
"\tcomp_type = '$component_type{$name}';\n" .
"\tname = '$name'\n" .
"\tcr = '$component_cr{$name}';\n" .
"\targ = '$component_arg{$name}';\n" .
"\trepetitions = $component_rep{$name} ;\n" .
"end\n";
}
}
close (OUT);
}