← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/yacas/oneiric

« back to all changes in this revision

Viewing changes to src/mathcommands.cpp

  • Committer: Bazaar Package Importer
  • Author(s): Gopal Narayanan
  • Date: 2002-04-23 13:50:51 UTC
  • Revision ID: james.westby@ubuntu.com-20020423135051-bbd6ov4orr8eufmw
Tags: upstream-1.0.51
Import upstream version 1.0.51

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/mathcommands.cpp
 
1
 
 
2
 
 
3
#include "yacasbase.h"
 
4
#include "lispenvironment.h"
 
5
#include "standard.h"
 
6
#include "lispeval.h"
 
7
#include "lispatom.h"
 
8
#include "lispparser.h"
 
9
#include "stdfileio.h"
 
10
#include "stringio.h"
 
11
#include "lisperror.h"
 
12
#include "infixparser.h"
 
13
#include "lispuserfunc.h"
 
14
#include "mathuserfunc.h"
 
15
#include "platmath.h"
 
16
#include "numbers.h"
 
17
#include "anumber.h"
 
18
#include "arrayclass.h"
 
19
#include "patternclass.h"
 
20
#include "substitute.h"
 
21
#include "errors.h"
 
22
#include "arggetter.h"
 
23
 
 
24
#define InternalEval aEnvironment.iEvaluator->Eval
 
25
 
 
26
 
 
27
 
 
28
void LispLexCompare2(LispEnvironment& aEnvironment, LispPtr& aResult,
 
29
                     LispPtr& aArguments,
 
30
                     LispBoolean (*lexfunc)(LispCharPtr f1, LispCharPtr f2, LispHashTable& aHashTable,LispInt aPrecision),
 
31
                     LispBoolean (*numfunc)(LispCharPtr f1, LispCharPtr f2, LispHashTable& aHashTable,LispInt aPrecision)
 
32
                    );
 
33
 
 
34
 
 
35
void LispQuote(LispEnvironment& aEnvironment,
 
36
               LispPtr& aResult,
 
37
               LispPtr& aArguments)
 
38
{
 
39
    TESTARGS(2);
 
40
    aResult.Set(Argument(aArguments,1).Get()->Copy(LispFalse));
 
41
}
 
42
 
 
43
/*TODO remove? just an experiment, didn't pan out it seems
 
44
template<int T>
 
45
class CArgs
 
46
{
 
47
public:
 
48
    inline CArgs(LispPtr& aArguments,LispEnvironment& aEnvironment);
 
49
    inline LispPtr& Arg(LispInt aIndex);
 
50
    inline void Eval(LispInt aIndex);
 
51
private:
 
52
    LispEnvironment& iEnvironment;
 
53
    LispPtr *iArgs[T];
 
54
};
 
55
template<int T>
 
56
inline CArgs<T>::CArgs(LispPtr& aArguments,LispEnvironment& aEnvironment)
 
57
: iEnvironment(aEnvironment)
 
58
{
 
59
   LISPASSERT(aArguments.Get() != NULL);
 
60
   LispPtr* ptr = &aArguments.Get()->Next();
 
61
   LispInt i;
 
62
   for (i=0;i<T;i++)
 
63
   {
 
64
      iArgs[i] = ptr;
 
65
      ptr = &ptr->Get()->Next();
 
66
   }
 
67
   if (ptr->Get() != NULL)
 
68
   {
 
69
        ErrorNrArgs(T, InternalListLength(aArguments)-1, aArguments, aEnvironment);
 
70
   }
 
71
}
 
72
 
 
73
template<int T>
 
74
inline LispPtr& CArgs<T>::Arg(LispInt aIndex)
 
75
{
 
76
    LISPASSERT(aIndex >= 0 && aIndex < T);
 
77
    return *iArgs[aIndex];
 
78
}
 
79
 
 
80
 template<int T>
 
81
inline void CArgs<T>::Eval(LispInt aIndex)
 
82
{
 
83
   LispPtr result;
 
84
   iEnvironment.iEvaluator->Eval(iEnvironment, result, iArgs[aIndex]);
 
85
   iArgs[aIndex].Set(result.Get());
 
86
}
 
87
*/
 
88
 
 
89
 
 
90
void LispEval(LispEnvironment& aEnvironment,LispPtr& aResult,
 
91
              LispPtr& aArguments)
 
92
{
 
93
    /*TODO remove? just an experiment, didn't pan out it seems
 
94
    CArgs<1> args(aArguments,aEnvironment);
 
95
    LispPtr result;
 
96
    InternalEval(aEnvironment, result, args.Arg(0));
 
97
    InternalEval(aEnvironment, aResult, result);
 
98
    */
 
99
 
 
100
    TESTARGS(2);
 
101
    LispPtr result;
 
102
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
103
    InternalEval(aEnvironment, aResult, result);
 
104
}
 
105
 
 
106
static void InternalSetVar(LispEnvironment& aEnvironment, LispPtr& aResult,
 
107
                LispPtr& aArguments,LispBoolean aMacroMode)
 
108
{
 
109
    TESTARGS(3);
 
110
 
 
111
    LispStringPtr varstring=NULL;
 
112
 
 
113
    if (aMacroMode)
 
114
    {
 
115
        LispPtr result;
 
116
        InternalEval(aEnvironment, result, Argument(aArguments,1));
 
117
        varstring = result.Get()->String();
 
118
    }
 
119
    else
 
120
    {
 
121
        varstring = Argument(aArguments,1).Get()->String();
 
122
    }
 
123
    CHK_ARG(varstring != NULL,1);
 
124
    CHK_ARG(!IsNumber(varstring->String(),LispTrue),1);
 
125
    
 
126
    LispPtr result;
 
127
    InternalEval(aEnvironment, result, Argument(aArguments,2));
 
128
    aEnvironment.SetVariable(varstring, result);
 
129
    InternalTrue(aEnvironment,aResult);
 
130
}
 
131
 
 
132
 
 
133
void LispSetVar(LispEnvironment& aEnvironment, LispPtr& aResult,
 
134
                LispPtr& aArguments)
 
135
{
 
136
    InternalSetVar(aEnvironment, aResult,aArguments,LispFalse);
 
137
}
 
138
void LispMacroSetVar(LispEnvironment& aEnvironment, LispPtr& aResult,
 
139
                LispPtr& aArguments)
 
140
{
 
141
    InternalSetVar(aEnvironment, aResult,aArguments,LispTrue);
 
142
}
 
143
 
 
144
 
 
145
static void InternalClearVar(LispEnvironment& aEnvironment,
 
146
                      LispPtr& aResult, LispPtr& aArguments,
 
147
                      LispBoolean aMacroMode)
 
148
{
 
149
    LispIterator iter(Argument(aArguments,1));
 
150
    LispInt nr=1;
 
151
    while (iter())
 
152
    {
 
153
        LispStringPtr str;
 
154
 
 
155
        if (aMacroMode)
 
156
        {
 
157
            LispPtr result;
 
158
            InternalEval(aEnvironment, result, *iter.Ptr());
 
159
            str = result.Get()->String();
 
160
        }
 
161
        else
 
162
        {
 
163
            str = iter()->String();
 
164
        }
 
165
 
 
166
        CHK_ARG(str != NULL, nr);
 
167
        aEnvironment.UnsetVariable(str);
 
168
        iter.GoNext();
 
169
        nr++;
 
170
    }
 
171
    InternalTrue(aEnvironment,aResult);
 
172
}
 
173
 
 
174
void LispClearVar(LispEnvironment& aEnvironment,
 
175
                  LispPtr& aResult,LispPtr& aArguments)
 
176
{
 
177
    InternalClearVar(aEnvironment,aResult, aArguments, LispFalse);
 
178
}
 
179
void LispMacroClearVar(LispEnvironment& aEnvironment,
 
180
                  LispPtr& aResult,LispPtr& aArguments)
 
181
{
 
182
    InternalClearVar(aEnvironment,aResult, aArguments, LispTrue);
 
183
}
 
184
 
 
185
 
 
186
 
 
187
/* StrCompare returns f1-f2: if f1 < f2 it returns -1, if f1=f2 it
 
188
 returns 0, and it returns 1 if f1>f2
 
189
 */
 
190
 
 
191
static LispBoolean LexLessThan(LispCharPtr f1, LispCharPtr f2, LispHashTable& aHashTable,LispInt aPrecision)
 
192
{
 
193
    return (StrCompare(f1, f2)<0);
 
194
}
 
195
 
 
196
static LispBoolean LexGreaterThan(LispCharPtr f1, LispCharPtr f2, LispHashTable& aHashTable,LispInt aPrecision)
 
197
{
 
198
    return (StrCompare(f1, f2)>0);
 
199
}
 
200
 
 
201
 
 
202
void LispLessThan(LispEnvironment& aEnvironment, LispPtr& aResult,
 
203
                  LispPtr& aArguments)
 
204
{
 
205
    LispLexCompare2(aEnvironment, aResult, aArguments, LexLessThan,LessThan);
 
206
}
 
207
 
 
208
void LispGreaterThan(LispEnvironment& aEnvironment, LispPtr& aResult,
 
209
                  LispPtr& aArguments)
 
210
{
 
211
    LispLexCompare2(aEnvironment, aResult, aArguments, LexGreaterThan, GreaterThan);
 
212
}
 
213
 
 
214
 
 
215
void LispLexCompare2(LispEnvironment& aEnvironment, LispPtr& aResult,
 
216
                     LispPtr& aArguments,
 
217
                     LispBoolean (*lexfunc)(LispCharPtr f1, LispCharPtr f2, LispHashTable& aHashTable,LispInt aPrecision),
 
218
                     LispBoolean (*numfunc)(LispCharPtr f1, LispCharPtr f2, LispHashTable& aHashTable,LispInt aPrecision)
 
219
                    )
 
220
{
 
221
    TESTARGS(3);
 
222
 
 
223
    LispStringPtr str1;
 
224
    LispStringPtr str2;
 
225
 
 
226
    LispPtr result1;
 
227
    LispPtr result2;
 
228
    InternalEval(aEnvironment, result1, Argument(aArguments,1));
 
229
    InternalEval(aEnvironment, result2, Argument(aArguments,2));
 
230
 
 
231
    str1 = result1.Get()->String();
 
232
    str2 = result2.Get()->String();
 
233
    CHK_ARG(str1 != NULL ,1);
 
234
    CHK_ARG(str2 != NULL, 2);
 
235
 
 
236
    LispBoolean cmp;
 
237
    if (IsNumber(str1->String(),LispTrue) &&
 
238
        IsNumber(str2->String(),LispTrue))
 
239
    {
 
240
        cmp =numfunc(str1->String(),str2->String(),
 
241
                             aEnvironment.HashTable(),
 
242
                             aEnvironment.Precision());
 
243
    }
 
244
    else
 
245
    {
 
246
        cmp =lexfunc(str1->String(),str2->String(),
 
247
                             aEnvironment.HashTable(),
 
248
                             aEnvironment.Precision());
 
249
    }
 
250
    
 
251
    InternalBoolean(aEnvironment,aResult, cmp);
 
252
}
 
253
 
 
254
void LispPi(LispEnvironment& aEnvironment, LispPtr& aResult,
 
255
            LispPtr& aArguments)
 
256
{
 
257
    TESTARGS(1);
 
258
    aResult.Set(LispAtom::New(PiFloat(aEnvironment.HashTable(),
 
259
                                         aEnvironment.Precision())));
 
260
}
 
261
 
 
262
 
 
263
 
 
264
void LispGcd(LispEnvironment& aEnvironment, LispPtr& aResult,
 
265
             LispPtr& aArguments)
 
266
{
 
267
    LispArgGetter g(aEnvironment, aArguments);
 
268
    IntegerArgument(g,str1,LispTrue);
 
269
    IntegerArgument(g,str2,LispTrue);
 
270
    g.Finalize(2);
 
271
    aResult.Set(LispAtom::New(GcdInteger(str1->String(),str2->String(),
 
272
                                         aEnvironment.HashTable())));
 
273
}
 
274
 
 
275
void LispFullForm(LispEnvironment& aEnvironment, LispPtr& aResult,
 
276
                  LispPtr& aArguments)
 
277
{
 
278
    InternalEval(aEnvironment, aResult, Argument(aArguments,1));
 
279
    LispPrinter printer;
 
280
    StdUserOutput output;
 
281
    printer.Print(aResult, output, aEnvironment);
 
282
    output.Write("\n");
 
283
}
 
284
 
 
285
 
 
286
void LispHead(LispEnvironment& aEnvironment, LispPtr& aResult,
 
287
                  LispPtr& aArguments)
 
