← Back to branch summary

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

« back to all changes in this revision

Viewing changes to maple/maple2scilab.mpl.g

  • 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:
maple/maple2scilab.mpl.g
 
1
#****************************************************************************
 
2
#                          Maple to Scilab interface
 
3
#                        Version 1.0.1 (18 August 1998)
 
4
#                         Copyright (C) 1997-98 INRIA 
 
5
#
 
6
#                                Claude Gomez                               
 
7
#                           Tel: 33+ 01 39 63 55 77                         
 
8
#                       email: Claude.Gomez@inria.fr
 
9
#              Web site: http://www-rocq.inria.fr/scilab/gomez
 
10
#                                                                           
 
11
#                                META2 project                              
 
12
#                                                                           
 
13
#                              INRIA-Rocquencourt
 
14
#                             Domaine de Voluceau                           
 
15
#                                    BP 105                         
 
16
#                            78153 Le Chesnay Cedex                         
 
17
#                                    FRANCE                                 
 
18
#****************************************************************************
 
19
 
 
20
#############################################################################
 
21
# maple2scilab Maple procedure
 
22
#
 
23
# Converts a Maple matrix "expr" into a Scilab function "fname".
 
24
# The Maple matrix can have parameters which are changed into
 
25
#   the arguments of the Scilab function.
 
26
# Then you have to load the generated code into Scilab: the way
 
27
#   to do that is printed by the maple2scilab procedure.
 
28
#
 
29
# This conversion is made via: Fortran if "code" is 'f'
 
30
#                              C if "code" is 'c'
 
31
#                         directly in Scilab if code is 's'.
 
32
#
 
33
# Note that "expr" can also be an algebraic expression, a vector,
 
34
#   a bi-dimensional array or a list of lists.
 
35
#
 
36
# If there is a fifth argument, it is the directory where
 
37
#   the source codes of the Scilab function, Fortran subroutine
 
38
#   or C function are gererated. Otherwise, the current directory is used.
 
39
#
 
40
# When generating C code, the file must include the "machine.h" header
 
41
#   distributed with Scilab in the "routines" directory. Its path
 
42
#   is automatically generated when installing Scilab.
 
43
# If you want to change the path, use the Maple global variable
 
44
#   "machine_include"; for instance, do in Maple:
 
45
#   machine_include:=`/my_directory/machine.h`;
 
46
#
 
47
# By default, the Fortran or C generated code is not optimized. If you want 
 
48
#   to generated optimized code do: optimized:=true;
 
49
#############################################################################
 
50
 
 
51
maple2scilab:=proc(fname::{name,string},expr,parameters,code::{name,string})
 
52
local ffile,k,lpath,maplematrix,ofile,para,release,sfile,soptimized;
 
53
global _ifunc,_old_labelling,_old_quiet,_old_screenwidth,_scicall,
 
54
       optimized;
 
55
_old_quiet:=interface(quiet); interface(quiet=true);
 
56
_old_labelling:=interface(labelling); interface(labelling=false);
 
57
_old_screenwidth:=interface(screenwidth); interface(screenwidth=80);
 
58
# check arguments
 
59
if type(expr,scalar) then 
 
60
  maplematrix:=convert([[expr]],matrix);
 
61
elif type(expr,matrix) then
 
62
  maplematrix:=expr;
 
63
else
 
64
  maplematrix:=convert(expr,matrix);
 
65
fi;
 
66
# check parameters
 
67
if type(parameters,name) then
 
68
  para:=[parameters];
 
69
elif type(parameters,list) then
 
70
  para:=parameters;
 
71
else
 
72
  `maple2scilab/error`(`"parameters" argument must be a name or a list`)
 
73
fi;
 
74
for k in para do
 
75
  if type(eval(k),name) then next;
 
76
  elif type(eval(k),vector) or type(eval(k),matrix) then
 
77
    if entries(eval(k))<>NULL then
 
78
      `maple2scilab/error`(`matrix or vector parameter "`.k.
 
79
                           `" must not have entries`);
 
80
    fi
 
81
   else
 
82
      `maple2scilab/error`(`a parameter must be a name, a vector or a matrix`);
 
83
   fi;
 
84
od;
 
85
if code<>'f' and code<>'c' and code<>'s' then
 
86
  `maple2scilab/error`(`code must be 'f' (Fortran), 'c' (C) or 's' (Scilab)`);
 
87
fi;
 
88
lpath:=``;
 
89
if nargs=5 then lpath:=cat(args[5],`/`); fi;
 
90
_ifunc:=linalg[indexfunc](maplematrix);
 
91
if (_ifunc<>NULL and _ifunc<>'sparse') then
 
92
  `maple2scilab/error`(``.`matrix with index function "`._ifunc.
 
93
                       `" not implemented`);
 
94
fi;
 
95
# look for Maple release number
 
96
release:=interface(version):
 
