/tags/jade_0_6/jade/style/primitive.cxx

// 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 "macros.h"
#include "ELObjMessageArg.h"
#include "LocNode.h"
#include <math.h>
#include <limits.h>
#include <stdio.h>
#include <time.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 ElementPattern : public Resource {
public:
  virtual ~ElementPattern();
  virtual bool matches(const NodePtr &, SdataMapper &) const = 0;
};

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

class UnionElementPattern : public ElementPattern {
public:
  UnionElementPattern(const ConstPtr<ElementPattern> &,
		      const ConstPtr<ElementPattern> &);
  bool matches(const NodePtr &, SdataMapper &) const;
private:
  ConstPtr<ElementPattern> pat1_;
  ConstPtr<ElementPattern> pat2_;
};

class SimpleElementPattern : public ElementPattern {
public:
  SimpleElementPattern(Vector<StringC> &);
  bool matches(const NodePtr &, SdataMapper &) const;
private:
  // gi followed by att name/value pairs.
  // empty gi matches any gi
  Vector<StringC> giAtts_;
};

class ParentElementPattern : public ElementPattern {
public:
  ParentElementPattern(const ConstPtr<ElementPattern> &pat,
		       const ConstPtr<ElementPattern> &parentPat);
  bool matches(const NodePtr &, SdataMapper &) const;
private:
  ConstPtr<ElementPattern> pat_;
  ConstPtr<ElementPattern> parentPat_;
};

class NoElementPattern : public ElementPattern {
public:
  NoElementPattern() { }
  bool matches(const NodePtr &, SdataMapper &) const;
};

#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
#include "primitive.h"
#undef PRIMITIVE
#undef XPRIMITIVE

