Overview
Comment:Writes messages to logfile instead of stdout if debug is enabled.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | origin/master | trunk
Files: files | file ages | folders
SHA3-256: 3f67ca4c4cb854e389f2d936eea27fef24e7933632d4b65c0a2be4750b408a71
User & Date: geraint@users.sourceforge.net on 2004-09-07 18:25:50
Other Links: branch diff | manifest | tags
Context
2004-09-07
20:34:39
Reformats elementary system equations. check-in: 19a58b6986 user: geraint@users.sourceforge.net tags: origin/master, trunk
18:25:50
Writes messages to logfile instead of stdout if debug is enabled. check-in: 3f67ca4c4c user: geraint@users.sourceforge.net tags: origin/master, trunk
18:22:53
Issues a more helpful error message than the cryptic Octave stuff
if there are unconnected ports. check-in: b964998861 user: geraint@users.sourceforge.net tags: origin/master, trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified mttroot/mtt/bin/trans/ese_r2make.pl from [499a5fe272] to [d21f011f7e].

︙︙
45
46
47
48
49
50
51





52
53
54
55
56
57
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72

# default file names
$infile	 = "${sys}_ese.r"	if ($infile  eq '');
$outfile = "${sys}_ese.make"	if ($outfile eq '');

#-------------------------------------------------------------------------------
# main
#-------------------------------------------------------------------------------






# First the elementary system equations are read
# and placed in the "expressions" hash.
read_ese_r ();

# Then the occurence of any lvalue in the expression
# of any other is sought. 
get_dependencies ();

# Finally the expressions are written to a makefile
# where the targets are the left hand values and the
# pre-requisites are the dependencies
write_make ($sys);