97
if SearchText(`Release 4`,release) <> 0 then
 
98
  release:=4:
 
99
elif SearchText(`Release 5`,release) <> 0 then
 
100
  release:=5:
 
101
else
 
102
  ERROR(`Unknown Maple release`):
 
103
fi:
 
104
if code='f' then
 
105
  if not assigned(macrofor) then
 
106
    # load Macrofort according to Maple release number
 
107
    with(share):
 
108
    if assigned(optimized) then
 
109
      soptimized:=optimized;
 
110
    fi;
 
111
    if release = 4 then
 
112
      readshare(macrofor,'numerics');
 
113
    else 
 
114
      with(macrofor):
 
115
    fi;
 
116
    optimized:=soptimized;
 
117
  fi;
 
118
  ffile:=cat(``.lpath,fname,`.f`);
 
119
  writeto(ffile);
 
120
  `maple2scilab/make_fortran`(fname,maplematrix,para);
 
121
  writeto(terminal);
 
122
elif code='c' then
 
123
  if not assigned(macroC) then 
 
124
    with(share):
 
125
    if assigned(optimized) then
 
126
      soptimized:=optimized;
 
127
    fi;
 
128
    # load MacroC according to Maple release number
 
129
    if release = 4 then
 
130
      readshare(macroC,'numerics');
 
131
    else
 
132
      with(macroC);
 
133
    fi;
 
134
    optimized:=soptimized;
 
135
  fi;
 
136
  ffile:=cat(``.lpath,fname,`.c`);
 
137
  writeto(ffile);
 
138
  `maple2scilab/make_c`(fname,maplematrix,para);
 
139
  writeto(terminal);
 
140
elif code='s' then
 
141
  ffile:=cat(``.lpath,fname,`.sci`);
 
142
  `maple2scilab/scilab`(fname,expr,ffile,para);
 
143
  lprint(` `);
 
144
  lprint(`Scilab file created: `.ffile);
 
145
  lprint(` `);
 
146
  lprint(`Usage in Scilab: getf('`.ffile.`');`);
 
147
  lprint(`                 `._scicall);
 
148
  interface(quiet=_old_quiet);
 
149
  interface(labelling=_old_labelling);
 
150
  interface(screenwidth=_old_screenwidth);
 
151
  RETURN();
 
152
fi;
 
153
# generate Scilab code
 
154
sfile:=cat(``.lpath,fname,`.sci`);
 
155
writeto(sfile);
 
156
`maple2scilab/make_scilab_interface`(fname,maplematrix,para,code);
 
157
writeto(terminal);
 
158
lprint(` `);
 
159
if code='f' then
 
160
  lprint(`Fortran file created (to be compiled): `.ffile);
 
161
elif code='c' then
 
162
  lprint(`C file created (to be compiled): `.ffile);
 
163
fi;
 
164
ofile:=cat(``.lpath,fname,`.o`);
 
165
lprint(`Scilab file created: `.sfile);
 
166
lprint(` `);
 
167
lprint(`Usage in Scilab: link('`.ofile.`','`.fname.`');`);
 
168
lprint(`                 getf('`.sfile.`');`);
 
169
lprint(`                 `._scicall);
 
170
interface(quiet=_old_quiet);
 
171
interface(labelling=_old_labelling);
 
172
interface(screenwidth=_old_screenwidth);
 
173
RETURN();
 
174
end:
 
175
 
 
176
`maple2scilab/error`:=proc(message)
 
177
interface(quiet=_old_quiet);
 
178
interface(labelling=_old_labelling);
 
179
interface(screenwidth=_old_screenwidth);
 
180
ERROR(message);
 
181
end:
 
182
 
 
183
# This procedure generates the Fortran subroutine
 
184
#   corresponding to the maple matrix "maplematrix".
 
185
# If the matrix is not sparse, the Fortran subroutine is
 
186
#   fname(x1,x2,...,xn,fmat); it computes fmat(i,j) as a function of
 
187
#   the arguments x1,x2,...,xn.
 
188
# If the matrix is sparse, the Fortran subroutine is
 
189
#   fname(x1,x2,...,xn,ij,v,mn); it computes v(i) as a function of
 
190
#   the arguments x1,x2,...,xn. ij and mn are used for creating the
 
191
#   Scilab sparse matrix.
 
192
# Each argument can be a maple scalar, vector or matrix which should be
 
193
#   in the list "arguments".
 
194
 
 
195
`maple2scilab/make_fortran`:=proc(fname,maplematrix,arguments)
 
196
global _ifunc,optimized;
 
197
local ent,flist,fmat,ij,ind,k,listarg,ll,mn,nent,soptimized,v;
 
198
listarg:=[]:
 
199
ll:=NULL;
 
200
if arguments<>[] then
 
201
  for k in arguments do
 
202
    if type(eval(k),name) then
 
203
      listarg:=[op(listarg),k];
 
