File mttroot/mtt/bin/trans/lbl2cmp_txt2m.pl artifact efef75dda9 part of check-in 927ce86557

#! /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);
}