288
{
 
289
    LispArgGetter g(aEnvironment, aArguments);
 
290
    ListArgument(g,list,LispTrue);
 
291
    g.Finalize(1);
 
292
    InternalNth(aResult, list,1);
 
293
}
 
294
 
 
295
void LispNth(LispEnvironment& aEnvironment, LispPtr& aResult,
 
296
                  LispPtr& aArguments)
 
297
{
 
298
    LispArgGetter g(aEnvironment, aArguments);
 
299
    ListArgument(g,list,LispTrue);
 
300
    ShortIntegerArgument(g,index,LispTrue);
 
301
    g.Finalize(2);
 
302
    InternalNth(aResult, list, index);
 
303
}
 
304
 
 
305
 
 
306
void LispTail(LispEnvironment& aEnvironment, LispPtr& aResult,
 
307
                  LispPtr& aArguments)
 
308
{
 
309
    LispArgGetter g(aEnvironment, aArguments);
 
310
    ListArgument(g,list,LispTrue);
 
311
    g.Finalize(1);
 
312
 
 
313
    LispPtr first;
 
314
    InternalTail(first, list);
 
315
    InternalTail(aResult, first);
 
316
    LispPtr head;
 
317
    head.Set(LispAtom::New(aEnvironment.iList));
 
318
    head.Get()->Next().Set(aResult.Get()->SubList()->Get());
 
319
    aResult.Get()->SubList()->Set(head.Get());
 
320
}
 
321
 
 
322
void LispUnList(LispEnvironment& aEnvironment, LispPtr& aResult,
 
323
                  LispPtr& aArguments)
 
324
{
 
325
    LispArgGetter g(aEnvironment, aArguments);
 
326
    ListArgument(g,list,LispTrue);
 
327
    g.Finalize(1);
 
328
    InternalTail(aResult, list);
 
329
}
 
330
 
 
331
void LispListify(LispEnvironment& aEnvironment, LispPtr& aResult,
 
332
                 LispPtr& aArguments)
 
333
{
 
334
    LispArgGetter g(aEnvironment, aArguments);
 
335
    ListArgument(g,list,LispTrue);
 
336
    g.Finalize(1);
 
337
 
 
338
    LispPtr head;
 
339
    head.Set(LispAtom::New(aEnvironment.iList));
 
340
    head.Get()->Next().Set(list.Get()->SubList()->Get());
 
341
    aResult.Set(LispSubList::New(head.Get()));
 
342
}
 
343
 
 
344
 
 
345
 
 
346
 
 
347
void LispDestructiveReverse(LispEnvironment& aEnvironment, LispPtr& aResult,
 
348
                            LispPtr& aArguments)
 
349
{
 
350
    LispArgGetter g(aEnvironment, aArguments);
 
351
    ListArgument(g,list,LispTrue);
 
352
    g.Finalize(1);
 
353
 
 
354
    LispPtr reversed;
 
355
    reversed.Set(LispAtom::New(aEnvironment.iList));
 
356
    InternalReverseList(reversed.Get()->Next(), list.Get()->SubList()->Get()->Next());
 
357
    aResult.Set(LispSubList::New(reversed.Get()));
 
358
}
 
359
 
 
360
 
 
361
void LispLength(LispEnvironment& aEnvironment, LispPtr& aResult,
 
362
                LispPtr& aArguments)
 
363
{
 
364
    TESTARGS(2);
 
365
    LispPtr evaluated;
 
366
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
367
 
 
368
    LispPtr* subList = evaluated.Get()->SubList();
 
369
    if (subList != NULL)
 
370
    {
 
371
        LispChar s[20];
 
372
        LispInt num = InternalListLength(subList->Get()->Next());
 
373
        InternalIntToAscii(s,num);
 
374
        aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(s)));
 
375
        return;
 
376
    }
 
377
    LispStringPtr string = evaluated.Get()->String();
 
378
    if (InternalIsString(string))
 
379
    {
 
380
        LispChar s[20];
 
381
        LispInt num = string->NrItems()-3;
 
382
        InternalIntToAscii(s,num);
 
383
        aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(s)));
 
384
        return;
 
385
    }
 
386
    GenericClass *gen = evaluated.Get()->Generic();
 
387
    if (gen != NULL)
 
388
    if (StrEqual(gen->TypeName(),"\"Array\""))
 
389
    {
 
390
        LispInt size=((ArrayClass*)gen)->Size();
 
391
        LispChar s[20];
 
392
        InternalIntToAscii(s,size);
 
393
        aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(s)));
 
394
        return;
 
395
    }
 
396
    CHK_ISLIST(evaluated,1);
 
397
}
 
398
 
 
399
 
 
400
void LispList(LispEnvironment& aEnvironment, LispPtr& aResult,
 
401
              LispPtr& aArguments)
 
402
{
 
403
    LispPtr all;
 
404
    all.Set(LispAtom::New(aEnvironment.iList));
 
405
    LispIterator tail(all);
 
406
    tail.GoNext();
 
407
    LispIterator iter = Argument(aArguments,1);
 
408
    while (iter())
 
409
    {
 
410
        LispPtr evaluated;
 
411
        InternalEval(aEnvironment, evaluated, *iter.Ptr());
 
412
        tail.Ptr()->Set(evaluated.Get());
 
413
        tail.GoNext();
 
414
        iter.GoNext();
 
415
    }
 
416
    
 
417
    aResult.Set(LispSubList::New(all.Get()));
 
418
}
 
419
 
 
420
 
 
421
void LispConcatenate(LispEnvironment& aEnvironment, LispPtr& aResult,
 
422
              LispPtr& aArguments)
 
423
{
 
424
    LispPtr all;
 
425
    all.Set(LispAtom::New(aEnvironment.iList));
 
426
    LispIterator tail(all);
 
427
    tail.GoNext();
 
428
    LispInt arg = 1;
 
429
 
 
430
    LispIterator iter = Argument(aArguments,1);
 
431
    while (iter())
 
432
    {
 
433
        LispPtr evaluated;
 
434
        InternalEval(aEnvironment, evaluated, *iter.Ptr());
 
435
        CHK_ISLIST(evaluated,arg);
 
436
        InternalFlatCopy(*tail.Ptr(),evaluated.Get()->SubList()->Get()->Next());
 
437
        while (tail() != NULL)
 
438
            tail.GoNext();
 
439
 
 
440
        iter.GoNext();
 
441
        arg++;
 
442
    }
 
443
    
 
444
    aResult.Set(LispSubList::New(all.Get()));
 
445
}
 
446
 
 
447
 
 
448
static void ConcatenateStrings(LispStringSmartPtr& aSmartPtr, LispEnvironment& aEnvironment, LispPtr& aResult,
 
449
              LispPtr& aArguments)
 
450
{
 
451
    LISPASSERT(aSmartPtr());
 
452
    aSmartPtr()->SetNrItems(0);
 
453
    aSmartPtr()->Append('\"');
 
454
    LispInt arg=1;
 
455
    
 
456
    LispIterator iter = Argument(aArguments,1);
 
457
    while (iter())
 
458
    {
 
459
        LispPtr evaluated;
 
460
        InternalEval(aEnvironment, evaluated, *iter.Ptr());
 
461
        CHK_ISSTRING(evaluated,arg);
 
462
 
 
463
        LispInt length = evaluated.Get()->String()->NrItems()-2;
 
464
        LispCharPtr ptr=evaluated.Get()->String()->String();
 
465
        
 
466
        LispInt curlen = aSmartPtr()->NrItems();
 
467
        aSmartPtr()->GrowTo(curlen+length-1);
 
468
        LispCharPtr put = &(*aSmartPtr())[curlen-1];
 
469
        PlatMemCopy(put+1,ptr+1,length-1);
 
470
        iter.GoNext();
 
471
        arg++;
 
472
    }
 
473
    
 
474
    aSmartPtr()->Append('\"');
 
475
    aSmartPtr()->Append('\0');
 
476
}
 
477
void LispConcatenateStrings(LispEnvironment& aEnvironment, LispPtr& aResult,
 
478
              LispPtr& aArguments)
 
479
{
 
480
    LispString *str = NEW LispString;
 
481
    LispStringSmartPtr smartptr;
 
482
    smartptr.Set(str);
 
483
    ConcatenateStrings(smartptr,aEnvironment, aResult, aArguments);
 
484
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(str)));
 
485
}
 
486
 
 
487
static void InternalDelete(LispEnvironment& aEnvironment, LispPtr& aResult,
 
488
                  LispPtr& aArguments, LispInt aDestructive)
 
489
{
 
490
    TESTARGS(3);
 
491
    LispPtr evaluated;
 
492
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
493
    CHK_ISLIST(evaluated,1);
 
494
 
 
495
    LispPtr copied;
 
496
    if (aDestructive)
 
497
    {
 
498
        copied.Set(evaluated.Get()->SubList()->Get());
 
499
    }
 
500
    else
 
501
    {
 
502
        InternalFlatCopy(copied,*evaluated.Get()->SubList());
 
503
    }
 
504
 
 
505
    LispPtr index;
 
506
    InternalEval(aEnvironment, index, Argument(aArguments,2));
 
507
    CHK_ARG(index.Get() != NULL, 2);
 
508
    CHK_ARG(index.Get()->String() != NULL, 2);
 
509
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
510
    CHK_ARG(ind>0,2);
 
511
 
 
512
    LispIterator iter(copied);
 
513
    while (ind>0)
 
514
    {
 
515
        iter.GoNext();
 
516
        ind--;
 
517
    }
 
518
    CHK(iter() != NULL, KLispErrListNotLongEnough);
 
519
    LispPtr next;
 
520
    next.Set(iter()->Next().Get());
 
521
    iter.Ptr()->Set(next.Get());
 
522
    aResult.Set(LispSubList::New(copied.Get()));
 
523
}
 
524
void LispDelete(LispEnvironment& aEnvironment, LispPtr& aResult,
 
525
                  LispPtr& aArguments)
 
526
{
 
527
    InternalDelete(aEnvironment, aResult,aArguments,LispFalse);
 
528
}
 
529
void LispDestructiveDelete(LispEnvironment& aEnvironment, LispPtr& aResult,
 
530
                           LispPtr& aArguments)
 
531
{
 
532
    InternalDelete(aEnvironment, aResult,aArguments,LispTrue);
 
533
}
 
534
 
 
535
void LispFlatCopy(LispEnvironment& aEnvironment, LispPtr& aResult,
 
536
                  LispPtr& aArguments)
 
537
{
 
538
    LispArgGetter g(aEnvironment, aArguments);
 
539
    ListArgument(g,list,LispTrue);
 
540
    g.Finalize(1);
 
541
    LispPtr copied;
 
542
    InternalFlatCopy(copied,*list.Get()->SubList());
 
543
    aResult.Set(LispSubList::New(copied.Get()));
 
544
}
 
545
 
 
546
 
 
547
static void InternalInsert(LispEnvironment& aEnvironment, LispPtr& aResult,
 
548
                  LispPtr& aArguments, LispInt aDestructive)
 
549
{
 
550
    TESTARGS(4);
 
551
    LispPtr evaluated;
 
552
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
553
    CHK_ISLIST(evaluated,1);
 
554
 
 
555
    LispPtr copied;
 
556
    if (aDestructive)
 
557
    {
 
558
        copied.Set(evaluated.Get()->SubList()->Get());
 
559
    }
 
560
    else
 
561
    {
 
562
        InternalFlatCopy(copied,*evaluated.Get()->SubList());
 
563
    }
 
564
    
 
565
    LispPtr index;
 
566
    InternalEval(aEnvironment, index, Argument(aArguments,2));
 
567
    CHK_ARG(index.Get() != NULL, 2);
 
568
    CHK_ARG(index.Get()->String() != NULL, 2);
 
569
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
570
    CHK_ARG(ind>0,2);
 
571
 
 
572
    LispIterator iter(copied);
 
573
    while (ind>0)
 
574
    {
 
575
        iter.GoNext();
 
576
        ind--;
 
577
    }
 
578
 
 
579
    LispPtr toInsert;
 
580
    InternalEval(aEnvironment, toInsert, Argument(aArguments,3));
 
581
    toInsert.Get()->Next().Set(iter());
 
582
    iter.Ptr()->Set(toInsert.Get());
 
583
    aResult.Set(LispSubList::New(copied.Get()));
 
584
}
 
585
 
 
586
void LispInsert(LispEnvironment& aEnvironment, LispPtr& aResult,
 
587
                  LispPtr& aArguments)
 
588
{
 
589
    InternalInsert(aEnvironment, aResult,aArguments,LispFalse);
 
590
}
 
591
 
 
592
void LispDestructiveInsert(LispEnvironment& aEnvironment, LispPtr& aResult,
 
593
                  LispPtr& aArguments)
 