204
    elif type(eval(k),vector) then
 
205
      listarg:=[op(listarg),k[linalg[vectdim](eval(k))]];
 
206
    elif type(eval(k),matrix) then
 
207
      listarg:=[op(listarg),
 
208
                k[linalg[rowdim](eval(k)),linalg[coldim](eval(k))]];
 
209
    fi;
 
210
  od;
 
211
  if listarg<>[] then ll:=['declaref','doubleprecision',listarg]; fi;
 
212
fi;
 
213
if _ifunc=NULL then
 
214
  flist:=['subroutinem',fname,[op(arguments),'fmat'],
 
215
           [['commentf',``],
 
216
            ['commentf',`Function generated by Maple to Scilab interface`],
 
217
            ['commentf',``],
 
218
            ['declaref',`implicit doubleprecision`,[`(a-h,o-z)`]],
 
219
            ll,
 
220
            ['declaref','dimension',
 
221
              [fmat[linalg[rowdim](maplematrix),linalg[coldim](maplematrix)]]],
 
222
            ['matrixm','fmat',maplematrix]]];
 
223
elif _ifunc='sparse' then
 
224
  ind:=matrix([indices(maplematrix)]); 
 
225
  ent:=vector(map(op,[entries(maplematrix)]));
 
226
  nent:=linalg[vectdim](ent);
 
227
  flist:=['subroutinem',fname,[op(arguments),'ij','v','mn'],
 
228
           [['commentf',``],
 
229
            ['commentf',`Function generated by Maple to Scilab interface`],
 
230
            ['commentf',``],
 
231
            ['declaref',`implicit doubleprecision`,[`(a-h,o-z)`]],
 
232
            ll,
 
233
            ['declaref','dimension',
 
234
             [ij[nent,2],v[nent],mn[2]]],
 
235
            ['equalf',mn[1],linalg[rowdim](maplematrix)],
 
236
            ['equalf',mn[2],linalg[coldim](maplematrix)],
 
237
            ['matrixm','ij',ind],
 
238
            ['matrixm','v',ent]]];
 
239
fi;
 
240
soptimized:=false;
 
241
if assigned(optimized) then
 
242
  soptimized:=optimized;
 
243
fi;
 
244
init_genfor();
 
245
optimized:=soptimized;
 
246
genfor(flist);
 
247
end:
 
248
 
 
249
# This procedure generates the C function
 
250
#   corresponding to the maple matrix "maplematrix".
 
251
# If the matrix is not sparse, the C function is
 
252
#   void fname(x1,x2,...,xn,fmat); it computes fmat(i,j) as a function of
 
253
#   the arguments x1,x2,...,xn.
 
254
# If the matrix is sparse, the C function is
 
255
#   void fname(x1,x2,...,xn,ij,v,mn); it computes v(i) as a function of
 
256
#   the arguments x1,x2,...,xn. ij and mn are used for creating the
 
257
#   Scilab sparse matrix.
 
258
# Each argument can be a maple scalar, vector or matrix which should be
 
259
#   in the list "arguments".
 
260
 
 
261
`maple2scilab/make_c`:=proc(fname,maplematrix,arguments)
 
262
global _ifunc,autodeclare,machine_include,optimized,precision;
 
263
local dcl,ent,flist,fmat,i,ij,include,ind,j,k,kk,listarg,m,mn,n,nent,
 
264
      soptimized,v;
 
265
if not assigned(machine_include) then
 
266
  include:=`SCILAB_DIRECTORY/routines/machine.h`;
 
267
else
 
268
  include:=machine_include;
 
269
fi;
 
270
listarg:=[]:
 
271
dcl:=[];
 
272
if arguments<>[] then
 
273
  for k in arguments do
 
274
    if type(eval(k),name) then 
 
275
      listarg:=[op(listarg),``.`*arg_`.k];
 
276
      dcl:=[op(dcl),['declareC','double',[``.k.`=*arg_`.k]]];
 
277
    elif type(eval(k),vector) then
 
278
      kk:=` `.k;
 
279
      listarg:=[op(listarg),kk[linalg[vectdim](eval(k))+1]];
 
280
    elif type(eval(k),matrix) then
 
281
      kk:=` `.k;
 
282
      listarg:=[op(listarg),kk[linalg[rowdim](eval(k))+1,
 
283
                                     linalg[coldim](eval(k))+1]];
 
284
    fi;
 
285
  od;
 
286
fi;
 
287
m:=linalg[rowdim](maplematrix); n:=linalg[coldim](maplematrix);
 
288
if _ifunc=NULL then
 
289
  flist:=[['commentC',` Function generated by Maple to Scilab interface `],[],
 
290
          ['includeC',` "`.include.`" `],
 
291
          ['includeC',`<math.h>`],[],
 
292
          ['functionm','void',``.`C2F(`.fname.`)`,
 
293
           [['double',[op(listarg),fmat[n+1,m+1]]]],
 
294
           [op(dcl),['matrixm','fmat',linalg[transpose](maplematrix)]]]];
 
