/tags/jade_RELEASE-1_3_3-pre1/style/primitive.cxx

Large files files are truncated, but you can click here to view the full file

// Copyright (c) 1996 James Clark
// See the file copying.txt for copying permission.

#include "stylelib.h"
#include "Interpreter.h"
#include "InterpreterMessages.h"
#include "EvalContext.h"
#include "SosofoObj.h"
#include "Style.h"
#include "Insn.h"
#include "macros.h"
#include "ELObjMessageArg.h"
#include "LocNode.h"
#include "VM.h"
#include "Pattern.h"
#include "ELObjPropVal.h"
#include <math.h>
#include <limits.h>
#include <stdio.h>
#include <time.h>
#include "LangObj.h"
#include <ctype.h>

#ifdef DSSSL_NAMESPACE
namespace DSSSL_NAMESPACE {
#endif

class DescendantsNodeListObj : public NodeListObj {
public:
  void *operator new(size_t, Collector &c) {
    return c.allocateObject(1);
  }
  DescendantsNodeListObj(const NodePtr &, unsigned = 0);
  NodePtr nodeListFirst(EvalContext &, Interpreter &);
  NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
private:
  static void advance(NodePtr &, unsigned &);
  static void chunkAdvance(NodePtr &, unsigned &);
  // nodes in node list are strictly after this node
  NodePtr start_;
  unsigned depth_;
};

class SiblingNodeListObj : public NodeListObj {
public:
  void *operator new(size_t, Collector &c) {
    return c.allocateObject(1);
  }
  SiblingNodeListObj(const NodePtr &first, const NodePtr &end);
  NodePtr nodeListFirst(EvalContext &, Interpreter &);
  NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
private:
  NodePtr first_;
  NodePtr end_;
};

class SelectByClassNodeListObj : public NodeListObj {
public:
  SelectByClassNodeListObj(NodeListObj *nl, ComponentName::Id);
  NodePtr nodeListFirst(EvalContext &, Interpreter &);
  NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  void traceSubObjects(Collector &) const;
private:
  NodeListObj *nodeList_;
  ComponentName::Id cls_;
};

class MapNodeListObj : public NodeListObj {
public:
  class Context : public Resource {
  public:
    Context(const EvalContext &, const Location &);
    void set(EvalContext &) const;
    void traceSubObjects(Collector &) const;
    Location loc;
  private:
    NodePtr currentNode_;
    const ProcessingMode *processingMode_;
    StyleObj *overridingStyle_;
    bool haveStyleStack_;
  };
  void *operator new(size_t, Collector &c) {
    return c.allocateObject(1);
  }
  MapNodeListObj(FunctionObj *func, NodeListObj *nl, const ConstPtr<Context> &, NodeListObj *mapped = 0);
  NodePtr nodeListFirst(EvalContext &, Interpreter &);
  NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  void traceSubObjects(Collector &) const;
  bool suppressError();
private:
  void mapNext(EvalContext &, Interpreter &);
  FunctionObj *func_;
  NodeListObj *nl_;
  NodeListObj *mapped_;
  ConstPtr<Context> context_;
};

class SelectElementsNodeListObj : public NodeListObj {
public:
  struct PatternSet : public Resource, public NCVector<Pattern> { };
  void *operator new(size_t, Collector &c) {
    return c.allocateObject(1);
  }
  SelectElementsNodeListObj(NodeListObj *, NCVector<Pattern> &);
  SelectElementsNodeListObj(NodeListObj *, const ConstPtr<PatternSet> &);
  void traceSubObjects(Collector &) const;
  NodePtr nodeListFirst(EvalContext &, Interpreter &);
  NodeListObj *nodeListRest(EvalContext &, Interpreter &);
private:
  NodeListObj *nodeList_;
  ConstPtr<PatternSet> patterns_;
};

#define PRIMITIVE(name, string, nRequired, nOptional, rest) \
class name ## PrimitiveObj : public PrimitiveObj { \
public: \
  static const Signature signature_; \
  name ## PrimitiveObj() : PrimitiveObj(&signature_) { } \
  ELObj *primitiveCall(int, ELObj **, EvalContext &, Interpreter &, const Location &); \
}; \
const Signature name ## PrimitiveObj::signature_ \
  = { nRequired, nOptional, rest };

#define XPRIMITIVE PRIMITIVE
#define XXPRIMITIVE PRIMITIVE
#define PRIMITIVE2 PRIMITIVE
#include "primitive.h"
#undef PRIMITIVE
#undef XPRIMITIVE
#undef XXPRIMITIVE
#undef PRIMITIVE2

#define DEFPRIMITIVE(name, argc, argv, context, interp, loc) \
 ELObj *name ## PrimitiveObj \
  ::primitiveCall(int argc, ELObj **argv, EvalContext &context, Interpreter &interp, \
                  const Location &loc)

DEFPRIMITIVE(Cons, argc, argv, context, interp, loc)
{
  return new (interp) PairObj(argv[0], argv[1]);
}

DEFPRIMITIVE(List, argc, argv, context, interp, loc)
{
  if (argc == 0)
    return interp.makeNil();
  PairObj *head = new (interp) PairObj(argv[0], 0);
  ELObjDynamicRoot protect(interp, head);
  PairObj *tail = head;
  for (int i = 1; i < argc; i++) {
    PairObj *tem = new (interp) PairObj(argv[i], 0);
    tail->setCdr(tem);
    tail = tem;
  }
  tail->setCdr(interp.makeNil());
  return head;
}

DEFPRIMITIVE(IsNull, argc, argv, context, interp, loc)
{
  if (argv[0]->isNil())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsList, argc, argv, context, interp, loc)
{
  ELObj *obj = argv[0];
  for (;;) {
    PairObj *pair = obj->asPair();
    if (pair)
      obj = pair->cdr();
    else if (obj->isNil())
      return interp.makeTrue();
    else
      break;
  }
  return interp.makeFalse();
}

DEFPRIMITIVE(IsEqual, argc, argv, context, interp, loc)
{
  if (ELObj::equal(*argv[0], *argv[1]))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsEqv, argc, argv, context, interp, loc)
{
  if (ELObj::eqv(*argv[0], *argv[1]))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(Car, argc, argv, context, interp, loc)
{
  PairObj *pair = argv[0]->asPair();
  if (!pair)
    return argError(interp, loc,
		    InterpreterMessages::notAPair, 0, argv[0]);
  else
    return pair->car();
}

DEFPRIMITIVE(Cdr, argc, argv, context, interp, loc)
{
  PairObj *pair = argv[0]->asPair();
  if (!pair)
    return argError(interp, loc,
		    InterpreterMessages::notAPair, 0, argv[0]);
  else
    return pair->cdr();
}

DEFPRIMITIVE(Append, argc, argv, context, interp, loc)
{
  if (argc == 0)
    return interp.makeNil();
  PairObj *tail = interp.makePair(0, 0);
  PairObj *head = tail;
  ELObjDynamicRoot protect(interp, head);
  for (int i = 0; i < argc - 1; i++) {
    for (ELObj *p = argv[i]; !p->isNil();) {
      PairObj *tem = p->asPair();
      if (!tem)
	return argError(interp, loc,
			InterpreterMessages::notAList, i, p);
      PairObj *newTail = new (interp) PairObj(tem->car(), 0);
      tail->setCdr(newTail);
      tail = newTail;
      p = tem->cdr();
    }
  }
  tail->setCdr(argv[argc - 1]);
  return head->cdr();
}

DEFPRIMITIVE(Reverse, argc, argv, context, interp, loc)
{
  ELObjDynamicRoot protect(interp, interp.makeNil());
  ELObj *p = argv[0];
  while (!p->isNil()) {
    PairObj *tem = p->asPair();
    if (!tem)
      return argError(interp, loc,
		      InterpreterMessages::notAList, 0, argv[0]);
    protect = new (interp) PairObj(tem->car(), protect);
    p = tem->cdr();
  }
  return protect;
}

DEFPRIMITIVE(ListTail, argc, argv, context, interp, loc)
{
  long k;
  if (!argv[1]->exactIntegerValue(k))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  if (k < 0) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::outOfRange);
    return interp.makeError();
  }
  ELObj *p = argv[0];
  for (; k > 0; k--) {
    PairObj *tem = p->asPair();
    if (!tem) {
      if (p->isNil()) {
        interp.setNextLocation(loc);
	interp.message(InterpreterMessages::outOfRange);
	return interp.makeError();
      }
      else
        return argError(interp, loc,
		        InterpreterMessages::notAList, 0, argv[0]);
    }
    p = tem->cdr();
  }
  return p;
}

DEFPRIMITIVE(ListRef, argc, argv, context, interp, loc)
{
  long k;
  if (!argv[1]->exactIntegerValue(k))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  if (k < 0) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::outOfRange);
    return interp.makeError();
  }
  ELObj *p = argv[0];
  for (;;) {
    PairObj *tem = p->asPair();
    if (!tem)
      break;
    if (k == 0)
      return tem->car();
    --k;
    p = tem->cdr();
  }
  if (p->isNil()) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::outOfRange);
    return interp.makeError();
  }
  else
    return argError(interp, loc,
		    InterpreterMessages::notAList, 0, argv[0]);
}

DEFPRIMITIVE(Member, argc, argv, context, interp, loc)
{
  ELObj *p = argv[1];
  while (!p->isNil()) {
    PairObj *tem = p->asPair();
    if (!tem)
      return argError(interp, loc,
		      InterpreterMessages::notAList, 1, argv[1]);
    if (ELObj::equal(*argv[0], *tem->car()))
      return p;
    p = tem->cdr();
  }
  return interp.makeFalse();
}

DEFPRIMITIVE(Memv, argc, argv, context, interp, loc)
{
  ELObj *p = argv[1];
  while (!p->isNil()) {
    PairObj *tem = p->asPair();
    if (!tem)
      return argError(interp, loc,
		      InterpreterMessages::notAList, 1, argv[1]);
    if (ELObj::eqv(*argv[0], *tem->car()))
      return p;
    p = tem->cdr();
  }
  return interp.makeFalse();
}

DEFPRIMITIVE(Length, argc, argv, context, interp, loc)
{
  ELObj *obj = argv[0];
  long n = 0;
  for (;;) {
    PairObj *pair = obj->asPair();
    if (pair) {
      n++;
      obj = pair->cdr();
    }
    else if (obj->isNil())
      break;
    else if (interp.isError(obj))
      return obj;
    else
      return argError(interp, loc,
		      InterpreterMessages::notAList, 0, obj);
  }
  return interp.makeInteger(n);
}

DEFPRIMITIVE(Not, argc, argv, context, interp, loc)
{
  if (argv[0]->isTrue())
    return interp.makeFalse();
  else
    return interp.makeTrue();
}