#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 (*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 (*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;
  int dim;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
    {
      const LengthSpec *lsp = argv[0]->lengthSpec();
      if (!lsp)
	return argError(interp, loc,
			InterpreterMessages::notAQuantityOrLengthSpec, 0, argv[0]);
      LengthSpec ls(*lsp);
      for (int i = 1; i < argc; i++) {
	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);
    }
  case ELObj::longQuantity:
    usingD = 0;
    break;
  case ELObj::doubleQuantity:
    usingD = 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 (!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 (!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;
  int dim;
  switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  case ELObj::noQuantity:
     {
      const LengthSpec *lsp = argv[0]->lengthSpec();
      if (!lsp)
	return argError(interp, loc,
			InterpreterMessages::notAQuantityOrLengthSpec, 0, argv[0]);
      LengthSpec ls(*lsp);
      for (int i = 1; i < argc; i++) {
	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);
    }
 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; 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 (!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 (!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]);
  Char c;
  if (!argv[1]->charValue(c))
    return argError(interp, loc,
		    InterpreterMessages::notAChar, 1, argv[1]);
  // FIXME
  if (argc > 2)
    return argv[2];
  else
    return interp.makeFalse();
}

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)
{
  AppendSosofoObj *obj = new (interp) AppendSosofoObj;
  for (int i = 0; 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;
}

static
ConstPtr<ElementPattern> convertToPattern(ELObj *obj, Interpreter &interp)
{
  Vector<StringC> giAtts(1);
  StringObj *str = obj->convertToString();
  if (str) {
    const Char *s;
    size_t n;
    str->stringData(s, n);
    if (!n)
      return new NoElementPattern;
    giAtts[0].assign(s, n);
    interp.normalizeGeneralName(giAtts[0]);
    return new SimpleElementPattern(giAtts);
  }
  else if (obj == interp.makeTrue() || obj->isNil())
    return new SimpleElementPattern(giAtts);
  PairObj *pair = obj->asPair();
  if (!pair)
    return 0;
  str = pair->car()->convertToString();
  if (str) {
    const Char *s;
    size_t n;
    str->stringData(s, n);
    if (!n)
      return new NoElementPattern;
    giAtts[0].assign(s, n);
    interp.normalizeGeneralName(giAtts[0]);
  }
  else if (pair->car() != interp.makeTrue())
    return 0;
  obj = pair->cdr();
  if (!obj->isNil()) {
    pair = obj->asPair();
    if (!pair)
      return 0;
    if (pair->car()->isNil())
      obj = pair->cdr();
    else {
      PairObj *atts = pair->car()->asPair();
      if (atts) {
	obj = pair->cdr();
	for (;;) {
	  str = atts->car()->convertToString();
	  if (!str)
	    return 0;
	  const Char *s;
	  size_t n;
	  str->stringData(s, n);
	  giAtts.push_back(StringC(s, n));
	  if (atts->cdr()->isNil())
	    break;
	  atts = atts->cdr()->asPair();
	  if (!atts)
	    return 0;
	}
	if ((giAtts.size() & 1) == 0)
	  return 0;
      }
    }
    if (!obj->isNil()) {
      ConstPtr<ElementPattern> parentPat = convertToPattern(obj, interp);
      if (parentPat.isNull())
	return parentPat;
      return new ParentElementPattern(new SimpleElementPattern(giAtts), parentPat);
    }
  }
  return new SimpleElementPattern(giAtts);
}

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);
  ConstPtr<ElementPattern> pattern;
  for (size_t i = 0; i < argc; i++) {
    ConstPtr<ElementPattern> tem = convertToPattern(argv[i], interp);
    if (tem.isNull())
      return argError(interp, loc,
    		      InterpreterMessages::notAPattern, i, argv[i]);
    if (pattern.isNull())
      pattern = tem;
    else
      pattern = new UnionElementPattern(tem, pattern);
  }
  if (pattern.isNull())
    return new (interp) EmptySosofoObj;
  NodeListObj *nl = new (interp) DescendantsNodeListObj(context.currentNode);
  ELObjDynamicRoot protect(interp, nl);
  nl = new (interp) SelectElementsNodeListObj(nl, pattern);
  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);
  ConstPtr<ElementPattern> pattern;
  for (size_t i = 0; i < argc; i++) {
    ConstPtr<ElementPattern> tem = convertToPattern(argv[i], interp);
    if (tem.isNull())
      return argError(interp, loc,
    		      InterpreterMessages::notAPattern, i, argv[i]);
    if (pattern.isNull())
      pattern = tem;
    else
      pattern = new UnionElementPattern(tem, pattern);
  }
  NodeListPtr nlPtr;
  // FIXME handle root
  if (pattern.isNull() || context.currentNode->children(nlPtr) != accessOK)
    return new (interp) EmptySosofoObj;
  NodeListObj *nl = new (interp) NodeListPtrNodeListObj(nlPtr);
  ELObjDynamicRoot protect(interp, nl);
  nl = new (interp) SelectElementsNodeListObj(nl, pattern);
  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]);
  ConstPtr<ElementPattern> pattern(convertToPattern(argv[1], interp));
  if (pattern.isNull())
    return argError(interp, loc,
  		    InterpreterMessages::notAPattern, 1, argv[1]);
  return new (interp) SelectElementsNodeListObj(nl, pattern);
}

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];
      break;
    case 2:
      result += letters[2];
      result += letters[2];
      break;
    case 3:
      result += letters[2];
      result += letters[2];
      result += letters[2];
      break;
    case 4:
      result += letters[2];
      result += letters[1];
      break;
    case 5:
      result += letters[1];
      break;
    case 6:
      result += letters[1];
      result += letters[2];
      break;
    case 7:
      result += letters[1];
      result += letters[2];
      result += letters[2];
      break;
    case 8:
      result += letters[1];
      result += letters[2];
      result += letters[2];
      result += letters[2];
      break;
    case 9:
      result += letters[2];
      result += letters[0];
      break;
    }
  }
  return result;
}