295
elif _ifunc='sparse' then
 
296
  ind:=matrix([indices(maplematrix)]); 
 
297
  ent:=vector(map(op,[entries(maplematrix)]));
 
298
  nent:=linalg[vectdim](ent);
 
299
  flist:=[['commentC',` Function generated by Maple to Scilab interface `],[],
 
300
          ['includeC',` "`.include.`" `],
 
301
          ['includeC',`<math.h>`],[],
 
302
          ['functionm','void',``.`C2F(`.fname.`)`,
 
303
           [['double',[op(listarg)]],['int',[ij[3,nent+1]]],
 
304
            ['double',[`*v`]],['int',[`*mn`]]],
 
305
           [op(dcl),[equalC,mn[1],m], [equalC,mn[2],n],
 
306
            ['matrixm','ij',linalg[transpose](ind)],
 
307
            ['matrixm','v',ent]]]];
 
308
fi;
 
309
soptimized:=false;
 
310
if assigned(optimized) then
 
311
  soptimized:=optimized;
 
312
fi;
 
313
init_genC();
 
314
optimized:=soptimized;
 
315
autodeclare:='double';
 
316
precision:='double';
 
317
genC(flist);
 
318
end:
 
319
 
 
320
# This procedure generates the Scilab function "fname" which calls
 
321
#   the fortran subroutine "fname".
 
322
 
 
323
`maple2scilab/make_scilab_interface`:=proc(fname,maplematrix,arguments,code)
 
324
local a,chain,ff,first,k,kk,l1,l2,naargs,nent,rest,snd,ss:
 
325
global _scicall;
 
326
#
 
327
naargs:=nops(arguments);
 
328
ff:=`(`;
 
329
if arguments<>[] then
 
330
  ff:=cat(ff,arguments[1]);
 
331
  k:=2;
 
332
  while k<naargs+1 do
 
333
    ff:=cat(ff,`,`,arguments[k]); k:=k+1; 
 
334
  od;
 
335
fi;
 
336
ff:=cat(ff,`)`);
 
337
_scicall:=cat(`out=`,fname,ff);
 
338
ff:=cat(`function [out]=`,fname,ff);
 
339
l1:=0:
 
340
rest:=ff:
 
341
if length(ff)>70 then 
 
342
  while length(rest)>70 do
 
343
    first[l1]:=cat(substring(rest,1..70),`...`);
 
344
    l1:=l1+1;
 
345
    first[l1]:=substring(rest,71..length(rest));
 
346
    rest:=first[l1];
 
347
  od:
 
348
else
 
349
  first[0]:=ff;
 
350
fi:
 
351
#
 
352
if _ifunc=NULL then
 
353
  ss:=cat(`out=fort(`,`'`,fname,`',`);
 
354
elif _ifunc='sparse' then
 
355
  ss:=cat(`[ij,v,mn]=fort(`,`'`,fname,`',`);
 
356
fi;
 
357
k:=1;
 
358
if arguments<>[] then
 
359
  for kk in arguments do
 
360
    a:=kk;
 
361
    if type(eval(kk),matrix) and code='c' then a:=cat(a,`'`); fi;
 
362
    chain:=cat(a,`,`,k,`,`,`'d',`);
 
363
    ss:=cat(ss,chain);
 
364
    k:=k+1;
 
365
  od;
 
366
fi;
 
367
ss:=cat(ss,`'out',`);
 
368
if _ifunc=NULL then
 
369
  ss:=cat(ss,`[`,linalg[rowdim](maplematrix),`,`,
 
370
             linalg[coldim](maplematrix),`],`,naargs+1,`,'d')`);
 
371
elif _ifunc='sparse' then
 
372
  nent:=nops([entries(maplematrix)]);
 
373
  ss:=cat(ss,`[`,nent,`,`,2,`],`,naargs+1,`,'i',`,
 
374
             `[`,nent,`,1],`,naargs+2,`,'d',`,
 
375
             `[2,1],`,naargs+3,`,'i')`);
 
376
fi;
 
377
l2:=0;
 
378
rest:=ss;
 
379
if length(ss)>70 then 
 
380
  while length(rest)>70 do
 
381
    snd[l2]:=cat(substring(rest,1..70),`...`);
 
382
    l2:=l2+1;
 
383
    snd[l2]:=substring(rest,71..length(rest));
 
384
    rest:=snd[l2];
 
385
  od;
 
386
else
 
387
  snd[0]:=ss;
 
388
fi;
 
389
lprint(first[0]);
 
390
lprint(`// Function generated by Maple to Scilab interface`);
 
391
for k from 1 to l1 do lprint(first[k]); od;
 
392
for k from 0 to l2 do lprint(snd[k]); od;
 