594
{
 
595
    InternalInsert(aEnvironment, aResult,aArguments,LispTrue);
 
596
}
 
597
 
 
598
 
 
599
 
 
600
 
 
601
 
 
602
 
 
603
 
 
604
static void InternalReplace(LispEnvironment& aEnvironment, LispPtr& aResult,
 
605
                  LispPtr& aArguments, LispInt aDestructive)
 
606
{
 
607
    TESTARGS(4);
 
608
    LispPtr evaluated;
 
609
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
610
    CHK_ISLIST(evaluated,1);
 
611
 
 
612
    LispPtr index;
 
613
    InternalEval(aEnvironment, index, Argument(aArguments,2));
 
614
    CHK_ARG(index.Get() != NULL, 2);
 
615
    CHK_ARG(index.Get()->String() != NULL, 2);
 
616
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
617
 
 
618
    LispPtr copied;
 
619
    if (aDestructive)
 
620
    {
 
621
        copied.Set(evaluated.Get()->SubList()->Get());
 
622
    }
 
623
    else
 
624
    {
 
625
        InternalFlatCopy(copied,*evaluated.Get()->SubList());
 
626
    }
 
627
    CHK_ARG(ind>0,2);
 
628
 
 
629
    LispIterator iter(copied);
 
630
    while (ind>0)
 
631
    {
 
632
        iter.GoNext();
 
633
        ind--;
 
634
    }
 
635
 
 
636
    LispPtr toInsert;
 
637
    InternalEval(aEnvironment, toInsert, Argument(aArguments,3));
 
638
    CHK_ARG(iter.Ptr() != NULL, 2);
 
639
    CHK_ARG(iter.Ptr()->Get() != NULL, 2);
 
640
    toInsert.Get()->Next().Set(iter.Ptr()->Get()->Next().Get());
 
641
    iter.Ptr()->Set(toInsert.Get());
 
642
    aResult.Set(LispSubList::New(copied.Get()));
 
643
}
 
644
 
 
645
void LispReplace(LispEnvironment& aEnvironment, LispPtr& aResult,
 
646
                  LispPtr& aArguments)
 
647
{
 
648
    InternalReplace(aEnvironment, aResult,aArguments,LispFalse);
 
649
}
 
650
 
 
651
void LispDestructiveReplace(LispEnvironment& aEnvironment, LispPtr& aResult,
 
652
                  LispPtr& aArguments)
 
653
{
 
654
    InternalReplace(aEnvironment, aResult,aArguments,LispTrue);
 
655
}
 
656
 
 
657
 
 
658
 
 
659
 
 
660
 
 
661
 
 
662
 
 
663
 
 
664
 
 
665
 
 
666
 
 
667
 
 
668
 
 
669
 
 
670
 
 
671
 
 
672
void LispNot(LispEnvironment& aEnvironment, LispPtr& aResult,
 
673
                  LispPtr& aArguments)
 
674
{
 
675
    TESTARGS(2);
 
676
    LispPtr evaluated;
 
677
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
678
    if (IsTrue(aEnvironment, evaluated) || IsFalse(aEnvironment, evaluated))
 
679
    {
 
680
        InternalNot(aResult, aEnvironment, evaluated);
 
681
    }
 
682
    else
 
683
    {
 
684
        LispPtr ptr;
 
685
        ptr.Set(aArguments.Get()->Copy(LispFalse));
 
686
        ptr.Get()->Next().Set(evaluated.Get());
 
687
        aResult.Set(LispSubList::New(ptr.Get()));
 
688
    }
 
689
}
 
690
 
 
691
void LispLazyAnd(LispEnvironment& aEnvironment, LispPtr& aResult,
 
692
                  LispPtr& aArguments)
 
693
{
 
694
    LispPtr nogos;
 
695
    LispInt nrnogos=0;
 
696
    LispPtr evaluated;
 
697
 
 
698
    LispIterator iter(Argument(aArguments,1));
 
699
    while (iter())
 
700
    {
 
701
        InternalEval(aEnvironment, evaluated, *iter.Ptr());
 
702
        if (IsFalse(aEnvironment, evaluated))
 
703
        {
 
704
            InternalFalse(aEnvironment,aResult);
 
705
            return;
 
706
        }
 
707
        else if (!IsTrue(aEnvironment, evaluated))
 
708
        {
 
709
            LispPtr ptr;
 
710
            nrnogos++;
 
711
            ptr.Set(evaluated.Get()->Copy(LispFalse));
 
712
            ptr.Get()->Next().Set(nogos.Get());
 
713
            nogos.Set(ptr.Get());
 
714
        }
 
715
        
 
716
        iter.GoNext();
 
717
    }
 
718
 
 
719
    if (nogos.Get() != NULL)
 
720
    {
 
721
        if (nrnogos == 1)
 
722
        {
 
723
            aResult.Set(nogos.Get());
 
724
        }
 
725
        else
 
726
        {
 
727
            LispPtr ptr;
 
728
 
 
729
            InternalReverseList(ptr, nogos);
 
730
            nogos.Set(ptr.Get());
 
731
 
 
732
            ptr.Set(aArguments.Get()->Copy(LispFalse));
 
733
            ptr.Get()->Next().Set(nogos.Get());
 
734
            nogos.Set(ptr.Get());
 
735
            aResult.Set(LispSubList::New(nogos.Get()));
 
736
 
 
737
            //aEnvironment.CurrentPrinter().Print(aResult, *aEnvironment.CurrentOutput());
 
738
        }
 
739
    }
 
740
    else
 
741
    {
 
742
        InternalTrue(aEnvironment,aResult);
 
743
    }
 
744
}
 
745
 
 
746
void LispLazyOr(LispEnvironment& aEnvironment, LispPtr& aResult,
 
747
                  LispPtr& aArguments)
 
748
{
 
749
    LispPtr nogos;
 
750
    LispInt nrnogos=0;
 
751
 
 
752
    LispPtr evaluated;
 
753
 
 
754
    LispIterator iter(Argument(aArguments,1));
 
755
    while (iter())
 
756
    {
 
757
        InternalEval(aEnvironment, evaluated, *iter.Ptr());
 
758
        if (IsTrue(aEnvironment, evaluated))
 
759
        {
 
760
            InternalTrue(aEnvironment,aResult);
 
761
            return;
 
762
        }
 
763
        else if (!IsFalse(aEnvironment, evaluated))
 
764
        {
 
765
 
 
766
 
 
767
            LispPtr ptr;
 
768
            nrnogos++;
 
769
 
 
770
            ptr.Set(evaluated.Get()->Copy(LispFalse));
 
771
            ptr.Get()->Next().Set(nogos.Get());
 
772
            nogos.Set(ptr.Get());
 
773
        }
 
774
        iter.GoNext();
 
775
    }
 
776
 
 
777
    if (nogos.Get() != NULL)
 
778
    {
 
779
        if (nrnogos == 1)
 
780
        {
 
781
            aResult.Set(nogos.Get());
 
782
        }
 
783
        else
 
784
        {
 
785
            LispPtr ptr;
 
786
 
 
787
            InternalReverseList(ptr, nogos);
 
788
            nogos.Set(ptr.Get());
 
789
 
 
790
            ptr.Set(aArguments.Get()->Copy(LispFalse));
 
791
            ptr.Get()->Next().Set(nogos.Get());
 
792
            nogos.Set(ptr.Get());
 
793
            aResult.Set(LispSubList::New(nogos.Get()));
 
794
        }
 
795
        //aEnvironment.CurrentPrinter().Print(aResult, *aEnvironment.CurrentOutput());
 
796
    }
 
797
    else
 
798
    {
 
799
        InternalFalse(aEnvironment,aResult);
 
800
    }
 
801
}
 
802
 
 
803
void LispEquals(LispEnvironment& aEnvironment, LispPtr& aResult,
 
804
                  LispPtr& aArguments)
 
805
{
 
806
    TESTARGS(3);
 
807
    LispPtr evaluated1;
 
808
    InternalEval(aEnvironment, evaluated1, Argument(aArguments,1));
 
809
    LispPtr evaluated2;
 
810
    InternalEval(aEnvironment, evaluated2, Argument(aArguments,2));
 
811
 
 
812
    InternalBoolean(aEnvironment,aResult,
 
813
                    InternalEquals(aEnvironment, evaluated1, evaluated2));
 
814
}
 
815
 
 
816
 
 
817
void LispWrite(LispEnvironment& aEnvironment, LispPtr& aResult,
 
818
                  LispPtr& aArguments)
 
819
{
 
820
    LispPtr evaluated;
 
821
    LispInt nrArguments = InternalListLength(aArguments);
 
822
    LispInt arg;
 
823
    for (arg=1;arg<nrArguments;arg++)
 
824
    {
 
825
        InternalEval(aEnvironment, evaluated, Argument(aArguments,arg));
 
826
        aEnvironment.CurrentPrinter().Print(evaluated,
 
827
                                            *aEnvironment.CurrentOutput(),
 
828
                                           aEnvironment);
 
829
    }
 
830
    InternalTrue(aEnvironment,aResult);
 
831
}
 
832
/*TODO remove!!!
 
833
static void RepeatChar(LispEnvironment& aEnvironment, LispPtr& aResult,
 
834
                  LispPtr& aArguments, LispCharPtr aString)
 
835
{
 
836
    LispInt nrArguments = InternalListLength(aArguments);
 
837
    CHK(nrArguments == 1 || nrArguments == 2,KLispErrWrongNumberOfArgs);
 
838
    LispInt nrTimes=1;
 
839
    if (nrArguments == 2)
 
840
    {
 
841
        LispPtr index;
 
842
        InternalEval(aEnvironment, index, Argument(aArguments,1));
 
843
        CHK_ARG(index.Get() != NULL, 1);
 
844
        CHK_ARG(index.Get()->String() != NULL, 1);
 
845
        nrTimes = InternalAsciiToInt(index.Get()->String()->String());
 
846
    }
 
847
    CHK_ARG(nrTimes>=0,1);
 
848
    LispInt i;
 
849
    for (i=0;i<nrTimes;i++)
 
850
        aEnvironment.CurrentOutput()->Write(aString);
 
851
    InternalTrue(aEnvironment,aResult);
 
852
}
 
853
 
 
854
void LispSpace(LispEnvironment& aEnvironment, LispPtr& aResult,
 
855
                  LispPtr& aArguments)
 
856
{
 
857
    RepeatChar(aEnvironment, aResult, aArguments, " ");
 
858
}
 
859
 
 
860
void LispNewLine(LispEnvironment& aEnvironment, LispPtr& aResult,
 
861
                  LispPtr& aArguments)
 
862
{
 
863
    RepeatChar(aEnvironment, aResult, aArguments, "\n");
 
864
}
 
865
*/
 
866
 
 
867
 
 
868
void LispWriteString(LispEnvironment& aEnvironment, LispPtr& aResult,
 
869
                  LispPtr& aArguments)
 
870
{
 
871
    TESTARGS(2);
 
872
    LispPtr evaluated;
 
873
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
874
    CHK_ARG(evaluated.Get()!= NULL,1);
 
875
    LispStringPtr str = evaluated.Get()->String();
 
876
    CHK_ARG(str != NULL,1);
 
877
    CHK_ARG((*str)[0] == '\"',1);
 
878
    CHK_ARG((*str)[str->NrItems()-2] == '\"',1);
 
879
 
 
880
    LispInt i=1;
 
881
    LispInt nr=str->NrItems()-2;
 
882
    //((*str)[i] != '\"')
 
883
    for (i=1;i<nr;i++)
 
884
    {
 
885
        aEnvironment.CurrentOutput()->PutChar((*str)[i]);
 
886
    }
 
887
        // pass last printed character to the current printer
 
888
        aEnvironment.CurrentPrinter().RememberLastChar((*str)[nr-1]);   // hacky hacky
 
889
    InternalTrue(aEnvironment,aResult);
 
890
}
 
891
 
 
892
void LispProgBody(LispEnvironment& aEnvironment, LispPtr& aResult,
 
893
                  LispPtr& aArguments)
 
894
{
 
895
    // Allow accessing previous locals.
 
896
    LispLocalFrame frame(aEnvironment,LispFalse);
 
897
 
 
898
    InternalTrue(aEnvironment,aResult);
 
899
    
 
900
    // Evaluate args one by one.
 
901
    LispInt nrArguments = InternalListLength(aArguments);
 
902
    LispInt arg;
 
903
    for (arg=1;arg<nrArguments;arg++)
 
904
    {
 
905
        InternalEval(aEnvironment, aResult, Argument(aArguments,arg));
 
906
    }
 
907
}
 
908
 
 
909
static void InternalNewLocal(LispEnvironment& aEnvironment, LispPtr& aResult,
 
910
                             LispPtr& aArguments, LispBoolean aMacroMode)
 