static
bool formatNumber(long n, const Char *s, size_t len, StringC &result)
{
  if (len > 0) {
    switch (s[len - 1]) {
    case 'a':
      result += formatNumberLetter(n, "abcdefghijklmnopqrstuvwxyz");
      return 1;
    case 'A':
      result += formatNumberLetter(n, "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
      return 1;
    case 'i':
      result += formatNumberRoman(n, "mdclxvi");
      return 1;
    case 'I':
      result += formatNumberRoman(n, "MDCLXVI");
      return 1;
    case '1':
      result += formatNumberDecimal(n, len);
      return 1;
    default:
      break;
    }
  }
  result += formatNumberDecimal(n, 1);
  return 0;
}

DEFPRIMITIVE(FormatNumber, argc, argv, context, interp, loc)
{
  long n;
  if (!argv[0]->exactIntegerValue(n))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 0, argv[0]);
  const Char *s;
  size_t len;
  if (!argv[1]->stringData(s, len))
    return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
  StringObj *result = new (interp) StringObj;
  if (!formatNumber(n, s, len, *result)) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::invalidNumberFormat,
                   StringMessageArg(StringC(s, len)));
  }
  return result;
}

DEFPRIMITIVE(FormatNumberList, argc, argv, context, interp, loc)
{
  ELObj *numbers = argv[0];
  ELObj *formats = argv[1];
  ELObj *seps = argv[2];
  StringObj *result = new (interp) StringObj;
  while (!numbers->isNil()) {
    PairObj *tem;
    const Char *s;
    size_t len;
    if (numbers != argv[0]) {
      if (!seps->stringData(s, len)) {
	tem = seps->asPair();
	if (!tem)
	  return argError(interp, loc,
  	    	          InterpreterMessages::notAList, 2, argv[2]);
	if (!tem->car()->stringData(s, len))
	  return argError(interp, loc,
  	  	          InterpreterMessages::notAString, 2, tem->car());
	seps = tem->cdr();
      }
      result->append(s, len);
    }
    tem = numbers->asPair();
    if (!tem)
      return argError(interp, loc,
  		      InterpreterMessages::notAList, 0, argv[0]);
    long k;
    if (!tem->car()->exactIntegerValue(k))
      // FIXME message not quite right
      return argError(interp, loc,
  		      InterpreterMessages::notAnExactInteger, 0, tem->car());
    numbers = tem->cdr();
    if (!formats->stringData(s, len)) {
      tem = formats->asPair();
      if (!tem)
	return argError(interp, loc,
  	  	        InterpreterMessages::notAList, 1, argv[1]);
      if (!tem->car()->stringData(s, len))
        return argError(interp, loc,
  		        InterpreterMessages::notAString, 0, tem->car());
      formats = tem->cdr();
    }
    if (!formatNumber(k, s, len, *result)) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::invalidNumberFormat,
		     StringMessageArg(StringC(s, len)));
    }
  }
  return result;
}

DEFPRIMITIVE(ExternalProcedure, 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]);
  StringC tem(s, n);
  FunctionObj *func = interp.lookupExternalProc(tem);
  if (func)
    return func;
  return interp.makeFalse();
}

DEFPRIMITIVE(Error, 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]);
  interp.setNextLocation(loc);
  interp.message(InterpreterMessages::errorProc,
		 StringMessageArg(StringC(s, n)));
  return interp.makeError();
}

DEFPRIMITIVE(StringToNumber, 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 radix;
  if (argc > 1) {
    if (!argv[1]->exactIntegerValue(radix))
      return argError(interp, loc,
		      InterpreterMessages::notAnExactInteger, 1, argv[1]);
    switch (radix) {
    case 2:
    case 8:
    case 10:
    case 16:
      break;
    default:
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::invalidRadix);
      radix = 10;
      break;
    }
  }
  else
    radix = 10;
  StringC tem(s, n);
  return interp.convertNumber(tem, 0, int(radix));
}

DEFPRIMITIVE(NumberToString, argc, argv, context, interp, loc)
{
  // FIXME use optional radix
  double x;
  if (!argv[0]->realValue(x))
    return argError(interp, loc,
		    InterpreterMessages::notANumber, 0, argv[0]);
  StrOutputCharStream os;
  argv[0]->print(interp, os);
  StringC tem;
  os.extractString(tem);
  return new (interp) StringObj(tem);
}

