1 // -*- mode:C++ ; compile-command: "g++-3.4 -I.. -g -c rpn.cc  -DIN_GIAC -DHAVE_CONFIG_H" -*-
2 #include "giacPCH.h"
3 /*
4  *  Copyright (C) 2001,14 B. Parisse, Institut Fourier, 38402 St Martin d'Heres
5  *
6  *  This program is free software; you can redistribute it and/or modify
7  *  it under the terms of the GNU General Public License as published by
8  *  the Free Software Foundation; either version 3 of the License, or
9  *  (at your option) any later version.
10  *
11  *  This program is distributed in the hope that it will be useful,
12  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
13  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  *  GNU General Public License for more details.
15  *
16  *  You should have received a copy of the GNU General Public License
17  *  along with this program. If not, see <http://www.gnu.org/licenses/>.
18  */
19 
20 using namespace std;
21 #include "rpn.h"
22 #include "symbolic.h"
23 #include "unary.h"
24 #include <algorithm>
25 #include <math.h>
26 #include "prog.h"
27 #include "usual.h"
28 #include "identificateur.h"
29 #include <stdio.h>
30 #ifdef HAVE_UNISTD_H
31 #include <unistd.h>
32 #if !defined(NSPIRE) && !defined FXCG && !defined(__VISUALC__) && !defined(KHICAS)// #ifndef NSPIRE
33 #include <dirent.h>
34 #if !defined(__MINGW_H) && !defined(HAVE_NO_PWD_H)
35 #include <pwd.h>
36 #endif // MINGW
37 #endif // NSPIRE
38 #endif // UNISTD
39 #include "input_lexer.h"
40 #include "plot.h"
41 #include "tex.h"
42 #include "ti89.h"
43 #include "maple.h"
44 #include "misc.h"
45 #include "permu.h"
46 #include "intg.h"
47 #include "derive.h"
48 #include "sym2poly.h"
49 #include "input_parser.h"
50 #include "solve.h"
51 #include "subst.h"
52 #include "csturm.h"
53 #include "giacintl.h"
54 
55 #ifdef GIAC_HAS_STO_38
56 #include "aspen.h"
57 //THPObj *EditMat(int);
58 #endif
59 
60 
61 #ifndef NO_NAMESPACE_GIAC
62 namespace giac {
63 #endif // ndef NO_NAMESPACE_GIAC
64 
enmajuscule(const string & s)65   string enmajuscule(const string & s){
66     string res;
67     string::const_iterator it=s.begin(),itend=s.end();
68     for (;it!=itend;++it){
69       if ((*it>='a') && (*it<='z'))
70         res += char(*it-32);
71       else
72         res += char(*it);
73     }
74     return res;
75   }
76 
printasconstant(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)77   string printasconstant(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
78     return sommetstr;
79   }
80 #ifdef RTOS_THREADX
return_undef(const gen &,GIAC_CONTEXT)81   gen return_undef(const gen &,GIAC_CONTEXT){
82     return undef;
83   }
84   static const char _rpn_s []="rpn";
85   static define_unary_function_eval2 (__rpn,&return_undef,_rpn_s,&printasconstant);
86   define_unary_function_ptr5( at_rpn ,alias_at_rpn ,(unary_function_eval*)&__rpn,0,true);
87 
88   static const char _alg_s []="alg";
89   static define_unary_function_eval2 (__alg,&return_undef,_alg_s,&printasconstant);
90   define_unary_function_ptr5( at_alg ,alias_at_alg ,(unary_function_eval *)&__alg,0,true);
91 
92   static const char _ROLL_s []="ROLL";
93   static define_unary_function_eval (__ROLL,&return_undef,_ROLL_s);
94   define_unary_function_ptr( at_ROLL ,alias_at_ROLL ,&__ROLL);
95 
96   static const char _ROLLD_s []="ROLLD";
97   static define_unary_function_eval (__ROLLD,&return_undef,_ROLLD_s);
98   define_unary_function_ptr( at_ROLLD ,alias_at_ROLLD ,&__ROLLD);
99 
100   static const char _SWAP_s []="SWAP";
101   static define_unary_function_eval (__SWAP,&return_undef,_SWAP_s);
102   define_unary_function_ptr5( at_SWAP ,alias_at_SWAP ,&__SWAP,0,T_RPN_OP);
103 
104   static const char _DUP_s []="DUP";
105   static define_unary_function_eval (__DUP,&return_undef,_DUP_s);
106   define_unary_function_ptr5( at_DUP ,alias_at_DUP ,&__DUP,0,T_RPN_OP);
107 
108   static const char _OVER_s []="OVER";
109   static define_unary_function_eval (__OVER,&return_undef,_OVER_s);
110   define_unary_function_ptr5( at_OVER ,alias_at_OVER ,&__OVER,0,T_RPN_OP);
111 
112   static const char _PICK_s []="PICK";
113   static define_unary_function_eval (__PICK,&return_undef,_PICK_s);
114   define_unary_function_ptr5( at_PICK ,alias_at_PICK ,&__PICK,0,T_RPN_OP);
115 
116   static const char _DROP_s []="DROP";
117   static define_unary_function_eval (__DROP,&return_undef,_DROP_s);
118   define_unary_function_ptr5( at_DROP ,alias_at_DROP ,&__DROP,0,T_RPN_OP);
119 
120   static const char _NOP_s []="NOP";
121   static define_unary_function_eval2_index (136,__NOP,&return_undef,_NOP_s,&printasconstant);
122   define_unary_function_ptr5( at_NOP ,alias_at_NOP ,&__NOP,0,T_RPN_OP);
123 
124   static const char _IFTE_s []="IFTE";
125   static define_unary_function_eval2_index (126,__IFTE,&return_undef,_IFTE_s,&printasconstant);
126   define_unary_function_ptr5( at_IFTE ,alias_at_IFTE ,&__IFTE,0,T_RPN_OP);
127 
128   static const char _RPN_LOCAL_s []="RPN_LOCAL";
129   static define_unary_function_eval2_index (130,__RPN_LOCAL,&return_undef,_RPN_LOCAL_s,&printasconstant);
130   define_unary_function_ptr5( at_RPN_LOCAL ,alias_at_RPN_LOCAL ,&__RPN_LOCAL,0,T_RPN_OP);
131 
132   static const char _RPN_FOR_s []="RPN_FOR";
133   static define_unary_function_eval2_index (132,__RPN_FOR,&return_undef,_RPN_FOR_s,&printasconstant);
134   define_unary_function_ptr5( at_RPN_FOR ,alias_at_RPN_FOR ,&__RPN_FOR,0,T_RPN_OP);
135 
136   static const char _RPN_WHILE_s []="RPN_WHILE";
137   static define_unary_function_eval2_index (134,__RPN_WHILE,&return_undef,_RPN_WHILE_s,&printasconstant);
138   define_unary_function_ptr5( at_RPN_WHILE ,alias_at_RPN_WHILE ,&__RPN_WHILE,0,T_RPN_OP);
139 
140   static const char _RPN_CASE_s []="RPN_CASE";
141   static define_unary_function_eval2_index (128,__RPN_CASE,&return_undef,_RPN_CASE_s,&printasconstant);
142   define_unary_function_ptr5( at_RPN_CASE ,alias_at_RPN_CASE ,&__RPN_CASE,0,T_RPN_OP);
143 
144   static const char _RPN_UNTIL_s []="RPN_UNTIL";
145   static define_unary_function_eval2 (__RPN_UNTIL,&return_undef,_RPN_UNTIL_s,&printasconstant);
146   define_unary_function_ptr( at_RPN_UNTIL ,alias_at_RPN_UNTIL ,&__RPN_UNTIL);
147 
148   static const char _rpn_prog_s []="rpn_prog";
149   static define_unary_function_eval2_index (83,__rpn_prog,&return_undef,_rpn_prog_s,&printasconstant);
150   define_unary_function_ptr5( at_rpn_prog ,alias_at_rpn_prog,&__rpn_prog,_QUOTE_ARGUMENTS,0);
151 #else // RTOS_THREADX
symb_rpn(const gen & args)152   static gen symb_rpn(const gen & args){
153     return symbolic(at_rpn,args);
154   }
_rpn(const gen & args,GIAC_CONTEXT)155   gen _rpn(const gen & args,GIAC_CONTEXT){
156     if ( args.type==_STRNG && args.subtype==-1) return  args;
157     rpn_mode(contextptr)=true;
158     return symb_rpn(args);
159   }
160   static const char _rpn_s []="rpn";
161   static define_unary_function_eval2 (__rpn,&_rpn,_rpn_s,&printasconstant);
162   define_unary_function_ptr5( at_rpn ,alias_at_rpn ,(unary_function_eval*)&__rpn,0,true);
163 
symb_alg(const gen & args)164   static gen symb_alg(const gen & args){
165     return symbolic(at_alg,args);
166   }
_alg(const gen & args,GIAC_CONTEXT)167   gen _alg(const gen & args,GIAC_CONTEXT){
168     if ( args.type==_STRNG && args.subtype==-1) return  args;
169     rpn_mode(contextptr)=false;
170     return symb_alg(args);
171   }
172   static const char _alg_s []="alg";
173   static define_unary_function_eval2 (__alg,&_alg,_alg_s,&printasconstant);
174   define_unary_function_ptr5( at_alg ,alias_at_alg ,(unary_function_eval *)&__alg,0,true);
175 
roll(int i,vecteur & v)176   void roll(int i,vecteur & v){
177     if (i<2)
178       return;
179     iterateur it=v.begin(),itend=v.end();
180     if (itend-it<i)
181       return;
182     it=itend-i;
183     gen save=*it;
184     for (;;){
185       ++it;
186       if (it==itend)
187 	break;
188       *(it-1)=*it;
189     }
190     *(it-1)=save;
191   }
192 
ROLL(int i,GIAC_CONTEXT)193   void ROLL(int i,GIAC_CONTEXT){
194     roll(i,history_in(contextptr));
195     roll(i,history_out(contextptr));
196   }
197 
_ROLL(const gen & args,GIAC_CONTEXT)198   gen _ROLL(const gen & args,GIAC_CONTEXT){
199     if ( args.type==_STRNG && args.subtype==-1) return  args;
200     if (args._VECTptr->empty())
201       return args;
202     gen e=args._VECTptr->back();
203     args._VECTptr->pop_back();
204     if (e.type==_INT_)
205       roll(e.val,*args._VECTptr);
206     if (e.type==_DOUBLE_)
207       roll(int(e._DOUBLE_val),*args._VECTptr);
208     return args;
209   }
210   static const char _ROLL_s []="ROLL";
211   static define_unary_function_eval (__ROLL,&_ROLL,_ROLL_s);
212   define_unary_function_ptr( at_ROLL ,alias_at_ROLL ,&__ROLL);
213 
rolld(int i,vecteur & v)214   void rolld(int i,vecteur & v){
215     if (i<2)
216       return;
217     iterateur it=v.begin(),itend=v.end();
218     if (itend-it<i)
219       return;
220     it=itend-i;
221     --itend;
222     gen save=*itend;
223     for (;it!=itend;){
224       --itend;
225       *(itend+1)=*itend;
226     }
227     *it=save;
228   }
229 
ROLLD(int i,GIAC_CONTEXT)230   void ROLLD(int i,GIAC_CONTEXT){
231     rolld(i,history_in(contextptr));
232     rolld(i,history_out(contextptr));
233   }
_ROLLD(const gen & args,GIAC_CONTEXT)234   gen _ROLLD(const gen & args,GIAC_CONTEXT){
235     if ( args.type==_STRNG && args.subtype==-1) return  args;
236     if (args._VECTptr->empty())
237       return args;
238     gen e=args._VECTptr->back();
239     args._VECTptr->pop_back();
240     if (e.type==_INT_)
241       rolld(e.val,*args._VECTptr);
242     if (e.type==_DOUBLE_)
243       rolld(int(e._DOUBLE_val),*args._VECTptr);
244     return args;
245   }
246   static const char _ROLLD_s []="ROLLD";
247   static define_unary_function_eval (__ROLLD,&_ROLLD,_ROLLD_s);
248   define_unary_function_ptr( at_ROLLD ,alias_at_ROLLD ,&__ROLLD);
249 
stack_swap(vecteur & v)250   void stack_swap(vecteur & v){
251     iterateur it=v.begin(),itend=v.end();
252     int s=int(itend-it);
253     if (s<2)
254       return;
255     --itend;
256     gen tmp=*itend;
257     *itend=*(itend-1);
258     *(itend-1)=tmp;
259   }
260 
SWAP(GIAC_CONTEXT)261   void SWAP(GIAC_CONTEXT){
262     stack_swap(history_in(contextptr));
263     stack_swap(history_out(contextptr));
264   }
265 
_SWAP(const gen & args,GIAC_CONTEXT)266   gen _SWAP(const gen & args,GIAC_CONTEXT){
267     if ( args.type==_STRNG && args.subtype==-1) return  args;
268     stack_swap(*args._VECTptr);
269     return args;
270   }
271   static const char _SWAP_s []="SWAP";
272   static define_unary_function_eval (__SWAP,&_SWAP,_SWAP_s);
273   define_unary_function_ptr5( at_SWAP ,alias_at_SWAP ,&__SWAP,0,T_RPN_OP);
274 
dup(vecteur & v)275   void dup(vecteur & v){
276     if (!v.empty())
277       v.push_back(v.back());
278   }
_DUP(const gen & args,GIAC_CONTEXT)279   gen _DUP(const gen & args,GIAC_CONTEXT){
280     if ( args.type==_STRNG && args.subtype==-1) return  args;
281     dup(*args._VECTptr);
282     return args;
283   }
284   static const char _DUP_s []="DUP";
285   static define_unary_function_eval (__DUP,&_DUP,_DUP_s);
286   define_unary_function_ptr5( at_DUP ,alias_at_DUP ,&__DUP,0,T_RPN_OP);
287 
over(vecteur & v)288   void over(vecteur & v){
289     int s=int(v.size());
290     if (s>=2)
291       v.push_back(v[s-2]);
292   }
_OVER(const gen & args,GIAC_CONTEXT)293   gen _OVER(const gen & args,GIAC_CONTEXT){
294     if ( args.type==_STRNG && args.subtype==-1) return  args;
295     over(*args._VECTptr);
296     return args;
297   }
298   static const char _OVER_s []="OVER";
299   static define_unary_function_eval (__OVER,&_OVER,_OVER_s);
300   define_unary_function_ptr5( at_OVER ,alias_at_OVER ,&__OVER,0,T_RPN_OP);
301 
pick(int i,vecteur & v)302   void pick(int i,vecteur & v){
303     int s=int(v.size());
304     if ((i>=1) && (s>=i))
305       v.push_back(v[s-i]);
306   }
_PICK(const gen & args,GIAC_CONTEXT)307   gen _PICK(const gen & args,GIAC_CONTEXT){
308     if ( args.type==_STRNG && args.subtype==-1) return  args;
309     if (args._VECTptr->empty())
310       return args;
311     gen e=args._VECTptr->back();
312     args._VECTptr->pop_back();
313     if (e.type==_INT_)
314       pick(e.val,*args._VECTptr);
315     if (e.type==_DOUBLE_)
316       pick(int(e._DOUBLE_val),*args._VECTptr);
317     return args;
318   }
319   static const char _PICK_s []="PICK";
320   static define_unary_function_eval (__PICK,&_PICK,_PICK_s);
321   define_unary_function_ptr5( at_PICK ,alias_at_PICK ,&__PICK,0,T_RPN_OP);
322 
drop(vecteur & v)323   void drop(vecteur & v){
324     if (v.empty())
325       return;
326     v.pop_back();
327   }
_DROP(const gen & args,GIAC_CONTEXT)328   gen _DROP(const gen & args,GIAC_CONTEXT){
329     if ( args.type==_STRNG && args.subtype==-1) return  args;
330     drop(*args._VECTptr);
331     return args;
332   }
333   static const char _DROP_s []="DROP";
334   static define_unary_function_eval (__DROP,&_DROP,_DROP_s);
335   define_unary_function_ptr5( at_DROP ,alias_at_DROP ,&__DROP,0,T_RPN_OP);
336 
printasNOP(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)337   static string printasNOP(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
338     return sommetstr;
339   }
symb_NOP(const gen & args)340   gen symb_NOP(const gen & args){
341     return vecteur(1,symbolic(at_NOP,args));
342   }
_NOP(const gen & args,GIAC_CONTEXT)343   gen _NOP(const gen & args,GIAC_CONTEXT){
344     if ( args.type==_STRNG && args.subtype==-1) return  args;
345     return args;
346   }
347   static const char _NOP_s []="NOP";
348   static define_unary_function_eval2_index (136,__NOP,&_NOP,_NOP_s,&printasNOP);
349   define_unary_function_ptr5( at_NOP ,alias_at_NOP ,&__NOP,0,T_RPN_OP);
350 
printasIFTE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)351   static string printasIFTE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
352     const_iterateur it=feuille._VECTptr->begin();
353     string res("IF " + printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr));
354     res += " THEN ";
355     ++it;
356     res += printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr) + " ELSE ";
357     ++it;
358     return res + printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr)+ " END";
359   }
symb_IFTE(const gen & args)360   gen symb_IFTE(const gen & args){
361     return symbolic(at_IFTE,args);
362   }
_IFTE(const gen & args,const context * contextptr)363   gen _IFTE(const gen & args,const context * contextptr){
364     if ( args.type==_STRNG && args.subtype==-1) return  args;
365     if (args.type!=_VECT || args._VECTptr->size()<3)
366       return gensizeerr(contextptr);
367     gen no=args._VECTptr->back();
368     args._VECTptr->pop_back();
369     gen yes=args._VECTptr->back();
370     args._VECTptr->pop_back();
371     gen e=args._VECTptr->back();
372     args._VECTptr->pop_back();
373     if (e.type==_VECT){
374       rpn_eval(e,*args._VECTptr,contextptr);
375       if (args._VECTptr->empty())
376 	return args;
377       e=args._VECTptr->back();
378       args._VECTptr->pop_back();
379     }
380     if (is_zero(e))
381       return rpn_eval(no,*args._VECTptr,contextptr);
382     else
383       return rpn_eval(yes,*args._VECTptr,contextptr);
384   }
385   static const char _IFTE_s []="IFTE";
386   static define_unary_function_eval2_index (126,__IFTE,&_IFTE,_IFTE_s,&printasIFTE);
387   define_unary_function_ptr5( at_IFTE ,alias_at_IFTE ,&__IFTE,0,T_RPN_OP);
388 
printasRPN_LOCAL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)389   static string printasRPN_LOCAL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
390     string s("-> ");
391     s += printinner_VECT(*feuille._VECTptr->front()._VECTptr,_RPN_FUNC__VECT,contextptr);
392     gen e= feuille._VECTptr->back();
393     if ( (e.type==_VECT) && (e.subtype==_RPN_FUNC__VECT))
394       return s + " " +e.print(contextptr);
395     else {
396       if ( (e.type==_SYMB) && (e._SYMBptr->sommet==at_quote))
397 	return s + " '"+e._SYMBptr->feuille.print(contextptr)+"'";
398       else
399 	return s + " '"+e.print(contextptr)+"'";
400     }
401   }
symb_RPN_LOCAL(const gen & a,const gen & b)402   gen symb_RPN_LOCAL(const gen & a,const gen & b){
403     return symbolic(at_RPN_LOCAL,makesequence(a,b));
404   }
_RPN_LOCAL(const gen & args,const context * contextptr)405   gen _RPN_LOCAL(const gen & args,const context * contextptr) {
406     if ( args.type==_STRNG && args.subtype==-1) return  args;
407     // stack level 2=symbolic names, level 1=program
408     if (args.type!=_VECT)
409       return symbolic(at_RPN_LOCAL,args);
410     int s=int(args._VECTptr->size());
411     if (s<3)
412       return gentoofewargs("RPN_LOCAL must have at least 3 args");
413     gen prog=args._VECTptr->back();
414     args._VECTptr->pop_back();
415     vecteur names=*(args._VECTptr->back()._VECTptr); // must be a vector
416     args._VECTptr->pop_back();
417     // get values from stack
418     int nvars=int(names.size());
419     if (s-2<nvars)
420       return gentoofewargs("RPN_LOCAL");
421     vecteur values(names);
422     for (int j=nvars-1;j>=0;--j){
423       values[j]=args._VECTptr->back();
424       args._VECTptr->pop_back();
425     }
426     // Initialization
427     context * newcontextptr = (context *) contextptr;
428     int protect=giac_bind(values,names,newcontextptr);
429     vecteur res;
430     if ((prog.type==_SYMB) && (prog._SYMBptr->sommet==at_quote)){
431       args._VECTptr->push_back(prog._SYMBptr->feuille.eval(eval_level(contextptr),newcontextptr));
432       res=*args._VECTptr;
433     }
434     else
435       res=rpn_eval(prog,*args._VECTptr,newcontextptr);
436     leave(protect,names,newcontextptr);
437     return gen(res,_RPN_STACK__VECT);
438   }
439   static const char _RPN_LOCAL_s []="RPN_LOCAL";
440   static define_unary_function_eval2_index (130,__RPN_LOCAL,&_RPN_LOCAL,_RPN_LOCAL_s,&printasRPN_LOCAL);
441   define_unary_function_ptr5( at_RPN_LOCAL ,alias_at_RPN_LOCAL ,&__RPN_LOCAL,0,T_RPN_OP);
442 
printasRPN_FOR(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)443   static string printasRPN_FOR(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
444     if ( (feuille.type!=_VECT) && (feuille._VECTptr->size()!=2))
445       return "Invalid_RPN_FOR";
446     string s;
447     gen controle=feuille._VECTptr->front();
448     gen prog=feuille._VECTptr->back();
449     bool is_start= (controle[0].print(contextptr)==" j");
450     if (is_start)
451       s="START ";
452     else
453       s="FOR "+controle[0].print(contextptr)+" ";
454     s += printinner_VECT(*prog._VECTptr,_RPN_FUNC__VECT,contextptr);
455     if (is_one(controle[1]))
456       s+=" NEXT";
457     else
458       s+= " "+controle[1].print(contextptr)+" STEP";
459     return s;
460   }
symb_RPN_FOR(const gen & a,const gen & b)461   gen symb_RPN_FOR(const gen & a,const gen & b){
462     return symbolic(at_RPN_FOR,makesequence(a,b));
463   }
_RPN_FOR(const gen & args,const context * contextptr)464   gen _RPN_FOR(const gen & args,const context * contextptr) {
465     if ( args.type==_STRNG && args.subtype==-1) return  args;
466     // stack level 4=init
467     // stack level 3=end
468     // stack level 2=[init_var,step]
469     // level 1=program to execute,
470     if (args.type!=_VECT)
471       return symbolic(at_RPN_FOR,args);
472     int s=int(args._VECTptr->size());
473     if (s<4)
474       return gentoofewargs("RPN_FOR must have at least 4 args");
475     gen prog=args._VECTptr->back();
476     args._VECTptr->pop_back();
477     vecteur controle=*(args._VECTptr->back()._VECTptr); // it must be a vector
478     args._VECTptr->pop_back();
479     gen fin=args._VECTptr->back();
480     args._VECTptr->pop_back();
481     gen debut=args._VECTptr->back();
482     args._VECTptr->pop_back();
483     // Initialization
484     vecteur names(1,controle[0]);
485     gen test=inferieur_egal(controle[0],fin,contextptr);
486     context * newcontextptr = (context *) contextptr;
487     int protect=giac_bind(vecteur(1,debut),names,newcontextptr);
488     vecteur res;
489     for (;!is_zero(test.eval(eval_level(newcontextptr),newcontextptr).evalf(eval_level(contextptr),newcontextptr));sto(eval(controle[0]+controle[1],eval_level(newcontextptr),newcontextptr),controle[0],newcontextptr)){
490       res=rpn_eval(prog,*args._VECTptr,newcontextptr);
491     }
492     leave(protect,names,newcontextptr);
493     return gen(res,_RPN_STACK__VECT);
494   }
495   static const char _RPN_FOR_s []="RPN_FOR";
496   static define_unary_function_eval2_index (132,__RPN_FOR,&_RPN_FOR,_RPN_FOR_s,&printasRPN_FOR);
497   define_unary_function_ptr5( at_RPN_FOR ,alias_at_RPN_FOR ,&__RPN_FOR,0,T_RPN_OP);
498 
printasRPN_WHILE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)499   static string printasRPN_WHILE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
500     if ( (feuille.type!=_VECT) && (feuille._VECTptr->size()!=2))
501       return "Invalid_RPN_WHILE";
502     return "WHILE "+ printinner_VECT(*feuille._VECTptr->front()._VECTptr,_RPN_FUNC__VECT,contextptr) + " REPEAT "+printinner_VECT(*feuille._VECTptr->back()._VECTptr,_RPN_FUNC__VECT,contextptr)+ " END ";
503   }
symb_RPN_WHILE(const gen & a,const gen & b)504   gen symb_RPN_WHILE(const gen & a,const gen & b){
505     return symbolic(at_RPN_WHILE,makesequence(a,b));
506   }
_RPN_WHILE(const gen & args,const context * contextptr)507   gen _RPN_WHILE(const gen & args,const context * contextptr) {
508     if ( args.type==_STRNG && args.subtype==-1) return  args;
509     // stack level 2=condition
510     // level 1=program to execute
511     if (args.type!=_VECT)
512       return symbolic(at_RPN_WHILE,args);
513     int s=int(args._VECTptr->size());
514     if (s<2)
515       return gentoofewargs("RPN_WHILE must have at least 2 args");
516     gen prog=args._VECTptr->back();
517     args._VECTptr->pop_back();
518     gen controle=args._VECTptr->back();
519     args._VECTptr->pop_back();
520     vecteur res;
521     for (;;){
522       res=rpn_eval(controle,*args._VECTptr,contextptr);
523       if (args._VECTptr->empty())
524 	return gentoofewargs("WHILE");
525       gen tmp=args._VECTptr->back();
526       args._VECTptr->pop_back();
527       if (is_zero(tmp.eval(1,contextptr).evalf(1,contextptr)))
528 	break;
529       res=rpn_eval(prog,*args._VECTptr,contextptr);
530     }
531     return gen(res,_RPN_STACK__VECT);
532   }
533   static const char _RPN_WHILE_s []="RPN_WHILE";
534   static define_unary_function_eval2_index (134,__RPN_WHILE,&_RPN_WHILE,_RPN_WHILE_s,&printasRPN_WHILE);
535   define_unary_function_ptr5( at_RPN_WHILE ,alias_at_RPN_WHILE ,&__RPN_WHILE,0,T_RPN_OP);
536 
printasRPN_CASE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)537   static string printasRPN_CASE(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
538     if (feuille.type!=_VECT)
539       return "Invalid_RPN_CASE";
540     vecteur v=*feuille._VECTptr;
541     if ((v.size()!=1) ||(v.front().type!=_VECT))
542       return "Invalid_RPN_CASE";
543     string res("CASE ");
544     const_iterateur it=v.front()._VECTptr->begin(),itend=v.front()._VECTptr->end();
545     for (;it!=itend;){
546       res += printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr);
547       ++it;
548       if (it==itend)
549 	break;
550       res += " THEN " + printinner_VECT(*it->_VECTptr,_RPN_FUNC__VECT,contextptr) + " END ";
551       ++it;
552     }
553     return res+" END ";
554   }
symb_RPN_CASE(const gen & a)555   gen symb_RPN_CASE(const gen & a){
556     return symbolic(at_RPN_CASE,vecteur(1,a));
557   }
_RPN_CASE(const gen & args,const context * contextptr)558   gen _RPN_CASE(const gen & args,const context * contextptr) {
559     if ( args.type==_STRNG && args.subtype==-1) return  args;
560     // level 1=[case1, prg1, case2,prg2,..., [default]]
561     if (args.type!=_VECT)
562       return symbolic(at_RPN_CASE,args);
563     int s=int(args._VECTptr->size());
564     if (s<1)
565       return gentoofewargs("RPN_CASE must have at least 1 arg");
566     vecteur controle=*args._VECTptr->back()._VECTptr;
567     args._VECTptr->pop_back();
568     const_iterateur it=controle.begin(),itend=controle.end();
569     vecteur res;
570     for (;it!=itend;){
571       res=rpn_eval(*it,*args._VECTptr,contextptr);
572       if (args._VECTptr->empty())
573 	return gentoofewargs("CASE");
574       ++it;
575       if (it==itend) // default of the case struct
576 	break;
577       gen test=args._VECTptr->back();
578       args._VECTptr->pop_back();
579       if (!(is_zero(test.eval(1,contextptr).evalf(1,contextptr)))){
580 	res=rpn_eval(*it,*args._VECTptr,contextptr);
581 	break;
582       }
583       ++it;
584     }
585     return gen(*args._VECTptr,_RPN_STACK__VECT);
586   }
587   static const char _RPN_CASE_s []="RPN_CASE";
588   static define_unary_function_eval2_index (128,__RPN_CASE,&_RPN_CASE,_RPN_CASE_s,&printasRPN_CASE);
589   define_unary_function_ptr5( at_RPN_CASE ,alias_at_RPN_CASE ,&__RPN_CASE,0,T_RPN_OP);
590 
printasRPN_UNTIL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)591   static string printasRPN_UNTIL(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
592     if ( (feuille.type!=_VECT) && (feuille._VECTptr->size()!=2))
593       return "Invalid_RPN_UNTIL";
594     return "DO "+ printinner_VECT(*feuille._VECTptr->front()._VECTptr,_RPN_FUNC__VECT,contextptr) + " UNTIL "+printinner_VECT(*feuille._VECTptr->back()._VECTptr,_RPN_FUNC__VECT,contextptr)+ " END ";
595   }
symb_RPN_UNTIL(const gen & a,const gen & b)596   gen symb_RPN_UNTIL(const gen & a,const gen & b){
597     return symbolic(at_RPN_UNTIL,makesequence(a,b));
598   }
_RPN_UNTIL(const gen & args,const context * contextptr)599   gen _RPN_UNTIL(const gen & args,const context * contextptr) {
600     if ( args.type==_STRNG && args.subtype==-1) return  args;
601     // stack level 2=program
602     // level 1=condition
603     if (args.type!=_VECT)
604       return symbolic(at_RPN_UNTIL,args);
605     int s=int(args._VECTptr->size());
606     if (s<2)
607       return gentoofewargs("RPN_UNTIL must have at least 2 args");
608     gen controle=args._VECTptr->back();
609     args._VECTptr->pop_back();
610     gen prog=args._VECTptr->back();
611     args._VECTptr->pop_back();
612     vecteur res;
613     for (;;){
614       res=rpn_eval(prog,*args._VECTptr,contextptr);
615       res=rpn_eval(controle,*args._VECTptr,contextptr);
616       if (args._VECTptr->empty())
617 	return gentoofewargs("UNTIL");
618       gen tmp=args._VECTptr->back();
619       args._VECTptr->pop_back();
620       if (!is_zero(tmp.eval(eval_level(contextptr),contextptr).evalf(eval_level(contextptr),contextptr)))
621 	break;
622     }
623     return gen(res,_RPN_STACK__VECT);
624   }
625   static const char _RPN_UNTIL_s []="RPN_UNTIL";
626   static define_unary_function_eval2 (__RPN_UNTIL,&_RPN_UNTIL,_RPN_UNTIL_s,&printasRPN_UNTIL);
627   define_unary_function_ptr( at_RPN_UNTIL ,alias_at_RPN_UNTIL ,&__RPN_UNTIL);
628 
629   // RPN evaluation loop (_VECTEVAL), no return stack currently
rpn_eval(const vecteur & prog,vecteur & pile,const context * contextptr)630   vecteur rpn_eval(const vecteur & prog,vecteur & pile,const context * contextptr){
631     const_iterateur it=prog.begin(),itend=prog.end();
632     for (;it!=itend;++it){
633       if (it->type==_FUNC){
634 	// test nargs with subtype
635 	int nargs=it->subtype;
636 	if (nargs>signed(pile.size()))
637 	  return vecteur(1,gentoofewargs(it->print(contextptr)+": stack "+gen(pile).print(contextptr)));
638 	if (nargs==1){
639 	  pile.back()=(*it->_FUNCptr)(pile.back(),contextptr);
640 	}
641 	else {
642 	  if (nargs){
643 	    vecteur v(nargs);
644 	    for (int k=nargs-1;k>=0;--k){
645 	      v[k]=pile.back();
646 	      pile.pop_back();
647 	    }
648 	    pile.push_back((*it->_FUNCptr)(v,contextptr));
649 	  }
650 	  else {
651 	    gen res;
652 	    if (*it->_FUNCptr==at_eval){ // eval stack level 1
653 	      if (pile.empty())
654 		return vecteur(1,gentoofewargs("EVAL"));
655 	      res=pile.back();
656 	      pile.pop_back();
657 	      if ( (res.type==_SYMB) && (res._SYMBptr->sommet==at_rpn_prog))
658 		res=res._SYMBptr->feuille;
659 	      res=rpn_eval(res,pile,contextptr);
660 	    }
661 	    else
662 	      res=(*it->_FUNCptr)(pile,contextptr);
663 	    if ( (res.type==_VECT) && (res.subtype==_RPN_STACK__VECT) )
664 	      pile= *res._VECTptr;
665 	    else
666 	      pile= vecteur(1,res);
667 	  }
668 	}
669       }
670       else {
671 	// test for special symbolic (control struct)
672 	const unary_function_ptr control_op[]={*at_RPN_LOCAL,*at_RPN_FOR,*at_IFTE,*at_RPN_CASE,*at_RPN_WHILE,*at_RPN_UNTIL,0};
673 	if ( (it->type==_SYMB) && equalposcomp(control_op,it->_SYMBptr->sommet)){
674 	  // push args of it to the stack and call sommet on the stack
675 	  if (it->_SYMBptr->feuille.type!=_VECT) // should not happen!
676 	    pile.push_back(it->_SYMBptr->feuille);
677 	  else
678 	    pile=mergevecteur(pile,*it->_SYMBptr->feuille._VECTptr);
679 	  gen res=it->_SYMBptr->sommet(pile,contextptr);
680 	  if ( (res.type==_VECT) && (res.subtype==_RPN_STACK__VECT) )
681 	    pile= *res._VECTptr;
682 	  else
683 	    pile= vecteur(1,res);
684 	}
685 	else {
686 	  if ( (it->type!=_VECT)
687 	       // || (it->subtype==_RPN_FUNC__VECT)
688 	       ){
689 	    gen res=it->eval(1,contextptr);
690 	    if ( (res.type==_VECT) && (res.subtype==_RPN_STACK__VECT))
691 	      pile=*res._VECTptr;
692 	    else
693 	      pile.push_back(res);
694 	  }
695 	  else
696 	    pile.push_back(*it);
697 	}
698       }
699     }
700     return pile;
701   }
702 
rpn_eval(const gen & prog,vecteur & pile,const context * contextptr)703   vecteur rpn_eval(const gen & prog,vecteur & pile,const context * contextptr){
704     if (prog.type!=_VECT)
705       return rpn_eval(vecteur(1,prog),pile,contextptr);
706     else
707       return rpn_eval(*prog._VECTptr,pile,contextptr);
708   }
709 
printasrpn_prog(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)710   static string printasrpn_prog(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
711     if (feuille.type!=_VECT)
712       return "<< "+feuille.print(contextptr)+" >>";
713     return "<< "+printinner_VECT(*feuille._VECTptr,_RPN_FUNC__VECT,contextptr)+" >>";
714   }
symb_rpn_prog(const gen & args)715   gen symb_rpn_prog(const gen & args){
716     return symbolic(at_rpn_prog,args);
717   }
_rpn_prog(const gen & args,const context * contextptr)718   gen _rpn_prog(const gen & args,const context * contextptr){
719     if ( args.type==_STRNG && args.subtype==-1) return  args;
720     if (!rpn_mode(contextptr) || (args.type!=_VECT))
721       return symbolic(at_rpn_prog,args);
722     vecteur pile(history_out(contextptr));
723     *logptr(contextptr) << pile << " " << args << '\n';
724     return gen(rpn_eval(*args._VECTptr,pile,contextptr),_RPN_STACK__VECT);
725   }
726   static const char _rpn_prog_s []="rpn_prog";
727   static define_unary_function_eval2_index (83,__rpn_prog,&_rpn_prog,_rpn_prog_s,&printasrpn_prog);
728   define_unary_function_ptr5( at_rpn_prog ,alias_at_rpn_prog,&__rpn_prog,_QUOTE_ARGUMENTS,0);
729 
730 #endif // RTOS_THREADX
731 
_RCL(const gen & args,const context * contextptr)732   gen _RCL(const gen & args,const context * contextptr) {
733     if ( args.type==_STRNG && args.subtype==-1) return  args;
734     // stack level 2=condition
735     // level 1=program to execute
736     if (args.type!=_IDNT)
737       return symbolic(at_RCL,args);
738     return args._IDNTptr->eval(1,args,contextptr);
739   }
740   static const char _RCL_s []="RCL";
741   static define_unary_function_eval (__RCL,&_RCL,_RCL_s);
742   define_unary_function_ptr5( at_RCL ,alias_at_RCL ,&__RCL,0,T_RPN_OP);
743 
744 #if defined(__APPLE__) // || defined(__FreeBSD__)
int_one(struct dirent * unused)745   static int int_one (struct dirent *unused){
746     return 1;
747   }
748 #else
int_one(const struct dirent * unused)749   static int int_one (const struct dirent *unused){
750     return 1;
751   }
752 #endif
753 
_VARS(const gen & args,const context * contextptr)754   gen _VARS(const gen & args,const context * contextptr) {
755     if ( args.type==_STRNG && args.subtype==-1) return  args;
756     bool val=is_one(args);
757     bool valonly=args==-2;
758     bool valsto=is_minus_one(args);
759     bool strng=args==2;
760     bool strngeq=args==3;
761     vecteur res;
762     if (contextptr){
763       if (contextptr->globalcontextptr && contextptr->globalcontextptr->tabptr){
764 	sym_tab::const_iterator it=contextptr->globalcontextptr->tabptr->begin(),itend=contextptr->globalcontextptr->tabptr->end();
765 #if defined FXCG || defined GIAC_HAS_STO_38 || defined KHICAS
766 	vecteur * keywordsptr=0;
767 #else
768 	vecteur * keywordsptr=keywords_vecteur_ptr();
769 #endif
770 	for (;it!=itend;++it){
771 	  lastprog_name(it->first,contextptr);
772 	  gen g=identificateur(it->first);
773 	  if (keywordsptr==0 || !equalposcomp(*keywordsptr,g)){
774 	    if (strng)
775 	      g=string2gen(it->first,false);
776 	    if (strngeq){
777 	      res.push_back(string2gen(it->first,false));
778 	      int t=it->second.type;
779 #if !defined GIAC_HAS_STO_38 && !defined FXCG && !defined KHICAS
780 	      if ( (t==_SYMB && it->second._SYMBptr->sommet!=at_program) || t==_FRAC || t<=_REAL || t==_VECT)
781 		g=_mathml(makesequence(it->second,1),contextptr);
782 	      else
783 #endif
784 		g=string2gen(it->second.print(contextptr),false);
785 	    }
786 	    if (valonly)
787 	      res.push_back(it->second);
788 	    else {
789 	      if (val)
790 		g=symbolic(at_equal,makesequence(g,it->second));
791 	      if (valsto)
792 		g=symb_sto(it->second,g);
793 	      res.push_back(g);
794 	    }
795 	  }
796 	}
797       }
798       return res;
799     }
800     if (!variables_are_files(contextptr)){
801       lock_syms_mutex();
802       sym_string_tab::const_iterator it=syms().begin(),itend=syms().end();
803       for (;it!=itend;++it){
804 	gen id=it->second;
805 	if (id.type==_IDNT && id._IDNTptr->value){
806 	  res.push_back(id);
807 	}
808       }
809       unlock_syms_mutex();
810       if (is_one(args) && current_folder_name.type==_IDNT && current_folder_name._IDNTptr->value){ // add variables of the current folder
811 	gen & tmp=*current_folder_name._IDNTptr->value;
812 	if (tmp.type==_VECT){
813 	  vecteur v=*current_folder_name._IDNTptr->value->_VECTptr;
814 	  iterateur it=v.begin(),itend=v.end();
815 	  for (;it!=itend;++it){
816 	    if (it->type!=_VECT || it->_VECTptr->size()!=2)
817 	      continue;
818 	    vecteur & w=*it->_VECTptr;
819 	    res.push_back(w[0]);
820 	  }
821 	}
822       }
823       return res;
824     }
825 #ifndef VARIABLE_ARE_FILES
826     return undef;
827 #else
828     struct dirent **eps;
829     int n;
830     n = scandir ("./", &eps, int_one, alphasort);
831     if (n >= 0){
832       string s;
833       int cnt;
834       for (cnt = 0; cnt < n; ++cnt){
835 	s=string(eps[cnt]->d_name);
836 	unsigned k=0;
837 	for (;k<s.size();++k){
838 	  if (!isalphan(s[k]))
839 	    break;
840 	}
841 	if ( (k==s.size()-4) && (s[k]=='.') && (s.substr(k+1,3)=="cas") )
842 	  res.push_back(identificateur(s.substr(0,k)));
843       }
844       if ( rpn_mode(contextptr) && (args.type==_VECT) && (args.subtype==_RPN_STACK__VECT) ){
845 	args._VECTptr->push_back(res);
846 	return args;
847       }
848       return res;
849     }
850     else
851       settypeerr ("Couldn't open the directory");
852     return 0;
853 #endif
854   }
855 
856   static const char _VARS_s []="VARS";
857   static define_unary_function_eval (__VARS,&_VARS,_VARS_s);
858   define_unary_function_ptr( at_VARS ,alias_at_VARS ,&__VARS);
859 
purgenoassume(const gen & args,const context * contextptr)860   gen purgenoassume(const gen & args,const context * contextptr){
861     if (args.type==_VECT){
862       vecteur & v=*args._VECTptr;
863       vecteur res;
864       for (unsigned i=0;i<v.size();++i)
865 	res.push_back(purgenoassume(v[i],contextptr));
866       return res;
867     }
868     if (args.type!=_IDNT)
869       return gensizeerr("Invalid purgenoassume "+args.print(contextptr));
870     if (!contextptr)
871       return _purge(args,0);
872     const char * ch=args._IDNTptr->id_name;
873     if (strlen(ch)==1){
874       if (ch[0]=='O' && (series_flags(contextptr) & (1<<6)) )
875 	series_flags(contextptr) ^= (1<<6);
876       if (ch[0]==series_variable_name(contextptr)){
877 	if (series_flags(contextptr) & (1<<5))
878 	  series_flags(contextptr) ^= (1<<5);
879 	if (series_flags(contextptr) & (1<<6))
880 	  series_flags(contextptr) ^= (1<<6);
881       }
882     }
883     // purge a global variable
884     sym_tab::iterator it=contextptr->tabptr->find(ch),itend=contextptr->tabptr->end();
885     if (it==itend)
886       return string2gen("No such variable "+args.print(contextptr),false);
887     gen res=it->second;
888     if (it->second.type==_POINTER_ && it->second.subtype==_THREAD_POINTER)
889       return gentypeerr(args.print(contextptr)+" is locked by thread "+it->second.print(contextptr));
890     if (contextptr->previous)
891       it->second=identificateur(it->first);
892     else
893       contextptr->tabptr->erase(it);
894     if (res.is_symb_of_sommet(at_rootof))
895       _purge(res,contextptr);
896     return res;
897   }
898 
_purge(const gen & args,const context * contextptr)899   gen _purge(const gen & args,const context * contextptr) {
900     if ( args.type==_STRNG && args.subtype==-1) return  args;
901     if (rpn_mode(contextptr) && (args.type==_VECT)){
902       if (!args._VECTptr->size())
903 	return gentoofewargs("purge");
904       gen apurger=args._VECTptr->back();
905       _purge(apurger,contextptr);
906       args._VECTptr->pop_back();
907       return gen(*args._VECTptr,_RPN_STACK__VECT);
908     }
909     if (args.type==_VECT)
910       return apply(args,contextptr,_purge);
911     if (args.is_symb_of_sommet(at_at)){
912       gen & f = args._SYMBptr->feuille;
913       if (f.type==_VECT && f._VECTptr->size()==2){
914 	gen m = eval(f._VECTptr->front(),eval_level(contextptr),contextptr);
915 	gen indice=eval(f._VECTptr->back(),eval_level(contextptr),contextptr);
916 	if (m.type==_MAP){
917 	  gen_map::iterator it=m._MAPptr->find(indice),itend=m._MAPptr->end();
918 	  if (it==itend)
919 	    return gensizeerr(gettext("Bad index")+indice.print(contextptr));
920 	  m._MAPptr->erase(it);
921 	  return 1;
922 	}
923 	if (m.type==_VECT && indice.type==_INT_){
924 	  vecteur & v = *m._VECTptr;
925 	  int i=indice.val;
926 	  if (i>=0 && i<v.size()){
927 	    v.erase(v.begin()+i);
928 	    return 1;
929 	  }
930 	  return gendimerr(contextptr);
931 	}
932       }
933     }
934     if (contextptr && args.is_symb_of_sommet(at_rootof)){
935       gen a=eval(args,1,contextptr);
936       if (!a.is_symb_of_sommet(at_rootof))
937 	return gensizeerr(gettext("Bad rootof"));
938       if (!contextptr->globalcontextptr->rootofs)
939 	contextptr->globalcontextptr->rootofs=new vecteur;
940       gen Pmin=a._SYMBptr->feuille;
941       if (Pmin.type!=_VECT || Pmin._VECTptr->size()!=2 || Pmin._VECTptr->front()!=makevecteur(1,0))
942 	return gensizeerr(gettext("Bad rootof"));
943       Pmin=Pmin._VECTptr->back();
944       vecteur & r =*contextptr->globalcontextptr->rootofs;
945       for (unsigned i=0;i<r.size();++i){
946 	gen ri=r[i];
947 	if (ri.type==_VECT && ri._VECTptr->size()==2 && Pmin==ri._VECTptr->front()){
948 	  gen a=ri._VECTptr->back();
949 	  r.erase(r.begin()+i);
950 	  return _purge(a,contextptr);
951 	}
952       }
953       return 0;
954     }
955     if (args.type!=_IDNT)
956       return symbolic(at_purge,args);
957     // REMOVED! args.eval(eval_level(contextptr),contextptr);
958     if (contextptr){
959       if (contextptr->globalcontextptr!=contextptr){
960 	// purge a local variable = set it to assume(DOM_SYMBOLIC)
961 	gen a2(_SYMB);
962 	a2.subtype=1;
963 	return sto(gen(makevecteur(a2),_ASSUME__VECT),args,contextptr);
964       }
965       return purgenoassume(args,contextptr);
966     }
967     if (current_folder_name.type==_IDNT && current_folder_name._IDNTptr->value && current_folder_name._IDNTptr->value->type==_VECT){
968       vecteur v=*current_folder_name._IDNTptr->value->_VECTptr;
969       iterateur it=v.begin(),itend=v.end();
970       gen val;
971       for (;it!=itend;++it){
972 	if (it->type!=_VECT || it->_VECTptr->size()!=2)
973 	  continue;
974 	vecteur & w=*it->_VECTptr;
975 	if (w[0]==args){
976 	  val=w[1];
977 	  break;
978 	}
979       }
980       if (it!=itend){
981 	v.erase(it);
982 	gen res=gen(v,_FOLDER__VECT);
983 	*current_folder_name._IDNTptr->value=res;
984 #ifdef HAVE_SIGNAL_H_OLD
985 	if (!child_id && signal_store)
986 	  _signal(symb_quote(symbolic(at_sto,makesequence(res,current_folder_name))),contextptr);
987 #endif
988 	return val;
989       }
990     }
991     if (args._IDNTptr->value){
992 #if !defined RTOS_THREADX && !defined BESTA_OS && !defined FREERTOS && !defined FXCG
993       if (variables_are_files(contextptr))
994 	unlink((args._IDNTptr->name()+string(cas_suffixe)).c_str());
995 #endif
996       gen res=*args._IDNTptr->value;
997       if (res.type==_VECT && res.subtype==_FOLDER__VECT){
998 	if (res._VECTptr->size()!=1)
999 	  return gensizeerr(gettext("Non-empty folder"));
1000       }
1001       delete args._IDNTptr->value;
1002       args._IDNTptr->value=0;
1003 #ifdef HAVE_SIGNAL_H_OLD
1004       if (!child_id && signal_store)
1005 	_signal(symb_quote(symb_purge(args)),contextptr);
1006 #endif
1007       return res;
1008     }
1009     else
1010       return string2gen(args.print(contextptr)+" not assigned",false);
1011   }
1012   static const char _purge_s []="purge";
1013   static define_unary_function_eval_quoted (__purge,&_purge,_purge_s);
1014   define_unary_function_ptr5( at_purge ,alias_at_purge,&__purge,_QUOTE_ARGUMENTS,0);
1015 
printasdivision(const gen & feuille,const char * s,GIAC_CONTEXT)1016   static string printasdivision(const gen & feuille,const char * s,GIAC_CONTEXT){
1017     if (feuille.type!=_VECT || feuille._VECTptr->size()!=2)
1018       return printsommetasoperator(feuille,s,contextptr);
1019     gen n=feuille._VECTptr->front();
1020     bool need=need_parenthesis(n);
1021     string res;
1022     if (need) res+='(';
1023     res += n.print(contextptr);
1024     if (need) res += ')';
1025     res += '/';
1026     gen f=feuille._VECTptr->back();
1027     if ( (f.type==_SYMB && ( f._SYMBptr->sommet==at_plus || f._SYMBptr->sommet==at_prod || f._SYMBptr->sommet==at_division || f._SYMBptr->sommet==at_inv  || need_parenthesis(f._SYMBptr->sommet) )) || (f.type==_CPLX) || (f.type==_MOD)){
1028       res += '(';
1029       res += f.print(contextptr);
1030       res += ')';
1031     }
1032     else
1033       res += f.print(contextptr);
1034     return res;
1035   }
1036 
texprintasdivision(const gen & feuille,const char * s,GIAC_CONTEXT)1037   static string texprintasdivision(const gen & feuille,const char * s,GIAC_CONTEXT){
1038     if (feuille.type!=_VECT || feuille._VECTptr->size()!=2)
1039       return "invalid /";
1040     return "\\frac{"+gen2tex(feuille._VECTptr->front(),contextptr)+"}{"+gen2tex(feuille._VECTptr->back(),contextptr)+"}";
1041   }
symb_division(const gen & args)1042   static gen symb_division(const gen & args){
1043     return symbolic(at_division,args);
1044   }
_division(const gen & args,GIAC_CONTEXT)1045   gen _division(const gen & args,GIAC_CONTEXT){
1046     if ( args.type==_STRNG && args.subtype==-1) return  args;
1047     if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) )
1048       return symb_division(args);
1049     gen a=args._VECTptr->front(),b=args._VECTptr->back();
1050     if (a.is_approx()){
1051       gen b1;
1052       if (has_evalf(b,b1,1,contextptr) && b.type!=b1.type){
1053 #ifdef HAVE_LIBMPFR
1054 	if (a.type==_REAL){
1055 	  gen b2=accurate_evalf(b,mpfr_get_prec(a._REALptr->inf));
1056 	  if (b2.is_approx())
1057 	    return (*a._REALptr)/b2;
1058 	}
1059 #endif
1060 	return rdiv(a,b1,contextptr);
1061       }
1062     }
1063     if (b.is_approx()){
1064       gen a1;
1065       if (has_evalf(a,a1,1,contextptr) && a.type!=a1.type){
1066 #ifdef HAVE_LIBMPFR
1067 	if (b.type==_REAL){
1068 	  gen a2=accurate_evalf(a,mpfr_get_prec(b._REALptr->inf));
1069 	  if (a2.is_approx())
1070 	    return a2/b;
1071 	}
1072 #endif
1073 	return rdiv(a1,b,contextptr);
1074       }
1075     }
1076     return rdiv(a,b,contextptr);
1077   }
1078   static const char _division_s []="/";
1079   static define_unary_function_eval4_index (10,__division,&_division,_division_s,&printasdivision,&texprintasdivision);
1080   define_unary_function_ptr( at_division ,alias_at_division ,&__division);
1081 
symb_binary_minus(const gen & args)1082   static gen symb_binary_minus(const gen & args){
1083     return symbolic(at_binary_minus,args);
1084   }
_binary_minus(const gen & args,GIAC_CONTEXT)1085   gen _binary_minus(const gen & args,GIAC_CONTEXT){
1086     if ( args.type==_STRNG && args.subtype==-1) return  args;
1087     if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) )
1088       return symb_binary_minus(args);
1089     return args._VECTptr->front()-args._VECTptr->back();
1090   }
1091   static const char _binary_minus_s[]="-";
1092   static define_unary_function_eval4_index (6,__binary_minus,&_binary_minus,_binary_minus_s,&printsommetasoperator,&texprintsommetasoperator);
1093   define_unary_function_ptr( at_binary_minus ,alias_at_binary_minus ,&__binary_minus);
1094 
tab2vecteur(gen tab[])1095   vecteur tab2vecteur(gen tab[]){
1096     vecteur res;
1097     for (;!is_zero(*tab);++tab)
1098       res.push_back(*tab);
1099     return res;
1100   }
1101 
1102   // hp38 compatibility
1103   // model
_hp38(const gen & args,GIAC_CONTEXT)1104   gen _hp38(const gen & args,GIAC_CONTEXT){
1105     if ( args.type==_STRNG && args.subtype==-1) return  args;
1106     if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) )
1107       return gensizeerr(contextptr);
1108     return undef;
1109   }
1110   static const char _hp38_s[]="hp38";
1111   static define_unary_function_eval (__hp38,&_hp38,_hp38_s);
1112   define_unary_function_ptr5( at_hp38 ,alias_at_hp38,&__hp38,0,true);
1113 
1114   // real/complex
_ABS(const gen & args,GIAC_CONTEXT)1115   gen _ABS(const gen & args,GIAC_CONTEXT){
1116     if ( args.type==_STRNG && args.subtype==-1) return  args;
1117     if (args.type!=_VECT)
1118       return abs(args,contextptr);
1119     if (args.subtype)
1120       return apply(args,_abs,contextptr);
1121     vecteur v;
1122     aplatir(*args._VECTptr,v);
1123     return _l2norm(v,contextptr);
1124   }
1125   static const char _ABS_s[]="ABS";
1126   static define_unary_function_eval (__ABS,&_ABS,_ABS_s);
1127   define_unary_function_ptr5( at_ABS ,alias_at_ABS,&__ABS,0,T_UNARY_OP_38);
1128 
_ARG38(const gen & g,GIAC_CONTEXT)1129   gen _ARG38(const gen & g,GIAC_CONTEXT){
1130     // if (angle_radian(contextptr)==0) return arg(evalf2bcd(g,1,contextptr),contextptr);
1131     return arg(g,contextptr);
1132   }
1133   static const char _ARG38_s[]="ARG";
1134   static define_unary_function_eval (__ARG38,&_ARG38,_ARG38_s);
1135   define_unary_function_ptr5( at_ARG38 ,alias_at_ARG38,&__ARG38,0,T_UNARY_OP_38);
1136 
1137   static const char _CONJ_s[]="CONJ";
1138   static define_unary_function_eval (__CONJ,(const gen_op_context)conj,_CONJ_s);
1139   define_unary_function_ptr5( at_CONJ ,alias_at_CONJ,&__CONJ,0,T_UNARY_OP_38);
1140 
1141   static const char _RE_s[]="RE";
1142   static define_unary_function_eval (__RE,(const gen_op_context)re,_RE_s);
1143   define_unary_function_ptr5( at_RE ,alias_at_RE,&__RE,0,T_UNARY_OP_38);
1144 
1145   static const char _IM_s[]="IM";
1146   static define_unary_function_eval (___IM,(const gen_op_context)im,_IM_s);
1147   define_unary_function_ptr5( at_IM ,alias_at_IM,&___IM,0,T_UNARY_OP_38);
1148 
1149   static const char _FLOOR_s[]="FLOOR";
1150   static define_unary_function_eval (__FLOOR,(const gen_op_context)_floor,_FLOOR_s);
1151   define_unary_function_ptr5( at_FLOOR ,alias_at_FLOOR,&__FLOOR,0,T_UNARY_OP_38);
1152 
1153   static const char _CEILING_s[]="CEILING";
1154   static define_unary_function_eval (__CEILING,(const gen_op_context)_ceil,_CEILING_s);
1155   define_unary_function_ptr5( at_CEILING ,alias_at_CEILING,&__CEILING,0,T_UNARY_OP_38);
1156 
FP(const gen & g,GIAC_CONTEXT)1157   gen FP(const gen & g,GIAC_CONTEXT){
1158     if (is_undef(g))
1159       return g;
1160     if (is_equal(g))
1161       return apply_to_equal(g,FP,contextptr);
1162     return g-_INT(g,contextptr);
1163   }
1164   static const char _FRAC_s[]="FP";
1165   static define_unary_function_eval (__FRAC,&FP,_FRAC_s);
1166   define_unary_function_ptr5( at_FRAC ,alias_at_FRAC,&__FRAC,0,T_UNARY_OP_38);
1167 
1168   static const char _MAX_s[]="MAX";
1169   static define_unary_function_eval (__MAX,&_max,_MAX_s);
1170   define_unary_function_ptr5( at_MAX ,alias_at_MAX,&__MAX,0,T_UNARY_OP_38);
1171 
1172   static const char _MIN_s[]="MIN";
1173   static define_unary_function_eval (__MIN,&_min,_MIN_s);
1174   define_unary_function_ptr5( at_MIN ,alias_at_MIN,&__MIN,0,T_UNARY_OP_38);
1175 
_MODULO(const gen & args,GIAC_CONTEXT)1176   gen _MODULO(const gen & args,GIAC_CONTEXT){
1177     if ( args.type==_STRNG && args.subtype==-1) return  args;
1178     if (args.type==_VECT && args._VECTptr->size()==2){
1179       gen a=args._VECTptr->front(),b=args._VECTptr->back();
1180       if (is_zero(b))
1181 	return a;
1182       if (is_integer(a)&&is_integer(b))
1183 	return _irem(args,contextptr);
1184       if (a.type==_FLOAT_){
1185 	if (b.type==_FLOAT_)
1186 	  return fmod(a._FLOAT_val,b._FLOAT_val);
1187 	if (b.type==_INT_)
1188 	  return fmod(a._FLOAT_val,giac_float(b.val));
1189       }
1190       return a-b*_floor(a/b,contextptr);
1191     }
1192     return gentypeerr(contextptr);
1193   }
1194   static const char _MOD_s[]="MOD";
1195   static define_unary_function_eval4 (__MOD,&_MODULO,_MOD_s,&printsommetasoperator,&texprintsommetasoperator);
1196   define_unary_function_ptr5( at_MOD ,alias_at_MOD,&__MOD,0,T_DIV);
1197 
1198   static const char _ROUND_s[]="ROUND";
1199   static define_unary_function_eval (__ROUND,&_round,_ROUND_s);
1200   define_unary_function_ptr5( at_ROUND ,alias_at_ROUND,&__ROUND,0,T_UNARY_OP_38);
1201 
_INTERSECT(const gen & g,GIAC_CONTEXT)1202   gen _INTERSECT(const gen & g,GIAC_CONTEXT){
1203     return _intersect(g,contextptr);
1204   }
1205   static const char _INTERSECT_s[]="INTERSECT";
1206   static define_unary_function_eval (__INTERSECT,&_INTERSECT,_INTERSECT_s);
1207   define_unary_function_ptr5( at_INTERSECT ,alias_at_INTERSECT,&__INTERSECT,0,T_UNARY_OP_38);
1208 
_UNION(const gen & g,GIAC_CONTEXT)1209   gen _UNION(const gen & g,GIAC_CONTEXT){
1210     return _union(g,contextptr);
1211   }
1212   static const char _UNION_s[]="UNION";
1213   static define_unary_function_eval (__UNION,&_UNION,_UNION_s);
1214   define_unary_function_ptr5( at_UNION ,alias_at_UNION,&__UNION,0,T_UNARY_OP_38);
1215 
_MINUS(const gen & g,GIAC_CONTEXT)1216   gen _MINUS(const gen & g,GIAC_CONTEXT){
1217     return _minus(g,contextptr);
1218   }
1219   static const char _MINUS_s[]="MINUS";
1220   static define_unary_function_eval (__MINUS,&_MINUS,_MINUS_s);
1221   define_unary_function_ptr5( at_MINUS ,alias_at_MINUS,&__MINUS,0,T_UNARY_OP_38);
1222 
1223   gen _trunc(const gen & args,GIAC_CONTEXT);
1224 
1225   static const char _TRUNCATE_s[]="TRUNCATE";
1226   static define_unary_function_eval (__TRUNCATE,&_trunc,_TRUNCATE_s);
1227   define_unary_function_ptr5( at_TRUNCATE ,alias_at_TRUNCATE,&__TRUNCATE,0,T_UNARY_OP_38);
1228 
1229   static const char _QUOTE_s[]="QUOTE";
1230   static define_unary_function_eval_quoted (__QUOTE,&quote,_QUOTE_s);
1231   define_unary_function_ptr5( at_QUOTE ,alias_at_QUOTE,&__QUOTE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1232 
1233   // Note that 0 is necessary otherwise conflict on freeBSD
1234   static const char _SIGN_s[]="SIGN";
1235   static define_unary_function_eval (__SIGN0,&sign,_SIGN_s);
1236   define_unary_function_ptr5( at_SIGN ,alias_at_SIGN,&__SIGN0,0,T_UNARY_OP_38);
1237 
1238   // proba
1239   static const char _COMB_s[]="COMB";
1240   static define_unary_function_eval (__COMB,&_comb,_COMB_s);
1241   define_unary_function_ptr5( at_COMB ,alias_at_COMB,&__COMB,0,T_UNARY_OP_38);
1242 
1243   static const char _PERM_s[]="PERM";
1244   static define_unary_function_eval (__PERM,&_perm,_PERM_s);
1245   define_unary_function_ptr5( at_PERM ,alias_at_PERM,&__PERM,0,T_UNARY_OP_38);
1246 
printasRANDOM(const gen & feuille,const char * s,GIAC_CONTEXT)1247   string printasRANDOM(const gen & feuille,const char * s,GIAC_CONTEXT){
1248     if (feuille.type==_VECT && feuille._VECTptr->empty())
1249       return s;
1250     return "("+(s+(" "+feuille.print())+")");
1251   }
_RANDOM(const gen & g0,GIAC_CONTEXT)1252   gen _RANDOM(const gen & g0,GIAC_CONTEXT){
1253     gen g(g0);
1254     if ( g.type==_STRNG && g.subtype==-1) return  g;
1255     is_integral(g);
1256     if (g.type==_CPLX)
1257       return _rand(gen(makevecteur(*g._CPLXptr,*(g._CPLXptr+1)),_SEQ__VECT),contextptr);
1258     if (g.type!=_VECT || g.subtype!=_SEQ__VECT || !g._VECTptr->empty())
1259       return _rand(g,contextptr);
1260     return double(giac_rand(contextptr))/rand_max2;
1261   }
1262   static const char _RANDOM_s[]="RANDOM";
1263   static define_unary_function_eval2 (__RANDOM,&_RANDOM,_RANDOM_s,&printasRANDOM);
1264   define_unary_function_ptr5( at_RANDOM ,alias_at_RANDOM,&__RANDOM,0,T_RETURN);
1265 
1266   static const char _RANDSEED_s[]="RANDSEED";
1267   static define_unary_function_eval (__RANDSEED,&_srand,_RANDSEED_s);
1268   define_unary_function_ptr5( at_RANDSEED ,alias_at_RANDSEED,&__RANDSEED,0,T_RETURN);
1269 
_MAXREAL(const gen & g,GIAC_CONTEXT)1270   gen _MAXREAL(const gen & g,GIAC_CONTEXT){
1271     if ( g.type==_STRNG && g.subtype==-1) return  g;
1272 #if 0 // def BCD
1273     return_bcd_maxreal;
1274 #else
1275     return 1.79769313486e+308;
1276 #endif
1277   }
1278   static const char _MAXREAL_s[]="MAXREAL";
1279   static define_unary_function_eval (__MAXREAL,&_MAXREAL,_MAXREAL_s);
1280   define_unary_function_ptr5( at_MAXREAL ,alias_at_MAXREAL,&__MAXREAL,0,T_NUMBER);
1281 
_MINREAL(const gen & g,GIAC_CONTEXT)1282   gen _MINREAL(const gen & g,GIAC_CONTEXT){
1283     if ( g.type==_STRNG && g.subtype==-1) return  g;
1284 #if 0 // def BCD
1285     return_bcd_minreal;
1286     // return_bcd_minreal;
1287 #else
1288     return 2.22507385851e-308; // smallest non-denormalized double
1289     // return 1.26480805335e-321;
1290 #endif
1291   }
1292   static const char _MINREAL_s[]="MINREAL";
1293   static define_unary_function_eval (__MINREAL,&_MINREAL,_MINREAL_s);
1294   define_unary_function_ptr5( at_MINREAL ,alias_at_MINREAL,&__MINREAL,0,T_NUMBER);
1295 
1296   // transcendent
1297   static const char _EXP_s[]="EXP";
1298   static define_unary_function_eval (__EXP,&exp,_EXP_s);
1299   define_unary_function_ptr5( at_EXP ,alias_at_EXP,&__EXP,0,T_UNARY_OP_38);
1300 
1301 #if 0
1302   define_partial_derivative_onearg_genop( D_at_expm1,"D_at_expm1",&exp);
1303 #endif
_EXPM1(const gen & g,GIAC_CONTEXT)1304   gen _EXPM1(const gen & g,GIAC_CONTEXT){
1305     if ( g.type==_STRNG && g.subtype==-1) return  g;
1306     if (g.type==_DOUBLE_)
1307       return expm1(g._DOUBLE_val);
1308     return exp(g,contextptr)-1;
1309   }
1310   static const char _EXPM1_s[]="EXPM1";
1311   static define_unary_function_eval (__EXPM1,&_EXPM1,_EXPM1_s);
1312   define_unary_function_ptr5( at_EXPM1 ,alias_at_EXPM1,&__EXPM1,0,T_UNARY_OP_38);
1313 
1314   static const char _expm1_s[]="expm1";
1315   static define_unary_function_eval (__expm1,&_EXPM1,_expm1_s);
1316   define_unary_function_ptr5( at_expm1 ,alias_at_expm1,&__expm1,0,T_UNARY_OP);
1317 
1318 #if 0
1319   static gen d_lnp1(const gen & args,GIAC_CONTEXT){
1320     return inv(args+1,contextptr);
1321   }
1322   define_partial_derivative_onearg_genop( D_at_lnp1,"D_at_lnp1",&d_lnp1);
1323 #endif
_LNP1(const gen & g,GIAC_CONTEXT)1324   gen _LNP1(const gen & g,GIAC_CONTEXT){
1325     if ( g.type==_STRNG && g.subtype==-1) return  g;
1326     if (g.type==_DOUBLE_)
1327       return log1p(g._DOUBLE_val);
1328     return ln(g+1,contextptr);
1329   }
1330   static const char _LNP1_s[]="LNP1";
1331   static define_unary_function_eval (__LNP1,&_LNP1,_LNP1_s);
1332   define_unary_function_ptr5( at_LNP1 ,alias_at_LNP1,&__LNP1,0,T_UNARY_OP_38);
1333 
1334   static const char _log1p_s[]="log1p";
1335   static define_unary_function_eval (__log1p,&_LNP1,_log1p_s);
1336   define_unary_function_ptr5( at_log1p ,alias_at_log1p,&__log1p,0,T_UNARY_OP);
1337 
1338   static const char _LN_s[]="LN";
1339   static define_unary_function_eval (__LN,&ln,_LN_s);
1340   define_unary_function_ptr5( at_LN ,alias_at_LN,&__LN,0,T_UNARY_OP_38);
1341 
_LOG(const gen & g,GIAC_CONTEXT)1342   gen _LOG(const gen & g,GIAC_CONTEXT){
1343     if (g.type==_VECT && g.subtype==_SEQ__VECT && g._VECTptr->size()==2)
1344       return _logb(g,contextptr);
1345     return log10(g,contextptr);
1346   }
1347   static const char _LOG_s[]="LOG";
1348   static define_unary_function_eval (__LOG,&_LOG,_LOG_s);
1349   define_unary_function_ptr5( at_LOG ,alias_at_LOG,&__LOG,0,T_UNARY_OP_38);
1350 
1351   static const char _ALOG_s[]="ALOG";
1352   static define_unary_function_eval (__ALOG,&alog10,_ALOG_s);
1353   define_unary_function_ptr5( at_ALOG ,alias_at_ALOG,&__ALOG,0,T_UNARY_OP_38);
1354 
1355   static const char _SIN_s[]="SIN";
1356   static define_unary_function_eval (__SIN,&sin,_SIN_s);
1357   define_unary_function_ptr5( at_SIN ,alias_at_SIN,&__SIN,0,T_UNARY_OP_38);
1358 
1359   static const char _COS_s[]="COS";
1360   static define_unary_function_eval (__COS,&cos,_COS_s);
1361   define_unary_function_ptr5( at_COS ,alias_at_COS,&__COS,0,T_UNARY_OP_38);
1362 
1363   static const char _TAN_s[]="TAN";
1364   static define_unary_function_eval (__TAN,&tan,_TAN_s);
1365   define_unary_function_ptr5( at_TAN ,alias_at_TAN,&__TAN,0,T_UNARY_OP_38);
1366 
1367   static const char _ASIN_s[]="ASIN";
1368   static define_unary_function_eval (__ASIN,&asin,_ASIN_s);
1369   define_unary_function_ptr5( at_ASIN ,alias_at_ASIN,&__ASIN,0,T_UNARY_OP_38);
1370 
1371   static const char _ACOS_s[]="ACOS";
1372   static define_unary_function_eval (__ACOS,&acos,_ACOS_s);
1373   define_unary_function_ptr5( at_ACOS ,alias_at_ACOS,&__ACOS,0,T_UNARY_OP_38);
1374 
1375   static const char _ATAN_s[]="ATAN";
1376   static define_unary_function_eval (__ATAN,&atan,_ATAN_s);
1377   define_unary_function_ptr5( at_ATAN ,alias_at_ATAN,&__ATAN,0,T_UNARY_OP_38);
1378 
1379   static const char _SINH_s[]="SINH";
1380   static define_unary_function_eval (__SINH,&sinh,_SINH_s);
1381   define_unary_function_ptr5( at_SINH ,alias_at_SINH,&__SINH,0,T_UNARY_OP_38);
1382 
1383   static const char _COSH_s[]="COSH";
1384   static define_unary_function_eval (__COSH,&cosh,_COSH_s);
1385   define_unary_function_ptr5( at_COSH ,alias_at_COSH,&__COSH,0,T_UNARY_OP_38);
1386 
1387   static const char _TANH_s[]="TANH";
1388   static define_unary_function_eval (__TANH,&tanh,_TANH_s);
1389   define_unary_function_ptr5( at_TANH ,alias_at_TANH,&__TANH,0,T_UNARY_OP_38);
1390 
1391   static const char _ASINH_s[]="ASINH";
1392   static define_unary_function_eval (__ASINH,&asinh,_ASINH_s);
1393   define_unary_function_ptr5( at_ASINH ,alias_at_ASINH,&__ASINH,0,T_UNARY_OP_38);
1394 
1395   static const char _ACOSH_s[]="ACOSH";
1396   static define_unary_function_eval (__ACOSH,&acosh,_ACOSH_s);
1397   define_unary_function_ptr5( at_ACOSH ,alias_at_ACOSH,&__ACOSH,0,T_UNARY_OP_38);
1398 
1399   static const char _ATANH_s[]="ATANH";
1400   static define_unary_function_eval (__ATANH,&atanh,_ATANH_s);
1401   define_unary_function_ptr5( at_ATANH ,alias_at_ATANH,&__ATANH,0,T_UNARY_OP_38);
1402 
is_Ans(const gen & g)1403   bool is_Ans(const gen & g){
1404     if (g.type==_FUNC && *g._FUNCptr==at_Ans)
1405       return true;
1406     if (g.type==_SYMB && g._SYMBptr->sommet==at_Ans)
1407       return true;
1408     return false;
1409   }
1410   /* matrices */
_ADDROW(const gen & args,GIAC_CONTEXT)1411   gen _ADDROW(const gen & args,GIAC_CONTEXT){
1412     if ( args.type==_STRNG && args.subtype==-1) return  args;
1413     vecteur v(gen2vecteur(args));
1414     if (!v.empty() && is_Ans(v[0]))
1415       v[0]=eval(v[0],1,contextptr);
1416     if (!v.empty() && v[0].type==_IDNT){
1417       gen v0=v[0];
1418       gen g=eval(args,eval_level(contextptr),contextptr);
1419       if (ckmatrix(g[0])){
1420 	gen tmp=_ADDROW(g,contextptr);
1421 	return is_undef(tmp)?tmp:sto(tmp,v0,contextptr);
1422       }
1423     }
1424     if (v.size()!=3)
1425       return gentypeerr(contextptr);
1426     v[1]=eval(v[1],1,contextptr);
1427     v[2]=eval(v[2],1,contextptr);
1428     v[2]=_floor(v[2],contextptr);
1429     if (!ckmatrix(v[0]) || v[1].type!=_VECT || v[2].type!=_INT_)
1430       return gentypeerr(contextptr);
1431     vecteur & w = *v[0]._VECTptr;
1432     if (w.front()._VECTptr->size()!=v[1]._VECTptr->size())
1433       return gendimerr(contextptr);
1434     int s=int(w.size());
1435     int shift = array_start(contextptr); //xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38;
1436     int l2=v[2].val-shift;
1437     if (l2<0 || l2>s)
1438       return gendimerr(contextptr);
1439     matrice res(w.begin(),w.begin()+l2);
1440     res.push_back(v[1]);
1441     for (int i=l2;i<s;++i)
1442       res.push_back(w[i]);
1443     return res;
1444   }
1445   static const char _ADDROW_s[]="ADDROW";
1446   static define_unary_function_eval_quoted (__ADDROW,&_ADDROW,_ADDROW_s);
1447   define_unary_function_ptr5( at_ADDROW ,alias_at_ADDROW,&__ADDROW,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1448 
_ADDCOL(const gen & args,GIAC_CONTEXT)1449   gen _ADDCOL(const gen & args,GIAC_CONTEXT){
1450     if ( args.type==_STRNG && args.subtype==-1) return  args;
1451     vecteur v(gen2vecteur(args));
1452     if (!v.empty() && is_Ans(v[0]))
1453       v[0]=eval(v[0],1,contextptr);
1454     if (!v.empty() && v[0].type==_IDNT){
1455       gen v0=v[0];
1456       gen g=eval(args,eval_level(contextptr),contextptr);
1457       if (ckmatrix(g[0])){
1458 	gen tmp=_ADDCOL(g,contextptr);
1459 	return is_undef(tmp)?tmp:sto(tmp,v0,contextptr);
1460       }
1461     }
1462     if (v.size()!=3 || !ckmatrix(v[0]))
1463       return gensizeerr(contextptr);
1464     matrice m;
1465     mtran(*v[0]._VECTptr,m);
1466     gen res=_ADDROW(makesequence(m,v[1],v[2]),contextptr);
1467     if (res.type==_VECT){
1468       mtran(*res._VECTptr,m);
1469       res=m;
1470     }
1471     return res;
1472   }
1473   static const char _ADDCOL_s[]="ADDCOL";
1474   static define_unary_function_eval_quoted (__ADDCOL,&_ADDCOL,_ADDCOL_s);
1475   define_unary_function_ptr5( at_ADDCOL ,alias_at_ADDCOL,&__ADDCOL,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1476 
_SCALE(const gen & g,GIAC_CONTEXT)1477   gen _SCALE(const gen & g,GIAC_CONTEXT){
1478     if ( g.type==_STRNG && g.subtype==-1) return  g;
1479     if (g.type!=_VECT || g._VECTptr->size()!=3)
1480       return gensizeerr(contextptr);
1481     vecteur v =*g._VECTptr;
1482     v[1]=eval(v[1],1,contextptr);
1483     v[2]=eval(v[2],1,contextptr);
1484     swapgen(v[0],v[1]);
1485     return _mRow(gen(v,_SEQ__VECT),contextptr);
1486   }
1487   static const char _SCALE_s[]="SCALE";
1488   static define_unary_function_eval_quoted (__SCALE,&_SCALE,_SCALE_s);
1489   define_unary_function_ptr5( at_SCALE ,alias_at_SCALE,&__SCALE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1490 
1491   static const char _scale_s[]="scale";
1492   static define_unary_function_eval_quoted (__scale,&_SCALE,_scale_s);
1493   define_unary_function_ptr5( at_scale ,alias_at_scale,&__scale,_QUOTE_ARGUMENTS,T_UNARY_OP);
1494 
_SCALEADD(const gen & g,GIAC_CONTEXT)1495   gen _SCALEADD(const gen & g,GIAC_CONTEXT){
1496     if ( g.type==_STRNG && g.subtype==-1) return  g;
1497     if (g.type!=_VECT || g._VECTptr->size()!=4)
1498       return gensizeerr(contextptr);
1499     vecteur v =*g._VECTptr;
1500     v[1]=eval(v[1],1,contextptr);
1501     v[2]=eval(v[2],1,contextptr);
1502     v[3]=eval(v[3],1,contextptr);
1503     swapgen(v[0],v[1]);
1504     return _mRowAdd(gen(v,_SEQ__VECT),contextptr);
1505   }
1506   static const char _SCALEADD_s[]="SCALEADD";
1507   static define_unary_function_eval_quoted (__SCALEADD,&_SCALEADD,_SCALEADD_s);
1508   define_unary_function_ptr5( at_SCALEADD ,alias_at_SCALEADD,&__SCALEADD,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1509 
1510   static const char _scaleadd_s[]="scaleadd";
1511   static define_unary_function_eval_quoted (__scaleadd,&_SCALEADD,_scaleadd_s);
1512   define_unary_function_ptr5( at_scaleadd ,alias_at_scaleadd,&__scaleadd,_QUOTE_ARGUMENTS,T_UNARY_OP);
1513 
_SWAPCOL(const gen & args,GIAC_CONTEXT)1514   gen _SWAPCOL(const gen & args,GIAC_CONTEXT){
1515     if ( args.type==_STRNG && args.subtype==-1) return  args;
1516     vecteur v(gen2vecteur(args));
1517     if (!v.empty() && is_Ans(v[0]))
1518       v[0]=eval(v[0],1,contextptr);
1519     if (!v.empty() && v[0].type==_IDNT){
1520       gen v0=v[0];
1521       gen g=eval(args,eval_level(contextptr),contextptr);
1522       if (ckmatrix(g[0]))
1523 	return sto(_SWAPCOL(g,contextptr),v0,contextptr);
1524     }
1525     if (v.size()!=3 || !ckmatrix(v[0]))
1526       return gensizeerr(contextptr);
1527     v[1]=eval(v[1],1,contextptr);
1528     v[2]=eval(v[2],1,contextptr);
1529     matrice m;
1530     mtran(*v[0]._VECTptr,m);
1531     gen res=_rowSwap(makesequence(m,v[1],v[2]),contextptr);
1532     if (res.type==_VECT){
1533       mtran(*res._VECTptr,m);
1534       res=m;
1535     }
1536     return res;
1537   }
1538   static const char _SWAPCOL_s[]="SWAPCOL";
1539   static define_unary_function_eval_quoted (__SWAPCOL,&_SWAPCOL,_SWAPCOL_s);
1540   define_unary_function_ptr5( at_SWAPCOL ,alias_at_SWAPCOL,&__SWAPCOL,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1541 
1542   static const char _colswap_s[]="colswap";
1543   static define_unary_function_eval (__colswap,&_SWAPCOL,_colswap_s);
1544   define_unary_function_ptr5( at_colswap ,alias_at_colswap,&__colswap,0,true);
1545 
1546   static const char _swapcol_s[]="swapcol";
1547   static define_unary_function_eval (__swapcol,&_SWAPCOL,_swapcol_s);
1548   define_unary_function_ptr5( at_swapcol ,alias_at_swapcol,&__swapcol,0,true);
1549 
1550   static const char _colSwap_s[]="colSwap";
1551   static define_unary_function_eval (__colSwap,&_SWAPCOL,_colSwap_s);
1552   define_unary_function_ptr5( at_colSwap ,alias_at_colSwap,&__colSwap,0,true);
1553 
1554   static const char _DELCOL_s[]="DELCOL";
1555   static define_unary_function_eval_quoted (__DELCOL,&_delcols,_DELCOL_s);
1556   define_unary_function_ptr5( at_DELCOL ,alias_at_DELCOL,&__DELCOL,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1557 
1558   static const char _DELROW_s[]="DELROW";
1559   static define_unary_function_eval_quoted (__DELROW,&_delrows,_DELROW_s);
1560   define_unary_function_ptr5( at_DELROW ,alias_at_DELROW,&__DELROW,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1561 
1562   static const char _SWAPROW_s[]="SWAPROW";
1563   static define_unary_function_eval_quoted (__SWAPROW,&_rowSwap,_SWAPROW_s);
1564   define_unary_function_ptr5( at_SWAPROW ,alias_at_SWAPROW,&__SWAPROW,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1565 
_SUB(const gen & args,GIAC_CONTEXT)1566   gen _SUB(const gen & args,GIAC_CONTEXT){
1567     if ( args.type==_STRNG && args.subtype==-1) return  args;
1568     vecteur v(gen2vecteur(args));
1569     gen v0=v[0];
1570     v=*eval(v,eval_level(contextptr),contextptr)._VECTptr;
1571     if (v0.type!=_IDNT){
1572       if (v.size()<3)
1573 	return gendimerr(contextptr);
1574       if (ckmatrix(v[0]))
1575 	return _subMat(gen(makevecteur(v[0],v[1],v[2]),_SEQ__VECT),contextptr);
1576       int shift = array_start(contextptr); //xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38;
1577       if (v[0].type==_VECT && v[1].type==_INT_ && v[2].type==_INT_){
1578 	vecteur & w =*v[0]._VECTptr;
1579 	int v2=v[1].val-shift, v3=v[2].val-shift;
1580 	if (v2<=v3 && v2>=0 && v3<int(w.size()))
1581 	  return gen(vecteur(w.begin()+v2,w.begin()+v3+1),v[1].subtype);
1582       }
1583     }
1584     if (v.size()==3)
1585       v.insert(v.begin(),v0);
1586     if (v.size()<4)
1587       return gendimerr(contextptr);
1588     v[2]=_floor(v[2],contextptr);
1589     v[3]=_floor(v[3],contextptr);
1590     if (ckmatrix(v[1]))
1591       return sto(_subMat(gen(makevecteur(v[1],v[2],v[3]),_SEQ__VECT),contextptr),v0,contextptr);
1592     int shift = array_start(contextptr); //xcas_mode(contextptr)!=0 || abs_calc_mode(contextptr)==38;
1593     if (v[1].type==_VECT && v[2].type==_INT_ && v[3].type==_INT_){
1594       vecteur & w =*v[1]._VECTptr;
1595       int v2=v[2].val-shift, v3=v[3].val-shift;
1596       if (v2<=v3 && v2>=0 && v3<int(w.size()))
1597 	return sto(gen(vecteur(w.begin()+v2,w.begin()+v3+1),v[1].subtype),v0,contextptr);
1598     }
1599     return undef;
1600   }
1601   static const char _SUB_s[]="SUB";
1602   static define_unary_function_eval_quoted (__SUB,&_SUB,_SUB_s);
1603   define_unary_function_ptr5( at_SUB ,alias_at_SUB,&__SUB,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1604 
_RANDMAT(const gen & args,GIAC_CONTEXT)1605   gen _RANDMAT(const gen & args,GIAC_CONTEXT){
1606     if ( args.type==_STRNG && args.subtype==-1) return  args;
1607     vecteur v(gen2vecteur(args));
1608     int s=int(v.size());
1609     if (s==1){
1610       v[0]=_floor(v[0],contextptr);
1611       if (v[0].type!=_INT_)
1612 	return gentypeerr(contextptr);
1613       return vranm(v[0].val,0,contextptr);
1614     }
1615     if (s<2)
1616       return gensizeerr(contextptr);
1617     gen name=v[0];
1618     if (name.type!=_IDNT && !name.is_symb_of_sommet(at_double_deux_points))
1619       return _ranm(eval(args,eval_level(contextptr),contextptr),contextptr);
1620     v=*eval(v,eval_level(contextptr),contextptr)._VECTptr;
1621     v[1]=_floor(v[1],contextptr);
1622     if (v[1].type!=_INT_)
1623       return gentypeerr(contextptr);
1624     if (s==2)
1625       return sto(vranm(v[1].val,0,contextptr),name,contextptr);
1626     v[2]=_floor(v[2],contextptr);
1627     if (v[2].type!=_INT_)
1628       return gentypeerr(contextptr);
1629     return sto(mranm(v[1].val,v[2].val,0,contextptr),name,contextptr);
1630   }
1631   static const char _RANDMAT_s[]="RANDMAT";
1632   static define_unary_function_eval_quoted (__RANDMAT,&_RANDMAT,_RANDMAT_s);
1633   define_unary_function_ptr5( at_RANDMAT ,alias_at_RANDMAT,&__RANDMAT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1634 
_REDIM(const gen & args,GIAC_CONTEXT)1635   gen _REDIM(const gen & args,GIAC_CONTEXT){
1636     if ( args.type==_STRNG && args.subtype==-1) return  args;
1637     vecteur v(gen2vecteur(args));
1638     int s=int(v.size());
1639     if (s==3)
1640       return _REDIM(gen(makevecteur(v[0],makevecteur(v[1],v[2])),_SEQ__VECT),contextptr);
1641     gen name=v[0];
1642     if (s!=2)
1643       return gensizeerr(contextptr);
1644     bool unnamed= name.type!=_IDNT && !name.is_symb_of_sommet(at_double_deux_points);
1645     v=*eval(v,eval_level(contextptr),contextptr)._VECTptr;
1646     if (v[0].type!=_VECT)
1647       return gentypeerr(contextptr);
1648     vecteur w=*v[0]._VECTptr,argv;
1649     argv=gen2vecteur(v[1]);
1650     for (unsigned i=0;i<argv.size();++i){
1651       if (!is_integral(argv[i]))
1652 	return gentypeerr(contextptr);
1653     }
1654     if (ckmatrix(v[0])){
1655       if (argv.size()==2){
1656 	w.clear();
1657 	int newl=argv[0].val,newc=argv[1].val;
1658 	if (newl<=0 || newc<=0 || newl*newc>LIST_SIZE_LIMIT)
1659 	  return gendimerr(contextptr);
1660 	// create w
1661 	vecteur & v0=*v[0]._VECTptr;
1662 	newl=giacmin(newl,int(v0.size()));
1663 	int nc=giacmin(newc,int(v0.front()._VECTptr->size())),j;
1664 	for (int i=0;i<newl;++i){
1665 	  vecteur & cur = *v0[i]._VECTptr;
1666 	  for (j=0;j<nc;++j){
1667 	    w.push_back(cur[j]);
1668 	  }
1669 	  for (;j<newc;++j)
1670 	    w.push_back(0);
1671 	}
1672       }
1673       else
1674 	aplatir(*v[0]._VECTptr,w);
1675     }
1676     argv.push_back(w);
1677     if (unnamed)
1678       return _matrix(gen(argv,_SEQ__VECT),contextptr);
1679     return sto(_matrix(gen(argv,_SEQ__VECT),contextptr),name,contextptr);
1680   }
1681   static const char _REDIM_s[]="REDIM";
1682   static define_unary_function_eval_quoted (__REDIM,&_REDIM,_REDIM_s);
1683   define_unary_function_ptr5( at_REDIM ,alias_at_REDIM,&__REDIM,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1684 
1685   static const char _redim_s[]="redim";
1686   static define_unary_function_eval_quoted (__redim,&_REDIM,_redim_s);
1687   define_unary_function_ptr5( at_redim ,alias_at_redim,&__redim,_QUOTE_ARGUMENTS,T_UNARY_OP);
1688 
_REPLACE(const gen & args,GIAC_CONTEXT)1689   gen _REPLACE(const gen & args,GIAC_CONTEXT){
1690     if ( args.type==_STRNG && args.subtype==-1) return  args;
1691     vecteur v(gen2vecteur(args));
1692     int s=int(v.size());
1693     gen name=v[0];
1694     if (s!=3)
1695       return gensizeerr(contextptr);
1696     bool unnamed= name.type!=_IDNT && !name.is_symb_of_sommet(at_double_deux_points);
1697     v=*eval(v,eval_level(contextptr),contextptr)._VECTptr;
1698     int pos,l,c=0,shift=abs_calc_mode(contextptr)==38; //  && v[1].subtype==_LIST__VECT;
1699     if (v[0].type==_STRNG && v[1].type==_STRNG && v[2].type==_STRNG){
1700       string s(*v[0]._STRNGptr),f(*v[1]._STRNGptr),rep(*v[2]._STRNGptr),res;
1701       int fs=int(f.size());
1702       for (;;){
1703 	int pos=s.find(f);
1704 	if (pos<0 || pos>int(s.size())-fs)
1705 	  break;
1706 	res += s.substr(0,pos)+rep;
1707 	s=s.substr(pos+fs,int(s.size())-pos-fs);
1708       }
1709       res += s;
1710       if (unnamed)
1711 	return string2gen(res,false);
1712       return sto(string2gen(res,false),name,contextptr);
1713     }
1714     v[1]=_floor(v[1],contextptr);
1715     if (v[0].type!=_VECT || v[2].type!=_VECT)
1716       return gentypeerr(contextptr);
1717     vecteur w0=*v[0]._VECTptr,w2=*v[2]._VECTptr,argv;
1718     if (ckmatrix(v[0])){
1719       mdims(w0,l,c);
1720       if (ckmatrix(v[2]) && v[1].type==_VECT){
1721 	vecteur & v1=*v[1]._VECTptr;
1722 	if (v1.size()!=2 || v1.front().type!=_INT_ || v1.back().type!=_INT_)
1723 	  return gentypeerr(contextptr);
1724 	int ls,cs,pos1=v1.front().val-shift,pos2=v1.back().val-shift;
1725 	if (pos1<0 || pos1>=l || pos2<0 || pos2>=c)
1726 	  return gendimerr(contextptr);
1727 	mdims(w2,ls,cs);
1728 	std_matrix<gen> target,source;
1729 	matrice2std_matrix_gen(w2,source);
1730 	matrice2std_matrix_gen(w0,target);
1731 	for (int i=0;i<ls;++i){
1732 	  if (i+pos1>=l)
1733 	    break;
1734 	  vecteur & ws =source[i];
1735 	  vecteur & wt =target[i+pos1];
1736 	  for (int j=0;j<cs;++j){
1737 	    if (j+pos2>=c)
1738 	      break;
1739 	    wt[j+pos2]=ws[j];
1740 	  }
1741 	}
1742 	std_matrix_gen2matrice(target,w0);
1743 	if (unnamed)
1744 	  return gen(w0,_MATRIX__VECT);
1745 	return sto(gen(w0,_MATRIX__VECT),name,contextptr);
1746       }
1747       aplatir(*v[0]._VECTptr,w0);
1748     }
1749     else
1750       l=int(w0.size());
1751     if (v[1].type==_VECT){
1752       vecteur & v1=*v[1]._VECTptr;
1753       if (v1.size()!=2 || v1.front().type!=_INT_ || v1.back().type!=_INT_)
1754 	return gentypeerr(contextptr);
1755       pos=(v1.front().val-shift)*c+(v1.back().val-shift);
1756     }
1757     else {
1758       if (v[1].type!=_INT_)
1759 	return gentypeerr(contextptr);
1760       pos=v[1].val;
1761       if (abs_calc_mode(contextptr)==38)
1762 	--pos;
1763     }
1764     if (ckmatrix(v[2]))
1765       aplatir(*v[2]._VECTptr,w2);
1766     int w0s=int(w0.size()),w2s=int(w2.size()),i=giacmax(pos,0),j=0;
1767     for (;i<w0s && j<w2s;++j,++i){
1768       w0[i]=w2[j];
1769     }
1770     if (!c){
1771       if (unnamed)
1772 	return gen(w0,v[0].subtype);
1773       return sto(gen(w0,v[0].subtype),name,contextptr);
1774     }
1775     if (unnamed)
1776       return _matrix(gen(makevecteur(l,c,w0),_SEQ__VECT),contextptr);
1777     return sto(_matrix(gen(makevecteur(l,c,w0),_SEQ__VECT),contextptr),name,contextptr);
1778   }
1779   static const char _REPLACE_s[]="REPLACE";
1780   static define_unary_function_eval_quoted (__REPLACE,&_REPLACE,_REPLACE_s);
1781   define_unary_function_ptr5( at_REPLACE ,alias_at_REPLACE,&__REPLACE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1782 
1783   static const char _replace_s[]="replace";
1784   static define_unary_function_eval_quoted (__replace,&_REPLACE,_replace_s);
1785   define_unary_function_ptr5( at_replace ,alias_at_replace,&__replace,_QUOTE_ARGUMENTS,T_UNARY_OP);
1786 
1787   static const char _COLNORM_s[]="COLNORM";
1788   static define_unary_function_eval (__COLNORM,&_colNorm,_COLNORM_s);
1789   define_unary_function_ptr5( at_COLNORM ,alias_at_COLNORM,&__COLNORM,0,T_UNARY_OP_38);
1790 
1791   static const char _ROWNORM_s[]="ROWNORM";
1792   static define_unary_function_eval (__ROWNORM,&_rowNorm,_ROWNORM_s);
1793   define_unary_function_ptr5( at_ROWNORM ,alias_at_ROWNORM,&__ROWNORM,0,T_UNARY_OP_38);
1794 
1795   static const char _CROSS_s[]="CROSS";
1796   static define_unary_function_eval (__CROSS,&_cross,_CROSS_s);
1797   define_unary_function_ptr5( at_CROSS ,alias_at_CROSS,&__CROSS,0,T_UNARY_OP_38);
1798 
1799   static const char _DET_s[]="DET";
1800   static define_unary_function_eval (__DET,&_det,_DET_s);
1801   define_unary_function_ptr5( at_DET ,alias_at_DET,&__DET,0,T_UNARY_OP_38);
1802 
1803   static const char _DOT_s[]="DOT";
1804   static define_unary_function_eval (__DOT,&_dotprod,_DOT_s);
1805   define_unary_function_ptr5( at_DOT ,alias_at_DOT,&__DOT,0,T_UNARY_OP_38);
1806 
_EIGENVAL(const gen & args,GIAC_CONTEXT)1807   gen _EIGENVAL(const gen & args,GIAC_CONTEXT){
1808     if ( args.type==_STRNG && args.subtype==-1) return  args;
1809     if (!is_squarematrix(args))
1810       return gendimerr(contextptr);
1811     bool b=complex_mode(contextptr);
1812     complex_mode(true,contextptr);
1813     gen res=_egvl(evalf(args,1,contextptr),contextptr);
1814     res=_diag(res,contextptr);
1815     complex_mode(b,contextptr);
1816     return res;
1817   }
1818   static const char _EIGENVAL_s[]="EIGENVAL";
1819   static define_unary_function_eval (__EIGENVAL,&_EIGENVAL,_EIGENVAL_s);
1820   define_unary_function_ptr5( at_EIGENVAL ,alias_at_EIGENVAL,&__EIGENVAL,0,T_UNARY_OP_38);
1821 
_EIGENVV(const gen & args,GIAC_CONTEXT)1822   gen _EIGENVV(const gen & args,GIAC_CONTEXT){
1823     if ( args.type==_STRNG && args.subtype==-1) return  args;
1824     if (!is_squarematrix(args))
1825       return gendimerr(contextptr);
1826     bool b=complex_mode(contextptr);
1827     complex_mode(true,contextptr);
1828     gen res=_jordan(evalf(args,1,contextptr),contextptr);
1829     complex_mode(b,contextptr);
1830     if (res.type==_VECT)
1831       res.subtype=_LIST__VECT;
1832     return res;
1833   }
1834   static const char _EIGENVV_s[]="EIGENVV";
1835   static define_unary_function_eval (__EIGENVV,&_EIGENVV,_EIGENVV_s);
1836   define_unary_function_ptr5( at_EIGENVV ,alias_at_EIGENVV,&__EIGENVV,0,T_UNARY_OP_38);
1837 
1838   static const char _IDENMAT_s[]="IDENMAT";
1839   static define_unary_function_eval (__IDENMAT,&_idn,_IDENMAT_s);
1840   define_unary_function_ptr5( at_IDENMAT ,alias_at_IDENMAT,&__IDENMAT,0,T_UNARY_OP_38);
1841 
1842   static const char _INVERSE_s[]="INVERSE";
1843   static define_unary_function_eval (__INVERSE,&inv,_INVERSE_s);
1844   define_unary_function_ptr5( at_INVERSE ,alias_at_INVERSE,&__INVERSE,0,T_UNARY_OP_38);
1845 
_TRACE(const gen & g,GIAC_CONTEXT)1846   gen _TRACE(const gen & g,GIAC_CONTEXT){
1847     if (!is_squarematrix(g))
1848       return gensizeerr(contextptr);
1849     return mtrace(*g._VECTptr);
1850   }
1851   static const char _TRACE_s[]="TRACE";
1852   static define_unary_function_eval (__TRACE,&_TRACE,_TRACE_s);
1853   define_unary_function_ptr5( at_TRACE ,alias_at_TRACE,&__TRACE,0,T_UNARY_OP_38);
1854 
1855   static const char _TRN_s[]="TRN";
1856   static define_unary_function_eval (__TRN,&_trn,_TRN_s);
1857   define_unary_function_ptr5( at_TRN ,alias_at_TRN,&__TRN,0,T_UNARY_OP_38);
1858 
1859   static const char _RANK_s[]="RANK";
1860   static define_unary_function_eval (__RANK,&_rank,_RANK_s);
1861   define_unary_function_ptr5( at_RANK ,alias_at_RANK,&__RANK,0,T_UNARY_OP_38);
1862 
_SIZE(const gen & args,GIAC_CONTEXT)1863   gen _SIZE(const gen& args,GIAC_CONTEXT){
1864     if (ckmatrix(args))
1865       return _dim(args,contextptr);
1866     else
1867       return _size(args,contextptr);
1868   }
1869   static const char _SIZE_s[]="SIZE";
1870   static define_unary_function_eval (__SIZE,&_SIZE,_SIZE_s);
1871   define_unary_function_ptr5( at_SIZE ,alias_at_SIZE,&__SIZE,0,T_UNARY_OP_38);
1872 
1873   static const char _SORT_s[]="SORT";
1874   static define_unary_function_eval (__SORT,&_sort,_SORT_s);
1875   define_unary_function_ptr5( at_SORT ,alias_at_SORT,&__SORT,0,T_UNARY_OP_38);
1876 
1877   static const char _DELTALIST_s[]="ΔLIST";
1878   static define_unary_function_eval (__DELTALIST,&_deltalist,_DELTALIST_s);
1879   define_unary_function_ptr5( at_DELTALIST ,alias_at_DELTALIST,&__DELTALIST,0,T_UNARY_OP_38);
1880 
1881   static const char _CONCAT_s[]="CONCAT";
1882   static define_unary_function_eval (__CCONCAT,&_concat,_CONCAT_s);
1883   define_unary_function_ptr5( at_CONCAT ,alias_at_CONCAT,&__CCONCAT,0,T_UNARY_OP_38);
1884 
_PILIST(const gen & args,GIAC_CONTEXT)1885   gen _PILIST(const gen & args,GIAC_CONTEXT){
1886     if (args.type==_VECT)
1887       return _product(change_subtype(args,0),contextptr);
1888     return _product(args,contextptr);
1889   }
1890   static const char _PILIST_s[]="ΠLIST";
1891   static define_unary_function_eval (__PILIST,&_PILIST,_PILIST_s);
1892   define_unary_function_ptr5( at_PILIST ,alias_at_PILIST,&__PILIST,0,T_UNARY_OP_38);
1893 
_SIGMALIST(const gen & args,GIAC_CONTEXT)1894   gen _SIGMALIST(const gen & args,GIAC_CONTEXT){
1895     if (args.type==_VECT)
1896       return _sum(change_subtype(args,0),contextptr);
1897     return _sum(args,contextptr);
1898   }
1899   static const char _SIGMALIST_s[]="ΣLIST";
1900   static define_unary_function_eval (__SIGMALIST,&_SIGMALIST,_SIGMALIST_s);
1901   define_unary_function_ptr5( at_SIGMALIST ,alias_at_SIGMALIST,&__SIGMALIST,0,T_UNARY_OP_38);
1902 
1903   static const char _REVERSE_s[]="REVERSE";
1904   static define_unary_function_eval (__REVERSE,&_revlist,_REVERSE_s);
1905   define_unary_function_ptr5( at_REVERSE ,alias_at_REVERSE,&__REVERSE,0,T_UNARY_OP_38);
1906 
_POS(const gen & args,GIAC_CONTEXT)1907   gen _POS(const gen & args,GIAC_CONTEXT){
1908     if ( args.type==_STRNG &&  args.subtype==-1) return  args;
1909     if ( (args.type!=_VECT) || (args._VECTptr->size()!=2) || (args._VECTptr->front().type!=_VECT) )
1910       return gensizeerr(contextptr);
1911     return equalposcomp(*args._VECTptr->front()._VECTptr,evalf2bcd(args._VECTptr->back(),1,contextptr));
1912   }
1913   static const char _POS_s[]="POS";
1914   static define_unary_function_eval (__POS,&_POS,_POS_s);
1915   define_unary_function_ptr5( at_POS ,alias_at_POS,&__POS,0,T_UNARY_OP_38);
1916 
_MAKELIST(const gen & args,GIAC_CONTEXT)1917   gen _MAKELIST(const gen & args,GIAC_CONTEXT){
1918     if (args.type!=_VECT || (args._VECTptr->size()!=4 && args._VECTptr->size()!=5))
1919       return gensizeerr(contextptr);
1920     vecteur & v = *args._VECTptr;
1921     if (v.size()==5 && is_positive(-v[4]*(v[3]-v[2]),contextptr))
1922       return gensizeerr(gettext("Invalid step value"));
1923     gen res=_seq(args,contextptr);
1924     if (res.type==_VECT)
1925       res.subtype=_LIST__VECT;
1926     return res;
1927   }
1928   static const char _MAKELIST_s[]="MAKELIST";
1929   static define_unary_function_eval_quoted (__MAKELIST,&_MAKELIST,_MAKELIST_s);
1930   define_unary_function_ptr5( at_MAKELIST ,alias_at_MAKELIST,&__MAKELIST,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
1931 
_INT(const gen & g,GIAC_CONTEXT)1932   gen _INT(const gen & g,GIAC_CONTEXT){
1933     if ( g.type==_STRNG && g.subtype==-1) return  g;
1934     if (g.type==_VECT)
1935       return apply(g,_INT,contextptr);
1936     if (g.type==_CPLX)
1937       return _INT(*g._CPLXptr,contextptr)+cst_i*_INT(*(g._CPLXptr+1),contextptr);
1938     if (is_positive(g,contextptr))
1939       return _floor(g,contextptr);
1940     else {
1941       if (is_positive(-g,contextptr))
1942 	return _ceil(g,contextptr);
1943       gen sg=sign(g,contextptr);
1944       return sg*_floor(g*sg,contextptr);//symbolic(at_when,makesequence(symbolic(at_superieur_egal,makesequence(g,0)),symbolic(at_floor,g),symbolic(at_ceil,g)));
1945     }
1946   }
1947   static const char _INT_s[]="IP";
1948   static define_unary_function_eval (__INT,&_INT,_INT_s);
1949   define_unary_function_ptr5( at_INT ,alias_at_INT,&__INT,0,T_UNARY_OP_38);
1950 
1951   static int taylorxn=0;
hp38_eval(vecteur & v,gen & x,gen & newx,GIAC_CONTEXT)1952   static void hp38_eval(vecteur & v,gen & x,gen& newx,GIAC_CONTEXT){
1953     x=v[1];
1954     if (is_equal(x))
1955       x=x._SYMBptr->feuille[0];
1956     identificateur idx("taylorx"+print_INT_(taylorxn));
1957     ++taylorxn;
1958     newx=idx;
1959     gen tmp=subst(v[0],x,newx,false,contextptr);
1960     gen tmp1=eval(tmp,eval_level(contextptr),contextptr);
1961     if (!is_undef(tmp1))
1962       tmp=tmp1;
1963     tmp1=subst(tmp,x,newx,false,contextptr);
1964     if (!is_undef(tmp1))
1965       tmp=tmp1;
1966     v[0]=tmp;
1967     v[1]=newx;
1968     int s=int(v.size());
1969     for (int i=2;i<s;++i)
1970       v[i]=eval(v[i],eval_level(contextptr),contextptr);
1971   }
1972 
_HPDIFF(const gen & args,GIAC_CONTEXT)1973   gen _HPDIFF(const gen & args,GIAC_CONTEXT){
1974     if ( args.type==_STRNG && args.subtype==-1) return  args;
1975     gen tmp;
1976     if (args.type==_VECT && args.subtype==_SEQ__VECT && args._VECTptr->size()>=2){
1977       gen value=(*args._VECTptr)[1],var=value;
1978       if (is_equal(value)){
1979 	var=value._SYMBptr->feuille[0];
1980 	value=value._SYMBptr->feuille[1];
1981       }
1982       if (var.type!=_IDNT && abs_calc_mode(contextptr)==38)
1983 	return gensizeerr(gettext("∂(expression,variable=value)"));
1984       int ndiff=1;
1985       if (args._VECTptr->size()>=3 && (*args._VECTptr)[2].type==_INT_ ){
1986 	ndiff=(*args._VECTptr)[2].val;
1987 	if (ndiff<0)
1988 	  return gensizeerr(gettext("Order of derivation must be positive"));
1989       }
1990       if (args._VECTptr->size()>=4 && abs_calc_mode(contextptr)!=38)
1991 	value=(*args._VECTptr)[3];
1992       static int count=0;
1993       gen newx("hpdiffx"+print_INT_(count),contextptr);
1994       ++count;
1995       gen arg0=eval(subst(args._VECTptr->front(),var,newx,false,contextptr),eval_level(contextptr),contextptr);
1996       arg0=subst(arg0,var,newx,false,contextptr);
1997       if (ndiff==0){
1998 	value=eval(value,1,contextptr);
1999 	tmp=gen(makevecteur(arg0,newx,value),_SEQ__VECT);
2000 	return _limit(tmp,contextptr);
2001       }
2002       else {
2003 	if (ndiff==1)
2004 	  tmp=gen(makesequence(arg0,newx));
2005 	else
2006 	  tmp=gen(makevecteur(arg0,newx,ndiff),_SEQ__VECT);
2007 	tmp=_derive(tmp,contextptr);
2008 	// return _limit(makesequence(tmp,newx,value),contextptr);
2009 	tmp=subst(tmp,newx,value,false,contextptr);
2010 	tmp=eval(tmp,1,contextptr);
2011 	return tmp;
2012       }
2013     }
2014     else {
2015       gen a(args);
2016       if (guess_program(a,contextptr))
2017 	return _derive(a,contextptr);
2018       return _HPDIFF(gen(makevecteur(args,vx_var),_SEQ__VECT),contextptr);
2019     }
2020   }
2021   static const char _HPDIFF_s[]="∂";
2022   static define_unary_function_eval_quoted (__HPDIFF,&_HPDIFF,_HPDIFF_s);
2023   define_unary_function_ptr5( at_HPDIFF ,alias_at_HPDIFF,&__HPDIFF,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2024 
_HPINT(const gen & args,GIAC_CONTEXT)2025   gen _HPINT(const gen & args,GIAC_CONTEXT){
2026     if ( args.type==_STRNG && args.subtype==-1) return  args;
2027     if (args.type==_VECT && args.subtype==_SEQ__VECT){
2028       vecteur v = *args._VECTptr;
2029       if (v.size()==3){
2030 	if (is_equal(v.front())){
2031 	  gen var=v.front()._SYMBptr->feuille[0];
2032 	  gen lower=v.front()._SYMBptr->feuille[1];
2033 	  v=makevecteur(v[2],var,lower,v[1]);
2034 	}
2035 	if (is_equal(v[1])){
2036 	  gen var=v[1]._SYMBptr->feuille[0];
2037 	  gen lower=v[1]._SYMBptr->feuille[1];
2038 	  v=makevecteur(v.front(),var,lower,v[2]);
2039 	}
2040 	if (v.size()==3)
2041 	  return _integrate(args,contextptr);
2042       }
2043       if (v.size()>=4){
2044 	if (v[1].type!=_IDNT){
2045 	  return gensizeerr(gettext("∫(expression,var,lower,upper)"));
2046 	  // swapgen(v[0],v[2]);
2047 	  // swapgen(v[1],v[3]);
2048 	}
2049 	gen x,newx;
2050 	hp38_eval(v,x,newx,contextptr);
2051 	gen tmp=_integrate(gen(v,_SEQ__VECT),contextptr);
2052 	if (eval(x,1,contextptr)!=x)
2053 	  return tmp;
2054 	else
2055 	  return subst(tmp,newx,x,false,contextptr);
2056 	// if we subst then the value of x may alter tmp even with subst
2057       }
2058     }
2059 #ifndef CAS38_DISABLED
2060     return _integrate(args,contextptr);
2061 #else
2062     return gensizeerr(contextptr);
2063 #endif
2064   }
2065   static const char _HPINT_s[]="∫";
2066   static define_unary_function_eval_quoted (__HPINT,&_HPINT,_HPINT_s);
2067   define_unary_function_ptr5( at_HPINT ,alias_at_HPINT,&__HPINT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2068 
_HPSUM(const gen & args,GIAC_CONTEXT)2069   gen _HPSUM(const gen & args,GIAC_CONTEXT){
2070     if ( args.type==_STRNG && args.subtype==-1) return  args;
2071     if (args.type==_VECT && args.subtype==_SEQ__VECT){
2072       int s=args._VECTptr->size();
2073       if (s==4){
2074 	gen var=(*args._VECTptr)[1];
2075 	if (var.type==_IDNT && eval(var,1,contextptr)!=var){
2076 	  gen newvar(var);
2077 	  while (eval(newvar,1,contextptr)!=newvar){
2078 	    newvar=identificateur(newvar.print(contextptr)+"_");
2079 	  }
2080 	  gen args_=subst(args,var,newvar,true,contextptr);
2081 	  return _HPSUM(args_,contextptr);
2082 	}
2083       }
2084       if (s<=3){
2085 	if (s!=3)
2086 	  return gensizeerr(contextptr);
2087 	const vecteur & v = *args._VECTptr;
2088 	if (is_equal(v[0])){
2089 	  gen var=v[0]._SYMBptr->feuille[0];
2090 	  if (var.type!=_IDNT)
2091 	    return gensizeerr(contextptr);
2092 	  gen inf=v[0]._SYMBptr->feuille[1];
2093 	  gen sup=v[1];
2094 	  gen expr=v[2];
2095 	  return _sum(gen(makevecteur(expr,var,inf,sup),_SEQ__VECT),contextptr);
2096 	}
2097 	if (is_equal(v[1])){
2098 	  gen var=v[1]._SYMBptr->feuille[0];
2099 	  if (var.type!=_IDNT)
2100 	    return gensizeerr(contextptr);
2101 	  gen inf=v[1]._SYMBptr->feuille[1];
2102 	  gen sup=v[2];
2103 	  gen expr=v[0];
2104 	  return _sum(gen(makevecteur(expr,var,inf,sup),_SEQ__VECT),contextptr);
2105 	}
2106       }
2107     }
2108     return _sum(args,contextptr);
2109   }
2110   static const char _HPSUM_s[]="Σ"; // "∑";
2111   // static const char _HPSUM_s[]="∑"; // "Σ";
2112   static define_unary_function_eval_quoted (__HPSUM,&_HPSUM,_HPSUM_s);
2113   define_unary_function_ptr5( at_HPSUM ,alias_at_HPSUM,&__HPSUM,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2114 
_TAYLOR(const gen & args,GIAC_CONTEXT)2115   gen _TAYLOR(const gen & args,GIAC_CONTEXT){
2116 #ifdef CAS38_DISABLED
2117     return gensizeerr(contextptr);
2118 #endif
2119     if ( args.type==_STRNG && args.subtype==-1) return  args;
2120     if (args.type!=_VECT)
2121       return gentypeerr(contextptr);
2122     vecteur v = *args._VECTptr;
2123     if (v.size()<2)
2124       v.push_back(x__IDNT_e);
2125     gen x,newx;
2126     hp38_eval(v,x,newx,contextptr);
2127     gen res=subst(_taylor(gen(v,_SEQ__VECT),contextptr),newx,x,false,contextptr);
2128     v=lop(res,at_order_size);
2129     res=subst(res,v,vecteur(v.size()),false,contextptr);
2130     return res;
2131   }
2132   static const char _TAYLOR_s[]="TAYLOR";
2133   static define_unary_function_eval_quoted (__TAYLOR,&_TAYLOR,_TAYLOR_s);
2134   define_unary_function_ptr5( at_TAYLOR ,alias_at_TAYLOR,&__TAYLOR,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2135 
_POLYCOEFF(const gen & args0,GIAC_CONTEXT)2136   gen _POLYCOEFF(const gen &args0,GIAC_CONTEXT){
2137     gen args=eval(args0,1,contextptr);
2138     if (args.type==_VECT && args.subtype!=_SEQ__VECT)
2139       return _pcoeff(args,contextptr);
2140     return _symb2poly(args0,contextptr);
2141   }
2142   static const char _POLYCOEF_s[]="POLYCOEF";
2143   static define_unary_function_eval_quoted (__POLYCOEF,&_POLYCOEFF,_POLYCOEF_s);
2144   define_unary_function_ptr5( at_POLYCOEF ,alias_at_POLYCOEF,&__POLYCOEF,_QUOTE_ARGUMENTS,T_UNARY_OP);
2145 
2146   gen _horner(const gen & args,GIAC_CONTEXT);
_POLYEVAL(const gen & args,GIAC_CONTEXT)2147   gen _POLYEVAL(const gen & args,GIAC_CONTEXT){
2148     if (args.type!=_VECT)
2149       return gentypeerr(contextptr);
2150     if (args.subtype!=_SEQ__VECT)
2151       return _POLYFORM(_horner(gen(makevecteur(args,vx_var),_SEQ__VECT),contextptr),contextptr);
2152     return _horner(args,contextptr);
2153   }
2154   static const char _POLYEVAL_s[]="POLYEVAL";
2155   static define_unary_function_eval (__POLYEVAL,&_POLYEVAL,_POLYEVAL_s);
2156   define_unary_function_ptr5( at_POLYEVAL ,alias_at_POLYEVAL,&__POLYEVAL,0,T_UNARY_OP_38);
2157 
evalfunc(const gen & args,GIAC_CONTEXT)2158   gen evalfunc(const gen & args,GIAC_CONTEXT){
2159 #ifdef GIAC_HAS_STO_38
2160     vecteur v(lidnt(args));
2161     vecteur lf,lfval;
2162     for (unsigned i=0;i<v.size();++i){
2163       if (v[i].type!=_IDNT)
2164 	continue;
2165       const char * ch=v[i]._IDNTptr->id_name;
2166       if (strlen(ch)==2 && (ch[0]=='F' || ch[0]=='X' || ch[0]=='Y' || ch[0]=='R')){
2167 	lf.push_back(v[i]);
2168 	lfval.push_back(eval(v[i],1,contextptr));
2169       }
2170     }
2171     if (lf.empty())
2172       return args;
2173     return subst(args,lf,lfval,false,contextptr);
2174 #else
2175     return args;
2176 #endif
2177   }
printasPOLYFORM(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)2178   static string printasPOLYFORM(const gen &feuille,const char * sommetstr,GIAC_CONTEXT){
2179     if (feuille.type==_VECT && feuille._VECTptr->size()==2 && feuille._VECTptr->back().type==_FUNC){
2180       const char * s=feuille._VECTptr->back()._FUNCptr->ptr()->s;
2181       return feuille._VECTptr->front().print(contextptr)+"\xe2\x96\xba"+((strcmp(s,"eval")==0)?"\xe2\x96\xba":s);
2182     }
2183     return string(sommetstr)+('('+feuille.print(contextptr)+')');
2184   }
_POLYFORM(const gen & args,GIAC_CONTEXT)2185   gen _POLYFORM(const gen & args,GIAC_CONTEXT){
2186     if ( args.type==_STRNG && args.subtype==-1) return args;
2187     gen tmp;
2188     if (args.type==_VECT && !args._VECTptr->empty()){
2189       const vecteur & v = *args._VECTptr;
2190       tmp=v[0];
2191       tmp=eval(tmp,1,context0);
2192       tmp=evalfunc(tmp,contextptr);
2193       int vs=int(v.size());
2194 #ifdef CAS38_DISABLED
2195       if (vs==2 && v.back()==at_prod && is_integral(tmp))
2196 	return _ifactor(tmp,context0);
2197 #else
2198       if (vs==2){
2199 	if (v.back()==at_eval) return tmp;
2200 	if (v.back()==at_prod){
2201 	  if (is_integral(tmp))
2202 	    return _ifactor(tmp,context0);
2203 	  return _factor(tmp,context0);
2204 	}
2205 	if (v.back()==at_plus)
2206 	  return _partfrac(tmp,context0);
2207 	if (v.back().type==_FUNC)
2208 	  return _convert(gen(makevecteur(tmp,v.back()),_SEQ__VECT),context0);
2209       }
2210 #endif
2211       if (v.back().type==_FUNC) // additional check for STO> +/-/etc. if CAS38_DISABLED is set
2212 	return gensizeerr(contextptr);
2213       if (vs>1)
2214 	return _reorder(makesequence(tmp,vecteur(v.begin()+1,v.end())),context0);
2215     }
2216     tmp=eval(args,1,context0);
2217     tmp=evalfunc(tmp,contextptr);
2218     return _recursive_normal(tmp,context0); // return symb_quote(_partfrac(args,contextptr)); // return symb_quote(recursive_normal(args,1,contextptr)); // symb_quote(simplify(eval(args,1,context0),context0));
2219   }
2220   static const char _POLYFORM_s[]="POLYFORM";
2221   static define_unary_function_eval2_quoted (__POLYFORM,&_POLYFORM,_POLYFORM_s,&printasPOLYFORM);
2222   define_unary_function_ptr5( at_POLYFORM ,alias_at_POLYFORM,&__POLYFORM,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2223 
_POLYROOT(const gen & args0,GIAC_CONTEXT)2224   gen _POLYROOT(const gen & args0,GIAC_CONTEXT){
2225     gen args=eval(args0,1,contextptr);
2226     if (args.type==_VECT && args.subtype!=_SEQ__VECT)
2227       ;
2228     else
2229       args=args0;
2230     gen res;
2231     if (complex_mode(contextptr))
2232       res=_proot(args,contextptr);
2233     else {
2234 #if 0 // set to 1 : POLYROOT returns only real roots without multiplicities, SLOW on aspen
2235       vecteur vas_res;
2236       if (vas(symb2poly_num(args,contextptr),0,0,1e-14,vas_res,false,contextptr))
2237 	res=vas_res;
2238       else
2239 	res=_proot(args,contextptr);
2240 #else
2241       res=_proot(args,contextptr);
2242 #endif
2243     }
2244 #ifdef GIAC_HAS_STO_38
2245     if (res.type==_VECT)
2246       res.subtype=_LIST__VECT;
2247 #endif
2248     return res;
2249   }
2250   static const char _POLYROOT_s[]="POLYROOT";
2251   static define_unary_function_eval_quoted (__POLYROOT,&_POLYROOT,_POLYROOT_s);
2252   define_unary_function_ptr5( at_POLYROOT ,alias_at_POLYROOT,&__POLYROOT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2253 
_ISOLATE(const gen & args0,GIAC_CONTEXT)2254   gen _ISOLATE(const gen & args0,GIAC_CONTEXT){
2255 #ifdef CAS38_DISABLED
2256     return gensizeerr(contextptr);
2257 #endif
2258     return symb_quote(_solve(args0,contextptr));
2259   }
2260   static const char _ISOLATE_s[]="ISOLATE";
2261   static define_unary_function_eval_quoted (__ISOLATE,&_ISOLATE,_ISOLATE_s);
2262   define_unary_function_ptr5( at_ISOLATE ,alias_at_ISOLATE,&__ISOLATE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2263 
2264   static const char _QUAD_s[]="QUAD";
2265   static define_unary_function_eval_quoted (__QUAD,&_ISOLATE,_QUAD_s);
2266   define_unary_function_ptr5( at_QUAD ,alias_at_QUAD,&__QUAD,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2267 
_IS_LINEAR(const gen & args,GIAC_CONTEXT)2268   gen _IS_LINEAR(const gen & args,GIAC_CONTEXT){
2269     if ( args.type==_STRNG && args.subtype==-1) return  args;
2270     if (args.type==_VECT && args._VECTptr->size()==2){
2271       vecteur & v = *args._VECTptr;
2272       gen a,b;
2273       if (v[1].type==_IDNT && is_linear_wrt(v[0],v[1],a,b,contextptr))
2274 	return makevecteur(eval(a,eval_level(contextptr),contextptr),eval(b, eval_level(contextptr),contextptr));
2275       else
2276 	return 0;
2277     }
2278     return gentypeerr(contextptr);
2279     // return 0;
2280   }
2281   static const char _IS_LINEAR_s[]="LINEAR?";
2282   static define_unary_function_eval_quoted (__IS_LINEAR,&_IS_LINEAR,_IS_LINEAR_s);
2283   define_unary_function_ptr5( at_IS_LINEAR ,alias_at_IS_LINEAR,&__IS_LINEAR,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2284 
2285   static const char _FNROOT_s[]="FNROOT";
2286   static define_unary_function_eval_quoted (__FNROOT,&_fsolve,_FNROOT_s);
2287   define_unary_function_ptr5( at_FNROOT ,alias_at_FNROOT,&__FNROOT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2288 
_SVD(const gen & args0,GIAC_CONTEXT)2289   gen _SVD(const gen & args0,GIAC_CONTEXT){
2290     if ( args0.type==_STRNG && args0.subtype==-1) return  args0;
2291     if (!ckmatrix(args0))
2292       return gentypeerr(contextptr);
2293     if (!has_num_coeff(args0))
2294       *logptr(contextptr) << gettext("SVD is implemented for numeric matrices, running evalf first") << '\n';
2295     gen args=evalf(args0,1,contextptr);
2296     gen res= _svd(gen(makevecteur(args,-1),_SEQ__VECT),contextptr);
2297     if (res.type==_VECT) res.subtype=_LIST__VECT;
2298     return res;
2299   }
2300   static const char _SVD_s[]="SVD";
2301   static define_unary_function_eval (__SVD,&_SVD,_SVD_s); // FIXME
2302   define_unary_function_ptr5( at_SVD ,alias_at_SVD,&__SVD,0,T_UNARY_OP_38);
2303 
_SVL(const gen & args0,GIAC_CONTEXT)2304   gen _SVL(const gen & args0,GIAC_CONTEXT){
2305     if ( args0.type==_STRNG && args0.subtype==-1) return  args0;
2306     if (!ckmatrix(args0))
2307       return gentypeerr(contextptr);
2308     gen args=evalf(args0,1,contextptr);
2309     return _svd(gen(makevecteur(args,-2),_SEQ__VECT),contextptr);
2310   }
2311   static const char _SVL_s[]="SVL";
2312   static define_unary_function_eval (__SVL,&_SVL,_SVL_s);
2313   define_unary_function_ptr5( at_SVL ,alias_at_SVL,&__SVL,0,T_UNARY_OP_38);
2314 
2315   static const char _svl_s[]="svl";
2316   static define_unary_function_eval (__svl,&_SVL,_svl_s);
2317   define_unary_function_ptr5( at_svl ,alias_at_svl,&__svl,0,T_UNARY_OP);
2318 
_SPECRAD(const gen & args0,GIAC_CONTEXT)2319   gen _SPECRAD(const gen & args0,GIAC_CONTEXT){
2320     if ( args0.type==_STRNG && args0.subtype==-1) return  args0;
2321     gen args=evalf(args0,1,contextptr);
2322     if (!is_squarematrix(args))
2323       return gentypeerr(contextptr);
2324     vecteur v=megvl(*args._VECTptr,contextptr);
2325     if (is_undef(v)) return v;
2326     gen res,tmp;
2327     int s=int(v.size());
2328     for (int i=0;i<s;++i){
2329       tmp=abs(v[i],contextptr);
2330       if (ck_is_strictly_greater(tmp,res,contextptr))
2331 	res=tmp;
2332     }
2333     return res;
2334   }
2335   static const char _SPECRAD_s[]="SPECRAD";
2336   static define_unary_function_eval (__SPECRAD,&_SPECRAD,_SPECRAD_s); // FIXME
2337   define_unary_function_ptr5( at_SPECRAD ,alias_at_SPECRAD,&__SPECRAD,0,T_UNARY_OP_38);
2338 
_SPECNORM(const gen & args0,GIAC_CONTEXT)2339   gen _SPECNORM(const gen & args0,GIAC_CONTEXT){
2340     if ( args0.type==_STRNG && args0.subtype==-1) return  args0;
2341     gen args=evalf(args0,1,contextptr);
2342     if (!ckmatrix(args)){
2343       if (args.type==_VECT)
2344 	return _l2norm(args,contextptr);
2345       return gentypeerr(contextptr);
2346     }
2347     return _max(_SVL(*args._VECTptr,contextptr),contextptr);
2348   }
2349   static const char _SPECNORM_s[]="SPECNORM";
2350   static define_unary_function_eval (__SPECNORM,&_SPECNORM,_SPECNORM_s); // FIXME
2351   define_unary_function_ptr5( at_SPECNORM ,alias_at_SPECNORM,&__SPECNORM,0,T_UNARY_OP_38);
2352 
_COND(const gen & args0,GIAC_CONTEXT)2353   gen _COND(const gen & args0,GIAC_CONTEXT){
2354     if ( args0.type==_STRNG && args0.subtype==-1) return  args0;
2355     // COND(matrix,2) L2norm condition number
2356     // otherwise COLNORM(args0)*COLNORM(inv(args0))
2357     if (args0.type==_VECT && args0._VECTptr->size()==2){
2358       if (args0._VECTptr->back()==1)
2359 	return _COND(args0._VECTptr->front(),contextptr);
2360       if (args0._VECTptr->back()==2){
2361 	gen args=args0._VECTptr->front();
2362 	if (!ckmatrix(args))
2363 	  return gentypeerr(contextptr);
2364 	double save_eps=epsilon(contextptr);
2365 	epsilon(0.0,contextptr); // otherwise small singular values are cancelled and condition is infinity
2366 	gen g=_SVL(args,contextptr);
2367 	epsilon(save_eps,contextptr);
2368 	if (is_undef(g)) return g;
2369 	if (g.type!=_VECT)
2370 	  return undef;
2371 	vecteur & v =*g._VECTptr;
2372 	int s=int(v.size());
2373 	gen mina(plus_inf),maxa(0);
2374 	for (int i=0;i<s;++i){
2375 	  gen tmp=abs(v[i],contextptr);
2376 	  if (ck_is_strictly_greater(mina,tmp,contextptr))
2377 	    mina=tmp;
2378 	  if (ck_is_strictly_greater(tmp,maxa,contextptr))
2379 	    maxa=tmp;
2380 	}
2381 	return maxa/mina;
2382       }
2383       if (is_inf(args0._VECTptr->back())){
2384 	gen args=evalf(args0._VECTptr->front(),1,contextptr);
2385 	if (!is_squarematrix(args))
2386 	  return gensizeerr(contextptr);
2387 	gen invargs=inv(args,contextptr);
2388 	if (is_undef(invargs))
2389 	  return undef;
2390 	return _rowNorm(args,contextptr)*_rowNorm(invargs,contextptr);
2391       }
2392     }
2393     gen args=evalf(args0,1,contextptr);
2394     if (!is_squarematrix(args))
2395       return gensizeerr(contextptr);
2396     gen invargs=inv(args,contextptr);
2397     if (is_undef(invargs))
2398       return undef;
2399     return _colNorm(args,contextptr)*_colNorm(invargs,contextptr);
2400     // return _colNorm(args,contextptr)*_rowNorm(args,contextptr)/abs(_det(args,contextptr),contextptr);
2401   }
2402   static const char _COND_s[]="COND";
2403   static define_unary_function_eval (__COND,&_COND,_COND_s); // FIXME
2404   define_unary_function_ptr5( at_COND ,alias_at_COND,&__COND,0,T_UNARY_OP_38);
2405 
2406   static const char _cond_s[]="cond";
2407   static define_unary_function_eval (__cond,&_COND,_cond_s); // FIXME
2408   define_unary_function_ptr5( at_cond ,alias_at_cond,&__cond,0,T_UNARY_OP);
2409 
_SCHUR(const gen & args,GIAC_CONTEXT)2410   gen _SCHUR(const gen & args,GIAC_CONTEXT){
2411     if ( args.type==_STRNG && args.subtype==-1) return  args;
2412     gen res;
2413     if (ckmatrix(args)){
2414       if (!is_squarematrix(args))
2415 	return gendimerr(contextptr);
2416 #ifdef HAVE_LIBMPFR
2417       res= _hessenberg(gen(makevecteur(args,epsilon(contextptr)),_SEQ__VECT),contextptr);
2418 #else
2419       res= _hessenberg(gen(makevecteur(args,1e-12),_SEQ__VECT),contextptr);
2420 #endif
2421     }
2422     else
2423       res= _hessenberg(args,contextptr);
2424     if (res.type==_VECT) res.subtype=_LIST__VECT;
2425     return res;
2426   }
2427   static const char _SCHUR_s[]="SCHUR";
2428   static define_unary_function_eval (__SCHUR,&_SCHUR,_SCHUR_s); // FIXME
2429   define_unary_function_ptr5( at_SCHUR ,alias_at_SCHUR,&__SCHUR,0,T_UNARY_OP_38);
2430 
2431   static const char _schur_s[]="schur";
2432   static define_unary_function_eval (__schur,&_SCHUR,_schur_s); // FIXME
2433   define_unary_function_ptr5( at_schur ,alias_at_schur,&__schur,0,T_UNARY_OP);
2434 
_LQ(const gen & args0,GIAC_CONTEXT)2435   gen _LQ(const gen & args0,GIAC_CONTEXT){
2436     if ( args0.type==_STRNG && args0.subtype==-1) return  args0;
2437     gen args=evalf(args0,1,contextptr);
2438     if (!ckmatrix(args))
2439       return gentypeerr(contextptr);
2440     gen res=qr(makevecteur(_trn(args,contextptr),-1),contextptr);
2441     if (is_undef(res) || res.type!=_VECT || res._VECTptr->size()<3)
2442       return gensizeerr(contextptr);
2443     vecteur v(*res._VECTptr);
2444     v[0]=_trn(v[0],contextptr);
2445     v[1]=_trn(v[1],contextptr);
2446     swapgen(v[0],v[1]);
2447     // v[2]=midn(v[0]._VECTptr->size());
2448     return gen(v,_LIST__VECT);
2449   }
2450   static const char _LQ_s[]="LQ";
2451   static define_unary_function_eval (__LQ,&_LQ,_LQ_s);
2452   define_unary_function_ptr5( at_LQ ,alias_at_LQ,&__LQ,0,T_UNARY_OP_38);
2453 
2454   static const char _RREF_s[]="RREF";
2455   static define_unary_function_eval (__RREF,&_rref,_RREF_s); // FIXME
2456   define_unary_function_ptr5( at_RREF ,alias_at_RREF,&__RREF,0,T_UNARY_OP_38);
2457 
_XPON(const gen & g0,GIAC_CONTEXT)2458   gen _XPON(const gen & g0,GIAC_CONTEXT){
2459     if (g0.type==_STRNG && g0.subtype==-1) return g0;
2460     if (is_equal(g0))
2461       return apply_to_equal(g0,_XPON,contextptr);
2462     if (g0.type==_VECT)
2463       return apply(g0,_XPON,contextptr);
2464 #if 0 // def BCD
2465     gen g=evalf2bcd(g0,1,contextptr);
2466 #else
2467     gen g=evalf_double(g0,1,contextptr);
2468 #endif
2469     if (is_exactly_zero(g))
2470       return undef;
2471     gen gf=_floor(log10(abs(g,contextptr),contextptr),contextptr);
2472     if (gf.type!=_INT_ && gf.type!=_FLOAT_)
2473       return gensizeerr(contextptr);
2474     return gf;
2475   }
2476   static const char _XPON_s[]="XPON";
2477   static define_unary_function_eval (__XPON,&_XPON,_XPON_s); // FIXME
2478   define_unary_function_ptr5( at_XPON ,alias_at_XPON,&__XPON,0,T_UNARY_OP_38);
2479 
mantissa(const gen & g0,bool includesign,int base,gen & expo,GIAC_CONTEXT)2480   gen mantissa(const gen & g0,bool includesign,int base,gen & expo,GIAC_CONTEXT){
2481 #if 0 // def BCD
2482     gen g=evalf2bcd(g0,1,contextptr);
2483 #else
2484     gen g=evalf_double(g0,1,contextptr);
2485 #endif
2486     if (is_exactly_zero(g))
2487       return g;
2488     gen gabs=abs(g,contextptr);
2489     expo=base==10?log10(gabs,contextptr):_logb(makesequence(gabs,base),contextptr);
2490     expo=_floor(expo,contextptr);
2491     if (abs_calc_mode(contextptr)!=38 && expo.type!=_INT_)
2492       return gensizeerr(contextptr);
2493     // FIXME number of digits
2494     gabs=gabs*(base==10?alog10(-expo,contextptr):pow(base,-expo,contextptr));
2495     return (includesign?sign(g,contextptr):1)*evalf(gabs,1,contextptr);
2496   }
mantissa(const gen & g0,bool includesign,GIAC_CONTEXT)2497   gen mantissa(const gen & g0,bool includesign,GIAC_CONTEXT){
2498     gen expo;
2499     return mantissa(g0,includesign,10,expo,contextptr);
2500   }
_MANT(const gen & g0,GIAC_CONTEXT)2501   gen _MANT(const gen & g0,GIAC_CONTEXT){
2502     if (g0.type==_STRNG && g0.subtype==-1) return g0;
2503     if (is_equal(g0))
2504       return apply_to_equal(g0,_MANT,contextptr);
2505     if (g0.type==_VECT)
2506       return apply(g0,_MANT,contextptr);
2507     return mantissa(g0,true,contextptr);
2508   }
2509   static const char _MANT_s[]="MANT";
2510   static define_unary_function_eval (__MANT,&_MANT,_MANT_s);
2511   define_unary_function_ptr5( at_MANT ,alias_at_MANT,&__MANT,0,T_UNARY_OP_38);
2512 
_mantissa(const gen & g0,GIAC_CONTEXT)2513   gen _mantissa(const gen & g0,GIAC_CONTEXT){
2514     if (g0.type==_STRNG && g0.subtype==-1) return g0;
2515     if (is_equal(g0))
2516       return apply_to_equal(g0,_mantissa,contextptr);
2517     if (g0.type==_VECT)
2518       return apply(g0,_mantissa,contextptr);
2519     return mantissa(g0,false,contextptr);
2520   }
2521   static const char _mantissa_s[]="mantissa";
2522   static define_unary_function_eval (__mantissa,&_mantissa,_mantissa_s);
2523   define_unary_function_ptr5( at_mantissa ,alias_at_mantissa,&__mantissa,0,T_UNARY_OP);
2524 
_frexp(const gen & g0,GIAC_CONTEXT)2525   gen _frexp(const gen & g0,GIAC_CONTEXT){
2526     if (g0.type==_STRNG && g0.subtype==-1) return g0;
2527     if (is_equal(g0))
2528       return apply_to_equal(g0,_frexp,contextptr);
2529     if (g0.type==_VECT)
2530       return gensizeerr(contextptr); // apply(g0,_frexp,contextptr);
2531     gen expo;
2532     gen m=mantissa(g0,true,2,expo,contextptr);
2533     return makesequence(m/2,expo+1);
2534   }
2535   static const char _frexp_s[]="frexp";
2536   static define_unary_function_eval (__frexp,&_frexp,_frexp_s);
2537   define_unary_function_ptr5( at_frexp ,alias_at_frexp,&__frexp,0,T_UNARY_OP);
2538 
_ldexp(const gen & g0,GIAC_CONTEXT)2539   gen _ldexp(const gen & g0,GIAC_CONTEXT){
2540     if (g0.type==_STRNG && g0.subtype==-1) return g0;
2541     if (g0.type!=_VECT || g0.subtype!=_SEQ__VECT || g0._VECTptr->size()!=2)
2542       return gensizeerr(contextptr);
2543     return g0._VECTptr->front()*pow(2,g0._VECTptr->back(),contextptr);
2544   }
2545   static const char _ldexp_s[]="ldexp";
2546   static define_unary_function_eval (__ldexp,&_ldexp,_ldexp_s);
2547   define_unary_function_ptr5( at_ldexp ,alias_at_ldexp,&__ldexp,0,T_UNARY_OP);
2548 
_copysign(const gen & g0,GIAC_CONTEXT)2549   gen _copysign(const gen & g0,GIAC_CONTEXT){
2550     if (g0.type==_STRNG && g0.subtype==-1) return g0;
2551     if (g0.type!=_VECT || g0.subtype!=_SEQ__VECT || g0._VECTptr->size()!=2)
2552       return gensizeerr(contextptr);
2553     return abs(g0._VECTptr->front(),contextptr)*sign(g0._VECTptr->back(),contextptr);
2554   }
2555   static const char _copysign_s[]="copysign";
2556   static define_unary_function_eval (__copysign,&_copysign,_copysign_s);
2557   define_unary_function_ptr5( at_copysign ,alias_at_copysign,&__copysign,0,T_UNARY_OP);
2558 
_HMSX(const gen & g0,GIAC_CONTEXT)2559   gen _HMSX(const gen & g0,GIAC_CONTEXT){
2560     if ( g0.type==_STRNG && g0.subtype==-1) return  g0;
2561     if (g0.type==_VECT)
2562       return apply(g0,_HMSX,contextptr);
2563     gen g(evalf(g0,1,contextptr));
2564     if (g.type==_DOUBLE_)
2565       g = g+1e-12;
2566     if (g.type==_FLOAT_)
2567       g = g+plus_one/20000;
2568     if (g.type!=_DOUBLE_ && g.type!=_FLOAT_)
2569       return gentypeerr(contextptr);
2570     gen h=_floor(g,contextptr);
2571     gen m=_floor(100*(g-h),contextptr);
2572     gen s=_floor(100*(100*(g-h)-m),contextptr);
2573     return h+m/giac_float(60.)+s/giac_float(3600.);
2574   }
2575   static const char _HMSX_s[]="HMSX";
2576   static define_unary_function_eval (__HMSX,&_HMSX,_HMSX_s);
2577   define_unary_function_ptr5( at_HMSX ,alias_at_HMSX,&__HMSX,0,T_UNARY_OP_38);
2578 
_XHMS(const gen & g0,GIAC_CONTEXT)2579   gen _XHMS(const gen & g0,GIAC_CONTEXT){
2580     if ( g0.type==_STRNG && g0.subtype==-1) return  g0;
2581     if (g0.type==_VECT)
2582       return apply(g0,_XHMS,contextptr);
2583     gen g(evalf(g0,1,contextptr));
2584     if (g.type==_DOUBLE_)
2585       g = g+1e-12;
2586     if (g.type==_FLOAT_)
2587       g=g+plus_one/7200;
2588     if (g.type!=_DOUBLE_ && g.type!=_FLOAT_)
2589       return gentypeerr(contextptr);
2590     gen h=_floor(g,contextptr);
2591     gen m=_floor(60*(g-h),contextptr);
2592     gen s=_floor(60*(60*(g-h)-m),contextptr);
2593     return h+m/giac_float(100.)+s/giac_float(10000.);
2594   }
2595   static const char _XHMS_s[]="XHMS";
2596   static define_unary_function_eval (__XHMS,&_XHMS,_XHMS_s);
2597   define_unary_function_ptr5( at_XHMS ,alias_at_XHMS,&__XHMS,0,T_UNARY_OP_38);
2598 
_DEGXRAD(const gen & g,GIAC_CONTEXT)2599   gen _DEGXRAD(const gen & g,GIAC_CONTEXT){
2600     if ( g.type==_STRNG && g.subtype==-1) return  g;
2601     if (g.type==_VECT)
2602       return apply(g,_DEGXRAD,contextptr);
2603     return deg2rad_d*g;
2604   }
2605   static const char _DEGXRAD_s[]="DEGXRAD";
2606   static define_unary_function_eval (__DEGXRAD,&_DEGXRAD,_DEGXRAD_s);
2607   define_unary_function_ptr5( at_DEGXRAD ,alias_at_DEGXRAD,&__DEGXRAD,0,T_UNARY_OP_38);
2608 
_RADXDEG(const gen & g,GIAC_CONTEXT)2609   gen _RADXDEG(const gen & g,GIAC_CONTEXT){
2610     if ( g.type==_STRNG && g.subtype==-1) return  g;
2611     if (g.type==_VECT)
2612       return apply(g,_RADXDEG,contextptr);
2613     return rad2deg_d*g;
2614   }
2615   static const char _RADXDEG_s[]="RADXDEG";
2616   static define_unary_function_eval (__RADXDEG,&_RADXDEG,_RADXDEG_s);
2617   define_unary_function_ptr5( at_RADXDEG ,alias_at_RADXDEG,&__RADXDEG,0,T_UNARY_OP_38);
2618 
_PERCENT(const gen & g,GIAC_CONTEXT)2619   gen _PERCENT(const gen & g,GIAC_CONTEXT){
2620     if ( g.type==_STRNG && g.subtype==-1) return  g;
2621     if (g.type!=_VECT || g._VECTptr->size()!=2)
2622       return gentypeerr(contextptr);
2623     return g._VECTptr->front()*g._VECTptr->back()/giac_float(100.);
2624   }
2625   static const char _PERCENT_s[]="%"; // FIXE
2626   static define_unary_function_eval (__PERCENT,&_PERCENT,_PERCENT_s);
2627   define_unary_function_ptr5( at_PERCENT ,alias_at_PERCENT,&__PERCENT,0,T_UNARY_OP_38);
2628 
_PERCENTCHANGE(const gen & g,GIAC_CONTEXT)2629   gen _PERCENTCHANGE(const gen & g,GIAC_CONTEXT){
2630     if ( g.type==_STRNG && g.subtype==-1) return  g;
2631     if (g.type!=_VECT || g._VECTptr->size()!=2)
2632       return gentypeerr(contextptr);
2633     return giac_float(100.)*(g._VECTptr->back()-g._VECTptr->front())/g._VECTptr->front();
2634   }
2635   static const char _PERCENTCHANGE_s[]="%CHANGE";
2636   static define_unary_function_eval (__PERCENTCHANGE,&_PERCENTCHANGE,_PERCENTCHANGE_s);
2637   define_unary_function_ptr5( at_PERCENTCHANGE ,alias_at_PERCENTCHANGE,&__PERCENTCHANGE,0,T_UNARY_OP_38);
2638 
_PERCENTTOTAL(const gen & g,GIAC_CONTEXT)2639   gen _PERCENTTOTAL(const gen & g,GIAC_CONTEXT){
2640     if ( g.type==_STRNG && g.subtype==-1) return  g;
2641     if (g.type!=_VECT || g._VECTptr->size()!=2)
2642       return gentypeerr(contextptr);
2643     return giac_float(100.)*g._VECTptr->back()/g._VECTptr->front();
2644   }
2645   static const char _PERCENTTOTAL_s[]="%TOTAL";
2646   static define_unary_function_eval (__PERCENTTOTAL,&_PERCENTTOTAL,_PERCENTTOTAL_s);
2647   define_unary_function_ptr5( at_PERCENTTOTAL ,alias_at_PERCENTTOTAL,&__PERCENTTOTAL,0,T_UNARY_OP_38);
2648 
_DISP(const gen & g,GIAC_CONTEXT)2649   gen _DISP(const gen & g,GIAC_CONTEXT){
2650     if (g.type!=_VECT || g._VECTptr->size()!=2)
2651       return gensizeerr(contextptr);
2652     gen a=g._VECTptr->front();
2653     if (a.type!=_INT_ || a.val <0 || a.val>10)
2654       setdimerr(contextptr);
2655     gen b=g._VECTptr->back();
2656     return _legende(gen(makevecteur(makevecteur(0,a*gen(12)),b),_SEQ__VECT),contextptr);
2657   }
2658   static const char _DISP_s []="DISP";
2659   static define_unary_function_eval_quoted (__DISP,&_DISP,_DISP_s);
2660   define_unary_function_ptr5( at_DISP ,alias_at_DISP,&__DISP,0,T_UNARY_OP_38);
2661 
2662   static const char _WAIT_s []="WAIT";
2663   static define_unary_function_eval (__WAIT,&_Pause,_WAIT_s);
2664   define_unary_function_ptr5( at_WAIT ,alias_at_WAIT,&__WAIT,0,T_UNARY_OP_38);
2665 
2666 #if 0 // def GIAC_HAS_STO_38
2667   gen aspen_input(const vecteur & v,GIAC_CONTEXT);
2668   gen aspen_msgbox(const vecteur & v,GIAC_CONTEXT);
2669 #endif
2670 
2671   // INPUT(A) or INPUT(A,"title") or INPUT(A,"title","label") or INPUT(A,"title","label","help")
2672   // or INPUT(A,"title","label","help",default_value)
_INPUT(const gen & args,GIAC_CONTEXT)2673   gen _INPUT(const gen & args,GIAC_CONTEXT){
2674     vecteur v=gen2vecteur(args);
2675     int s=int(v.size());
2676     if (s==1){
2677       v.push_back(string2gen("Input"));
2678       ++s;
2679     }
2680     if (s==2){
2681       v.push_back(string2gen(v[0].print(contextptr),false));
2682       ++s;
2683     }
2684     if (s==3){
2685       v.push_back(string2gen("Enter value for "+v[0].print(contextptr),false));
2686       ++s;
2687     }
2688     // check types
2689     if (v[0].is_symb_of_sommet(at_double_deux_points) && v[0]._SYMBptr->feuille.type==_VECT && v[0]._SYMBptr->feuille._VECTptr->size()==2)
2690       v[0]=v[0]._SYMBptr->feuille._VECTptr->back();
2691     for (int i=1; i<=3; i++) { if (v[i].type!=_STRNG) v[i]= eval(v[i], 1, contextptr); if (v[i].type!=_STRNG) v[i]=  string2gen(v[i].print(contextptr)); }
2692     if (v[0].type!=_IDNT || s>5)
2693       return gentypeerr(contextptr);
2694     // set default value in v[0]
2695     if (s==5){
2696       gen tmpsto=sto(v[4],v[0],contextptr);
2697       if (is_undef(tmpsto)) return tmpsto;
2698       v.pop_back();
2699       s=4;
2700     }
2701 #if 0 // def GIAC_HAS_STO_38
2702     return aspen_input(v,contextptr);
2703 #else
2704     // now make a dialog
2705     v[1]=symbolic(at_Title,v[1]);
2706     v[2]=symbolic(at_Request,makesequence(v[2],v[0]));
2707     v[3]=symbolic(at_Text,v[3]);
2708     v.erase(v.begin());
2709     return _Dialog(gen(v,_SEQ__VECT),contextptr);
2710 #endif
2711   }
2712   static const char _INPUT_s []="INPUT";
2713   static define_unary_function_eval_quoted (__INPUT,_INPUT,_INPUT_s);
2714   define_unary_function_ptr5( at_INPUT ,alias_at_INPUT,&__INPUT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2715 
2716 #if 0 // def GIAC_HAS_STO_38
2717   // MSGBOX(txt) or MSGBOX(txt, true/false) to have OK/Cancel or just OK menus
2718   gen _MSGBOX(const gen & args,GIAC_CONTEXT){
2719     vecteur v=gen2vecteur(args);
2720     int s=int(v.size());
2721     if (s==1) { v.push_back(gen(0)); ++s; }
2722     return aspen_msgbox(v,contextptr);
2723   }
2724 #else
_MSGBOX(const gen & args,GIAC_CONTEXT)2725   gen _MSGBOX(const gen & args,GIAC_CONTEXT){
2726     return _output(args,contextptr);
2727   }
2728 #endif
2729   static const char _MSGBOX_s []="MSGBOX";
2730   static define_unary_function_eval (__MSGBOX,_MSGBOX,_MSGBOX_s);
2731   define_unary_function_ptr5( at_MSGBOX ,alias_at_MSGBOX,&__MSGBOX,0,T_UNARY_OP_38);
2732 
2733   static const char _GETKEY_s[]="GETKEY";
2734 #if 0 // def GIAC_HAS_STO_38
2735   static define_unary_function_eval(__GETKEY,&at_GETKEYAspen,_GETKEY_s);
2736   // unary_function_eval __GETKEY(0,&at_GETKEYAspen,_GETKEY_s);
2737 #else
2738   unary_function_eval __GETKEY(0,&_getKey,_GETKEY_s);
2739 #endif
2740   define_unary_function_ptr5( at_GETKEY ,alias_at_GETKEY,&__GETKEY,0,T_UNARY_OP_38);
2741 
_ITERATE(const gen & args,GIAC_CONTEXT)2742   gen _ITERATE(const gen & args,GIAC_CONTEXT){
2743     if ( args.type==_STRNG && args.subtype==-1) return  args;
2744     if (args.type!=_VECT || args._VECTptr->size()!=4)
2745       return gentypeerr(contextptr);
2746     vecteur v = plotpreprocess(args,contextptr);
2747     gen v0=v[0];
2748     gen v1=v[1];
2749     // v[2]=eval(v[2],eval_level(contextptr),contextptr);
2750     // v[3]=eval(v[3],eval_level(contextptr),contextptr);
2751     if (v[3].type!=_INT_)
2752       return gentypeerr(contextptr);
2753     int n=v[3].val;
2754     bool all=n<0;
2755     if (all){
2756       n=-n;
2757       if (n>LIST_SIZE_LIMIT)
2758 	return gendimerr(contextptr);
2759     }
2760     gen value=v[2];
2761     vecteur res;
2762     if (all)
2763       res=vecteur(n+1,value);
2764     for (int i=0;!ctrl_c && !interrupted && i<n;++i){
2765 #ifdef TIMEOUT
2766       control_c();
2767 #endif
2768       value=evalf(subst(v0,v1,value,false,contextptr),eval_level(contextptr),contextptr);
2769       if (is_undef(value))
2770 	return value;
2771       if (all)
2772 	res[i+1]=value;
2773     }
2774     return all?res:value;
2775   }
2776   static const char _ITERATE_s[]="ITERATE";
2777   static define_unary_function_eval_quoted (__ITERATE,&_ITERATE,_ITERATE_s);
2778   define_unary_function_ptr5( at_ITERATE ,alias_at_ITERATE,&__ITERATE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2779 
2780 #ifndef GIAC_HAS_STO_38
_RECURSE(const gen & args,GIAC_CONTEXT)2781   gen _RECURSE(const gen & args,GIAC_CONTEXT){
2782     if ( args.type==_STRNG && args.subtype==-1) return  args;
2783     if (args.type!=_VECT || args._VECTptr->size()<2)
2784       return gentypeerr(contextptr);
2785     vecteur v = *args._VECTptr;
2786     gen v0=v[0];
2787     gen v1=v[1];
2788     int s=int(v.size());
2789     for (int i=2;i<s;++i)
2790       v[i]=eval(v[i],eval_level(contextptr),contextptr);
2791     if (v[0].type!=_IDNT)
2792       return _rsolve(gen(v,args.subtype),contextptr);
2793     // HP38 syntax, define recurrent sequence
2794     // idnt, expression, first term, second term
2795     // e.g. RECURSE(U,U(N-1)*N,1,2) STO> U1(N)
2796     return gentypeerr(contextptr);
2797     return undef;
2798   }
2799   static const char _RECURSE_s[]="RECURSE";
2800   static define_unary_function_eval_quoted (__RECURSE,&_RECURSE,_RECURSE_s);
2801   define_unary_function_ptr5( at_RECURSE ,alias_at_RECURSE,&__RECURSE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2802 #endif
2803 
_MAKEMAT(const gen & args,GIAC_CONTEXT)2804   gen _MAKEMAT(const gen & args,GIAC_CONTEXT){
2805     if ( args.type==_STRNG && args.subtype==-1) return  args;
2806     if (args.type!=_VECT || args._VECTptr->size()!=3)
2807       return gentypeerr(contextptr);
2808     vecteur v = *args._VECTptr;
2809     gen v0=v[0];
2810     gen v1=eval(v[1],eval_level(contextptr),contextptr);
2811     gen v2=eval(v[2],eval_level(contextptr),contextptr);
2812     is_integral(v1);
2813     is_integral(v2);
2814     if (v1.type!=_INT_ || v2.type!=_INT_ || v1.val<1 || v2.val<1)
2815       return gensizeerr(contextptr);
2816     int l=giacmax(v1.val,1),c=giacmax(v2.val,1);
2817     if (longlong(l)*c>LIST_SIZE_LIMIT)
2818       return gendimerr(contextptr);
2819     identificateur idI("I"),idJ("J");
2820     vecteur IJ=makevecteur(idI,idJ);
2821     vecteur IJval(2),res;
2822     for (int i=1;i<=l;++i){
2823       vecteur ligne(c);
2824       IJval[0]=i;
2825       for (int j=1;j<=c;++j){
2826 	IJval[1]=j;
2827 	ligne[j-1]=eval(subst(v0,IJ,IJval,false,contextptr),eval_level(contextptr),contextptr);
2828       }
2829       res.push_back(ligne);
2830     }
2831     return res;
2832   }
2833   static const char _MAKEMAT_s[]="MAKEMAT";
2834   static define_unary_function_eval_quoted (__MAKEMAT,&_MAKEMAT,_MAKEMAT_s);
2835   define_unary_function_ptr5( at_MAKEMAT ,alias_at_MAKEMAT,&__MAKEMAT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
2836 
2837   // For over-determined system, find the solution such that || A*X-B || (L2) is min
2838   // for under-determined system, find a solution X of A*X=B such that ||X|| is min
_LSQ(const gen & args,GIAC_CONTEXT)2839   gen _LSQ(const gen & args,GIAC_CONTEXT){
2840     if ( args.type==_STRNG && args.subtype==-1) return  args;
2841     if (args.type!=_VECT || args._VECTptr->size()<2)
2842       return gentypeerr(contextptr);
2843     vecteur v = *args._VECTptr;
2844     gen v0=v[0]; // evalf(v[0],1,contextptr)
2845     gen v1=v[1];
2846     int vs=int(v.size());
2847     if (vs==3){
2848       v.push_back(vecteur(0));
2849       ++vs;
2850     }
2851     if (vs==4){
2852       gen v2=v[2],v3=v[3];
2853       if (v0.type==_VECT && v1.type==_VECT && !v0._VECTptr->empty() && v0._VECTptr->size()==v1._VECTptr->size() && v2.type==_VECT && v3.type==_VECT){
2854 	// v0=list of values of x or of [x,y,...], v1= observed value at x,
2855 	// v2=v[vs-2]=list of expressions f_i(x) or f_i(x,y) or [f_i(vars)],[vars]
2856 	// v3=v.back()=list of constraints = list of
2857 	// [X_k,n_k (number of derivatives), Y_k=value of n_k-th diff at X_k]
2858 	// or [[X_k,Y_k,...],[n_k],value]
2859 	// minimize sum_j=1..N (y_j-sum_i=1..M(a_i*f_i(x_j),i))^2
2860 	// under sum_i=1..M a_i*diff(f_i,n_k)(X_k) = 0 for k=1..K
2861 	vecteur expr(*v2._VECTptr),constraints(*v3._VECTptr);
2862 	if (!constraints.empty() && constraints.front().type!=_VECT)
2863 	  constraints=vecteur(1,constraints);
2864 	if (!constraints.empty() && (!ckmatrix(constraints) || constraints.front()._VECTptr->size()!=3))
2865 	  return gensizeerr(contextptr);
2866 	vecteur & x=*v0._VECTptr;
2867 	vecteur & y=*v1._VECTptr;
2868 	unsigned M=unsigned(expr.size()), K=unsigned(constraints.size()),N=unsigned(v0._VECTptr->size());
2869 	vecteur vars(1,x__IDNT_e);
2870 	int dim=2;
2871 	if (x.front().type==_VECT){
2872 	  if (!ckmatrix(x))
2873 	    return gensizeerr(contextptr);
2874 	  dim=int(x.front()._VECTptr->size())+1;
2875 	  if (dim<2)
2876 	    return gendimerr(contextptr);
2877 	}
2878 	if (dim==3)
2879 	  vars.push_back(y__IDNT_e);
2880 	if (expr.front().type==_VECT){
2881 	  if (M!=2 || expr.back().type!=_VECT)
2882 	    return gensizeerr(contextptr);
2883 	  vars=*expr.back()._VECTptr;
2884 	  if (int(vars.size())!=dim-1)
2885 	    return gendimerr(contextptr);
2886 	  expr=*expr.front()._VECTptr;
2887 	  M=unsigned(expr.size());
2888 	}
2889 	else {
2890 	  if (dim>3)
2891 	    return gendimerr(contextptr);
2892 	}
2893 	// F_{i,j}=f_i(x_j)
2894 	matrice F; // M rows, N cols
2895 	for (unsigned i=0;i<M;++i){
2896 	  gen fi=expr[i];
2897 	  vecteur ligne;
2898 	  for (unsigned j=0;j<N;++j){
2899 	    ligne.push_back(subst(fi,vars,gen2vecteur(x[j]),false,contextptr));
2900 	  }
2901 	  F.push_back(ligne);
2902 	}
2903 	// dF_{i,k}=diff(f_i,n_k)(X_k)
2904 	matrice dF; // M rows, K cols
2905 	for (unsigned i=0;i<M;++i){
2906 	  gen fi=expr[i];
2907 	  vecteur ligne;
2908 	  for (unsigned k=0;k<K;++k){
2909 	    gen nk=constraints[k][1];
2910 	    gen tmp=derive(fi,vars,gen2vecteur(nk),contextptr);
2911 	    ligne.push_back(subst(tmp,vars,gen2vecteur(constraints[k][0]),false,contextptr));
2912 	  }
2913 	  dF.push_back(ligne);
2914 	}
2915 	matrice mat; // M+K rows, M+K+1 cols
2916 	// first M equations of linear system: for l=1..M
2917 	// sum_i=1..M a_i*sum_j=1..N f_l(x_j)*f_i(x_j) + sum_k=1..K lagrange_k*diff(f_l,n_k)(X_k) = sum_j=1..N f_l(x_j)*y_j
2918 	for (unsigned l=0;l<M;++l){
2919 	  vecteur ligne;
2920 	  for (unsigned i=0;i<M;++i){
2921 	    gen tmp=0;
2922 	    for (unsigned j=0;j<N;++j)
2923 	      tmp += F[l][j]*F[i][j];
2924 	    ligne.push_back(tmp);
2925 	  }
2926 	  for (unsigned k=0;k<K;++k){
2927 	    ligne.push_back(dF[l][k]);
2928 	  }
2929 	  gen tmp=0;
2930 	  for (unsigned j=0;j<N;++j){
2931 	    tmp += F[l][j]*y[j];
2932 	  }
2933 	  ligne.push_back(tmp);
2934 	  mat.push_back(ligne);
2935 	}
2936 	// last K equations
2937 	// sum_i=1..M a_i*diff(f_i,n_k)(X_k)=Y_k
2938 	// giving a (M+K,M+K) matrix -> linsolve, first M coordinates
2939 	// -> sum_i=1..M a_i f_i(x)
2940 	for (unsigned k=0;k<K;++k){
2941 	  vecteur ligne(M+K+1);
2942 	  ligne[M+K]=constraints[k][2];
2943 	  for (unsigned i=0;i<M;++i){
2944 	    ligne[i]=dF[i][k];
2945 	  }
2946 	  mat.push_back(ligne);
2947 	}
2948 	// now solve linear system
2949 	vecteur res=mker(mat,contextptr);
2950 	if (res.size()!=1 || res.front().type!=_VECT || res.front()._VECTptr->size()!=M+K+1)
2951 	  return gensizeerr("Singular linear system");
2952 	vecteur Res=*res.front()._VECTptr;
2953 	res=vecteur(Res.begin(),Res.begin()+M);
2954 	return gen(res);
2955       }
2956       else
2957 	return gensizeerr(contextptr);
2958     }
2959     if (!ckmatrix(v0) || v1.type!=_VECT)
2960       return gentypeerr(contextptr);
2961     int neq=int(v0._VECTptr->size()); // neq equations
2962     v0=_trn(v0,contextptr);
2963     matrice A=*v0._VECTptr,B;
2964     if (ckmatrix(v1))
2965       B=gen2vecteur(_trn(v1,contextptr));
2966     else
2967       B=vecteur(1,v1);
2968     if (int(B[0]._VECTptr->size())!=neq)
2969       return gendimerr(contextptr);
2970     int as=int(A.size()),bs=int(B.size());
2971     // bs system to solve, each with neq equations and as variables
2972     if (as>neq){ // under-determined system, find the smallest solution
2973       if (has_num_coeff(A)){
2974 	// QR factorization of A=trn(system matrix)
2975 	// R_1=neq first rows of R
2976 	// Q_1=neq first cols of Q
2977 	// solve R_1^* c = B[i] then output Q_1*c
2978 	gen qrdec=qr(A,contextptr);
2979 	if (qrdec.type==_VECT && qrdec._VECTptr->size()==2){
2980 	  gen q=qrdec._VECTptr->front(),r=qrdec._VECTptr->back();
2981 	  if (ckmatrix(q) && ckmatrix(r)){
2982 	    if (!is_zero(r[neq-1])){
2983 	      vecteur R(r._VECTptr->begin(),r._VECTptr->begin()+neq);
2984 	      r=mtran(R);
2985 	      R=*r._VECTptr;
2986 	      vecteur qt=mtran(*q._VECTptr);
2987 	      matrice res;
2988 	      qt=vecteur(qt.begin(),qt.begin()+neq);
2989 	      qt=mtran(qt);
2990 	      for (int i=0;i<bs;++i){
2991 		gen Bi=B[i];
2992 		vecteur v,w;
2993 		linsolve_l(R,*Bi._VECTptr,v);
2994 		multmatvecteur(qt,v,w);
2995 		res.push_back(w);
2996 	      }
2997 	      return mtran(res);
2998 	    }
2999 	  }
3000 	}
3001       }
3002       // not optimal since we solve the system for each Bi
3003       A.push_back(0);
3004       matrice res;
3005       for (int i=0;i<bs;++i){
3006 	gen Bi=B[i];
3007 	A[as]=Bi;
3008 	matrice At=gen2vecteur(_trn(A,contextptr));
3009 	vecteur B=mker(At,contextptr);
3010 	if (is_undef(B) || B.empty())
3011 	  return undef;
3012 	// The last element of B must have a non-zero last component
3013 	vecteur Bend=*B.back()._VECTptr;
3014 	gen last=-Bend.back();
3015 	if (is_zero(last))
3016 	  return vecteur(0);
3017 	vecteur R=divvecteur(Bend,last);
3018 	R.pop_back();
3019 	B.pop_back();
3020 	int Bs=int(B.size());
3021 	for (int j=0;j<Bs;j++)
3022 	  B[j]._VECTptr->pop_back();
3023 	// The solution is R+Vect(B[0],..,B[Bs-1])
3024 	// the smallest solution is the orthogonal projection of 0 on R+Vect(B)
3025 	// i.e. R + projection of -R on Vect(B)
3026 	matrice r,Bg=gramschmidt(B,r,false,contextptr);
3027 	gen Rtmp(R);
3028 	for (int j=0;j<Bs;++j){
3029 	  Rtmp -= dotvecteur(Bg[j],R)/dotvecteur(Bg[j],Bg[j])*Bg[j];
3030 	}
3031 	res.push_back(Rtmp);
3032       }
3033       res=gen2vecteur(_trn(res,contextptr));
3034       return res;
3035     }
3036     matrice res;
3037     if (has_num_coeff(v)){
3038       // <Ax-b|Ax-b> minimal, i.e. A* Ax=A* b or
3039       // A=QR, if A has m rows and n cols and m>=n, then Q is m*m and R is m*n
3040       // first n cols of Q are Q1, first n rows of R are R1
3041       // solve R1*x=Q1^t*b
3042       gen qrdec=qr(v[0],contextptr);
3043       if (qrdec.type==_VECT && qrdec._VECTptr->size()==2){
3044 	gen q=qrdec._VECTptr->front(),r=qrdec._VECTptr->back();
3045 	if (ckmatrix(q) && ckmatrix(r)){
3046 	  if (!is_zero(r[int(A.size())-1])){
3047 	    gen qt=_trn(q,contextptr);
3048 	    qt=vecteur(qt._VECTptr->begin(),qt._VECTptr->begin()+as);
3049 	    vecteur R(r._VECTptr->begin(),r._VECTptr->begin()+A.size());
3050 	    for (int i=0;i<bs;++i){
3051 	      gen Bi=B[i];
3052 	      vecteur v;
3053 	      linsolve_u(R,multmatvecteur(*qt._VECTptr,*Bi._VECTptr),v);
3054 	      res.push_back(v);
3055 	    }
3056 	    return mtran(res);
3057 	  }
3058 	  // A* Ax=A* b => R* Rx=R* Qb
3059 	  gen rstar=_trn(r,contextptr);
3060 	  gen rr=rstar*r;
3061 	  gen rq=rstar*q*B;
3062 	  return _linsolve(makesequence(rr,rq),contextptr);
3063 	}
3064       }
3065     }
3066     // orthogonal projection of each vector of B on image of A
3067     if (A.size()>20)
3068       *logptr(contextptr) << "LSQ: exact data, running Gramschmidt instead of qr, this is much slower for large matrices" << '\n';
3069     matrice r,Ag=gramschmidt(A,r,false,contextptr);
3070     for (int i=0;i<bs;++i){
3071       gen Bi=B[i];
3072       vecteur tmp(as);
3073       for (int j=0;j<as;++j){
3074 	tmp[j] = scalar_product(Ag[j],Bi,contextptr)/scalar_product(Ag[j],Ag[j],contextptr);
3075       }
3076       res.push_back(tmp);
3077     }
3078     res=gen2vecteur(_trn(res,contextptr));
3079     return mmult(*inv(r,contextptr)._VECTptr,res);
3080   }
3081   static const char _LSQ_s[]="LSQ";
3082   static define_unary_function_eval (__LSQ,&_LSQ,_LSQ_s);
3083   define_unary_function_ptr5( at_LSQ ,alias_at_LSQ,&__LSQ,0,T_UNARY_OP_38);
3084 
3085   static const char _lsq_s []="lsq";
3086   static define_unary_function_eval (__lsq,&_LSQ,_lsq_s);
3087   define_unary_function_ptr5( at_lsq ,alias_at_lsq,&__lsq,0,true);
3088 
printasNTHROOT(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)3089   static string printasNTHROOT(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
3090     if (feuille.type==_VECT && feuille._VECTptr->size()==2 && abs_calc_mode(contextptr)!=38)
3091       return "surd("+feuille[1].print(contextptr)+","+feuille[0].print(contextptr)+")";
3092     // return '('+(printsommetasoperator(feuille," NTHROOT ",contextptr))+')';
3093     return printsommetasoperator(feuille," NTHROOT ",contextptr);
3094   }
texprintasNTHROOT(const gen & g,const char * s,GIAC_CONTEXT)3095   static string texprintasNTHROOT(const gen & g,const char * s,GIAC_CONTEXT){
3096     return texprintsommetasoperator(g,"\\mbox{ NTHROOT }",contextptr);
3097   }
_NTHROOT(const gen & args,GIAC_CONTEXT)3098   gen _NTHROOT(const gen & args,GIAC_CONTEXT){
3099     if ( args.type==_STRNG && args.subtype==-1) return  args;
3100     if (args.type!=_VECT || args._VECTptr->size()!=2)
3101       return gensizeerr(contextptr);
3102     return _surd(gen(makevecteur(args._VECTptr->back(),args._VECTptr->front()),_SEQ__VECT),contextptr);
3103   }
3104   static const char _NTHROOT_s[]="NTHROOT";
3105   static define_unary_function_eval4 (__NTHROOT,&_NTHROOT,_NTHROOT_s,&printasNTHROOT,&texprintasNTHROOT);
3106   define_unary_function_ptr5( at_NTHROOT ,alias_at_NTHROOT,&__NTHROOT,0,T_POW);
3107 
3108 #ifndef GIAC_HAS_STO_38
rpn_ans()3109   gen * rpn_ans(){
3110     return 0;
3111   }
3112 #endif
_Ans(const gen & args,GIAC_CONTEXT)3113   gen _Ans(const gen & args,GIAC_CONTEXT){
3114     if (rpn_ans())
3115       return *rpn_ans();
3116     return _ans(0,contextptr);
3117   }
3118   static const char _Ans_s[]="Ans";
printasAns(const gen & feuille,const char * sommetstr,GIAC_CONTEXT)3119   static string printasAns(const gen & feuille,const char * sommetstr,GIAC_CONTEXT){
3120     return _Ans_s;
3121   }
3122   static define_unary_function_eval2 (__Ans,&_Ans,_Ans_s,&printasAns);
3123   define_unary_function_ptr5( at_Ans ,alias_at_Ans,&__Ans,0,T_LITERAL);
3124 
_EXPORT_(const gen & args,GIAC_CONTEXT)3125   gen _EXPORT_(const gen & args,GIAC_CONTEXT){
3126     // eval sto only
3127     vecteur v =gen2vecteur(args);
3128     int nsto=0,s=int(v.size());
3129     for (int i=0;i<s;++i){
3130       if (v[i].is_symb_of_sommet(at_sto)){
3131 	++nsto;
3132 	eval(v[i],1,contextptr);
3133       }
3134     }
3135     return nsto;
3136   }
3137   static const char _EXPORT__s[]="EXPORT";
3138   static define_unary_function_eval_quoted (__EXPORT_,&_EXPORT_,_EXPORT__s);
3139   define_unary_function_ptr5( at_EXPORT ,alias_at_EXPORT_,&__EXPORT_,_QUOTE_ARGUMENTS,T_RETURN);
3140 
_VIEWS(const gen & args,GIAC_CONTEXT)3141   gen _VIEWS(const gen & args,GIAC_CONTEXT){
3142     return _EXPORT_(args,contextptr);
3143   }
3144   static const char _VIEWS_s[]="VIEWS";
3145   static define_unary_function_eval_quoted (__VIEWS,&_VIEWS,_VIEWS_s);
3146   define_unary_function_ptr5( at_VIEWS ,alias_at_VIEWS,&__VIEWS,_QUOTE_ARGUMENTS,T_RETURN);
3147 
3148 #ifdef USE_GMP_REPLACEMENTS
mpz_get_ull(mpz_t n)3149   unsigned long long mpz_get_ull(mpz_t n){
3150     return 0; // FIXME!!!!
3151   }
3152 #else
mpz_get_ull(mpz_t n)3153   unsigned long long mpz_get_ull(mpz_t n){
3154     unsigned int lo, hi;
3155     mpz_t tmp;
3156 
3157     mpz_init( tmp );
3158     mpz_mod_2exp( tmp, n, 64 );   /* tmp = (lower 64 bits of n) */
3159 
3160     lo = mpz_get_ui( tmp );       /* lo = tmp & 0xffffffff */
3161     mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
3162     hi = mpz_get_ui( tmp );       /* hi = tmp & 0xffffffff */
3163 
3164     mpz_clear( tmp );
3165 
3166     return (((unsigned long long)hi) << 32) + lo;
3167   }
3168 #endif
3169 
_pointer(const gen & args,GIAC_CONTEXT)3170   gen _pointer(const gen & args,GIAC_CONTEXT){
3171     if (args.type!=_VECT || args._VECTptr->size()!=2)
3172       return gensizeerr(contextptr);
3173     if (args._VECTptr->back().type!=_INT_)
3174       return gentypeerr(contextptr);
3175     if (args._VECTptr->front().type==_INT_)
3176       return gen((void *)(unsigned long)args._VECTptr->front().val, args._VECTptr->back().val);
3177 #ifndef USE_GMP_REPLACEMENTS
3178     if (args._VECTptr->front().type==_ZINT){
3179       unsigned long u=mpz_get_ull(*args._ZINTptr);
3180       return gen((void *)u,args._VECTptr->back().val);
3181     }
3182 #endif
3183     return gentypeerr(contextptr);
3184   }
3185   static const char _pointer_s[]="pointer";
3186   static define_unary_function_eval (__pointer,&_pointer,_pointer_s);
3187   define_unary_function_ptr5( at_pointer ,alias_at_pointer,&__pointer,0,T_UNARY_OP);
3188 
is_known_name_home_38(const char * idname)3189   int is_known_name_home_38(const char * idname){
3190     int s=int(strlen(idname));
3191     if (s==1 && idname[0]>='A' && idname[0]<='Z')
3192       return 3;
3193     if (s==2 && !strcmp(idname,"θ"))
3194       return 3;
3195     if (s==2 && (idname[0]=='Z' || idname[0]=='L' || idname[0]=='M') && idname[1]>='0' && idname[1]<='9')
3196       return 3;
3197     return is_known_name_38?is_known_name_38(0,idname):0;
3198   }
3199 
3200   // 1 and 2 app or program variable, 3 home variable
is_known_name_home_38(const char * name_space,const char * idname)3201   int is_known_name_home_38(const char * name_space,const char * idname){
3202     if (name_space)
3203       return is_known_name_38?is_known_name_38(name_space,idname):0;
3204     return is_known_name_home_38(idname);
3205   }
3206 
qualifysubst(const gen & g,const vecteur & vin,const vecteur & vout,GIAC_CONTEXT)3207   static gen qualifysubst(const gen & g,const vecteur & vin,const vecteur & vout,GIAC_CONTEXT){
3208     if (vin.empty()) return g;
3209     if (g.type!=_VECT){
3210       if (g.is_symb_of_sommet(at_sto)){
3211 	gen & f = g._SYMBptr->feuille;
3212 	if (f.type==_VECT && f._VECTptr->size()==2){
3213 	  return symbolic(at_sto,gen(makevecteur(subst(f._VECTptr->front(),vin,vout,true,contextptr),f._VECTptr->back()),_SEQ__VECT));
3214 	}
3215       }
3216       return subst(g,vin,vout,true,contextptr);
3217     }
3218     const_iterateur it=g._VECTptr->begin(),itend=g._VECTptr->end();
3219     vecteur res;
3220     res.reserve(itend-it);
3221     for (;it!=itend;++it)
3222       res.push_back(qualifysubst(*it,vin,vout,contextptr));
3223     return gen(res,g.subtype);
3224   }
3225 
qualify(gen & g,const vecteur & v,const gen & prog,GIAC_CONTEXT)3226   void qualify(gen & g,const vecteur & v,const gen & prog,GIAC_CONTEXT){
3227     if (v.empty()) return;
3228     vecteur w(v);
3229     unsigned s=unsigned(v.size());
3230     for (unsigned i=0;i<s;++i){
3231       w[i]=symbolic(at_double_deux_points,gen(makevecteur(prog,w[i]),_SEQ__VECT));
3232     }
3233     g=subst(g,v,w,true,contextptr);
3234     //g=qualifysubst(g,v,w,contextptr);
3235   }
3236 
3237 #if 0
3238   // 0: ok, -1: invalid views, -2: invalid VIEWS/EXPORT declaration in a program
3239   static int parse_program_decl(vecteur & assignation_by_equal,vecteur & undeclared_global_vars,vecteur & declared_global_vars,vecteur & declared_functions,vecteur & exported_function_names,vecteur & exported_variable_names,vecteur & unknown_exported,vecteur & unexported,vecteur & unexported_declared_global_vars,vecteur & views,vecteur & errors,const gen & prog,gen & parsed,GIAC_CONTEXT){
3240     check_local_assign(parsed,vecteur(0),assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,true,contextptr);
3241     vecteur vprog=lop(parsed,at_program);
3242     if (!lop(vprog,at_VIEWS).empty() || !lop(vprog,at_EXPORT).empty())
3243       return -2;
3244     // views
3245     vecteur vviews=lop(parsed,at_VIEWS);
3246     iterateur vt=vviews.begin(),vtend=vviews.end();
3247     for (;vt!=vtend;++vt){
3248       gen & f = vt->_SYMBptr->feuille;
3249       if (f.type==_VECT){
3250 	vecteur v=*f._VECTptr;
3251 	if (v.size()==2){
3252 	  if (v.front().type==_STRNG)
3253 	    reverse(v.begin(),v.end());
3254 	  if (v.front().is_symb_of_sommet(at_sto))
3255 	    v.front()=v.front()._SYMBptr->feuille[1];
3256 	  views=mergevecteur(views,v);
3257 	}
3258 	else return -1;
3259       }
3260     }
3261     // exported/unexported: declaration like export f,"help for f";
3262     vecteur exported=lop(parsed,at_EXPORT),exported_names;
3263     if (exported.empty()){
3264       unexported=declared_functions;
3265     }
3266     else {
3267       iterateur it=exported.begin(),itend=exported.end();
3268       for (;it!=itend;++it){
3269 	gen & f = it->_SYMBptr->feuille;
3270 	if (f.type==_VECT){
3271 	  vecteur v=*f._VECTptr;
3272 	  if (!v.empty()){
3273 	    if (v.front().type==_STRNG)
3274 	      reverse(v.begin(),v.end());
3275 	    if (v.front().is_symb_of_sommet(at_sto))
3276 	      v.front()=v.front()._SYMBptr->feuille[1];
3277 	    exported_names=mergevecteur(exported_names,v);
3278 	  }
3279 	}
3280 	else {
3281 	  exported_names.push_back(f.is_symb_of_sommet(at_sto)?f._SYMBptr->feuille[1]:f);
3282 	}
3283       }
3284       // check if exported functions are defined or exported variables declared
3285       // check also that we do not redefine regular home variables
3286       itend=exported_names.end();
3287       // first replace function definition by function name
3288       for (it=exported_names.begin();it!=itend;++it){
3289 	if (it->is_symb_of_sommet(at_sto)){
3290 	  *it=it->_SYMBptr->feuille;
3291 	  if (it->type==_VECT && it->_VECTptr->size()==2)
3292 	    *it=it->_VECTptr->back();
3293 	}
3294       }
3295       for (it=exported_names.begin();it!=itend;++it){
3296 	if (it->type!=_STRNG){
3297 	  if (equalposcomp(declared_functions,*it) && !equalposcomp(declared_global_vars,*it) && !equalposcomp(undeclared_global_vars,*it))
3298 	    unknown_exported.push_back(*it);
3299 	  if (it->type==_IDNT && is_known_name_home_38(it->_IDNTptr->id_name))
3300 	    errors.push_back(*it);
3301 	}
3302       }
3303       it=declared_functions.begin(),itend=declared_functions.end();
3304       for (;it!=itend;++it){
3305 	if (!equalposcomp(exported_names,*it))
3306 	  unexported.push_back(*it);
3307       }
3308     }
3309     // remove exported functions/views and variables from undeclared global vars
3310     // check other: either home variables or put in errors
3311     vecteur tmp;
3312     tmp=undeclared_global_vars;
3313     undeclared_global_vars.clear();
3314     const_iterateur jt=tmp.begin(),jtend=tmp.end();
3315     for (;jt!=jtend;++jt){
3316       if (jt->type!=_IDNT)
3317 	continue;
3318       if (!equalposcomp(declared_functions,*jt) && !equalposcomp(exported_names,*jt)){
3319 	if (is_known_name_home_38(0,jt->_IDNTptr->id_name))
3320 	  undeclared_global_vars.push_back(*jt);
3321 	else
3322 	  errors.push_back(*jt);
3323       }
3324     }
3325     // keep only home and app variables in declared global vars
3326     tmp=declared_global_vars;
3327     declared_global_vars.clear();
3328     jt=tmp.begin(); jtend=tmp.end();
3329     for (;jt!=jtend;++jt){
3330       if (jt->type==_IDNT && !equalposcomp(exported_names,*jt)){
3331 	if (is_known_name_home_38(0,jt->_IDNTptr->id_name))
3332 	  declared_global_vars.push_back(*jt);
3333 	else
3334 	  unexported_declared_global_vars.push_back(*jt);
3335       }
3336     }
3337     // split exported_names into function/variables
3338     exported_function_names.clear();
3339     exported_variable_names.clear();
3340     if (!exported_names.empty()){
3341       vecteur sto_var=lop(parsed,at_sto);
3342       int s=int(exported_names.size());
3343       int is_var=-1;
3344       for (int i=0;i<s;++i){
3345 	gen & var=exported_names[i];
3346 	if (var.type==_IDNT){
3347 	  const_iterateur it=sto_var.begin(),itend=sto_var.end();
3348 	  for (;it!=itend;++it){
3349 	    if (it->type!=_SYMB) continue;
3350 	    gen & f =it->_SYMBptr->feuille;
3351 	    if (f.type==_VECT && f._VECTptr->size()==2 && f._VECTptr->back()==var){
3352 	      if (f._VECTptr->front().is_symb_of_sommet(at_program))
3353 		is_var=0;
3354 	      else
3355 		is_var=1;
3356 	      break;
3357 	    }
3358 	  }
3359 	  if (it==itend)
3360 	    is_var=1;
3361 	}
3362 	if (is_var>=0){
3363 	  if (is_var)
3364 	    exported_variable_names.push_back(var);
3365 	  else
3366 	    exported_function_names.push_back(var);
3367 	}
3368       }
3369     }
3370     // qualify unexported functions and declared unexported variables
3371     qualify(parsed,unexported,prog,contextptr);
3372     qualify(parsed,unexported_declared_global_vars,prog,contextptr);
3373     qualify(parsed,exported_variable_names,prog,contextptr);
3374 #if !defined RTOS_THREADX && !defined NSPIRE && !defined FXCG && !defined GIAC_HAS_STO_38
3375     ofstream of("c:\\log"); of << "=" << assignation_by_equal << '\n' << "undecl vars:" << undeclared_global_vars << '\n' << "decl vars:" << declared_global_vars << '\n' << "decl func.:" << declared_functions << '\n' << "exported func:" << exported_function_names << '\n' << "exported vars:"<<exported_variable_names << '\n' << "unknown exported:"<<unknown_exported << '\n' << "unexported:" << unexported << '\n' << "unexported declared global vars:"<<unexported_declared_global_vars << '\n' << "views:" << views << '\n' << "errors:" << errors << '\n' << "prog:"<<prog << '\n' << "parsed:" << parsed; of.close();
3376 #endif
3377     return int(errors.size());
3378   }
3379 
3380   // 0: ok, -1: invalid view, >0: #errors
3381   int parse_program(const wchar_t * source,const wchar_t * progname,vecteur & assignation_by_equal,vecteur & undeclared_global_vars,vecteur & declared_global_vars,vecteur & exported_function_names,vecteur & exported_variable_names,vecteur & unknown_exported,vecteur & unexported,vecteur & unexported_declared_global_vars,vecteur & views,vecteur & errors,gen & parsed,GIAC_CONTEXT){
3382     unsigned utfs = giacmax(utf8length(source),utf8length(progname));
3383     char * utf8source = new char[utfs+1];
3384     unicode2utf8(source,utf8source,wstrlen(source));
3385     string s(utf8source);
3386     unicode2utf8(progname,utf8source,wstrlen(progname));
3387     string utf8progname(utf8source);
3388     gen prog=identificateur(utf8progname);
3389     delete [] utf8source;
3390     int c=calc_mode(contextptr);
3391     calc_mode(contextptr)=-38;
3392     parsed=gen(s,contextptr);
3393     calc_mode(contextptr)=c;
3394     vecteur declared_functions;
3395     int err=parse_program_decl(assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,views,errors,prog,parsed,contextptr);
3396     return err;
3397   }
3398 
3399   gen _testfunc(const gen & g0,GIAC_CONTEXT){
3400     if (g0.type==_STRNG){
3401       int c=calc_mode(contextptr);
3402       calc_mode(contextptr)=-38;
3403       gen parsed(*g0._STRNGptr,contextptr);
3404       calc_mode(contextptr)=c;
3405       gen prog("abc",contextptr);
3406       vecteur assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,views,errors;
3407       parse_program_decl(assignation_by_equal,undeclared_global_vars,declared_global_vars,declared_functions,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,views,errors,prog,parsed,contextptr);
3408       // eval
3409       gen res=eval(parsed,1,contextptr);
3410       vecteur resv=makevecteur(assignation_by_equal,undeclared_global_vars,declared_global_vars,exported_function_names,exported_variable_names,unknown_exported,unexported,unexported_declared_global_vars,errors);
3411       resv.push_back(res);
3412       return resv;
3413     }
3414     return undef;
3415   }
3416   static const char _testfunc_s[]="testfunc";
3417   static define_unary_function_eval(__testfunc,&_testfunc,_testfunc_s);
3418   define_unary_function_ptr5( at_testfunc ,alias_at_testfunc,&__testfunc,0,true);
3419 #else
3420 
_testfunc(const gen & g0,GIAC_CONTEXT)3421   gen _testfunc(const gen & g0,GIAC_CONTEXT){
3422 #if 0
3423     string S;
3424     pixon_print(g0,S,contextptr);
3425     return string2gen(S,false);
3426 #else
3427     return g0;
3428 #endif
3429   }
3430   static const char _testfunc_s[]="testfunc";
3431   static define_unary_function_eval(__testfunc,&_testfunc,_testfunc_s);
3432   define_unary_function_ptr5( at_testfunc ,alias_at_testfunc,&__testfunc,0,true);
3433 #endif // old code not used anymore
3434 
3435 #ifdef DOUBLEVAL
3436   const identificateur nsymbolic__IDNT("nsymbolic");
3437   const gen nsymbolic(nsymbolic__IDNT);
3438 
3439   const identificateur u0_nm1__IDNT("u0_nm1");
3440   const gen u0_nm1(u0_nm1__IDNT);
3441   const identificateur v0_nm2__IDNT("v0_nm2");
3442   const gen v0_nm2(v0_nm2__IDNT);
3443   const identificateur U0__IDNT("U0");
3444   const gen U0_idnt(U0__IDNT);
3445 
3446   const identificateur u1_nm1__IDNT("u1_nm1");
3447   const gen u1_nm1(u1_nm1__IDNT);
3448   const identificateur v1_nm2__IDNT("v1_nm2");
3449   const gen v1_nm2(v1_nm2__IDNT);
3450   const identificateur U1__IDNT("U1");
3451   const gen U1_idnt(U1__IDNT);
3452 
3453   const identificateur u2_nm1__IDNT("u2_nm1");
3454   const gen u2_nm1(u2_nm1__IDNT);
3455   const identificateur v2_nm2__IDNT("v2_nm2");
3456   const gen v2_nm2(v2_nm2__IDNT);
3457   const identificateur U2__IDNT("U2");
3458   const gen U2_idnt(U2__IDNT);
3459 
3460   const identificateur u3_nm1__IDNT("u3_nm1");
3461   const gen u3_nm1(u3_nm1__IDNT);
3462   const identificateur v3_nm2__IDNT("v3_nm2");
3463   const gen v3_nm2(v3_nm2__IDNT);
3464   const identificateur U3__IDNT("U3");
3465   const gen U3_idnt(U3__IDNT);
3466 
3467   const identificateur u4_nm1__IDNT("u4_nm1");
3468   const gen u4_nm1(u4_nm1__IDNT);
3469   const identificateur v4_nm2__IDNT("v4_nm2");
3470   const gen v4_nm2(v4_nm2__IDNT);
3471   const identificateur U4__IDNT("U4");
3472   const gen U4_idnt(U4__IDNT);
3473 
3474   const identificateur u5_nm1__IDNT("u5_nm1");
3475   const gen u5_nm1(u5_nm1__IDNT);
3476   const identificateur v5_nm2__IDNT("v5_nm2");
3477   const gen v5_nm2(v5_nm2__IDNT);
3478   const identificateur U5__IDNT("U5");
3479   const gen U5_idnt(U5__IDNT);
3480 
3481   const identificateur u6_nm1__IDNT("u6_nm1");
3482   const gen u6_nm1(u6_nm1__IDNT);
3483   const identificateur v6_nm2__IDNT("v6_nm2");
3484   const gen v6_nm2(v6_nm2__IDNT);
3485   const identificateur U6__IDNT("U6");
3486   const gen U6_idnt(U6__IDNT);
3487 
3488   const identificateur u7_nm1__IDNT("u7_nm1");
3489   const gen u7_nm1(u7_nm1__IDNT);
3490   const identificateur v7_nm2__IDNT("v7_nm2");
3491   const gen v7_nm2(v7_nm2__IDNT);
3492   const identificateur U7__IDNT("U7");
3493   const gen U7_idnt(U7__IDNT);
3494 
3495   const identificateur u8_nm1__IDNT("u8_nm1");
3496   const gen u8_nm1(u8_nm1__IDNT);
3497   const identificateur v8_nm2__IDNT("v8_nm2");
3498   const gen v8_nm2(v8_nm2__IDNT);
3499   const identificateur U8__IDNT("U8");
3500   const gen U8_idnt(U8__IDNT);
3501 
3502   const identificateur u9_nm1__IDNT("u9_nm1");
3503   const gen u9_nm1(u9_nm1__IDNT);
3504   const identificateur v9_nm2__IDNT("v9_nm2");
3505   const gen v9_nm2(v9_nm2__IDNT);
3506   const identificateur U9__IDNT("U9");
3507   const gen U9_idnt(U9__IDNT);
3508 
3509 #else // GIAC_HAS_STO_38
3510   const alias_ref_identificateur ref_nsymbolic={-1,0,0,"nsymbolic",0,0};
3511   const define_alias_gen(alias_nsymbolic,_IDNT,0,&ref_nsymbolic);
3512   const gen & nsymbolic = * (gen *) & alias_nsymbolic;
3513 
3514   const alias_ref_identificateur ref_u0_nm1={-1,0,0,"u0_nm1",0,0};
3515   const define_alias_gen(alias_u0_nm1,_IDNT,0,&ref_u0_nm1);
3516   const gen & u0_nm1 = * (gen *) & alias_u0_nm1;
3517   const alias_ref_identificateur ref_v0_nm2={-1,0,0,"v0_nm2",0,0};
3518   const define_alias_gen(alias_v0_nm2,_IDNT,0,&ref_v0_nm2);
3519   const gen & v0_nm2 = * (gen *) & alias_v0_nm2;
3520   const alias_ref_identificateur ref_U0_idnt={-1,0,0,"U0",0,0};
3521   const define_alias_gen(alias_U0_idnt,_IDNT,0,&ref_U0_idnt);
3522   const gen & U0_idnt = * (gen *) & alias_U0_idnt;
3523 
3524   const alias_ref_identificateur ref_u1_nm1={-1,0,0,"u1_nm1",0,0};
3525   const define_alias_gen(alias_u1_nm1,_IDNT,0,&ref_u1_nm1);
3526   const gen & u1_nm1 = * (gen *) & alias_u1_nm1;
3527   const alias_ref_identificateur ref_v1_nm2={-1,0,0,"v1_nm2",0,0};
3528   const define_alias_gen(alias_v1_nm2,_IDNT,0,&ref_v1_nm2);
3529   const gen & v1_nm2 = * (gen *) & alias_v1_nm2;
3530   const alias_ref_identificateur ref_U1_idnt={-1,0,0,"U1",0,0};
3531   const define_alias_gen(alias_U1_idnt,_IDNT,0,&ref_U1_idnt);
3532   const gen & U1_idnt = * (gen *) & alias_U1_idnt;
3533 
3534   const alias_ref_identificateur ref_u2_nm1={-1,0,0,"u2_nm1",0,0};
3535   const define_alias_gen(alias_u2_nm1,_IDNT,0,&ref_u2_nm1);
3536   const gen & u2_nm1 = * (gen *) & alias_u2_nm1;
3537   const alias_ref_identificateur ref_v2_nm2={-1,0,0,"v2_nm2",0,0};
3538   const define_alias_gen(alias_v2_nm2,_IDNT,0,&ref_v2_nm2);
3539   const gen & v2_nm2 = * (gen *) & alias_v2_nm2;
3540   const alias_ref_identificateur ref_U2_idnt={-1,0,0,"U2",0,0};
3541   const define_alias_gen(alias_U2_idnt,_IDNT,0,&ref_U2_idnt);
3542   const gen & U2_idnt = * (gen *) & alias_U2_idnt;
3543 
3544   const alias_ref_identificateur ref_u3_nm1={-1,0,0,"u3_nm1",0,0};
3545   const define_alias_gen(alias_u3_nm1,_IDNT,0,&ref_u3_nm1);
3546   const gen & u3_nm1 = * (gen *) & alias_u3_nm1;
3547   const alias_ref_identificateur ref_v3_nm2={-1,0,0,"v3_nm2",0,0};
3548   const define_alias_gen(alias_v3_nm2,_IDNT,0,&ref_v3_nm2);
3549   const gen & v3_nm2 = * (gen *) & alias_v3_nm2;
3550   const alias_ref_identificateur ref_U3_idnt={-1,0,0,"U3",0,0};
3551   const define_alias_gen(alias_U3_idnt,_IDNT,0,&ref_U3_idnt);
3552   const gen & U3_idnt = * (gen *) & alias_U3_idnt;
3553 
3554   const alias_ref_identificateur ref_u4_nm1={-1,0,0,"u4_nm1",0,0};
3555   const define_alias_gen(alias_u4_nm1,_IDNT,0,&ref_u4_nm1);
3556   const gen & u4_nm1 = * (gen *) & alias_u4_nm1;
3557   const alias_ref_identificateur ref_v4_nm2={-1,0,0,"v4_nm2",0,0};
3558   const define_alias_gen(alias_v4_nm2,_IDNT,0,&ref_v4_nm2);
3559   const gen & v4_nm2 = * (gen *) & alias_v4_nm2;
3560   const alias_ref_identificateur ref_U4_idnt={-1,0,0,"U4",0,0};
3561   const define_alias_gen(alias_U4_idnt,_IDNT,0,&ref_U4_idnt);
3562   const gen & U4_idnt = * (gen *) & alias_U4_idnt;
3563 
3564   const alias_ref_identificateur ref_u5_nm1={-1,0,0,"u5_nm1",0,0};
3565   const define_alias_gen(alias_u5_nm1,_IDNT,0,&ref_u5_nm1);
3566   const gen & u5_nm1 = * (gen *) & alias_u5_nm1;
3567   const alias_ref_identificateur ref_v5_nm2={-1,0,0,"v5_nm2",0,0};
3568   const define_alias_gen(alias_v5_nm2,_IDNT,0,&ref_v5_nm2);
3569   const gen & v5_nm2 = * (gen *) & alias_v5_nm2;
3570   const alias_ref_identificateur ref_U5_idnt={-1,0,0,"U5",0,0};
3571   const define_alias_gen(alias_U5_idnt,_IDNT,0,&ref_U5_idnt);
3572   const gen & U5_idnt = * (gen *) & alias_U5_idnt;
3573 
3574   const alias_ref_identificateur ref_u6_nm1={-1,0,0,"u6_nm1",0,0};
3575   const define_alias_gen(alias_u6_nm1,_IDNT,0,&ref_u6_nm1);
3576   const gen & u6_nm1 = * (gen *) & alias_u6_nm1;
3577   const alias_ref_identificateur ref_v6_nm2={-1,0,0,"v6_nm2",0,0};
3578   const define_alias_gen(alias_v6_nm2,_IDNT,0,&ref_v6_nm2);
3579   const gen & v6_nm2 = * (gen *) & alias_v6_nm2;
3580   const alias_ref_identificateur ref_U6_idnt={-1,0,0,"U6",0,0};
3581   const define_alias_gen(alias_U6_idnt,_IDNT,0,&ref_U6_idnt);
3582   const gen & U6_idnt = * (gen *) & alias_U6_idnt;
3583 
3584   const alias_ref_identificateur ref_u7_nm1={-1,0,0,"u7_nm1",0,0};
3585   const define_alias_gen(alias_u7_nm1,_IDNT,0,&ref_u7_nm1);
3586   const gen & u7_nm1 = * (gen *) & alias_u7_nm1;
3587   const alias_ref_identificateur ref_v7_nm2={-1,0,0,"v7_nm2",0,0};
3588   const define_alias_gen(alias_v7_nm2,_IDNT,0,&ref_v7_nm2);
3589   const gen & v7_nm2 = * (gen *) & alias_v7_nm2;
3590   const alias_ref_identificateur ref_U7_idnt={-1,0,0,"U7",0,0};
3591   const define_alias_gen(alias_U7_idnt,_IDNT,0,&ref_U7_idnt);
3592   const gen & U7_idnt = * (gen *) & alias_U7_idnt;
3593 
3594   const alias_ref_identificateur ref_u8_nm1={-1,0,0,"u8_nm1",0,0};
3595   const define_alias_gen(alias_u8_nm1,_IDNT,0,&ref_u8_nm1);
3596   const gen & u8_nm1 = * (gen *) & alias_u8_nm1;
3597   const alias_ref_identificateur ref_v8_nm2={-1,0,0,"v8_nm2",0,0};
3598   const define_alias_gen(alias_v8_nm2,_IDNT,0,&ref_v8_nm2);
3599   const gen & v8_nm2 = * (gen *) & alias_v8_nm2;
3600   const alias_ref_identificateur ref_U8_idnt={-1,0,0,"U8",0,0};
3601   const define_alias_gen(alias_U8_idnt,_IDNT,0,&ref_U8_idnt);
3602   const gen & U8_idnt = * (gen *) & alias_U8_idnt;
3603 
3604   const alias_ref_identificateur ref_u9_nm1={-1,0,0,"u9_nm1",0,0};
3605   const define_alias_gen(alias_u9_nm1,_IDNT,0,&ref_u9_nm1);
3606   const gen & u9_nm1 = * (gen *) & alias_u9_nm1;
3607   const alias_ref_identificateur ref_v9_nm2={-1,0,0,"v9_nm2",0,0};
3608   const define_alias_gen(alias_v9_nm2,_IDNT,0,&ref_v9_nm2);
3609   const gen & v9_nm2 = * (gen *) & alias_v9_nm2;
3610   const alias_ref_identificateur ref_U9_idnt={-1,0,0,"U9",0,0};
3611   const define_alias_gen(alias_U9_idnt,_IDNT,0,&ref_U9_idnt);
3612   const gen & U9_idnt = * (gen *) & alias_U9_idnt;
3613 
3614 #endif
3615 
has_Un(const gen & g)3616   int has_Un(const gen & g){
3617     vecteur l(lvar(g));
3618     for (unsigned i=0;i<l.size();++i){
3619       if (l[i].type==_IDNT){
3620 	const char * s=l[i]._IDNTptr->id_name;
3621 	if (strlen(s)==2 && s[0]=='U' && s[1]>='0' && s[1]<='9')
3622 	  return s[1]-'0';
3623       }
3624     }
3625     return -1;
3626   }
3627 
seqapp_lop_of(const gen & g,vecteur & res)3628   static void seqapp_lop_of(const gen & g,vecteur & res){
3629     vecteur vof(lop(g,at_of));
3630     const_iterateur it=vof.begin(),itend=vof.end();
3631     for (;it!=itend;++it){
3632       gen & f=it->_SYMBptr->feuille;
3633       if (f.type!=_VECT || f._VECTptr->size()!=2 || f._VECTptr->front().type!=_IDNT)
3634 	continue;
3635       if (f._VECTptr->back().type==_SYMB)
3636 	seqapp_lop_of(f._VECTptr->back(),res);
3637       res.push_back(*it);
3638     }
3639   }
3640 
is_n_minus_one_or_two(const gen & arg)3641   int is_n_minus_one_or_two(const gen & arg){
3642     if (arg.type!=_SYMB)
3643       return 0;
3644     if (arg._SYMBptr->feuille.type==_VECT && arg._SYMBptr->feuille._VECTptr->size()==2){
3645       gen a1=arg._SYMBptr->feuille._VECTptr->front();
3646       gen a2=arg._SYMBptr->feuille._VECTptr->back();
3647       if (a1.type==_IDNT && !strcmp(a1._IDNTptr->id_name,"N")){
3648 	if (arg._SYMBptr->sommet==at_plus){
3649 	  if (a2==-1) return 1;
3650 	  if (a2==-2) return 2;
3651 	}
3652 	if (arg._SYMBptr->sommet==at_binary_minus){
3653 	  if (a2==1) return 1;
3654 	  if (a2==2) return 2;
3655 	}
3656       }
3657     }
3658     return 0;
3659   }
3660 
3661   // Prepares app sequence for computing a recurrence relation
3662   // Valid if 1 sequence is checked and does not depend on other sequences
3663   // Given expr_un, the expression of UK(N) in terms of UK(N-1) and UK(N-2)
3664   // write the recurrence relation as UK(N)=subst(expr,vars,[N,UK(N-1),UK(N-2)])
3665   // Return 0 or -10-val if expr_un is invalid or depends on Uval,
3666   // 1 if it does not depend on UK(N-2)
3667   // 3 if not recurrent
3668   // 2 otherwise
seqapp_prepare(const gen & expr_un,gen & expr,vecteur & vars,GIAC_CONTEXT,int seqno)3669   int seqapp_prepare(const gen & expr_un,gen & expr,vecteur & vars,GIAC_CONTEXT,int seqno){
3670     if (has_Un(expr_un)!=-1)
3671       return 0;
3672     vecteur vof; seqapp_lop_of(expr_un,vof); // (lop(expr_un,at_of));
3673     // check functions with names in U0-U9
3674     int s=int(vof.size()),retval=1;
3675     gen uk(vx_var);
3676     bool notrecurrent=true;
3677     for (int i=0;i<s;++i){
3678       gen & f=vof[i]._SYMBptr->feuille;
3679       if (f.type!=_VECT || f._VECTptr->size()!=2 || f._VECTptr->front().type!=_IDNT)
3680 	continue;
3681       gen & id=f._VECTptr->front();
3682       const char * idname=id._IDNTptr->id_name;
3683       if (strlen(idname)!=2 || idname[0]!='U' || idname[1]<'0' || idname[1]>'9')
3684 	continue;
3685       notrecurrent=false;
3686       uk=id;
3687       if (seqno==-1){
3688 	seqno=idname[1]-'0';
3689       }
3690       else {
3691 	if (seqno!=idname[1]-'0')
3692 	  return -10-(idname[1]-'0');
3693       }
3694       gen & arg=f._VECTptr->back();
3695 #if 1
3696       int test=is_n_minus_one_or_two(arg);
3697       if (!test)
3698 	return 0;
3699       if (test==2)
3700 	retval=2;
3701 #else
3702       if (arg!=n__IDNT_e-1 && arg!=n__IDNT_e-2)
3703 	return 0;
3704       if (arg==n__IDNT_e-2)
3705 	retval=2;
3706 #endif
3707     }
3708     identificateur uk_nm1_("uk_nm1"),uk_nm2_("uk_nm2");
3709     gen uk_nm1(uk_nm1_),uk_nm2(uk_nm2_);
3710     vecteur vars0(makevecteur(n__IDNT_e,symb_of(uk,n__IDNT_e-1),symb_of(uk,n__IDNT_e-2)));
3711     vars=makevecteur(nsymbolic,uk_nm1,uk_nm2);
3712     expr=subst(expr_un,vars0,vars,true,contextptr);
3713     /* additional checking disabled
3714     vecteur lv(makevecteur(uk_nm1,uk_nm2));
3715     lidnt(expr,lv);
3716     s=lv.size();
3717     for (int i=2;i<s;++i){
3718       gen & g =lv[i];
3719       if (g.type!=_IDNT)
3720 	return 0;
3721       if (strlen(g._IDNTptr->id_name)>1)
3722 	return 0;
3723       if (g._IDNTptr->id_name[0]<'A' || g._IDNTptr->id_name[0]>'Z')
3724 	return 0;
3725     }
3726     */
3727     return notrecurrent?3:retval;
3728   }
3729 
3730   // Compute UK(N) for K=k to m, where UK(k) and UK(k+1) are given
3731   // If the recurrence relation does not depend on UK(N-2), set UK(k+1) to undef
seqapp_compute(const gen & expr0,const vecteur & vars,const gen & UK_k,const gen & UK_kp1,int k,int m,GIAC_CONTEXT)3732   vecteur seqapp_compute(const gen & expr0,const vecteur & vars,const gen & UK_k,const gen &UK_kp1,int k,int m,GIAC_CONTEXT){
3733     gen f1f9(lidnt_function38(expr0));
3734     gen f1f9value=eval(f1f9,1,contextptr);
3735     gen expr(expr0);
3736     if (f1f9.type==_VECT && !f1f9._VECTptr->empty())
3737       expr=subst(expr0,f1f9,f1f9value,true,contextptr);
3738     gen UK_nm2(UK_k),UK_nm1(UK_kp1),tmp;
3739     if (is_undef(UK_k))// also compute UK_n
3740       UK_nm2=subst(expr,vars,makevecteur(k,UK_k,undef),false,contextptr);
3741     if (is_undef(UK_kp1))// compute UK_np1
3742       UK_nm1=subst(expr,vars,makevecteur(k+1,UK_k,undef),false,contextptr);
3743     UK_nm1=evalf(UK_nm1,1,contextptr);
3744     if (UK_nm1.type>_REAL && UK_nm1.type!=_FLOAT_)
3745       UK_nm1=undef;
3746     UK_nm2=evalf(UK_nm2,1,contextptr);
3747     if (UK_nm2.type>_REAL && UK_nm2.type!=_FLOAT_)
3748       UK_nm2=undef;
3749     vecteur res(makevecteur(UK_nm2,UK_nm1));
3750     for (int n=k+2;n<=m;++n){
3751       tmp=subst(expr,vars,makevecteur(n,UK_nm1,UK_nm2),false,contextptr);
3752       tmp=evalf(tmp,1,contextptr);
3753       if (tmp.type>_REAL && tmp.type!=_FLOAT_)
3754 	res.push_back(undef);
3755       else
3756 	res.push_back(tmp);
3757       UK_nm2=UK_nm1;
3758       UK_nm1=tmp;
3759     }
3760     return res;
3761   }
3762 
3763 
3764 
3765   // Prepares app sequence for computing all recurrences relations
3766   // expr_un should contain the expression for U0(N) to UK(N) for K<=9
3767   // undef may be used if the sequence is not checked
3768   // Rewrite the recurrence relation as [U0(N),...,UK(N)]=subst(expr,vars,[N,U0(N-1),U0(N-2),...])
3769   // Return 0 if expr_un is invalid, -10-val if Uval should be checked
3770   // Return 1 if it does not depend on UK(N-2), 3 if not recurrent, 2 otherwise
seqapp_prepare(const vecteur & expr_un,vecteur & expr,vecteur & vars,GIAC_CONTEXT)3771   int seqapp_prepare(const vecteur & expr_un,vecteur & expr,vecteur & vars,GIAC_CONTEXT){
3772     int dim=int(expr_un.size());
3773     if (has_Un(expr_un)!=-1)
3774       return 0;
3775     vecteur vof; seqapp_lop_of(expr_un,vof); // (lop(expr_un,at_of));
3776     vector<int> defined_seqs;
3777     for (unsigned i=0;i<expr_un.size();++i){
3778       if (!is_undef(expr_un[i]))
3779 	defined_seqs.push_back(i); // allowed sequences numbers (starts with U0, not U1)
3780     }
3781     // check functions with names in U0-U9
3782     int s=int(vof.size()),retval=3;
3783     gen uk;
3784     for (int i=0;i<s;++i){
3785       gen & f=vof[i]._SYMBptr->feuille;
3786       if (f.type!=_VECT || f._VECTptr->size()!=2 || f._VECTptr->front().type!=_IDNT)
3787 	continue;
3788       gen & id=f._VECTptr->front();
3789       const char * idname=id._IDNTptr->id_name;
3790       if (strlen(idname)!=2 || idname[0]!='U' || idname[1]<'0' || idname[1]>'9')
3791 	continue;
3792       int val=idname[1]-'0';
3793       if (!equalposcomp(defined_seqs,val))
3794 	return -val-10;
3795       gen & arg=f._VECTptr->back();
3796 #if 1
3797       int test=is_n_minus_one_or_two(arg);
3798       if (!test)
3799 	return 0;
3800       if (test==2)
3801 	retval=2;
3802       else {
3803 	if (retval!=2)
3804 	  retval=1;
3805       }
3806 #else
3807       if (arg!=n__IDNT_e-1 && arg!=n__IDNT_e-2)
3808 	return 0;
3809       if (arg==n__IDNT_e-2)
3810 	retval=2;
3811       else {
3812 	if (retval!=2)
3813 	  retval=1;
3814       }
3815 #endif
3816     }
3817     vecteur vars0(1,n__IDNT_e); vars=vecteur(1,nsymbolic);
3818     vecteur tab_uk(30);
3819     tab_uk[0]=u0_nm1; // (identificateur("u0_nm1"));
3820     tab_uk[1]=v0_nm2; // (identificateur("v0_nm2"));
3821     tab_uk[2]=U0_idnt; // (identificateur("U0"));
3822     tab_uk[3]=u1_nm1; // (identificateur("u1_nm1"));
3823     tab_uk[4]=v1_nm2; // (identificateur("v1_nm2"));
3824     tab_uk[5]=U1_idnt; // (identificateur("U1"));
3825     tab_uk[6]=u2_nm1; // (identificateur("u2_nm1"));
3826     tab_uk[7]=v2_nm2; // (identificateur("v2_nm2"));
3827     tab_uk[8]=U2_idnt; // (identificateur("U2"));
3828     tab_uk[9]=u3_nm1; // (identificateur("u3_nm1"));
3829     tab_uk[10]=v3_nm2; // (identificateur("v3_nm2"));
3830     tab_uk[11]=U3_idnt; // (identificateur("U3"));
3831     tab_uk[12]=u4_nm1; // (identificateur("u4_nm1"));
3832     tab_uk[13]=v4_nm2; // (identificateur("v4_nm2"));
3833     tab_uk[14]=U4_idnt; // (identificateur("U4"));
3834     tab_uk[15]=u5_nm1; // (identificateur("u5_nm1"));
3835     tab_uk[16]=v5_nm2; // (identificateur("v5_nm2"));
3836     tab_uk[17]=U5_idnt; // (identificateur("U5"));
3837     tab_uk[18]=u6_nm1; // (identificateur("u6_nm1"));
3838     tab_uk[19]=v6_nm2; // (identificateur("v6_nm2"));
3839     tab_uk[20]=U6_idnt; // (identificateur("U6"));
3840     tab_uk[21]=u7_nm1; // (identificateur("u7_nm1"));
3841     tab_uk[22]=v7_nm2; // (identificateur("v7_nm2"));
3842     tab_uk[23]=U7_idnt; // (identificateur("U7"));
3843     tab_uk[24]=u8_nm1; // (identificateur("u8_nm1"));
3844     tab_uk[25]=v8_nm2; // (identificateur("v8_nm2"));
3845     tab_uk[26]=U8_idnt; // (identificateur("U8"));
3846     tab_uk[27]=u9_nm1; // (identificateur("u9_nm1"));
3847     tab_uk[28]=v9_nm2; // (identificateur("v9_nm2"));
3848     tab_uk[29]=U9_idnt; // (identificateur("U9"));
3849     gen n_minus_1=n__IDNT_e-1;
3850     for (int i=0;i<dim;++i){
3851       gen uk=tab_uk[3*i+2];
3852       vars0.push_back(new_ref_symbolic(symbolic(at_of,makenewvecteur(uk,n_minus_1))));
3853       vars.push_back(tab_uk[3*i]);
3854     }
3855     gen n_minus_2=n__IDNT_e-2;
3856     for (int i=0;i<dim;++i){
3857       gen uk=tab_uk[3*i+2];
3858       vars0.push_back(new_ref_symbolic(symbolic(at_of,makenewvecteur(uk,n_minus_2))));
3859       vars.push_back(tab_uk[3*i+1]);
3860     }
3861     expr=subst(expr_un,vars0,vars,true,contextptr);
3862     /* additional checking disabled
3863     vecteur lv(vars);
3864     lidnt(expr,lv);
3865     s=lv.size();
3866     for (int i=vars.size();i<s;++i){
3867       gen & g =lv[i];
3868       if (is_undef(g)) continue;
3869       if (g.type!=_IDNT)
3870 	return 0;
3871       if (strlen(g._IDNTptr->id_name)>1)
3872 	return 0;
3873       if (g._IDNTptr->id_name[0]<'A' || g._IDNTptr->id_name[0]>'Z')
3874 	return 0;
3875     }
3876     */
3877     return retval;
3878   }
3879 
3880 
3881   // Compute UK(N) for K=k to m, where UK(k) and UK(k+1) are given
3882   // If the recurrence relation does not depend on UK(N-2), set UK_kp1 to vecteur(0)
seqapp_compute(const vecteur & expr0,const vecteur & vars,const vecteur & UK_k,const vecteur & UK_kp1,int k,int m,GIAC_CONTEXT)3883   vecteur seqapp_compute(const vecteur & expr0,const vecteur & vars,const vecteur & UK_k,const vecteur &UK_kp1,int k,int m,GIAC_CONTEXT){
3884     gen f1f9(lidnt_function38(expr0));
3885     gen f1f9value=eval(f1f9,1,contextptr);
3886     vecteur expr(expr0);
3887     if (f1f9.type==_VECT && !f1f9._VECTptr->empty()){
3888       iterateur it=expr.begin(),itend=expr.end();
3889       for (;it!=itend;++it){
3890 	*it = subst(*it,f1f9,f1f9value,true,contextptr);
3891       }
3892     }
3893     int dim=int(expr.size());
3894     vecteur UK_nm2(UK_k),UK_nm1(UK_kp1),tmp(dim);
3895     vecteur vals(2*dim+1);
3896     if (UK_k.empty()){// compute UK_n
3897       vals[0]=k;
3898       for (int i=0;i<dim;++i){
3899 	vals[i+1]=undef;
3900       }
3901       for (int i=0;i<dim;++i)
3902 	vals[dim+i+1]=undef;
3903       UK_nm2=gen2vecteur(subst(expr,vars,vals,false,contextptr));
3904     }
3905     if (dim!=int(UK_nm2.size()))
3906       return vecteur(dim,gendimerr(contextptr));
3907     if (UK_kp1.empty()){// compute UK_np1
3908       vals[0]=k+1;
3909       for (int i=0;i<dim;++i){
3910 	vals[i+1]=UK_nm2[i];
3911       }
3912       for (int i=0;i<dim;++i)
3913 	vals[dim+i+1]=undef;
3914       UK_nm1=subst(expr,vars,vals,false,contextptr);
3915     }
3916     gen tmpU=evalf(UK_nm2,1,contextptr);
3917     if (tmpU.type!=_VECT)
3918       return vecteur(dim,gendimerr(contextptr));
3919     UK_nm2=*tmpU._VECTptr;
3920     tmpU=evalf(UK_nm1,1,contextptr);
3921     if (tmpU.type!=_VECT)
3922       return vecteur(dim,gendimerr(contextptr));
3923     UK_nm1=*tmpU._VECTptr;
3924     vecteur res(makevecteur(UK_nm2,UK_nm1));
3925     res.reserve(m-k+1);
3926     for (int n=k+2;n<=m;++n){
3927       vals[0]=n;
3928       for (int i=0;i<dim;++i){
3929 	vals[i+1]=UK_nm1[i];
3930       }
3931       for (int i=0;i<dim;++i){
3932 	vals[dim+i+1]=UK_nm2[i];
3933       }
3934       vecteur::const_iterator it=expr.begin(),itend=expr.end();
3935       for (int i=0;it!=itend;++it,++i)
3936 	tmp[i]=is_undef(*it)?*it:evalf(sortsubst(*it,vars,vals,false,contextptr),1,contextptr);
3937       res.push_back(tmp);
3938       UK_nm2=UK_nm1;
3939       UK_nm1=tmp;
3940     }
3941     return res;
3942   }
3943 
_tests(const gen & g0,GIAC_CONTEXT)3944   gen _tests(const gen & g0,GIAC_CONTEXT){
3945     // return eval_before_diff(g0,vx_var,contextptr);
3946     if (g0.type==_VECT){
3947       vecteur expr,vars;
3948       if (g0.subtype==_SEQ__VECT && g0._VECTptr->front().type==_VECT && g0._VECTptr->size()==3){
3949 	int i=seqapp_prepare(*g0._VECTptr->front()._VECTptr,expr,vars,contextptr);
3950 	if (i<0)
3951 	  return gensizeerr(contextptr);
3952 	gen g01=(*g0._VECTptr)[1];
3953 	gen g02=(*g0._VECTptr)[2];
3954 	vecteur v2;
3955 	if (i==2 && g02.type==_VECT)
3956 	  v2=*g02._VECTptr;
3957 	if (g01.type==_VECT)
3958 	  return seqapp_compute(expr,vars,*g01._VECTptr,v2,0,20,contextptr);
3959       }
3960       int i=seqapp_prepare(*g0._VECTptr,expr,vars,contextptr);
3961       if (i<0)
3962 	return gensizeerr(contextptr);
3963       return seqapp_compute(expr,vars,vecteur(expr.size(),1.0),i==1?vecteur(0):vecteur(expr.size(),2.0),0,20,contextptr);
3964     }
3965     gen expr; vecteur vars;
3966     int i=seqapp_prepare(g0,expr,vars,contextptr);
3967     if (!i)
3968       return undef;
3969     return seqapp_compute(expr,vars,1.0,i==1?undef:2.0,0,20,contextptr);
3970   }
3971   static const char _tests_s[]="tests";
3972   static define_unary_function_eval(__tests,&_tests,_tests_s);
3973   define_unary_function_ptr5( at_tests ,alias_at_tests,&__tests,0,T_UNARY_OP);
3974 
_CHOOSE(const gen & args,GIAC_CONTEXT)3975   gen _CHOOSE(const gen & args,GIAC_CONTEXT){
3976     if ( args.type==_STRNG &&  args.subtype==-1) return  args;
3977     if (args.type!=_VECT || args._VECTptr->size()<3)
3978       return gentypeerr(contextptr);
3979     vecteur v = *args._VECTptr;
3980     if (v[0].is_symb_of_sommet(at_double_deux_points) && v[0]._SYMBptr->feuille.type==_VECT && v[0]._SYMBptr->feuille._VECTptr->size()==2)
3981       v[0]=v[0]._SYMBptr->feuille._VECTptr->back();
3982     for (int i=1; i<=1; i++) { if (v[i].type!=_STRNG) v[i]= eval(v[i], 1, contextptr); if (v[i].type!=_STRNG) v[i]=  string2gen(v[i].print(contextptr)); }
3983     if (v.front().type!=_IDNT || v[1].type!=_STRNG)
3984       return gentypeerr(contextptr);
3985 #if defined NSPIRE || defined FXCG
3986     return undef;
3987 #else
3988 #ifndef GIAC_HAS_STO_38
3989     vecteur res(3);
3990     res[2]=v[0];
3991     res[0]=v[1];
3992     vecteur tmp;
3993     for (unsigned i=2;i<v.size();i++)
3994       tmp.push_back(eval(v[i],1,contextptr));
3995     res[1]=tmp;
3996     return __inputform.op(symbolic(at_choosebox,gen(res,_SEQ__VECT)),contextptr);
3997 #endif
3998 #endif
3999     return undef;
4000   }
4001   static const char _CHOOSE_s []="CHOOSE";
4002   static define_unary_function_eval_quoted (__CHOOSE,&_CHOOSE,_CHOOSE_s);
4003   define_unary_function_ptr5( at_CHOOSE ,alias_at_CHOOSE,&__CHOOSE,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
4004 
4005 
4006 
4007 #if 0 // def GIAC_HAS_STO_38
4008   // encoding is up to 8 nibbles with various values...
4009   // 1 optional graphic name
4010   // 2 graphic name
4011   // 3 coordinate pair
4012   // 4 optional coordinate pair
4013   // 5 color
4014   // 6 optional color
4015   // 7 integer
4016   // 8 boolean
4017   // 9 graphic name, return the adresses'adress and does not allow G0!!!
4018   // a: angle
4019   // b: optional integer
4020   // c: w/h based on 0/0
4021   // 0x631 means : optional graphic name, coordinate pair, optional color
4022 
4023 #define CyrilleFnc(n)   static const char _##n##_s []= #n;  static define_unary_function_eval_quoted (__##n,&giac::_##n,_##n##_s); define_unary_function_ptr5( at_##n ,alias_at_##n,&__##n,0,T_UNARY_OP_38);
4024   gen _FREEZE(const gen & args,GIAC_CONTEXT)
4025   {
4026     dofreeze();
4027     return 1;
4028   }
4029   CyrilleFnc(FREEZE);
4030 
4031   gen _GETPIX(const gen & args,GIAC_CONTEXT)
4032   {
4033     void *g=0; int xy[2];
4034     if (!GraphicVerifInputs(args, &g, xy, 0x31, NULL, contextptr)) return gensizeerr(contextptr);
4035     return gen(dogetpix(g, xy[0], xy[1]));
4036   }
4037   CyrilleFnc(GETPIX);
4038 
4039   gen _LINE(const gen & args,GIAC_CONTEXT)
4040   {
4041     void *g=0; int xy[4], c= 0;
4042     if (!GraphicVerifInputs(args, &g, xy, 0x6331, &c, contextptr)) return gensizeerr(contextptr);
4043     doline(g, xy[0], xy[1], xy[2], xy[3], c);
4044     return 1;
4045   }
4046   CyrilleFnc(LINE);
4047 
4048   gen _RECT(const gen & args,GIAC_CONTEXT)
4049   {
4050     void *g=0; int xy[4]= {0, 0, 0x0fffffff,0x0fffffff}, c[2]= { 3, -1};
4051     if (!GraphicVerifInputs(args, &g, xy, 0x66441, c, contextptr)) return gensizeerr(contextptr);
4052     if (c[1]==-1) c[1]= c[0];
4053     dorect(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1, c[0], c[1]);
4054     return 1;
4055   }
4056   CyrilleFnc(RECT);
4057 
4058   gen _INVERT(const gen & args,GIAC_CONTEXT)
4059   {
4060     void *g=0; int xy[4]= {0, 0, 0x0fffffff, 0x0fffffff };
4061     if (!GraphicVerifInputs(args, &g, xy, 0x441, NULL, contextptr)) return gensizeerr(contextptr);
4062     doinvert(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1);
4063     return 1;
4064   }
4065   CyrilleFnc(INVERT);
4066 
4067   gen _BLIT(const gen & args,GIAC_CONTEXT)
4068   {
4069     void *g[2]={0,0}; int xy[8]= { 0, 0, 0xfffffff, 0xfffffff, 0, 0, 0xfffffff, 0xfffffff }, c= -1;
4070     if (!GraphicVerifInputs(args, g, xy, 0x6442431, NULL, contextptr)) return gensizeerr(contextptr);
4071     xy[3]+= -xy[1]+1; if (xy[3]<0) xy[3]= -2-xy[3];
4072     xy[7]+= -xy[5]+1; if (xy[7]<0) xy[7]= -2-xy[7];
4073     doblit(g[0], xy[0], xy[1], xy[2]-xy[0]+1, xy[3], g[1], xy[4], xy[5], xy[6]-xy[4]+1, xy[7], c);
4074     return 1;
4075   }
4076   CyrilleFnc(BLIT);
4077   gen _TEXTOUT(const gen &args, GIAC_CONTEXT)
4078   {
4079     if (args.type!=_VECT) return gensizeerr(contextptr);
4080     int s= args._VECTptr->size();
4081     if (s<3) return gensizeerr(contextptr);
4082     gen t= *args._VECTptr->begin();
4083     gen v(*args._VECTptr); v._VECTptr->erase(v._VECTptr->begin());
4084     void *g=0; int xy[2]={0, 0}, c[4]= {0, 0, 1023, -1};
4085     //TEXTOUT("text", [G?], x, y, [font, [color, [width, [color]]]])
4086     if (!GraphicVerifInputs(v, &g, xy, 0x6b6b31, c, contextptr)) return gensizeerr(contextptr);
4087     return gen(dotextout(&t, g, xy, c, contextptr));
4088   }
4089   CyrilleFnc(TEXTOUT);
4090 
4091   gen _PIXON(const gen & args,GIAC_CONTEXT){
4092     void *g=0; int xy[2], c= 0;
4093     if (!GraphicVerifInputs(args, &g, xy, 0x631, &c, contextptr)) return gensizeerr(contextptr);
4094     dopixon(g, xy[0], xy[1], c);
4095     return 1;
4096   }
4097 
4098   gen _PIXOFF(const gen & args,GIAC_CONTEXT){
4099     void *g=0; int xy[2];
4100     if (!GraphicVerifInputs(args, &g, xy, 0x31, NULL, contextptr)) return gensizeerr(contextptr);
4101     dopixon(g, xy[0], xy[1], 3);
4102     return 1;
4103   }
4104   gen _DIMGROB(const gen &args,GIAC_CONTEXT)
4105   {
4106     void *g=0; int xy[2], c= 3;
4107     if (!GraphicVerifInputs(args, &g, xy, 0x6c9, &c, contextptr)) return gensizeerr(contextptr);
4108     dodimgrob((void**)g, xy[0], xy[1], c, gen());
4109     return 1;
4110   }
4111   CyrilleFnc(DIMGROB);
4112   gen _SUBGROB(const gen &args,GIAC_CONTEXT)
4113   {
4114     void *g[2]={0,0}; int xy[4]= {0, 0, 0xfffffff, 0xfffffff};
4115     if (!GraphicVerifInputs(args, g, xy, 0x9441, NULL, contextptr)) return gensizeerr(contextptr);
4116     dosubgrob(g, xy);
4117     return 1;
4118   }
4119   CyrilleFnc(SUBGROB);
4120   gen _ARC(const gen & args,GIAC_CONTEXT)
4121   {
4122     ///< draws a circle, or an arc between a1 and a2. full circle is 4096...
4123     // if OldColor is !=-1 and indiate the background color of the screen BEFORE the arc is drawn, the arc is filled...
4124     //int Arc(int x, int y, int r, int color, int a1=0, int a2=4096, int OldColor=-1);
4125     // ARC(x, y, r, [c, [a1, a2]])
4126     void *g=0; int xy[2], c[4]= { 0, 0, 0, 4096};
4127     if (!GraphicVerifInputs(args, &g, xy, 0xaab731, c, contextptr)) return gensizeerr(contextptr);
4128     doarc(g, true, xy, c);
4129     return 1;
4130   }
4131 
4132   gen _GETPIX_P(const gen & args,GIAC_CONTEXT)
4133   {
4134     void *g=0; int xy[2];
4135     if (!GraphicVerifInputs2(args, &g, xy, 0x31, NULL, true, contextptr)) return gensizeerr(contextptr);
4136     return gen(dogetpix(g, xy[0], xy[1]));
4137   }
4138   CyrilleFnc(GETPIX_P);
4139 
4140   gen _LINE_P(const gen & args,GIAC_CONTEXT)
4141   {
4142     void *g=0; int xy[4], c= 0;
4143     if (!GraphicVerifInputs2(args, &g, xy, 0x6331, &c, true, contextptr)) return gensizeerr(contextptr);
4144     doline(g, xy[0], xy[1], xy[2], xy[3], c);
4145     return 1;
4146   }
4147   CyrilleFnc(LINE_P);
4148 
4149   gen _RECT_P(const gen & args,GIAC_CONTEXT)
4150   {
4151     void *g=0; int xy[4]= {0, 0, 0x0fffffff,0x0fffffff}, c[2]= { 3, -1};
4152     if (!GraphicVerifInputs2(args, &g, xy, 0x66441, c, true, contextptr)) return gensizeerr(contextptr);
4153     if (c[1]==-1) c[1]= c[0];
4154     if (xy[0]>xy[2]) swap(xy[0], xy[2]);
4155     if (xy[1]>xy[3]) swap(xy[1], xy[3]);
4156     dorect(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1, c[0], c[1]);
4157     return 1;
4158   }
4159   CyrilleFnc(RECT_P);
4160 
4161   gen _INVERT_P(const gen & args,GIAC_CONTEXT)
4162   {
4163     void *g=0; int xy[4]= {0, 0, 0x0fffffff, 0x0fffffff };
4164     if (!GraphicVerifInputs2(args, &g, xy, 0x441, NULL, true, contextptr)) return gensizeerr(contextptr);
4165     doinvert(g, xy[0], xy[1], xy[2]-xy[0]+1, xy[3]-xy[1]+1);
4166     return 1;
4167   }
4168   CyrilleFnc(INVERT_P);
4169 
4170   gen _BLIT_P(const gen & args,GIAC_CONTEXT)
4171   {
4172     void *g[2]={0,0}; int xy[8]= { 0, 0, 0xfffffff, 0xfffffff, 0, 0, 0xfffffff, 0xfffffff }, c= -1;
4173     if (!GraphicVerifInputs2(args, g, xy, 0x6442431, NULL, true, contextptr)) return gensizeerr(contextptr);
4174     xy[3]+= -xy[1]+1; if (xy[3]<0) xy[3]= -2-xy[3];
4175     xy[7]+= -xy[5]+1; if (xy[7]<0) xy[7]= -2-xy[7];
4176     doblit(g[0], xy[0], xy[1], xy[2]-xy[0]+1, xy[3], g[1], xy[4], xy[5], xy[6]-xy[4]+1, xy[7], c);
4177     return 1;
4178   }
4179   CyrilleFnc(BLIT_P);
4180   gen _TEXTOUT_P(const gen &args, GIAC_CONTEXT)
4181   {
4182     if (args.type!=_VECT) return gensizeerr(contextptr);
4183     int s= args._VECTptr->size();
4184     if (s<3) return gensizeerr(contextptr);
4185     gen t= *args._VECTptr->begin();
4186     gen v(*args._VECTptr); v._VECTptr->erase(v._VECTptr->begin());
4187     void *g=0; int xy[2]={0, 0}, c[4]= {0, 0, 1023, -1};
4188     //TEXTOUT("text", [G?], x, y, [font, [color, [width, [color]]]])
4189     if (!GraphicVerifInputs2(v, &g, xy, 0x6b6b31, c, true, contextptr)) return gensizeerr(contextptr);
4190     return gen(dotextout(&t, g, xy, c, contextptr));
4191   }
4192   CyrilleFnc(TEXTOUT_P);
4193   gen _PIXON_P(const gen & args,GIAC_CONTEXT)
4194   {
4195     void *g=0; int xy[2], c= 0;
4196     if (!GraphicVerifInputs2(args, &g, xy, 0x631, &c, true, contextptr)) return gensizeerr(contextptr);
4197     dopixon(g, xy[0], xy[1], c);
4198     return 1;
4199   }
4200   CyrilleFnc(PIXON_P);
4201   gen _PIXOFF_P(const gen & args,GIAC_CONTEXT)
4202   {
4203     void *g=0; int xy[2];
4204     if (!GraphicVerifInputs2(args, &g, xy, 0x31, NULL, true, contextptr)) return gensizeerr(contextptr);
4205     dopixon(g, xy[0], xy[1], 3);
4206     return 1;
4207   }
4208   CyrilleFnc(PIXOFF_P);
4209   gen _DIMGROB_P(const gen &args,GIAC_CONTEXT)
4210   {
4211     void *g=0; int xy[2], c= 3;
4212     if (!GraphicVerifInputs2(args, &g, xy, 0x6c9, &c, false, contextptr)) return gensizeerr(contextptr);
4213     dodimgrob((void**)g, xy[0], xy[1], c, args._VECTptr->end()[-1]);
4214     return 1;
4215   }
4216   CyrilleFnc(DIMGROB_P);
4217   gen _SUBGROB_P(const gen &args,GIAC_CONTEXT)
4218   {
4219     void *g[2]={0,0}; int xy[4]= {0, 0, 0xfffffff, 0xfffffff};
4220     if (!GraphicVerifInputs2(args, g, xy, 0x9441, NULL, true, contextptr)) return gensizeerr(contextptr);
4221     dosubgrob(g, xy);
4222     return 1;
4223   }
4224   CyrilleFnc(SUBGROB_P);
4225   gen _ARC_P(const gen & args,GIAC_CONTEXT)
4226   {
4227     ///< draws a circle, or an arc between a1 and a2. full circle is 4096...
4228     // if OldColor is !=-1 and indiate the background color of the screen BEFORE the arc is drawn, the arc is filled...
4229     //int Arc(int x, int y, int r, int color, int a1=0, int a2=4096, int OldColor=-1);
4230     // ARC(x, y, r, [c, [a1, a2]])
4231     void *g=0; int xy[2], c[4]= { 0, 0, 0, 4096};
4232     if (!GraphicVerifInputs2(args, &g, xy, 0xaab731, c, true, contextptr)) return gensizeerr(contextptr);
4233     doarc(g, false, xy, c);
4234     return 1;
4235   }
4236   CyrilleFnc(ARC_P);
4237   gen _GROBW_P(const gen & args, GIAC_CONTEXT)
4238   {
4239     void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr);
4240     return gen(dogrobw(g));
4241   }
4242   CyrilleFnc(GROBW_P);
4243   gen _GROBH_P(const gen & args, GIAC_CONTEXT)
4244   {
4245     void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr);
4246     return gen(dogrobh(g, false));
4247   }
4248   CyrilleFnc(GROBH_P);
4249   gen _GROBW(const gen & args, GIAC_CONTEXT)
4250   {
4251     void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr);
4252     int w= dogrobw(g);
4253     return w*getxrangeperpixel();
4254   }
4255   CyrilleFnc(GROBW);
4256   gen _GROBH(const gen & args, GIAC_CONTEXT)
4257   {
4258     void *g=0; if (!GraphicVerifInputs(args, &g, NULL, 1, NULL, contextptr)) return gensizeerr(contextptr);
4259     int h= dogrobh(g, true);
4260     return h*getyrangeperpixel();
4261   }
4262   CyrilleFnc(GROBH);
4263 
4264   CyrilleFnc(ISKEYDOWN);
4265 
4266 #else
_ARC(const gen & args,GIAC_CONTEXT)4267   gen _ARC(const gen & args,GIAC_CONTEXT){
4268     if (args.type!=_VECT || args._VECTptr->size()!=5)
4269       return gensizeerr(contextptr);
4270     vecteur & v =*args._VECTptr;
4271     return _cercle(gen(makevecteur(v[0]+cst_i*v[1],v[2],v[3],v[4]),_SEQ__VECT),contextptr);
4272   }
_PIXON(const gen & args,GIAC_CONTEXT)4273   gen _PIXON(const gen & args,GIAC_CONTEXT){
4274     if (args.type!=_VECT || args._VECTptr->size()!=2)
4275       return gensizeerr(contextptr);
4276     vecteur & v =*args._VECTptr;
4277     return symb_pnt(v.front()+cst_i*v.back(),int(FL_BLACK),contextptr);
4278   }
_PIXOFF(const gen & args,GIAC_CONTEXT)4279   gen _PIXOFF(const gen & args,GIAC_CONTEXT){
4280     if (args.type!=_VECT || args._VECTptr->size()!=2)
4281       return gensizeerr(contextptr);
4282     vecteur & v =*args._VECTptr;
4283     return symb_pnt(v.front()+cst_i*v.back(),int(FL_WHITE),contextptr);
4284   }
_LINE(const gen & args,GIAC_CONTEXT)4285   gen _LINE(const gen & args,GIAC_CONTEXT){
4286     if (args.type!=_VECT || args._VECTptr->size()!=4)
4287       return _droite(args,contextptr);
4288     vecteur & v =*args._VECTptr;
4289     return _droite(gen(makevecteur(v[0]+cst_i*v[1],v[2]+cst_i*v[3]),_SEQ__VECT),contextptr);
4290   }
4291   static const char _LINE_s []="LINE";
4292   static define_unary_function_eval (__LINE,&_LINE,_LINE_s);
4293   define_unary_function_ptr5( at_LINE ,alias_at_LINE,&__LINE,0,T_UNARY_OP_38);
4294 
_RECT(const gen & args,GIAC_CONTEXT)4295   gen _RECT(const gen & args,GIAC_CONTEXT){
4296     if (args.type!=_VECT || args._VECTptr->size()!=4)
4297       return _droite(args,contextptr);
4298     vecteur & v =*args._VECTptr;
4299     gen a=v[0],b=v[1],c=v[2],d=v[3];
4300     if (is_greater(a,c,contextptr))
4301       swapgen(a,c);
4302     if (is_greater(b,d,contextptr))
4303       swapgen(b,d);
4304     gen e=a+b*cst_i,f=c+b*cst_i,g=a+d*cst_i,h=c+d*cst_i;
4305     gen res=pnt_attrib(gen(makevecteur(e,f,h,g,e),_GROUP__VECT),vecteur(1,int(FL_BLACK)),contextptr);
4306     return res;
4307   }
4308   static const char _RECT_s []="RECT";
4309   static define_unary_function_eval (__RECT,&_RECT,_RECT_s);
4310   define_unary_function_ptr5( at_RECT ,alias_at_RECT,&__RECT,0,T_UNARY_OP_38);
4311 
4312 #endif
4313   static const char _PIXON_s []="PIXON";
4314   static define_unary_function_eval (__PIXON,&_PIXON,_PIXON_s);
4315   define_unary_function_ptr5( at_PIXON ,alias_at_PIXON,&__PIXON,0,T_UNARY_OP_38);
4316   static const char _PIXOFF_s []="PIXOFF";
4317   static define_unary_function_eval (__PIXOFF,&_PIXOFF,_PIXOFF_s);
4318   define_unary_function_ptr5( at_PIXOFF ,alias_at_PIXOFF,&__PIXOFF,0,T_UNARY_OP_38);
4319   static const char _ARC_s []="ARC";
4320   static define_unary_function_eval (__ARC,&_ARC,_ARC_s);
4321   define_unary_function_ptr5( at_ARC ,alias_at_ARC,&__ARC,0,T_UNARY_OP_38);
4322 
4323   static const char _PRINT_s []="PRINT";
4324   static define_unary_function_eval_quoted (__PRINT,&_print,_PRINT_s);
4325   define_unary_function_ptr5( at_PRINT ,alias_at_PRINT,&__PRINT,0,T_UNARY_OP_38);
4326 
4327   static const char _SEC_s []="SEC";
4328   static define_unary_function_eval (__SEC,&_sec,_SEC_s);
4329   define_unary_function_ptr5( at_SEC ,alias_at_SEC,&__SEC,0,T_UNARY_OP_38);
4330 
4331   static const char _CSC_s []="CSC";
4332   static define_unary_function_eval (__CSC,&_csc,_CSC_s);
4333   define_unary_function_ptr5( at_CSC ,alias_at_CSC,&__CSC,0,T_UNARY_OP_38);
4334 
4335   static const char _COT_s []="COT";
4336   static define_unary_function_eval (__COT,&_cot,_COT_s);
4337   define_unary_function_ptr5( at_COT ,alias_at_COT,&__COT,0,T_UNARY_OP_38);
4338 
4339   static const char _ASEC_s []="ASEC";
4340   static define_unary_function_eval (__ASEC,&_asec,_ASEC_s);
4341   define_unary_function_ptr5( at_ASEC ,alias_at_ASEC,&__ASEC,0,T_UNARY_OP_38);
4342 
4343   static const char _ACSC_s []="ACSC";
4344   static define_unary_function_eval (__ACSC,&_acsc,_ACSC_s);
4345   define_unary_function_ptr5( at_ACSC ,alias_at_ACSC,&__ACSC,0,T_UNARY_OP_38);
4346 
4347   static const char _ACOT_s []="ACOT";
4348   static define_unary_function_eval (__ACOT,&_acot,_ACOT_s);
4349   define_unary_function_ptr5( at_ACOT ,alias_at_ACOT,&__ACOT,0,T_UNARY_OP_38);
4350 
_Celsius2Fahrenheit(const gen & g,GIAC_CONTEXT)4351   gen _Celsius2Fahrenheit(const gen & g,GIAC_CONTEXT){
4352     if (g.type==_VECT)
4353       return apply(g,_Celsius2Fahrenheit,contextptr);
4354     return (g*gen(9))/5+32;
4355   }
4356 #ifdef POCKETCAS
4357   static const char _Celsius2Fahrenheit_s []="CelsiusToFahrenheit";
4358 #else
4359   static const char _Celsius2Fahrenheit_s []="Celsius2Fahrenheit";
4360 #endif
4361   static define_unary_function_eval (__Celsius2Fahrenheit,&_Celsius2Fahrenheit,_Celsius2Fahrenheit_s);
4362   define_unary_function_ptr5( at_Celsius2Fahrenheit ,alias_at_Celsius2Fahrenheit,&__Celsius2Fahrenheit,0,T_UNARY_OP);
4363 
_Fahrenheit2Celsius(const gen & g,GIAC_CONTEXT)4364   gen _Fahrenheit2Celsius(const gen & g,GIAC_CONTEXT){
4365     if (g.type==_VECT)
4366       return apply(g,_Fahrenheit2Celsius,contextptr);
4367     return (g-32)*gen(5)/9;
4368   }
4369 #ifdef POCKETCAS
4370   static const char _Fahrenheit2Celsius_s []="FahrenheitToCelsius";
4371 #else
4372   static const char _Fahrenheit2Celsius_s []="Fahrenheit2Celsius";
4373 #endif
4374   static define_unary_function_eval (__Fahrenheit2Celsius,&_Fahrenheit2Celsius,_Fahrenheit2Celsius_s);
4375   define_unary_function_ptr5( at_Fahrenheit2Celsius ,alias_at_Fahrenheit2Celsius,&__Fahrenheit2Celsius,0,T_UNARY_OP);
4376 
4377   // put here function names that are in lowercase in giac and should be printed uppercase
4378   // on HP
4379   static const char * const display_in_maj[] ={
4380     "ABS",
4381     "ACOS",
4382     "ACOSH",
4383     "ACOT",
4384     "ACSC",
4385     //    "ADDCOL",
4386     // "ADDROW",
4387     // "ALOG",
4388     "AND",
4389     // "ARC",
4390     "ARG",
4391     "ASEC",
4392     "ASIN",
4393     "ASINH",
4394     "ATAN",
4395     "ATANH",
4396     "BINOMIAL",
4397     "BINOMIAL_CDF",
4398     "BINOMIAL_ICDF",
4399     "BITAND",
4400     // "BITNOT",
4401     "BITOR",
4402     "BITXOR",
4403     //"BREAK",
4404     "CEILING",
4405     "CFACTOR",
4406     "CHAR",
4407     "CHISQUARE",
4408     "CHISQUARE_CDF",
4409     "CHISQUARE_ICDF",
4410     //"CHOOSE",
4411     "COLNORM",
4412     "COMB",
4413     "CONCAT",
4414     // "COND",
4415     "CONJ",
4416     "COS",
4417     "COSH",
4418     "COT",
4419     "CROSS",
4420     "CSC",
4421     "CSOLVE",
4422     // "DEGXRAD",
4423     // "DELCOL",
4424     // "DELROW",
4425     "DET",
4426     "DIM",
4427     //"DISP",
4428     "DOT",
4429     // "EIGENVAL",
4430     // "EIGENVV",
4431     "EXP",
4432     // "EXPM1",
4433     // "EXPORT",
4434     "EXPR",
4435     "FLOOR",
4436     "FISHER",
4437     "FISHER_CDF",
4438     "FISHER_ICDF",
4439     "FLOOR",
4440     //"FNROOT",
4441     "FP",
4442     // "FREEZE",
4443     // "GETKEY",
4444     // "GF",
4445     //"HMSX",
4446     //"IDENMAT",
4447     "IM",
4448     // "INPUT",
4449     "IP",
4450     "INVERSE",
4451     // "ISOLATE",
4452     "ISPRIME",
4453     // "ITERATE",
4454     "LINE",
4455     // "LINEAR?",
4456     "LN",
4457     // "LNP1",
4458     "LOG",
4459     // "LQ",
4460     // "LSQ",
4461     "LU",
4462     //"MAKELIST",
4463     "MAKEMAT",
4464     // "MANT",
4465     "MAX",
4466     // "MAXREAL",
4467     "MID",
4468     "MIN",
4469     // "MINREAL",
4470     "MKSA",
4471 //    "MOD", // removed as cas has MOD and mod (operator and function)
4472     // "MSGBOX",
4473     "NEG",
4474     "NORMALD",
4475     "NORMALD_CDF",
4476     "NORMALD_ICDF",
4477     "NOT",
4478     // "NTHROOT",
4479     "OR",
4480     "PERM",
4481     "PI",
4482     "PIECEWISE",
4483     // "PIXOFF",
4484     // "PIXON",
4485     "POISSON",
4486     "POISSON_CDF",
4487     "POISSON_ICDF",
4488     // "POLYCOEF",
4489     // "POLYEVAL",
4490     // "POLYFORM",
4491     // "POLYROOT",
4492     // "POS",
4493     "PRINT",
4494     "QR",
4495     // "QUAD",
4496     "QUOTE",
4497     // "RADXDEG",
4498     //"RANDMAT",
4499     "RANDNORM",
4500     // "RANDOM",
4501     "RANDSEED",
4502     "RANK",
4503     "RE",
4504     // "RECURSE",
4505     // "REDIM",
4506     // "REPLACE",
4507     "RETURN",
4508     //"REVERSE",
4509     "RIGHT",
4510     "ROTATE",
4511     "ROUND",
4512     "ROWNORM",
4513     "RREF",
4514     // "SCALE",
4515     // "SCALEADD",
4516     // "SCHUR",
4517     "SEC",
4518     "SIGN",
4519     "SIN",
4520     "SINH",
4521     "SIZE",
4522     "SORT",
4523     // "SPECNORM",
4524     // "SPECRAD",
4525     "STRING",
4526     "STUDENT",
4527     "STUDENT_CDF",
4528     "STUDENT_ICDF",
4529     //"SUB",
4530     // "SVD",
4531     // "SVL",
4532     // "SWAPCOL",
4533     // "SWAPROW",
4534     "TAN",
4535     "TANH",
4536     "TAYLOR",
4537     "TCOLLECT",
4538     "TEXPAND",
4539     //"TRACE",
4540     "TRN",
4541     //"TRUNCATE",
4542     //"UTPC",
4543     //"UTPF",
4544     //"UTPN",
4545     //"UTPT",
4546     // "VIEWS",
4547     //"WAIT",
4548     // "XHMS",
4549     "XOR",
4550     // "XPON",
4551   };
4552 
4553   static const int display_in_maj_size=sizeof(display_in_maj)/sizeof(const char *);
4554 
4555   // check if a lowercase commandname should be uppercased
4556   static char maj_converted[16];
4557 
hp38_display_in_maj(const char * s)4558   char * hp38_display_in_maj(const char * s){
4559     int l=int(strlen(s));
4560     if (l>15)
4561       return 0;
4562     maj_converted[l]=0;
4563     for (int i=0;i<l;++i){
4564       maj_converted[i]=toupper(s[i]);
4565     }
4566     int beg=0,end=display_in_maj_size,cur,test;
4567     // string index is always >= begin and < end
4568     for (;;){
4569       cur=(beg+end)/2;
4570       test=strcmp(maj_converted,display_in_maj[cur]);
4571       if (!test)
4572 	return maj_converted;
4573       if (cur==beg){
4574 	return 0;
4575       }
4576       if (test>0)
4577 	beg=cur;
4578       else
4579 	end=cur;
4580     }
4581     return 0;
4582   }
4583 
_polar_complex(const gen & g,GIAC_CONTEXT)4584   gen _polar_complex(const gen & g,GIAC_CONTEXT){
4585     if (g.type==_STRNG && g.subtype==-1) return  g;
4586     if (g.type!=_VECT)
4587       return makevecteur(abs(g,contextptr),arg(g,contextptr));
4588     if (g._VECTptr->size()!=2)
4589       return gensizeerr(contextptr);
4590     gen res= g._VECTptr->front();
4591     gen angle=g._VECTptr->back();
4592     if (angle.is_symb_of_sommet(at_unit)){
4593       gen f=angle._SYMBptr->feuille;
4594       gen f0=f[0],f1=f[1];
4595       if (f1==(gen("_deg",contextptr)._SYMBptr->feuille)[1])
4596 	return res*exp(cst_i*f0*cst_pi/gen(180),contextptr);
4597       if (f1==(gen("_grad",contextptr)._SYMBptr->feuille)[1])
4598 	return res*exp(cst_i*f0*cst_pi/gen(200),contextptr);
4599       if (f1==(gen("_rad",contextptr)._SYMBptr->feuille)[1])
4600 	return res*exp(cst_i*f0,contextptr);
4601     }
4602 #ifdef GIAC_HAS_STO_38
4603     angle=evalf(angle,1,contextptr);
4604     res= evalf(res,1,contextptr);
4605     if (angle.type==_FLOAT_ && res.type==_FLOAT_)
4606       {
4607 	HP_Real a, r, s, c;
4608 	fExpand(gen2HP(angle), &a); fExpand(gen2HP(res), &r);
4609 	fisin(&a, &s, angle_radian(contextptr)?AMRad:(angle_degree(contextptr)?AMDeg:AMGrad)); ficos(&a, &c, angle_radian(contextptr)?AMRad:(angle_degree(contextptr)?AMDeg:AMGrad)); //grad
4610 	fimul_L(&s, &r, &s); fimul_L(&c, &r, &c);
4611 	HP_gen C= fUnExpand(&c), S= fUnExpand(&s);
4612 	gen gC, gS; gC= HP2gen(C); gS= HP2gen(S);
4613 	res= gC+gS*cst_i;
4614       } else {
4615       if(!angle_radian(contextptr))
4616       {
4617         //grad
4618         if(angle_degree(contextptr))
4619           angle = angle * m_pi(contextptr) / 180;
4620         else
4621           angle = angle * m_pi(contextptr) / 200;
4622       }
4623       res=res*exp(cst_i*angle,contextptr);
4624     }
4625 #else
4626     res=res*(cos(angle,contextptr)+cst_i*sin(angle,contextptr));
4627 #endif
4628     if (res.type==_CPLX){
4629       int * ptr = complex_display_ptr(res);
4630       if (ptr)
4631 	*ptr=1;
4632       return res;
4633     }
4634     else
4635       return calc_mode(contextptr)==1?symbolic(at_ggb_ang,g):symbolic(at_polar_complex,g);
4636   }
4637 #ifdef BCD
4638   static const char _polar_complex_s[]="\xe2\x88\xa1";
4639 #else
4640   static const char _polar_complex_s[]="∡"; // " polar_complex ";
4641 #endif
4642   static define_unary_function_eval4 (__polar_complex,&_polar_complex,_polar_complex_s,&printsommetasoperator,&texprintsommetasoperator);
4643   define_unary_function_ptr5( at_polar_complex ,alias_at_polar_complex,&__polar_complex,0,T_MOD);
4644 
4645   static const char _ggb_ang_s []="ggb_ang"; // prefixed version of polar complex
4646   static define_unary_function_eval (__ggb_ang,&_polar_complex,_ggb_ang_s);
4647   define_unary_function_ptr5( at_ggb_ang ,alias_at_ggb_ang,&__ggb_ang,0,true);
4648 
4649 #ifdef GIAC_HAS_STO_38
4650   gen aspen_HDigits(int i);
4651   gen aspen_HFormat(int i);
4652   gen aspen_HAngle(int i);
4653   gen aspen_HComplex(int i);
4654   gen aspen_HLanguage(int i);
4655 #endif
4656 
_HDigits(const gen & g0,GIAC_CONTEXT)4657   gen _HDigits(const gen & g0,GIAC_CONTEXT){
4658     gen g=g0;
4659     if (g.type==_VECT && g._VECTptr->empty()){
4660       g=-1;
4661     }
4662     else {
4663       if (g.type==_FLOAT_)
4664 	g=get_int(g0._FLOAT_val);
4665       if (g.type==_DOUBLE_)
4666 	g=_floor(g,contextptr);
4667       if (g.type!=_INT_)
4668 	return gentypeerr(contextptr);
4669       if (g.val<0 || g.val>12)
4670 	return gensizeerr(contextptr);
4671     }
4672 #ifdef GIAC_HAS_STO_38
4673     return aspen_HDigits(g.val);
4674 #else
4675     return _Digits(g,contextptr);
4676 #endif
4677   }
4678   static const char _HDigits_s []="HDigits";
4679   static define_unary_function_eval2 (__HDigits,&_HDigits,_HDigits_s,&printasDigits);
4680   define_unary_function_ptr( at_HDigits ,alias_at_HDigits ,&__HDigits);
4681 
_HFormat(const gen & g0,GIAC_CONTEXT)4682   gen _HFormat(const gen & g0,GIAC_CONTEXT){
4683     gen g=g0;
4684     if (g.type==_VECT && g._VECTptr->empty()){
4685       g=-1;
4686     }
4687     else {
4688       if (g.type==_FLOAT_)
4689 	g=get_int(g0._FLOAT_val);
4690       if (g.type==_DOUBLE_)
4691 	g=_floor(g,contextptr);
4692       if (g.type!=_INT_)
4693 	return gentypeerr(contextptr);
4694       if (g.val<0 || g.val>4)
4695 	return gensizeerr(contextptr);
4696     }
4697 #ifdef GIAC_HAS_STO_38
4698     return aspen_HFormat(g.val);
4699 #else
4700     return _scientific_format(g,contextptr);
4701 #endif
4702   }
4703   static const char _HFormat_s []="HFormat";
4704   static define_unary_function_eval2 (__HFormat,&_HFormat,_HFormat_s,&printasDigits);
4705   define_unary_function_ptr( at_HFormat ,alias_at_HFormat ,&__HFormat);
4706 
_HAngle(const gen & g0,GIAC_CONTEXT)4707   gen _HAngle(const gen & g0,GIAC_CONTEXT){
4708     gen g=g0;
4709     if (g.type==_VECT && g._VECTptr->empty()){
4710       g=-1;
4711     }
4712     else {
4713       if (g.type==_FLOAT_)
4714 	g=get_int(g0._FLOAT_val);
4715       if (g.type==_DOUBLE_)
4716 	g=_floor(g,contextptr);
4717       if (g.type!=_INT_)
4718 	return gentypeerr(contextptr);
4719       if (g.val<1 || g.val>2)
4720 	return gensizeerr(contextptr);
4721     }
4722 #ifdef GIAC_HAS_STO_38
4723     return aspen_HAngle(g.val);
4724 #else
4725     return _angle_radian(g-1,contextptr);
4726 #endif
4727   }
4728   static const char _HAngle_s []="HAngle";
4729   static define_unary_function_eval2 (__HAngle,&_HAngle,_HAngle_s,&printasDigits);
4730   define_unary_function_ptr( at_HAngle ,alias_at_HAngle ,&__HAngle);
4731 
_HComplex(const gen & g0,GIAC_CONTEXT)4732   gen _HComplex(const gen & g0,GIAC_CONTEXT){
4733     gen g=g0;
4734     if (g.type==_VECT && g._VECTptr->empty()){
4735       g=-1;
4736     }
4737     else {
4738       if (g.type==_FLOAT_)
4739 	g=get_int(g0._FLOAT_val);
4740       if (g.type==_DOUBLE_)
4741 	g=_floor(g,contextptr);
4742       if (g.type!=_INT_)
4743 	return gentypeerr(contextptr);
4744       if (g.val<0 || g.val>1)
4745 	return gensizeerr(contextptr);
4746     }
4747 #ifdef GIAC_HAS_STO_38
4748     return aspen_HComplex(g.val);
4749 #else
4750     return _complex_mode(g,contextptr);
4751 #endif
4752   }
4753   static const char _HComplex_s []="HComplex";
4754   static define_unary_function_eval2 (__HComplex,&_HComplex,_HComplex_s,&printasDigits);
4755   define_unary_function_ptr( at_HComplex ,alias_at_HComplex ,&__HComplex);
4756 
_HLanguage(const gen & g0,GIAC_CONTEXT)4757   gen _HLanguage(const gen & g0,GIAC_CONTEXT){
4758     gen g=g0;
4759     if (g.type==_VECT && g._VECTptr->empty()){
4760       g=-1;
4761     }
4762     else {
4763       if (g.type==_FLOAT_)
4764 	g=get_int(g0._FLOAT_val);
4765       if (g.type==_DOUBLE_)
4766 	g=_floor(g,contextptr);
4767       if (g.type!=_INT_)
4768 	return gentypeerr(contextptr);
4769       if (g.val<0 || g.val>2)
4770 	return gensizeerr(contextptr);
4771     }
4772 #ifdef GIAC_HAS_STO_38
4773     return aspen_HLanguage(g.val);
4774 #else
4775     if (g==-1)
4776       return language(contextptr);
4777     language(g.val,contextptr);
4778     return g.val;
4779 #endif
4780   }
4781   static const char _HLanguage_s []="HLanguage";
4782   static define_unary_function_eval2 (__HLanguage,&_HLanguage,_HLanguage_s,&printasDigits);
4783   define_unary_function_ptr( at_HLanguage ,alias_at_HLanguage ,&__HLanguage);
4784 
_EDITMAT(const gen & args,GIAC_CONTEXT)4785   gen _EDITMAT(const gen & args,GIAC_CONTEXT){
4786     if (args.type==_STRNG &&  args.subtype==-1) return  args;
4787 #ifdef GIAC_HAS_STO_38
4788     if (args.type!=_IDNT)
4789       return gensizeerr(contextptr);
4790     const char * id = args._IDNTptr->id_name;
4791     if (id[0]!='M' || id[1]<'0' || id[1]>'9')
4792       return gensizeerr(contextptr);
4793     int i=id[1]-'0';
4794 //    EditMat(i?i-1:9);
4795 #endif
4796     return eval(args,1,contextptr);
4797   }
4798   static const char _EDITMAT_s []="EDITMAT";
4799   static define_unary_function_eval_quoted (__EDITMAT,&_EDITMAT,_EDITMAT_s);
4800   define_unary_function_ptr5( at_EDITMAT ,alias_at_EDITMAT,&__EDITMAT,_QUOTE_ARGUMENTS,T_UNARY_OP_38);
4801 
4802 #ifndef NO_NAMESPACE_GIAC
4803 } // namespace giac
4804 #endif // ndef NO_NAMESPACE_GIAC
4805 
4806