911
{
 
912
    LispInt nrArguments = InternalListLength(aArguments);
 
913
    LispInt arg;
 
914
    for (arg=1;arg<nrArguments;arg++)
 
915
    {
 
916
        LispStringPtr variable=NULL;
 
917
        if (aMacroMode)
 
918
        {
 
919
            LispPtr result;
 
920
            InternalEval(aEnvironment, result,  Argument(aArguments,arg));
 
921
            variable = result.Get()->String();
 
922
        }
 
923
        else
 
924
        {
 
925
            variable = Argument(aArguments,arg).Get()->String();
 
926
        }
 
927
        CHK_ARG(variable != NULL,arg);
 
928
        aEnvironment.NewLocal(variable,NULL);
 
929
    }
 
930
    InternalTrue(aEnvironment,aResult);
 
931
}
 
932
 
 
933
void LispNewLocal(LispEnvironment& aEnvironment, LispPtr& aResult,
 
934
                  LispPtr& aArguments)
 
935
{
 
936
    InternalNewLocal(aEnvironment, aResult,aArguments, LispFalse);
 
937
}
 
938
 
 
939
void LispMacroNewLocal(LispEnvironment& aEnvironment, LispPtr& aResult,
 
940
                       LispPtr& aArguments)
 
941
{
 
942
    InternalNewLocal(aEnvironment, aResult,aArguments, LispTrue);
 
943
}
 
944
 
 
945
 
 
946
void LispWhile(LispEnvironment& aEnvironment, LispPtr& aResult,
 
947
                  LispPtr& aArguments)
 
948
{
 
949
    TESTARGS(3);
 
950
 
 
951
    LispPtr& arg1 = Argument(aArguments,1);
 
952
    LispPtr& arg2 = Argument(aArguments,2);
 
953
    
 
954
    LispPtr predicate;
 
955
    InternalEval(aEnvironment, predicate, arg1);
 
956
 
 
957
    while (IsTrue(aEnvironment,predicate))
 
958
    {
 
959
        LispPtr evaluated;
 
960
        InternalEval(aEnvironment, evaluated, arg2);
 
961
        InternalEval(aEnvironment, predicate, arg1);
 
962
 
 
963
    }
 
964
    CHK_ARG(IsFalse(aEnvironment,predicate),1);
 
965
    InternalTrue(aEnvironment,aResult);
 
966
}
 
967
 
 
968
 
 
969
 
 
970
 
 
971
static void MultiFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
972
                     LispPtr& aArguments, LispOperators& aOps)
 
973
{
 
974
    TESTARGS(3);
 
975
 
 
976
    // Get operator
 
977
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
978
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
979
    CHK_ARG(orig != NULL, 1);
 
980
    
 
981
    LispPtr precedence;
 
982
    InternalEval(aEnvironment, precedence, Argument(aArguments,2));
 
983
    CHK_ARG(precedence.Get()->String() != NULL, 2);
 
984
    LispInt prec = InternalAsciiToInt(precedence.Get()->String()->String());
 
985
    CHK_ARG(prec <= KMaxPrecedence, 2);
 
986
    aOps.SetOperator(prec,SymbolName(aEnvironment,orig->String()));
 
987
    InternalTrue(aEnvironment,aResult);
 
988
}
 
989
 
 
990
void LispInFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
991
                  LispPtr& aArguments)
 
992
{
 
993
    MultiFix(aEnvironment, aResult, aArguments, aEnvironment.InFix());
 
994
}
 
995
 
 
996
 
 
997
static void SingleFix(LispInt aPrecedence, LispEnvironment& aEnvironment, LispPtr& aResult,
 
998
                  LispPtr& aArguments, LispOperators& aOps)
 
999
{
 
1000
    TESTARGS(2);
 
1001
 
 
1002
    // Get operator
 
1003
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1004
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
1005
    CHK_ARG(orig != NULL, 1);
 
1006
    aOps.SetOperator(aPrecedence,SymbolName(aEnvironment,orig->String()));
 
1007
    InternalTrue(aEnvironment,aResult);
 
1008
}
 
1009
void LispPreFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1010
                  LispPtr& aArguments)
 
1011
{
 
1012
    LispInt nrArguments = InternalListLength(aArguments);
 
1013
    if (nrArguments == 2)
 
1014
    {
 
1015
        SingleFix(0, aEnvironment, aResult,aArguments, aEnvironment.PreFix());
 
1016
    }
 
1017
    else
 
1018
    {
 
1019
        MultiFix(aEnvironment, aResult, aArguments, aEnvironment.PreFix());
 
1020
    }
 
1021
}
 
1022
void LispPostFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1023
                  LispPtr& aArguments)
 
1024
{
 
1025
    LispInt nrArguments = InternalListLength(aArguments);
 
1026
    if (nrArguments == 2)
 
1027
    {
 
1028
        SingleFix(0, aEnvironment, aResult,aArguments, aEnvironment.PostFix());
 
1029
    }
 
1030
    else
 
1031
    {
 
1032
        MultiFix(aEnvironment, aResult, aArguments, aEnvironment.PostFix());
 
1033
    }
 
1034
//    SingleFix(0, aEnvironment, aResult,aArguments, aEnvironment.PostFix());
 
1035
}
 
1036
void LispBodied(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1037
                  LispPtr& aArguments)
 
1038
{
 
1039
    MultiFix(aEnvironment, aResult, aArguments, aEnvironment.Bodied());
 
1040
}
 
1041
 
 
1042
 
 
1043
void LispAtomize(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1044
                  LispPtr& aArguments)
 
1045
{
 
1046
    TESTARGS(2);
 
1047
 
 
1048
    LispPtr evaluated;
 
1049
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1050
 
 
1051
    // Get operator
 
1052
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1053
    LispStringPtr orig = evaluated.Get()->String();
 
1054
    CHK_ARG(orig != NULL, 1);
 
1055
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUpUnStringify(orig->String())));
 
1056
}
 
1057
 
 
1058
 
 
1059
void LispStringify(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1060
                   LispPtr& aArguments)
 
1061
{
 
1062
    TESTARGS(2);
 
1063
 
 
1064
    LispPtr evaluated;
 
1065
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1066
 
 
1067
    // Get operator
 
1068
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1069
    LispStringPtr orig = evaluated.Get()->String();
 
1070
    CHK_ARG(orig != NULL, 1);
 
1071
 
 
1072
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUpStringify(orig->String())));
 
1073
}
 
1074
 
 
1075
 
 
1076
 
 
1077
 
 
1078
void LispLoad(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1079
                  LispPtr& aArguments)
 
1080
{
 
1081
    TESTARGS(2);
 
1082
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1083
 
 
1084
    LispPtr evaluated;
 
1085
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1086
 
 
1087
    // Get file name
 
1088
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1089
    LispStringPtr orig = evaluated.Get()->String();
 
1090
    CHK_ARG(orig != NULL, 1);
 
1091
 
 
1092
    InternalLoad(aEnvironment,orig);
 
1093
    InternalTrue(aEnvironment,aResult);
 
1094
}
 
1095
 
 
1096
 
 
1097
static void InternalRuleBase(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1098
                             LispPtr& aArguments, LispBoolean aMacroMode,
 
1099
                             LispInt aListed)
 
1100
{
 
1101
    TESTARGS(3);
 
1102
    
 
1103
    // Get operator
 
1104
    LispPtr args;
 
1105
    LispStringPtr orig=NULL;
 
1106
    
 
1107
    if (aMacroMode)
 
1108
    {
 
1109
        LispPtr result;
 
1110
        InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1111
        orig = result.Get()->String();
 
1112
        CHK_ARG(orig != NULL, 1);
 
1113
        InternalEval(aEnvironment, args, Argument(aArguments,2));
 
1114
    }
 
1115
    else
 
1116
    {
 
1117
        CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1118
        orig = Argument(aArguments,1).Get()->String();
 
1119
        CHK_ARG(orig != NULL, 1);
 
1120
        args.Set(Argument(aArguments,2).Get());
 
1121
    }
 
1122
    
 
1123
    // The arguments
 
1124
    CHK_ISLIST(args,2);
 
1125
 
 
1126
    // Finally define the rule base
 
1127
    aEnvironment.DeclareRuleBase(SymbolName(aEnvironment,orig->String()),
 
1128
                                 args.Get()->SubList()->Get()->Next(),aListed);
 
1129
    
 
1130
    // Return LispTrue
 
1131
    InternalTrue(aEnvironment,aResult);
 
1132
}
 
1133
 
 
1134
void LispRuleBase(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1135
                  LispPtr& aArguments)
 
1136
{
 
1137
    InternalRuleBase(aEnvironment, aResult, aArguments, LispFalse,LispFalse);
 
1138
}
 
1139
void LispMacroRuleBase(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1140
                       LispPtr& aArguments)
 
1141
{
 
1142
    InternalRuleBase(aEnvironment, aResult, aArguments, LispTrue,LispFalse);
 
1143
}
 
1144
 
 
1145
void LispRuleBaseListed(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1146
                  LispPtr& aArguments)
 
1147
{
 
1148
    InternalRuleBase(aEnvironment, aResult, aArguments, LispFalse,LispTrue);
 
1149
}
 
1150
void LispMacroRuleBaseListed(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1151
                       LispPtr& aArguments)
 
1152
{
 
1153
    InternalRuleBase(aEnvironment, aResult, aArguments, LispTrue,LispTrue);
 
1154
}
 
1155
 
 
1156
 
 
1157
void LispHoldArg(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1158
                  LispPtr& aArguments)
 
1159
{
 
1160
    TESTARGS(3);
 
1161
    
 
1162
    // Get operator
 
1163
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1164
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
1165
    CHK_ARG(orig != NULL, 1);
 
1166
 
 
1167
    // The arguments
 
1168
    LispStringPtr tohold = Argument(aArguments,2).Get()->String();
 
1169
    CHK_ARG(tohold != NULL, 2);
 
1170
    aEnvironment.HoldArgument(SymbolName(aEnvironment,orig->String()), tohold);
 
1171
    // Return LispTrue
 
1172
    InternalTrue(aEnvironment,aResult);
 
1173
}
 
1174
 
 
1175
static void InternalNewRule(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1176
                            LispPtr& aArguments, LispBoolean aMacroMode)
 
1177
{
 
1178
    TESTARGS(6);
 
1179
 
 
1180
    LispInt arity;
 
1181
    LispInt precedence;
 
1182
 
 
1183
    LispPtr ar;
 
1184
    LispPtr pr;
 
1185
    LispPtr predicate;
 
1186
    LispPtr body;
 
1187
    LispStringPtr orig=NULL;
 
1188
    
 
1189
    // Get operator
 
1190
    if (aMacroMode)
 
1191
    {
 
1192
        LispPtr result;
 
1193
        InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1194
        CHK_ARG(result.Get() != NULL, 1);
 
1195
        orig = result.Get()->String();
 
1196
        CHK_ARG(orig != NULL, 1);
 
1197
 
 
1198
        InternalEval(aEnvironment, ar, Argument(aArguments,2));
 
1199
        InternalEval(aEnvironment, pr, Argument(aArguments,3));
 
1200
        InternalEval(aEnvironment, predicate, Argument(aArguments,4));
 
1201
        InternalEval(aEnvironment, body, Argument(aArguments,5));
 
1202
    }
 
1203
    else
 
1204
    {
 
1205
        CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1206
        orig = Argument(aArguments,1).Get()->String();
 
1207
        CHK_ARG(orig != NULL, 1);
 
1208
        ar.Set(Argument(aArguments,2).Get());
 
1209
        pr.Set(Argument(aArguments,3).Get());
 
1210
        predicate.Set(Argument(aArguments,4).Get());
 
1211
        body.Set(Argument(aArguments,5).Get());
 
1212
    }
 
1213
    
 
1214
    // The arity
 
1215
    CHK_ARG(ar.Get() != NULL, 2);
 
1216
    CHK_ARG(ar.Get()->String() != NULL, 2);
 
1217
    arity = InternalAsciiToInt(ar.Get()->String()->String());
 
1218
 
 
1219
    // The precedence
 
1220
    CHK_ARG(pr.Get() != NULL, 3);
 
1221
    CHK_ARG(pr.Get()->String() != NULL, 3);
 
1222
    precedence = InternalAsciiToInt(pr.Get()->String()->String());
 
1223
    
 
1224
    // Finally define the rule base
 
1225
    aEnvironment.DefineRule(SymbolName(aEnvironment,orig->String()),
 
1226
                            arity,
 
1227
                            precedence,
 
1228
                            predicate,
 
1229
                            body );
 
1230
 
 
1231
    // Return LispTrue
 
1232
    InternalTrue(aEnvironment,aResult);
 
1233
}
 