393
if _ifunc='sparse' then
 
394
  lprint(`out=sparse(ij,v,mn)`);
 
395
fi;
 
396
end:
 
397
 
 
398
# This procedure generates directly the Scilab function
 
399
#   corresponding to the maple expression "e".
 
400
# The Scilab function is fname(x1,x2,...,xn).
 
401
# Each argument can be a maple scalar, vector or matrix which should be
 
402
#   in the list "arguments".
 
403
 
 
404
`maple2scilab/scilab` := proc(fname,e,file,arguments)
 
405
  local bres;
 
406
  bres := traperror(`scilab/scilab1`(fname,e,file,arguments));
 
407
  writeto(terminal);
 
408
  if bres = lasterror then print(`maple2scilab/scilab`,lasterror) fi; 
 
409
end:
 
410
 
 
411
`scilab/scilab1` := proc(fname,e,file,arguments)
 
412
  global _ifunc,_scicall,_scilab_buffer,_scilab_level;
 
413
  local ent,ind,k,naargs,str;
 
414
  writeto(file);
 
415
  _scilab_level := 0;
 
416
  if type(e,'procedure') and type(e,'name') then 
 
417
    ERROR(`unable to translate a procedure to Scilab`,e);
 
418
  else
 
419
    naargs:=nops(arguments);
 
420
    str:=`(`;
 
421
    if arguments<>[] then
 
422
      str:=cat(str,arguments[1]);
 
423
      k:=2;
 
424
      while k<naargs+1 do
 
425
        str:=cat(str,`,`,arguments[k]); k:=k+1; 
 
426
      od;
 
427
    fi;
 
428
    str:=cat(str,`)`);
 
429
    _scicall:=cat(`out=`,fname,str);
 
430
    str:=cat(`function [out]=`,fname,str);
 
431
    `scilab/lprint`(str);
 
432
    str := `// Function generated by Maple to Scilab interface`;
 
433
    `scilab/lprint`(str);
 
434
    if _ifunc=NULL then
 
435
       _scilab_buffer := `out=`;
 
436
      `scilab/expression`(e);
 
437
      `scilab/lprint`(_scilab_buffer);
 
438
    elif _ifunc='sparse' then
 
439
      ind:=matrix([indices(e)]); 
 
440
      ent:=vector(map(op,[entries(e)]));
 
441
      _scilab_buffer := `ij=`;
 
442
      `scilab/expression`(ind);
 
443
      `scilab/lprint`(_scilab_buffer);
 
444
      _scilab_buffer := `v=`;
 
445
      `scilab/expression`(ent);
 
446
      `scilab/lprint`(_scilab_buffer);
 
447
      str := cat(`out=sparse(ij,v,[`,linalg[rowdim](e),`,`,
 
448
                 linalg[coldim](e),`])`);
 
449
      `scilab/lprint`(str);
 
450
    fi;
 
451
  fi;
 
452
end:
 
453
 
 
454
`scilab/space` := proc(n) 
 
455
  if n = 0 then `` else map(cat,` `$n) fi 
 
456
end:
 
457
 
 
458
`scilab/lprint` := proc(str)
 
459
  global _scilab_level;
 
460
  local stro;
 
461
  stro := cat(`scilab/space`(_scilab_level),str);
 
462
  lprint(stro)
 
463
end:
 
464
 
 
465
`scilab/write` := proc(e) local d, l, maxl, stro;
 
466
  global _scilab_buffer,_scilab_level;
 
467
  maxl := 72;
 
468
  l := length(e);
 
469
  stro := cat(`scilab/space`(_scilab_level),_scilab_buffer);
 
470
  d := length(stro) + l - (maxl - 2);
 
471
  if d <= 0 then _scilab_buffer := cat(_scilab_buffer,e);
 
472
  else
 
473
    _scilab_buffer := cat(stro,substring(e,1..l-d),`..`);
 
474
    lprint(_scilab_buffer);
 
475
    _scilab_buffer := substring(e,l-d+1..l);
 
476
  fi
 
477
end:
 
478
 
 
479
`scilab/expression` := proc(e) local a;
 
480
  if type(e,'array') and type(e,name) then `scilab/array`(e)
 
481
  elif type(e,'array') then a:=e; `scilab/array`(a)
 
482
  elif type(e,'algebraic') then `scilab/alg`(e);
 
483
  elif type(e,'list') then `scilab/list`(e);
 
484
  else
 
485
    ERROR(`unable to translate to Scilab`,e);
 
486
  fi;
 
487
end:
 
488
 
 
489
`scilab/array` := proc(a) local i,j,ins,d,i1,i2,j1,j2;
 
490
  global _scilab_buffer;
 
491
  ins := op(2,op(a));
 
492
  d := nops([ins]);
 
493
  if (d = 1) then
 
494
    `scilab/write`(`[`); `scilab/lprint`(_scilab_buffer);
 
