← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to macros/m2sci/mmodlst.sci

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
macros/m2sci/mmodlst.sci
 
1
function lst=mmodlst(lst)
 
2
// mmodlst is used to reduce mutiple concatenations, obtained by the 
 
3
// interpretor, such as 
 
4
// [[a,b],c]
 
5
// [[a;b];c]
 
6
// to a single one  whenever possible 
 
7
//!
 
8
// Copyright INRIA
 
9
void=['0','0','0','0']
 
10
nlst=size(lst);top=0
 
11
ilst=0
 
12
pos=[]
 
13
to_kill=[]
 
14
while ilst<nlst
 
15
  ilst=ilst+1
 
16
  if type(lst(ilst))==15 then
 
17
    lst(ilst)=mmodlst(lst(ilst))
 
18
  else
 
19
    op=lst(ilst)
 
20
    if type(op)<>10 then op='????',end  //bug dans macr2lst
 
21
    opn=op(1)
 
22
    if opn=='5' then
 
23
      if op(2)=='23' then // row concatenation
 
24
        i2=pos(top);i1=pos(top-1)
 
25
        a1=lst(i1)
 
26
        a2=lst(i2);
 
27
        // [a1 a2] contenation 
 
28
        if a1(1:2)==['5','23'] then 
 
29
          // [a1,a2] is [[a,b,...],a2] replaced by [a,b,...,a2 ]
 
30
          lst(i1)=void;to_kill=[to_kill,i1] //ignore concat which forms a1
 
31
          lst(ilst)(3)=addf(a1(3),'1'); //change rhs of current concat
 
32
          top=top-1
 
33
          pos(top)=ilst
 
34
        else // catenate
 
35
          top=top-1
 
36
          pos(top)=ilst
 
37
        end
 
38
      elseif op(2)=='27' then // column  concatenation
 
39
        i2=pos(top);i1=pos(top-1)
 
40
        a1=lst(i1)
 
41
        if size(a1,2)<4 then a1(4)=' ',end
 
42
 
 
43
        a2=lst(i2)
 
44
        if size(a2,2)<4 then a2(4)=' ',end
 
45
 
 
46
        // [a1;a2] contenation 
 
47
        if a1(1:2)==['5','27'] then
 
48
          // [a1;a2] is [[a;b;...];a2] replaced by [a;b;...;a2 ]
 
49
          lst(i1)=void;to_kill=[to_kill,i1]//ignore concat which forms a1
 
50
          lst(ilst)(3)=addf(a1(3),'1');//change rhs of current concat
 
51
          top=top-1
 
52
          pos(top)=ilst
 
53
        elseif and(a1(1:2)==['5','23']&a2(1:2)==['5','23'])&a1(3)==a2(3) then
 
54
          // [a1;a2] is [[a,b,...];[x,y,..] replaced by [a,b,...;x,y,..]
 
55
          lst(i1)=void;to_kill=[to_kill,i1]//ignore concat which forms a1
 
56
          lst(i2)=void;to_kill=[to_kill,i2]//ignore concat which forms a2
 
57
          lst(ilst)=['5','33','2',a1(3)];// change op
 
58
          top=top-1
 
59
          pos(top)=ilst
 
60
        elseif and(a1(1:2)==['5','33']&a2(1:2)==['5','23'])&a1(4)==a2(3) then
 
61
          // [a1;a2] is [[[a,b,...;x,y,..];a2] replaced by [a,b,...;x,y,..;a2]
 
62
          w=lst(i1)
 
63
          lst(i1)=void;to_kill=[to_kill,i1]//ignore concat which forms a1
 
64
          lst(i2)=void;to_kill=[to_kill,i2]//ignore concat which forms a2
 
65
          lst(ilst)=w
 
66
          lst(ilst)(3)=addf(a1(3),'1');//change rhs of current concat 
 
67
          top=top-1
 
68
          pos(top)=ilst
 
69
        else // catenate
 
70
          top=top-1
 
71
          pos(top)=ilst
 
72
        end
 
73
 
 
74
      else
 
75
        rhs=abs(evstr(op(3)));lhs=evstr(op(4))
 
76
        pos((top-rhs+1):(top-rhs+lhs))=ones(lhs,1)*ilst
 
77
        top=top-rhs+lhs
 
78
        pos(top+1:$)=[]
 
79
      end
 
80
 
 
81
    elseif opn=='20' then
 
82
      rhs=abs(evstr(op(3)));lhs=evstr(op(4))
 
83
      pos((top-rhs+1):(top-rhs+lhs))=ones(lhs,1)*ilst
 
84
      top=top-rhs+lhs
 
85
      pos(top+1:$)=[]
 
86
    elseif opn=='2'|opn=='3'|opn=='4'|opn=='6'|opn=='23' then
 
87
      top=top+1
 
88
      pos(top)=ilst
 
89
      //    else
 
90
    end
 
91
  end
 
92
end
 
93
// purge list of suppressed concatenations
 
94
to_kill=sort(to_kill)
 
95
for k=1:prod(size(to_kill))
 
96
  lst(to_kill(k))=null();
 
97
end
 
98
 
 
99
 
 
100