1234
 
 
1235
void LispNewRule(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1236
                  LispPtr& aArguments)
 
1237
{
 
1238
    InternalNewRule(aEnvironment, aResult,aArguments, LispFalse);
 
1239
}
 
1240
 
 
1241
void LispMacroNewRule(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1242
                  LispPtr& aArguments)
 
1243
{
 
1244
    InternalNewRule(aEnvironment, aResult,aArguments, LispTrue);
 
1245
}
 
1246
 
 
1247
 
 
1248
void LispUnFence(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1249
                  LispPtr& aArguments)
 
1250
{
 
1251
    TESTARGS(3);
 
1252
    
 
1253
    // Get operator
 
1254
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1255
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
1256
    CHK_ARG(orig != NULL, 1);
 
1257
 
 
1258
    // The arity
 
1259
    CHK_ARG(Argument(aArguments,2).Get() != NULL, 2);
 
1260
    CHK_ARG(Argument(aArguments,2).Get()->String() != NULL, 2);
 
1261
    LispInt arity = InternalAsciiToInt(Argument(aArguments,2).Get()->String()->String());
 
1262
 
 
1263
    aEnvironment.UnFenceRule(SymbolName(aEnvironment,orig->String()),
 
1264
                            arity);
 
1265
    
 
1266
    // Return LispTrue
 
1267
    InternalTrue(aEnvironment,aResult);
 
1268
}
 
1269
 
 
1270
 
 
1271
 
 
1272
void LispIsFunction(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1273
              LispPtr& aArguments)
 
1274
{
 
1275
    TESTARGS(2);
 
1276
    LispPtr result;
 
1277
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1278
    InternalBoolean(aEnvironment,aResult,
 
1279
                    result.Get()->SubList()!=NULL);
 
1280
}
 
1281
void LispIsAtom(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1282
              LispPtr& aArguments)
 
1283
{
 
1284
    TESTARGS(2);
 
1285
    LispPtr result;
 
1286
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1287
    InternalBoolean(aEnvironment,aResult,
 
1288
                    result.Get()->String()!=NULL);
 
1289
}
 
1290
void LispIsNumber(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1291
              LispPtr& aArguments)
 
1292
{
 
1293
    TESTARGS(2);
 
1294
    LispPtr result;
 
1295
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1296
    if (result.Get()->String() == NULL)
 
1297
    {
 
1298
        InternalFalse(aEnvironment,aResult);
 
1299
    }
 
1300
    else
 
1301
    {
 
1302
        InternalBoolean(aEnvironment,aResult,
 
1303
                        IsNumber(result.Get()->String()->String(),LispTrue));
 
1304
    }
 
1305
}
 
1306
 
 
1307
void LispIsInteger(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1308
              LispPtr& aArguments)
 
1309
{
 
1310
    TESTARGS(2);
 
1311
    LispPtr result;
 
1312
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1313
    if (result.Get()->String() == NULL)
 
1314
    {
 
1315
        InternalFalse(aEnvironment,aResult);
 
1316
    }
 
1317
    else
 
1318
    {
 
1319
        InternalBoolean(aEnvironment,aResult,
 
1320
                        IsNumber(result.Get()->String()->String(),LispFalse));
 
1321
    }
 
1322
}
 
1323
 
 
1324
 
 
1325
void LispIsList(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1326
              LispPtr& aArguments)
 
1327
{
 
1328
    TESTARGS(2);
 
1329
    LispPtr result;
 
1330
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1331
    InternalBoolean(aEnvironment,aResult,InternalIsList(result));
 
1332
}
 
1333
 
 
1334
 
 
1335
void LispIsString(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1336
              LispPtr& aArguments)
 
1337
{
 
1338
    TESTARGS(2);
 
1339
    LispPtr result;
 
1340
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1341
    InternalBoolean(aEnvironment,aResult,
 
1342
                    InternalIsString(result.Get()->String()));
 
1343
}
 
1344
 
 
1345
void LispIsBound(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1346
              LispPtr& aArguments)
 
1347
{
 
1348
    TESTARGS(2);
 
1349
    LispStringPtr str = Argument(aArguments,1).Get()->String();
 
1350
    if (str)
 
1351
    {
 
1352
        LispPtr val;
 
1353
        aEnvironment.GetVariable(str,val);
 
1354
        if (val.Get())
 
1355
        {
 
1356
            InternalTrue(aEnvironment,aResult);
 
1357
            return;
 
1358
        }
 
1359
    }
 
1360
    InternalFalse(aEnvironment,aResult);
 
1361
}
 
1362
 
 
1363
 
 
1364
 
 
1365
void LispIf(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1366
                  LispPtr& aArguments)
 
1367
{
 
1368
    LispInt nrArguments = InternalListLength(aArguments);
 
1369
    CHK(nrArguments == 3 || nrArguments == 4,KLispErrWrongNumberOfArgs);
 
1370
 
 
1371
    LispPtr predicate;
 
1372
    InternalEval(aEnvironment, predicate, Argument(aArguments,1));
 
1373
 
 
1374
    if (IsTrue(aEnvironment,predicate))
 
1375
    {
 
1376
        InternalEval(aEnvironment, aResult, Argument(aArguments,2));
 
1377
    }
 
1378
    else
 
1379
    {
 
1380
        CHK_ARG(IsFalse(aEnvironment,predicate),1);
 
1381
        if (nrArguments == 4)
 
1382
        {
 
1383
            InternalEval(aEnvironment, aResult, Argument(aArguments,3));
 
1384
        }
 
1385
        else
 
1386
        {
 
1387
            InternalFalse(aEnvironment,aResult);
 
1388
        }
 
1389
    }
 
1390
}
 
1391
 
 
1392
 
 
1393
 
 
1394
void LispRetract(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1395
                 LispPtr& aArguments)
 
1396
{
 
1397
    TESTARGS(3);
 
1398
 
 
1399
    // Get operator
 
1400
    LispPtr evaluated;
 
1401
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1402
 
 
1403
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1404
    LispStringPtr orig = evaluated.Get()->String();
 
1405
    CHK_ARG(orig != NULL, 1);
 
1406
    LispStringPtr oper = SymbolName(aEnvironment,orig->String());
 
1407
//TODO remove    InternalUnstringify(oper, orig);
 
1408
    
 
1409
    LispPtr arity;
 
1410
    InternalEval(aEnvironment, arity, Argument(aArguments,2));
 
1411
    CHK_ARG(arity.Get()->String() != NULL, 2);
 
1412
    LispInt ar = InternalAsciiToInt(arity.Get()->String()->String());
 
1413
    aEnvironment.Retract(oper, ar);
 
1414
    InternalTrue(aEnvironment,aResult);
 
1415
}
 
1416
 
 
1417
 
 
1418
void LispPrecision(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1419
                   LispPtr& aArguments)
 
1420
{
 
1421
    TESTARGS(2);
 
1422
 
 
1423
    LispPtr index;
 
1424
    InternalEval(aEnvironment, index, Argument(aArguments,1));
 
1425
    CHK_ARG(index.Get() != NULL, 1);
 
1426
    CHK_ARG(index.Get()->String() != NULL, 1);
 
1427
 
 
1428
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
1429
    CHK_ARG(ind>0,1);
 
1430
    aEnvironment.SetPrecision(ind);
 
1431
    InternalTrue(aEnvironment,aResult);
 
1432
}
 
1433
 
 
1434
 
 
1435
 
 
1436
void LispDefaultDirectory(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1437
                          LispPtr& aArguments)
 
1438
{
 
1439
    TESTARGS(2);
 
1440
 
 
1441
    LispPtr evaluated;
 
1442
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1443
 
 
1444
    // Get file name
 
1445
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1446
    LispStringPtr orig = evaluated.Get()->String();
 
1447
    CHK_ARG(orig != NULL, 1);
 
1448
    LispString oper;
 
1449
    InternalUnstringify(oper, orig);
 
1450
    aEnvironment.iInputDirectories.Append(NEW LispString(oper.String()));
 
1451
    InternalTrue(aEnvironment,aResult);
 
1452
}
 
1453
 
 
1454
 
 
1455
void LispFromFile(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1456
                  LispPtr& aArguments)
 
1457
{
 
1458
    TESTARGS(3);
 
1459
 
 
1460
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1461
    
 
1462
    LispPtr evaluated;
 
1463
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1464
 
 
1465
    // Get file name
 
1466
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1467
    LispStringPtr orig = evaluated.Get()->String();
 
1468
    CHK_ARG(orig != NULL, 1);
 
1469
 
 
1470
    LispStringPtr contents = aEnvironment.FindCachedFile(orig->String());
 
1471
    LispStringPtr hashedname = aEnvironment.HashTable().LookUpUnStringify(orig->String());
 
1472
//TODO remove?    LispRamFile* ramFile=aEnvironment.iRamDisk.LookUp(hashedname);
 
1473
 
 
1474
    InputStatus oldstatus = aEnvironment.iInputStatus;
 
1475
    aEnvironment.iInputStatus.SetTo(hashedname->String());
 
1476
 
 
1477
    //TODO remove?    if (ramFile != NULL)
 
1478
    if (contents)
 
1479
    {
 
1480
        StringInput newInput(*contents,aEnvironment.iInputStatus);
 
1481
        LispLocalInput localInput(aEnvironment, &newInput);
 
1482
 
 
1483
        // Evaluate the body
 
1484
        InternalEval(aEnvironment, aResult, Argument(aArguments,2));
 
1485
        delete contents;
 
1486
    }
 
1487
    else
 
1488
    {
 
1489
        //TODO make the file api platform independent!!!!
 
1490
        // Open file
 
1491
        LispLocalFile localFP(aEnvironment, hashedname->String(),LispTrue,
 
1492
                              aEnvironment.iInputDirectories);
 
1493
        CHK(localFP.iOpened != 0, KLispErrFileNotFound);
 
1494
        FILEINPUT newInput(localFP,aEnvironment.iInputStatus);
 
1495
        LispLocalInput localInput(aEnvironment, &newInput);
 
1496
 
 
1497
        // Evaluate the body
 
1498
        InternalEval(aEnvironment, aResult, Argument(aArguments,2));
 
1499
    }
 
1500
    aEnvironment.iInputStatus.RestoreFrom(oldstatus);
 
1501
    //Return the result
 
1502
}
 
1503
 
 
1504
 
 
1505
void LispFromString(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1506
                  LispPtr& aArguments)
 
1507
{
 
1508
    TESTARGS(3);
 
1509
 
 
1510
    LispPtr evaluated;
 
1511
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1512
 
 
1513
    // Get file name
 
1514
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1515
    LispStringPtr orig = evaluated.Get()->String();
 
1516
    CHK_ARG(orig != NULL, 1);
 
1517
    LispString oper;
 
1518
    InternalUnstringify(oper, orig);
 
1519
 
 
1520
    InputStatus oldstatus = aEnvironment.iInputStatus;
 
1521
    aEnvironment.iInputStatus.SetTo("String");
 
1522
    StringInput newInput(oper,aEnvironment.iInputStatus);
 
1523
    LispLocalInput localInput(aEnvironment, &newInput);
 
1524
 
 
1525
    // Evaluate the body
 
1526
    InternalEval(aEnvironment, aResult, Argument(aArguments,2));
 
1527
    aEnvironment.iInputStatus.RestoreFrom(oldstatus);
 
1528
 
 
1529
    //Return the result
 
1530
}
 
1531
 
 
1532
 
 
1533
void LispRead(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1534
              LispPtr& aArguments)
 
1535
{
 
1536
    LispTokenizer &tok = *aEnvironment.iCurrentTokenizer;
 
1537
    InfixParser parser(tok,
 
1538
                       *aEnvironment.CurrentInput(),
 
1539
                       aEnvironment.HashTable(),
 
1540
                       aEnvironment.PreFix(),
 
1541
                       aEnvironment.InFix(),
 
1542
                       aEnvironment.PostFix(),
 
1543
                       aEnvironment.Bodied());
 
1544
    // Read expression
 
1545
    parser.Parse(aResult,aEnvironment);
 
1546
}
 
1547
 
 
1548
 
 
1549
void LispReadToken(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1550
                   LispPtr& aArguments)
 
1551
{
 
1552
    LispTokenizer &tok = *aEnvironment.iCurrentTokenizer;
 
1553
    LispStringPtr result;
 
1554
    result = tok.NextToken(*aEnvironment.CurrentInput(),
 
1555
                           aEnvironment.HashTable());
 
1556
 
 
1557
    if (result->String()[0] == '\0')
 
1558
    {
 
1559
        aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp("EndOfFile")));
 
1560
        return;
 
1561
    }
 