495
      for i from op(1,ins) to op(2,ins) do
 
496
        _scilab_buffer:=``;
 
497
        `scilab/alg`(a[i]); 
 
498
        `scilab/lprint`(``._scilab_buffer.`;`);
 
499
      od;
 
500
    _scilab_buffer:=``;
 
501
    `scilab/lprint`(`]`);
 
502
  elif (d = 2) then
 
503
    `scilab/write`(`[[`); `scilab/lprint`(_scilab_buffer);
 
504
     j1 := op(1,op(2,[ins]));
 
505
     j2 := op(2,op(2,[ins]));
 
506
     i1 := op(1,op(1,[ins]));
 
507
     i2 := op(2,op(1,[ins]));
 
508
     for j from j1 to j2 do
 
509
       for i from i1 to i2 do
 
510
         _scilab_buffer:=``;
 
511
         `scilab/alg`(a[i,j]); 
 
512
         `scilab/lprint`(``._scilab_buffer.`;`);
 
513
       od;
 
514
       if (j <> j2) then 
 
515
         _scilab_buffer:=``;
 
516
         `scilab/lprint`(`],[`) fi;
 
517
     od;
 
518
    _scilab_buffer:=``;
 
519
    `scilab/lprint`(`]]`);
 
520
  else
 
521
    ERROR(`unable to translate to Scilab`);
 
522
  fi    
 
523
end:
 
524
 
 
525
`scilab/alg` := proc(e) local k,p,s;
 
526
  if type(e,'float') then `scilab/write`(`scilab/float`(evalf(e)))
 
527
  elif type(e,'integer') then `scilab/write`(`scilab/integer`(e))
 
528
  elif (e = Pi) then `scilab/write`(`%pi`)
 
529
  elif (e = E) then `scilab/write`(`%e`)
 
530
  elif (e = I) then `scilab/write`(`%i`)
 
531
 
 
532
  elif type(e,`*`) then
 
533
 
 
534
        if op(1,e) + 1 = 0 then
 
535
                `scilab/write`(`-`);
 
536
                p := nops(e) = 2 and `scilab/precedence`(op(2,e)) <= 50;
 
537
                if p then `scilab/write`(`(`) fi;
 
538
                `scilab/alg`(subsop(1=1,e));
 
539
                if p then `scilab/write`(`)`) fi;
 
540
                RETURN()
 
541
        elif type(op(1,e),'fraction') and
 
542
                (op(1,op(1,e)) = 1 or op(1,op(1,e)) = -1) then
 
543
                if op(1,e) < 0 then `scilab/write`(`-`) fi;
 
544
                p := nops(e) = 2 and `scilab/precedence`(op(2,e)) <= 50;
 
545
                if p then `scilab/write`(`(`) fi;
 
546
                `scilab/alg`(subsop(1=1,e));
 
547
                if p then `scilab/write`(`)`) fi;
 
548
                `scilab/write`(`/`.(op(2,op(1,e))));
 
549
                RETURN()
 
550
        fi;
 
551
 
 
552
        p := `scilab/precedence`(e,1);
 
553
        if p then `scilab/write`(`(`) fi;
 
554
        `scilab/alg`(op(1,e));
 
555
        if p then `scilab/write`(`)`) fi;
 
556
        for k from 2 to nops(e) do
 
557
                if type(op(k,e),`^`) and type(op(2,op(k,e)),'numeric')
 
558
                        and sign(op(2,op(k,e))) = -1 
 
559
                then s := op(1,op(k,e))^(-op(2,op(k,e))); 
 
560
                  `scilab/write`(`/`)
 
561
                else s := op(k,e); `scilab/write`(`*`)
 
562
                fi;
 
563
                p := `scilab/precedence`(s) < `scilab/precedence`(e);
 
564
                if p then `scilab/write`(`(`) fi;
 
565
                `scilab/alg`(s);
 
566
                if p then `scilab/write`(`)`) fi;
 
567
        od
 
568
 
 
569
  elif type(e,`^`) then
 
570
 
 
571
        if type(op(2,e),'rational') and op(2,e) < 0 then
 
572
                p := `scilab/precedence`(op(1,e));
 
573
                `scilab/write`(`1/`);
 
574
                if p < 70 then `scilab/write`(`(`) fi;
 
575
                `scilab/alg`(op(1,e)^(-op(2,e)));
 
576
                if p < 70 then `scilab/write`(`)`) fi;
 
577
        elif type(op(1,e),'name') and type(op(2,e),'integer') then
 
578
                `scilab/write`(cat(convert(op(1,e),string),`**`,op(2,e)) )
 
579
        elif type(op(2,e),'fraction') and op(2,op(2,e))=2 then
 
580
                s := op(1,e)^op(1,op(2,e));
 
581
                `scilab/alg`('sqrt'(s))
 
582
        else    p := `scilab/precedence`(e,1);
 
