style/primitive.cxx

   1 // Copyright (c) 1996 James Clark
   2 // See the file copying.txt for copying permission.
   3
   4 #include "stylelib.h"
   5 #include "Interpreter.h"
   6 #include "InterpreterMessages.h"
   7 #include "EvalContext.h"
   8 #include "SosofoObj.h"
   9 #include "Style.h"
  10 #include "Insn.h"
  11 #include "macros.h"
  12 #include "ELObjMessageArg.h"
  13 #include "LocNode.h"
  14 #include "VM.h"
  15 #include "Pattern.h"
  16 #include "ELObjPropVal.h"
  17 #include <math.h>
  18 #include <limits.h>
  19 #include <stdio.h>
  20 #include <time.h>
  21 #include "LangObj.h"
  22 #include <ctype.h>
  23
  24 #ifdef DSSSL_NAMESPACE
  25 namespace DSSSL_NAMESPACE {
  26 #endif
  27
  28 class DescendantsNodeListObj : public NodeListObj {
  29 public:
  30   void *operator new(size_t, Collector &c) {
  31     return c.allocateObject(1);
  32   }
  33   DescendantsNodeListObj(const NodePtr &, unsigned = 0);
  34   NodePtr nodeListFirst(EvalContext &, Interpreter &);
  35   NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  36   NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  37 private:
  38   static void advance(NodePtr &, unsigned &);
  39   static void chunkAdvance(NodePtr &, unsigned &);
  40   // nodes in node list are strictly after this node
  41   NodePtr start_;
  42   unsigned depth_;
  43 };
  44
  45 class SiblingNodeListObj : public NodeListObj {
  46 public:
  47   void *operator new(size_t, Collector &c) {
  48     return c.allocateObject(1);
  49   }
  50   SiblingNodeListObj(const NodePtr &first, const NodePtr &end);
  51   NodePtr nodeListFirst(EvalContext &, Interpreter &);
  52   NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  53   NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  54 private:
  55   NodePtr first_;
  56   NodePtr end_;
  57 };
  58
  59 class SelectByClassNodeListObj : public NodeListObj {
  60 public:
  61   SelectByClassNodeListObj(NodeListObj *nl, ComponentName::Id);
  62   NodePtr nodeListFirst(EvalContext &, Interpreter &);
  63   NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  64   NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  65   void traceSubObjects(Collector &) const;
  66 private:
  67   NodeListObj *nodeList_;
  68   ComponentName::Id cls_;
  69 };
  70
  71 class MapNodeListObj : public NodeListObj {
  72 public:
  73   class Context : public Resource {
  74   public:
  75     Context(const EvalContext &, const Location &);
  76     void set(EvalContext &) const;
  77     void traceSubObjects(Collector &) const;
  78     Location loc;
  79   private:
  80     NodePtr currentNode_;
  81     const ProcessingMode *processingMode_;
  82     StyleObj *overridingStyle_;
  83     bool haveStyleStack_;
  84   };
  85   void *operator new(size_t, Collector &c) {
  86     return c.allocateObject(1);
  87   }
  88   MapNodeListObj(FunctionObj *func, NodeListObj *nl, const ConstPtr<Context> &, NodeListObj *mapped = 0);
  89   NodePtr nodeListFirst(EvalContext &, Interpreter &);
  90   NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  91   void traceSubObjects(Collector &) const;
  92   bool suppressError();
  93 private:
  94   void mapNext(EvalContext &, Interpreter &);
  95   FunctionObj *func_;
  96   NodeListObj *nl_;
  97   NodeListObj *mapped_;
  98   ConstPtr<Context> context_;
  99 };
 100
 101 class SelectElementsNodeListObj : public NodeListObj {
 102 public:
 103   struct PatternSet : public Resource, public NCVector<Pattern> { };
 104   void *operator new(size_t, Collector &c) {
 105     return c.allocateObject(1);
 106   }
 107   SelectElementsNodeListObj(NodeListObj *, NCVector<Pattern> &);
 108   SelectElementsNodeListObj(NodeListObj *, const ConstPtr<PatternSet> &);
 109   void traceSubObjects(Collector &) const;
 110   NodePtr nodeListFirst(EvalContext &, Interpreter &);
 111   NodeListObj *nodeListRest(EvalContext &, Interpreter &);
 112 private:
 113   NodeListObj *nodeList_;
 114   ConstPtr<PatternSet> patterns_;
 115 };
 116
 117 #define PRIMITIVE(name, string, nRequired, nOptional, rest) \
 118 class name ## PrimitiveObj : public PrimitiveObj { \
 119 public: \
 120   static const Signature signature_; \
 121   name ## PrimitiveObj() : PrimitiveObj(&signature_) { } \
 122   ELObj *primitiveCall(int, ELObj **, EvalContext &, Interpreter &, const Location &); \
 123 }; \
 124 const Signature name ## PrimitiveObj::signature_ \
 125   = { nRequired, nOptional, rest };
 126
 127 #define XPRIMITIVE PRIMITIVE
 128 #define XXPRIMITIVE PRIMITIVE
 129 #define PRIMITIVE2 PRIMITIVE
 130 #include "primitive.h"
 131 #undef PRIMITIVE
 132 #undef XPRIMITIVE
 133 #undef XXPRIMITIVE
 134 #undef PRIMITIVE2
 135
 136 #define DEFPRIMITIVE(name, argc, argv, context, interp, loc) \
 137  ELObj *name ## PrimitiveObj \
 138   ::primitiveCall(int argc, ELObj **argv, EvalContext &context, Interpreter &interp, \
 139                   const Location &loc)
 140
 141 DEFPRIMITIVE(Cons, argc, argv, context, interp, loc)
 142 {
 143   return new (interp) PairObj(argv[0], argv[1]);
 144 }
 145
 146 DEFPRIMITIVE(List, argc, argv, context, interp, loc)
 147 {
 148   if (argc == 0)
 149     return interp.makeNil();
 150   PairObj *head = new (interp) PairObj(argv[0], 0);
 151   ELObjDynamicRoot protect(interp, head);
 152   PairObj *tail = head;
 153   for (int i = 1; i < argc; i++) {
 154     PairObj *tem = new (interp) PairObj(argv[i], 0);
 155     tail->setCdr(tem);
 156     tail = tem;
 157   }
 158   tail->setCdr(interp.makeNil());
 159   return head;
 160 }
 161
 162 DEFPRIMITIVE(IsNull, argc, argv, context, interp, loc)
 163 {
 164   if (argv[0]->isNil())
 165     return interp.makeTrue();
 166   else
 167     return interp.makeFalse();
 168 }
 169
 170 DEFPRIMITIVE(IsList, argc, argv, context, interp, loc)
 171 {
 172   ELObj *obj = argv[0];
 173   for (;;) {
 174     PairObj *pair = obj->asPair();
 175     if (pair)
 176       obj = pair->cdr();
 177     else if (obj->isNil())
 178       return interp.makeTrue();
 179     else
 180       break;
 181   }
 182   return interp.makeFalse();
 183 }
 184
 185 DEFPRIMITIVE(IsEqual, argc, argv, context, interp, loc)
 186 {
 187   if (ELObj::equal(*argv[0], *argv[1]))
 188     return interp.makeTrue();
 189   else
 190     return interp.makeFalse();
 191 }
 192
 193 DEFPRIMITIVE(IsEqv, argc, argv, context, interp, loc)
 194 {
 195   if (ELObj::eqv(*argv[0], *argv[1]))
 196     return interp.makeTrue();
 197   else
 198     return interp.makeFalse();
 199 }
 200
 201 DEFPRIMITIVE(Car, argc, argv, context, interp, loc)
 202 {
 203   PairObj *pair = argv[0]->asPair();
 204   if (!pair)
 205     return argError(interp, loc,
 206                     InterpreterMessages::notAPair, 0, argv[0]);
 207   else
 208     return pair->car();
 209 }
 210
 211 DEFPRIMITIVE(Cdr, argc, argv, context, interp, loc)
 212 {
 213   PairObj *pair = argv[0]->asPair();
 214   if (!pair)
 215     return argError(interp, loc,
 216                     InterpreterMessages::notAPair, 0, argv[0]);
 217   else
 218     return pair->cdr();
 219 }
 220
 221 DEFPRIMITIVE(Append, argc, argv, context, interp, loc)
 222 {
 223   if (argc == 0)
 224     return interp.makeNil();
 225   PairObj *tail = interp.makePair(0, 0);
 226   PairObj *head = tail;
 227   ELObjDynamicRoot protect(interp, head);
 228   for (int i = 0; i < argc - 1; i++) {
 229     for (ELObj *p = argv[i]; !p->isNil();) {
 230       PairObj *tem = p->asPair();
 231       if (!tem)
 232         return argError(interp, loc,
 233                         InterpreterMessages::notAList, i, p);
 234       PairObj *newTail = new (interp) PairObj(tem->car(), 0);
 235       tail->setCdr(newTail);
 236       tail = newTail;
 237       p = tem->cdr();
 238     }
 239   }
 240   tail->setCdr(argv[argc - 1]);
 241   return head->cdr();
 242 }
 243
 244 DEFPRIMITIVE(Reverse, argc, argv, context, interp, loc)
 245 {
 246   ELObjDynamicRoot protect(interp, interp.makeNil());
 247   ELObj *p = argv[0];
 248   while (!p->isNil()) {
 249     PairObj *tem = p->asPair();
 250     if (!tem)
 251       return argError(interp, loc,
 252                       InterpreterMessages::notAList, 0, argv[0]);
 253     protect = new (interp) PairObj(tem->car(), protect);
 254     p = tem->cdr();
 255   }
 256   return protect;
 257 }
 258
 259 DEFPRIMITIVE(ListTail, argc, argv, context, interp, loc)
 260 {
 261   long k;
 262   if (!argv[1]->exactIntegerValue(k))
 263     return argError(interp, loc,
 264                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
 265   if (k < 0) {
 266     interp.setNextLocation(loc);
 267     interp.message(InterpreterMessages::outOfRange);
 268     return interp.makeError();
 269   }
 270   ELObj *p = argv[0];
 271   for (; k > 0; k--) {
 272     PairObj *tem = p->asPair();
 273     if (!tem) {
 274       if (p->isNil()) {
 275         interp.setNextLocation(loc);
 276         interp.message(InterpreterMessages::outOfRange);
 277         return interp.makeError();
 278       }
 279       else
 280         return argError(interp, loc,
 281                         InterpreterMessages::notAList, 0, argv[0]);
 282     }
 283     p = tem->cdr();
 284   }
 285   return p;
 286 }
 287
 288 DEFPRIMITIVE(ListRef, argc, argv, context, interp, loc)
 289 {
 290   long k;
 291   if (!argv[1]->exactIntegerValue(k))
 292     return argError(interp, loc,
 293                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
 294   if (k < 0) {
 295     interp.setNextLocation(loc);
 296     interp.message(InterpreterMessages::outOfRange);
 297     return interp.makeError();
 298   }
 299   ELObj *p = argv[0];
 300   for (;;) {
 301     PairObj *tem = p->asPair();
 302     if (!tem)
 303       break;
 304     if (k == 0)
 305       return tem->car();
 306     --k;
 307     p = tem->cdr();
 308   }
 309   if (p->isNil()) {
 310     interp.setNextLocation(loc);
 311     interp.message(InterpreterMessages::outOfRange);
 312     return interp.makeError();
 313   }
 314   else
 315     return argError(interp, loc,
 316                     InterpreterMessages::notAList, 0, argv[0]);
 317 }
 318
 319 DEFPRIMITIVE(Member, argc, argv, context, interp, loc)
 320 {
 321   ELObj *p = argv[1];
 322   while (!p->isNil()) {
 323     PairObj *tem = p->asPair();
 324     if (!tem)
 325       return argError(interp, loc,
 326                       InterpreterMessages::notAList, 1, argv[1]);
 327     if (ELObj::equal(*argv[0], *tem->car()))
 328       return p;
 329     p = tem->cdr();
 330   }
 331   return interp.makeFalse();
 332 }
 333
 334 DEFPRIMITIVE(Memv, argc, argv, context, interp, loc)
 335 {
 336   ELObj *p = argv[1];
 337   while (!p->isNil()) {
 338     PairObj *tem = p->asPair();
 339     if (!tem)
 340       return argError(interp, loc,
 341                       InterpreterMessages::notAList, 1, argv[1]);
 342     if (ELObj::eqv(*argv[0], *tem->car()))
 343       return p;
 344     p = tem->cdr();
 345   }
 346   return interp.makeFalse();
 347 }
 348
 349 DEFPRIMITIVE(Length, argc, argv, context, interp, loc)
 350 {
 351   ELObj *obj = argv[0];
 352   long n = 0;
 353   for (;;) {
 354     PairObj *pair = obj->asPair();
 355     if (pair) {
 356       n++;
 357       obj = pair->cdr();
 358     }
 359     else if (obj->isNil())
 360       break;
 361     else if (interp.isError(obj))
 362       return obj;
 363     else
 364       return argError(interp, loc,
 365                       InterpreterMessages::notAList, 0, obj);
 366   }
 367   return interp.makeInteger(n);
 368 }
 369
 370 DEFPRIMITIVE(Not, argc, argv, context, interp, loc)
 371 {
 372   if (argv[0]->isTrue())
 373     return interp.makeFalse();
 374   else
 375     return interp.makeTrue();
 376 }
 377
 378 DEFPRIMITIVE(IsSymbol, argc, argv, context, interp, loc)
 379 {
 380   if (argv[0]->asSymbol())
 381     return interp.makeTrue();
 382   else
 383     return interp.makeFalse();
 384 }
 385
 386 DEFPRIMITIVE(IsKeyword, argc, argv, context, interp, loc)
 387 {
 388   if (argv[0]->asKeyword())
 389     return interp.makeTrue();
 390   else
 391     return interp.makeFalse();
 392 }
 393
 394 DEFPRIMITIVE(IsInteger, argc, argv, context, interp, loc)
 395 {
 396   long n;
 397   if (argv[0]->exactIntegerValue(n))
 398     return interp.makeTrue();
 399   double x;
 400   if (argv[0]->realValue(x) && modf(x, &x) == 0.0)
 401     return interp.makeTrue();
 402   else
 403     return interp.makeFalse();
 404 }
 405
 406 DEFPRIMITIVE(IsReal, argc, argv, context, interp, loc)
 407 {
 408   double x;
 409   if (argv[0]->realValue(x))
 410     return interp.makeTrue();
 411   else
 412     return interp.makeFalse();
 413 }
 414
 415 DEFPRIMITIVE(IsNumber, argc, argv, context, interp, loc)
 416 {
 417   double x;
 418   if (argv[0]->realValue(x))
 419     return interp.makeTrue();
 420   else
 421     return interp.makeFalse();
 422 }
 423
 424 DEFPRIMITIVE(IsQuantity, argc, argv, context, interp, loc)
 425 {
 426   long n;
 427   double d;
 428   int dim;
 429   if (argv[0]->quantityValue(n, d, dim) != ELObj::noQuantity)
 430     return interp.makeTrue();
 431   else
 432     return interp.makeFalse();
 433 }
 434
 435 DEFPRIMITIVE(IsPair, argc, argv, context, interp, loc)
 436 {
 437   if (argv[0]->asPair())
 438     return interp.makeTrue();
 439   else
 440     return interp.makeFalse();
 441 }
 442
 443 DEFPRIMITIVE(IsProcedure, argc, argv, context, interp, loc)
 444 {
 445   if (argv[0]->asFunction())
 446     return interp.makeTrue();
 447   else
 448     return interp.makeFalse();
 449 }
 450
 451 DEFPRIMITIVE(IsBoolean, argc, argv, context, interp, loc)
 452 {
 453   if (argv[0] == interp.makeTrue())
 454     return argv[0];
 455   else if (argv[0] == interp.makeFalse())
 456     return interp.makeTrue();
 457   else
 458     return interp.makeFalse();
 459 }
 460
 461 DEFPRIMITIVE(IsChar, argc, argv, context, interp, loc)
 462 {
 463   Char c;
 464   if (argv[0]->charValue(c))
 465     return interp.makeTrue();
 466   else
 467     return interp.makeFalse();
 468 }
 469
 470 DEFPRIMITIVE(IsCharEqual, argc, argv, context, interp, loc)
 471 {
 472   Char c1, c2;
 473   if (!argv[0]->charValue(c1))
 474     return argError(interp, loc,
 475                     InterpreterMessages::notAChar, 0, argv[0]);
 476   if (!argv[1]->charValue(c2))
 477     return argError(interp, loc,
 478                     InterpreterMessages::notAChar, 1, argv[1]);
 479   if (c1 == c2)
 480     return interp.makeTrue();
 481   else
 482     return interp.makeFalse();
 483 }
 484
 485 DEFPRIMITIVE(String, argc, argv, context, interp, loc)
 486 {
 487   StringObj *obj = new (interp) StringObj;
 488   for (int i = 0; i < argc; i++) {
 489     Char c;
 490     if (!argv[i]->charValue(c))
 491       return argError(interp, loc,
 492                       InterpreterMessages::notAChar, i, argv[i]);
 493     *obj += c;
 494   }
 495   return obj;
 496 }
 497
 498 DEFPRIMITIVE(SymbolToString, argc, argv, context, interp, loc)
 499 {
 500   SymbolObj *obj = argv[0]->asSymbol();
 501   if (!obj)
 502     return argError(interp, loc,
 503                     InterpreterMessages::notASymbol, 0, argv[0]);
 504   return obj->name();
 505 }
 506
 507 DEFPRIMITIVE(StringToSymbol, argc, argv, context, interp, loc)
 508 {
 509   const Char *s;
 510   size_t n;
 511   if (!argv[0]->stringData(s, n))
 512     return argError(interp, loc,
 513                     InterpreterMessages::notAString, 0, argv[0]);
 514   return interp.makeSymbol(StringC(s, n));
 515 }
 516
 517 DEFPRIMITIVE(IsString, argc, argv, context, interp, loc)
 518 {
 519   const Char *s;
 520   size_t n;
 521   if (argv[0]->stringData(s, n))
 522     return interp.makeTrue();
 523   else
 524     return interp.makeFalse();
 525 }
 526
 527 DEFPRIMITIVE(StringLength, argc, argv, context, interp, loc)
 528 {
 529   const Char *s;
 530   size_t n;
 531   if (!argv[0]->stringData(s, n))
 532     return argError(interp, loc,
 533                     InterpreterMessages::notAString, 0, argv[0]);
 534   return interp.makeInteger(n);
 535 }
 536
 537 DEFPRIMITIVE(IsStringEqual, argc, argv, context, interp, loc)
 538 {
 539   const Char *s1, *s2;
 540   size_t n1, n2;
 541   if (!argv[0]->stringData(s1, n1))
 542     return argError(interp, loc,
 543                     InterpreterMessages::notAString, 0, argv[0]);
 544   if (!argv[1]->stringData(s2, n2))
 545     return argError(interp, loc,
 546                     InterpreterMessages::notAString, 1, argv[1]);
 547   if (n1 == n2
 548       && (n1 == 0 || memcmp(s1, s2, n1*sizeof(Char)) == 0))
 549     return interp.makeTrue();
 550   else
 551     return interp.makeFalse();
 552 }
 553
 554 DEFPRIMITIVE(StringAppend, argc, argv, context, interp, loc)
 555 {
 556   StringObj *result = new (interp) StringObj;
 557   for (int i = 0; i < argc; i++) {
 558     const Char *s;
 559     size_t n;
 560     if (!argv[i]->stringData(s, n))
 561       return argError(interp, loc,
 562                       InterpreterMessages::notAString, i,
 563                       argv[i]);
 564     result->append(s, n);
 565   }
 566   return result;
 567 }
 568
 569 DEFPRIMITIVE(StringRef, argc, argv, context, interp, loc)
 570 {
 571   const Char *s;
 572   size_t n;
 573   if (!argv[0]->stringData(s, n))
 574     return argError(interp, loc,
 575                     InterpreterMessages::notAString, 0, argv[0]);
 576   long k;
 577   if (!argv[1]->exactIntegerValue(k))
 578     return argError(interp, loc,
 579                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
 580   if (k < 0 || (unsigned long)k >= n) {
 581     interp.setNextLocation(loc);
 582     interp.message(InterpreterMessages::outOfRange);
 583     return interp.makeError();
 584   }
 585   return interp.makeChar(s[size_t(k)]);
 586 }
 587
 588 DEFPRIMITIVE(Substring, argc, argv, context, interp, loc)
 589 {
 590   const Char *s;
 591   size_t n;
 592   if (!argv[0]->stringData(s, n))
 593     return argError(interp, loc,
 594                     InterpreterMessages::notAString, 0, argv[0]);
 595   long start;
 596   if (!argv[1]->exactIntegerValue(start))
 597     return argError(interp, loc,
 598                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
 599   long end;
 600   if (!argv[2]->exactIntegerValue(end))
 601     return argError(interp, loc,
 602                     InterpreterMessages::notAnExactInteger, 2, argv[2]);
 603   if (start < 0 || (unsigned long)end > n || start > end) {
 604     interp.setNextLocation(loc);
 605     interp.message(InterpreterMessages::outOfRange);
 606     return interp.makeError();
 607   }
 608   return new (interp) StringObj(s + size_t(start), size_t(end - start));
 609 }
 610
 611 DEFPRIMITIVE(Equal, argc, argv, context, interp, loc)
 612 {
 613   if (argc == 0)
 614     return interp.makeTrue();
 615   long lResult;
 616   double dResult;
 617   int dim;
 618   int i = 1;
 619   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
 620   case ELObj::noQuantity:
 621     return argError(interp, loc,
 622                     InterpreterMessages::notAQuantity, 0, argv[0]);
 623   case ELObj::longQuantity:
 624     break;
 625   case ELObj::doubleQuantity:
 626     goto useDouble;
 627     break;
 628   default:
 629     CANNOT_HAPPEN();
 630   }
 631   long lResult2;
 632   double dResult2;
 633   int dim2;
 634   for (; i < argc; i++) {
 635     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
 636     case ELObj::noQuantity:
 637       return argError(interp, loc,
 638                     InterpreterMessages::notAQuantity, i, argv[i]);
 639     case ELObj::longQuantity:
 640       if (lResult2 != lResult || dim2 != dim)
 641         return interp.makeFalse();
 642       break;
 643     case ELObj::doubleQuantity:
 644       dResult = lResult;
 645       if (dResult2 != dResult || dim2 != dim)
 646         return interp.makeFalse();
 647       i++;
 648       goto useDouble;
 649     default:
 650       CANNOT_HAPPEN();
 651     }
 652   }
 653   return interp.makeTrue();
 654  useDouble:
 655   for (; i < argc; i++) {
 656     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
 657     case ELObj::noQuantity:
 658       return argError(interp, loc,
 659                       InterpreterMessages::notAQuantity, i, argv[i]);
 660     case ELObj::longQuantity:
 661       if (lResult2 != dResult || dim2 != dim)
 662         return interp.makeFalse();
 663       break;
 664     case ELObj::doubleQuantity:
 665       if (dResult2 != dResult || dim2 != dim)
 666         return interp.makeFalse();
 667       break;
 668     }
 669   }
 670   return interp.makeTrue();
 671 }
 672
 673 DEFPRIMITIVE(Plus, argc, argv, context, interp, loc)
 674 {
 675   if (argc == 0)
 676     return interp.makeInteger(0);
 677   long lResult;
 678   double dResult;
 679   bool usingD;
 680   bool spec = 0;
 681   int dim;
 682   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
 683   case ELObj::noQuantity:
 684     dim = 1;
 685     spec = 1;
 686     break;
 687   case ELObj::longQuantity:
 688     usingD = 0;
 689     break;
 690   case ELObj::doubleQuantity:
 691     usingD = 1;
 692     break;
 693   default:
 694     CANNOT_HAPPEN();
 695   }
 696   for (int i = 1; !spec && i < argc; i++) {
 697     long lResult2;
 698     double dResult2;
 699     int dim2;
 700     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
 701     case ELObj::noQuantity:
 702       // FIXME shouldn't quantityValue set dim to 1 for length-specs ?
 703       dim2 = 1;
 704       spec = 1;
 705       break;
 706     case ELObj::longQuantity:
 707       if (!usingD) {
 708         if (lResult2 < 0) {
 709           if (lResult >= LONG_MIN - lResult2) {
 710             lResult += lResult2;
 711             break;
 712           }
 713         }
 714         else {
 715           if (lResult <= LONG_MAX - lResult2) {
 716             lResult += lResult2;
 717             break;
 718           }
 719         }
 720         usingD = 1;
 721         dResult = double(lResult);
 722       }
 723       dResult += double(lResult2);
 724       break;
 725     case ELObj::doubleQuantity:
 726       if (!usingD) {
 727         dResult = lResult;
 728         usingD = 1;
 729       }
 730       dResult += dResult2;
 731       break;
 732     default:
 733       CANNOT_HAPPEN();
 734     }
 735     if (dim2 != dim) {
 736       interp.setNextLocation(loc);
 737       interp.message(InterpreterMessages::incompatibleDimensions);
 738       return interp.makeError();
 739     }
 740   }
 741
 742   if (spec) {
 743     LengthSpec ls;
 744     for (int i = 0; i < argc; i++) {
 745       const LengthSpec *lsp = argv[i]->lengthSpec();
 746       if (lsp)
 747         ls += *lsp;
 748       else {
 749         switch (argv[i]->quantityValue(lResult, dResult, dim)) {
 750         case ELObj::noQuantity:
 751           return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
 752                           i, argv[i]);
 753         case ELObj::longQuantity:
 754           dResult = lResult;
 755           // fall through
 756         case ELObj::doubleQuantity:
 757           if (dim != 1) {
 758             interp.setNextLocation(loc);
 759             interp.message(InterpreterMessages::incompatibleDimensions);
 760             return interp.makeError();
 761           }
 762           ls += dResult;
 763           break;
 764         }
 765       }
 766     }
 767     return new (interp) LengthSpecObj(ls);
 768   }
 769
 770   if (!usingD) {
 771     if (dim == 0)
 772       return interp.makeInteger(lResult);
 773     else if (dim == 1)
 774       return new (interp) LengthObj(lResult);
 775     else
 776       dResult = lResult;
 777   }
 778   if (dim == 0)
 779     return new (interp) RealObj(dResult);
 780   else
 781     return new (interp) QuantityObj(dResult, dim);
 782 }
 783
 784 DEFPRIMITIVE(Minus, argc, argv, context, interp, loc)
 785 {
 786   long lResult;
 787   double dResult;
 788   bool usingD;
 789   bool spec = 0;
 790   int dim;
 791   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
 792   case ELObj::noQuantity:
 793     spec = 1;
 794     break;
 795   case ELObj::longQuantity:
 796     usingD = 0;
 797     break;
 798   case ELObj::doubleQuantity:
 799     usingD = 1;
 800     break;
 801   default:
 802     CANNOT_HAPPEN();
 803   }
 804   if (argc == 1) {
 805     if (usingD)
 806       dResult = -dResult;
 807     else
 808       lResult = -lResult;
 809   }
 810   else {
 811     for (int i = 1; !spec && i < argc; i++) {
 812       long lResult2;
 813       double dResult2;
 814       int dim2;
 815       switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
 816       case ELObj::noQuantity:
 817         dim2 = dim;
 818         spec = 1;
 819         break;
 820       case ELObj::longQuantity:
 821         if (!usingD) {
 822           if (lResult2 > 0) {
 823             if (lResult >= LONG_MIN + lResult2) {
 824               lResult -= lResult2;
 825               break;
 826             }
 827           }
 828           else {
 829             if (lResult <= LONG_MAX + lResult2) {
 830               lResult -= lResult2;
 831               break;
 832             }
 833           }
 834           usingD = 1;
 835           dResult = double(lResult);
 836         }
 837         dResult -= double(lResult2);
 838         break;
 839       case ELObj::doubleQuantity:
 840         if (!usingD) {
 841           dResult = lResult;
 842           usingD = 1;
 843         }
 844         dResult -= dResult2;
 845         break;
 846       default:
 847         CANNOT_HAPPEN();
 848       }
 849       if (dim2 != dim) {
 850         interp.setNextLocation(loc);
 851         interp.message(InterpreterMessages::incompatibleDimensions);
 852         return interp.makeError();
 853       }
 854     }
 855   }
 856
 857   if (spec) {
 858     LengthSpec ls;
 859     for (int i = 0; i < argc; i++) {
 860       const LengthSpec *lsp = argv[i]->lengthSpec();
 861       if (lsp) {
 862         if (i > 0 || argc == 1)
 863           ls -= *lsp;
 864         else
 865           ls += *lsp;
 866       }
 867       else {
 868         switch (argv[i]->quantityValue(lResult, dResult, dim)) {
 869         case ELObj::noQuantity:
 870           return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
 871                           i, argv[i]);
 872         case ELObj::longQuantity:
 873           dResult = lResult;
 874           // fall through
 875         case ELObj::doubleQuantity:
 876           if (dim != 1) {
 877             interp.setNextLocation(loc);
 878             interp.message(InterpreterMessages::incompatibleDimensions);
 879             return interp.makeError();
 880           }
 881           if (i > 0 || argc == 1)
 882             ls -= dResult;
 883           else
 884             ls += dResult;
 885           break;
 886         }
 887       }
 888     }
 889     return new (interp) LengthSpecObj(ls);
 890   }
 891
 892   if (!usingD) {
 893     if (dim == 0)
 894       return interp.makeInteger(lResult);
 895     else if (dim == 1)
 896       return new (interp) LengthObj(lResult);
 897     else
 898       dResult = lResult;
 899   }
 900   if (dim == 0)
 901     return new (interp) RealObj(dResult);
 902   else
 903     return new (interp) QuantityObj(dResult, dim);
 904 }
 905
 906 DEFPRIMITIVE(Multiply, argc, argv, context, interp, loc)
 907 {
 908   if (argc == 0)
 909     return interp.makeInteger(1);
 910   long lResult;
 911   double dResult;
 912   int dim;
 913   int i = 1;
 914   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
 915   case ELObj::noQuantity:
 916     {
 917       const LengthSpec *ls = argv[0]->lengthSpec();
 918       if (ls) {
 919         LengthSpec result(*ls);
 920         double d;
 921         for (; i < argc; i++) {
 922           if (!argv[i]->realValue(d))
 923             return argError(interp, loc,
 924                             InterpreterMessages::notANumber, 1, argv[1]);
 925           result *= d;
 926         }
 927         return new (interp) LengthSpecObj(result);
 928       }
 929     }
 930     return argError(interp, loc,
 931                     InterpreterMessages::notAQuantity, 0, argv[0]);
 932   case ELObj::longQuantity:
 933     break;
 934   case ELObj::doubleQuantity:
 935     goto useDouble;
 936   default:
 937     CANNOT_HAPPEN();
 938   }
 939   long lResult2;
 940   double dResult2;
 941   int dim2;
 942   for (; i < argc; i++) {
 943     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
 944     case ELObj::noQuantity:
 945       return argError(interp, loc,
 946                       InterpreterMessages::notAQuantity, i, argv[i]);
 947     case ELObj::longQuantity:
 948       dim += dim2;
 949       if (dim > 1
 950           || (lResult2 != 0
 951               && (lResult2 < 0
 952                   ? (lResult > 0
 953                      ? lResult > -(unsigned)LONG_MIN / -(unsigned)lResult2
 954                      : -(unsigned)lResult > LONG_MAX / -(unsigned)lResult2)
 955                   : (lResult > 0
 956                      ? lResult > LONG_MAX / lResult2
 957                      : -(unsigned)lResult > -(unsigned)LONG_MIN / lResult2)))) {
 958         dResult = double(lResult) * lResult2;
 959         i++;
 960         goto useDouble;
 961       }
 962       lResult *= lResult2;
 963       break;
 964     case ELObj::doubleQuantity:
 965       dim += dim2;
 966       dResult = lResult * dResult2;
 967       i++;
 968       goto useDouble;
 969     default:
 970       CANNOT_HAPPEN();
 971     }
 972   }
 973   if (dim == 0)
 974     return interp.makeInteger(lResult);
 975   else
 976     return new (interp) LengthObj(lResult);
 977  useDouble:
 978   for (; i < argc; i++) {
 979     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
 980     case ELObj::noQuantity:
 981       return argError(interp, loc,
 982                       InterpreterMessages::notAQuantity, i, argv[i]);
 983     case ELObj::longQuantity:
 984       dResult *= lResult2;
 985       break;
 986     case ELObj::doubleQuantity:
 987       dResult *= dResult2;
 988       break;
 989     }
 990     dim += dim2;
 991   }
 992   if (dim == 0)
 993     return new (interp) RealObj(dResult);
 994   else
 995     return new (interp) QuantityObj(dResult, dim);
 996 }
 997
 998 DEFPRIMITIVE(Divide, argc, argv, context, interp, loc)
 999 {
1000   long lResult;
1001   double dResult;
1002   int dim;
1003   if (argc == 1) {
1004     switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1005     case ELObj::noQuantity:
1006       return argError(interp, loc,
1007                       InterpreterMessages::notAQuantity, 0, argv[0]);
1008     case ELObj::longQuantity:
1009       if (lResult == 0)
1010         goto divide0;
1011       dResult = 1.0/lResult;
1012       break;
1013     case ELObj::doubleQuantity:
1014       if (dResult == 0.0)
1015         goto divide0;
1016       dResult = 1.0/dResult;
1017       break;
1018     default:
1019       CANNOT_HAPPEN();
1020     }
1021     dim = -dim;
1022   }
1023   else {
1024     int i = 1;
1025     switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1026     case ELObj::noQuantity:
1027       {
1028         const LengthSpec *ls = argv[0]->lengthSpec();
1029         if (ls) {
1030           LengthSpec result(*ls);
1031           double d;
1032           for (; i < argc; i++) {
1033             if (!argv[i]->realValue(d))
1034               return argError(interp, loc,
1035                               InterpreterMessages::notANumber, 1, argv[1]);
1036             if (d == 0.0)
1037               goto divide0;
1038             result /= d;
1039           }
1040           return new (interp) LengthSpecObj(result);
1041         }
1042       }
1043       return argError(interp, loc,
1044                       InterpreterMessages::notAQuantity, 0, argv[0]);
1045     case ELObj::longQuantity:
1046       break;
1047     case ELObj::doubleQuantity:
1048       goto useDouble;
1049     default:
1050       CANNOT_HAPPEN();
1051     }
1052     long lResult2;
1053     double dResult2;
1054     int dim2;
1055     for (; i < argc; i++) {
1056       switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1057       case ELObj::noQuantity:
1058         return argError(interp, loc,
1059                         InterpreterMessages::notAQuantity, 0, argv[0]);
1060       case ELObj::longQuantity:
1061         if (lResult2 == 0)
1062           goto divide0;
1063         dim -= dim2;
1064         // If dim and dim2 are both 1, must goto useDouble:
1065         // since lengths are inexact, result must be inexact.
1066         if (dim2 == 0 && lResult % lResult2 == 0) {
1067           lResult /= lResult2;
1068           break;
1069         }
1070         dResult = double(lResult)/lResult2;
1071         i++;
1072         goto useDouble;
1073       case ELObj::doubleQuantity:
1074         dim -= dim2;
1075         dResult = lResult;
1076         if (dResult2 == 0.0)
1077           goto divide0;
1078         dResult /= dResult2;
1079         i++;
1080         goto useDouble;
1081       default:
1082         CANNOT_HAPPEN();
1083       }
1084     }
1085     if (dim == 0)
1086       return interp.makeInteger(lResult);
1087     else
1088       return new (interp) LengthObj(lResult);
1089   useDouble:
1090     for (; i < argc; i++) {
1091       switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1092       case ELObj::noQuantity:
1093         return argError(interp, loc,
1094                         InterpreterMessages::notAQuantity, i, argv[i]);
1095       case ELObj::longQuantity:
1096         if (lResult2 == 0)
1097           goto divide0;
1098         dResult /= lResult2;
1099         break;
1100       case ELObj::doubleQuantity:
1101         dResult /= dResult2;
1102         if (dResult2 == 0.0)
1103           goto divide0;
1104         break;
1105       }
1106       dim -= dim2;
1107     }
1108   }
1109   if (dim == 0)
1110     return new (interp) RealObj(dResult);
1111   else
1112     return new (interp) QuantityObj(dResult, dim);
1113  divide0:
1114   interp.setNextLocation(loc);
1115   interp.message(InterpreterMessages::divideBy0);
1116   return interp.makeError();
1117 }
1118
1119 DEFPRIMITIVE(Quotient, argc, argv, context, interp, loc)
1120 {
1121   long n1;
1122   long n2;
1123   if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
1124     if (n2 == 0) {
1125       interp.setNextLocation(loc);
1126       interp.message(InterpreterMessages::divideBy0);
1127       return interp.makeError();
1128     }
1129     // This isn't strictly portable.
1130     return interp.makeInteger(n1 / n2);
1131   }
1132   double d1;
1133   if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
1134     return argError(interp, loc,
1135                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
1136   double d2;
1137   if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
1138     return argError(interp, loc,
1139                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
1140   if (d2 == 0.0) {
1141     interp.setNextLocation(loc);
1142     interp.message(InterpreterMessages::divideBy0);
1143     return interp.makeError();
1144   }
1145   return new (interp) RealObj((d1 - fmod(d1, d2))/d2);
1146 }
1147
1148 DEFPRIMITIVE(Remainder, argc, argv, context, interp, loc)
1149 {
1150   long n1;
1151   long n2;
1152   if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
1153     if (n2 == 0) {
1154       interp.setNextLocation(loc);
1155       interp.message(InterpreterMessages::divideBy0);
1156       return interp.makeError();
1157     }
1158     // This isn't strictly portable.
1159     return interp.makeInteger(n1 % n2);
1160   }
1161   double d1;
1162   if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
1163     return argError(interp, loc,
1164                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
1165   double d2;
1166   if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
1167     return argError(interp, loc,
1168                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
1169   if (d2 == 0.0) {
1170     interp.setNextLocation(loc);
1171     interp.message(InterpreterMessages::divideBy0);
1172     return interp.makeError();
1173   }
1174   return new (interp) RealObj(fmod(d1, d2));
1175 }
1176
1177 DEFPRIMITIVE(Modulo, argc, argv, context, interp, loc)
1178 {
1179   long n1;
1180   long n2;
1181   if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
1182     if (n2 == 0) {
1183       interp.setNextLocation(loc);
1184       interp.message(InterpreterMessages::divideBy0);
1185       return interp.makeError();
1186     }
1187     long r = n1 % n2;
1188     if (n2 > 0 ? r < 0 : r > 0)
1189       r += n2;
1190     return interp.makeInteger(r);
1191   }
1192   double d1;
1193   if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
1194     return argError(interp, loc,
1195                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
1196   double d2;
1197   if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
1198     return argError(interp, loc,
1199                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
1200   if (d2 == 0.0) {
1201     interp.setNextLocation(loc);
1202     interp.message(InterpreterMessages::divideBy0);
1203     return interp.makeError();
1204   }
1205   double r = fmod(d1, d2);
1206   if (d2 > 0 ? r < 0 : r > 0)
1207     r += d2;
1208   return new (interp) RealObj(r);
1209 }
1210
1211 #define DEFCOMPARE(NAME, OP) \
1212 DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
1213 { \
1214   if (argc == 0) \
1215     return interp.makeTrue(); \
1216   long lResult; \
1217   double dResult; \
1218   int dim; \
1219   bool lastWasDouble; \
1220   switch (argv[0]->quantityValue(lResult, dResult, dim)) { \
1221   case ELObj::noQuantity: \
1222     return argError(interp, loc, \
1223                     InterpreterMessages::notAQuantity, 0, argv[0]); \
1224   case ELObj::longQuantity: \
1225     lastWasDouble = 0; \
1226     break; \
1227   case ELObj::doubleQuantity: \
1228     lastWasDouble = 1; \
1229     break; \
1230   default: \
1231     CANNOT_HAPPEN(); \
1232   } \
1233   for (int i = 1; i < argc; i++) { \
1234     long lResult2; \
1235     double dResult2; \
1236     int dim2; \
1237     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) { \
1238     case ELObj::noQuantity: \
1239       return argError(interp, loc, \
1240                       InterpreterMessages::notAQuantity, i, argv[i]); \
1241     case ELObj::longQuantity: \
1242       if (dim2 != dim) \
1243         goto badDim; \
1244       if (!(lastWasDouble \
1245             ? (dResult OP lResult2) \
1246             : (lResult OP lResult2))) \
1247         return interp.makeFalse(); \
1248       lResult = lResult2; \
1249       lastWasDouble = 0; \
1250       break; \
1251     case ELObj::doubleQuantity: \
1252       if (dim != dim2) \
1253         goto badDim; \
1254       if (!(lastWasDouble \
1255             ? (dResult OP dResult2) \
1256             : (lResult OP dResult2))) \
1257         return interp.makeFalse(); \
1258       dResult = dResult2; \
1259       lastWasDouble = 1; \
1260       break; \
1261     } \
1262   } \
1263   return interp.makeTrue(); \
1264  badDim: \
1265   interp.setNextLocation(loc); \
1266   interp.message(InterpreterMessages::incompatibleDimensions); \
1267   return interp.makeError(); \
1268 }
1269
1270 DEFCOMPARE(Less, <)
1271 DEFCOMPARE(Greater, >)
1272 DEFCOMPARE(LessEqual, <=)
1273 DEFCOMPARE(GreaterEqual, >=)
1274
1275 DEFPRIMITIVE(Min, argc, argv, context, interp, loc)
1276 {
1277   long lResult;
1278   double dResult;
1279   int dim;
1280   int i = 1;
1281   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1282   case ELObj::noQuantity:
1283     return argError(interp, loc,
1284                     InterpreterMessages::notAQuantity, 0, argv[0]);
1285   case ELObj::longQuantity:
1286     break;
1287   case ELObj::doubleQuantity:
1288     goto useDouble;
1289   default:
1290     CANNOT_HAPPEN();
1291   }
1292   // Note that result is inexact if any of the arguments are
1293   for (; i < argc; i++) {
1294     long lResult2;
1295     double dResult2;
1296     int dim2;
1297     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1298     case ELObj::noQuantity:
1299       return argError(interp, loc,
1300                       InterpreterMessages::notAQuantity, i, argv[i]);
1301     case ELObj::longQuantity:
1302       if (dim2 != dim)
1303         goto badDim;
1304       if (lResult2 < lResult)
1305         lResult = lResult2;
1306       break;
1307     case ELObj::doubleQuantity:
1308       if (dim != dim2)
1309         goto badDim;
1310       if (dResult2 < lResult)
1311         dResult = dResult2;
1312       else if (dim)
1313         break;
1314       else
1315         dResult = lResult;
1316       i++;
1317       goto useDouble;
1318     }
1319   }
1320   if (dim == 0)
1321     return interp.makeInteger(lResult);
1322   else
1323     return new (interp) LengthObj(lResult);
1324  useDouble:
1325   for (; i < argc; i++) {
1326     long lResult2;
1327     double dResult2;
1328     int dim2;
1329     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1330     case ELObj::noQuantity:
1331       return argError(interp, loc,
1332                       InterpreterMessages::notAQuantity, i, argv[i]);
1333     case ELObj::longQuantity:
1334       if (dim2 != dim)
1335         goto badDim;
1336       if (lResult2 < dResult)
1337         dResult = lResult2;
1338       break;
1339     case ELObj::doubleQuantity:
1340       if (dim != dim2)
1341         goto badDim;
1342       if (dResult2 < dResult)
1343         dResult = dResult2;
1344       break;
1345     }
1346   }
1347   if (dim == 0)
1348     return new (interp) RealObj(dResult);
1349   else
1350     return new (interp) QuantityObj(dResult, dim);
1351  badDim:
1352   interp.setNextLocation(loc);
1353   interp.message(InterpreterMessages::incompatibleDimensions);
1354   return interp.makeError();
1355 }
1356
1357 DEFPRIMITIVE(Max, argc, argv, context, interp, loc)
1358 {
1359   long lResult;
1360   double dResult;
1361   int dim;
1362   int i = 1;
1363   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1364   case ELObj::noQuantity:
1365     return argError(interp, loc,
1366                     InterpreterMessages::notAQuantity, 0, argv[0]);
1367   case ELObj::longQuantity:
1368     break;
1369   case ELObj::doubleQuantity:
1370     goto useDouble;
1371   default:
1372     CANNOT_HAPPEN();
1373   }
1374   // Note that result is inexact if any of the arguments are
1375   for (; i < argc; i++) {
1376     long lResult2;
1377     double dResult2;
1378     int dim2;
1379     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1380     case ELObj::noQuantity:
1381       return argError(interp, loc,
1382                       InterpreterMessages::notAQuantity, i, argv[i]);
1383     case ELObj::longQuantity:
1384       if (dim2 != dim)
1385         goto badDim;
1386       if (lResult2 > lResult)
1387         lResult = lResult2;
1388       break;
1389     case ELObj::doubleQuantity:
1390       if (dim != dim2)
1391         goto badDim;
1392       if (dResult2 > lResult)
1393         dResult = dResult2;
1394       else if (dim)
1395         break;
1396       else
1397         dResult = lResult;
1398       i++;
1399       goto useDouble;
1400     }
1401   }
1402   if (dim == 0)
1403     return interp.makeInteger(lResult);
1404   else
1405     return new (interp) LengthObj(lResult);
1406  useDouble:
1407   for (; i < argc; i++) {
1408     long lResult2;
1409     double dResult2;
1410     int dim2;
1411     switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1412     case ELObj::noQuantity:
1413       return argError(interp, loc,
1414                       InterpreterMessages::notAQuantity, i, argv[i]);
1415     case ELObj::longQuantity:
1416       if (dim2 != dim)
1417         goto badDim;
1418       if (lResult2 > dResult)
1419         dResult = lResult2;
1420       break;
1421     case ELObj::doubleQuantity:
1422       if (dim != dim2)
1423         goto badDim;
1424       if (dResult2 > dResult)
1425         dResult = dResult2;
1426       break;
1427     }
1428   }
1429   if (dim == 0)
1430     return new (interp) RealObj(dResult);
1431   else
1432     return new (interp) QuantityObj(dResult, dim);
1433  badDim:
1434   interp.setNextLocation(loc);
1435   interp.message(InterpreterMessages::incompatibleDimensions);
1436   return interp.makeError();
1437 }
1438
1439 DEFPRIMITIVE(Floor, argc, argv, context, interp, loc)
1440 {
1441   double d;
1442   if (argv[0]->inexactRealValue(d))
1443     return new (interp) RealObj(floor(d));
1444   long n;
1445   if (argv[0]->exactIntegerValue(n))
1446     return argv[0];
1447   return argError(interp, loc,
1448                   InterpreterMessages::notANumber, 0, argv[0]);
1449 }
1450
1451 DEFPRIMITIVE(Ceiling, argc, argv, context, interp, loc)
1452 {
1453   double d;
1454   if (argv[0]->inexactRealValue(d))
1455     return new (interp) RealObj(ceil(d));
1456   long n;
1457   if (argv[0]->exactIntegerValue(n))
1458     return argv[0];
1459   return argError(interp, loc,
1460                   InterpreterMessages::notANumber, 0, argv[0]);
1461 }
1462
1463 DEFPRIMITIVE(Round, argc, argv, context, interp, loc)
1464 {
1465   double d;
1466   if (argv[0]->inexactRealValue(d)) {
1467     double result = floor(d + .5);
1468     // That rounded it upwards.
1469     // Now figure out if that was different from round to
1470     // even.
1471     if (result - d == 0.5 && fmod(result, 2.0) != 0)
1472       result -= 1.0;
1473     return new (interp) RealObj(result);
1474   }
1475   long n;
1476   if (argv[0]->exactIntegerValue(n))
1477     return argv[0];
1478   return argError(interp, loc,
1479                   InterpreterMessages::notANumber, 0, argv[0]);
1480 }
1481
1482 DEFPRIMITIVE(Truncate, argc, argv, context, interp, loc)
1483 {
1484   double d;
1485   if (argv[0]->inexactRealValue(d)) {
1486     double iPart;
1487     modf(d, &iPart);
1488     return new (interp) RealObj(iPart);
1489   }
1490   long n;
1491   if (argv[0]->exactIntegerValue(n))
1492     return argv[0];
1493   return argError(interp, loc,
1494                   InterpreterMessages::notANumber, 0, argv[0]);
1495 }
1496
1497 DEFPRIMITIVE(Abs, argc, argv, context, interp, loc)
1498 {
1499   long lResult;
1500   double dResult;
1501   int dim;
1502   switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1503   case ELObj::noQuantity:
1504     return argError(interp, loc,
1505                     InterpreterMessages::notAQuantity, 0, argv[0]);
1506   case ELObj::longQuantity:
1507     if (lResult != LONG_MIN) {
1508       if (lResult >= 0)
1509         return argv[0];
1510       if (dim == 0)
1511         return interp.makeInteger(-lResult);
1512       else
1513         return new (interp) LengthObj(-lResult);
1514     }
1515     dResult = lResult;
1516     break;
1517   case ELObj::doubleQuantity:
1518     break;
1519   default:
1520     CANNOT_HAPPEN();
1521   }
1522   if (dResult >= 0)
1523     return argv[0];
1524   if (dim == 0)
1525     return new (interp) RealObj(-dResult);
1526   else
1527     return new (interp) QuantityObj(-dResult, dim);
1528 }
1529
1530 DEFPRIMITIVE(Sqrt, argc, argv, context, interp, loc)
1531 {
1532   long lResult;
1533   double dResult;
1534   int dim;
1535   ELObj::QuantityType type
1536     = argv[0]->quantityValue(lResult, dResult, dim);
1537   switch (type) {
1538   case ELObj::noQuantity:
1539     return argError(interp, loc,
1540                     InterpreterMessages::notAQuantity, 0, argv[0]);
1541   case ELObj::longQuantity:
1542     dResult = lResult;
1543     break;
1544   case ELObj::doubleQuantity:
1545     break;
1546   default:
1547     CANNOT_HAPPEN();
1548   }
1549   if ((dim & 1) || dResult < 0.0) {
1550     interp.setNextLocation(loc);
1551     interp.message(InterpreterMessages::outOfRange);
1552     return interp.makeError();
1553   }
1554   dim /= 2;
1555   dResult = sqrt(dResult);
1556   if (type == ELObj::longQuantity && dim == 0) {
1557     long n = long(dResult);
1558     if (n*n == lResult)
1559       return interp.makeInteger(n);
1560   }
1561   return new (interp) QuantityObj(dResult, dim);
1562 }
1563
1564 DEFPRIMITIVE(Time, argc, argv, context, interp, loc)
1565 {
1566   // This assumes a Posix compatible time().
1567   time_t t = time(0);
1568   return interp.makeInteger(long(t));
1569 }
1570
1571 DEFPRIMITIVE(TimeToString, argc, argv, context, interp, loc)
1572 {
1573   long k;
1574   if (!argv[0]->exactIntegerValue(k))
1575     return argError(interp, loc,
1576                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
1577   time_t t = time_t(k);
1578   const struct tm *p;
1579   if (argc > 1 && argv[1] != interp.makeFalse())
1580     p = gmtime(&t);
1581   else
1582     p = localtime(&t);
1583   char buf[64];
1584   sprintf(buf, "%04d-%02d-%02dT%02d:%02d:%02d",
1585           p->tm_year + 1900, p->tm_mon + 1, p->tm_mday,
1586           p->tm_hour, p->tm_min, p->tm_sec);
1587   return new (interp) StringObj(interp.makeStringC(buf));
1588 }
1589
1590 DEFPRIMITIVE(CharProperty, argc, argv, context, interp, loc)
1591 {
1592   SymbolObj *sym = argv[0]->asSymbol();
1593   if (!sym)
1594     return argError(interp, loc,
1595                     InterpreterMessages::notASymbol, 0, argv[0]);
1596   StringObj *prop = argv[0]->asSymbol()->convertToString();
1597   Char c;
1598   if (!argv[1]->charValue(c))
1599     return argError(interp, loc,
1600                     InterpreterMessages::notAChar, 1, argv[1]);
1601   return interp.charProperty(*prop, c, loc, (argc > 2) ? argv[2] : 0);
1602 }
1603
1604 DEFPRIMITIVE(Literal, argc, argv, context, interp, loc)
1605 {
1606   if (argc == 0)
1607     return new (interp) EmptySosofoObj;
1608   const Char *s;
1609   size_t n;
1610   if (!argv[0]->stringData(s, n))
1611     return argError(interp, loc, InterpreterMessages::notAString,
1612                       0, argv[0]);
1613   if (argc == 1)
1614     return new (interp) LiteralSosofoObj(argv[0]);
1615   StringObj *strObj = new (interp) StringObj(s, n);
1616   for (int i = 1; i < argc; i++) {
1617     if (!argv[i]->stringData(s, n))
1618       return argError(interp, loc, InterpreterMessages::notAString,
1619                       i, argv[i]);
1620     strObj->append(s, n);
1621   }
1622   ELObjDynamicRoot protect(interp, strObj);
1623   return new (interp) LiteralSosofoObj(strObj);
1624 }
1625
1626 DEFPRIMITIVE(ProcessChildren, argc, argv, context, interp, loc)
1627 {
1628   if (!context.processingMode) {
1629     interp.setNextLocation(loc);
1630     interp.message(InterpreterMessages::noCurrentProcessingMode);
1631     return interp.makeError();
1632   }
1633   return new (interp) ProcessChildrenSosofoObj(context.processingMode);
1634 }
1635
1636 DEFPRIMITIVE(ProcessChildrenTrim, argc, argv, context, interp, loc)
1637 {
1638   if (!context.processingMode) {
1639     interp.setNextLocation(loc);
1640     interp.message(InterpreterMessages::noCurrentProcessingMode);
1641     return interp.makeError();
1642   }
1643   return new (interp) ProcessChildrenTrimSosofoObj(context.processingMode);
1644 }
1645
1646 DEFPRIMITIVE(SosofoAppend, argc, argv, context, interp, loc)
1647 {
1648   /* Optimize the case where there is no or only
1649      one argument */
1650   if (argc == 0)
1651     return new (interp) EmptySosofoObj;
1652   else if (argc == 1) {
1653     SosofoObj *sosofo = argv[0]->asSosofo();
1654     if (!sosofo)
1655       return argError(interp, loc, InterpreterMessages::notASosofo,
1656                       0, argv[0]);
1657     return sosofo;
1658   }
1659
1660   /* Don't create another object if the first argument is
1661      already an AppendSosofoObj, this handles gracefully
1662      case like
1663      (let loop ( (res (empty-sosofo))
1664                  (nl  (node-list-rest (children (current-node)))))
1665         (loop (sosofo-append res (process-node-list (node-list-first nl)))
1666               (node-list-rest nl)))
1667    */
1668   AppendSosofoObj *obj;
1669   int i = 0;
1670   if ( argv[i]->asAppendSosofo() )
1671     obj = argv[i++]->asAppendSosofo();
1672   else
1673     obj = new (interp) AppendSosofoObj;
1674
1675   for ( ; i < argc; i++) {
1676     SosofoObj *sosofo = argv[i]->asSosofo();
1677     if (!sosofo)
1678       return argError(interp, loc, InterpreterMessages::notASosofo,
1679                       i, argv[i]);
1680     obj->append(sosofo);
1681   }
1682   return obj;
1683 }
1684
1685 DEFPRIMITIVE(NextMatch, argc, argv, context, interp, loc)
1686 {
1687   if (!context.processingMode) {
1688     interp.setNextLocation(loc);
1689     interp.message(InterpreterMessages::noCurrentProcessingMode);
1690     return interp.makeError();
1691   }
1692   StyleObj *style;
1693   if (argc == 0)
1694     style = 0;
1695   else {
1696     style = argv[0]->asStyle();
1697     if (!style)
1698       return argError(interp, loc, InterpreterMessages::notAStyle, 0, argv[0]);
1699   }
1700   return new (interp) NextMatchSosofoObj(style);
1701 }
1702
1703 DEFPRIMITIVE(EmptySosofo, argc, argv, context, interp, loc)
1704 {
1705   return new (interp) EmptySosofoObj;
1706 }
1707
1708 DEFPRIMITIVE(SosofoLabel, argc, argv, context, interp, loc)
1709 {
1710   SosofoObj *sosofo = argv[0]->asSosofo();
1711   if (!sosofo)
1712     return argError(interp, loc, InterpreterMessages::notASosofo,
1713                     0, argv[0]);
1714
1715   SymbolObj *sym = argv[1]->asSymbol();
1716   if (!sym)
1717     return argError(interp, loc,
1718                     InterpreterMessages::notASymbol, 1, argv[1]);
1719   return new (interp) LabelSosofoObj(sym, loc, sosofo);
1720 }
1721
1722 DEFPRIMITIVE(SosofoDiscardLabeled, argc, argv, context, interp, loc)
1723 {
1724   SosofoObj *sosofo = argv[0]->asSosofo();
1725   if (!sosofo)
1726     return argError(interp, loc, InterpreterMessages::notASosofo,
1727                     0, argv[0]);
1728
1729   SymbolObj *sym = argv[1]->asSymbol();
1730   if (!sym)
1731     return argError(interp, loc,
1732                     InterpreterMessages::notASymbol, 1, argv[1]);
1733   return new (interp) DiscardLabeledSosofoObj(sym, sosofo);
1734 }
1735
1736 DEFPRIMITIVE(IsSosofo, argc, argv, context, interp, loc)
1737 {
1738   if (argv[0]->asSosofo())
1739     return interp.makeTrue();
1740   else
1741     return interp.makeFalse();
1742 }
1743
1744 DEFPRIMITIVE(MergeStyle, argc, argv, context, interp, loc)
1745 {
1746   MergeStyleObj *merged = new (interp) MergeStyleObj;
1747   for (int i = 0; i < argc; i++) {
1748     StyleObj *style = argv[i]->asStyle();
1749     if (!style)
1750       return argError(interp, loc,
1751                       InterpreterMessages::notAStyle, i, argv[i]);
1752     merged->append(style);
1753   }
1754   return merged;
1755 }
1756
1757 DEFPRIMITIVE(IsStyle, argc, argv, context, interp, loc)
1758 {
1759   if (argv[0]->asStyle())
1760     return interp.makeTrue();
1761   else
1762     return interp.makeFalse();
1763 }
1764
1765 DEFPRIMITIVE(CurrentNodePageNumberSosofo, argc, argv, context, interp, loc)
1766 {
1767   if (!context.currentNode)
1768     return noCurrentNodeError(interp, loc);
1769   return new (interp) CurrentNodePageNumberSosofoObj(context.currentNode);
1770 }
1771
1772 DEFPRIMITIVE(PageNumberSosofo, argc, argv, context, interp, loc)
1773 {
1774   return new (interp) PageNumberSosofoObj;
1775 }
1776
1777 DEFPRIMITIVE(ProcessElementWithId, argc, argv, context, interp, loc)
1778 {
1779   const Char *s;
1780   size_t n;
1781   if (!argv[0]->stringData(s, n))
1782     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
1783   if (!context.currentNode)
1784     return noCurrentNodeError(interp, loc);
1785   if (!context.processingMode) {
1786     interp.setNextLocation(loc);
1787     interp.message(InterpreterMessages::noCurrentProcessingMode);
1788     return interp.makeError();
1789   }
1790   NodePtr root;
1791   NamedNodeListPtr elements;
1792   if (context.currentNode->getGroveRoot(root) == accessOK
1793       && root->getElements(elements) == accessOK) {
1794     NodePtr node;
1795     if (elements->namedNode(GroveString(s, n), node) == accessOK)
1796       return new (interp) ProcessNodeSosofoObj(node, context.processingMode);
1797   }
1798   return new (interp) EmptySosofoObj;
1799 }
1800
1801 DEFPRIMITIVE(ProcessFirstDescendant, argc, argv, context, interp, loc)
1802 {
1803   if (!context.processingMode) {
1804     interp.setNextLocation(loc);
1805     interp.message(InterpreterMessages::noCurrentProcessingMode);
1806     return interp.makeError();
1807   }
1808   if (!context.currentNode)
1809     return noCurrentNodeError(interp, loc);
1810
1811   NCVector<Pattern> patterns(argc);
1812   for (size_t i = 0; i < argc; i++) {
1813     if (!interp.convertToPattern(argv[i], loc, patterns[i]))
1814       return interp.makeError();
1815   }
1816   NodeListObj *nl = new (interp) DescendantsNodeListObj(context.currentNode);
1817   ELObjDynamicRoot protect(interp, nl);
1818   nl = new (interp) SelectElementsNodeListObj(nl, patterns);
1819   protect = nl;
1820   NodePtr nd(nl->nodeListFirst(context, interp));
1821   if (!nd)
1822     return new (interp) EmptySosofoObj;
1823   return new (interp) ProcessNodeSosofoObj(nd, context.processingMode);
1824 }
1825
1826 DEFPRIMITIVE(ProcessMatchingChildren, argc, argv, context, interp, loc)
1827 {
1828   if (!context.processingMode) {
1829     interp.setNextLocation(loc);
1830     interp.message(InterpreterMessages::noCurrentProcessingMode);
1831     return interp.makeError();
1832   }
1833   if (!context.currentNode)
1834     return noCurrentNodeError(interp, loc);
1835   NCVector<Pattern> patterns(argc);
1836   for (size_t i = 0; i < argc; i++) {
1837     if (!interp.convertToPattern(argv[i], loc, patterns[i]))
1838       return interp.makeError();
1839   }
1840   NodeListPtr nlPtr;
1841   // FIXME handle root
1842   if (patterns.size() == 0 || context.currentNode->children(nlPtr) != accessOK)
1843     return new (interp) EmptySosofoObj;
1844   NodeListObj *nl = new (interp) NodeListPtrNodeListObj(nlPtr);
1845   ELObjDynamicRoot protect(interp, nl);
1846   nl = new (interp) SelectElementsNodeListObj(nl, patterns);
1847   protect = nl;
1848   return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode);
1849 }
1850
1851 DEFPRIMITIVE(SelectElements, argc, argv, context, interp, loc)
1852 {
1853   NodeListObj *nl = argv[0]->asNodeList();
1854   if (!nl)
1855     return argError(interp, loc,
1856                     InterpreterMessages::notANodeList, 0, argv[0]);
1857   NCVector<Pattern> patterns(1);
1858   if (!interp.convertToPattern(argv[1], loc, patterns[0]))
1859     return interp.makeError();
1860   return new (interp) SelectElementsNodeListObj(nl, patterns);
1861 }
1862
1863 DEFPRIMITIVE(IsMatchElement, argc, argv, context, interp, loc)
1864 {
1865   Pattern pattern;
1866   if (!interp.convertToPattern(argv[0], loc, pattern))
1867     return interp.makeError();
1868   NodePtr node;
1869   if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
1870     return argError(interp, loc,
1871                     InterpreterMessages::notASingletonNode, 1, argv[1]);
1872   if (pattern.matches(node, interp))
1873     return interp.makeTrue();
1874   return interp.makeFalse();
1875 }
1876
1877 DEFPRIMITIVE(ProcessNodeList, argc, argv, context, interp, loc)
1878 {
1879   if (!context.processingMode) {
1880     interp.setNextLocation(loc);
1881     interp.message(InterpreterMessages::noCurrentProcessingMode);
1882     return interp.makeError();
1883   }
1884   NodeListObj *nl = argv[0]->asNodeList();
1885   if (!nl)
1886     return argError(interp, loc,
1887                     InterpreterMessages::notANodeList, 0, argv[0]);
1888   return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode);
1889 }
1890
1891 static
1892 void reverse(StringC &s)
1893 {
1894   size_t i = 0;
1895   size_t j = s.size() - 1;
1896   while (i < j) {
1897     Char tem = s[i];
1898     s[i] = s[j];
1899     s[j] = tem;
1900     i++;
1901     j--;
1902   }
1903 }
1904
1905 static
1906 StringC formatNumberLetter(long n, const char *letters)
1907 {
1908   StringC result;
1909   if (n == 0)
1910     result += '0';
1911   else {
1912     bool neg;
1913     // FIXME possibility of overflow
1914     if (n < 0) {
1915       n = -n;
1916       neg = 1;
1917     }
1918     else
1919       neg = 0;
1920     do {
1921       n--;
1922       int r = n % 26;
1923       n -= r;
1924       n /= 26;
1925       result += letters[r];
1926     } while (n > 0);
1927     if (neg)
1928       result += '-';
1929     reverse(result);
1930   }
1931   return result;
1932 }
1933
1934 static
1935 StringC formatNumberDecimal(long n, size_t minWidth)
1936 {
1937   StringC result;
1938   char buf[32];
1939   sprintf(buf, "%ld", n);
1940   const char *p = buf;
1941   if (*p == '-') {
1942     p++;
1943     result += '-';
1944   }
1945   size_t len = strlen(p);
1946   while (len < minWidth) {
1947     result += '0';
1948     len++;
1949   }
1950   while (*p)
1951     result += *p++;
1952   return result;
1953 }
1954
1955 static
1956 StringC formatNumberRoman(long n, const char *letters)
1957 {
1958   StringC result;
1959   if (n > 5000 || n < -5000 || n == 0)
1960     return formatNumberDecimal(n, 1);
1961   if (n < 0) {
1962     n = -n;
1963     result += '-';
1964   }
1965   while (n >= 1000) {
1966     result += letters[0];
1967     n -= 1000;
1968   }
1969   for (int i = 100; i > 0; i /= 10, letters += 2) {
1970     long q = n / i;
1971     n -= q * i;
1972     switch (q) {
1973     case 1:
1974       result += letters[2];
1975       break;
1976     case 2:
1977       result += letters[2];
1978       result += letters[2];
1979       break;
1980     case 3:
1981       result += letters[2];
1982       result += letters[2];
1983       result += letters[2];
1984       break;
1985     case 4:
1986       result += letters[2];
1987       result += letters[1];
1988       break;
1989     case 5:
1990       result += letters[1];
1991       break;
1992     case 6:
1993       result += letters[1];
1994       result += letters[2];
1995       break;
1996     case 7:
1997       result += letters[1];
1998       result += letters[2];
1999       result += letters[2];
2000       break;
2001     case 8:
2002       result += letters[1];
2003       result += letters[2];
2004       result += letters[2];
2005       result += letters[2];
2006       break;
2007     case 9:
2008       result += letters[2];
2009       result += letters[0];
2010       break;
2011     }
2012   }
2013   return result;
2014 }
2015
2016 static
2017 bool formatNumber(long n, const Char *s, size_t len, StringC &result)
2018 {
2019   if (len > 0) {
2020     switch (s[len - 1]) {
2021     case 'a':
2022       result += formatNumberLetter(n, "abcdefghijklmnopqrstuvwxyz");
2023       return 1;
2024     case 'A':
2025       result += formatNumberLetter(n, "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
2026       return 1;
2027     case 'i':
2028       result += formatNumberRoman(n, "mdclxvi");
2029       return 1;
2030     case 'I':
2031       result += formatNumberRoman(n, "MDCLXVI");
2032       return 1;
2033     case '1':
2034       result += formatNumberDecimal(n, len);
2035       return 1;
2036     default:
2037       break;
2038     }
2039   }
2040   result += formatNumberDecimal(n, 1);
2041   return 0;
2042 }
2043
2044 DEFPRIMITIVE(FormatNumber, argc, argv, context, interp, loc)
2045 {
2046   long n;
2047   if (!argv[0]->exactIntegerValue(n))
2048     return argError(interp, loc,
2049                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
2050   const Char *s;
2051   size_t len;
2052   if (!argv[1]->stringData(s, len))
2053     return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
2054   StringObj *result = new (interp) StringObj;
2055   if (!formatNumber(n, s, len, *result)) {
2056     interp.setNextLocation(loc);
2057     interp.message(InterpreterMessages::invalidNumberFormat,
2058                    StringMessageArg(StringC(s, len)));
2059   }
2060   return result;
2061 }
2062
2063 DEFPRIMITIVE(FormatNumberList, argc, argv, context, interp, loc)
2064 {
2065   ELObj *numbers = argv[0];
2066   ELObj *formats = argv[1];
2067   ELObj *seps = argv[2];
2068   StringObj *result = new (interp) StringObj;
2069   while (!numbers->isNil()) {
2070     PairObj *tem;
2071     const Char *s;
2072     size_t len;
2073     if (numbers != argv[0]) {
2074       if (!seps->stringData(s, len)) {
2075         tem = seps->asPair();
2076         if (!tem)
2077           return argError(interp, loc,
2078                           InterpreterMessages::notAList, 2, argv[2]);
2079         if (!tem->car()->stringData(s, len))
2080           return argError(interp, loc,
2081                           InterpreterMessages::notAString, 2, tem->car());
2082         seps = tem->cdr();
2083       }
2084       result->append(s, len);
2085     }
2086     tem = numbers->asPair();
2087     if (!tem)
2088       return argError(interp, loc,
2089                       InterpreterMessages::notAList, 0, argv[0]);
2090     long k;
2091     if (!tem->car()->exactIntegerValue(k))
2092       // FIXME message not quite right
2093       return argError(interp, loc,
2094                       InterpreterMessages::notAnExactInteger, 0, tem->car());
2095     numbers = tem->cdr();
2096     if (!formats->stringData(s, len)) {
2097       tem = formats->asPair();
2098       if (!tem)
2099         return argError(interp, loc,
2100                         InterpreterMessages::notAList, 1, argv[1]);
2101       if (!tem->car()->stringData(s, len))
2102         return argError(interp, loc,
2103                         InterpreterMessages::notAString, 0, tem->car());
2104       formats = tem->cdr();
2105     }
2106     if (!formatNumber(k, s, len, *result)) {
2107       interp.setNextLocation(loc);
2108       interp.message(InterpreterMessages::invalidNumberFormat,
2109                      StringMessageArg(StringC(s, len)));
2110     }
2111   }
2112   return result;
2113 }
2114
2115 DEFPRIMITIVE(ExternalProcedure, argc, argv, context, interp, loc)
2116 {
2117   const Char *s;
2118   size_t n;
2119   if (!argv[0]->stringData(s, n))
2120     return argError(interp, loc,
2121                     InterpreterMessages::notAString, 0, argv[0]);
2122   StringC tem(s, n);
2123   FunctionObj *func = interp.lookupExternalProc(tem);
2124   if (func)
2125     return func;
2126   return interp.makeFalse();
2127 }
2128
2129 DEFPRIMITIVE(Error, argc, argv, context, interp, loc)
2130 {
2131   const Char *s;
2132   size_t n;
2133   if (!argv[0]->stringData(s, n))
2134     return argError(interp, loc,
2135                     InterpreterMessages::notAString, 0, argv[0]);
2136   interp.setNextLocation(loc);
2137   interp.message(InterpreterMessages::errorProc,
2138                  StringMessageArg(StringC(s, n)));
2139   return interp.makeError();
2140 }
2141
2142 DEFPRIMITIVE(StringToNumber, argc, argv, context, interp, loc)
2143 {
2144   const Char *s;
2145   size_t n;
2146   if (!argv[0]->stringData(s, n))
2147     return argError(interp, loc,
2148                     InterpreterMessages::notAString, 0, argv[0]);
2149   long radix;
2150   if (argc > 1) {
2151     if (!argv[1]->exactIntegerValue(radix))
2152       return argError(interp, loc,
2153                       InterpreterMessages::notAnExactInteger, 1, argv[1]);
2154     switch (radix) {
2155     case 2:
2156     case 8:
2157     case 10:
2158     case 16:
2159       break;
2160     default:
2161       interp.setNextLocation(loc);
2162       interp.message(InterpreterMessages::invalidRadix);
2163       radix = 10;
2164       break;
2165     }
2166   }
2167   else
2168     radix = 10;
2169   ELObj *result = interp.convertNumber(StringC(s, n), int(radix));
2170   if (result) {
2171     result = result->resolveQuantities(0, interp, loc);
2172     if (interp.isError(result))
2173       return result;
2174     long n;
2175     double d;
2176     int dim;
2177     if (result->quantityValue(n, d, dim) != ELObj::noQuantity)
2178       return result;
2179   }
2180   return interp.makeFalse();
2181 }
2182
2183 DEFPRIMITIVE(NumberToString, argc, argv, context, interp, loc)
2184 {
2185   double x;
2186   if (!argv[0]->realValue(x))
2187     return argError(interp, loc,
2188                     InterpreterMessages::notANumber, 0, argv[0]);
2189   unsigned radix;
2190   if (argc > 1) {
2191     long r;
2192     if (!argv[1]->exactIntegerValue(r))
2193       return argError(interp, loc,
2194                       InterpreterMessages::notAnExactInteger, 1, argv[1]);
2195     switch (r) {
2196     case 2:
2197     case 8:
2198     case 10:
2199     case 16:
2200       radix = unsigned(r);
2201       break;
2202     default:
2203       interp.setNextLocation(loc);
2204       interp.message(InterpreterMessages::invalidRadix);
2205       radix = 10;
2206       break;
2207     }
2208   }
2209   else
2210     radix = 10;
2211   StrOutputCharStream os;
2212   argv[0]->print(interp, os, radix);
2213   StringC tem;
2214   os.extractString(tem);
2215   return new (interp) StringObj(tem);
2216 }
2217
2218 DEFPRIMITIVE(QuantityToString, argc, argv, context, interp, loc)
2219 {
2220   long lResult;
2221   double dResult;
2222   int dim;
2223   if (argv[0]->quantityValue(lResult, dResult, dim) == ELObj::noQuantity)
2224     return argError(interp, loc,
2225                     InterpreterMessages::notAQuantity, 0, argv[0]);
2226   unsigned radix;
2227   if (argc > 1) {
2228     long r;
2229     if (!argv[1]->exactIntegerValue(r))
2230       return argError(interp, loc,
2231                       InterpreterMessages::notAnExactInteger, 1, argv[1]);
2232     switch (r) {
2233     case 2:
2234     case 8:
2235     case 10:
2236     case 16:
2237       radix = unsigned(r);
2238       break;
2239     default:
2240       interp.setNextLocation(loc);
2241       interp.message(InterpreterMessages::invalidRadix);
2242       radix = 10;
2243       break;
2244     }
2245   }
2246   else
2247     radix = 10;
2248   StrOutputCharStream os;
2249   argv[0]->print(interp, os, radix);
2250   StringC tem;
2251   os.extractString(tem);
2252   return new (interp) StringObj(tem);
2253 }
2254
2255 DEFPRIMITIVE(DisplaySize, argc, argv, context, interp, loc)
2256 {
2257   return new (interp) LengthSpecObj(LengthSpec(LengthSpec::displaySize, 1.0));
2258 }
2259
2260 DEFPRIMITIVE(TableUnit, argc, argv, context, interp, loc)
2261 {
2262   long k;
2263   if (!argv[0]->exactIntegerValue(k))
2264     return argError(interp, loc,
2265                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
2266
2267   return new (interp) LengthSpecObj(LengthSpec(LengthSpec::tableUnit, double(k)));
2268 }
2269
2270 DEFPRIMITIVE(IsDisplaySpace, argc, argv, context, interp, loc)
2271 {
2272   if (argv[0]->asDisplaySpace())
2273     return interp.makeTrue();
2274   else
2275     return interp.makeFalse();
2276 }
2277
2278
2279 DEFPRIMITIVE(DisplaySpace, argc, argv, context, interp, loc)
2280 {
2281   FOTBuilder::DisplaySpace displaySpace;
2282   if (!interp.convertLengthSpec(argv[0], displaySpace.nominal))
2283     return argError(interp, loc,
2284                     InterpreterMessages::notALengthSpec, 0, argv[0]);
2285   displaySpace.min = displaySpace.nominal;
2286   displaySpace.max = displaySpace.nominal;
2287   // first specified keyword argument takes priority,
2288   // so scan them backwards...
2289   for (int i = argc - 1; i > 0; i -= 2) {
2290     if ((argc & 1) == 0) {
2291       interp.setNextLocation(loc);
2292       interp.message(InterpreterMessages::oddKeyArgs);
2293       return interp.makeError();
2294     }
2295     KeywordObj *keyObj = argv[i - 1]->asKeyword();
2296     if (!keyObj) {
2297       interp.setNextLocation(loc);
2298       interp.message(InterpreterMessages::keyArgsNotKey);
2299       return interp.makeError();
2300     }
2301     Identifier::SyntacticKey key;
2302     if (!keyObj->identifier()->syntacticKey(key)) {
2303       interp.setNextLocation(loc);
2304       interp.message(InterpreterMessages::invalidKeyArg,
2305                      StringMessageArg(keyObj->identifier()->name()));
2306       return interp.makeError();
2307     }
2308     else {
2309       switch (key) {
2310       case Identifier::keyMin:
2311         if (!interp.convertLengthSpec(argv[i], displaySpace.min))
2312           return argError(interp, loc,
2313                           InterpreterMessages::notALengthSpec, i, argv[i]);
2314         break;
2315       case Identifier::keyMax:
2316         if (!interp.convertLengthSpec(argv[i], displaySpace.max))
2317           return argError(interp, loc,
2318                           InterpreterMessages::notALengthSpec, i, argv[i]);
2319         break;
2320       case Identifier::keyIsConditional:
2321         if (argv[i] == interp.makeTrue())
2322           displaySpace.conditional = 1;
2323         else if (argv[i] == interp.makeFalse())
2324           displaySpace.conditional = 0;
2325         else
2326           return argError(interp, loc,
2327                           InterpreterMessages::notABoolean, i, argv[i]);
2328         break;
2329       case Identifier::keyPriority:
2330         if (argv[i]->exactIntegerValue(displaySpace.priority))
2331           displaySpace.force = 0;
2332         else {
2333           SymbolObj *sym = argv[i]->asSymbol();
2334           if (sym && sym->cValue() == FOTBuilder::symbolForce)
2335             displaySpace.force = 1;
2336           else
2337             return argError(interp, loc,
2338                             InterpreterMessages::notAPriority, i, argv[i]);
2339         }
2340         break;
2341       default:
2342         interp.setNextLocation(loc);
2343         interp.message(InterpreterMessages::invalidKeyArg,
2344                        StringMessageArg(keyObj->identifier()->name()));
2345         return interp.makeError();
2346       }
2347     }
2348   }
2349   return new (interp) DisplaySpaceObj(displaySpace);
2350 }
2351
2352 DEFPRIMITIVE(IsInlineSpace, argc, argv, context, interp, loc)
2353 {
2354   if (argv[0]->asInlineSpace())
2355     return interp.makeTrue();
2356   else
2357     return interp.makeFalse();
2358 }
2359
2360 DEFPRIMITIVE(InlineSpace, argc, argv, context, interp, loc)
2361 {
2362   FOTBuilder::InlineSpace inlineSpace;
2363   if (!interp.convertLengthSpec(argv[0], inlineSpace.nominal))
2364     return argError(interp, loc,
2365                     InterpreterMessages::notALengthSpec, 0, argv[0]);
2366   inlineSpace.min = inlineSpace.nominal;
2367   inlineSpace.max = inlineSpace.nominal;
2368   // first specified keyword argument takes priority,
2369   // so scan them backwards...
2370   for (int i = argc - 1; i > 0; i -= 2) {
2371     if ((argc & 1) == 0) {
2372       interp.setNextLocation(loc);
2373       interp.message(InterpreterMessages::oddKeyArgs);
2374       return interp.makeError();
2375     }
2376     KeywordObj *keyObj = argv[i - 1]->asKeyword();
2377     if (!keyObj) {
2378       interp.setNextLocation(loc);
2379       interp.message(InterpreterMessages::keyArgsNotKey);
2380       return interp.makeError();
2381     }
2382     Identifier::SyntacticKey key;
2383     if (!keyObj->identifier()->syntacticKey(key)) {
2384       interp.setNextLocation(loc);
2385       interp.message(InterpreterMessages::invalidKeyArg,
2386                      StringMessageArg(keyObj->identifier()->name()));
2387       return interp.makeError();
2388     }
2389     else {
2390       switch (key) {
2391       case Identifier::keyMin:
2392         if (!interp.convertLengthSpec(argv[i], inlineSpace.min))
2393           return argError(interp, loc,
2394                           InterpreterMessages::notALengthSpec, i, argv[i]);
2395         break;
2396       case Identifier::keyMax:
2397         if (!interp.convertLengthSpec(argv[i], inlineSpace.max))
2398           return argError(interp, loc,
2399                           InterpreterMessages::notALengthSpec, i, argv[i]);
2400         break;
2401       default:
2402         interp.setNextLocation(loc);
2403         interp.message(InterpreterMessages::invalidKeyArg,
2404                        StringMessageArg(keyObj->identifier()->name()));
2405         return interp.makeError();
2406       }
2407     }
2408   }
2409   return new (interp) InlineSpaceObj(inlineSpace);
2410   return argv[0];
2411 }
2412
2413 DEFPRIMITIVE(IsColor, argc, argv, context, interp, loc)
2414 {
2415   if (argv[0]->asColor())
2416     return interp.makeTrue();
2417   else
2418     return interp.makeFalse();
2419 }
2420
2421 DEFPRIMITIVE(IsColorSpace, argc, argv, context, interp, loc)
2422 {
2423   if (argv[0]->asColorSpace())
2424     return interp.makeTrue();
2425   else
2426     return interp.makeFalse();
2427 }
2428
2429 static
2430 bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
2431                    int nKeys, Interpreter &interp, const Location &loc, int *pos);
2432
2433 // return 1 if obj is a list of numbers of length len.
2434 static
2435 bool decodeNumVector(double *res, int len, ELObj *obj)
2436 {
2437   ELObj *e = obj;
2438   PairObj *p;
2439   for (int i = 0; i < len; i++) {
2440     p = e->asPair();
2441     if (!p || !p->car()->realValue(res[i]))
2442       return 0;
2443     e = p->cdr();
2444   }
2445   return 1;
2446 }
2447
2448 static
2449 bool decodeFuncVector(FunctionObj **res, int len, ELObj *obj)
2450 {
2451   ELObj *e = obj;
2452   PairObj *p;
2453   for (int i = 0; i < len; i++) {
2454     p = e->asPair();
2455     if (!p || !(res[i] = p->car()->asFunction()))
2456       return 0;
2457     e = p->cdr();
2458   }
2459   return 1;
2460 }
2461
2462 DEFPRIMITIVE(ColorSpace, argc, argv, context, interp, loc)
2463 {
2464   const Char *s;
2465   size_t n;
2466   if (!argv[0]->stringData(s, n))
2467      return argError(interp, loc,
2468                     InterpreterMessages::notAString, 0, argv[0]);
2469   StringC str(s, (n < 43) ? n : 43);
2470   if (str == interp.makeStringC("ISO/IEC 10179:1996//Color-Space Family::Dev")) {
2471     str.assign(s + 40, n - 40);
2472     ELObj *res;
2473     if (str == interp.makeStringC("Device RGB"))
2474       res = new (interp) DeviceRGBColorSpaceObj;
2475     else if (str == interp.makeStringC("Device Gray"))
2476       res = new (interp) DeviceGrayColorSpaceObj;
2477     else if (str == interp.makeStringC("Device CMYK"))
2478       res = new (interp) DeviceCMYKColorSpaceObj;
2479     else if (str == interp.makeStringC("Device KX"))
2480       res = new (interp) DeviceKXColorSpaceObj;
2481     else {
2482       interp.setNextLocation(loc);
2483       interp.message(InterpreterMessages::unknownColorSpaceFamily,
2484                      StringMessageArg(StringC(s, n)));
2485       return interp.makeError();
2486     }
2487     if (argc > 1) {
2488       interp.setNextLocation(loc);
2489       interp.message(InterpreterMessages::colorSpaceNoArgs,
2490                      StringMessageArg(str));
2491     }
2492     return res;
2493   }
2494   else if (str == interp.makeStringC("ISO/IEC 10179:1996//Color-Space Family::CIE")) {
2495     str.assign(s + 40, n - 40);
2496     if (   str == interp.makeStringC("CIE LUV")
2497         || str == interp.makeStringC("CIE LAB")
2498         || str == interp.makeStringC("CIE Based ABC")
2499         || str == interp.makeStringC("CIE Based A")) {
2500       static const Identifier::SyntacticKey keys[12] = {
2501         Identifier::keyWhitePoint,
2502         Identifier::keyBlackPoint,
2503         Identifier::keyRange,
2504         Identifier::keyRangeAbc,
2505         Identifier::keyRangeLmn,
2506         Identifier::keyRangeA,
2507         Identifier::keyMatrixAbc,
2508         Identifier::keyMatrixLmn,
2509         Identifier::keyMatrixA,
2510         Identifier::keyDecodeAbc,
2511         Identifier::keyDecodeLmn,
2512         Identifier::keyDecodeA
2513       };
2514       int pos[12];
2515       // FIXME messages
2516       double wp[3], bp[3], range[6];
2517       double rangeAbc[6], rangeLmn[6], rangeA[2];
2518       double matrixAbc[9], matrixLmn[9], matrixA[3];
2519       FunctionObj *decodeAbc[3], *decodeLmn[3], *decodeA;
2520       if (!decodeKeyArgs(argc - 1, argv + 1, keys, 12, interp, loc, pos)
2521           || (pos[0] < 0)
2522           || (pos[0] >= 0 && !decodeNumVector(wp, 3, argv[pos[0] + 1]))
2523           || (pos[1] >= 0 && !decodeNumVector(bp, 3, argv[pos[1] + 1]))
2524           || (pos[2] >= 0 && !decodeNumVector(range, 6, argv[pos[2] + 1]))
2525           || (pos[3] >= 0 && !decodeNumVector(rangeAbc, 6, argv[pos[3] + 1]))
2526           || (pos[4] >= 0 && !decodeNumVector(rangeLmn, 6, argv[pos[4] + 1]))
2527           || (pos[5] >= 0 && !decodeNumVector(rangeA, 2, argv[pos[5] + 1]))
2528           || (pos[6] >= 0 && !decodeNumVector(matrixAbc, 9, argv[pos[6] + 1]))
2529           || (pos[7] >= 0 && !decodeNumVector(matrixLmn, 9, argv[pos[7] + 1]))
2530           || (pos[8] >= 0 && !decodeNumVector(matrixA, 3, argv[pos[8] + 1]))
2531           || (pos[9] >= 0 && !decodeFuncVector(decodeAbc, 3, argv[pos[9] + 1]))
2532           || (pos[10] >= 0 && !decodeFuncVector(decodeLmn, 3, argv[pos[10] + 1]))
2533           || (pos[11] >= 0 && !(decodeA = argv[pos[11] + 1]->asFunction()))) {
2534         interp.setNextLocation(loc);
2535         interp.message(InterpreterMessages::colorSpaceArgError,
2536                        StringMessageArg(str));
2537         return interp.makeError();
2538       }
2539       if (   str == interp.makeStringC("CIE LUV")
2540           || str == interp.makeStringC("CIE LAB")) {
2541         for (int i = 3; i < 12; i++)
2542           if (pos[i] >= 0) {
2543             interp.setNextLocation(loc);
2544             interp.message(InterpreterMessages::colorSpaceArgError,
2545                            StringMessageArg(str));
2546             return interp.makeError();
2547           }
2548         if (str == interp.makeStringC("CIE LUV"))
2549           return new (interp) CIELUVColorSpaceObj(wp, (pos[1] >= 0) ? bp : 0,
2550                                                   (pos[2] >= 0) ? range : 0);
2551         else
2552           return new (interp) CIELABColorSpaceObj(wp, (pos[1] >= 0) ? bp : 0,
2553                                                   (pos[2] >= 0) ? range : 0);
2554       }
2555       else if (str == interp.makeStringC("CIE Based ABC")) {
2556         if (pos[2] >= 0 || pos[5] >= 0 || pos[8] >= 0 || pos[11] >= 0) {
2557           interp.setNextLocation(loc);
2558           interp.message(InterpreterMessages::colorSpaceArgError,
2559                          StringMessageArg(str));
2560           return interp.makeError();
2561         }
2562         return new (interp) CIEABCColorSpaceObj(wp,
2563             (pos[1] >= 0) ? bp : 0,
2564             (pos[3] >= 0) ? rangeAbc : 0,
2565             (pos[9] >= 0) ? decodeAbc : 0,
2566             (pos[6] >= 0) ? matrixAbc : 0,
2567             (pos[4] >= 0) ? rangeLmn : 0,
2568             (pos[10] >= 0) ? decodeLmn : 0,
2569             (pos[7] >= 0) ? matrixLmn : 0);
2570       }
2571       else { // CIE Based A
2572         if (pos[2] >= 0 || pos[3] >= 0 || pos[6] >= 0 || pos[9] >= 0) {
2573           interp.setNextLocation(loc);
2574           interp.message(InterpreterMessages::colorSpaceArgError,
2575                          StringMessageArg(str));
2576           return interp.makeError();
2577         }
2578         return new (interp) CIEAColorSpaceObj(wp,
2579             (pos[1] >= 0) ? bp : 0,
2580             (pos[5] >= 0) ? rangeA : 0,
2581             (pos[11] >= 0) ? decodeA : 0,
2582             (pos[8] >= 0) ? matrixA : 0,
2583             (pos[4] >= 0) ? rangeLmn : 0,
2584             (pos[10] >= 0) ? decodeLmn : 0,
2585             (pos[7] >= 0) ? matrixLmn : 0);
2586       }
2587     }
2588   }
2589   interp.setNextLocation(loc);
2590   interp.message(InterpreterMessages::unknownColorSpaceFamily,
2591                  StringMessageArg(StringC(s, n)));
2592   return interp.makeError();
2593 }
2594
2595 DEFPRIMITIVE(Color, argc, argv, context, interp, loc)
2596 {
2597   ColorSpaceObj *colorSpace = argv[0]->asColorSpace();
2598   if (!colorSpace)
2599     return argError(interp, loc,
2600                     InterpreterMessages::notAColorSpace, 0, argv[0]);
2601   return colorSpace->makeColor(argc - 1, argv + 1, interp, loc);
2602  }
2603
2604 DEFPRIMITIVE(IsAddress, argc, argv, context, interp, loc)
2605 {
2606   if (argv[0]->asAddress())
2607     return interp.makeTrue();
2608   else
2609     return interp.makeFalse();
2610 }
2611
2612 DEFPRIMITIVE(IsAddressLocal, argc, argv, context, interp, loc)
2613 {
2614   AddressObj *address = argv[0]->asAddress();
2615   if (!address)
2616     return argError(interp, loc,
2617                     InterpreterMessages::notAnAddress, 0, argv[0]);
2618   if (!context.currentNode)
2619     return noCurrentNodeError(interp, loc);
2620   switch (address->address().type) {
2621   case FOTBuilder::Address::resolvedNode:
2622     if (address->address().node->sameGrove(*context.currentNode))
2623       return interp.makeTrue();
2624     else
2625       return interp.makeFalse();
2626   case FOTBuilder::Address::idref:
2627     return interp.makeTrue();
2628   case FOTBuilder::Address::entity:
2629     return interp.makeFalse();
2630   default:
2631     break;
2632   }
2633   return interp.makeFalse();
2634 }
2635
2636 DEFPRIMITIVE(IsAddressVisited, argc, argv, context, interp, loc)
2637 {
2638   AddressObj *address = argv[0]->asAddress();
2639   if (!address)
2640     return argError(interp, loc,
2641                     InterpreterMessages::notAnAddress, 0, argv[0]);
2642   // FIXME
2643   return interp.makeFalse();
2644 }
2645
2646 DEFPRIMITIVE(CurrentNodeAddress, argc, argv, context, interp, loc)
2647 {
2648   if (!context.currentNode)
2649     return noCurrentNodeError(interp, loc);
2650   return new (interp) AddressObj(FOTBuilder::Address::resolvedNode, context.currentNode);
2651 }
2652
2653 DEFPRIMITIVE(HytimeLinkend, argc, argv, context, interp, loc)
2654 {
2655   if (!context.currentNode)
2656     return noCurrentNodeError(interp, loc);
2657   return new (interp) AddressObj(FOTBuilder::Address::hytimeLinkend, context.currentNode);
2658 }
2659
2660 DEFPRIMITIVE(SgmlDocumentAddress, argc, argv, context, interp, loc)
2661 {
2662   const Char *s;
2663   size_t n;
2664   if (!argv[0]->stringData(s, n))
2665     return argError(interp, loc,
2666                     InterpreterMessages::notAString, 0, argv[0]);
2667   StringC sysid(s, n);
2668   if (!argv[1]->stringData(s, n))
2669     return argError(interp, loc,
2670                     InterpreterMessages::notAString, 1, argv[1]);
2671   return new (interp) AddressObj(FOTBuilder::Address::sgmlDocument, NodePtr(), sysid, StringC(s, n));
2672 }
2673
2674 DEFPRIMITIVE(IdrefAddress, argc, argv, context, interp, loc)
2675 {
2676   // The advantage of doing this rather than using an NodeAddressObj,
2677   // is that when it's a forward reference we don't have to
2678   // wait for the node.  It might be cleaner to use a ProxyNode class
2679   // for this.
2680   const Char *s;
2681   size_t n;
2682   if (!argv[0]->stringData(s, n))
2683     return argError(interp, loc,
2684                     InterpreterMessages::notAString, 0, argv[0]);
2685   if (!context.currentNode)
2686     return noCurrentNodeError(interp, loc);
2687   return new (interp) AddressObj(FOTBuilder::Address::idref, context.currentNode, StringC(s, n));
2688 }
2689
2690 DEFPRIMITIVE(EntityAddress, argc, argv, context, interp, loc)
2691 {
2692   // Note that multiple space separated entity names are allowed;
2693   // currently Address doesn't support multiple nodes, so we can't resolve here.
2694   const Char *s;
2695   size_t n;
2696   if (!argv[0]->stringData(s, n))
2697     return argError(interp, loc,
2698                     InterpreterMessages::notAString, 0, argv[0]);
2699   if (!context.currentNode)
2700     return noCurrentNodeError(interp, loc);
2701   return new (interp) AddressObj(FOTBuilder::Address::entity, context.currentNode, StringC(s, n));
2702 }
2703
2704 DEFPRIMITIVE(NodeListAddress, argc, argv, context, interp, loc)
2705 {
2706   NodePtr node;
2707   if (!argv[0]->optSingletonNodeList(context, interp, node) || !node)
2708     return argError(interp, loc,
2709                     InterpreterMessages::notASingletonNode, 0, argv[0]);
2710   return new (interp) AddressObj(FOTBuilder::Address::resolvedNode, node);
2711 }
2712
2713 DEFPRIMITIVE(CharScriptCase, argc, argv, context, interp, loc)
2714 {
2715   if (!context.styleStack) {
2716     interp.setNextLocation(loc);
2717     interp.message(InterpreterMessages::notInCharacteristicValue);
2718     return interp.makeError();
2719   }
2720   for (size_t i = 0; i < argc; i += 2) {
2721     const Char *s;
2722     size_t n;
2723     if (!argv[i]->stringData(s, n))
2724       return argError(interp, loc,
2725                       InterpreterMessages::notAString, i, argv[i]);
2726   }
2727   // FIXME
2728   return argv[argc - 1];
2729 }
2730
2731 DEFPRIMITIVE(IsGlyphId, argc, argv, context, interp, loc)
2732 {
2733   if (argv[0]->glyphId())
2734     return interp.makeTrue();
2735   else
2736     return interp.makeFalse();
2737 }
2738
2739 DEFPRIMITIVE(GlyphId, argc, argv, context, interp, loc)
2740 {
2741   const Char *s;
2742   size_t n;
2743   if (!argv[0]->stringData(s, n))
2744     return argError(interp, loc,
2745                     InterpreterMessages::notAString, 0, argv[0]);
2746   return interp.convertGlyphId(s, n, loc);
2747 }
2748
2749 DEFPRIMITIVE(IsGlyphSubstTable, argc, argv, context, interp, loc)
2750 {
2751   if (argv[0]->asGlyphSubstTable())
2752     return interp.makeTrue();
2753   else
2754     return interp.makeFalse();
2755 }
2756
2757 DEFPRIMITIVE(GlyphSubstTable, argc, argv, context, interp, loc)
2758 {
2759   ELObj *p = argv[0];
2760   Ptr<FOTBuilder::GlyphSubstTable> table = new FOTBuilder::GlyphSubstTable;
2761   table->uniqueId = interp.allocGlyphSubstTableUniqueId();
2762   while (!p->isNil()) {
2763     PairObj *tem = p->asPair();
2764     if (!tem)
2765       return argError(interp, loc,
2766                       InterpreterMessages::notAGlyphIdPairList, 0, argv[0]);
2767     p = tem->cdr();
2768     tem = tem->car()->asPair();
2769     const FOTBuilder::GlyphId *g1, *g2;
2770     if (!tem
2771         || (g1 = tem->car()->glyphId()) == 0
2772         || (g2 = tem->cdr()->glyphId()) == 0)
2773       return argError(interp, loc,
2774                       InterpreterMessages::notAGlyphIdPairList, 0, argv[0]);
2775     table->pairs.push_back(*g1);
2776     table->pairs.push_back(*g2);
2777   }
2778   return new (interp) GlyphSubstTableObj(table);
2779 }
2780
2781 DEFPRIMITIVE(GlyphSubst, argc, argv, context, interp, loc)
2782 {
2783   GlyphSubstTableObj *table = argv[0]->asGlyphSubstTable();
2784   if (!table)
2785     return argError(interp, loc,
2786                     InterpreterMessages::notAGlyphSubstTable, 0, argv[0]);
2787   const FOTBuilder::GlyphId *glyphId = argv[1]->glyphId();
2788   if (!glyphId)
2789     return argError(interp, loc,
2790                     InterpreterMessages::notAGlyphId, 1, argv[1]);
2791   return new (interp) GlyphIdObj(table->glyphSubstTable()->subst(*glyphId));
2792 }
2793
2794 // Core query language
2795
2796 DEFPRIMITIVE(CurrentNode, argc, argv, context, interp, loc)
2797 {
2798   if (!context.currentNode)
2799     return noCurrentNodeError(interp, loc);
2800   return new (interp) NodePtrNodeListObj(context.currentNode);
2801 }
2802
2803 DEFPRIMITIVE(NodeListError, argc, argv, context, interp, loc)
2804 {
2805   const Char *s;
2806   size_t n;
2807   if (!argv[0]->stringData(s, n))
2808     return argError(interp, loc,
2809                     InterpreterMessages::notAString, 0, argv[0]);
2810   if (!argv[1]->asNodeList())
2811     return argError(interp, loc,
2812                     InterpreterMessages::notANodeList, 1, argv[1]);
2813   NodePtr nd;
2814   const LocNode *lnp;
2815   Location nodeLoc;
2816   if (argv[1]->optSingletonNodeList(context, interp, nd)
2817       && (lnp = LocNode::convert(nd)) != 0
2818       && lnp->getLocation(nodeLoc) == accessOK)
2819     interp.setNextLocation(nodeLoc);
2820   else
2821     interp.setNextLocation(loc);
2822   interp.message(InterpreterMessages::errorProc,
2823                  StringMessageArg(StringC(s, n)));
2824   return interp.makeError();
2825 }
2826
2827 DEFPRIMITIVE(IsNodeListEmpty, argc, argv, context, interp, loc)
2828 {
2829   NodeListObj *nl = argv[0]->asNodeList();
2830   if (!nl)
2831     return argError(interp, loc,
2832                     InterpreterMessages::notANodeList, 0, argv[0]);
2833   if (nl->nodeListFirst(context, interp))
2834     return interp.makeFalse();
2835   else
2836     return interp.makeTrue();
2837 }
2838
2839 DEFPRIMITIVE(IsNodeList, argc, argv, context, interp, loc)
2840 {
2841   if (argv[0]->asNodeList())
2842     return interp.makeTrue();
2843   else
2844     return interp.makeFalse();
2845 }
2846
2847 DEFPRIMITIVE(Parent, argc, argv, context, interp, loc)
2848 {
2849   NodePtr node;
2850   if (argc > 0) {
2851     if (!argv[0]->optSingletonNodeList(context, interp, node))
2852       return argError(interp, loc,
2853                       InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2854     if (!node)
2855       return argv[0];
2856   }
2857   else {
2858     node = context.currentNode;
2859     if (!node)
2860       return noCurrentNodeError(interp, loc);
2861   }
2862   if (node->getParent(node) != accessOK)
2863     return interp.makeEmptyNodeList();
2864   return new (interp) NodePtrNodeListObj(node);
2865 }
2866
2867 static
2868 bool convertGeneralName(ELObj *obj, const NodePtr &node, StringC &result)
2869 {
2870   const Char *s;
2871   size_t n;
2872   if (!obj->stringData(s, n))
2873     return 0;
2874   result.assign(s, n);
2875   NodePtr root;
2876   node->getGroveRoot(root);
2877   NamedNodeListPtr elements;
2878   root->getElements(elements);
2879   result.resize(elements->normalize(result.begin(), result.size()));
2880   return 1;
2881 }
2882
2883 DEFPRIMITIVE(Ancestor, argc, argv, context, interp, loc)
2884 {
2885   NodePtr node;
2886   if (argc > 1) {
2887     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
2888       return argError(interp, loc,
2889                       InterpreterMessages::notASingletonNode, 1, argv[1]);
2890   }
2891   else {
2892     node = context.currentNode;
2893     if (!node)
2894       return noCurrentNodeError(interp, loc);
2895   }
2896   StringC gi;
2897   if (!convertGeneralName(argv[0], node, gi))
2898     return argError(interp, loc,
2899                     InterpreterMessages::notAString, 0, argv[0]);
2900   while (node->getParent(node) == accessOK) {
2901     GroveString str;
2902     if (node->getGi(str) == accessOK && str == GroveString(gi.data(), gi.size()))
2903       return new (interp) NodePtrNodeListObj(node);
2904   }
2905   return interp.makeEmptyNodeList();
2906 }
2907
2908 DEFPRIMITIVE(Gi, argc, argv, context, interp, loc)
2909 {
2910   NodePtr node;
2911   if (argc > 0) {
2912     if (!argv[0]->optSingletonNodeList(context, interp, node))
2913       return argError(interp, loc,
2914                       InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2915   }
2916   else {
2917     if (!context.currentNode)
2918       return noCurrentNodeError(interp, loc);
2919     node = context.currentNode;
2920   }
2921   GroveString str;
2922   if (node && node->getGi(str) == accessOK)
2923     return new (interp) StringObj(str.data(), str.size());
2924   else
2925     return interp.makeFalse();
2926 }
2927
2928 DEFPRIMITIVE(FirstChildGi, argc, argv, context, interp, loc)
2929 {
2930   NodePtr node;
2931   if (argc > 0) {
2932     if (!argv[0]->optSingletonNodeList(context, interp, node))
2933       return argError(interp, loc,
2934                       InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2935     if (!node)
2936       return interp.makeFalse();
2937   }
2938   else {
2939     if (!context.currentNode)
2940       return noCurrentNodeError(interp, loc);
2941     node = context.currentNode;
2942   }
2943   if (node.assignFirstChild() != accessOK)
2944     return interp.makeFalse();
2945   for (;;) {
2946     GroveString str;
2947     if (node->getGi(str) == accessOK)
2948       return new (interp) StringObj(str.data(), str.size());
2949     if (node.assignNextChunkSibling() != accessOK)
2950       break;
2951   }
2952   return interp.makeFalse();
2953 }
2954
2955 DEFPRIMITIVE(Id, argc, argv, context, interp, loc)
2956 {
2957   NodePtr node;
2958   if (argc > 0) {
2959     if (!argv[0]->optSingletonNodeList(context, interp, node))
2960       return argError(interp, loc,
2961                       InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2962   }
2963   else {
2964     if (!context.currentNode)
2965       return noCurrentNodeError(interp, loc);
2966     node = context.currentNode;
2967   }
2968   GroveString str;
2969   if (node && node->getId(str) == accessOK)
2970     return new (interp) StringObj(str.data(), str.size());
2971   else
2972     return interp.makeFalse();
2973 }
2974
2975 static
2976 bool nodeAttributeString(const NodePtr &node, const Char *s, size_t n,
2977                          const SdataMapper &mapper, StringC &value)
2978 {
2979   NamedNodeListPtr atts;
2980   if (node->getAttributes(atts) != accessOK)
2981     return 0;
2982   NodePtr att;
2983   if (atts->namedNode(GroveString(s, n), att) != accessOK)
2984     return 0;
2985   bool implied;
2986   if (att->getImplied(implied) == accessOK && implied)
2987     return 0;
2988   GroveString tokens;
2989   if (att->tokens(tokens) == accessOK) {
2990     value.assign(tokens.data(), tokens.size());
2991     return 1;
2992   }
2993   NodePtr tem;
2994   value.resize(0);
2995   if (att->firstChild(tem) == accessOK) {
2996     do {
2997       GroveString chunk;
2998       if (tem->charChunk(mapper, chunk) == accessOK)
2999         value.append(chunk.data(), chunk.size());
3000     } while (tem.assignNextChunkSibling() == accessOK);
3001   }
3002   return 1;
3003 }
3004
3005 DEFPRIMITIVE(AttributeString, argc, argv, context, interp, loc)
3006 {
3007   NodePtr node;
3008   if (argc > 1) {
3009     if (!argv[1]->optSingletonNodeList(context, interp, node))
3010       return argError(interp, loc,
3011                       InterpreterMessages::notAnOptSingletonNode, 1, argv[1]);
3012     if (!node)
3013       return interp.makeFalse();
3014   }
3015   else {
3016     if (!context.currentNode)
3017       return noCurrentNodeError(interp, loc);
3018     node = context.currentNode;
3019   }
3020   const Char *s;
3021   size_t n;
3022   if (!argv[0]->stringData(s, n))
3023     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3024   StringC value;
3025   if (nodeAttributeString(node, s, n, interp, value))
3026     return new (interp) StringObj(value);
3027   return interp.makeFalse();
3028 }
3029
3030 DEFPRIMITIVE(InheritedAttributeString, argc, argv, context, interp, loc)
3031 {
3032   NodePtr node;
3033   if (argc > 1) {
3034     if (!argv[1]->optSingletonNodeList(context, interp, node))
3035       return argError(interp, loc,
3036                       InterpreterMessages::notAnOptSingletonNode, 1, argv[1]);
3037     if (!node)
3038       return interp.makeFalse();
3039   }
3040   else {
3041     if (!context.currentNode)
3042       return noCurrentNodeError(interp, loc);
3043     node = context.currentNode;
3044   }
3045   const Char *s;
3046   size_t n;
3047   if (!argv[0]->stringData(s, n))
3048     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3049   do {
3050     StringC value;
3051     if (nodeAttributeString(node, s, n, interp, value))
3052       return new (interp) StringObj(value);
3053   } while (node->getParent(node) == accessOK);
3054   return interp.makeFalse();
3055 }
3056
3057 DEFPRIMITIVE(InheritedElementAttributeString, argc, argv, context, interp, loc)
3058 {
3059   NodePtr node;
3060   if (argc > 2) {
3061     if (!argv[2]->optSingletonNodeList(context, interp, node))
3062       return argError(interp, loc,
3063                       InterpreterMessages::notAnOptSingletonNode, 2, argv[2]);
3064     if (!node)
3065       return interp.makeFalse();
3066   }
3067   else {
3068     if (!context.currentNode)
3069       return noCurrentNodeError(interp, loc);
3070     node = context.currentNode;
3071   }
3072   StringC gi;
3073   if (!convertGeneralName(argv[0], node, gi))
3074     return argError(interp, loc,
3075                     InterpreterMessages::notAString, 0, argv[0]);
3076   const Char *s;
3077   size_t n;
3078   if (!argv[1]->stringData(s, n))
3079     return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
3080   do {
3081     GroveString nodeGi;
3082     StringC value;
3083     if (node->getGi(nodeGi) == accessOK
3084         && nodeGi == GroveString(gi.data(), gi.size())
3085         && nodeAttributeString(node, s, n, interp, value))
3086       return new (interp) StringObj(value);
3087   } while (node->getParent(node) == accessOK);
3088   return interp.makeFalse();
3089 }
3090
3091 DEFPRIMITIVE(IsFirstSibling, argc, argv, context, interp, loc)
3092 {
3093   NodePtr nd;
3094   if (argc > 0) {
3095     if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3096       return argError(interp, loc,
3097                       InterpreterMessages::notASingletonNode, 0, argv[0]);
3098   }
3099   else {
3100     if (!context.currentNode)
3101       return noCurrentNodeError(interp, loc);
3102     nd = context.currentNode;
3103   }
3104   GroveString gi;
3105   NodePtr p;
3106   if (nd->firstSibling(p) != accessOK
3107       || nd->getGi(gi) != accessOK)
3108     return interp.makeFalse();
3109   while (*p != *nd) {
3110     GroveString tem;
3111     if (p->getGi(tem) == accessOK && tem == gi)
3112       return interp.makeFalse();
3113     if (p.assignNextChunkSibling() != accessOK)
3114       CANNOT_HAPPEN();
3115   }
3116   return interp.makeTrue();
3117 }
3118
3119 DEFPRIMITIVE(IsAbsoluteFirstSibling, argc, argv, context, interp, loc)
3120 {
3121   NodePtr nd;
3122   if (argc > 0) {
3123     if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3124       return argError(interp, loc,
3125                       InterpreterMessages::notASingletonNode, 0, argv[0]);
3126   }
3127   else {
3128     if (!context.currentNode)
3129       return noCurrentNodeError(interp, loc);
3130     nd = context.currentNode;
3131   }
3132   NodePtr p;
3133   if (nd->firstSibling(p) != accessOK)
3134     return interp.makeFalse();
3135   while (*p != *nd) {
3136     GroveString tem;
3137     if (p->getGi(tem) == accessOK)
3138       return interp.makeFalse();
3139     if (p.assignNextChunkSibling() != accessOK)
3140       CANNOT_HAPPEN();
3141   }
3142   return interp.makeTrue();
3143 }
3144
3145 DEFPRIMITIVE(IsLastSibling, argc, argv, context, interp, loc)
3146 {
3147   NodePtr nd;
3148   if (argc > 0) {
3149     if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3150       return argError(interp, loc,
3151                       InterpreterMessages::notASingletonNode, 0, argv[0]);
3152   }
3153   else {
3154     if (!context.currentNode)
3155       return noCurrentNodeError(interp, loc);
3156     nd = context.currentNode;
3157   }
3158   GroveString gi;
3159   if (nd->getGi(gi) != accessOK)
3160     return interp.makeFalse();
3161   while (nd.assignNextChunkSibling() == accessOK) {
3162     GroveString tem;
3163     if (nd->getGi(tem) == accessOK && tem == gi)
3164       return interp.makeFalse();
3165   }
3166   return interp.makeTrue();
3167 }
3168
3169 DEFPRIMITIVE(IsAbsoluteLastSibling, argc, argv, context, interp, loc)
3170 {
3171   NodePtr nd;
3172   if (argc > 0) {
3173     if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3174       return argError(interp, loc,
3175                       InterpreterMessages::notASingletonNode, 0, argv[0]);
3176   }
3177   else {
3178     if (!context.currentNode)
3179       return noCurrentNodeError(interp, loc);
3180     nd = context.currentNode;
3181   }  while (nd.assignNextChunkSibling() == accessOK) {
3182     GroveString tem;
3183     if (nd->getGi(tem) == accessOK)
3184       return interp.makeFalse();
3185   }
3186   return interp.makeTrue();
3187 }
3188
3189 // Return 0 on error.
3190
3191 bool matchAncestors(ELObj *obj, const NodePtr &node, ELObj *&unmatched)
3192 {
3193   NodePtr parent;
3194   if (node->getParent(parent) != accessOK) {
3195     unmatched = obj;
3196     return 1;
3197   }
3198   if (!matchAncestors(obj, parent, unmatched))
3199     return 0;
3200   if (!unmatched->isNil()) {
3201     PairObj *pair = unmatched->asPair();
3202     if (!pair)
3203       return 0;
3204     StringC gi;
3205     if (!convertGeneralName(pair->car(), node, gi))
3206       return 0;
3207     GroveString tem;
3208     if (parent->getGi(tem) == accessOK
3209         && tem == GroveString(gi.data(), gi.size()))
3210       unmatched = pair->cdr();
3211   }
3212   return 1;
3213 }
3214
3215 DEFPRIMITIVE(IsHaveAncestor, argc, argv, context, interp, loc)
3216 {
3217   NodePtr node;
3218   if (argc > 1) {
3219     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3220       return argError(interp, loc,
3221                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3222   }
3223   else {
3224     if (!context.currentNode)
3225       return noCurrentNodeError(interp, loc);
3226     node = context.currentNode;
3227   }
3228   StringC gi;
3229   if (convertGeneralName(argv[0], node, gi)) {
3230     while (node->getParent(node) == accessOK) {
3231       GroveString tem;
3232       if (node->getGi(tem) == accessOK && tem == GroveString(gi.data(), gi.size()))
3233         return interp.makeTrue();
3234     }
3235     return interp.makeFalse();
3236   }
3237   ELObj *unmatched;
3238   if (!matchAncestors(argv[0], node, unmatched))
3239     return argError(interp, loc,
3240                     InterpreterMessages::notAList, 0, argv[0]);
3241   else if (unmatched->isNil())
3242     return interp.makeTrue();
3243   else
3244     return interp.makeFalse();
3245 }
3246
3247 DEFPRIMITIVE(ChildNumber, argc, argv, context, interp, loc)
3248 {
3249   NodePtr node;
3250   if (argc > 0) {
3251     if (!argv[0]->optSingletonNodeList(context, interp, node) || !node)
3252       return argError(interp, loc,
3253                       InterpreterMessages::notASingletonNode, 0, argv[0]);
3254   }
3255   else {
3256     if (!context.currentNode)
3257       return noCurrentNodeError(interp, loc);
3258     node = context.currentNode;
3259   }
3260   unsigned long num;
3261   if (!interp.childNumber(node, num))
3262     return interp.makeFalse();
3263   return interp.makeInteger(num + 1);
3264 }
3265
3266 DEFPRIMITIVE(AncestorChildNumber, argc, argv, context, interp, loc)
3267 {
3268   NodePtr node;
3269   if (argc > 1) {
3270     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3271       return argError(interp, loc,
3272                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3273   }
3274   else {
3275     if (!context.currentNode)
3276       return noCurrentNodeError(interp, loc);
3277     node = context.currentNode;
3278   }
3279   StringC gi;
3280   if (!convertGeneralName(argv[0], node, gi))
3281     return argError(interp, loc,
3282                     InterpreterMessages::notAString, 0, argv[0]);
3283   while (node->getParent(node) == accessOK) {
3284     GroveString str;
3285     if (node->getGi(str) == accessOK
3286         && str == GroveString(gi.data(), gi.size())) {
3287       unsigned long num;
3288       interp.childNumber(node, num);
3289       return interp.makeInteger(num + 1);
3290     }
3291   }
3292   return interp.makeFalse();
3293 }
3294
3295 DEFPRIMITIVE(HierarchicalNumber, argc, argv, context, interp, loc)
3296 {
3297   NodePtr node;
3298   if (argc > 1) {
3299     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3300       return argError(interp, loc,
3301                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3302   }
3303   else {
3304     if (!context.currentNode)
3305       return noCurrentNodeError(interp, loc);
3306     node = context.currentNode;
3307   }
3308   // Make a reversed copy of the list of GIs.
3309   ELObjDynamicRoot list(interp, 0);
3310   ELObj *p = argv[0];
3311   while (!p->isNil()) {
3312     PairObj *tem = p->asPair();
3313     if (!tem)
3314       return argError(interp, loc,
3315                       InterpreterMessages::notAList, 0, argv[0]);
3316     list = new (interp) PairObj(tem->car(), list);
3317     p = tem->cdr();
3318   }
3319   p = list;
3320   while (p) {
3321     PairObj *pair = (PairObj *)p;
3322     StringC gi;
3323     // FIXME error message not quite right
3324     if (!convertGeneralName(pair->car(), node, gi))
3325       return argError(interp, loc,
3326                       InterpreterMessages::notAString, 0, pair->car());
3327     for (;;) {
3328       // Replace the GI by its number.
3329       if (node->getParent(node) != accessOK) {
3330         pair->setCar(interp.makeInteger(0));
3331         break;
3332       }
3333       GroveString str;
3334       if (node->getGi(str) == accessOK
3335           && str == GroveString(gi.data(), gi.size())) {
3336         unsigned long num;
3337         interp.childNumber(node, num);
3338         pair->setCar(interp.makeInteger(num + 1));
3339         break;
3340       }
3341     }
3342     p = pair->cdr();
3343   }
3344   // Reverse the list of numbers in place.
3345   p = list;
3346   ELObj *result = interp.makeNil();
3347   while (p) {
3348     PairObj *tem = (PairObj *)p;
3349     p = tem->cdr();
3350     tem->setCdr(result);
3351     result = tem;
3352   }
3353   return result;
3354 }
3355
3356 DEFPRIMITIVE(HierarchicalNumberRecursive, argc, argv, context, interp, loc)
3357 {
3358   NodePtr node;
3359   if (argc > 1) {
3360     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3361       return argError(interp, loc,
3362                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3363   }
3364   else {
3365     if (!context.currentNode)
3366       return noCurrentNodeError(interp, loc);
3367     node = context.currentNode;
3368   }
3369   StringC gi;
3370   if (!convertGeneralName(argv[0], node, gi))
3371     return argError(interp, loc,
3372                     InterpreterMessages::notAString, 0, argv[0]);
3373   ELObjDynamicRoot result(interp, interp.makeNil());
3374   while (node->getParent(node) == accessOK) {
3375     GroveString str;
3376     if (node->getGi(str) == accessOK
3377         && str == GroveString(gi.data(), gi.size())) {
3378       unsigned long num;
3379       interp.childNumber(node, num);
3380       PairObj *pair = new (interp) PairObj(0, result);
3381       result = pair;
3382       pair->setCar(interp.makeInteger(num + 1));
3383     }
3384   }
3385   return result;
3386 }
3387
3388 DEFPRIMITIVE(ElementNumber, argc, argv, context, interp, loc)
3389 {
3390   NodePtr node;
3391   if (argc > 0) {
3392     if (!argv[0]->optSingletonNodeList(context, interp, node) || !node)
3393       return argError(interp, loc,
3394                       InterpreterMessages::notASingletonNode, 0, argv[0]);
3395   }
3396   else {
3397     if (!context.currentNode)
3398       return noCurrentNodeError(interp, loc);
3399     node = context.currentNode;
3400   }
3401   GroveString gi;
3402   if (node->getGi(gi) != accessOK)
3403     return interp.makeFalse();
3404   StringC buf(gi.data(), gi.size());
3405   unsigned long num = interp.elementNumber(node, buf);
3406   return interp.makeInteger(num);
3407 }
3408
3409 DEFPRIMITIVE(ElementNumberList, argc, argv, context, interp, loc)
3410 {
3411   NodePtr node;
3412   if (argc > 1) {
3413     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3414       return argError(interp, loc,
3415                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3416   }
3417   else {
3418     if (!context.currentNode)
3419       return noCurrentNodeError(interp, loc);
3420     node = context.currentNode;
3421   }
3422   ELObjDynamicRoot list(interp, 0);
3423   ELObj *p = argv[0];
3424   while (!p->isNil()) {
3425     PairObj *tem = p->asPair();
3426     if (!tem)
3427       return argError(interp, loc,
3428                       InterpreterMessages::notAList, 0, argv[0]);
3429     list = new (interp) PairObj(tem->car(), list);
3430     p = tem->cdr();
3431   }
3432   ELObjDynamicRoot result(interp, interp.makeNil());
3433   p = list;
3434   if (p) {
3435     PairObj *pair = (PairObj *)p;
3436     StringC gi;
3437     if (!convertGeneralName(pair->car(), node, gi))
3438       return argError(interp, loc,
3439                       InterpreterMessages::notAString, 0, pair->car());
3440     p = pair->cdr();
3441     while (p) {
3442       pair = (PairObj *)p;
3443       StringC numGi(gi);
3444       if (!convertGeneralName(pair->car(), node, gi))
3445         return argError(interp, loc,
3446                         InterpreterMessages::notAString, 0, pair->car());
3447       unsigned long num = interp.elementNumberAfter(node, numGi, gi);
3448       PairObj *tem = new (interp) PairObj(0, result);
3449       result = tem;
3450       tem->setCar(interp.makeInteger(num));
3451       p = pair->cdr();
3452     }
3453     unsigned long num = interp.elementNumber(node, gi);
3454     PairObj *tem = new (interp) PairObj(0, result);
3455     result = tem;
3456     tem->setCar(interp.makeInteger(num));
3457   }
3458   return result;
3459 }
3460
3461 DEFPRIMITIVE(EntityAttributeString, argc, argv, context, interp, loc)
3462 {
3463   const Char *entityName;
3464   size_t entityNameLen;
3465   if (!argv[0]->stringData(entityName, entityNameLen))
3466     return argError(interp, loc,
3467                     InterpreterMessages::notAString, 0, argv[0]);
3468   const Char *attName;
3469   size_t attNameLen;
3470   if (!argv[1]->stringData(attName, attNameLen))
3471     return argError(interp, loc,
3472                     InterpreterMessages::notAString, 1, argv[1]);
3473   NodePtr node;
3474   if (argc > 2) {
3475     if (!argv[2]->optSingletonNodeList(context, interp, node) || !node)
3476       return argError(interp, loc,
3477                       InterpreterMessages::notASingletonNode, 2, argv[2]);
3478   }
3479   else {
3480     node = context.currentNode;
3481     if (!node)
3482       return noCurrentNodeError(interp, loc);
3483   }
3484   NamedNodeListPtr entities;
3485   StringC value;
3486   if (node->getGroveRoot(node) == accessOK
3487       && node->getEntities(entities) == accessOK
3488       && entities->namedNode(GroveString(entityName, entityNameLen), node) == accessOK
3489       && nodeAttributeString(node, attName, attNameLen, interp, value))
3490     return new (interp) StringObj(value);
3491   return interp.makeFalse();
3492 }
3493
3494 DEFPRIMITIVE(EntityGeneratedSystemId, argc, argv, context, interp, loc)
3495 {
3496   const Char *s;
3497   size_t n;
3498   if (!argv[0]->stringData(s, n))
3499     return argError(interp, loc,
3500                     InterpreterMessages::notAString, 0, argv[0]);
3501   NodePtr node;
3502   if (argc > 1) {
3503     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3504       return argError(interp, loc,
3505                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3506   }
3507   else {
3508     node = context.currentNode;
3509     if (!node)
3510       return noCurrentNodeError(interp, loc);
3511   }
3512   GroveString str;
3513   NamedNodeListPtr entities;
3514   if (node->getGroveRoot(node) == accessOK
3515       && node->getEntities(entities) == accessOK
3516       && entities->namedNode(GroveString(s, n), node) == accessOK
3517       && node->getExternalId(node) == accessOK
3518       && node->getGeneratedSystemId(str) == accessOK)
3519     return new (interp) StringObj(str.data(), str.size());
3520   return interp.makeFalse();
3521 }
3522
3523 DEFPRIMITIVE(EntitySystemId, argc, argv, context, interp, loc)
3524 {
3525   const Char *s;
3526   size_t n;
3527   if (!argv[0]->stringData(s, n))
3528     return argError(interp, loc,
3529                     InterpreterMessages::notAString, 0, argv[0]);
3530   NodePtr node;
3531   if (argc > 1) {
3532     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3533       return argError(interp, loc,
3534                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3535   }
3536   else {
3537     node = context.currentNode;
3538     if (!node)
3539       return noCurrentNodeError(interp, loc);
3540   }
3541   GroveString str;
3542   NamedNodeListPtr entities;
3543   if (node->getGroveRoot(node) == accessOK
3544       && node->getEntities(entities) == accessOK
3545       && entities->namedNode(GroveString(s, n), node) == accessOK
3546       && node->getExternalId(node) == accessOK
3547       && node->getSystemId(str) == accessOK)
3548     return new (interp) StringObj(str.data(), str.size());
3549   return interp.makeFalse();
3550 }
3551
3552 DEFPRIMITIVE(EntityPublicId, argc, argv, context, interp, loc)
3553 {
3554   const Char *s;
3555   size_t n;
3556   if (!argv[0]->stringData(s, n))
3557     return argError(interp, loc,
3558                     InterpreterMessages::notAString, 0, argv[0]);
3559   NodePtr node;
3560   if (argc > 1) {
3561     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3562       return argError(interp, loc,
3563                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3564   }
3565   else {
3566     node = context.currentNode;
3567     if (!node)
3568       return noCurrentNodeError(interp, loc);
3569   }
3570   GroveString str;
3571   NamedNodeListPtr entities;
3572   if (node->getGroveRoot(node) == accessOK
3573       && node->getEntities(entities) == accessOK) {
3574     StringC tem(s, n);
3575     tem.resize(entities->normalize(tem.begin(), tem.size()));
3576     if (entities->namedNode(GroveString(tem.data(), tem.size()), node) == accessOK
3577         && node->getExternalId(node) == accessOK
3578         && node->getPublicId(str) == accessOK)
3579       return new (interp) StringObj(str.data(), str.size());
3580   }
3581   return interp.makeFalse();
3582 }
3583
3584 DEFPRIMITIVE(EntityNotation, argc, argv, context, interp, loc)
3585 {
3586   const Char *s;
3587   size_t n;
3588   if (!argv[0]->stringData(s, n))
3589     return argError(interp, loc,
3590                     InterpreterMessages::notAString, 0, argv[0]);
3591   NodePtr node;
3592   if (argc > 1) {
3593     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3594       return argError(interp, loc,
3595                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3596   }
3597   else {
3598     node = context.currentNode;
3599     if (!node)
3600       return noCurrentNodeError(interp, loc);
3601   }
3602   GroveString str;
3603   NamedNodeListPtr entities;
3604   if (node->getGroveRoot(node) == accessOK
3605       && node->getEntities(entities) == accessOK
3606       && entities->namedNode(GroveString(s, n), node) == accessOK
3607       && node->getNotation(node) == accessOK
3608       && node->getName(str) == accessOK)
3609     return new (interp) StringObj(str.data(), str.size());
3610   return interp.makeFalse();
3611 }
3612
3613 DEFPRIMITIVE(EntityText, argc, argv, context, interp, loc)
3614 {
3615   const Char *s;
3616   size_t n;
3617   if (!argv[0]->stringData(s, n))
3618     return argError(interp, loc,
3619                     InterpreterMessages::notAString, 0, argv[0]);
3620   NodePtr node;
3621   if (argc > 1) {
3622     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3623       return argError(interp, loc,
3624                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3625   }
3626   else {
3627     node = context.currentNode;
3628     if (!node)
3629       return noCurrentNodeError(interp, loc);
3630   }
3631   GroveString str;
3632   NamedNodeListPtr entities;
3633   if (node->getGroveRoot(node) == accessOK
3634       && node->getEntities(entities) == accessOK
3635       && entities->namedNode(GroveString(s, n), node) == accessOK
3636       && node->getText(str) == accessOK)
3637     return new (interp) StringObj(str.data(), str.size());
3638   return interp.makeFalse();
3639 }
3640
3641 DEFPRIMITIVE(EntityType, argc, argv, context, interp, loc)
3642 {
3643   const Char *s;
3644   size_t n;
3645   if (!argv[0]->stringData(s, n))
3646     return argError(interp, loc,
3647                     InterpreterMessages::notAString, 0, argv[0]);
3648   NodePtr node;
3649   if (argc > 1) {
3650     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3651       return argError(interp, loc,
3652                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3653   }
3654   else {
3655     node = context.currentNode;
3656     if (!node)
3657       return noCurrentNodeError(interp, loc);
3658   }
3659   NamedNodeListPtr entities;
3660   Node::EntityType::Enum type;
3661   if (node->getGroveRoot(node) == accessOK
3662       && node->getEntities(entities) == accessOK
3663       && entities->namedNode(GroveString(s, n), node) == accessOK
3664       && node->getEntityType(type) == accessOK) {
3665     const char *s;
3666     switch (type) {
3667     case Node::EntityType::text:
3668       s = "text";
3669       break;
3670     case Node::EntityType::cdata:
3671       s = "cdata";
3672       break;
3673     case Node::EntityType::sdata:
3674       s = "sdata";
3675       break;
3676     case Node::EntityType::ndata:
3677       s = "ndata";
3678       break;
3679     case Node::EntityType::subdocument:
3680       s = "subdocument";
3681       break;
3682     case Node::EntityType::pi:
3683       s = "pi";
3684       break;
3685     default:
3686       CANNOT_HAPPEN();
3687     }
3688     return interp.makeSymbol(interp.makeStringC(s));
3689   }
3690   return interp.makeFalse();
3691 }
3692
3693 DEFPRIMITIVE(NotationSystemId, argc, argv, context, interp, loc)
3694 {
3695   const Char *s;
3696   size_t n;
3697   if (!argv[0]->stringData(s, n))
3698     return argError(interp, loc,
3699                     InterpreterMessages::notAString, 0, argv[0]);
3700   NodePtr node;
3701   if (argc > 1) {
3702     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3703       return argError(interp, loc,
3704                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3705   }
3706   else {
3707     node = context.currentNode;
3708     if (!node)
3709       return noCurrentNodeError(interp, loc);
3710   }
3711   GroveString str;
3712   NamedNodeListPtr notations;
3713   if (node->getGroveRoot(node) == accessOK
3714       && node->getGoverningDoctype(node) == accessOK
3715       && node->getNotations(notations) == accessOK
3716       && notations->namedNode(GroveString(s, n), node) == accessOK
3717       && node->getExternalId(node) == accessOK
3718       && node->getSystemId(str) == accessOK)
3719     return new (interp) StringObj(str.data(), str.size());
3720   return interp.makeFalse();
3721 }
3722
3723 DEFPRIMITIVE(NotationPublicId, argc, argv, context, interp, loc)
3724 {
3725   const Char *s;
3726   size_t n;
3727   if (!argv[0]->stringData(s, n))
3728     return argError(interp, loc,
3729                     InterpreterMessages::notAString, 0, argv[0]);
3730   NodePtr node;
3731   if (argc > 1) {
3732     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3733       return argError(interp, loc,
3734                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3735   }
3736   else {
3737     node = context.currentNode;
3738     if (!node)
3739       return noCurrentNodeError(interp, loc);
3740   }
3741   GroveString str;
3742   NamedNodeListPtr notations;
3743   if (node->getGroveRoot(node) == accessOK
3744       && node->getGoverningDoctype(node) == accessOK
3745       && node->getNotations(notations) == accessOK
3746       && notations->namedNode(GroveString(s, n), node) == accessOK
3747       && node->getExternalId(node) == accessOK
3748       && node->getPublicId(str) == accessOK)
3749     return new (interp) StringObj(str.data(), str.size());
3750   return interp.makeFalse();
3751 }
3752
3753 DEFPRIMITIVE(NotationGeneratedSystemId, argc, argv, context, interp, loc)
3754 {
3755   const Char *s;
3756   size_t n;
3757   if (!argv[0]->stringData(s, n))
3758     return argError(interp, loc,
3759                     InterpreterMessages::notAString, 0, argv[0]);
3760   NodePtr node;
3761   if (argc > 1) {
3762     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3763       return argError(interp, loc,
3764                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3765   }
3766   else {
3767     node = context.currentNode;
3768     if (!node)
3769       return noCurrentNodeError(interp, loc);
3770   }
3771   GroveString str;
3772   NamedNodeListPtr notations;
3773   if (node->getGroveRoot(node) == accessOK
3774       && node->getGoverningDoctype(node) == accessOK
3775       && node->getNotations(notations) == accessOK
3776       && notations->namedNode(GroveString(s, n), node) == accessOK
3777       && node->getExternalId(node) == accessOK
3778       && node->getGeneratedSystemId(str) == accessOK)
3779     return new (interp) StringObj(str.data(), str.size());
3780   return interp.makeFalse();
3781 }
3782
3783 DEFPRIMITIVE(GeneralNameNormalize, argc, argv, context, interp, loc)
3784 {
3785   NodePtr node;
3786   if (argc > 1) {
3787     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3788       return argError(interp, loc,
3789                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3790   }
3791   else {
3792     node = context.currentNode;
3793     if (!node)
3794       return noCurrentNodeError(interp, loc);
3795   }
3796   StringC result;
3797   if (!convertGeneralName(argv[0], node, result))
3798     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3799   return new (interp) StringObj(result);
3800 }
3801
3802 DEFPRIMITIVE(EntityNameNormalize, argc, argv, context, interp, loc)
3803 {
3804   const Char *s;
3805   size_t n;
3806   if (!argv[0]->stringData(s, n))
3807     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3808   NodePtr node;
3809   if (argc > 1) {
3810     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3811       return argError(interp, loc,
3812                       InterpreterMessages::notASingletonNode, 1, argv[1]);
3813   }
3814   else {
3815     node = context.currentNode;
3816     if (!node)
3817       return noCurrentNodeError(interp, loc);
3818   }
3819   StringC result(s, n);
3820
3821   node->getGroveRoot(node);
3822   NamedNodeListPtr entities;
3823   node->getEntities(entities);
3824   result.resize(entities->normalize(result.begin(), result.size()));
3825   return new (interp) StringObj(result);
3826 }
3827
3828 DEFPRIMITIVE(NodeListFirst, argc, argv, context, interp, loc)
3829 {
3830   NodeListObj *nl = argv[0]->asNodeList();
3831   if (!nl)
3832     return argError(interp, loc,
3833                     InterpreterMessages::notANodeList, 0, argv[0]);
3834   NodePtr nd = nl->nodeListFirst(context, interp);
3835   return new (interp) NodePtrNodeListObj(nd);
3836 }
3837
3838 DEFPRIMITIVE(NodeListRest, argc, argv, context, interp, loc)
3839 {
3840   NodeListObj *nl = argv[0]->asNodeList();
3841   if (!nl)
3842     return argError(interp, loc,
3843                     InterpreterMessages::notANodeList, 0, argv[0]);
3844   return nl->nodeListRest(context, interp);
3845 }
3846
3847 DEFPRIMITIVE(NodeList, argc, argv, context, interp, loc)
3848 {
3849   if (argc == 0)
3850     return interp.makeEmptyNodeList();
3851   int i = argc - 1;
3852   NodeListObj *nl = argv[i]->asNodeList();
3853   if (!nl)
3854     return argError(interp, loc,
3855                     InterpreterMessages::notANodeList, i, argv[i]);
3856   if (i > 0) {
3857     ELObjDynamicRoot protect(interp, nl);
3858     for (;;) {
3859       i--;
3860       NodeListObj *tem = argv[i]->asNodeList();
3861       if (!tem)
3862         return argError(interp, loc,
3863                         InterpreterMessages::notANodeList, i, argv[i]);
3864       nl = new (interp) PairNodeListObj(tem, nl);
3865       if (i == 0)
3866         break;
3867       protect = nl;
3868     }
3869   }
3870   return nl;
3871 }
3872
3873 DEFPRIMITIVE(NodeListNoOrder, argc, argv, context, interp, loc)
3874 {
3875   NodeListObj *nl = argv[0]->asNodeList();
3876   if (!nl)
3877     return argError(interp, loc,
3878                     InterpreterMessages::notANodeList, 0, argv[0]);
3879   return nl->nodeListNoOrder(interp);
3880 }
3881
3882 DEFPRIMITIVE(IsNodeListEqual, argc, argv, context, interp, loc)
3883 {
3884   NodeListObj *nl1 = argv[0]->asNodeList();
3885   if (!nl1)
3886     return argError(interp, loc,
3887                     InterpreterMessages::notANodeList, 0, argv[0]);
3888   if (nl1 == argv[1])
3889     return interp.makeTrue();
3890   NodeListObj *nl2 = argv[1]->asNodeList();
3891   if (!nl2)
3892     return argError(interp, loc,
3893                     InterpreterMessages::notANodeList, 1, argv[1]);
3894   ELObjDynamicRoot protect1(interp, nl1);
3895   ELObjDynamicRoot protect2(interp, nl2);
3896   for (;;) {
3897     NodePtr nd1 = nl1->nodeListFirst(context, interp);
3898     NodePtr nd2 = nl2->nodeListFirst(context, interp);
3899     if (!nd1) {
3900       if (nd2)
3901         return interp.makeFalse();
3902       else
3903         break;
3904     }
3905     else if (!nd2)
3906       return interp.makeFalse();
3907     else if (*nd1 != *nd2)
3908       return interp.makeFalse();
3909     nl1 = nl1->nodeListRest(context, interp);
3910     protect1 = nl1;
3911     nl2 = nl2->nodeListRest(context, interp);
3912     protect2 = nl2;
3913   }
3914   return interp.makeTrue();
3915 }
3916
3917 DEFPRIMITIVE(IsNamedNodeList, argc, argv, context, interp, loc)
3918 {
3919   if (argv[0]->asNamedNodeList())
3920     return interp.makeTrue();
3921   else
3922     return interp.makeFalse();
3923 }
3924
3925 DEFPRIMITIVE(NamedNode, argc, argv, context, interp, loc)
3926 {
3927   const Char *s;
3928   size_t n;
3929   if (!argv[0]->stringData(s, n))
3930     return argError(interp, loc,
3931                     InterpreterMessages::notAString, 0, argv[0]);
3932   NamedNodeListObj *nnl = argv[1]->asNamedNodeList();
3933   if (!nnl)
3934     return argError(interp, loc,
3935                     InterpreterMessages::notANamedNodeList, 1, argv[1]);
3936   return new (interp) NodePtrNodeListObj(nnl->namedNode(s, n));
3937 }
3938
3939 DEFPRIMITIVE(NamedNodeListNormalize, argc, argv, context, interp, loc)
3940 {
3941   const Char *s;
3942   size_t n;
3943   if (!argv[0]->stringData(s, n))
3944     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3945   NamedNodeListObj *nnl = argv[1]->asNamedNodeList();
3946   if (!nnl)
3947     return argError(interp, loc,
3948                     InterpreterMessages::notANamedNodeList, 1, argv[1]);
3949   if (!argv[2]->asSymbol())
3950     return argError(interp, loc,
3951                     InterpreterMessages::notASymbol, 2, argv[2]);
3952   StringC result(s, n);
3953   result.resize(nnl->normalize(result.begin(), result.size()));
3954   return new (interp) StringObj(result);
3955 }
3956
3957 DEFPRIMITIVE(NamedNodeListNames, argc, argv, context, interp, loc)
3958 {
3959   NamedNodeListObj *nnl = argv[0]->asNamedNodeList();
3960   if (!nnl)
3961     return argError(interp, loc,
3962                     InterpreterMessages::notANamedNodeList, 0, argv[0]);
3963   NodeListObj *nl = nnl;
3964   PairObj *tail = interp.makePair(0, 0);
3965   PairObj *head = tail;
3966   ELObjDynamicRoot protect(interp, head);
3967   for (;;) {
3968     ELObjDynamicRoot protect(interp, nl);
3969     NodePtr nd = nl->nodeListFirst(context, interp);
3970     if (!nd)
3971       break;
3972     GroveString str;
3973     if (nnl->nodeName(nd, str)) {
3974       // protect the StringObj by putting in the head's car
3975       head->setCar(new (interp) StringObj(str.data(), str.size()));
3976       PairObj *newTail = new (interp) PairObj(head->car(), 0);
3977       tail->setCdr(newTail);
3978       tail = newTail;
3979     }
3980     nl = nl->nodeListRest(context, interp);
3981   }
3982   tail->setCdr(interp.makeNil());
3983   return head->cdr();
3984 }
3985
3986 DEFPRIMITIVE(Children, argc, argv, context, interp, loc)
3987 {
3988   NodePtr node;
3989   if (!argv[0]->optSingletonNodeList(context, interp, node)) {
3990     NodeListObj *nl = argv[0]->asNodeList();
3991     if (nl)
3992       return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
3993     return argError(interp, loc,
3994                     InterpreterMessages::notANodeList, 0, argv[0]);
3995   }
3996   if (!node)
3997     return argv[0];
3998   NodeListPtr nl;
3999   if (node->children(nl) != accessOK)
4000     return interp.makeEmptyNodeList();
4001   return new (interp) NodeListPtrNodeListObj(nl);
4002 }
4003
4004 DEFPRIMITIVE(Follow, argc, argv, context, interp, loc)
4005 {
4006   NodePtr node;
4007   if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4008     NodeListObj *nl = argv[0]->asNodeList();
4009     if (nl)
4010       return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4011     return argError(interp, loc,
4012                     InterpreterMessages::notANodeList, 0, argv[0]);
4013   }
4014   if (!node)
4015     return argv[0];
4016   NodeListPtr nl;
4017   if (node->follow(nl) != accessOK)
4018     return interp.makeEmptyNodeList();
4019   return new (interp) NodeListPtrNodeListObj(nl);
4020 }
4021
4022 DEFPRIMITIVE(Descendants, argc, argv, context, interp, loc)
4023 {
4024   NodePtr node;
4025   if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4026     NodeListObj *nl = argv[0]->asNodeList();
4027     if (nl)
4028       return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4029     return argError(interp, loc,
4030                     InterpreterMessages::notANodeList, 0, argv[0]);
4031   }
4032   return new (interp) DescendantsNodeListObj(node);
4033 }
4034
4035 DEFPRIMITIVE(Preced, argc, argv, context, interp, loc)
4036 {
4037   NodePtr node;
4038   if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4039     NodeListObj *nl = argv[0]->asNodeList();
4040     if (nl)
4041       return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4042     return argError(interp, loc,
4043                     InterpreterMessages::notANodeList, 0, argv[0]);
4044   }
4045   NodePtr first;
4046   if (!node || node->firstSibling(first) != accessOK)
4047     return interp.makeEmptyNodeList();
4048   return new (interp) SiblingNodeListObj(first, node);
4049 }
4050
4051 DEFPRIMITIVE(Attributes, argc, argv, context, interp, loc)
4052 {
4053   NodePtr node;
4054   if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4055     NodeListObj *nl = argv[0]->asNodeList();
4056     if (nl)
4057       return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4058     return argError(interp, loc,
4059                     InterpreterMessages::notANodeList, 0, argv[0]);
4060   }
4061   if (!node)
4062     return argv[0];
4063   NamedNodeListPtr nnl;
4064   if (node->getAttributes(nnl) != accessOK)
4065     return interp.makeEmptyNodeList();
4066   return new (interp) NamedNodeListPtrNodeListObj(nnl);
4067 }
4068
4069 static
4070 void nodeData(const NodePtr &nd, const SdataMapper &mapper, bool chunk, StringC &s)
4071 {
4072   GroveString tem;
4073   if (nd->charChunk(mapper, tem) == accessOK) {
4074     s.append(tem.data(), chunk ? tem.size() : 1);
4075     return;
4076   }
4077   if (nd->tokens(tem) == accessOK) {
4078     s.append(tem.data(), tem.size());
4079     return;
4080   }
4081   NodePtr cnd;
4082   if (nd->firstChild(cnd) == accessOK) {
4083     do {
4084       nodeData(cnd, mapper, 1, s);
4085     } while (cnd.assignNextChunkSibling() == accessOK);
4086     return;
4087   }
4088   // This happens if the data procedure is called on an AVT node
4089   if (nd->getToken(tem) == accessOK)
4090     s.append(tem.data(), tem.size());
4091 }
4092
4093 DEFPRIMITIVE(Data, argc, argv, context, interp, loc)
4094 {
4095   NodeListObj *nl = argv[0]->asNodeList();
4096   if (!nl)
4097     return argError(interp, loc,
4098                     InterpreterMessages::notANodeList, 0, argv[0]);
4099   StringObj *s = new (interp) StringObj;
4100   ELObjDynamicRoot protect(interp, s);
4101   for (;;) {
4102     ELObjDynamicRoot protect(interp, nl);
4103     NodePtr nd = nl->nodeListFirst(context, interp);
4104     if (!nd)
4105       break;
4106     bool chunk;
4107     nl = nl->nodeListChunkRest(context, interp, chunk);
4108     nodeData(nd, interp, chunk, *s);
4109   }
4110   return s;
4111 }
4112
4113 DEFPRIMITIVE(ElementWithId, argc, argv, context, interp, loc)
4114 {
4115   const Char *s;
4116   size_t n;
4117   if (!argv[0]->stringData(s, n))
4118     return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
4119   NodePtr node;
4120   if (argc > 1) {
4121     if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
4122       return argError(interp, loc,
4123                       InterpreterMessages::notASingletonNode, 1, argv[1]);
4124   }
4125   else {
4126     node = context.currentNode;
4127     if (!node)
4128       return noCurrentNodeError(interp, loc);
4129   }
4130   NamedNodeListPtr elements;
4131   if (node->getGroveRoot(node) == accessOK
4132       && node->getElements(elements) == accessOK
4133       && elements->namedNode(GroveString(s, n), node) == accessOK)
4134     return new (interp) NodePtrNodeListObj(node);
4135   return interp.makeEmptyNodeList();
4136 }
4137
4138 DEFPRIMITIVE(EmptyNodeList, argc, argv, context, interp, loc)
4139 {
4140   return interp.makeEmptyNodeList();
4141 }
4142
4143 static
4144 bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
4145                    int nKeys, Interpreter &interp, const Location &loc, int *pos)
4146 {
4147   if ((argc & 1) == 1) {
4148     interp.setNextLocation(loc);
4149     interp.message(InterpreterMessages::oddKeyArgs);
4150     return 0;
4151   }
4152   for (int i = 0; i < nKeys; i++)
4153     pos[i] = -1;
4154   // First has priority, so scan in reverse order
4155   for (int i = argc - 1; i > 0; i -= 2) {
4156     KeywordObj *keyObj = argv[i - 1]->asKeyword();
4157     if (!keyObj) {
4158       interp.setNextLocation(loc);
4159       interp.message(InterpreterMessages::keyArgsNotKey);
4160       return 0;
4161     }
4162     bool found = 0;
4163     Identifier::SyntacticKey key;
4164     if (keyObj->identifier()->syntacticKey(key)) {
4165       for (int j = 0; j < nKeys; j++) {
4166         if (key == keys[j]) {
4167           pos[j] = i;
4168           found = 1;
4169         }
4170       }
4171     }
4172     if (!found) {
4173       interp.setNextLocation(loc);
4174       interp.message(InterpreterMessages::invalidKeyArg,
4175                      StringMessageArg(keyObj->identifier()->name()));
4176       return 0;
4177     }
4178   }
4179   return 1;
4180 }
4181
4182 DEFPRIMITIVE(NodeProperty, argc, argv, context, interp, loc)
4183 {
4184   StringObj *str = argv[0]->convertToString();
4185   if (!str)
4186     return argError(interp, loc,
4187                     InterpreterMessages::notAStringOrSymbol, 0, argv[0]);
4188   NodePtr node;
4189   if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
4190     return argError(interp, loc,
4191                     InterpreterMessages::notASingletonNode, 1, argv[1]);
4192   static const Identifier::SyntacticKey keys[3] = {
4193     Identifier::keyDefault, Identifier::keyNull, Identifier::keyIsRcs
4194   };
4195   int pos[3];
4196   if (!decodeKeyArgs(argc - 2, argv + 2, keys, 3, interp, loc, pos))
4197     return interp.makeError();
4198   //FIXME: this is just a hack to fix the single duplicate rcsname 'tokens';
4199   //       should really be handled in Interpreter.
4200   StringC propname;
4201   ComponentName::Id cls;
4202   ComponentName::Id id = ComponentName::noId;
4203   if (*str == "tokens"
4204       && node->getClassName(cls) == accessOK
4205       && cls == ComponentName::idModelGroup)
4206     id = ComponentName::idContentTokens;
4207   else
4208     interp.lookupNodeProperty(*str, id);
4209   if (id != ComponentName::noId) {
4210     ELObjPropertyValue value(interp,
4211                              pos[2] >= 0
4212                              && argv[pos[2] + 2] != interp.makeFalse());
4213     AccessResult ret = node->property(id, interp, value);
4214     if (ret == accessOK)
4215       return value.obj;
4216     if (ret == accessNull && pos[1] >= 0)
4217       return argv[pos[1] + 2];
4218   }
4219   if (pos[0] < 0) {
4220     interp.setNextLocation(loc);
4221     interp.message(InterpreterMessages::noNodePropertyValue,
4222                    StringMessageArg(*str));
4223     return interp.makeError();
4224   }
4225   return argv[pos[0] + 2];
4226 }
4227
4228 DEFPRIMITIVE(SelectByClass, argc, argv, context, interp, loc)
4229 {
4230   NodeListObj *nl = argv[0]->asNodeList();
4231   if (!nl)
4232     return argError(interp, loc,
4233                     InterpreterMessages::notANodeList, 0, argv[0]);
4234   StringObj *str = argv[1]->convertToString();
4235   if (!str)
4236     return argError(interp, loc,
4237                     InterpreterMessages::notAStringOrSymbol, 1, argv[1]);
4238   ComponentName::Id id;
4239   if (!interp.lookupNodeProperty(*str, id))
4240     return interp.makeEmptyNodeList();
4241   return new (interp) SelectByClassNodeListObj(nl, id);
4242 }
4243
4244 DEFPRIMITIVE(NodeListMap, argc, argv, context, interp, loc)
4245 {
4246   FunctionObj *func = argv[0]->asFunction();
4247   if (!func)
4248     return argError(interp, loc,
4249                     InterpreterMessages::notAProcedure, 0, argv[0]);
4250   if (func->nRequiredArgs() > 1) {
4251     interp.setNextLocation(loc);
4252     // FIXME
4253     interp.message(InterpreterMessages::missingArg);
4254     return interp.makeError();
4255   }
4256   if (func->nRequiredArgs() + func->nOptionalArgs() + func->restArg() == 0) {
4257     interp.setNextLocation(loc);
4258     // FIXME
4259     interp.message(InterpreterMessages::tooManyArgs);
4260     return interp.makeError();
4261   }
4262   interp.makeReadOnly(func);
4263   NodeListObj *nl = argv[1]->asNodeList();
4264   if (!nl)
4265     return argError(interp, loc,
4266                     InterpreterMessages::notANodeList, 1, argv[1]);
4267   return new (interp) MapNodeListObj(func, nl, new MapNodeListObj::Context(context, loc));
4268 }
4269
4270 DEFPRIMITIVE(NodeListRef, argc, argv, context, interp, loc)
4271 {
4272   NodeListObj *nl = argv[0]->asNodeList();
4273   if (!nl)
4274     return argError(interp, loc,
4275                     InterpreterMessages::notANodeList, 0, argv[0]);
4276   long k;
4277   if (!argv[1]->exactIntegerValue(k))
4278     return argError(interp, loc,
4279                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
4280   // Must use temporary variable, because operator new may bew called before nodeListRef.
4281   NodePtr nd(nl->nodeListRef(k, context, interp));
4282   return new (interp) NodePtrNodeListObj(nd);
4283 }
4284
4285 DEFPRIMITIVE(NodeListReverse, argc, argv, context, interp, loc)
4286 {
4287   NodeListObj *nl = argv[0]->asNodeList();
4288   if (!nl)
4289     return argError(interp, loc,
4290                     InterpreterMessages::notANodeList, 0, argv[0]);
4291   return nl->nodeListReverse(context, interp);
4292 }
4293
4294 DEFPRIMITIVE(NodeListLength, argc, argv, context, interp, loc)
4295 {
4296   NodeListObj *nl = argv[0]->asNodeList();
4297   if (!nl)
4298     return argError(interp, loc,
4299                     InterpreterMessages::notANodeList, 0, argv[0]);
4300   return interp.makeInteger(nl->nodeListLength(context, interp));
4301 }
4302
4303 DEFPRIMITIVE(SgmlParse, argc, argv, context, interp, loc)
4304 {
4305   const Char *s;
4306   size_t n;
4307   if (!argv[0]->stringData(s, n))
4308     return argError(interp, loc,
4309                     InterpreterMessages::notAString, 0, argv[0]);
4310   StringC sysid(s, n);
4311   static const Identifier::SyntacticKey keys[2] = {
4312       Identifier::keyActive, Identifier::keyParent
4313   };
4314   int pos[2];
4315   if (!decodeKeyArgs(argc - 1, argv + 1, keys, 2, interp, loc, pos))
4316     return interp.makeError();
4317   Vector<StringC> lists[2];
4318   if (pos[0] >= 0) {
4319     ELObj *obj = argv[pos[0] + 1];
4320     while (!obj->isNil()) {
4321       PairObj *pair = obj->asPair();
4322       if (!pair)
4323         return argError(interp, loc,
4324                         InterpreterMessages::notAList, pos[0] + 1, argv[pos[0] + 1]);
4325       if (!pair->car()->stringData(s, n))
4326         return argError(interp, loc,
4327                         InterpreterMessages::notAString, pos[0] + 1, pair->car());
4328       lists[0].resize(lists[0].size() + 1);
4329       lists[0].back().assign(s, n);
4330       obj = pair->cdr();
4331     }
4332   }
4333
4334   NodePtr parent;
4335   if (pos[1] >= 0) {
4336     if (!argv[pos[1] + 1]->optSingletonNodeList(context, interp, parent) || !parent)
4337       return argError(interp, loc,
4338                       InterpreterMessages::notASingletonNode, pos[1] + 1, argv[pos[1] + 1]);
4339   }
4340
4341   NodePtr nd;
4342   if (!interp.groveManager()->load(sysid, lists[0], parent, nd, lists[1]))
4343     return interp.makeEmptyNodeList();
4344   return new (interp) NodePtrNodeListObj(nd);
4345 }
4346
4347 DEFPRIMITIVE(XSgmlParse, argc, argv, context, interp, loc)
4348 {
4349   const Char *s;
4350   size_t n;
4351   if (!argv[0]->stringData(s, n))
4352     return argError(interp, loc,
4353                     InterpreterMessages::notAString, 0, argv[0]);
4354   StringC sysid(s, n);
4355   static const Identifier::SyntacticKey keys[3] = {
4356       Identifier::keyActive, Identifier::keyArchitecture, Identifier::keyParent
4357   };
4358   int pos[3];
4359   if (!decodeKeyArgs(argc - 1, argv + 1, keys, 3, interp, loc, pos))
4360     return interp.makeError();
4361   Vector<StringC> lists[2];
4362   for (int i = 0; i < 3; i++) {
4363     if (pos[i] >= 0) {
4364       ELObj *obj = argv[pos[0] + 1];
4365       while (!obj->isNil()) {
4366         PairObj *pair = obj->asPair();
4367         if (!pair)
4368           return argError(interp, loc,
4369                           InterpreterMessages::notAList, pos[i] + 1, argv[pos[i] + 1]);
4370         if (!pair->car()->stringData(s, n))
4371           return argError(interp, loc,
4372                           InterpreterMessages::notAString, pos[i] + 1, pair->car());
4373         lists[i].resize(lists[i].size() + 1);
4374         lists[i].back().assign(s, n);
4375         obj = pair->cdr();
4376       }
4377     }
4378   }
4379
4380   NodePtr parent;
4381   if (pos[2] >= 0) {
4382     if (!argv[pos[2] + 1]->optSingletonNodeList(context, interp, parent) || !parent)
4383       return argError(interp, loc,
4384                       InterpreterMessages::notASingletonNode, pos[2] + 1, argv[pos[2] + 1]);
4385   }
4386
4387   NodePtr nd;
4388   if (!interp.groveManager()->load(sysid, lists[0], parent, nd, lists[1]))
4389     return interp.makeEmptyNodeList();
4390   return new (interp) NodePtrNodeListObj(nd);
4391 }
4392
4393 DEFPRIMITIVE(ReadEntity, argc, argv, context, interp, loc)
4394 {
4395   const Char *s;
4396   size_t n;
4397   if (!argv[0]->stringData(s, n))
4398     return argError(interp, loc,
4399                     InterpreterMessages::notAString, 0, argv[0]);
4400   StringC sysid(s, n);
4401   StringObj *contents = new (interp) StringObj;
4402   if (interp.groveManager()->readEntity(sysid, *contents))
4403     return contents;
4404   return interp.makeError();
4405 }
4406
4407 DEFPRIMITIVE(Debug, argc, argv, context, interp, loc)
4408 {
4409   interp.setNextLocation(loc);
4410   interp.message(InterpreterMessages::debug, ELObjMessageArg(argv[0], interp));
4411   return argv[0];
4412 }
4413
4414 DEFPRIMITIVE(IfFirstPage, argc, argv, context, interp, loc)
4415 {
4416   SosofoObj *sosofo[2];
4417   for (int i = 0; i < 2; i++) {
4418     sosofo[i] = argv[i]->asSosofo();
4419     if (!sosofo[i])
4420       return argError(interp, loc, InterpreterMessages::notASosofo,
4421                       i, argv[i]);
4422   }
4423   return new (interp) PageTypeSosofoObj(FOTBuilder::firstHF, sosofo[0], sosofo[1]);
4424 }
4425
4426 DEFPRIMITIVE(IfFrontPage, argc, argv, context, interp, loc)
4427 {
4428   SosofoObj *sosofo[2];
4429   for (int i = 0; i < 2; i++) {
4430     sosofo[i] = argv[i]->asSosofo();
4431     if (!sosofo[i])
4432       return argError(interp, loc, InterpreterMessages::notASosofo,
4433                       i, argv[i]);
4434   }
4435   return new (interp) PageTypeSosofoObj(FOTBuilder::frontHF, sosofo[0], sosofo[1]);
4436 }
4437
4438 DEFPRIMITIVE(AllElementNumber, argc, argv, context, interp, loc)
4439 {
4440   NodePtr node;
4441   if (argc > 0) {
4442     if (!argv[0]->optSingletonNodeList(context, interp, node))
4443       return argError(interp, loc,
4444                       InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
4445   }
4446   else {
4447     if (!context.currentNode)
4448       return noCurrentNodeError(interp, loc);
4449     node = context.currentNode;
4450   }
4451   unsigned long n;
4452   if (node && node->elementIndex(n) == accessOK)
4453     return interp.makeInteger(long(n) + 1);
4454   else
4455     return interp.makeFalse();
4456 }
4457
4458 DEFPRIMITIVE(IsVector, argc, argv, context, interp, loc)
4459 {
4460   if (argv[0]->asVector())
4461     return interp.makeTrue();
4462   else
4463     return interp.makeFalse();
4464 }
4465
4466 DEFPRIMITIVE(Vector, argc, argv, context, interp, loc)
4467 {
4468   Vector<ELObj *> v(argc);
4469   for (size_t i = 0; i < argc; i++)
4470     v[i] = argv[i];
4471   return new (interp) VectorObj(v);
4472 }
4473
4474 DEFPRIMITIVE(MakeVector, argc, argv, context, interp, loc)
4475 {
4476   long k;
4477   if (!argv[0]->exactIntegerValue(k))
4478     return argError(interp, loc,
4479                     InterpreterMessages::notAnExactInteger, 0, argv[0]);
4480   if (k < 0) {
4481     interp.setNextLocation(loc);
4482     interp.message(InterpreterMessages::outOfRange);
4483     return interp.makeError();
4484   }
4485   ELObj *fill = argc > 1 ? argv[1] : interp.makeUnspecified();
4486   Vector<ELObj *> v((size_t)k);
4487   for (size_t i = 0; i < v.size(); i++)
4488     v[i] = fill;
4489   return new (interp) VectorObj(v);
4490 }
4491
4492 DEFPRIMITIVE(VectorSet, argc, argv, context, interp, loc)
4493 {
4494   VectorObj *v = argv[0]->asVector();
4495   if (!v)
4496     return argError(interp, loc,
4497                     InterpreterMessages::notAVector, 0, argv[0]);
4498   long k;
4499   if (!argv[1]->exactIntegerValue(k))
4500     return argError(interp, loc,
4501                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
4502   if (k < 0 || (unsigned long)k >= v->size()) {
4503     interp.setNextLocation(loc);
4504     interp.message(InterpreterMessages::outOfRange);
4505     return interp.makeError();
4506   }
4507   if (v->readOnly()) {
4508     interp.setNextLocation(loc);
4509     interp.message(InterpreterMessages::readOnly);
4510     return interp.makeError();
4511   }
4512   (*v)[k] = argv[2];
4513   return interp.makeUnspecified();
4514 }
4515
4516 DEFPRIMITIVE(VectorRef, argc, argv, context, interp, loc)
4517 {
4518   VectorObj *v = argv[0]->asVector();
4519   if (!v)
4520     return argError(interp, loc,
4521                     InterpreterMessages::notAVector, 0, argv[0]);
4522   long k;
4523   if (!argv[1]->exactIntegerValue(k))
4524     return argError(interp, loc,
4525                     InterpreterMessages::notAnExactInteger, 1, argv[1]);
4526   if (k < 0 || (unsigned long)k >= v->size()) {
4527     interp.setNextLocation(loc);
4528     interp.message(InterpreterMessages::outOfRange);
4529     return interp.makeError();
4530   }
4531   return (*v)[k];
4532 }
4533
4534 DEFPRIMITIVE(VectorToList, argc, argv, context, interp, loc)
4535 {
4536   VectorObj *v = argv[0]->asVector();
4537   if (!v)
4538     return argError(interp, loc,
4539                     InterpreterMessages::notAVector, 0, argv[0]);
4540   Vector<ELObj *> &vec = *v;
4541   ELObjDynamicRoot result(interp, interp.makeNil());
4542   for (size_t i = vec.size(); i > 0; i--)
4543     result = new (interp) PairObj(vec[i - 1], result);
4544   return result;
4545 }
4546
4547 DEFPRIMITIVE(ListToVector, argc, argv, context, interp, loc)
4548 {
4549   Vector<ELObj *> v;
4550   ELObj *obj = argv[0];
4551   while (!obj->isNil()) {
4552     PairObj *pair = obj->asPair();
4553     if (!pair)
4554       return argError(interp, loc, InterpreterMessages::notAList, 0, obj);
4555     v.push_back(pair->car());
4556     obj = pair->cdr();
4557   }
4558   return new (interp) VectorObj(v);
4559 }
4560
4561 DEFPRIMITIVE(VectorFill, argc, argv, context, interp, loc)
4562 {
4563   VectorObj *v = argv[0]->asVector();
4564   if (!v)
4565     return argError(interp, loc,
4566                     InterpreterMessages::notAVector, 0, argv[0]);
4567   if (v->readOnly()) {
4568     interp.setNextLocation(loc);
4569     interp.message(InterpreterMessages::readOnly);
4570     return interp.makeError();
4571   }
4572   Vector<ELObj *> &vec = *v;
4573   for (size_t i = 0; i < vec.size(); i++)
4574     vec[i] = argv[1];
4575   return interp.makeUnspecified();
4576 }
4577
4578 DEFPRIMITIVE(Language, argc, argv, context, interp, loc)
4579 {
4580   StringObj *lang = argv[0]->convertToString();
4581   if (!lang)
4582     return argError(interp, loc,
4583                     InterpreterMessages::notAStringOrSymbol, 0, argv[0]);
4584   StringObj *country = argv[1]->convertToString();
4585   if (!country)
4586     return argError(interp, loc,
4587                     InterpreterMessages::notAStringOrSymbol, 1, argv[1]);
4588 #ifdef SP_HAVE_LOCALE
4589 #ifdef SP_HAVE_WCHAR
4590   if (RefLangObj::supportedLanguage(*lang, *country))
4591     return new (interp) RefLangObj (*lang, *country);
4592   else
4593 #endif
4594 #endif
4595     return interp.makeFalse();
4596 }
4597
4598 DEFPRIMITIVE(IsLanguage, argc, argv, context, interp, loc)
4599 {
4600   if (argv[0]->asLanguage())
4601     return interp.makeTrue();
4602   else
4603     return interp.makeFalse();
4604 }
4605
4606 DEFPRIMITIVE(CurrentLanguage, argc, argv, context, interp, loc)
4607 {
4608   if (context.currentLanguage)
4609     return context.currentLanguage;
4610   else
4611     return interp.defaultLanguage();
4612 }
4613
4614 DEFPRIMITIVE(WithLanguage, argc, argv, context, interp, loc)
4615 {
4616   // Check that argv[0] is a language
4617   LanguageObj *lang = argv[0]->asLanguage();
4618   if (!lang)
4619     return argError(interp, loc,
4620                     InterpreterMessages::notALanguage, 0, argv[0]);
4621   // Check that argv[1] is a thunk
4622   FunctionObj *func = argv[1]->asFunction();
4623   if (!func)
4624     return argError(interp, loc,
4625                     InterpreterMessages::notAProcedure, 1, argv[1]);
4626   if (func->totalArgs() > 0) {
4627     interp.message(InterpreterMessages::tooManyArgs);
4628     return interp.makeError();
4629   }
4630   LanguageObj *savedLanguage = context.currentLanguage;
4631   context.currentLanguage = lang;
4632   VM vm(context, interp);
4633   InsnPtr insn(func->makeCallInsn(0, interp, loc, InsnPtr()));
4634   ELObj *ret = vm.eval(insn.pointer());
4635   context.currentLanguage = savedLanguage;
4636   return ret;
4637 }
4638
4639 #define GETCURLANG(lang,context,interp) \
4640   const LanguageObj *lang; \
4641   if (context.currentLanguage != 0) \
4642     lang = context.currentLanguage; \
4643   else if (interp.defaultLanguage()->asLanguage() != 0) \
4644     lang = interp.defaultLanguage()->asLanguage(); \
4645   else { \
4646     interp.message(InterpreterMessages::noCurrentLanguage); \
4647     return interp.makeError(); \
4648   }
4649
4650 DEFPRIMITIVE(CharLess, argc, argv, context, interp, loc)
4651 {
4652   GETCURLANG(lang, context, interp);
4653   Char c[2];
4654   for (unsigned i = 0; i < 2; i++)
4655     if (!argv[i]->charValue(c[i]))
4656       return argError(interp, loc,
4657                       InterpreterMessages::notAChar, i, argv[i]);
4658   if (lang->isLess(StringC(c, 1), StringC(c + 1, 1)))
4659     return interp.makeTrue();
4660   else
4661     return interp.makeFalse();
4662 }
4663
4664 DEFPRIMITIVE(CharLessOrEqual, argc, argv, context, interp, loc)
4665 {
4666   GETCURLANG(lang, context, interp);
4667   Char c[2];
4668   for (unsigned i = 0; i < 2; i++)
4669     if (!argv[i]->charValue(c[i]))
4670       return argError(interp, loc,
4671                       InterpreterMessages::notAChar, i, argv[i]);
4672   if (lang->isLessOrEqual(StringC(c, 1), StringC(c + 1, 1)))
4673     return interp.makeTrue();
4674   else
4675     return interp.makeFalse();
4676 }
4677
4678 DEFPRIMITIVE(CharUpcase, argc, argv, context, interp, loc)
4679 {
4680   GETCURLANG(lang, context, interp);
4681   Char c;
4682   if (!argv[0]->charValue(c))
4683     return argError(interp, loc,
4684                     InterpreterMessages::notAChar, 0, argv[0]);
4685   return interp.makeChar(lang->toUpper(c));
4686 }
4687
4688 DEFPRIMITIVE(CharDowncase, argc, argv, context, interp, loc)
4689 {
4690   GETCURLANG(lang, context, interp);
4691   Char c;
4692   if (!argv[0]->charValue(c))
4693     return argError(interp, loc,
4694                     InterpreterMessages::notAChar, 0, argv[0]);
4695   return interp.makeChar(lang->toLower(c));
4696 }
4697
4698 DEFPRIMITIVE(StringEquiv, argc, argv, context, interp, loc)
4699 {
4700   GETCURLANG(lang, context, interp);
4701   const Char *s[2];
4702   size_t n[2];
4703   for (unsigned i = 0; i < 2; i++)
4704     if (!argv[i]->stringData(s[i], n[i]))
4705       return argError(interp, loc,
4706                       InterpreterMessages::notAString, i, argv[i]);
4707   long k = 0;
4708   if (!argv[2]->exactIntegerValue(k) || (k <= 0))
4709     return argError(interp, loc,
4710                     InterpreterMessages::notAPositiveInteger, 2, argv[2]);
4711   if (lang->areEquivalent(StringC(s[0], n[0]), StringC(s[1], n[1]), k))
4712     return interp.makeTrue();
4713   else
4714     return interp.makeFalse();
4715 }
4716
4717 DEFPRIMITIVE(StringLess, argc, argv, context, interp, loc)
4718 {
4719   GETCURLANG(lang, context, interp);
4720   const Char *s[2];
4721   size_t n[2];
4722   for (unsigned i = 0; i < 2; i++)
4723     if (!argv[i]->stringData(s[i], n[i]))
4724       return argError(interp, loc,
4725                       InterpreterMessages::notAString, i, argv[i]);
4726   if (lang->isLess(StringC(s[0], n[0]), StringC(s[1], n[1])))
4727     return interp.makeTrue();
4728   else
4729     return interp.makeFalse();
4730 }
4731
4732 DEFPRIMITIVE(StringLessOrEqual, argc, argv, context, interp, loc)
4733 {
4734   GETCURLANG(lang, context, interp);
4735   const Char *s[2];
4736   size_t n[2];
4737   for (unsigned i = 0; i < 2; i++)
4738     if (!argv[i]->stringData(s[i], n[i]))
4739       return argError(interp, loc,
4740                       InterpreterMessages::notAString, i, argv[i]);
4741   if (lang->isLessOrEqual(StringC(s[0], n[0]), StringC(s[1], n[1])))
4742     return interp.makeTrue();
4743   else
4744     return interp.makeFalse();
4745 }
4746
4747 DEFPRIMITIVE(Assoc, argc, argv, context, interp, loc)
4748 {
4749   ELObj *list = argv[1];
4750   for (;;) {
4751     PairObj *pair = list->asPair();
4752     if (pair) {
4753       PairObj *car = pair->car()->asPair();
4754       if (!car)
4755         return argError(interp, loc,
4756                         InterpreterMessages::notAnAlist, 1, argv[1]);
4757       if (ELObj::equal(*car->car(), *argv[0]))
4758         return car;
4759       list = pair->cdr();
4760     } else if (list->isNil())
4761       break;
4762     else
4763       return argError(interp, loc,
4764                       InterpreterMessages::notAList, 1, argv[1]);
4765   }
4766   return interp.makeFalse();
4767 }
4768
4769 DEFPRIMITIVE(KeywordToString, argc, argv, context, interp, loc)
4770 {
4771   KeywordObj *obj = argv[0]->asKeyword();
4772   if (!obj)
4773     return argError(interp, loc,
4774                     InterpreterMessages::notAKeyword, 0, argv[0]);
4775   return new (interp) StringObj(obj->identifier()->name());
4776 }
4777
4778 DEFPRIMITIVE(StringToKeyword, argc, argv, context, interp, loc)
4779 {
4780   const Char *s;
4781   size_t n;
4782   if (!argv[0]->stringData(s, n))
4783     return argError(interp, loc,
4784                     InterpreterMessages::notAString, 0, argv[0]);
4785   return interp.makeKeyword(StringC(s, n));
4786 }
4787
4788 DEFPRIMITIVE(IsExact, argc, argv, context, interp, loc)
4789 {
4790   long n;
4791   double d;
4792   int dim;
4793   switch (argv[0]->quantityValue(n, d, dim)) {
4794   case ELObj::noQuantity:
4795     return argError(interp, loc,
4796                     InterpreterMessages::notAQuantity, 0, argv[0]);
4797   case ELObj::doubleQuantity:
4798     return interp.makeFalse();
4799   case ELObj::longQuantity:
4800     return interp.makeTrue();
4801   default:
4802     CANNOT_HAPPEN();
4803   }
4804 }
4805
4806 DEFPRIMITIVE(IsInexact, argc, argv, context, interp, loc)
4807 {
4808   long n;
4809   double d;
4810   int dim;
4811   switch (argv[0]->quantityValue(n, d, dim)) {
4812   case ELObj::noQuantity:
4813     return argError(interp, loc,
4814                     InterpreterMessages::notAQuantity, 0, argv[0]);
4815   case ELObj::doubleQuantity:
4816     return interp.makeTrue();
4817   case ELObj::longQuantity:
4818     return interp.makeFalse();
4819   default:
4820     CANNOT_HAPPEN();
4821   }
4822 }
4823
4824 #define DEFNUMPRED(NAME, OP) \
4825 DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
4826 { \
4827   long n; \
4828   double d; \
4829   int dim; \
4830   switch (argv[0]->quantityValue(n, d, dim)) { \
4831   case ELObj::noQuantity: \
4832     return argError(interp, loc, \
4833                     InterpreterMessages::notAQuantity, 0, argv[0]); \
4834   case ELObj::doubleQuantity: \
4835     if (d OP 0.0) \
4836       return interp.makeTrue(); \
4837     else \
4838       return interp.makeFalse(); \
4839   case ELObj::longQuantity: \
4840     if (n OP 0) \
4841       return interp.makeTrue(); \
4842     else \
4843       return interp.makeFalse(); \
4844   default: \
4845     CANNOT_HAPPEN(); \
4846   } \
4847 }
4848
4849 DEFNUMPRED(IsZero, == )
4850 DEFNUMPRED(IsPositive, > )
4851 DEFNUMPRED(IsNegative, < )
4852
4853 DEFPRIMITIVE(IsOdd, argc, argv, context, interp, loc)
4854 {
4855   long n;
4856   double d;
4857   int dim;
4858   switch (argv[0]->quantityValue(n, d, dim)) {
4859   case ELObj::noQuantity:
4860   case ELObj::doubleQuantity:
4861     return argError(interp, loc,
4862                     InterpreterMessages::notAnInteger, 0, argv[0]);
4863   case ELObj::longQuantity:
4864     if (n % 2)
4865       return interp.makeTrue();
4866     else
4867       return interp.makeFalse();
4868   default:
4869     CANNOT_HAPPEN();
4870   }
4871 }
4872
4873 DEFPRIMITIVE(IsEven, argc, argv, context, interp, loc)
4874 {
4875   long n;
4876   double d;
4877   int dim;
4878   switch (argv[0]->quantityValue(n, d, dim)) {
4879   case ELObj::noQuantity:
4880   case ELObj::doubleQuantity:
4881     return argError(interp, loc,
4882                     InterpreterMessages::notAnInteger, 0, argv[0]);
4883   case ELObj::longQuantity:
4884     if (n % 2)
4885       return interp.makeFalse();
4886     else
4887       return interp.makeTrue();
4888   default:
4889     CANNOT_HAPPEN();
4890   }
4891 }
4892
4893 DEFPRIMITIVE(Exp, argc, argv, context, interp, loc)
4894 {
4895   double d;
4896   if (!argv[0]->realValue(d))
4897     return argError(interp, loc,
4898                     InterpreterMessages::notANumber, 0, argv[0]);
4899   return new (interp) RealObj(exp(d));
4900 }
4901
4902 DEFPRIMITIVE(Log, argc, argv, context, interp, loc)
4903 {
4904   double d;
4905   if (!argv[0]->realValue(d))
4906     return argError(interp, loc,
4907                     InterpreterMessages::notANumber, 0, argv[0]);
4908   if (d <= 0) {
4909     interp.setNextLocation(loc);
4910     interp.message(InterpreterMessages::outOfRange);
4911     return interp.makeError();
4912   }
4913   return new (interp) RealObj(log(d));
4914 }
4915
4916 DEFPRIMITIVE(Sin, argc, argv, context, interp, loc)
4917 {
4918   double d;
4919   if (!argv[0]->realValue(d))
4920   return argError(interp, loc,
4921                     InterpreterMessages::notANumber, 0, argv[0]);
4922   return new (interp) RealObj(sin(d));
4923 }
4924
4925 DEFPRIMITIVE(Cos, argc, argv, context, interp, loc)
4926 {
4927   double d;
4928   if (!argv[0]->realValue(d))
4929     return argError(interp, loc,
4930                     InterpreterMessages::notANumber, 0, argv[0]);
4931   return new (interp) RealObj(cos(d));
4932 }
4933
4934 DEFPRIMITIVE(Tan, argc, argv, context, interp, loc)
4935 {
4936   double d;
4937   if (!argv[0]->realValue(d))
4938     return argError(interp, loc,
4939                     InterpreterMessages::notANumber, 0, argv[0]);
4940   return new (interp) RealObj(tan(d));
4941 }
4942
4943 DEFPRIMITIVE(Asin, argc, argv, context, interp, loc)
4944 {
4945   double d;
4946   if (!argv[0]->realValue(d))
4947     return argError(interp, loc,
4948                     InterpreterMessages::notANumber, 0, argv[0]);
4949   if (d < -1 || d > 1) {
4950     interp.setNextLocation(loc);
4951     interp.message(InterpreterMessages::outOfRange);
4952     return interp.makeError();
4953   }
4954   return new (interp) RealObj(asin(d));
4955 }
4956
4957 DEFPRIMITIVE(Acos, argc, argv, context, interp, loc)
4958 {
4959   double d;
4960   if (!argv[0]->realValue(d))
4961     return argError(interp, loc,
4962                     InterpreterMessages::notANumber, 0, argv[0]);
4963   if (d < -1 || d > 1) {
4964     interp.setNextLocation(loc);
4965     interp.message(InterpreterMessages::outOfRange);
4966     return interp.makeError();
4967    }
4968   return new (interp) RealObj(acos(d));
4969 }
4970
4971 DEFPRIMITIVE(Atan, argc, argv, context, interp, loc)
4972 {
4973   long lResult;
4974   double dResult;
4975   int dim;
4976   ELObj::QuantityType type =
4977     argv[0]->quantityValue(lResult, dResult, dim);
4978
4979   if (argc == 1) {
4980     if (type == ELObj::noQuantity || dim != 0)
4981       return argError(interp, loc,
4982                       InterpreterMessages::notANumber, 0, argv[0]);
4983     if (type == ELObj::longQuantity)
4984       dResult = lResult;
4985     return new (interp) RealObj(atan(dResult));
4986   }
4987
4988   long lResult2;
4989   double dResult2;
4990   int dim2;
4991   ELObj::QuantityType type2 =
4992     argv[1]->quantityValue(lResult2, dResult2, dim2);
4993
4994   switch (type) {
4995   case ELObj::noQuantity:
4996     return argError(interp, loc,
4997                     InterpreterMessages::notAQuantity, 0, argv[0]);
4998   case ELObj::doubleQuantity:
4999     break;
5000   case ELObj::longQuantity:
5001     dResult = lResult;
5002     break;
5003   default:
5004     CANNOT_HAPPEN();
5005   }
5006
5007   switch (type2) {
5008   case ELObj::noQuantity:
5009     return argError(interp, loc,
5010                     InterpreterMessages::notAQuantity, 1, argv[1]);
5011   case ELObj::doubleQuantity:
5012     break;
5013   case ELObj::longQuantity:
5014     dResult2 = lResult2;
5015     break;
5016   default:
5017     CANNOT_HAPPEN();
5018   }
5019
5020   if (dim != dim2) {
5021     interp.setNextLocation(loc);
5022     interp.message(InterpreterMessages::incompatibleDimensions);
5023     return interp.makeError();
5024   }
5025   // FIXME: the standard is a bit vague about the range
5026   // of atan with two arguments. The description sounds like
5027   // it should be [0,2pi] or [-pi,pi], but then it says
5028   // the range is [-pi/2,pi/2]. I guess that the last sentence
5029   // applies only to the one-argument version of atan, so that
5030   // the semantics would parallel that of the C libraries
5031   // atan/atan2.
5032   return new (interp) RealObj(atan2(dResult, dResult2));
5033 }
5034
5035 DEFPRIMITIVE(XExpt, argc, argv, context, interp, loc)
5036 {
5037   long n1, n2;
5038   double d1, d2;
5039   int dim1, dim2;
5040
5041   ELObj::QuantityType q1 = argv[0]->quantityValue(n1, d1, dim1);
5042   ELObj::QuantityType q2 = argv[0]->quantityValue(n2, d2, dim2);
5043   if (q1 == ELObj::noQuantity)
5044     return argError(interp, loc,
5045                     InterpreterMessages::notAQuantity, 0, argv[0]);
5046   else if (dim1 != 0) {
5047     if (!argv[1]->exactIntegerValue(n2))
5048       return argError(interp, loc,
5049                       InterpreterMessages::notAnExactInteger, 1, argv[1]);
5050     return new (interp) QuantityObj(pow(d1,n2), dim1*n2);
5051   }
5052   else {
5053     if ((q2 == ELObj::noQuantity) || (dim2 != 0))
5054       return argError(interp, loc,
5055                       InterpreterMessages::notANumber, 1, argv[1]);
5056     double res = pow(d1, d2);
5057     long tem;
5058     if (argv[0]->exactIntegerValue(tem) &&
5059         argv[1]->exactIntegerValue(tem) &&
5060         fabs(res) < LONG_MAX)
5061       return interp.makeInteger((long)res);
5062     return new (interp) RealObj(res);
5063   }
5064 }
5065
5066 DEFPRIMITIVE(Expt, argc, argv, context, interp, loc)
5067 {
5068   double d, d2;
5069   if (!argv[0]->realValue(d))
5070     return argError(interp, loc,
5071                     InterpreterMessages::notANumber, 0, argv[0]);
5072   if (!argv[1]->realValue(d2))
5073     return argError(interp, loc,
5074                     InterpreterMessages::notANumber, 1, argv[1]);
5075   double res = pow(d, d2);
5076   long tem;
5077   if (argv[0]->exactIntegerValue(tem) &&
5078       argv[1]->exactIntegerValue(tem) &&
5079       fabs(res) < LONG_MAX)
5080     return interp.makeInteger((long)res);
5081   return new (interp) RealObj(res);
5082 }
5083
5084 DEFPRIMITIVE(ExactToInexact, argc, argv, context, interp, loc)
5085 {
5086   long n;
5087   double d;
5088   int dim;
5089   switch (argv[0]->quantityValue(n, d, dim)) {
5090   case ELObj::noQuantity:
5091     return argError(interp, loc,
5092                     InterpreterMessages::notAQuantity, 0, argv[0]);
5093   case ELObj::doubleQuantity:
5094     return argv[0];
5095   case ELObj::longQuantity:
5096     argv[0]->realValue(d);
5097     return new (interp) RealObj(d);
5098   default:
5099     CANNOT_HAPPEN();
5100   }
5101 }
5102
5103 DEFPRIMITIVE(InexactToExact, argc, argv, context, interp, loc)
5104 {
5105   long n;
5106   double d;
5107   int dim;
5108   switch (argv[0]->quantityValue(n, d, dim)) {
5109   case ELObj::noQuantity:
5110     return argError(interp, loc,
5111                     InterpreterMessages::notAQuantity, 0, argv[0]);
5112   case ELObj::doubleQuantity:
5113    if (argv[0]->realValue(d) && modf(d, &d) == 0.0
5114         && fabs(d) < LONG_MAX && dim == 0)
5115       return interp.makeInteger((long)d);
5116    interp.setNextLocation(loc);
5117    interp.message(InterpreterMessages::noExactRepresentation,
5118                   ELObjMessageArg(argv[0], interp));
5119   case ELObj::longQuantity:  // fall through
5120     return argv[0];
5121   default:
5122     CANNOT_HAPPEN();
5123   }
5124 }
5125
5126 DEFPRIMITIVE(QuantityToNumber, argc, argv, context, interp, loc)
5127 {
5128   // FIXME this is wrong, but what exactly is the
5129   // `number of the quantity' ???
5130   long n;
5131   double d;
5132   int dim;
5133   switch (argv[0]->quantityValue(n, d, dim)) {
5134   case ELObj::noQuantity:
5135     return argError(interp, loc,
5136                     InterpreterMessages::notAQuantity, 0, argv[0]);
5137   case ELObj::doubleQuantity:
5138     if (dim == 0)
5139       return new (interp) RealObj(d);
5140     else
5141       return new (interp) RealObj(d * pow(0.0254/interp.unitsPerInch(), dim));
5142   case ELObj::longQuantity:
5143     if (dim == 0)
5144       return interp.makeInteger(n);
5145     else
5146       return new (interp) RealObj(n * pow(0.0254/interp.unitsPerInch(), dim));
5147   default:
5148     CANNOT_HAPPEN();
5149   }
5150 }
5151
5152 DEFPRIMITIVE(StringToList, argc, argv, context, interp, loc)
5153 {
5154   const Char *s;
5155   size_t n;
5156   if (!argv[0]->stringData(s, n))
5157     return argError(interp, loc,
5158                     InterpreterMessages::notAString, 0, argv[0]);
5159   ELObjDynamicRoot protect(interp, interp.makeNil());
5160   for (int i = n; i > 0; i--) {
5161     // We have to do it in this order, to ensure that no object is GC'ed
5162     PairObj *p = interp.makePair(0, protect);
5163     protect = p;
5164     p->setCar(interp.makeChar(s[i - 1]));
5165   }
5166   return protect;
5167 }
5168
5169 DEFPRIMITIVE(ListToString, argc, argv, context, interp, loc)
5170 {
5171   StringObj *obj = new (interp) StringObj;
5172   ELObj *list = argv[0];
5173   for (;;) {
5174     PairObj *pair = list->asPair();
5175     if (pair) {
5176       Char c;
5177       if (!pair->car()->charValue(c))
5178         return argError(interp, loc,
5179                         InterpreterMessages::notACharList, 0, list);
5180       *obj += c;
5181       list = pair->cdr();
5182     } else if (list->isNil())
5183       break;
5184     else
5185       return argError(interp, loc,
5186                       InterpreterMessages::notAList, 0, list);
5187   }
5188   return obj;
5189 }
5190
5191 static time_t timeConv(const Char *s, size_t n)
5192 {
5193   char buf[100];
5194   unsigned i;
5195
5196   for ( i = 0; i < n && i < (sizeof(buf) - 1); i++)
5197     buf[i] = char(s[i]);
5198   buf[i] = 0;
5199   time_t    today_sec = time(NULL);
5200   struct tm tim, *today;
5201   int       nparsed;
5202
5203   today = localtime(&today_sec);
5204
5205   /* First try to parse as time string without date */
5206   /* Defaults are same as of today */
5207   memcpy(&tim, today, sizeof(tim));
5208   nparsed = sscanf(buf, "%d:%d:%d",
5209                    &tim.tm_hour,
5210                    &tim.tm_min,
5211                    &tim.tm_sec);
5212
5213   /* If we got only one number, it could be
5214      a year so try to parse complete format */
5215   if ( nparsed < 2 ) {
5216     /* Defaults are set to zero */
5217     memset( &tim, 0, sizeof(tim) );
5218
5219     /* This accepts any non digit character between
5220        the date and time spec
5221     */
5222     nparsed = sscanf(buf, "%d-%d-%d%*[^0-9]%d:%d:%d",
5223                      &tim.tm_year,
5224                      &tim.tm_mon,
5225                      &tim.tm_mday,
5226                      &tim.tm_hour,
5227                      &tim.tm_min,
5228                      &tim.tm_sec);
5229     switch (nparsed) {
5230     case 0:
5231         /* Invalid parse */
5232         return (time_t)-1;
5233         /* Not reached */
5234     case 1:
5235         /* We only got a year set to January First
5236            Month is already set to 0
5237         */
5238         /* Fall through */
5239     case 2:
5240         tim.tm_mday = 1;
5241         /* Fall through to month normalization */
5242     default:
5243         tim.tm_mon -= 1;
5244         break;
5245     }
5246
5247     if (tim.tm_year < 38 )
5248       tim.tm_year += 100; /* Y2K workaround */
5249     else if (tim.tm_year >= 1900)
5250       tim.tm_year -= 1900;
5251   }
5252
5253   return mktime(&tim);
5254 }
5255
5256 #define DEFTIMECOMP(NAME, OP) \
5257 DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
5258 { \
5259   const Char *s1, *s2; \
5260   size_t n1, n2; \
5261   time_t t1, t2; \
5262   if (!argv[0]->stringData(s1, n1)) \
5263     return argError(interp, loc, \
5264                     InterpreterMessages::notAString, 0, argv[0]); \
5265   if (!argv[1]->stringData(s2, n2)) \
5266     return argError(interp, loc, \
5267                     InterpreterMessages::notAString, 1, argv[1]); \
5268   if ( (t1 = timeConv(s1, n1)) == (time_t)-1 ) \
5269     return argError(interp, loc, \
5270                     InterpreterMessages::notATimeString, 0, argv[0]); \
5271   if ( (t2 = timeConv(s2, n2)) == (time_t)-1 ) \
5272     return argError(interp, loc, \
5273                     InterpreterMessages::notATimeString, 1, argv[1]); \
5274   if (timeConv(s1, n1) OP timeConv(s2, n2)) \
5275     return interp.makeTrue(); \
5276   else \
5277     return interp.makeFalse(); \
5278 }
5279
5280 DEFTIMECOMP(TimeLess, < )
5281 DEFTIMECOMP(TimeGreater, > )
5282 DEFTIMECOMP(TimeLessOrEqual, <= )
5283 DEFTIMECOMP(TimeGreaterOrEqual, >= )
5284
5285 DEFPRIMITIVE(MapConstructor, argc, argv, context, interp, loc)
5286 {
5287   FunctionObj *func = argv[0]->asFunction();
5288   if (!func)
5289     return argError(interp, loc,
5290                     InterpreterMessages::notAProcedure, 0, argv[0]);
5291   if (func->totalArgs() > 0) {
5292     interp.setNextLocation(loc);
5293     interp.message(InterpreterMessages::tooManyArgs);
5294     return interp.makeError();
5295   }
5296   NodeListObj *nl = argv[1]->asNodeList();
5297   ELObjDynamicRoot protect1(interp, nl);
5298   if (!nl)
5299     return argError(interp, loc,
5300                     InterpreterMessages::notANodeList, 1, argv[1]);
5301   AppendSosofoObj *obj = new (interp) AppendSosofoObj;
5302   ELObjDynamicRoot protect2(interp, obj);
5303   NodePtr nd;
5304   ELObj *ret;
5305   InsnPtr insn(func->makeCallInsn(0, interp, loc, InsnPtr()));
5306   VM vm(context, interp);
5307   while (nd = nl->nodeListFirst(context, interp)) {
5308     nl = nl->nodeListRest(context, interp);
5309     protect1 = nl;
5310     EvalContext::CurrentNodeSetter cns(nd, context.processingMode, vm);
5311     ret = vm.eval(insn.pointer());
5312     if (!ret->asSosofo()) {
5313       interp.setNextLocation(loc);
5314       interp.message(InterpreterMessages::returnNotSosofo);
5315       return interp.makeError();
5316     }
5317     obj->append(ret->asSosofo());
5318   }
5319   return obj;
5320 }
5321
5322 void Interpreter::installPrimitives()
5323 {
5324 #define PRIMITIVE(name, string, nRequired, nOptional, rest) \
5325   installPrimitive(string, new (*this) name ## PrimitiveObj);
5326 #define XPRIMITIVE(name, string, nRequired, nOptional, rest) \
5327   installXPrimitive("UNREGISTERED::James Clark//Procedure::", \
5328                     string, new (*this) name ## PrimitiveObj);
5329 #define XXPRIMITIVE(name, string, nRequired, nOptional, rest) \
5330   installXPrimitive("UNREGISTERED::OpenJade//Procedure::", \
5331                     string, new (*this) name ## PrimitiveObj);
5332
5333 #define PRIMITIVE2(name, string, nRequired, nOptional, rest) \
5334   if (dsssl2()) installPrimitive(string, new (*this) name ## PrimitiveObj);
5335 #include "primitive.h"
5336 #undef PRIMITIVE
5337 #undef XPRIMITIVE
5338 #undef XXPRIMITIVE
5339 #undef PRIMITIVE2
5340   FunctionObj *apply = new (*this) ApplyPrimitiveObj;
5341   makePermanent(apply);
5342   lookup(makeStringC("apply"))->setValue(apply);
5343   if (dsssl2()) {
5344     FunctionObj *callCC = new (*this) CallWithCurrentContinuationPrimitiveObj;
5345     makePermanent(callCC);
5346     lookup(makeStringC("call-with-current-continuation"))->setValue(callCC);
5347   }
5348   if (dsssl2())
5349     lookup(makeStringC("string->quantity"))
5350       ->setValue(lookup(makeStringC("string->number"))->computeValue(0, *this));
5351 }
5352
5353 void Interpreter::installPrimitive(const char *s, PrimitiveObj *value)
5354 {
5355   makePermanent(value);
5356   Identifier *ident = lookup(makeStringC(s));
5357   ident->setValue(value);
5358   value->setIdentifier(ident);
5359   StringC pubid(makeStringC("ISO/IEC 10179:1996//Procedure::"));
5360   pubid += makeStringC(s);
5361   externalProcTable_.insert(pubid, value);
5362 }
5363
5364 void Interpreter::installXPrimitive(const char *prefix, const char *s,
5365                                     PrimitiveObj *value)
5366 {
5367   makePermanent(value);
5368   value->setIdentifier(lookup(makeStringC(s)));
5369   StringC pubid(makeStringC(prefix));
5370   pubid += makeStringC(s);
5371   externalProcTable_.insert(pubid, value);
5372 }
5373
5374 DescendantsNodeListObj::DescendantsNodeListObj(const NodePtr &start, unsigned depth)
5375 : start_(start), depth_(depth)
5376 {
5377   advance(start_, depth_);
5378 }
5379
5380 NodePtr DescendantsNodeListObj::nodeListFirst(EvalContext &, Interpreter &)
5381 {
5382   return start_;
5383 }
5384
5385 NodeListObj *DescendantsNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5386 {
5387   DescendantsNodeListObj *obj = new (interp) DescendantsNodeListObj(*this);
5388   advance(obj->start_, obj->depth_);
5389   return obj;
5390 }
5391
5392 NodeListObj *DescendantsNodeListObj::nodeListChunkRest(EvalContext &context, Interpreter &interp, bool &chunk)
5393 {
5394   DescendantsNodeListObj *obj = new (interp) DescendantsNodeListObj(*this);
5395   chunkAdvance(obj->start_, obj->depth_);
5396   chunk = 1;
5397   return obj;
5398 }
5399
5400 void DescendantsNodeListObj::advance(NodePtr &nd, unsigned &depth)
5401 {
5402   if (!nd)
5403     return;
5404   if (nd.assignFirstChild() == accessOK) {
5405     depth++;
5406     return;
5407   }
5408   if (depth == 0) {
5409     nd.clear();
5410     return;
5411   }
5412   while (nd.assignNextSibling() != accessOK) {
5413     if (depth == 1 || nd.assignOrigin() != accessOK) {
5414       nd.clear();
5415       return;
5416     }
5417     depth--;
5418   }
5419 }
5420
5421 void DescendantsNodeListObj::chunkAdvance(NodePtr &nd, unsigned &depth)
5422 {
5423   if (!nd)
5424     return;
5425   if (nd.assignFirstChild() == accessOK) {
5426     depth++;
5427     return;
5428   }
5429   if (depth == 0) {
5430     nd.clear();
5431     return;
5432   }
5433   while (nd.assignNextChunkSibling() != accessOK) {
5434     if (depth == 1 || nd.assignOrigin() != accessOK) {
5435       nd.clear();
5436       return;
5437     }
5438     depth--;
5439   }
5440 }
5441
5442 SelectByClassNodeListObj::SelectByClassNodeListObj(NodeListObj *nl, ComponentName::Id cls)
5443 : nodeList_(nl), cls_(cls)
5444 {
5445   hasSubObjects_ = 1;
5446 }
5447
5448 NodePtr SelectByClassNodeListObj::nodeListFirst(EvalContext &context, Interpreter &interp)
5449 {
5450   for (;;) {
5451     NodePtr nd = nodeList_->nodeListFirst(context, interp);
5452     if (!nd || nd->classDef().className == cls_)
5453       return nd;
5454     // All nodes in a chunk have the same class
5455     bool chunk;
5456     nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5457   }
5458   // not reached
5459   return NodePtr();
5460 }
5461
5462 NodeListObj *SelectByClassNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5463 {
5464   for (;;) {
5465     NodePtr nd = nodeList_->nodeListFirst(context, interp);
5466     if (!nd || nd->classDef().className == cls_)
5467       break;
5468     // All nodes in a chunk have the same class
5469     bool chunk;
5470     nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5471   }
5472   NodeListObj *tem = nodeList_->nodeListRest(context, interp);
5473   ELObjDynamicRoot protect(interp, tem);
5474   return new (interp) SelectByClassNodeListObj(tem, cls_);
5475 }
5476
5477 NodeListObj *SelectByClassNodeListObj::nodeListChunkRest(EvalContext &context, Interpreter &interp, bool &chunk)
5478 {
5479   for (;;) {
5480     NodePtr nd = nodeList_->nodeListFirst(context, interp);
5481     if (!nd)
5482       return interp.makeEmptyNodeList();
5483     if (nd->classDef().className == cls_)
5484       break;
5485     bool tem;
5486     nodeList_ = nodeList_->nodeListChunkRest(context, interp, tem);
5487   }
5488   NodeListObj *tem = nodeList_->nodeListChunkRest(context, interp, chunk);
5489   ELObjDynamicRoot protect(interp, tem);
5490   return new (interp) SelectByClassNodeListObj(tem, cls_);
5491 }
5492
5493 void SelectByClassNodeListObj::traceSubObjects(Collector &c) const
5494 {
5495   c.trace(nodeList_);
5496 }
5497
5498 MapNodeListObj::MapNodeListObj(FunctionObj *func, NodeListObj *nl,
5499                                const ConstPtr<Context> &context,
5500                                NodeListObj *mapped)
5501 : func_(func), nl_(nl), context_(context), mapped_(mapped)
5502 {
5503   hasSubObjects_ = 1;
5504 }
5505
5506 NodePtr MapNodeListObj::nodeListFirst(EvalContext &context, Interpreter &interp)
5507 {
5508   for (;;) {
5509     if (!mapped_) {
5510       mapNext(context, interp);
5511       if (!mapped_)
5512         break;
5513     }
5514     NodePtr nd = mapped_->nodeListFirst(context, interp);
5515     if (nd)
5516       return nd;
5517     mapped_ = 0;
5518   }
5519   return NodePtr();
5520 }
5521
5522 NodeListObj *MapNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5523 {
5524   for (;;) {
5525     if (!mapped_) {
5526       mapNext(context, interp);
5527       if (!mapped_)
5528         break;
5529     }
5530     NodePtr nd = mapped_->nodeListFirst(context, interp);
5531     if (nd) {
5532       NodeListObj *tem = mapped_->nodeListRest(context, interp);
5533       ELObjDynamicRoot protect(interp, tem);
5534       return new (interp) MapNodeListObj(func_, nl_, context_, tem);
5535     }
5536     mapped_ = 0;
5537   }
5538   return interp.makeEmptyNodeList();
5539 }
5540
5541 void MapNodeListObj::mapNext(EvalContext &context, Interpreter &interp)
5542 {
5543   if (!func_)
5544     return;
5545   NodePtr nd = nl_->nodeListFirst(context, interp);
5546   if (!nd)
5547     return;
5548   VM vm(context, interp);
5549   context_->set(vm);
5550   InsnPtr insn(func_->makeCallInsn(1, interp, context_->loc, InsnPtr()));
5551   ELObj *ret = vm.eval(insn.pointer(), 0, new (interp) NodePtrNodeListObj(nd));
5552   if (interp.isError(ret)) {
5553     func_ = 0;
5554     return;
5555   }
5556   mapped_ = ret->asNodeList();
5557   if (!mapped_) {
5558     interp.setNextLocation(context_->loc);
5559     interp.message(InterpreterMessages::returnNotNodeList);
5560     func_ = 0;
5561     return;
5562   }
5563   nl_ = nl_->nodeListRest(context, interp);
5564 }
5565
5566 void MapNodeListObj::traceSubObjects(Collector &c) const
5567 {
5568   c.trace(nl_);
5569   c.trace(func_);
5570   c.trace(mapped_);
5571   context_->traceSubObjects(c);
5572 }
5573
5574 bool MapNodeListObj::suppressError()
5575 {
5576   return func_ == 0;
5577 }
5578
5579 MapNodeListObj::Context::Context(const EvalContext &context, const Location &l)
5580 : loc(l),
5581   haveStyleStack_(context.styleStack != 0),
5582   processingMode_(context.processingMode),
5583   currentNode_(context.currentNode),
5584   overridingStyle_(context.overridingStyle)
5585 {
5586 }
5587
5588 void MapNodeListObj::Context::set(EvalContext &context) const
5589 {
5590   context.processingMode = processingMode_;
5591   context.currentNode = currentNode_;
5592   context.overridingStyle = overridingStyle_;
5593   if (!haveStyleStack_)
5594     context.styleStack = 0;
5595 }
5596
5597 void MapNodeListObj::Context::traceSubObjects(Collector &c) const
5598 {
5599   c.trace(overridingStyle_);
5600 }
5601
5602 SelectElementsNodeListObj::SelectElementsNodeListObj(NodeListObj *nodeList,
5603                                                      const ConstPtr<PatternSet> &patterns)
5604 : nodeList_(nodeList), patterns_(patterns)
5605 {
5606   ASSERT(!patterns_.isNull());
5607   hasSubObjects_ = 1;
5608 }
5609
5610 SelectElementsNodeListObj::SelectElementsNodeListObj(NodeListObj *nodeList,
5611                                                      NCVector<Pattern> &patterns)
5612 : nodeList_(nodeList)
5613 {
5614   hasSubObjects_ = 1;
5615   Ptr<PatternSet> tem(new PatternSet);
5616   tem->swap(patterns);
5617   patterns_ = tem;
5618 }
5619
5620 void SelectElementsNodeListObj::traceSubObjects(Collector &c) const
5621 {
5622   c.trace(nodeList_);
5623 }
5624
5625 NodePtr SelectElementsNodeListObj::nodeListFirst(EvalContext &context, Interpreter &interp)
5626 {
5627   for (;;) {
5628     NodePtr nd = nodeList_->nodeListFirst(context, interp);
5629     if (!nd)
5630       return nd;
5631     for (size_t i = 0; i < patterns_->size(); i++)
5632       if ((*patterns_)[i].matches(nd, interp))
5633         return nd;
5634     bool chunk;
5635     nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5636   }
5637   // not reached
5638   return NodePtr();
5639 }
5640
5641 NodeListObj *SelectElementsNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5642 {
5643   for (;;) {
5644     NodePtr nd = nodeList_->nodeListFirst(context, interp);
5645     if (!nd)
5646       break;
5647     bool matched = 0;
5648     for (size_t i = 0; i < patterns_->size(); i++) {
5649       if ((*patterns_)[i].matches(nd, interp)) {
5650         matched = 1;
5651         break;
5652       }
5653     }
5654     if (matched)
5655       break;
5656     bool chunk;
5657     nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5658   }
5659   bool chunk;
5660   NodeListObj *tem = nodeList_->nodeListChunkRest(context, interp, chunk);
5661   ELObjDynamicRoot protect(interp, tem);
5662   return new (interp) SelectElementsNodeListObj(tem, patterns_);
5663 }
5664
5665 SiblingNodeListObj::SiblingNodeListObj(const NodePtr &first, const NodePtr &end)
5666 : first_(first), end_(end)
5667 {
5668 }
5669
5670 NodePtr SiblingNodeListObj::nodeListFirst(EvalContext &, Interpreter &)
5671 {
5672   if (*first_ == *end_)
5673     return NodePtr();
5674   return first_;
5675 }
5676
5677 NodeListObj *SiblingNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5678 {
5679   if (*first_ == *end_)
5680     return interp.makeEmptyNodeList();
5681   NodePtr nd;
5682   if (first_->nextSibling(nd) != accessOK)
5683     CANNOT_HAPPEN();
5684   return new (interp) SiblingNodeListObj(nd, end_);
5685 }
5686
5687 NodeListObj *SiblingNodeListObj::nodeListChunkRest(EvalContext &context, Interpreter &interp, bool &chunk)
5688 {
5689   if (first_->chunkContains(*end_)) {
5690     chunk = 0;
5691     return nodeListRest(context, interp);
5692   }
5693   NodePtr nd;
5694   if (first_->nextChunkSibling(nd) != accessOK)
5695     CANNOT_HAPPEN();
5696   chunk = 1;
5697   return new (interp) SiblingNodeListObj(nd, end_);
5698 }
5699
5700 #ifdef DSSSL_NAMESPACE
5701 }
5702 #endif
5703
5704 #include "primitive_inst.cxx"