1562
    aResult.Set(LispAtom::New(result));
 
1563
}
 
1564
 
 
1565
 
 
1566
void LispToFile(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1567
                  LispPtr& aArguments)
 
1568
{
 
1569
    TESTARGS(3);
 
1570
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1571
 
 
1572
    LispPtr evaluated;
 
1573
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1574
 
 
1575
    // Get file name
 
1576
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1577
    LispStringPtr orig = evaluated.Get()->String();
 
1578
    CHK_ARG(orig != NULL, 1);
 
1579
    LispString oper;
 
1580
    InternalUnstringify(oper, orig);
 
1581
 
 
1582
    //TODO make the file api platform independent!!!!
 
1583
    // Open file for writing
 
1584
    LispLocalFile localFP(aEnvironment, oper.String(),LispFalse,
 
1585
                          aEnvironment.iInputDirectories);
 
1586
    CHK(localFP.iOpened != 0, KLispErrFileNotFound);
 
1587
    StdFileOutput newOutput(localFP);
 
1588
    LispLocalOutput localOutput(aEnvironment, &newOutput);
 
1589
 
 
1590
    // Evaluate the body
 
1591
    InternalEval(aEnvironment, aResult, Argument(aArguments,2));
 
1592
 
 
1593
    //Return the result
 
1594
}
 
1595
 
 
1596
 
 
1597
 
 
1598
void LispCheck(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1599
               LispPtr& aArguments)
 
1600
{
 
1601
    TESTARGS(3);
 
1602
 
 
1603
    InternalEval(aEnvironment, aResult, Argument(aArguments,1));
 
1604
    if (!IsTrue(aEnvironment,aResult))
 
1605
    {
 
1606
        LispPtr evaluated;
 
1607
        InternalEval(aEnvironment, evaluated, Argument(aArguments,2));
 
1608
        CHK_ISSTRING(evaluated,2);
 
1609
        aEnvironment.SetUserError(evaluated.Get()->String()->String());
 
1610
        CHK(0,KLispErrUser);
 
1611
    }
 
1612
}
 
1613
 
 
1614
 
 
1615
 
 
1616
void LispSystemCall(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1617
               LispPtr& aArguments)
 
1618
{
 
1619
    TESTARGS(2);
 
1620
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1621
 
 
1622
    LispPtr result;
 
1623
    InternalEval(aEnvironment, result, Argument(aArguments,1));
 
1624
    CHK_ISSTRING(result,1);
 
1625
 
 
1626
    LispString command;
 
1627
    InternalUnstringify(command, result.Get()->String());
 
1628
#ifdef SystemCall
 
1629
    SystemCall(command.String());
 
1630
    InternalTrue(aEnvironment,aResult);
 
1631
#else
 
1632
    InternalFalse(aEnvironment,aResult);
 
1633
#endif
 
1634
}
 
1635
 
 
1636
 
 
1637
 
 
1638
 
 
1639
 
 
1640
 
 
1641
void LispFastPi(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1642
                  LispPtr& aArguments)
 
1643
{
 
1644
    TESTARGS(1);
 
1645
    aResult.Set(LispAtom::New(PlatPi(aEnvironment.HashTable(),
 
1646
                                         aEnvironment.Precision())));
 
1647
}
 
1648
 
 
1649
 
 
1650
 
 
1651
 
 
1652
 
 
1653
 
 
1654
 
 
1655
 
 
1656
 
 
1657
 
 
1658
 
 
1659
 
 
1660
 
 
1661
void LispMaxEvalDepth(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1662
                      LispPtr& aArguments)
 
1663
{
 
1664
    TESTARGS(2);
 
1665
 
 
1666
    LispPtr index;
 
1667
    InternalEval(aEnvironment, index, Argument(aArguments,1));
 
1668
    CHK_ARG(index.Get() != NULL, 1);
 
1669
    CHK_ARG(index.Get()->String() != NULL, 1);
 
1670
 
 
1671
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
1672
    aEnvironment.iMaxEvalDepth = ind;
 
1673
    InternalTrue(aEnvironment,aResult);
 
1674
}
 
1675
 
 
1676
 
 
1677
void LispDefLoad(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1678
                  LispPtr& aArguments)
 
1679
{
 
1680
    TESTARGS(2);
 
1681
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1682
 
 
1683
    LispPtr evaluated;
 
1684
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1685
 
 
1686
    // Get file name
 
1687
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1688
    LispStringPtr orig = evaluated.Get()->String();
 
1689
    CHK_ARG(orig != NULL, 1);
 
1690
 
 
1691
    LoadDefFile(aEnvironment, orig);
 
1692
    InternalTrue(aEnvironment,aResult);
 
1693
}
 
1694
 
 
1695
void LispUse(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1696
                  LispPtr& aArguments)
 
1697
{
 
1698
    TESTARGS(2);
 
1699
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1700
 
 
1701
    LispPtr evaluated;
 
1702
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1703
 
 
1704
    // Get file name
 
1705
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1706
    LispStringPtr orig = evaluated.Get()->String();
 
1707
    CHK_ARG(orig != NULL, 1);
 
1708
 
 
1709
    InternalUse(aEnvironment,orig);
 
1710
    InternalTrue(aEnvironment,aResult);
 
1711
}
 
1712
 
 
1713
void LispRightAssociative(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1714
                          LispPtr& aArguments)
 
1715
{
 
1716
    TESTARGS(2);
 
1717
    // Get operator
 
1718
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1719
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
1720
    CHK_ARG(orig != NULL, 1);
 
1721
    aEnvironment.InFix().SetRightAssociative(SymbolName(aEnvironment,orig->String()));
 
1722
    InternalTrue(aEnvironment,aResult);
 
1723
}
 
1724
 
 
1725
 
 
1726
void LispLeftPrecedence(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1727
                          LispPtr& aArguments)
 
1728
{
 
1729
    TESTARGS(3);
 
1730
    // Get operator
 
1731
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1732
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
1733
    CHK_ARG(orig != NULL, 1);
 
1734
 
 
1735
    LispPtr index;
 
1736
    InternalEval(aEnvironment, index, Argument(aArguments,2));
 
1737
    CHK_ARG(index.Get() != NULL, 2);
 
1738
    CHK_ARG(index.Get()->String() != NULL, 2);
 
1739
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
1740
 
 
1741
    aEnvironment.InFix().SetLeftPrecedence(SymbolName(aEnvironment,orig->String()),ind);
 
1742
    InternalTrue(aEnvironment,aResult);
 
1743
}
 
1744
 
 
1745
 
 
1746
void LispRightPrecedence(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1747
                          LispPtr& aArguments)
 
1748
{
 
1749
    TESTARGS(3);
 
1750
    // Get operator
 
1751
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1752
    LispStringPtr orig = Argument(aArguments,1).Get()->String();
 
1753
    CHK_ARG(orig != NULL, 1);
 
1754
 
 
1755
    LispPtr index;
 
1756
    InternalEval(aEnvironment, index, Argument(aArguments,2));
 
1757
    CHK_ARG(index.Get() != NULL, 2);
 
1758
    CHK_ARG(index.Get()->String() != NULL, 2);
 
1759
    LispInt ind = InternalAsciiToInt(index.Get()->String()->String());
 
1760
 
 
1761
    aEnvironment.InFix().SetRightPrecedence(SymbolName(aEnvironment,orig->String()),ind);
 
1762
    InternalTrue(aEnvironment,aResult);
 
1763
}
 
1764
 
 
1765
 
 
1766
 
 
1767
 
 
1768
 
 
1769
 
 
1770
 
 
1771
 
 
1772
 
 
1773
 
 
1774
 
 
1775
 
 
1776
 
 
1777
 
 
1778
 
 
1779
 
 
1780
static LispInFixOperator* OperatorInfo(LispEnvironment& aEnvironment,
 
1781
                                       LispPtr& aArguments,
 
1782
                                       LispOperators & aOperators)
 
1783
{
 
1784
    TESTARGS(2);
 
1785
    // Get operator
 
1786
    CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
1787
 
 
1788
    LispPtr evaluated;
 
1789
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1790
 
 
1791
    LispStringPtr orig = evaluated.Get()->String();
 
1792
    CHK_ARG(orig != NULL, 1);
 
1793
 
 
1794
    //
 
1795
    LispInFixOperator* op = aOperators.LookUp(
 
1796
                                              SymbolName(aEnvironment,orig->String()));
 
1797
    return op;
 
1798
}
 
1799
 
 
1800
 
 
1801
void LispIsInFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1802
               LispPtr& aArguments)
 
1803
{
 
1804
 
 
1805
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1806
                                         aArguments,
 
1807
                                         aEnvironment.InFix());
 
1808
    if (op != NULL)
 
1809
        InternalTrue( aEnvironment, aResult);
 
1810
    else
 
1811
        InternalFalse(aEnvironment, aResult);
 
1812
}
 
1813
 
 
1814
void LispIsBodied(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1815
               LispPtr& aArguments)
 
1816
{
 
1817
 
 
1818
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1819
                                         aArguments,
 
1820
                                         aEnvironment.Bodied());
 
1821
    if (op != NULL)
 
1822
        InternalTrue( aEnvironment, aResult);
 
1823
    else
 
1824
        InternalFalse(aEnvironment, aResult);
 
1825
}
 
1826
 
 
1827
void LispGetPrecedence(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1828
                       LispPtr& aArguments)
 
1829
{
 
1830
 
 
1831
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1832
                                         aArguments,
 
1833
                                         aEnvironment.InFix());
 
1834
    if (op == NULL) {   // also need to check for a postfix or prefix operator
 
1835
            op = OperatorInfo(aEnvironment,
 
1836
                          aArguments,
 
1837
                          aEnvironment.PreFix());
 
1838
        if (op == NULL) {
 
1839
                        op = OperatorInfo(aEnvironment,
 
1840
                              aArguments,
 
1841
                              aEnvironment.PostFix());
 
1842
                if (op == NULL) {       // or maybe it's a bodied function
 
1843
                                op = OperatorInfo(aEnvironment,
 
1844
                              aArguments,
 
1845
                              aEnvironment.Bodied());
 
1846
                        CHK(op!=NULL, KLispErrIsNotInFix);
 
1847
                        }
 
1848
                }
 
1849
        }
 
1850
    LispChar buf[30];
 
1851
    InternalIntToAscii(buf, op->iPrecedence);
 
1852
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(buf)));
 
1853
}
 
1854
 
 
1855
 
 
1856
void LispGetLeftPrecedence(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1857
                           LispPtr& aArguments)
 
1858
{
 
1859
 
 
1860
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1861
                                         aArguments,
 
1862
                                         aEnvironment.InFix());
 
1863
    if (op == NULL) {   // infix and postfix operators have left precedence
 
1864
            op = OperatorInfo(aEnvironment,
 
1865
                          aArguments,
 
1866
                          aEnvironment.PostFix());
 
1867
                CHK(op!=NULL, KLispErrIsNotInFix);
 
1868
        }
 
1869
 
 
1870
    LispChar buf[30];
 
1871
    InternalIntToAscii(buf, op->iLeftPrecedence);
 
1872
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(buf)));
 
1873
}
 
1874
void LispGetRightPrecedence(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1875
                            LispPtr& aArguments)
 
1876
{
 
1877
 
 
1878
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1879
                                         aArguments,
 
1880
                                         aEnvironment.InFix());
 
1881
    if (op == NULL) {   // bodied, infix and prefix operators have right precedence
 
1882
        op = OperatorInfo(aEnvironment,
 
1883
                          aArguments,
 
1884
                          aEnvironment.PreFix());
 
1885
        if (op == NULL) {   // or maybe it's a bodied function
 
1886
            op = OperatorInfo(aEnvironment,
 
1887
                          aArguments,
 
1888
                          aEnvironment.Bodied());
 
1889
            CHK(op!=NULL, KLispErrIsNotInFix);
 
1890
        }
 
1891
    }
 
1892
 
 
1893
    LispChar buf[30];
 
1894
    InternalIntToAscii(buf, op->iRightPrecedence);
 
1895
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(buf)));
 
1896
}
 
1897
 
 
1898
 
 
1899
 
 
1900
void LispIsPreFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1901
                  LispPtr& aArguments)
 
1902
{
 
1903
 
 
1904
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1905
                                         aArguments,
 
1906
                                         aEnvironment.PreFix());
 
1907
    if (op != NULL)
 
1908
        InternalTrue( aEnvironment, aResult);
 
1909
    else
 
1910
        InternalFalse(aEnvironment, aResult);
 
1911
}
 
1912
 
 
1913
void LispIsPostFix(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1914
                   LispPtr& aArguments)
 
1915
{
 
1916
 
 
1917
    LispInFixOperator* op = OperatorInfo(aEnvironment,
 
1918
                                         aArguments,
 
1919
                                         aEnvironment.PostFix());
 
1920
    if (op != NULL)
 
1921
        InternalTrue( aEnvironment, aResult);
 
1922
    else
 
1923
        InternalFalse(aEnvironment, aResult);
 
1924
}
 
1925
 
 
1926
void LispGetPrecision(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1927
                      LispPtr& aArguments)
 
1928
{
 
1929
    TESTARGS(1);
 
1930
    LispChar buf[30];
 
1931
    InternalIntToAscii(buf, aEnvironment.Precision());
 
1932
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(buf)));
 
1933
}
 
1934
 
 
1935
 
 
1936
 
 
1937
void LispToString(LispEnvironment& aEnvironment, LispPtr& aResult,
 
1938
                  LispPtr& aArguments)
 
1939
{
 
1940
    TESTARGS(2);
 
1941
 
 
1942
    LispString oper;
 
1943
    StringOutput newOutput(oper);
 
1944
 
 
1945
    LispLocalOutput localOutput(aEnvironment, &newOutput);
 
1946
 
 
1947
    // Evaluate the body
 
1948
    InternalEval(aEnvironment, aResult, Argument(aArguments,1));
 
1949
 
 
1950
    //Return the result
 
1951
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUpStringify(oper.String())));
 
1952
}
 
1953
 
 
1954
void LispSecure(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1955
              LispPtr& aArguments)
 
1956
{
 
1957
    TESTARGS(2);
 
1958
    LispSecureFrame security(aEnvironment);
 
1959
    InternalEval(aEnvironment, aResult, Argument(aArguments,1));
 
1960
}
 
1961
 
 
1962
 
 
1963
void LispFindFile(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1964
              LispPtr& aArguments)
 
1965
{
 
1966
 
 
1967
    TESTARGS(2);
 
1968
 
 
1969
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
1970
    
 
1971
    LispPtr evaluated;
 
1972
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1973
 
 
1974
    // Get file name
 
1975
    CHK_ARG(evaluated.Get() != NULL, 1);
 
1976
    LispStringPtr orig = evaluated.Get()->String();
 
1977
    CHK_ARG(orig != NULL, 1);
 
1978
    LispString oper;
 
1979
    InternalUnstringify(oper, orig);
 
1980
 
 
1981
    LispChar filename[1024];//TODO FIXME
 
1982
    InternalFindFile(oper.String(), aEnvironment.iInputDirectories,
 
1983
                     filename);
 
1984
    LispString res(filename,1);
 
1985
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUpStringify(res.String())));
 
1986
}
 
1987
 
 
1988
 
 
1989
void LispIsGeneric(LispEnvironment& aEnvironment,LispPtr& aResult,
 
1990
                   LispPtr& aArguments)
 
1991
{
 
1992
    TESTARGS(2);
 
1993
    LispPtr evaluated;
 
1994
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
1995
 
 
1996
    if (evaluated.Get()->Generic() != NULL)
 
1997
        InternalTrue( aEnvironment, aResult);
 
1998
    else
 
1999
        InternalFalse(aEnvironment, aResult);
 
2000
}
 
2001
 
 
2002
void LispGenericTypeName(LispEnvironment& aEnvironment,LispPtr& aResult,
 
2003
                         LispPtr& aArguments)
 
2004
{
 
2005
    TESTARGS(2);
 
2006
    LispPtr evaluated;
 
2007
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
2008
 
 
2009
    CHK_ARG(evaluated.Get()->Generic() != NULL,1);
 
2010
 
 
2011
    LispCharPtr name = evaluated.Get()->Generic()->TypeName();
 
2012
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(name)));
 
2013
}
 
2014
 
 
2015
void GenArrayCreate(LispEnvironment& aEnvironment,LispPtr& aResult,
 
2016
                    LispPtr& aArguments)
 
2017
{
 
2018
    TESTARGS(3);
 
2019
 
 
2020
    LispPtr sizearg;
 
2021
    InternalEval(aEnvironment, sizearg, Argument(aArguments,1));
 
2022
 
 
2023
    CHK_ARG(sizearg.Get() != NULL, 1);
 
2024
    CHK_ARG(sizearg.Get()->String() != NULL, 1);
 
2025
 
 
2026
    LispInt size = InternalAsciiToInt(sizearg.Get()->String()->String());
 
2027
 
 
2028
    LispPtr initarg;
 
2029
    InternalEval(aEnvironment, initarg, Argument(aArguments,2));
 
2030
     
 
2031
    ArrayClass *array = NEW ArrayClass(size,initarg.Get());
 
2032
    aResult.Set(LispGenericClass::New(array));
 
2033
}
 
2034
 
 
2035
void GenArraySize(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2036
{
 
2037
    TESTARGS(2);
 
2038
    LispPtr evaluated;
 
2039
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
2040
 
 
2041
    GenericClass *gen = evaluated.Get()->Generic();
 
2042
    CHK_ARG(gen != NULL,1);
 
2043
    CHK_ARG(StrEqual(gen->TypeName(),"\"Array\""),1);
 
2044
    LispInt size=((ArrayClass*)gen)->Size();
 
2045
    LispChar s[20];
 
2046
    InternalIntToAscii(s,size);
 
2047
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(s)));
 
2048
}
 
2049
 
 
2050
void GenArrayGet(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2051
{
 
2052
    TESTARGS(3);
 
2053
    LispPtr evaluated;
 
2054
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
2055
 
 
2056
    GenericClass *gen = evaluated.Get()->Generic();
 
2057
    CHK_ARG(gen != NULL,1);
 
2058
    CHK_ARG(StrEqual(gen->TypeName(),"\"Array\""),1);
 
2059
 
 
2060
    LispPtr sizearg;
 
2061
    InternalEval(aEnvironment, sizearg, Argument(aArguments,2));
 
2062
 
 
2063
    CHK_ARG(sizearg.Get() != NULL, 2);
 
2064
    CHK_ARG(sizearg.Get()->String() != NULL, 2);
 
2065
 
 
2066
    LispInt size = InternalAsciiToInt(sizearg.Get()->String()->String());
 
2067
 
 
2068
 
 
2069
    CHK_ARG(size>0 && size<=((ArrayClass*)gen)->Size(),2);
 
2070
    LispObject* object = ((ArrayClass*)gen)->GetElement(size);
 
2071
 
 
2072
    aResult.Set(object->Copy(LispFalse));
 
2073
}
 
2074
 
 
2075
 
 
2076
void GenArraySet(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2077
{
 
2078
    TESTARGS(4);
 
2079
 
 
2080
    LispPtr evaluated;
 
2081
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
2082
 
 
2083
    GenericClass *gen = evaluated.Get()->Generic();
 
2084
    CHK_ARG(gen != NULL,1);
 
2085
    CHK_ARG(StrEqual(gen->TypeName(),"\"Array\""),1);
 
2086
 
 
2087
    LispPtr sizearg;
 
2088
    InternalEval(aEnvironment, sizearg, Argument(aArguments,2));
 
2089
 
 
2090
    CHK_ARG(sizearg.Get() != NULL, 2);
 
2091
    CHK_ARG(sizearg.Get()->String() != NULL, 2);
 
2092
 
 
2093
    LispInt size = InternalAsciiToInt(sizearg.Get()->String()->String());
 
2094
    CHK_ARG(size>0 && size<=((ArrayClass*)gen)->Size(),2);
 
2095
 
 
2096
    LispPtr obj;
 
2097
    InternalEval(aEnvironment, obj, Argument(aArguments,3));
 
2098
    ((ArrayClass*)gen)->SetElement(size,obj.Get());
 
2099
    InternalTrue( aEnvironment, aResult);
 
2100
}
 
2101
 
 
2102
void LispTrace(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2103
{
 
2104
    TESTARGS(2);
 
2105
    LispLocalEvaluator local(aEnvironment,NEW TracedEvaluator);
 
2106
    aEnvironment.iDebugger->Start();
 
2107
    InternalEval(aEnvironment, aResult, Argument(aArguments,1));
 
2108
    aEnvironment.iDebugger->Finish();
 
2109
}
 
2110
 
 
2111
void LispTraceStack(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2112
{
 
2113
    TESTARGS(2);
 
2114
    LispLocalEvaluator local(aEnvironment,NEW TracedStackEvaluator);
 
2115
    InternalEval(aEnvironment, aResult, Argument(aArguments,1));
 
2116
}
 
2117
 
 
2118
 
 
2119
void LispReadLisp(LispEnvironment& aEnvironment, LispPtr& aResult,
 
2120
                  LispPtr& aArguments)
 
2121
{
 
2122
    LispTokenizer &tok = *aEnvironment.iCurrentTokenizer;
 
2123
    LispParser parser(tok,
 
2124
                      *aEnvironment.CurrentInput(),
 
2125
                      aEnvironment.HashTable());
 
2126
    // Read expression
 
2127
    parser.Parse(aResult,aEnvironment);
 
2128
}
 
2129
 
 
2130
 
 
2131
void LispTraceRule(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2132
{
 
2133
    TESTARGS(3);
 
2134
    LispPtr *ptr = aArguments.Get()->Next().Get()->SubList();
 
2135
    LispUserFunction* userfunc=NULL;
 
2136
    if (ptr != NULL)
 
2137
        userfunc = GetUserFunction(aEnvironment,ptr);
 
2138
    LispLocalTrace trace(userfunc);
 
2139
    InternalEval(aEnvironment, aResult, Argument(aArguments,2));
 
2140
}
 
2141
 
 
2142
void LispType(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2143
{
 
2144
    TESTARGS(2);
 
2145
    LispPtr evaluated;
 
2146
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
2147
    LispPtr* subList = evaluated.Get()->SubList();
 
2148
    LispObject* head = NULL;
 
2149
    if (!subList)
 
2150
    {
 
2151
        goto EMPTY;
 
2152
    }
 
2153
    head = subList->Get();
 
2154
    if (!head->String())
 
2155
        goto EMPTY;
 
2156
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUpStringify(head->String()->String())));
 
2157
    return;
 
2158
    
 
2159
EMPTY:
 
2160
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp("\"\"")));
 
2161
    return;
 
2162
}
 
2163
 
 
2164
 
 
2165
 
 
2166
void LispStringMid(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2167
{
 
2168
    TESTARGS(4);
 
2169
    LispPtr evaluated;
 
2170
    InternalEval(aEnvironment, evaluated, Argument(aArguments,3));
 
2171
    CHK_ISSTRING(evaluated,3);
 
2172
    LispStringPtr orig = evaluated.Get()->String();
 
2173
    
 
2174
    LispPtr index;
 
2175
    InternalEval(aEnvironment, index, Argument(aArguments,1));
 
2176
    CHK_ARG(index.Get() != NULL, 1);
 
2177
    CHK_ARG(index.Get()->String() != NULL, 1);
 
2178
    LispInt from = InternalAsciiToInt(index.Get()->String()->String());
 
2179
    CHK_ARG(from>0,1);
 
2180
    
 
2181
    InternalEval(aEnvironment, index, Argument(aArguments,2));
 
2182
    CHK_ARG(index.Get() != NULL, 2);
 
2183
    CHK_ARG(index.Get()->String() != NULL, 2);
 
2184
    LispInt count = InternalAsciiToInt(index.Get()->String()->String());
 
2185
 
 
2186
    
 
2187
    LispString str;
 
2188
    str.SetNrItems(0);
 
2189
    str.Append('\"');
 
2190
    LispInt i;
 
2191
    CHK(from+count<orig->NrItems()-1, KLispErrInvalidArg);
 
2192
    for (i=from;i<from+count;i++)
 
2193
        str.Append((*orig)[i]);
 
2194
    str.Append('\"');
 
2195
    str.Append('\0');
 
2196
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(str.String())));
 
2197
}
 
2198
 
 
2199
 
 
2200
void LispSetStringMid(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2201
{
 
2202
    TESTARGS(4);
 
2203
    LispPtr evaluated;
 
2204
    InternalEval(aEnvironment, evaluated, Argument(aArguments,3));
 
2205
    CHK_ISSTRING(evaluated,3);
 
2206
    LispStringPtr orig = evaluated.Get()->String();
 
2207
    LispPtr index;
 
2208
    InternalEval(aEnvironment, index, Argument(aArguments,1));
 
2209
    CHK_ARG(index.Get() != NULL, 1);
 
2210
    CHK_ARG(index.Get()->String() != NULL, 1);
 
2211
    LispInt from = InternalAsciiToInt(index.Get()->String()->String());
 
2212
 
 
2213
    CHK_ARG(from>0,1);
 
2214
    
 
2215
    LispPtr ev2;
 
2216
    InternalEval(aEnvironment, ev2, Argument(aArguments,2));
 
2217
    CHK_ISSTRING(ev2,2);
 
2218
    LispStringPtr replace = ev2.Get()->String();
 
2219
 
 
2220
    LispString str(orig->String());
 
2221
    LispInt i;
 
2222
    LispInt count = replace->NrItems();
 
2223
    CHK(from+count-3<orig->NrItems()-1, KLispErrInvalidArg);
 
2224
 
 
2225
    for (i=0;i<count-3;i++)
 
2226
        str[i+from] = (*replace)[i+1];
 
2227
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(str.String())));
 
2228
}
 