583
                if p then `scilab/write`(`(`) fi;
 
584
                `scilab/alg`(op(1,e));
 
585
                if p then `scilab/write`(`)`) fi;
 
586
                `scilab/write`(`**`);
 
587
                p := `scilab/precedence`(e,2);
 
588
                if p then `scilab/write`(`(`) fi;
 
589
                `scilab/alg`(op(2,e));
 
590
                if p then `scilab/write`(`)`) fi;
 
591
        fi
 
592
 
 
593
  elif type(e,`+`) then
 
594
        p := `scilab/precedence`(e,1);
 
595
        if p then `scilab/write`(`(`) fi;
 
596
        `scilab/alg`(op(1,e));
 
597
        if p then `scilab/write`(`)`) fi;
 
598
        for k from 2 to nops(e) do
 
599
                if not (type(op(k,e),'numeric') and op(k,e) < 0 or
 
600
                        type(op(k,e),`*`) and type(op(1,op(k,e)),'numeric')
 
601
                        and sign(op(1,op(k,e))) = -1)
 
602
                then `scilab/write`(`+`) fi;
 
603
                p := `scilab/precedence`(e,k);
 
604
                if p then `scilab/write`(`(`) fi;
 
605
                `scilab/alg`(op(k,e));
 
606
                if p then `scilab/write`(`)`) fi;
 
607
        od
 
608
 
 
609
  elif type(e,'function') then
 
610
  `scilab/function`(op(0,e),op(e))
 
611
 
 
612
  elif type(e,'indexed') then
 
613
    if (op(0,e) = `&args`) then
 
614
      `scilab/write`(_larg[op(1,op(1,e))])
 
615
    elif (op(0,e) = `&local`) then
 
616
      `scilab/write`(_lcal[op(1,op(1,e))])
 
617
    else
 
618
        `scilab/alg`(op(0,e));
 
619
        `scilab/write`(`(`);
 
620
        if type(op(1,e),'function') and (op(0,op(1,e)) = `&expseq`) then
 
621
          s := op(1,e);
 
622
        else s:= e; fi;
 
623
        `scilab/alg`(op(1,s));
 
624
        for k from 2 to nops(s) do
 
625
                `scilab/write`(`,`);
 
626
                `scilab/alg`(op(k,s))
 
627
        od;
 
628
        `scilab/write`(`)`)
 
629
    fi
 
630
 
 
631
  elif type(e,'name') then `scilab/write`(e)
 
632
 
 
633
  elif type(e,'fraction') then
 
634
        `scilab/alg`(evalf(op(1,e)));
 
635
        `scilab/write`('`/`');
 
636
        `scilab/alg`(evalf(op(2,e)));
 
637
 
 
638
  else ERROR(`unable to translate to Scilab`,e);
 
639
fi
 
640
 
 
641
end:
 
642
 
 
643
`scilab/function` := proc(f) local k;
 
644
  if (nargs > 1) and type(args[2],'function') and 
 
645
     (op(0,args[2]) = `&expseq`) then
 
646
    `scilab/function`(args[1],op(args[2]))
 
647
  elif f = `&ev` then `scilab/ev`(args[2])
 
648
  elif f = 'evalm' then `scilab/evalm`(args[2..nargs])
 
649
  elif f = 'add' then
 
650
        `scilab/write`(`(`);
 
651
       if nargs > 1 then
 
652
          `scilab/alg`(args[2]);
 
653
          for k from 3 to nargs do
 
654
                `scilab/write`(`+`);
 
655
                `scilab/alg`(args[k])
 
656
          od;
 
657
        fi;
 
658
        `scilab/write`(`)`);
 
659
  elif f = 'multiply' then
 
660
        `scilab/write`(`(`);
 
661
       if nargs > 1 then
 
662
          `scilab/alg`(args[2]);
 
663
          for k from 3 to nargs do
 
664
                `scilab/write`(`*`);
 
665
                `scilab/alg`(args[k])
 
666
          od;
 
667
        fi;
 
668
        `scilab/write`(`)`);
 
669
  elif f = 'inverse' then
 
670
        `scilab/write`(`(1/`);
 
671
       if nargs < 2 then ERROR(`inverse must have one argument`) fi;
 
672
        `scilab/alg`(args[2]);
 
673
        `scilab/write`(`)`);
 
674
  else  `scilab/alg`(
 
675
          `scilab/function_name`(f));
 
676
        `scilab/write`(`(`);
 
677
        if nargs > 1 then
 
678
          if type(args[2],'integer')
 
679
          then `scilab/write`(`scilab/float`(evalf(args[2])))
 
680
          else `scilab/alg`(args[2])
 
681
          fi;
 
682
          for k from 3 to nargs do
 
683
                `scilab/write`(`,`);
 
684
                if type(args[k],'integer')
 
685
                then `scilab/write`(`scilab/float`(evalf(args[k])))
 