#-------------------------------------------------------------------------------
# subroutines
#-------------------------------------------------------------------------------
sub read_ese_r {

    open (ESE, $infile)








>
>
>
>
>














>








45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

# default file names
$infile	 = "${sys}_ese.r"	if ($infile  eq '');
$outfile = "${sys}_ese.make"	if ($outfile eq '');

#-------------------------------------------------------------------------------
# main
#-------------------------------------------------------------------------------

if ($debug) {
    my $logfile = "ese_r2make_${sys}.log";
    open (LOG, ">$logfile") or die ("MTT: ese_r2make, cannot open $logfile");
}

# First the elementary system equations are read
# and placed in the "expressions" hash.
read_ese_r ();

# Then the occurence of any lvalue in the expression
# of any other is sought. 
get_dependencies ();

# Finally the expressions are written to a makefile
# where the targets are the left hand values and the
# pre-requisites are the dependencies
write_make ($sys);

close (LOG) if ($debug);

#-------------------------------------------------------------------------------
# subroutines
#-------------------------------------------------------------------------------
sub read_ese_r {

    open (ESE, $infile)
︙︙
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

	next if /^(\s)*$/;	# skip blank lines

	# separate the left and right side of equations
	# and assign them to the expressions hash
	my ($lvar,$expr) = split (/:=/);
	$expressions{$lvar} = $expr;

	print "$lvar\t= $expressions{$lvar}\n" if $debug;
    }
    
    close (ESE);
}
#-------------------------------------------------------------------------------
sub get_dependencies {

    # compare the pattern to each expression
    foreach my $lvar (keys %expressions) {
	$dependencies{$lvar} = "";
	$_ = $expressions{$lvar};
	for my $lvar2 (keys %expressions) {
	    if ($expressions{$lvar} =~ /$lvar2/) {
		# a left value has been found in the expression
		# add it to the dependencies for this lvar
		$dependencies{$lvar} = "$dependencies{$lvar} $lvar2";
	    }
	}
	print "$lvar:\t$dependencies{$lvar}\n" if $debug;
    }
}
#-------------------------------------------------------------------------------
sub write_make {
    
    # create lists of rates, states and tmpvars so that
    # separate rules can be created in the makefile








|


















|








89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

	next if /^(\s)*$/;	# skip blank lines

	# separate the left and right side of equations
	# and assign them to the expressions hash
	my ($lvar,$expr) = split (/:=/);
	$expressions{$lvar} = $expr;

	print LOG "$lvar\t= $expressions{$lvar}\n" if $debug;
    }
    
    close (ESE);
}
#-------------------------------------------------------------------------------
sub get_dependencies {

    # compare the pattern to each expression
    foreach my $lvar (keys %expressions) {
	$dependencies{$lvar} = "";
	$_ = $expressions{$lvar};
	for my $lvar2 (keys %expressions) {
	    if ($expressions{$lvar} =~ /$lvar2/) {
		# a left value has been found in the expression
		# add it to the dependencies for this lvar
		$dependencies{$lvar} = "$dependencies{$lvar} $lvar2";
	    }
	}
	print LOG "$lvar:\t$dependencies{$lvar}\n" if $debug;
    }
}
#-------------------------------------------------------------------------------
sub write_make {
    
    # create lists of rates, states and tmpvars so that
    # separate rules can be created in the makefile
︙︙

Modified mttroot/mtt/bin/trans/lbl2cmp_txt2m.pl from [975fe12492] to [aba4e1a1e3].

︙︙
43
44
45
46
47
48
49





50
51
52
53
54
55
56
57
58
59
60

61
62
63
64
65
66
67


my $sys = '';

GetOptions ('sys=s' => \$sys,
	    'debug' => \$debug);

die usage() if ($sys eq '');






$cmp = "${sys}_cmp.txt";
$lbl = "${sys}_lbl.txt";
$out = "${sys}_cmp.m";

read_cmp_file();
read_lbl_file();
sort_components();
write_header();
write_body();



sub usage() {
    return "Usage: lbl2cmp_txt2m --sys=<sys>\n";
}

sub read_cmp_file() {
    my ($line, $name, $type, $class, $rep, $i);








>
>
>
>
>











>








43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73


my $sys = '';

GetOptions ('sys=s' => \$sys,
	    'debug' => \$debug);

die usage() if ($sys eq '');

if ($debug) {
    my $logfile = "lbl2cmp_txt2m_${sys}.log";
    open (LOG, ">$logfile") or die ("MTT: lbl2cmp_txt2m, cannot open $logfile");
}

$cmp = "${sys}_cmp.txt";
$lbl = "${sys}_lbl.txt";
$out = "${sys}_cmp.m";

read_cmp_file();
read_lbl_file();
sort_components();
write_header();
write_body();

close (LOG) if ($debug);

sub usage() {
    return "Usage: lbl2cmp_txt2m --sys=<sys>\n";
}

sub read_cmp_file() {
    my ($line, $name, $type, $class, $rep, $i);
︙︙
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	$line = $_;
	print "read_cmp_file: line='${line}'\n" if ($debug);

	# cmp provides type, name and repetition information
	# class is inferred from type and name
	# (cr and args are placeholders)

	($type, $name, $rep) = read_cmp_line($line);
	$name = name_anonymous_component($type) if ($name eq '');	








|








82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

	next if (/^(\s)*$/);
	# skip comments
	next if (/^(\s)*[%\#]/);
	# remove leading and trailing whitespace
	s/^\s*(\S.*\S)\s*$/$1/;
	
	$line = $_;
	print LOG "read_cmp_file: line='${line}'\n" if ($debug);

	# cmp provides type, name and repetition information
	# class is inferred from type and name
	# (cr and args are placeholders)

	($type, $name, $rep) = read_cmp_line($line);
	$name = name_anonymous_component($type) if ($name eq '');
︙︙
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

	($name, $rep) = split (/\*/, $misc);
	$name = $misc unless defined ($name);
    }

    $name = '' unless defined $name;
    $rep  = 1  unless defined $rep;
    
    print "read_cmp_line: type='$type', name='$name', rep='$rep'\n" if ($debug);
    return ($type, $name, $rep);
}

sub name_anonymous_component() {
    my $type = $_;
    my ($name, $num);
    if (defined ($anonymous_component_type_index{$type})) {
	$num = ++$anonymous_component_type_index{$type};
	$name = "mtt${type}_${num}";
    } else {
	$anonymous_component_type_index{$type} = 1;
	$name = "mtt${type}";
    }
    print "name_anonymous_component: type='${type}', name='${name}'\n" if ($debug);
    return ($name);
}

sub port_or_component_or_junction() {

    # ports are internal SS components (SS:[...])
    # junctions are '0' and '1' types








|













|








117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

	($name, $rep) = split (/\*/, $misc);
	$name = $misc unless defined ($name);
    }

    $name = '' unless defined $name;
    $rep  = 1  unless defined $rep;
    
    print LOG "read_cmp_line: type='$type', name='$name', rep='$rep'\n" if ($debug);
    return ($type, $name, $rep);
}

sub name_anonymous_component() {
    my $type = $_;
    my ($name, $num);
    if (defined ($anonymous_component_type_index{$type})) {
	$num = ++$anonymous_component_type_index{$type};
	$name = "mtt${type}_${num}";
    } else {
	$anonymous_component_type_index{$type} = 1;
	$name = "mtt${type}";
    }
    print LOG "name_anonymous_component: type='${type}', name='${name}'\n" if ($debug);
    return ($name);
}

sub port_or_component_or_junction() {

    # ports are internal SS components (SS:[...])
    # junctions are '0' and '1' types
︙︙
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

    } elsif ($type eq "0") {
	$retval = "0junction";
    } elsif ($type eq "1") {
	$retval = "1junction";
    } else {
	$retval = "component";
    }
    print "port_or_component_or_junction: type='$type', name='$name' class='$retval'\n" if ($debug);
    return ($retval);
}

sub read_lbl_file() {
    my (@line, $name, $type, $cr, $arg, $i);
    
    open (LBL, $lbl) or die ("MTT: lbl2cmp_txt2m, cannot open $lbl");








|








157
158
159
160
161
162
163
164
165
166
167
168
169
170
171

    } elsif ($type eq "0") {
	$retval = "0junction";
    } elsif ($type eq "1") {
	$retval = "1junction";
    } else {
	$retval = "component";
    }
    print LOG "port_or_component_or_junction: type='$type', name='$name' class='$retval'\n" if ($debug);
    return ($retval);
}