2229
 
 
2230
 
 
2231
 
 
2232
void LispFindFunction(LispEnvironment& aEnvironment,LispPtr& aResult,
 
2233
                      LispPtr& aArguments)
 
2234
{
 
2235
    TESTARGS(2);
 
2236
    CHK(aEnvironment.iSecure == 0, KLispErrSecurityBreach);
 
2237
    
 
2238
    LispPtr evaluated;
 
2239
    InternalEval(aEnvironment, evaluated, Argument(aArguments,1));
 
2240
 
 
2241
    // Get file name
 
2242
    CHK_ARG(evaluated.Get() != NULL, 1);
 
2243
    LispStringPtr orig = evaluated.Get()->String();
 
2244
    CHK_ARG(orig != NULL, 1);
 
2245
    LispString oper;
 
2246
    InternalUnstringify(oper, orig);
 
2247
 
 
2248
    LispMultiUserFunction* multiUserFunc =
 
2249
        aEnvironment.MultiUserFunction(aEnvironment.HashTable().LookUp(oper.String()));
 
2250
    if (multiUserFunc != NULL)
 
2251
    {
 
2252
        LispDefFile* def = multiUserFunc->iFileToOpen;
 
2253
        if (def != NULL)
 
2254
        {
 
2255
            aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp(def->iFileName()->String())));
 
2256
            return;
 
2257
        }
 
2258
    }
 
2259
    aResult.Set(LispAtom::New(aEnvironment.HashTable().LookUp("\"\"")));
 
2260
}
 
2261
 
 
2262
 
 
2263
 
 
2264
 
 
2265
 
 
2266
 
 
2267
 
 
2268
 
 
2269
 
 
2270
 
 
2271
 
 
2272
 
 
2273
 
 
2274
 
 
2275
 
 
2276
 
 
2277
 
 
2278
 
 
2279
 
 
2280
 
 
2281
void GenPatternCreate(LispEnvironment& aEnvironment,LispPtr& aResult,
 
2282
                      LispPtr& aArguments)
 
2283
{
 
2284
    TESTARGS(3);
 
2285
    LispPtr pattern;
 
2286
    InternalEval(aEnvironment, pattern, Argument(aArguments,1));
 
2287
    LispPtr postpredicate;
 
2288
    InternalEval(aEnvironment, postpredicate, Argument(aArguments,2));
 
2289
 
 
2290
    LispIterator iter(pattern);
 
2291
    CHK_ARG(iter() != NULL,1);
 
2292
    CHK_ARG(iter()->SubList() != NULL,1);
 
2293
    iter.GoSub();
 
2294
    CHK_ARG(iter() != NULL,1);
 
2295
    iter.GoNext();
 
2296
 
 
2297
    LispPtr *ptr = iter.Ptr();
 
2298
 
 
2299
 
 
2300
    YacasPatternPredicateBase* matcher =
 
2301
        NEW YacasPatternPredicateBase(aEnvironment, *ptr,postpredicate);
 
2302
    PatternClass *p = NEW PatternClass(matcher);
 
2303
    aResult.Set(LispGenericClass::New(p));
 
2304
}
 
2305
void GenPatternMatches(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2306
{
 
2307
    TESTARGS(3);
 
2308
    LispPtr pattern;
 
2309
    InternalEval(aEnvironment, pattern, Argument(aArguments,1));
 
2310
    GenericClass *gen = pattern.Get()->Generic();
 
2311
    CHK_ARG(gen != NULL,1);
 
2312
    CHK_ARG(StrEqual(gen->TypeName(),"\"Pattern\""),1);
 
2313
 
 
2314
    LispPtr list;
 
2315
    InternalEval(aEnvironment, list, Argument(aArguments,2));
 
2316
 
 
2317
    PatternClass *patclass = (PatternClass*)gen;
 
2318
 
 
2319
    LispIterator iter(list);
 
2320
    CHK_ARG(iter() != NULL,2);
 
2321
    CHK_ARG(iter()->SubList() != NULL,2);
 
2322
    iter.GoSub();
 
2323
    CHK_ARG(iter() != NULL,2);
 
2324
    iter.GoNext();
 
2325
 
 
2326
    LispPtr *ptr = iter.Ptr();
 
2327
    CHK_ARG(ptr != NULL,2);
 
2328
    LispBoolean matches = patclass->Matches(aEnvironment,*ptr);
 
2329
    InternalBoolean(aEnvironment,aResult,matches);
 
2330
}
 
2331
 
 
2332
void LispRuleBaseDefined(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2333
{
 
2334
    TESTARGS(3);
 
2335
    LispPtr name;
 
2336
    InternalEval(aEnvironment, name, Argument(aArguments,1));
 
2337
    LispStringPtr orig = name.Get()->String();
 
2338
    CHK_ARG(orig != NULL, 1);
 
2339
    LispString oper;
 
2340
    InternalUnstringify(oper, orig);
 
2341
 
 
2342
    LispPtr sizearg;
 
2343
    InternalEval(aEnvironment, sizearg, Argument(aArguments,2));
 
2344
    CHK_ARG(sizearg.Get() != NULL, 2);
 
2345
    CHK_ARG(sizearg.Get()->String() != NULL, 2);
 
2346
 
 
2347
    LispInt arity = InternalAsciiToInt(sizearg.Get()->String()->String());
 
2348
 
 
2349
    LispUserFunction* userFunc = aEnvironment.UserFunction(aEnvironment.HashTable().LookUp(oper.String()),arity);
 
2350
    InternalBoolean(aEnvironment,aResult,userFunc != NULL);
 
2351
}
 
2352
 
 
2353
void LispDefLoadFunction(LispEnvironment& aEnvironment,LispPtr& aResult,
 
2354
                         LispPtr& aArguments)
 
2355
{
 
2356
    TESTARGS(2);
 
2357
    LispPtr name;
 
2358
    InternalEval(aEnvironment, name, Argument(aArguments,1));
 
2359
    LispStringPtr orig = name.Get()->String();
 
2360
    CHK_ARG(orig != NULL, 1);
 
2361
    LispString oper;
 
2362
    InternalUnstringify(oper, orig);
 
2363
 
 
2364
    LispMultiUserFunction* multiUserFunc =
 
2365
        aEnvironment.MultiUserFunction(aEnvironment.HashTable().LookUp(oper.String()));
 
2366
    if (multiUserFunc != NULL)
 
2367
    {
 
2368
        if (multiUserFunc->iFileToOpen!=NULL)
 
2369
        {
 
2370
            LispDefFile* def = multiUserFunc->iFileToOpen;
 
2371
            if (!def->iIsLoaded)
 
2372
            {
 
2373
#ifdef YACAS_DEBUG
 
2374
                /*Show loading... */
 
2375
                printf("Debug> Loading file %s for function %s\n",def->iFileName()->String(),oper.String());
 
2376
#endif
 
2377
                multiUserFunc->iFileToOpen=NULL;
 
2378
                InternalUse(aEnvironment,def->iFileName());
 
2379
            }
 
2380
        }
 
2381
    }
 
2382
    InternalTrue(aEnvironment,aResult);
 
2383
}
 
2384
 
 
2385
 
 
2386
void LispRuleBaseArgList(LispEnvironment& aEnvironment,LispPtr& aResult, LispPtr& aArguments)
 
2387
{
 
2388
    TESTARGS(3);
 
2389
    LispPtr name;
 
2390
    InternalEval(aEnvironment, name, Argument(aArguments,1));
 
2391
    LispStringPtr orig = name.Get()->String();
 
2392
    CHK_ARG(orig != NULL, 1);
 
2393
    LispString oper;
 
2394
    InternalUnstringify(oper, orig);
 
2395
 
 
2396
    LispPtr sizearg;
 
2397
    InternalEval(aEnvironment, sizearg, Argument(aArguments,2));
 
2398
    CHK_ARG(sizearg.Get() != NULL, 2);
 
2399
    CHK_ARG(sizearg.Get()->String() != NULL, 2);
 
2400
 
 
2401
    LispInt arity = InternalAsciiToInt(sizearg.Get()->String()->String());
 
2402
 
 
2403
    LispUserFunction* userFunc = aEnvironment.UserFunction(aEnvironment.HashTable().LookUp(oper.String()),arity);
 
2404
    CHK(userFunc != NULL, KLispErrInvalidArg);
 
2405
 
 
2406
    LispPtr& list = userFunc->ArgList();
 
2407
    LispPtr head;
 
2408
    head.Set(LispAtom::New(aEnvironment.iList));
 
2409
    head.Get()->Next().Set(list.Get());
 
2410
    aResult.Set(LispSubList::New(head.Get()));
 
2411
}
 
2412
 
 
2413
 
 
2414
static void InternalNewRulePattern(LispEnvironment& aEnvironment, LispPtr& aResult,
 
2415
                            LispPtr& aArguments, LispBoolean aMacroMode)
 
2416
{
 
2417
    TESTARGS(6);
 
2418
 
 
2419
    LispInt arity;
 
2420
    LispInt precedence;
 
2421
 
 
2422
    LispPtr ar;
 
2423
    LispPtr pr;
 
2424
    LispPtr predicate;
 
2425
    LispPtr body;
 
2426
    LispStringPtr orig=NULL;
 
2427
    
 
2428
    // Get operator
 
2429
    if (aMacroMode)
 
2430
    {
 
2431
        LispPtr result;
 
2432
        InternalEval(aEnvironment, result, Argument(aArguments,1));
 
2433
        CHK_ARG(result.Get() != NULL, 1);
 
2434
        orig = result.Get()->String();
 
2435
        CHK_ARG(orig != NULL, 1);
 
2436
 
 
2437
        InternalEval(aEnvironment, ar, Argument(aArguments,2));
 
2438
        InternalEval(aEnvironment, pr, Argument(aArguments,3));
 
2439
        InternalEval(aEnvironment, predicate, Argument(aArguments,4));
 
2440
        InternalEval(aEnvironment, body, Argument(aArguments,5));
 
2441
    }
 
2442
    else
 
2443
    {
 
2444
        CHK_ARG(Argument(aArguments,1).Get() != NULL, 1);
 
2445
        orig = Argument(aArguments,1).Get()->String();
 
2446
        CHK_ARG(orig != NULL, 1);
 
2447
        ar.Set(Argument(aArguments,2).Get());
 
2448
        pr.Set(Argument(aArguments,3).Get());
 
2449
        predicate.Set(Argument(aArguments,4).Get());
 
2450
        body.Set(Argument(aArguments,5).Get());
 
2451
    }
 
2452
    
 
2453
    // The arity
 
2454
    CHK_ARG(ar.Get() != NULL, 2);
 
2455
    CHK_ARG(ar.Get()->String() != NULL, 2);
 
2456
    arity = InternalAsciiToInt(ar.Get()->String()->String());
 
2457
 
 
2458
    // The precedence
 
2459
    CHK_ARG(pr.Get() != NULL, 3);
 
2460
    CHK_ARG(pr.Get()->String() != NULL, 3);
 
2461
    precedence = InternalAsciiToInt(pr.Get()->String()->String());
 
2462
    
 
2463
    // Finally define the rule base
 
2464
    aEnvironment.DefineRulePattern(SymbolName(aEnvironment,orig->String()),
 
2465
                            arity,
 
2466
                            precedence,
 
2467
                            predicate,
 
2468
                            body );
 
2469
 
 
2470
    // Return LispTrue
 
2471
    InternalTrue(aEnvironment,aResult);
 
2472
}
 
2473
 
 
2474
void LispNewRulePattern(LispEnvironment& aEnvironment, LispPtr& aResult,
 
2475
                  LispPtr& aArguments)
 
2476
{
 
2477
    InternalNewRulePattern(aEnvironment, aResult,aArguments, LispFalse);
 
2478
}
 
2479
 
 
2480
void LispMacroNewRulePattern(LispEnvironment& aEnvironment, LispPtr& aResult,
 
2481
                  LispPtr& aArguments)
 
2482
{
 
2483
    InternalNewRulePattern(aEnvironment, aResult,aArguments, LispTrue);
 
2484
}
 
2485
 
 
2486
 
 
2487