DEFPRIMITIVE(DisplaySize, argc, argv, context, interp, loc)
{
  return new (interp) LengthSpecObj(LengthSpec(LengthSpec::displaySize, 1.0));
}

DEFPRIMITIVE(TableUnit, argc, argv, context, interp, loc)
{
  long k;
  if (!argv[0]->exactIntegerValue(k))
    return argError(interp, loc,
		    InterpreterMessages::notAnExactInteger, 0, argv[0]);

  return new (interp) LengthSpecObj(LengthSpec(LengthSpec::tableUnit, double(k)));
}

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


DEFPRIMITIVE(DisplaySpace, argc, argv, context, interp, loc)
{
  FOTBuilder::DisplaySpace displaySpace;
  if (!interp.convertLengthSpec(argv[0], displaySpace.nominal))
    return argError(interp, loc,
		    InterpreterMessages::notALengthSpec, 0, argv[0]);
  displaySpace.min = displaySpace.nominal;
  displaySpace.max = displaySpace.nominal;
  // first specified keyword argument takes priority,
  // so scan them backwards...
  for (int i = argc - 1; i > 0; i -= 2) {
    if ((argc & 1) == 0) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::oddKeyArgs);
      return interp.makeError();
    }
    KeywordObj *keyObj = argv[i - 1]->asKeyword();
    if (!keyObj) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::keyArgsNotKey);
      return interp.makeError();
    }
    Identifier::SyntacticKey key;
    if (!keyObj->identifier()->syntacticKey(key)) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::invalidKeyArg,
		     StringMessageArg(keyObj->identifier()->name()));
      return interp.makeError();
    }
    else {
      switch (key) {
      case Identifier::keyMin:
	if (!interp.convertLengthSpec(argv[i], displaySpace.min))
	  return argError(interp, loc,
			  InterpreterMessages::notALengthSpec, i, argv[i]);
	break;
      case Identifier::keyMax:
	if (!interp.convertLengthSpec(argv[i], displaySpace.max))
	  return argError(interp, loc,
			  InterpreterMessages::notALengthSpec, i, argv[i]);
	break;
      case Identifier::keyIsConditional:
	if (argv[i] == interp.makeTrue())
	  displaySpace.conditional = 1;
	else if (argv[i] == interp.makeFalse())
	  displaySpace.conditional = 0;
	else
	  return argError(interp, loc,
		  	  InterpreterMessages::notABoolean, i, argv[i]);
	break;
      case Identifier::keyPriority:
	if (argv[i]->exactIntegerValue(displaySpace.priority))
	  displaySpace.force = 0;
	else {
	  SymbolObj *sym = argv[i]->asSymbol();
	  if (sym && sym->cValue() == FOTBuilder::symbolForce)
	    displaySpace.force = 1;
	  else
	    return argError(interp, loc,
			    InterpreterMessages::notAPriority, i, argv[i]);
	}
	break;
      default:
	interp.setNextLocation(loc);
	interp.message(InterpreterMessages::invalidKeyArg,
	               StringMessageArg(keyObj->identifier()->name()));
	return interp.makeError();
      }
    }
  }
  return new (interp) DisplaySpaceObj(displaySpace);
}

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

DEFPRIMITIVE(InlineSpace, argc, argv, context, interp, loc)
{
  FOTBuilder::InlineSpace inlineSpace;
  if (!interp.convertLengthSpec(argv[0], inlineSpace.nominal))
    return argError(interp, loc,
		    InterpreterMessages::notALengthSpec, 0, argv[0]);
  inlineSpace.min = inlineSpace.nominal;
  inlineSpace.max = inlineSpace.nominal;
  // first specified keyword argument takes priority,
  // so scan them backwards...
  for (int i = argc - 1; i > 0; i -= 2) {
    if ((argc & 1) == 0) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::oddKeyArgs);
      return interp.makeError();
    }
    KeywordObj *keyObj = argv[i - 1]->asKeyword();
    if (!keyObj) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::keyArgsNotKey);
      return interp.makeError();
    }
    Identifier::SyntacticKey key;
    if (!keyObj->identifier()->syntacticKey(key)) {
      interp.setNextLocation(loc);
      interp.message(InterpreterMessages::invalidKeyArg,
		     StringMessageArg(keyObj->identifier()->name()));
      return interp.makeError();
    }
    else {
      switch (key) {
      case Identifier::keyMin:
	if (!interp.convertLengthSpec(argv[i], inlineSpace.min))
	  return argError(interp, loc,
			  InterpreterMessages::notALengthSpec, i, argv[i]);
	break;
      case Identifier::keyMax:
	if (!interp.convertLengthSpec(argv[i], inlineSpace.max))
	  return argError(interp, loc,
			  InterpreterMessages::notALengthSpec, i, argv[i]);
	break;
      default:
	interp.setNextLocation(loc);
	interp.message(InterpreterMessages::invalidKeyArg,
	               StringMessageArg(keyObj->identifier()->name()));
	return interp.makeError();
      }
    }
  }
  return new (interp) InlineSpaceObj(inlineSpace);
  return argv[0];
}

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

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

