/trunk/jade/style/primitive.cxx
C++ | 2536 lines | 2375 code | 127 blank | 34 comment | 530 complexity | c9594c69e1b005e797f09c46b05da9eb MD5 | raw file
Possible License(s): LGPL-2.1, LGPL-2.0
- // Copyright (c) 1996 James Clark, 2000 Peter Nilsson
- // 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 <OpenSP/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 TreeNodeListObj : public NodeListObj {
- public:
- void *operator new(size_t, Collector &c) {
- return c.allocateObject(1);
- }
- TreeNodeListObj(const NodePtr &);
- NodePtr nodeListFirst(EvalContext &, Interpreter &);
- NodeListObj *nodeListRest(EvalContext &, Interpreter &);
- NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
- protected:
- virtual void advance(EvalContext &, Interpreter &) = 0;
- virtual void chunkAdvance(EvalContext &, Interpreter &) = 0;
- virtual TreeNodeListObj *copy(Interpreter &) = 0;
- NodePtr root_;
- // nodes in node list are strictly after this node
- NodePtr start_;
- };
- class SubtreeNodeListObj : public TreeNodeListObj {
- public:
- SubtreeNodeListObj(const NodePtr &);
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- protected:
- void advance(EvalContext &, Interpreter &);
- void chunkAdvance(EvalContext &, Interpreter &);
- SubtreeNodeListObj *copy(Interpreter &);
- unsigned depth_;
- };
- class SubgroveNodeListObj : public TreeNodeListObj {
- public:
- SubgroveNodeListObj(const NodePtr &);
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- protected:
- void advance(EvalContext &, Interpreter &);
- void chunkAdvance(EvalContext &, Interpreter &);
- SubgroveNodeListObj *copy(Interpreter &);
- unsigned depth_;
- };
- class DescendantsNodeListObj : public SubtreeNodeListObj {
- public:
- DescendantsNodeListObj(const NodePtr &, Interpreter &);
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- protected:
- DescendantsNodeListObj *copy(Interpreter &);
- };
- 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 &);
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- 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;
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- 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 &);
- NodeListObj *mapped_;
- protected:
- FunctionObj *func_;
- NodeListObj *nl_;
- ConstPtr<Context> context_;
- };
- class FilterNodeListObj : public MapNodeListObj {
- public:
- FilterNodeListObj(FunctionObj *func, NodeListObj *nl, const ConstPtr<Context> &);
- NodePtr nodeListFirst(EvalContext &, Interpreter &);
- NodeListObj *nodeListRest(EvalContext &, Interpreter &);
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- private:
- bool maybeIn(EvalContext &, Interpreter &, const NodePtr &);
- };
- class SelectElementsNodeListObj : public NodeListObj {
- public:
- struct PatternSet : public Resource, public NCVector<Pattern> { };
- void *operator new(size_t, Collector &c) {
- return c.allocateObject(1);
- }
- void traceSubObjects(Collector &c) const;
- SelectElementsNodeListObj(NodeListObj *, NCVector<Pattern> &);
- SelectElementsNodeListObj(NodeListObj *, const ConstPtr<PatternSet> &);
- NodePtr nodeListFirst(EvalContext &, Interpreter &);
- NodeListObj *nodeListRest(EvalContext &, Interpreter &);
- bool contains(EvalContext &, Interpreter &, const NodePtr &);
- private:
- NodeListObj *nodeList_;
- ConstPtr<PatternSet> patterns_;
- };
- #define PRIMITIVE(name, string, nRequired, nOptional, rest, feature) \
- 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 SPRIMITIVE PRIMITIVE
- #define TPRIMITIVE PRIMITIVE
- #define XPRIMITIVE(name, string, nRequired, nOptional, rest) \
- PRIMITIVE(name, string, nRequired, nOptional, rest, noFeature)
- #define XXPRIMITIVE XPRIMITIVE
- #define PRIMITIVE2 XPRIMITIVE
- #include "primitive.h"
- #undef PRIMITIVE
- #undef SPRIMITIVE
- #undef TPRIMITIVE
- #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.lookupCharProperty(*prop)->
- value(c, (argc > 2) ? argv[2] : 0, loc, interp);
- }
- 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], loc);
- 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, loc);
- }
- 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, loc);
- }
- 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,
- loc);
- }
- 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, loc);
- }
- 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,
- loc);
- }
- 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, interp);
- 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, loc);
- }
- 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,
- loc);
- }
- 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(IsNodeListContains, argc, argv, context, interp, loc)
- {
- NodeListObj *nl = argv[0]->asNodeList();
- if (!nl)
- return argError(interp, loc,
- InterpreterMessages::notANodeList, 0, argv[0]);
- NodePtr node;
- if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
- return argError(interp, loc,
- InterpreterMessages::notASingletonNode, 1, argv[1]);
- if (nl->contains(context, interp, node))
- 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, loc);
- }
- 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;
- ELObj *result = interp.convertNumber(StringC(s, n), int(radix));
- if (result) {
- result = result->resolveQuantities(0, interp, loc);
- if (interp.isError(result))
- return result;
- long n;
- double d;
- int dim;
- if (result->quantityValue(n, d, dim) != ELObj::noQuantity)
- return result;
- }
- return interp.makeFalse();
- }
- DEFPRIMITIVE(NumberToString, argc, argv, context, interp, loc)
- {
- double x;
- if (!argv[0]->realValue(x))
- return argError(interp, loc,
- InterpreterMessages::notANumber, 0, argv[0]);
- unsigned radix;
- if (argc > 1) {
- long r;
- if (!argv[1]->exactIntegerValue(r))
- return argError(interp, loc,
- InterpreterMessages::notAnExactInteger, 1, argv[1]);
- switch (r) {
- case 2:
- case 8:
- case 10:
- case 16:
- radix = unsigned(r);
- break;
- default:
- interp.setNextLocation(loc);
- interp.message(InterpreterMessages::invalidRadix);
- radix = 10;
- break;
- }
- }
- else
- radix = 10;
- StrOutputCharStream os;
- argv[0]->print(interp, os, radix);
- StringC tem;
- os.extractString(tem);
- return new (interp) StringObj(tem);
- }
- DEFPRIMITIVE(QuantityToString, argc, argv, context, interp, loc)
- {
- long lResult;
- double dResult;
- int dim;
- if (argv[0]->quantityValue(lResult, dResult, dim) == ELObj::noQuantity)
- return argError(interp, loc,
- InterpreterMessages::notAQuantity, 0, argv[0]);
- unsigned radix;
- if (argc > 1) {
- long r;
- if (!argv[1]->exactIntegerValue(r))
- return argError(interp, loc,
- InterpreterMessages::notAnExactInteger, 1, argv[1]);
- switch (r) {
- case 2:
- case 8:
- case 10:
- case 16:
- radix = unsigned(r);
- break;
- default:
- interp.setNextLocation(loc);
- interp.message(InterpreterMessages::invalidRadix);
- radix = 10;
- break;
- }
- }
- else
- radix = 10;
- StrOutputCharStream os;
- argv[0]->print(interp, os, radix);
- 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();
- }
- static
- bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
- int nKeys, Interpreter &interp, const Location &loc, int *pos);
- // return 1 if obj is a list of numbers of length len.
- static
- bool decodeNumVector(double *res, int len, ELObj *obj)
- {
- ELObj *e = obj;
- PairObj *p;
- for (int i = 0; i < len; i++) {
- p = e->asPair();
- if (!p || !p->car()->realValue(res[i]))
- return 0;
- e = p->cdr();
- }
- return 1;
- }
- static
- bool decodeFuncVector(FunctionObj **res, int len, ELObj *obj)
- {
- ELObj *e = obj;
- PairObj *p;
- for (int i = 0; i < len; i++) {
- p = e->asPair();
- if (!p || !(res[i] = p->car()->asFunction()))
- return 0;
- e = p->cdr();
- }
- return 1;
- }
- DEFPRIMITIVE(ColorSpace, argc, argv, context, interp, loc)
- {
- const Char *s;
- size_t n;
- if (!argv[0]->stringData(s, n))
-