DEFPRIMITIVE(IsSymbol, argc, argv, context, interp, loc)
{
  if (argv[0]->asSymbol())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsKeyword, argc, argv, context, interp, loc)
{
  if (argv[0]->asKeyword())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsInteger, argc, argv, context, interp, loc)
{
  long n;
  if (argv[0]->exactIntegerValue(n))
    return interp.makeTrue();
  double x;
  if (argv[0]->realValue(x) && modf(x, &x) == 0.0)
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsReal, argc, argv, context, interp, loc)
{
  double x;
  if (argv[0]->realValue(x))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsNumber, argc, argv, context, interp, loc)
{
  double x;
  if (argv[0]->realValue(x))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsQuantity, argc, argv, context, interp, loc)
{
  long n;
  double d;
  int dim;
  if (argv[0]->quantityValue(n, d, dim) != ELObj::noQuantity)
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsPair, argc, argv, context, interp, loc)
{
  if (argv[0]->asPair())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsProcedure, argc, argv, context, interp, loc)
{
  if (argv[0]->asFunction())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsBoolean, argc, argv, context, interp, loc)
{
  if (argv[0] == interp.makeTrue())
    return argv[0];
  else if (argv[0] == interp.makeFalse())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsChar, argc, argv, context, interp, loc)
{
  Char c;
  if (argv[0]->charValue(c))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(IsCharEqual, argc, argv, context, interp, loc)
{
  Char c1, c2;
  if (!argv[0]->charValue(c1))
    return argError(interp, loc,
		    InterpreterMessages::notAChar, 0, argv[0]);
  if (!argv[1]->charValue(c2))
    return argError(interp, loc,
		    InterpreterMessages::notAChar, 1, argv[1]);
  if (c1 == c2)
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(String, argc, argv, context, interp, loc)
{
  StringObj *obj = new (interp) StringObj;
  for (int i = 0; i < argc; i++) {
    Char c;
    if (!argv[i]->charValue(c)) 
      return argError(interp, loc,
		      InterpreterMessages::notAChar, i, argv[i]);
    *obj += c;
  }
  return obj;
}

DEFPRIMITIVE(SymbolToString, argc, argv, context, interp, loc)
{
  SymbolObj *obj = argv[0]->asSymbol();
  if (!obj)
    return argError(interp, loc,
		    InterpreterMessages::notASymbol, 0, argv[0]);
  return obj->name();
}

DEFPRIMITIVE(StringToSymbol, argc, argv, context, interp, loc)
{
  const Char *s;
  size_t n;
  if (!argv[0]->stringData(s, n))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 0, argv[0]);
  return interp.makeSymbol(StringC(s, n));
}

DEFPRIMITIVE(IsString, argc, argv, context, interp, loc)
{
  const Char *s;
  size_t n;
  if (argv[0]->stringData(s, n))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(StringLength, argc, argv, context, interp, loc)
{
  const Char *s;
  size_t n;
  if (!argv[0]->stringData(s, n))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 0, argv[0]);
  return interp.makeInteger(n);
}

DEFPRIMITIVE(IsStringEqual, argc, argv, context, interp, loc)
{
  const Char *s1, *s2;
  size_t n1, n2;
  if (!argv[0]->stringData(s1, n1))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 0, argv[0]);
  if (!argv[1]->stringData(s2, n2))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 1, argv[1]);
  if (n1 == n2
      && (n1 == 0 || memcmp(s1, s2, n1*sizeof(Char)) == 0))
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(StringAppend, argc, argv, context, interp, loc)
{
  StringObj *result = new (interp) StringObj;
  for (int i = 0; i < argc; i++) {
    const Char *s;
    size_t n;
    if (!argv[i]->stringData(s, n))
      return argError(interp, loc,
		      InterpreterMessages::notAString, i,
		      argv[i]);
    result->append(s, n);
  }
  return result;
}

DEFPRIMITIVE(StringRef, argc, argv, context, interp, loc)
{
  const Char *s;
  size_t n;
  if (!argv[0]->stringData(s, n))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 0, argv[0]);
  long k;
  if (!argv[1]->exactIntegerValue(k))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  if (k < 0 || (unsigned long)k >= n) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::outOfRange);
    return interp.makeError();
  }
  return interp.makeChar(s[size_t(k)]);
}

DEFPRIMITIVE(Substring, argc, argv, context, interp, loc)
{
  const Char *s;
  size_t n;
  if (!argv[0]->stringData(s, n))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 0, argv[0]);
  long start;
  if (!argv[1]->exactIntegerValue(start))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  long end;
  if (!argv[2]->exactIntegerValue(end))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 2, argv[2]);
  if (start < 0 || (unsigned long)end > n || start > end) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::outOfRange);
    return interp.makeError();
  }
  return new (interp) StringObj(s + size_t(start), size_t(end - start));
}

DEFPRIMITIVE(Equal, argc, argv, context, interp, loc)
{
  if (argc == 0)
    return interp.makeTrue();
  long lResult;
  double dResult;
  int dim;
  int i = 1;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    return argError(interp, loc,
		    InterpreterMessages::notAQuantity, 0, argv[0]);
  case ELObj::longQuantity:
    break;
  case ELObj::doubleQuantity:
    goto useDouble;
    break;
  default:
    CANNOT_HAPPEN();
  }
  long lResult2;
  double dResult2;
  int dim2;
  for (; i < argc; i++) {
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		    InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      if (lResult2 != lResult || dim2 != dim)
	return interp.makeFalse();
      break;
    case ELObj::doubleQuantity:
      dResult = lResult;
      if (dResult2 != dResult || dim2 != dim)
	return interp.makeFalse();
      i++;
      goto useDouble;
    default:
      CANNOT_HAPPEN();
    }
  }
  return interp.makeTrue();
 useDouble:
  for (; i < argc; i++) {
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      if (lResult2 != dResult || dim2 != dim)
	return interp.makeFalse();
      break;
    case ELObj::doubleQuantity:
      if (dResult2 != dResult || dim2 != dim)
	return interp.makeFalse();
      break;
    }
  }
  return interp.makeTrue();
}

DEFPRIMITIVE(Plus, argc, argv, context, interp, loc)
{
  if (argc == 0)
    return interp.makeInteger(0);
  long lResult;
  double dResult;
  bool usingD;
  bool spec = 0;
  int dim;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    dim = 1;
    spec = 1;
    break;
  case ELObj::longQuantity:
    usingD = 0;
    break;
  case ELObj::doubleQuantity:
    usingD = 1;
    break;
  default:
    CANNOT_HAPPEN();
  }
  for (int i = 1; !spec && i < argc; i++) {
    long lResult2;
    double dResult2;
    int dim2;
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      // FIXME shouldn't quantityValue set dim to 1 for length-specs ?
      dim2 = 1;
      spec = 1;
      break;
    case ELObj::longQuantity:
      if (!usingD) {
	if (lResult2 < 0) {
	  if (lResult >= LONG_MIN - lResult2) {
	    lResult += lResult2;
	    break;
	  }
	}
	else {
	  if (lResult <= LONG_MAX - lResult2) {
	    lResult += lResult2;
	    break;
	  }
	}
	usingD = 1;
	dResult = double(lResult);
      }
      dResult += double(lResult2);
      break;
    case ELObj::doubleQuantity:
      if (!usingD) {
	dResult = lResult;
	usingD = 1;
      }
      dResult += dResult2;
      break;
    default:
      CANNOT_HAPPEN();
    }
    if (dim2 != dim) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::incompatibleDimensions);
      return interp.makeError();
    }
  }

  if (spec) {
    LengthSpec ls;
    for (int i = 0; i < argc; i++) {
      const LengthSpec *lsp = argv[i]->lengthSpec();
      if (lsp)
	ls += *lsp;
      else {
	switch (argv[i]->quantityValue(lResult, dResult, dim)) {
	case ELObj::noQuantity:
	  return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
			  i, argv[i]);
	case ELObj::longQuantity:
	  dResult = lResult;
	  // fall through
	case ELObj::doubleQuantity:
	  if (dim != 1) {
	    interp.setNextLocation(loc);
	    interp.message(InterpreterMessages::incompatibleDimensions);
	    return interp.makeError();
	  }
	  ls += dResult;
	  break;
	}
      }
    }
    return new (interp) LengthSpecObj(ls);
  }

  if (!usingD) {
    if (dim == 0)
      return interp.makeInteger(lResult);
    else if (dim == 1)
      return new (interp) LengthObj(lResult);
    else
      dResult = lResult;
  }
  if (dim == 0)
    return new (interp) RealObj(dResult);
  else
    return new (interp) QuantityObj(dResult, dim);
}