DEFPRIMITIVE(ColorSpace, 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 (StringC(s, n)
      != interp.makeStringC("ISO/IEC 10179:1996//Color-Space Family::Device RGB")) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::unknownColorSpaceFamily,
                   StringMessageArg(StringC(s, n)));
    return interp.makeError();
  }
  if (argc > 1) {
    interp.setNextLocation(loc);
    interp.message(InterpreterMessages::deviceRGBColorSpaceNoArgs);
  }
  return new (interp) DeviceRGBColorSpaceObj;
}

DEFPRIMITIVE(Color, argc, argv, context, interp, loc)
{
  ColorSpaceObj *colorSpace = argv[0]->asColorSpace();
  if (!colorSpace)
    return argError(interp, loc,
  		    InterpreterMessages::notAColorSpace, 0, argv[0]);
  return colorSpace->makeColor(argc - 1, argv + 1, interp, loc);
 }

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

DEFPRIMITIVE(IsAddressLocal, argc, argv, context, interp, loc)
{
  AddressObj *address = argv[0]->asAddress();
  if (!address)
    return argError(interp, loc,
  		    InterpreterMessages::notAnAddress, 0, argv[0]);
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  switch (address->address().type) {
  case FOTBuilder::Address::resolvedNode:
    if (address->address().node->sameGrove(*context.currentNode))
      return interp.makeTrue();
    else
      return interp.makeFalse();
  case FOTBuilder::Address::idref:
    return interp.makeTrue();
  case FOTBuilder::Address::entity:
    return interp.makeFalse();
  default:
    break;
  }
  return interp.makeFalse();
}

DEFPRIMITIVE(IsAddressVisited, argc, argv, context, interp, loc)
{
  AddressObj *address = argv[0]->asAddress();
  if (!address)
    return argError(interp, loc,
  		    InterpreterMessages::notAnAddress, 0, argv[0]);
  // FIXME
  return interp.makeFalse();
}

DEFPRIMITIVE(CurrentNodeAddress, argc, argv, context, interp, loc)
{
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  return new (interp) AddressObj(FOTBuilder::Address::resolvedNode, context.currentNode);
}

DEFPRIMITIVE(HytimeLinkend, argc, argv, context, interp, loc)
{
  if (!context.currentNode)
    return noCurrentNodeError(interp, loc);
  return new (interp) AddressObj(FOTBuilder::Address::hytimeLinkend, context.currentNode);
}

DEFPRIMITIVE(SgmlDocumentAddress, 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]);
  StringC sysid(s, n);
  if (!argv[1]->stringData(s, n))
    return argError(interp, loc,
		    InterpreterMessages::notAString, 1, argv[1]);
  return new (interp) AddressObj(FOTBuilder::Address::sgmlDocument, NodePtr(), sysid, StringC(s, n));
}

DEFPRIMITIVE(IdrefAddress, argc, argv, context, interp, loc)
{
  // The advantage of doing this rather than using an NodeAddressObj,
  // is that when it's a forward reference we don't have to
  // wait for the node.  It might be cleaner to use a ProxyNode class
  // for this.
  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);
  return new