sub read_lbl_file() {
    my (@line, $name, $type, $cr, $arg, $i);
    
    open (LBL, $lbl) or die ("MTT: lbl2cmp_txt2m, cannot open $lbl");
︙︙
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212


    $cr  = shift (@line);
    $arg = shift (@line);

    $cr   = '' unless defined ($cr);
    $arg  = '' unless defined ($arg);
    
    print "read_lbl_line: name='$name' cr='$cr' arg='$arg'\n" if ($debug);
    return ($name, $cr, $arg);
}

sub write_header() {
    my $date = `date`;
    chomp ($date);









|








204
205
206
207
208
209
210
211
212
213
214
215
216
217
218


    $cr  = shift (@line);
    $arg = shift (@line);

    $cr   = '' unless defined ($cr);
    $arg  = '' unless defined ($arg);
    
    print LOG "read_lbl_line: name='$name' cr='$cr' arg='$arg'\n" if ($debug);
    return ($name, $cr, $arg);
}

sub write_header() {
    my $date = `date`;
    chomp ($date);
︙︙
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249

    foreach $target ("port", "component", "0junction", "1junction") {
	my @sorted_list = sort (sort_rule @component_name);
	for $name (@sorted_list) {
	    $class = $component_class{$name};
	    if ($class eq $target) {
		if (! defined ($sorted_component_list{$name})) {
		    $sorted_component_list{$name} = $i++;
		    print "sorted: '$name' '$i'\n" if ($debug); 
		}
	    }
	}
    }
}

sub sort_rule ()








|








241
242
243
244
245
246
247
248
249
250
251
252
253
254
255

    foreach $target ("port", "component", "0junction", "1junction") {
	my @sorted_list = sort (sort_rule @component_name);
	for $name (@sorted_list) {
	    $class = $component_class{$name};
	    if ($class eq $target) {
		if (! defined ($sorted_component_list{$name})) {
		    $sorted_component_list{$name} = $i++;
		    print LOG "sorted: '$name' '$i'\n" if ($debug); 
		}
	    }
	}
    }
}

sub sort_rule ()
︙︙

MTT: Model Transformation Tools
[ GitHub | SourceHut | Sourceforge | Fossil RSS ]