DEFPRIMITIVE(Minus, argc, argv, context, interp, loc)
{
  long lResult;
  double dResult;
  bool usingD;
  bool spec = 0;
  int dim;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    spec = 1;
    break;
  case ELObj::longQuantity:
    usingD = 0;
    break;
  case ELObj::doubleQuantity:
    usingD = 1;
    break;
  default:
    CANNOT_HAPPEN();
  }
  if (argc == 1) {
    if (usingD)
      dResult = -dResult;
    else
      lResult = -lResult;
  }
  else {
    for (int i = 1; !spec && i < argc; i++) {
      long lResult2;
      double dResult2;
      int dim2;
      switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
      case ELObj::noQuantity:
        dim2 = dim;
	spec = 1;
	break;
      case ELObj::longQuantity:
	if (!usingD) {
	  if (lResult2 > 0) {
	    if (lResult >= LONG_MIN + lResult2) {
	      lResult -= lResult2;
	      break;
	    }
	  }
	  else {
	    if (lResult <= LONG_MAX + lResult2) {
	      lResult -= lResult2;
	      break;
	    }
	  }
	  usingD = 1;
	  dResult = double(lResult);
	}
	dResult -= double(lResult2);
	break;
      case ELObj::doubleQuantity:
	if (!usingD) {
	  dResult = lResult;
	  usingD = 1;
	}
	dResult -= dResult2;
	break;
      default:
	CANNOT_HAPPEN();
      }
      if (dim2 != dim) {
	interp.setNextLocation(loc);
	interp.message(InterpreterMessages::incompatibleDimensions);
	return interp.makeError();
      }
    }
  }

  if (spec) {
    LengthSpec ls;
    for (int i = 0; i < argc; i++) {
      const LengthSpec *lsp = argv[i]->lengthSpec();
      if (lsp) {
        if (i > 0 || argc == 1) 
          ls -= *lsp;
        else
          ls += *lsp;
      }
      else {
        switch (argv[i]->quantityValue(lResult, dResult, dim)) {
        case ELObj::noQuantity:
          return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
        		  i, argv[i]);
	case ELObj::longQuantity:
	  dResult = lResult;
	  // fall through
	case ELObj::doubleQuantity:
	  if (dim != 1) {
	    interp.setNextLocation(loc);
	    interp.message(InterpreterMessages::incompatibleDimensions);
	    return interp.makeError();
	  }
          if (i > 0 || argc == 1) 
	    ls -= dResult;
          else 
	    ls += dResult;
	  break;
	}
      }
    }
    return new (interp) LengthSpecObj(ls);
  }
  
  if (!usingD) {
    if (dim == 0)
      return interp.makeInteger(lResult);
    else if (dim == 1)
      return new (interp) LengthObj(lResult);
    else
      dResult = lResult;
  }
  if (dim == 0)
    return new (interp) RealObj(dResult);
  else
    return new (interp) QuantityObj(dResult, dim);
}

DEFPRIMITIVE(Multiply, argc, argv, context, interp, loc)
{
  if (argc == 0)
    return interp.makeInteger(1);
  long lResult;
  double dResult;
  int dim;
  int i = 1;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    {
      const LengthSpec *ls = argv[0]->lengthSpec();
      if (ls) {
	LengthSpec result(*ls);
	double d;
	for (; i < argc; i++) {
	  if (!argv[i]->realValue(d))
	    return argError(interp, loc,
			    InterpreterMessages::notANumber, 1, argv[1]);
	  result *= d;
	}
	return new (interp) LengthSpecObj(result);
      }
    }
    return argError(interp, loc,
		    InterpreterMessages::notAQuantity, 0, argv[0]);
  case ELObj::longQuantity:
    break;
  case ELObj::doubleQuantity:
    goto useDouble;
  default:
    CANNOT_HAPPEN();
  }
  long lResult2;
  double dResult2;
  int dim2;
  for (; i < argc; i++) {
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      dim += dim2;
      if (dim > 1
	  || (lResult2 != 0
	      && (lResult2 < 0
		  ? (lResult > 0
		     ? lResult > -(unsigned)LONG_MIN / -(unsigned)lResult2
		     : -(unsigned)lResult > LONG_MAX / -(unsigned)lResult2)
		  : (lResult > 0
		     ? lResult > LONG_MAX / lResult2
		     : -(unsigned)lResult > -(unsigned)LONG_MIN / lResult2)))) {
	dResult = double(lResult) * lResult2;
	i++;
	goto useDouble;
      }
      lResult *= lResult2;
      break;
    case ELObj::doubleQuantity:
      dim += dim2;
      dResult = lResult * dResult2;
      i++;
      goto useDouble;
    default:
      CANNOT_HAPPEN();
    }
  }
  if (dim == 0)
    return interp.makeInteger(lResult);
  else
    return new (interp) LengthObj(lResult);
 useDouble:
  for (; i < argc; i++) {
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      dResult *= lResult2;
      break;
    case ELObj::doubleQuantity:
      dResult *= dResult2;
      break;
    }
    dim += dim2;
  }
  if (dim == 0)
    return new (interp) RealObj(dResult);
  else
    return new (interp) QuantityObj(dResult, dim);
}

DEFPRIMITIVE(Divide, argc, argv, context, interp, loc)
{
  long lResult;
  double dResult;
  int dim;
  if (argc == 1) {
    switch (argv[0]->quantityValue(lResult, dResult, dim)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, 0, argv[0]);
    case ELObj::longQuantity:
      if (lResult == 0)
	goto divide0;
      dResult = 1.0/lResult;
      break;
    case ELObj::doubleQuantity:
      if (dResult == 0.0)
	goto divide0;
      dResult = 1.0/dResult;
      break;
    default:
      CANNOT_HAPPEN();
    }
    dim = -dim;
  }
  else {
    int i = 1;
    switch (argv[0]->quantityValue(lResult, dResult, dim)) {
    case ELObj::noQuantity:
      {
	const LengthSpec *ls = argv[0]->lengthSpec();
	if (ls) {
	  LengthSpec result(*ls);
	  double d;
	  for (; i < argc; i++) {
	    if (!argv[i]->realValue(d))
	      return argError(interp, loc,
			      InterpreterMessages::notANumber, 1, argv[1]);
	    if (d == 0.0)
	      goto divide0;
	    result /= d;
	  }
	  return new (interp) LengthSpecObj(result);
	}
      }
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, 0, argv[0]);
    case ELObj::longQuantity:
      break;
    case ELObj::doubleQuantity:
      goto useDouble;
    default:
      CANNOT_HAPPEN();
    }
    long lResult2;
    double dResult2;
    int dim2;
    for (; i < argc; i++) {
      switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
      case ELObj::noQuantity:
	return argError(interp, loc,
			InterpreterMessages::notAQuantity, 0, argv[0]);
      case ELObj::longQuantity:
	if (lResult2 == 0)
	  goto divide0;
	dim -= dim2;
	// If dim and dim2 are both 1, must goto useDouble:
	// since lengths are inexact, result must be inexact.
	if (dim2 == 0 && lResult % lResult2 == 0) {
	  lResult /= lResult2;
	  break;
	}
	dResult = double(lResult)/lResult2;
	i++;
	goto useDouble;
      case ELObj::doubleQuantity:
	dim -= dim2;
	dResult = lResult;
	if (dResult2 == 0.0)
	  goto divide0;
	dResult /= dResult2;
	i++;
	goto useDouble;
      default:
	CANNOT_HAPPEN();
      }
    }
    if (dim == 0)
      return interp.makeInteger(lResult);
    else
      return new (interp) LengthObj(lResult);
  useDouble:
    for (; i < argc; i++) {
      switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
      case ELObj::noQuantity:
	return argError(interp, loc,
			InterpreterMessages::notAQuantity, i, argv[i]);
      case ELObj::longQuantity:
	if (lResult2 == 0)
	  goto divide0;
	dResult /= lResult2;
	break;
      case ELObj::doubleQuantity:
	dResult /= dResult2;
	if (dResult2 == 0.0)
	  goto divide0;
	break;
      }
      dim -= dim2;
    }
  }
  if (dim == 0)
    return new (interp) RealObj(dResult);
  else
    return new (interp) QuantityObj(dResult, dim);
 divide0:
  interp.setNextLocation(loc);
  interp.message(InterpreterMessages::divideBy0);
  return interp.makeError();
}

DEFPRIMITIVE(Quotient, argc, argv, context, interp, loc)
{
  long n1;
  long n2;
  if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
    if (n2 == 0) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::divideBy0);
      return interp.makeError();
    }
    // This isn't strictly portable.
    return interp.makeInteger(n1 / n2);
  }
  double d1;
  if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 0, argv[0]);
  double d2;
  if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  if (d2 == 0.0) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::divideBy0);
    return interp.makeError();
  }
  return new (interp) RealObj((d1 - fmod(d1, d2))/d2);
}

DEFPRIMITIVE(Remainder, argc, argv, context, interp, loc)
{
  long n1;
  long n2;
  if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
    if (n2 == 0) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::divideBy0);
      return interp.makeError();
    }
    // This isn't strictly portable.
    return interp.makeInteger(n1 % n2);
  }
  double d1;
  if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 0, argv[0]);
  double d2;
  if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  if (d2 == 0.0) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::divideBy0);
    return interp.makeError();
  }
  return new (interp) RealObj(fmod(d1, d2));
}

DEFPRIMITIVE(Modulo, argc, argv, context, interp, loc)
{
  long n1;
  long n2;
  if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
    if (n2 == 0) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::divideBy0);
      return interp.makeError();
    }
    long r = n1 % n2;
    if (n2 > 0 ? r < 0 : r > 0)
      r += n2;
    return interp.makeInteger(r);
  }
  double d1;
  if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 0, argv[0]);
  double d2;
  if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 1, argv[1]);
  if (d2 == 0.0) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::divideBy0);
    return interp.makeError();
  }
  double r = fmod(d1, d2);
  if (d2 > 0 ? r < 0 : r > 0)
    r += d2;
  return new (interp) RealObj(r);
}

#define DEFCOMPARE(NAME, OP) \
DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
{ \
  if (argc == 0) \
    return interp.makeTrue(); \
  long lResult; \
  double dResult; \
  int dim; \
  bool lastWasDouble; \
  switch (argv[0]->quantityValue(lResult, dResult, dim)) { \
  case ELObj::noQuantity: \
    return argError(interp, loc, \
		    InterpreterMessages::notAQuantity, 0, argv[0]); \
  case ELObj::longQuantity: \
    lastWasDouble = 0; \
    break; \
  case ELObj::doubleQuantity: \
    lastWasDouble = 1; \
    break; \
  default: \
    CANNOT_HAPPEN(); \
  } \
  for (int i = 1; i < argc; i++) { \
    long lResult2; \
    double dResult2; \
    int dim2; \
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) { \
    case ELObj::noQuantity: \
      return argError(interp, loc, \
		      InterpreterMessages::notAQuantity, i, argv[i]); \
    case ELObj::longQuantity: \
      if (dim2 != dim) \
	goto badDim; \
      if (!(lastWasDouble \
	    ? (dResult OP lResult2) \
	    : (lResult OP lResult2))) \
	return interp.makeFalse(); \
      lResult = lResult2; \
      lastWasDouble = 0; \
      break; \
    case ELObj::doubleQuantity: \
      if (dim != dim2) \
	goto badDim; \
      if (!(lastWasDouble \
	    ? (dResult OP dResult2) \
	    : (lResult OP dResult2))) \
	return interp.makeFalse(); \
      dResult = dResult2; \
      lastWasDouble = 1; \
      break; \
    } \
  } \
  return interp.makeTrue(); \
 badDim: \
  interp.setNextLocation(loc); \
  interp.message(InterpreterMessages::incompatibleDimensions); \
  return interp.makeError(); \
}

DEFCOMPARE(Less, <)
DEFCOMPARE(Greater, >)
DEFCOMPARE(LessEqual, <=)
DEFCOMPARE(GreaterEqual, >=)

DEFPRIMITIVE(Min, argc, argv, context, interp, loc)
{
  long lResult;
  double dResult;
  int dim;
  int i = 1;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    return argError(interp, loc,
		    InterpreterMessages::notAQuantity, 0, argv[0]);
  case ELObj::longQuantity:
    break;
  case ELObj::doubleQuantity:
    goto useDouble;
  default:
    CANNOT_HAPPEN();
  }
  // Note that result is inexact if any of the arguments are
  for (; i < argc; i++) {
    long lResult2;
    double dResult2;
    int dim2;
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      if (dim2 != dim)
	goto badDim;
      if (lResult2 < lResult)
	lResult = lResult2;
      break;
    case ELObj::doubleQuantity:
      if (dim != dim2)
	goto badDim;
      if (dResult2 < lResult)
	dResult = dResult2;
      else if (dim)
	break;
      else
	dResult = lResult;
      i++;
      goto useDouble;
    }
  }
  if (dim == 0)
    return interp.makeInteger(lResult);
  else
    return new (interp) LengthObj(lResult);
 useDouble:
  for (; i < argc; i++) {
    long lResult2;
    double dResult2;
    int dim2;
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      if (dim2 != dim)
	goto badDim;
      if (lResult2 < dResult)
	dResult = lResult2;
      break;
    case ELObj::doubleQuantity:
      if (dim != dim2)
	goto badDim;
      if (dResult2 < dResult)
	dResult = dResult2;
      break;
    }
  }
  if (dim == 0)
    return new (interp) RealObj(dResult);
  else
    return new (interp) QuantityObj(dResult, dim);
 badDim:
  interp.setNextLocation(loc);
  interp.message(InterpreterMessages::incompatibleDimensions);
  return interp.makeError();
}

DEFPRIMITIVE(Max, argc, argv, context, interp, loc)
{
  long lResult;
  double dResult;
  int dim;
  int i = 1;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    return argError(interp, loc,
		    InterpreterMessages::notAQuantity, 0, argv[0]);
  case ELObj::longQuantity:
    break;
  case ELObj::doubleQuantity:
    goto useDouble;
  default:
    CANNOT_HAPPEN();
  }
  // Note that result is inexact if any of the arguments are
  for (; i < argc; i++) {
    long lResult2;
    double dResult2;
    int dim2;
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      if (dim2 != dim)
	goto badDim;
      if (lResult2 > lResult)
	lResult = lResult2;
      break;
    case ELObj::doubleQuantity:
      if (dim != dim2)
	goto badDim;
      if (dResult2 > lResult)
	dResult = dResult2;
      else if (dim)
	break;
      else
	dResult = lResult;
      i++;
      goto useDouble;
    }
  }
  if (dim == 0)
    return interp.makeInteger(lResult);
  else
    return new (interp) LengthObj(lResult);
 useDouble:
  for (; i < argc; i++) {
    long lResult2;
    double dResult2;
    int dim2;
    switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
    case ELObj::noQuantity:
      return argError(interp, loc,
		      InterpreterMessages::notAQuantity, i, argv[i]);
    case ELObj::longQuantity:
      if (dim2 != dim)
	goto badDim;
      if (lResult2 > dResult)
	dResult = lResult2;
      break;
    case ELObj::doubleQuantity:
      if (dim != dim2)
	goto badDim;
      if (dResult2 > dResult)
	dResult = dResult2;
      break;
    }
  }
  if (dim == 0)
    return new (interp) RealObj(dResult);
  else
    return new (interp) QuantityObj(dResult, dim);
 badDim:
  interp.setNextLocation(loc);
  interp.message(InterpreterMessages::incompatibleDimensions);
  return interp.makeError();
}

DEFPRIMITIVE(Floor, argc, argv, context, interp, loc)
{
  double d;
  if (argv[0]->inexactRealValue(d))
    return new (interp) RealObj(floor(d));
  long n;
  if (argv[0]->exactIntegerValue(n))
    return argv[0];
  return argError(interp, loc,
		  InterpreterMessages::notANumber, 0, argv[0]);
}

DEFPRIMITIVE(Ceiling, argc, argv, context, interp, loc)
{
  double d;
  if (argv[0]->inexactRealValue(d))
    return new (interp) RealObj(ceil(d));
  long n;
  if (argv[0]->exactIntegerValue(n))
    return argv[0];
  return argError(interp, loc,
		  InterpreterMessages::notANumber, 0, argv[0]);
}

DEFPRIMITIVE(Round, argc, argv, context, interp, loc)
{
  double d;
  if (argv[0]->inexactRealValue(d)) {
    double result = floor(d + .5);
    // That rounded it upwards.
    // Now figure out if that was different from round to
    // even.
    if (result - d == 0.5 && fmod(result, 2.0) != 0)
      result -= 1.0;
    return new (interp) RealObj(result);
  }
  long n;
  if (argv[0]->exactIntegerValue(n))
    return argv[0];
  return argError(interp, loc,
		  InterpreterMessages::notANumber, 0, argv[0]);
}

DEFPRIMITIVE(Truncate, argc, argv, context, interp, loc)
{
  double d;
  if (argv[0]->inexactRealValue(d)) {
    double iPart;
    modf(d, &iPart);
    return new (interp) RealObj(iPart);
  }
  long n;
  if (argv[0]->exactIntegerValue(n))
    return argv[0];
  return argError(interp, loc,
		  InterpreterMessages::notANumber, 0, argv[0]);
}

DEFPRIMITIVE(Abs, argc, argv, context, interp, loc)
{
  long lResult;
  double dResult;
  int dim;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    return argError(interp, loc,
		    InterpreterMessages::notAQuantity, 0, argv[0]);
  case ELObj::longQuantity:
    if (lResult != LONG_MIN) {
      if (lResult >= 0)
	return argv[0];
      if (dim == 0)
	return interp.makeInteger(-lResult);
      else
	return new (interp) LengthObj(-lResult);
    }
    dResult = lResult;
    break;
  case ELObj::doubleQuantity:
    break;
  default:
    CANNOT_HAPPEN();
  }
  if (dResult >= 0)
    return argv[0];
  if (dim == 0)
    return new (interp) RealObj(-dResult);
  else
    return new (interp) QuantityObj(-dResult, dim);
}

DEFPRIMITIVE(Sqrt, argc, argv, context, interp, loc)
{
  long lResult;
  double dResult;
  int dim;
  ELObj::QuantityType type
    = argv[0]->quantityValue(lResult, dResult, dim);
  switch (type) {
  case ELObj::noQuantity:
    return argError(interp, loc,
		    InterpreterMessages::notAQuantity, 0, argv[0]);
  case ELObj::longQuantity:
    dResult = lResult;
    break;
  case ELObj::doubleQuantity:
    break;
  default:
    CANNOT_HAPPEN();
  }
  if ((dim & 1) || dResult < 0.0) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::outOfRange);
    return interp.makeError();
  }
  dim /= 2;
  dResult = sqrt(dResult);
  if (type == ELObj::longQuantity && dim == 0) {
    long n = long(dResult);
    if (n*n == lResult)
      return interp.makeInteger(n);
  }
  return new (interp) QuantityObj(dResult, dim);
}

DEFPRIMITIVE(Time, argc, argv, context, interp, loc)
{
  // This assumes a Posix compatible time().
  time_t t = time(0);
  return interp.makeInteger(long(t));
}

DEFPRIMITIVE(TimeToString, argc, argv, context, interp, loc)
{
  long k;
  if (!argv[0]->exactIntegerValue(k))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 0, argv[0]);
  time_t t = time_t(k);
  const struct tm *p;
  if (argc > 1 && argv[1] != interp.makeFalse())
    p = gmtime(&t);
  else
    p = localtime(&t);
  char buf[64];
  sprintf(buf, "%04d-%02d-%02dT%02d:%02d:%02d",
          p->tm_year + 1900, p->tm_mon + 1, p->tm_mday,
	  p->tm_hour, p->tm_min, p->tm_sec);
  return new (interp) StringObj(interp.makeStringC(buf));
}

DEFPRIMITIVE(CharProperty, argc, argv, context, interp, loc)
{
  SymbolObj *sym = argv[0]->asSymbol();
  if (!sym)
    return argError(interp, loc,
		    InterpreterMessages::notASymbol, 0, argv[0]);
  StringObj *prop = argv[0]->asSymbol()->convertToString();
  Char c;
  if (!argv[1]->charValue(c))
    return argError(interp, loc,
		    InterpreterMessages::notAChar, 1, argv[1]);
  return interp.charProperty(*prop, c, loc, (argc > 2) ? argv[2] : 0);
}

DEFPRIMITIVE(Literal, argc, argv, context, interp, loc)
{
  if (argc == 0)
    return new (interp) EmptySosofoObj;
  const Char *s;
  size_t n;
  if (!argv[0]->stringData(s, n))
    return argError(interp, loc, InterpreterMessages::notAString,
		      0, argv[0]);
  if (argc == 1)
    return new (interp) LiteralSosofoObj(argv[0]);
  StringObj *strObj = new (interp) StringObj(s, n);
  for (int i = 1; i < argc; i++) {
    if (!argv[i]->stringData(s, n))
      return argError(interp, loc, InterpreterMessages::notAString,
		      i, argv[i]);
    strObj->append(s, n);
  }
  ELObjDynamicRoot protect(interp, strObj);
  return new (interp) LiteralSosofoObj(strObj);
}

DEFPRIMITIVE(ProcessChildren, argc, argv, context, interp, loc)
{
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  return new (interp) ProcessChildrenSosofoObj(context.processingMode);
}

DEFPRIMITIVE(ProcessChildrenTrim, argc, argv, context, interp, loc)
{
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  return new (interp) ProcessChildrenTrimSosofoObj(context.processingMode);
}

DEFPRIMITIVE(SosofoAppend, argc, argv, context, interp, loc)
{
  /* Optimize the case where there is no or only
     one argument */
  if (argc == 0)
    return new (interp) EmptySosofoObj;
  else if (argc == 1) {
    SosofoObj *sosofo = argv[0]->asSosofo();
    if (!sosofo)
      return argError(interp, loc, InterpreterMessages::notASosofo,
		      0, argv[0]);
    return sosofo;	
  }

  /* Don't create another object if the first argument is
     already an AppendSosofoObj, this handles gracefully 
     case like 
     (let loop ( (res (empty-sosofo))
		 (nl  (node-list-rest (children (current-node)))))
	(loop (sosofo-append res (process-node-list (node-list-first nl)))
	      (node-list-rest nl)))
   */
  AppendSosofoObj *obj;
  int i = 0; 
  if ( argv[i]->asAppendSosofo() )
    obj = argv[i++]->asAppendSosofo();
  else 
    obj = new (interp) AppendSosofoObj;

  for ( ; i < argc; i++) {
    SosofoObj *sosofo = argv[i]->asSosofo();
    if (!sosofo)
      return argError(interp, loc, InterpreterMessages::notASosofo,
		      i, argv[i]);
    obj->append(sosofo);
  }
  return obj;
}

DEFPRIMITIVE(NextMatch, argc, argv, context, interp, loc)
{
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  StyleObj *style;
  if (argc == 0)
    style = 0;
  else {
    style = argv[0]->asStyle();
    if (!style)
      return argError(interp, loc, InterpreterMessages::notAStyle, 0, argv[0]);
  }
  return new (interp) NextMatchSosofoObj(style);
}

DEFPRIMITIVE(EmptySosofo, argc, argv, context, interp, loc)
{
  return new (interp) EmptySosofoObj;
}

DEFPRIMITIVE(SosofoLabel, argc, argv, context, interp, loc)
{
  SosofoObj *sosofo = argv[0]->asSosofo();
  if (!sosofo)
    return argError(interp, loc, InterpreterMessages::notASosofo,
		    0, argv[0]);

  SymbolObj *sym = argv[1]->asSymbol();
  if (!sym)
    return argError(interp, loc,
		    InterpreterMessages::notASymbol, 1, argv[1]);
  return new (interp) LabelSosofoObj(sym, loc, sosofo);
}

DEFPRIMITIVE(SosofoDiscardLabeled, argc, argv, context, interp, loc)
{
  SosofoObj *sosofo = argv[0]->asSosofo();
  if (!sosofo)
    return argError(interp, loc, InterpreterMessages::notASosofo,
		    0, argv[0]);

  SymbolObj *sym = argv[1]->asSymbol();
  if (!sym)
    return argError(interp, loc,
		    InterpreterMessages::notASymbol, 1, argv[1]);
  return new (interp) DiscardLabeledSosofoObj(sym, sosofo);
}

DEFPRIMITIVE(IsSosofo, argc, argv, context, interp, loc)
{
  if (argv[0]->asSosofo())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(MergeStyle, argc, argv, context, interp, loc)
{
  MergeStyleObj *merged = new (interp) MergeStyleObj;
  for (int i = 0; i < argc; i++) {
    StyleObj *style = argv[i]->asStyle();
    if (!style)
      return argError(interp, loc,
		      InterpreterMessages::notAStyle, i, argv[i]);
    merged->append(style);
  }
  return merged;
}

DEFPRIMITIVE(IsStyle, argc, argv, context, interp, loc)
{
  if (argv[0]->asStyle())
    return interp.makeTrue();
  else
    return interp.makeFalse();
}

DEFPRIMITIVE(CurrentNodePageNumberSosofo, argc, argv, context, interp, loc)
{
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  return new (interp) CurrentNodePageNumberSosofoObj(context.currentNode);
}

DEFPRIMITIVE(PageNumberSosofo, argc, argv, context, interp, loc)
{
  return new (interp) PageNumberSosofoObj;
}

DEFPRIMITIVE(ProcessElementWithId, argc, argv, context, interp, loc)
{
  const Char *s;
  size_t n;
  if (!argv[0]->stringData(s, n))
    return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  NodePtr root;
  NamedNodeListPtr elements;
  if (context.currentNode->getGroveRoot(root) == accessOK
      && root->getElements(elements) == accessOK) {
    NodePtr node;
    if (elements->namedNode(GroveString(s, n), node) == accessOK)
      return new (interp) ProcessNodeSosofoObj(node, context.processingMode);
  }
  return new (interp) EmptySosofoObj;
}

DEFPRIMITIVE(ProcessFirstDescendant, argc, argv, context, interp, loc)
{
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  
  NCVector<Pattern> patterns(argc);
  for (size_t i = 0; i < argc; i++) {
    if (!interp.convertToPattern(argv[i], loc, patterns[i]))
      return interp.makeError();
  }
  NodeListObj *nl = new (interp) DescendantsNodeListObj(context.currentNode);
  ELObjDynamicRoot protect(interp, nl);
  nl = new (interp) SelectElementsNodeListObj(nl, patterns);
  protect = nl;
  NodePtr nd(nl->nodeListFirst(context, interp));
  if (!nd)
    return new (interp) EmptySosofoObj;
  return new (interp) ProcessNodeSosofoObj(nd, context.processingMode);
}

DEFPRIMITIVE(ProcessMatchingChildren, argc, argv, context, interp, loc)
{
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  NCVector<Pattern> patterns(argc);
  for (size_t i = 0; i < argc; i++) {
    if (!interp.convertToPattern(argv[i], loc, patterns[i])) 
      return interp.makeError();
  }
  NodeListPtr nlPtr;
  // FIXME handle root
  if (patterns.size() == 0 || context.currentNode->children(nlPtr) != accessOK)
    return new (interp) EmptySosofoObj;
  NodeListObj *nl = new (interp) NodeListPtrNodeListObj(nlPtr);
  ELObjDynamicRoot protect(interp, nl);
  nl = new (interp) SelectElementsNodeListObj(nl, patterns);
  protect = nl;
  return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode);
}

DEFPRIMITIVE(SelectElements, argc, argv, context, interp, loc)
{
  NodeListObj *nl = argv[0]->asNodeList();
  if (!nl)
    return argError(interp, loc,
		    InterpreterMessages::notANodeList, 0, argv[0]);
  NCVector<Pattern> patterns(1);
  if (!interp.convertToPattern(argv[1], loc, patterns[0]))
    return interp.makeError();
  return new (interp) SelectElementsNodeListObj(nl, patterns);
}

DEFPRIMITIVE(IsMatchElement, argc, argv, context, interp, loc)
{
  Pattern pattern;
  if (!interp.convertToPattern(argv[0], loc, pattern))
    return interp.makeError();
  NodePtr node;
  if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
    return argError(interp, loc,
		    InterpreterMessages::notASingletonNode, 1, argv[1]);
  if (pattern.matches(node, interp))
    return interp.makeTrue();
  return interp.makeFalse();
}

DEFPRIMITIVE(ProcessNodeList, argc, argv, context, interp, loc)
{
  if (!context.processingMode) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::noCurrentProcessingMode);
    return interp.makeError();
  }
  NodeListObj *nl = argv[0]->asNodeList();
  if (!nl)
    return argError(interp, loc,
		    InterpreterMessages::notANodeList, 0, argv[0]);
  return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode);
}

static
void reverse(StringC &s)
{
  size_t i = 0;
  size_t j = s.size() - 1;
  while (i < j) {
    Char tem = s[i];
    s[i] = s[j];
    s[j] = tem;
    i++;
    j--;
  }
}

static
StringC formatNumberLetter(long n, const char *letters)
{
  StringC result;
  if (n == 0)
    result += '0';
  else {
    bool neg;
    // FIXME possibility of overflow
    if (n < 0) {
      n = -n;
      neg = 1;
    }
    else
      neg = 0;
    do {
      n--;
      int r = n % 26;
      n -= r;
      n /= 26;
      result += letters[r];
    } while (n > 0);
    if (neg)
      result += '-';
    reverse(result);
  }
  return result;
}

static
StringC formatNumberDecimal(long n, size_t minWidth)
{
  StringC result;
  char buf[32];
  sprintf(buf, "%ld", n);
  const char *p = buf;
  if (*p == '-') {
    p++;
    result += '-';
  }
  size_t len = strlen(p);
  while (len < minWidth) {
    result += '0';
    len++;
  }
  while (*p)
    result += *p++;
  return result;
}

static
StringC formatNumberRoman(long n, const char *letters)
{
  StringC result;
  if (n > 5000 || n < -5000 || n == 0)
    return formatNumberDecimal(n, 1);
  if (n < 0) {
    n = -n;
    result += '-';
  }
  while (n >= 1000) {
    result += letters[0];
    n -= 1000;
  }
  for (int i = 100; i > 0; i /= 10, letters += 2) {
    long q = n / i;
    n -= q * i;
    switch (q) {
    case 1:
      result += letters[2]…