686
                else `scilab/alg`(args[k])
 
687
                fi
 
688
          od;
 
689
        fi;
 
690
        `scilab/write`(`)`);
 
691
        if (f = 'transpose') or (f = linalg['transpose']) then
 
692
          `scilab/write`(`'`) fi
 
693
  fi
 
694
end:
 
695
 
 
696
`scilab/evalm` := proc()
 
697
  ERROR(`unable to translate evalm to Scilab`);
 
698
end:
 
699
 
 
700
`scilab/list` := proc(e) local k,s;
 
701
  `scilab/write`(`list(`);
 
702
  if nops(e) > 0 then
 
703
    if type(op(1,e),'function') and (op(0,op(1,e)) = `&expseq`) then
 
704
      s := op(1,e);
 
705
    else s:= e; fi;
 
706
    `scilab/expression`(op(1,s));
 
707
    for k from 2 to nops(s) do
 
708
                `scilab/write`(`,`);
 
709
                `scilab/expression`(op(k,s))
 
710
    od;
 
711
  fi;
 
712
  `scilab/write`(`)`)
 
713
end:
 
714
 
 
715
`scilab/precedence` := proc(e,k)
 
716
option `Copyright 1989 by the University of Waterloo`;
 
717
 
 
718
if nargs = 1 then
 
719
        if type(e,'name') then 99
 
720
        elif type(e,'integer') and e > 0 then 99
 
721
        elif type(e,`*`) then 70
 
722
        elif type(e,`+`) then 50
 
723
        elif type(e,`^`) then 80
 
724
        elif type(e,'float') and e > 0 then 99
 
725
        elif type(e,'function') or type(e,'indexed') then 99
 
726
        elif type(e,'rational') then 70
 
727
        elif type(e,'integer') then 60
 
728
        elif type(e,'float') then 60
 
729
        elif type(e,`=`) or type(e,`<`) or type(e,`<=`) or type(e,`<>`) then 40
 
730
        elif type(e,`not`) then 30
 
731
        elif type(e,`and`) then 20
 
732
        elif type(e,`or`) then 10
 
733
        else 0
 
734
        fi
 
735
elif type(e,`*`) and k = 1 and type(op(1,e),'numeric') then false
 
736
elif type(e,`^`) and k = 1 and type(op(1,e),`^`) then true
 
737
else `scilab/precedence`(e) > `scilab/precedence`(op(k,e))
 
738
fi
 
739
 
 
740
end:
 
741
 
 
742
`scilab/float` := proc(f) local mantissa,exponent,letter,quotient,prefix;
 
743
        if f = 0
 
744
        then mantissa := 0; exponent := 0
 
745
        else mantissa := op(1,f); exponent := op(2,f) fi;
 
746
        if exponent = 0 and mantissa < 1000000 then
 
747
                  RETURN( cat(mantissa,`.0`) ) 
 
748
        fi;
 
749
        letter := 'D';
 
750
        if mantissa < 0 then
 
751
                prefix := `-0.`;
 
752
                mantissa := -mantissa
 
753
        else prefix := `0.`
 
754
        fi;
 
755
        while irem(mantissa,10,'quotient') = 0 do
 
756
                mantissa := quotient;
 
757
                exponent := exponent+1
 
758
        od;
 
759
        exponent := exponent+length(mantissa);
 
760
        cat(prefix,mantissa,letter,exponent)
 
761
end:
 
762
 
 
763
`scilab/integer` := proc(e)
 
764
  if length(e) > Digits then
 
765
    `m_fortran/float`(evalf(e))
 
766
  else ``.e
 
767
  fi
 
768
end:
 
769
 
 
770
`scilab/bool` := proc(c)
 
771
  if member(whattype(c),{`=`,`<`,`>`,`<=`,`>=`,`<>`}) then
 
772
    `scilab/alg`(op(1,c));
 
773
    `scilab/write`(whattype(c));
 
774
    `scilab/alg`(op(2,c));
 
775
  elif c = true then
 
776
    `scilab/write`(`1=1`)
 
777
  elif c = false then
 
778
    `scilab/write`(`1=0`)
 
779
  else ERROR(`unable to translate to Scilab`,c)
 
780
  fi
 
781
end:
 
782
 
 
783
`scilab/function_name` := proc(f) f end:
 
784
 
 
785
`scilab/function_name`('arctanh') := 'atanh':
 
786
`scilab/function_name`('arctan') := 'atan':
 
787
`scilab/function_name`('arcsin') := 'asin':
 
788
`scilab/function_name`('arcsinh') := 'asinh':
 
789
`scilab/function_name`('arccos') := 'acos':
 
790
`scilab/function_name`('arccosh') := 'acosh':
 
791
`scilab/function_name`('cot') := 'cotg':
 
792
`scilab/function_name`('ln') := 'log':
 
793
`scilab/function_name`('transpose') := ``: