1 // Copyright (c) 1996 James Clark
2 // See the file copying.txt for copying permission.
5 #include "Interpreter.h"
6 #include "InterpreterMessages.h"
7 #include "EvalContext.h"
12 #include "ELObjMessageArg.h"
16 #include "ELObjPropVal.h"
24 #ifdef DSSSL_NAMESPACE
25 namespace DSSSL_NAMESPACE {
28 class DescendantsNodeListObj : public NodeListObj {
30 void *operator new(size_t, Collector &c) {
31 return c.allocateObject(1);
33 DescendantsNodeListObj(const NodePtr &, unsigned = 0);
34 NodePtr nodeListFirst(EvalContext &, Interpreter &);
35 NodeListObj *nodeListRest(EvalContext &, Interpreter &);
36 NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
38 static void advance(NodePtr &, unsigned &);
39 static void chunkAdvance(NodePtr &, unsigned &);
40 // nodes in node list are strictly after this node
45 class SiblingNodeListObj : public NodeListObj {
47 void *operator new(size_t, Collector &c) {
48 return c.allocateObject(1);
50 SiblingNodeListObj(const NodePtr &first, const NodePtr &end);
51 NodePtr nodeListFirst(EvalContext &, Interpreter &);
52 NodeListObj *nodeListRest(EvalContext &, Interpreter &);
53 NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
59 class SelectByClassNodeListObj : public NodeListObj {
61 SelectByClassNodeListObj(NodeListObj *nl, ComponentName::Id);
62 NodePtr nodeListFirst(EvalContext &, Interpreter &);
63 NodeListObj *nodeListRest(EvalContext &, Interpreter &);
64 NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
65 void traceSubObjects(Collector &) const;
67 NodeListObj *nodeList_;
68 ComponentName::Id cls_;
71 class MapNodeListObj : public NodeListObj {
73 class Context : public Resource {
75 Context(const EvalContext &, const Location &);
76 void set(EvalContext &) const;
77 void traceSubObjects(Collector &) const;
81 const ProcessingMode *processingMode_;
82 StyleObj *overridingStyle_;
85 void *operator new(size_t, Collector &c) {
86 return c.allocateObject(1);
88 MapNodeListObj(FunctionObj *func, NodeListObj *nl, const ConstPtr<Context> &, NodeListObj *mapped = 0);
89 NodePtr nodeListFirst(EvalContext &, Interpreter &);
90 NodeListObj *nodeListRest(EvalContext &, Interpreter &);
91 void traceSubObjects(Collector &) const;
94 void mapNext(EvalContext &, Interpreter &);
98 ConstPtr<Context> context_;
101 class SelectElementsNodeListObj : public NodeListObj {
103 struct PatternSet : public Resource, public NCVector<Pattern> { };
104 void *operator new(size_t, Collector &c) {
105 return c.allocateObject(1);
107 SelectElementsNodeListObj(NodeListObj *, NCVector<Pattern> &);
108 SelectElementsNodeListObj(NodeListObj *, const ConstPtr<PatternSet> &);
109 void traceSubObjects(Collector &) const;
110 NodePtr nodeListFirst(EvalContext &, Interpreter &);
111 NodeListObj *nodeListRest(EvalContext &, Interpreter &);
113 NodeListObj *nodeList_;
114 ConstPtr<PatternSet> patterns_;
117 #define PRIMITIVE(name, string, nRequired, nOptional, rest) \
118 class name ## PrimitiveObj : public PrimitiveObj { \
120 static const Signature signature_; \
121 name ## PrimitiveObj() : PrimitiveObj(&signature_) { } \
122 ELObj *primitiveCall(int, ELObj **, EvalContext &, Interpreter &, const Location &); \
124 const Signature name ## PrimitiveObj::signature_ \
125 = { nRequired, nOptional, rest };
127 #define XPRIMITIVE PRIMITIVE
128 #define XXPRIMITIVE PRIMITIVE
129 #define PRIMITIVE2 PRIMITIVE
130 #include "primitive.h"
136 #define DEFPRIMITIVE(name, argc, argv, context, interp, loc) \
137 ELObj *name ## PrimitiveObj \
138 ::primitiveCall(int argc, ELObj **argv, EvalContext &context, Interpreter &interp, \
141 DEFPRIMITIVE(Cons, argc, argv, context, interp, loc)
143 return new (interp) PairObj(argv[0], argv[1]);
146 DEFPRIMITIVE(List, argc, argv, context, interp, loc)
149 return interp.makeNil();
150 PairObj *head = new (interp) PairObj(argv[0], 0);
151 ELObjDynamicRoot protect(interp, head);
152 PairObj *tail = head;
153 for (int i = 1; i < argc; i++) {
154 PairObj *tem = new (interp) PairObj(argv[i], 0);
158 tail->setCdr(interp.makeNil());
162 DEFPRIMITIVE(IsNull, argc, argv, context, interp, loc)
164 if (argv[0]->isNil())
165 return interp.makeTrue();
167 return interp.makeFalse();
170 DEFPRIMITIVE(IsList, argc, argv, context, interp, loc)
172 ELObj *obj = argv[0];
174 PairObj *pair = obj->asPair();
177 else if (obj->isNil())
178 return interp.makeTrue();
182 return interp.makeFalse();
185 DEFPRIMITIVE(IsEqual, argc, argv, context, interp, loc)
187 if (ELObj::equal(*argv[0], *argv[1]))
188 return interp.makeTrue();
190 return interp.makeFalse();
193 DEFPRIMITIVE(IsEqv, argc, argv, context, interp, loc)
195 if (ELObj::eqv(*argv[0], *argv[1]))
196 return interp.makeTrue();
198 return interp.makeFalse();
201 DEFPRIMITIVE(Car, argc, argv, context, interp, loc)
203 PairObj *pair = argv[0]->asPair();
205 return argError(interp, loc,
206 InterpreterMessages::notAPair, 0, argv[0]);
211 DEFPRIMITIVE(Cdr, argc, argv, context, interp, loc)
213 PairObj *pair = argv[0]->asPair();
215 return argError(interp, loc,
216 InterpreterMessages::notAPair, 0, argv[0]);
221 DEFPRIMITIVE(Append, argc, argv, context, interp, loc)
224 return interp.makeNil();
225 PairObj *tail = interp.makePair(0, 0);
226 PairObj *head = tail;
227 ELObjDynamicRoot protect(interp, head);
228 for (int i = 0; i < argc - 1; i++) {
229 for (ELObj *p = argv[i]; !p->isNil();) {
230 PairObj *tem = p->asPair();
232 return argError(interp, loc,
233 InterpreterMessages::notAList, i, p);
234 PairObj *newTail = new (interp) PairObj(tem->car(), 0);
235 tail->setCdr(newTail);
240 tail->setCdr(argv[argc - 1]);
244 DEFPRIMITIVE(Reverse, argc, argv, context, interp, loc)
246 ELObjDynamicRoot protect(interp, interp.makeNil());
248 while (!p->isNil()) {
249 PairObj *tem = p->asPair();
251 return argError(interp, loc,
252 InterpreterMessages::notAList, 0, argv[0]);
253 protect = new (interp) PairObj(tem->car(), protect);
259 DEFPRIMITIVE(ListTail, argc, argv, context, interp, loc)
262 if (!argv[1]->exactIntegerValue(k))
263 return argError(interp, loc,
264 InterpreterMessages::notAnExactInteger, 1, argv[1]);
266 interp.setNextLocation(loc);
267 interp.message(InterpreterMessages::outOfRange);
268 return interp.makeError();
272 PairObj *tem = p->asPair();
275 interp.setNextLocation(loc);
276 interp.message(InterpreterMessages::outOfRange);
277 return interp.makeError();
280 return argError(interp, loc,
281 InterpreterMessages::notAList, 0, argv[0]);
288 DEFPRIMITIVE(ListRef, argc, argv, context, interp, loc)
291 if (!argv[1]->exactIntegerValue(k))
292 return argError(interp, loc,
293 InterpreterMessages::notAnExactInteger, 1, argv[1]);
295 interp.setNextLocation(loc);
296 interp.message(InterpreterMessages::outOfRange);
297 return interp.makeError();
301 PairObj *tem = p->asPair();
310 interp.setNextLocation(loc);
311 interp.message(InterpreterMessages::outOfRange);
312 return interp.makeError();
315 return argError(interp, loc,
316 InterpreterMessages::notAList, 0, argv[0]);
319 DEFPRIMITIVE(Member, argc, argv, context, interp, loc)
322 while (!p->isNil()) {
323 PairObj *tem = p->asPair();
325 return argError(interp, loc,
326 InterpreterMessages::notAList, 1, argv[1]);
327 if (ELObj::equal(*argv[0], *tem->car()))
331 return interp.makeFalse();
334 DEFPRIMITIVE(Memv, argc, argv, context, interp, loc)
337 while (!p->isNil()) {
338 PairObj *tem = p->asPair();
340 return argError(interp, loc,
341 InterpreterMessages::notAList, 1, argv[1]);
342 if (ELObj::eqv(*argv[0], *tem->car()))
346 return interp.makeFalse();
349 DEFPRIMITIVE(Length, argc, argv, context, interp, loc)
351 ELObj *obj = argv[0];
354 PairObj *pair = obj->asPair();
359 else if (obj->isNil())
361 else if (interp.isError(obj))
364 return argError(interp, loc,
365 InterpreterMessages::notAList, 0, obj);
367 return interp.makeInteger(n);
370 DEFPRIMITIVE(Not, argc, argv, context, interp, loc)
372 if (argv[0]->isTrue())
373 return interp.makeFalse();
375 return interp.makeTrue();
378 DEFPRIMITIVE(IsSymbol, argc, argv, context, interp, loc)
380 if (argv[0]->asSymbol())
381 return interp.makeTrue();
383 return interp.makeFalse();
386 DEFPRIMITIVE(IsKeyword, argc, argv, context, interp, loc)
388 if (argv[0]->asKeyword())
389 return interp.makeTrue();
391 return interp.makeFalse();
394 DEFPRIMITIVE(IsInteger, argc, argv, context, interp, loc)
397 if (argv[0]->exactIntegerValue(n))
398 return interp.makeTrue();
400 if (argv[0]->realValue(x) && modf(x, &x) == 0.0)
401 return interp.makeTrue();
403 return interp.makeFalse();
406 DEFPRIMITIVE(IsReal, argc, argv, context, interp, loc)
409 if (argv[0]->realValue(x))
410 return interp.makeTrue();
412 return interp.makeFalse();
415 DEFPRIMITIVE(IsNumber, argc, argv, context, interp, loc)
418 if (argv[0]->realValue(x))
419 return interp.makeTrue();
421 return interp.makeFalse();
424 DEFPRIMITIVE(IsQuantity, argc, argv, context, interp, loc)
429 if (argv[0]->quantityValue(n, d, dim) != ELObj::noQuantity)
430 return interp.makeTrue();
432 return interp.makeFalse();
435 DEFPRIMITIVE(IsPair, argc, argv, context, interp, loc)
437 if (argv[0]->asPair())
438 return interp.makeTrue();
440 return interp.makeFalse();
443 DEFPRIMITIVE(IsProcedure, argc, argv, context, interp, loc)
445 if (argv[0]->asFunction())
446 return interp.makeTrue();
448 return interp.makeFalse();
451 DEFPRIMITIVE(IsBoolean, argc, argv, context, interp, loc)
453 if (argv[0] == interp.makeTrue())
455 else if (argv[0] == interp.makeFalse())
456 return interp.makeTrue();
458 return interp.makeFalse();
461 DEFPRIMITIVE(IsChar, argc, argv, context, interp, loc)
464 if (argv[0]->charValue(c))
465 return interp.makeTrue();
467 return interp.makeFalse();
470 DEFPRIMITIVE(IsCharEqual, argc, argv, context, interp, loc)
473 if (!argv[0]->charValue(c1))
474 return argError(interp, loc,
475 InterpreterMessages::notAChar, 0, argv[0]);
476 if (!argv[1]->charValue(c2))
477 return argError(interp, loc,
478 InterpreterMessages::notAChar, 1, argv[1]);
480 return interp.makeTrue();
482 return interp.makeFalse();
485 DEFPRIMITIVE(String, argc, argv, context, interp, loc)
487 StringObj *obj = new (interp) StringObj;
488 for (int i = 0; i < argc; i++) {
490 if (!argv[i]->charValue(c))
491 return argError(interp, loc,
492 InterpreterMessages::notAChar, i, argv[i]);
498 DEFPRIMITIVE(SymbolToString, argc, argv, context, interp, loc)
500 SymbolObj *obj = argv[0]->asSymbol();
502 return argError(interp, loc,
503 InterpreterMessages::notASymbol, 0, argv[0]);
507 DEFPRIMITIVE(StringToSymbol, argc, argv, context, interp, loc)
511 if (!argv[0]->stringData(s, n))
512 return argError(interp, loc,
513 InterpreterMessages::notAString, 0, argv[0]);
514 return interp.makeSymbol(StringC(s, n));
517 DEFPRIMITIVE(IsString, argc, argv, context, interp, loc)
521 if (argv[0]->stringData(s, n))
522 return interp.makeTrue();
524 return interp.makeFalse();
527 DEFPRIMITIVE(StringLength, argc, argv, context, interp, loc)
531 if (!argv[0]->stringData(s, n))
532 return argError(interp, loc,
533 InterpreterMessages::notAString, 0, argv[0]);
534 return interp.makeInteger(n);
537 DEFPRIMITIVE(IsStringEqual, argc, argv, context, interp, loc)
541 if (!argv[0]->stringData(s1, n1))
542 return argError(interp, loc,
543 InterpreterMessages::notAString, 0, argv[0]);
544 if (!argv[1]->stringData(s2, n2))
545 return argError(interp, loc,
546 InterpreterMessages::notAString, 1, argv[1]);
548 && (n1 == 0 || memcmp(s1, s2, n1*sizeof(Char)) == 0))
549 return interp.makeTrue();
551 return interp.makeFalse();
554 DEFPRIMITIVE(StringAppend, argc, argv, context, interp, loc)
556 StringObj *result = new (interp) StringObj;
557 for (int i = 0; i < argc; i++) {
560 if (!argv[i]->stringData(s, n))
561 return argError(interp, loc,
562 InterpreterMessages::notAString, i,
564 result->append(s, n);
569 DEFPRIMITIVE(StringRef, argc, argv, context, interp, loc)
573 if (!argv[0]->stringData(s, n))
574 return argError(interp, loc,
575 InterpreterMessages::notAString, 0, argv[0]);
577 if (!argv[1]->exactIntegerValue(k))
578 return argError(interp, loc,
579 InterpreterMessages::notAnExactInteger, 1, argv[1]);
580 if (k < 0 || (unsigned long)k >= n) {
581 interp.setNextLocation(loc);
582 interp.message(InterpreterMessages::outOfRange);
583 return interp.makeError();
585 return interp.makeChar(s[size_t(k)]);
588 DEFPRIMITIVE(Substring, argc, argv, context, interp, loc)
592 if (!argv[0]->stringData(s, n))
593 return argError(interp, loc,
594 InterpreterMessages::notAString, 0, argv[0]);
596 if (!argv[1]->exactIntegerValue(start))
597 return argError(interp, loc,
598 InterpreterMessages::notAnExactInteger, 1, argv[1]);
600 if (!argv[2]->exactIntegerValue(end))
601 return argError(interp, loc,
602 InterpreterMessages::notAnExactInteger, 2, argv[2]);
603 if (start < 0 || (unsigned long)end > n || start > end) {
604 interp.setNextLocation(loc);
605 interp.message(InterpreterMessages::outOfRange);
606 return interp.makeError();
608 return new (interp) StringObj(s + size_t(start), size_t(end - start));
611 DEFPRIMITIVE(Equal, argc, argv, context, interp, loc)
614 return interp.makeTrue();
619 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
620 case ELObj::noQuantity:
621 return argError(interp, loc,
622 InterpreterMessages::notAQuantity, 0, argv[0]);
623 case ELObj::longQuantity:
625 case ELObj::doubleQuantity:
634 for (; i < argc; i++) {
635 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
636 case ELObj::noQuantity:
637 return argError(interp, loc,
638 InterpreterMessages::notAQuantity, i, argv[i]);
639 case ELObj::longQuantity:
640 if (lResult2 != lResult || dim2 != dim)
641 return interp.makeFalse();
643 case ELObj::doubleQuantity:
645 if (dResult2 != dResult || dim2 != dim)
646 return interp.makeFalse();
653 return interp.makeTrue();
655 for (; i < argc; i++) {
656 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
657 case ELObj::noQuantity:
658 return argError(interp, loc,
659 InterpreterMessages::notAQuantity, i, argv[i]);
660 case ELObj::longQuantity:
661 if (lResult2 != dResult || dim2 != dim)
662 return interp.makeFalse();
664 case ELObj::doubleQuantity:
665 if (dResult2 != dResult || dim2 != dim)
666 return interp.makeFalse();
670 return interp.makeTrue();
673 DEFPRIMITIVE(Plus, argc, argv, context, interp, loc)
676 return interp.makeInteger(0);
682 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
683 case ELObj::noQuantity:
687 case ELObj::longQuantity:
690 case ELObj::doubleQuantity:
696 for (int i = 1; !spec && i < argc; i++) {
700 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
701 case ELObj::noQuantity:
702 // FIXME shouldn't quantityValue set dim to 1 for length-specs ?
706 case ELObj::longQuantity:
709 if (lResult >= LONG_MIN - lResult2) {
715 if (lResult <= LONG_MAX - lResult2) {
721 dResult = double(lResult);
723 dResult += double(lResult2);
725 case ELObj::doubleQuantity:
736 interp.setNextLocation(loc);
737 interp.message(InterpreterMessages::incompatibleDimensions);
738 return interp.makeError();
744 for (int i = 0; i < argc; i++) {
745 const LengthSpec *lsp = argv[i]->lengthSpec();
749 switch (argv[i]->quantityValue(lResult, dResult, dim)) {
750 case ELObj::noQuantity:
751 return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
753 case ELObj::longQuantity:
756 case ELObj::doubleQuantity:
758 interp.setNextLocation(loc);
759 interp.message(InterpreterMessages::incompatibleDimensions);
760 return interp.makeError();
767 return new (interp) LengthSpecObj(ls);
772 return interp.makeInteger(lResult);
774 return new (interp) LengthObj(lResult);
779 return new (interp) RealObj(dResult);
781 return new (interp) QuantityObj(dResult, dim);
784 DEFPRIMITIVE(Minus, argc, argv, context, interp, loc)
791 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
792 case ELObj::noQuantity:
795 case ELObj::longQuantity:
798 case ELObj::doubleQuantity:
811 for (int i = 1; !spec && i < argc; i++) {
815 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
816 case ELObj::noQuantity:
820 case ELObj::longQuantity:
823 if (lResult >= LONG_MIN + lResult2) {
829 if (lResult <= LONG_MAX + lResult2) {
835 dResult = double(lResult);
837 dResult -= double(lResult2);
839 case ELObj::doubleQuantity:
850 interp.setNextLocation(loc);
851 interp.message(InterpreterMessages::incompatibleDimensions);
852 return interp.makeError();
859 for (int i = 0; i < argc; i++) {
860 const LengthSpec *lsp = argv[i]->lengthSpec();
862 if (i > 0 || argc == 1)
868 switch (argv[i]->quantityValue(lResult, dResult, dim)) {
869 case ELObj::noQuantity:
870 return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
872 case ELObj::longQuantity:
875 case ELObj::doubleQuantity:
877 interp.setNextLocation(loc);
878 interp.message(InterpreterMessages::incompatibleDimensions);
879 return interp.makeError();
881 if (i > 0 || argc == 1)
889 return new (interp) LengthSpecObj(ls);
894 return interp.makeInteger(lResult);
896 return new (interp) LengthObj(lResult);
901 return new (interp) RealObj(dResult);
903 return new (interp) QuantityObj(dResult, dim);
906 DEFPRIMITIVE(Multiply, argc, argv, context, interp, loc)
909 return interp.makeInteger(1);
914 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
915 case ELObj::noQuantity:
917 const LengthSpec *ls = argv[0]->lengthSpec();
919 LengthSpec result(*ls);
921 for (; i < argc; i++) {
922 if (!argv[i]->realValue(d))
923 return argError(interp, loc,
924 InterpreterMessages::notANumber, 1, argv[1]);
927 return new (interp) LengthSpecObj(result);
930 return argError(interp, loc,
931 InterpreterMessages::notAQuantity, 0, argv[0]);
932 case ELObj::longQuantity:
934 case ELObj::doubleQuantity:
942 for (; i < argc; i++) {
943 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
944 case ELObj::noQuantity:
945 return argError(interp, loc,
946 InterpreterMessages::notAQuantity, i, argv[i]);
947 case ELObj::longQuantity:
953 ? lResult > -(unsigned)LONG_MIN / -(unsigned)lResult2
954 : -(unsigned)lResult > LONG_MAX / -(unsigned)lResult2)
956 ? lResult > LONG_MAX / lResult2
957 : -(unsigned)lResult > -(unsigned)LONG_MIN / lResult2)))) {
958 dResult = double(lResult) * lResult2;
964 case ELObj::doubleQuantity:
966 dResult = lResult * dResult2;
974 return interp.makeInteger(lResult);
976 return new (interp) LengthObj(lResult);
978 for (; i < argc; i++) {
979 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
980 case ELObj::noQuantity:
981 return argError(interp, loc,
982 InterpreterMessages::notAQuantity, i, argv[i]);
983 case ELObj::longQuantity:
986 case ELObj::doubleQuantity:
993 return new (interp) RealObj(dResult);
995 return new (interp) QuantityObj(dResult, dim);
998 DEFPRIMITIVE(Divide, argc, argv, context, interp, loc)
1004 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1005 case ELObj::noQuantity:
1006 return argError(interp, loc,
1007 InterpreterMessages::notAQuantity, 0, argv[0]);
1008 case ELObj::longQuantity:
1011 dResult = 1.0/lResult;
1013 case ELObj::doubleQuantity:
1016 dResult = 1.0/dResult;
1025 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1026 case ELObj::noQuantity:
1028 const LengthSpec *ls = argv[0]->lengthSpec();
1030 LengthSpec result(*ls);
1032 for (; i < argc; i++) {
1033 if (!argv[i]->realValue(d))
1034 return argError(interp, loc,
1035 InterpreterMessages::notANumber, 1, argv[1]);
1040 return new (interp) LengthSpecObj(result);
1043 return argError(interp, loc,
1044 InterpreterMessages::notAQuantity, 0, argv[0]);
1045 case ELObj::longQuantity:
1047 case ELObj::doubleQuantity:
1055 for (; i < argc; i++) {
1056 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1057 case ELObj::noQuantity:
1058 return argError(interp, loc,
1059 InterpreterMessages::notAQuantity, 0, argv[0]);
1060 case ELObj::longQuantity:
1064 // If dim and dim2 are both 1, must goto useDouble:
1065 // since lengths are inexact, result must be inexact.
1066 if (dim2 == 0 && lResult % lResult2 == 0) {
1067 lResult /= lResult2;
1070 dResult = double(lResult)/lResult2;
1073 case ELObj::doubleQuantity:
1076 if (dResult2 == 0.0)
1078 dResult /= dResult2;
1086 return interp.makeInteger(lResult);
1088 return new (interp) LengthObj(lResult);
1090 for (; i < argc; i++) {
1091 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1092 case ELObj::noQuantity:
1093 return argError(interp, loc,
1094 InterpreterMessages::notAQuantity, i, argv[i]);
1095 case ELObj::longQuantity:
1098 dResult /= lResult2;
1100 case ELObj::doubleQuantity:
1101 dResult /= dResult2;
1102 if (dResult2 == 0.0)
1110 return new (interp) RealObj(dResult);
1112 return new (interp) QuantityObj(dResult, dim);
1114 interp.setNextLocation(loc);
1115 interp.message(InterpreterMessages::divideBy0);
1116 return interp.makeError();
1119 DEFPRIMITIVE(Quotient, argc, argv, context, interp, loc)
1123 if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
1125 interp.setNextLocation(loc);
1126 interp.message(InterpreterMessages::divideBy0);
1127 return interp.makeError();
1129 // This isn't strictly portable.
1130 return interp.makeInteger(n1 / n2);
1133 if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
1134 return argError(interp, loc,
1135 InterpreterMessages::notAnExactInteger, 0, argv[0]);
1137 if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
1138 return argError(interp, loc,
1139 InterpreterMessages::notAnExactInteger, 1, argv[1]);
1141 interp.setNextLocation(loc);
1142 interp.message(InterpreterMessages::divideBy0);
1143 return interp.makeError();
1145 return new (interp) RealObj((d1 - fmod(d1, d2))/d2);
1148 DEFPRIMITIVE(Remainder, argc, argv, context, interp, loc)
1152 if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
1154 interp.setNextLocation(loc);
1155 interp.message(InterpreterMessages::divideBy0);
1156 return interp.makeError();
1158 // This isn't strictly portable.
1159 return interp.makeInteger(n1 % n2);
1162 if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
1163 return argError(interp, loc,
1164 InterpreterMessages::notAnExactInteger, 0, argv[0]);
1166 if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
1167 return argError(interp, loc,
1168 InterpreterMessages::notAnExactInteger, 1, argv[1]);
1170 interp.setNextLocation(loc);
1171 interp.message(InterpreterMessages::divideBy0);
1172 return interp.makeError();
1174 return new (interp) RealObj(fmod(d1, d2));
1177 DEFPRIMITIVE(Modulo, argc, argv, context, interp, loc)
1181 if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
1183 interp.setNextLocation(loc);
1184 interp.message(InterpreterMessages::divideBy0);
1185 return interp.makeError();
1188 if (n2 > 0 ? r < 0 : r > 0)
1190 return interp.makeInteger(r);
1193 if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
1194 return argError(interp, loc,
1195 InterpreterMessages::notAnExactInteger, 0, argv[0]);
1197 if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
1198 return argError(interp, loc,
1199 InterpreterMessages::notAnExactInteger, 1, argv[1]);
1201 interp.setNextLocation(loc);
1202 interp.message(InterpreterMessages::divideBy0);
1203 return interp.makeError();
1205 double r = fmod(d1, d2);
1206 if (d2 > 0 ? r < 0 : r > 0)
1208 return new (interp) RealObj(r);
1211 #define DEFCOMPARE(NAME, OP) \
1212 DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
1215 return interp.makeTrue(); \
1219 bool lastWasDouble; \
1220 switch (argv[0]->quantityValue(lResult, dResult, dim)) { \
1221 case ELObj::noQuantity: \
1222 return argError(interp, loc, \
1223 InterpreterMessages::notAQuantity, 0, argv[0]); \
1224 case ELObj::longQuantity: \
1225 lastWasDouble = 0; \
1227 case ELObj::doubleQuantity: \
1228 lastWasDouble = 1; \
1233 for (int i = 1; i < argc; i++) { \
1237 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) { \
1238 case ELObj::noQuantity: \
1239 return argError(interp, loc, \
1240 InterpreterMessages::notAQuantity, i, argv[i]); \
1241 case ELObj::longQuantity: \
1244 if (!(lastWasDouble \
1245 ? (dResult OP lResult2) \
1246 : (lResult OP lResult2))) \
1247 return interp.makeFalse(); \
1248 lResult = lResult2; \
1249 lastWasDouble = 0; \
1251 case ELObj::doubleQuantity: \
1254 if (!(lastWasDouble \
1255 ? (dResult OP dResult2) \
1256 : (lResult OP dResult2))) \
1257 return interp.makeFalse(); \
1258 dResult = dResult2; \
1259 lastWasDouble = 1; \
1263 return interp.makeTrue(); \
1265 interp.setNextLocation(loc); \
1266 interp.message(InterpreterMessages::incompatibleDimensions); \
1267 return interp.makeError(); \
1271 DEFCOMPARE(Greater, >)
1272 DEFCOMPARE(LessEqual, <=)
1273 DEFCOMPARE(GreaterEqual, >=)
1275 DEFPRIMITIVE(Min, argc, argv, context, interp, loc)
1281 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1282 case ELObj::noQuantity:
1283 return argError(interp, loc,
1284 InterpreterMessages::notAQuantity, 0, argv[0]);
1285 case ELObj::longQuantity:
1287 case ELObj::doubleQuantity:
1292 // Note that result is inexact if any of the arguments are
1293 for (; i < argc; i++) {
1297 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1298 case ELObj::noQuantity:
1299 return argError(interp, loc,
1300 InterpreterMessages::notAQuantity, i, argv[i]);
1301 case ELObj::longQuantity:
1304 if (lResult2 < lResult)
1307 case ELObj::doubleQuantity:
1310 if (dResult2 < lResult)
1321 return interp.makeInteger(lResult);
1323 return new (interp) LengthObj(lResult);
1325 for (; i < argc; i++) {
1329 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1330 case ELObj::noQuantity:
1331 return argError(interp, loc,
1332 InterpreterMessages::notAQuantity, i, argv[i]);
1333 case ELObj::longQuantity:
1336 if (lResult2 < dResult)
1339 case ELObj::doubleQuantity:
1342 if (dResult2 < dResult)
1348 return new (interp) RealObj(dResult);
1350 return new (interp) QuantityObj(dResult, dim);
1352 interp.setNextLocation(loc);
1353 interp.message(InterpreterMessages::incompatibleDimensions);
1354 return interp.makeError();
1357 DEFPRIMITIVE(Max, argc, argv, context, interp, loc)
1363 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1364 case ELObj::noQuantity:
1365 return argError(interp, loc,
1366 InterpreterMessages::notAQuantity, 0, argv[0]);
1367 case ELObj::longQuantity:
1369 case ELObj::doubleQuantity:
1374 // Note that result is inexact if any of the arguments are
1375 for (; i < argc; i++) {
1379 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1380 case ELObj::noQuantity:
1381 return argError(interp, loc,
1382 InterpreterMessages::notAQuantity, i, argv[i]);
1383 case ELObj::longQuantity:
1386 if (lResult2 > lResult)
1389 case ELObj::doubleQuantity:
1392 if (dResult2 > lResult)
1403 return interp.makeInteger(lResult);
1405 return new (interp) LengthObj(lResult);
1407 for (; i < argc; i++) {
1411 switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
1412 case ELObj::noQuantity:
1413 return argError(interp, loc,
1414 InterpreterMessages::notAQuantity, i, argv[i]);
1415 case ELObj::longQuantity:
1418 if (lResult2 > dResult)
1421 case ELObj::doubleQuantity:
1424 if (dResult2 > dResult)
1430 return new (interp) RealObj(dResult);
1432 return new (interp) QuantityObj(dResult, dim);
1434 interp.setNextLocation(loc);
1435 interp.message(InterpreterMessages::incompatibleDimensions);
1436 return interp.makeError();
1439 DEFPRIMITIVE(Floor, argc, argv, context, interp, loc)
1442 if (argv[0]->inexactRealValue(d))
1443 return new (interp) RealObj(floor(d));
1445 if (argv[0]->exactIntegerValue(n))
1447 return argError(interp, loc,
1448 InterpreterMessages::notANumber, 0, argv[0]);
1451 DEFPRIMITIVE(Ceiling, argc, argv, context, interp, loc)
1454 if (argv[0]->inexactRealValue(d))
1455 return new (interp) RealObj(ceil(d));
1457 if (argv[0]->exactIntegerValue(n))
1459 return argError(interp, loc,
1460 InterpreterMessages::notANumber, 0, argv[0]);
1463 DEFPRIMITIVE(Round, argc, argv, context, interp, loc)
1466 if (argv[0]->inexactRealValue(d)) {
1467 double result = floor(d + .5);
1468 // That rounded it upwards.
1469 // Now figure out if that was different from round to
1471 if (result - d == 0.5 && fmod(result, 2.0) != 0)
1473 return new (interp) RealObj(result);
1476 if (argv[0]->exactIntegerValue(n))
1478 return argError(interp, loc,
1479 InterpreterMessages::notANumber, 0, argv[0]);
1482 DEFPRIMITIVE(Truncate, argc, argv, context, interp, loc)
1485 if (argv[0]->inexactRealValue(d)) {
1488 return new (interp) RealObj(iPart);
1491 if (argv[0]->exactIntegerValue(n))
1493 return argError(interp, loc,
1494 InterpreterMessages::notANumber, 0, argv[0]);
1497 DEFPRIMITIVE(Abs, argc, argv, context, interp, loc)
1502 switch (argv[0]->quantityValue(lResult, dResult, dim)) {
1503 case ELObj::noQuantity:
1504 return argError(interp, loc,
1505 InterpreterMessages::notAQuantity, 0, argv[0]);
1506 case ELObj::longQuantity:
1507 if (lResult != LONG_MIN) {
1511 return interp.makeInteger(-lResult);
1513 return new (interp) LengthObj(-lResult);
1517 case ELObj::doubleQuantity:
1525 return new (interp) RealObj(-dResult);
1527 return new (interp) QuantityObj(-dResult, dim);
1530 DEFPRIMITIVE(Sqrt, argc, argv, context, interp, loc)
1535 ELObj::QuantityType type
1536 = argv[0]->quantityValue(lResult, dResult, dim);
1538 case ELObj::noQuantity:
1539 return argError(interp, loc,
1540 InterpreterMessages::notAQuantity, 0, argv[0]);
1541 case ELObj::longQuantity:
1544 case ELObj::doubleQuantity:
1549 if ((dim & 1) || dResult < 0.0) {
1550 interp.setNextLocation(loc);
1551 interp.message(InterpreterMessages::outOfRange);
1552 return interp.makeError();
1555 dResult = sqrt(dResult);
1556 if (type == ELObj::longQuantity && dim == 0) {
1557 long n = long(dResult);
1559 return interp.makeInteger(n);
1561 return new (interp) QuantityObj(dResult, dim);
1564 DEFPRIMITIVE(Time, argc, argv, context, interp, loc)
1566 // This assumes a Posix compatible time().
1568 return interp.makeInteger(long(t));
1571 DEFPRIMITIVE(TimeToString, argc, argv, context, interp, loc)
1574 if (!argv[0]->exactIntegerValue(k))
1575 return argError(interp, loc,
1576 InterpreterMessages::notAnExactInteger, 0, argv[0]);
1577 time_t t = time_t(k);
1579 if (argc > 1 && argv[1] != interp.makeFalse())
1584 sprintf(buf, "%04d-%02d-%02dT%02d:%02d:%02d",
1585 p->tm_year + 1900, p->tm_mon + 1, p->tm_mday,
1586 p->tm_hour, p->tm_min, p->tm_sec);
1587 return new (interp) StringObj(interp.makeStringC(buf));
1590 DEFPRIMITIVE(CharProperty, argc, argv, context, interp, loc)
1592 SymbolObj *sym = argv[0]->asSymbol();
1594 return argError(interp, loc,
1595 InterpreterMessages::notASymbol, 0, argv[0]);
1596 StringObj *prop = argv[0]->asSymbol()->convertToString();
1598 if (!argv[1]->charValue(c))
1599 return argError(interp, loc,
1600 InterpreterMessages::notAChar, 1, argv[1]);
1601 return interp.charProperty(*prop, c, loc, (argc > 2) ? argv[2] : 0);
1604 DEFPRIMITIVE(Literal, argc, argv, context, interp, loc)
1607 return new (interp) EmptySosofoObj;
1610 if (!argv[0]->stringData(s, n))
1611 return argError(interp, loc, InterpreterMessages::notAString,
1614 return new (interp) LiteralSosofoObj(argv[0]);
1615 StringObj *strObj = new (interp) StringObj(s, n);
1616 for (int i = 1; i < argc; i++) {
1617 if (!argv[i]->stringData(s, n))
1618 return argError(interp, loc, InterpreterMessages::notAString,
1620 strObj->append(s, n);
1622 ELObjDynamicRoot protect(interp, strObj);
1623 return new (interp) LiteralSosofoObj(strObj);
1626 DEFPRIMITIVE(ProcessChildren, argc, argv, context, interp, loc)
1628 if (!context.processingMode) {
1629 interp.setNextLocation(loc);
1630 interp.message(InterpreterMessages::noCurrentProcessingMode);
1631 return interp.makeError();
1633 return new (interp) ProcessChildrenSosofoObj(context.processingMode);
1636 DEFPRIMITIVE(ProcessChildrenTrim, argc, argv, context, interp, loc)
1638 if (!context.processingMode) {
1639 interp.setNextLocation(loc);
1640 interp.message(InterpreterMessages::noCurrentProcessingMode);
1641 return interp.makeError();
1643 return new (interp) ProcessChildrenTrimSosofoObj(context.processingMode);
1646 DEFPRIMITIVE(SosofoAppend, argc, argv, context, interp, loc)
1648 /* Optimize the case where there is no or only
1651 return new (interp) EmptySosofoObj;
1652 else if (argc == 1) {
1653 SosofoObj *sosofo = argv[0]->asSosofo();
1655 return argError(interp, loc, InterpreterMessages::notASosofo,
1660 /* Don't create another object if the first argument is
1661 already an AppendSosofoObj, this handles gracefully
1663 (let loop ( (res (empty-sosofo))
1664 (nl (node-list-rest (children (current-node)))))
1665 (loop (sosofo-append res (process-node-list (node-list-first nl)))
1666 (node-list-rest nl)))
1668 AppendSosofoObj *obj;
1670 if ( argv[i]->asAppendSosofo() )
1671 obj = argv[i++]->asAppendSosofo();
1673 obj = new (interp) AppendSosofoObj;
1675 for ( ; i < argc; i++) {
1676 SosofoObj *sosofo = argv[i]->asSosofo();
1678 return argError(interp, loc, InterpreterMessages::notASosofo,
1680 obj->append(sosofo);
1685 DEFPRIMITIVE(NextMatch, argc, argv, context, interp, loc)
1687 if (!context.processingMode) {
1688 interp.setNextLocation(loc);
1689 interp.message(InterpreterMessages::noCurrentProcessingMode);
1690 return interp.makeError();
1696 style = argv[0]->asStyle();
1698 return argError(interp, loc, InterpreterMessages::notAStyle, 0, argv[0]);
1700 return new (interp) NextMatchSosofoObj(style);
1703 DEFPRIMITIVE(EmptySosofo, argc, argv, context, interp, loc)
1705 return new (interp) EmptySosofoObj;
1708 DEFPRIMITIVE(SosofoLabel, argc, argv, context, interp, loc)
1710 SosofoObj *sosofo = argv[0]->asSosofo();
1712 return argError(interp, loc, InterpreterMessages::notASosofo,
1715 SymbolObj *sym = argv[1]->asSymbol();
1717 return argError(interp, loc,
1718 InterpreterMessages::notASymbol, 1, argv[1]);
1719 return new (interp) LabelSosofoObj(sym, loc, sosofo);
1722 DEFPRIMITIVE(SosofoDiscardLabeled, argc, argv, context, interp, loc)
1724 SosofoObj *sosofo = argv[0]->asSosofo();
1726 return argError(interp, loc, InterpreterMessages::notASosofo,
1729 SymbolObj *sym = argv[1]->asSymbol();
1731 return argError(interp, loc,
1732 InterpreterMessages::notASymbol, 1, argv[1]);
1733 return new (interp) DiscardLabeledSosofoObj(sym, sosofo);
1736 DEFPRIMITIVE(IsSosofo, argc, argv, context, interp, loc)
1738 if (argv[0]->asSosofo())
1739 return interp.makeTrue();
1741 return interp.makeFalse();
1744 DEFPRIMITIVE(MergeStyle, argc, argv, context, interp, loc)
1746 MergeStyleObj *merged = new (interp) MergeStyleObj;
1747 for (int i = 0; i < argc; i++) {
1748 StyleObj *style = argv[i]->asStyle();
1750 return argError(interp, loc,
1751 InterpreterMessages::notAStyle, i, argv[i]);
1752 merged->append(style);
1757 DEFPRIMITIVE(IsStyle, argc, argv, context, interp, loc)
1759 if (argv[0]->asStyle())
1760 return interp.makeTrue();
1762 return interp.makeFalse();
1765 DEFPRIMITIVE(CurrentNodePageNumberSosofo, argc, argv, context, interp, loc)
1767 if (!context.currentNode)
1768 return noCurrentNodeError(interp, loc);
1769 return new (interp) CurrentNodePageNumberSosofoObj(context.currentNode);
1772 DEFPRIMITIVE(PageNumberSosofo, argc, argv, context, interp, loc)
1774 return new (interp) PageNumberSosofoObj;
1777 DEFPRIMITIVE(ProcessElementWithId, argc, argv, context, interp, loc)
1781 if (!argv[0]->stringData(s, n))
1782 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
1783 if (!context.currentNode)
1784 return noCurrentNodeError(interp, loc);
1785 if (!context.processingMode) {
1786 interp.setNextLocation(loc);
1787 interp.message(InterpreterMessages::noCurrentProcessingMode);
1788 return interp.makeError();
1791 NamedNodeListPtr elements;
1792 if (context.currentNode->getGroveRoot(root) == accessOK
1793 && root->getElements(elements) == accessOK) {
1795 if (elements->namedNode(GroveString(s, n), node) == accessOK)
1796 return new (interp) ProcessNodeSosofoObj(node, context.processingMode);
1798 return new (interp) EmptySosofoObj;
1801 DEFPRIMITIVE(ProcessFirstDescendant, argc, argv, context, interp, loc)
1803 if (!context.processingMode) {
1804 interp.setNextLocation(loc);
1805 interp.message(InterpreterMessages::noCurrentProcessingMode);
1806 return interp.makeError();
1808 if (!context.currentNode)
1809 return noCurrentNodeError(interp, loc);
1811 NCVector<Pattern> patterns(argc);
1812 for (size_t i = 0; i < argc; i++) {
1813 if (!interp.convertToPattern(argv[i], loc, patterns[i]))
1814 return interp.makeError();
1816 NodeListObj *nl = new (interp) DescendantsNodeListObj(context.currentNode);
1817 ELObjDynamicRoot protect(interp, nl);
1818 nl = new (interp) SelectElementsNodeListObj(nl, patterns);
1820 NodePtr nd(nl->nodeListFirst(context, interp));
1822 return new (interp) EmptySosofoObj;
1823 return new (interp) ProcessNodeSosofoObj(nd, context.processingMode);
1826 DEFPRIMITIVE(ProcessMatchingChildren, argc, argv, context, interp, loc)
1828 if (!context.processingMode) {
1829 interp.setNextLocation(loc);
1830 interp.message(InterpreterMessages::noCurrentProcessingMode);
1831 return interp.makeError();
1833 if (!context.currentNode)
1834 return noCurrentNodeError(interp, loc);
1835 NCVector<Pattern> patterns(argc);
1836 for (size_t i = 0; i < argc; i++) {
1837 if (!interp.convertToPattern(argv[i], loc, patterns[i]))
1838 return interp.makeError();
1841 // FIXME handle root
1842 if (patterns.size() == 0 || context.currentNode->children(nlPtr) != accessOK)
1843 return new (interp) EmptySosofoObj;
1844 NodeListObj *nl = new (interp) NodeListPtrNodeListObj(nlPtr);
1845 ELObjDynamicRoot protect(interp, nl);
1846 nl = new (interp) SelectElementsNodeListObj(nl, patterns);
1848 return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode);
1851 DEFPRIMITIVE(SelectElements, argc, argv, context, interp, loc)
1853 NodeListObj *nl = argv[0]->asNodeList();
1855 return argError(interp, loc,
1856 InterpreterMessages::notANodeList, 0, argv[0]);
1857 NCVector<Pattern> patterns(1);
1858 if (!interp.convertToPattern(argv[1], loc, patterns[0]))
1859 return interp.makeError();
1860 return new (interp) SelectElementsNodeListObj(nl, patterns);
1863 DEFPRIMITIVE(IsMatchElement, argc, argv, context, interp, loc)
1866 if (!interp.convertToPattern(argv[0], loc, pattern))
1867 return interp.makeError();
1869 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
1870 return argError(interp, loc,
1871 InterpreterMessages::notASingletonNode, 1, argv[1]);
1872 if (pattern.matches(node, interp))
1873 return interp.makeTrue();
1874 return interp.makeFalse();
1877 DEFPRIMITIVE(ProcessNodeList, argc, argv, context, interp, loc)
1879 if (!context.processingMode) {
1880 interp.setNextLocation(loc);
1881 interp.message(InterpreterMessages::noCurrentProcessingMode);
1882 return interp.makeError();
1884 NodeListObj *nl = argv[0]->asNodeList();
1886 return argError(interp, loc,
1887 InterpreterMessages::notANodeList, 0, argv[0]);
1888 return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode);
1892 void reverse(StringC &s)
1895 size_t j = s.size() - 1;
1906 StringC formatNumberLetter(long n, const char *letters)
1913 // FIXME possibility of overflow
1925 result += letters[r];
1935 StringC formatNumberDecimal(long n, size_t minWidth)
1939 sprintf(buf, "%ld", n);
1940 const char *p = buf;
1945 size_t len = strlen(p);
1946 while (len < minWidth) {
1956 StringC formatNumberRoman(long n, const char *letters)
1959 if (n > 5000 || n < -5000 || n == 0)
1960 return formatNumberDecimal(n, 1);
1966 result += letters[0];
1969 for (int i = 100; i > 0; i /= 10, letters += 2) {
1974 result += letters[2];
1977 result += letters[2];
1978 result += letters[2];
1981 result += letters[2];
1982 result += letters[2];
1983 result += letters[2];
1986 result += letters[2];
1987 result += letters[1];
1990 result += letters[1];
1993 result += letters[1];
1994 result += letters[2];
1997 result += letters[1];
1998 result += letters[2];
1999 result += letters[2];
2002 result += letters[1];
2003 result += letters[2];
2004 result += letters[2];
2005 result += letters[2];
2008 result += letters[2];
2009 result += letters[0];
2017 bool formatNumber(long n, const Char *s, size_t len, StringC &result)
2020 switch (s[len - 1]) {
2022 result += formatNumberLetter(n, "abcdefghijklmnopqrstuvwxyz");
2025 result += formatNumberLetter(n, "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
2028 result += formatNumberRoman(n, "mdclxvi");
2031 result += formatNumberRoman(n, "MDCLXVI");
2034 result += formatNumberDecimal(n, len);
2040 result += formatNumberDecimal(n, 1);
2044 DEFPRIMITIVE(FormatNumber, argc, argv, context, interp, loc)
2047 if (!argv[0]->exactIntegerValue(n))
2048 return argError(interp, loc,
2049 InterpreterMessages::notAnExactInteger, 0, argv[0]);
2052 if (!argv[1]->stringData(s, len))
2053 return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
2054 StringObj *result = new (interp) StringObj;
2055 if (!formatNumber(n, s, len, *result)) {
2056 interp.setNextLocation(loc);
2057 interp.message(InterpreterMessages::invalidNumberFormat,
2058 StringMessageArg(StringC(s, len)));
2063 DEFPRIMITIVE(FormatNumberList, argc, argv, context, interp, loc)
2065 ELObj *numbers = argv[0];
2066 ELObj *formats = argv[1];
2067 ELObj *seps = argv[2];
2068 StringObj *result = new (interp) StringObj;
2069 while (!numbers->isNil()) {
2073 if (numbers != argv[0]) {
2074 if (!seps->stringData(s, len)) {
2075 tem = seps->asPair();
2077 return argError(interp, loc,
2078 InterpreterMessages::notAList, 2, argv[2]);
2079 if (!tem->car()->stringData(s, len))
2080 return argError(interp, loc,
2081 InterpreterMessages::notAString, 2, tem->car());
2084 result->append(s, len);
2086 tem = numbers->asPair();
2088 return argError(interp, loc,
2089 InterpreterMessages::notAList, 0, argv[0]);
2091 if (!tem->car()->exactIntegerValue(k))
2092 // FIXME message not quite right
2093 return argError(interp, loc,
2094 InterpreterMessages::notAnExactInteger, 0, tem->car());
2095 numbers = tem->cdr();
2096 if (!formats->stringData(s, len)) {
2097 tem = formats->asPair();
2099 return argError(interp, loc,
2100 InterpreterMessages::notAList, 1, argv[1]);
2101 if (!tem->car()->stringData(s, len))
2102 return argError(interp, loc,
2103 InterpreterMessages::notAString, 0, tem->car());
2104 formats = tem->cdr();
2106 if (!formatNumber(k, s, len, *result)) {
2107 interp.setNextLocation(loc);
2108 interp.message(InterpreterMessages::invalidNumberFormat,
2109 StringMessageArg(StringC(s, len)));
2115 DEFPRIMITIVE(ExternalProcedure, argc, argv, context, interp, loc)
2119 if (!argv[0]->stringData(s, n))
2120 return argError(interp, loc,
2121 InterpreterMessages::notAString, 0, argv[0]);
2123 FunctionObj *func = interp.lookupExternalProc(tem);
2126 return interp.makeFalse();
2129 DEFPRIMITIVE(Error, argc, argv, context, interp, loc)
2133 if (!argv[0]->stringData(s, n))
2134 return argError(interp, loc,
2135 InterpreterMessages::notAString, 0, argv[0]);
2136 interp.setNextLocation(loc);
2137 interp.message(InterpreterMessages::errorProc,
2138 StringMessageArg(StringC(s, n)));
2139 return interp.makeError();
2142 DEFPRIMITIVE(StringToNumber, argc, argv, context, interp, loc)
2146 if (!argv[0]->stringData(s, n))
2147 return argError(interp, loc,
2148 InterpreterMessages::notAString, 0, argv[0]);
2151 if (!argv[1]->exactIntegerValue(radix))
2152 return argError(interp, loc,
2153 InterpreterMessages::notAnExactInteger, 1, argv[1]);
2161 interp.setNextLocation(loc);
2162 interp.message(InterpreterMessages::invalidRadix);
2169 ELObj *result = interp.convertNumber(StringC(s, n), int(radix));
2171 result = result->resolveQuantities(0, interp, loc);
2172 if (interp.isError(result))
2177 if (result->quantityValue(n, d, dim) != ELObj::noQuantity)
2180 return interp.makeFalse();
2183 DEFPRIMITIVE(NumberToString, argc, argv, context, interp, loc)
2186 if (!argv[0]->realValue(x))
2187 return argError(interp, loc,
2188 InterpreterMessages::notANumber, 0, argv[0]);
2192 if (!argv[1]->exactIntegerValue(r))
2193 return argError(interp, loc,
2194 InterpreterMessages::notAnExactInteger, 1, argv[1]);
2200 radix = unsigned(r);
2203 interp.setNextLocation(loc);
2204 interp.message(InterpreterMessages::invalidRadix);
2211 StrOutputCharStream os;
2212 argv[0]->print(interp, os, radix);
2214 os.extractString(tem);
2215 return new (interp) StringObj(tem);
2218 DEFPRIMITIVE(QuantityToString, argc, argv, context, interp, loc)
2223 if (argv[0]->quantityValue(lResult, dResult, dim) == ELObj::noQuantity)
2224 return argError(interp, loc,
2225 InterpreterMessages::notAQuantity, 0, argv[0]);
2229 if (!argv[1]->exactIntegerValue(r))
2230 return argError(interp, loc,
2231 InterpreterMessages::notAnExactInteger, 1, argv[1]);
2237 radix = unsigned(r);
2240 interp.setNextLocation(loc);
2241 interp.message(InterpreterMessages::invalidRadix);
2248 StrOutputCharStream os;
2249 argv[0]->print(interp, os, radix);
2251 os.extractString(tem);
2252 return new (interp) StringObj(tem);
2255 DEFPRIMITIVE(DisplaySize, argc, argv, context, interp, loc)
2257 return new (interp) LengthSpecObj(LengthSpec(LengthSpec::displaySize, 1.0));
2260 DEFPRIMITIVE(TableUnit, argc, argv, context, interp, loc)
2263 if (!argv[0]->exactIntegerValue(k))
2264 return argError(interp, loc,
2265 InterpreterMessages::notAnExactInteger, 0, argv[0]);
2267 return new (interp) LengthSpecObj(LengthSpec(LengthSpec::tableUnit, double(k)));
2270 DEFPRIMITIVE(IsDisplaySpace, argc, argv, context, interp, loc)
2272 if (argv[0]->asDisplaySpace())
2273 return interp.makeTrue();
2275 return interp.makeFalse();
2279 DEFPRIMITIVE(DisplaySpace, argc, argv, context, interp, loc)
2281 FOTBuilder::DisplaySpace displaySpace;
2282 if (!interp.convertLengthSpec(argv[0], displaySpace.nominal))
2283 return argError(interp, loc,
2284 InterpreterMessages::notALengthSpec, 0, argv[0]);
2285 displaySpace.min = displaySpace.nominal;
2286 displaySpace.max = displaySpace.nominal;
2287 // first specified keyword argument takes priority,
2288 // so scan them backwards...
2289 for (int i = argc - 1; i > 0; i -= 2) {
2290 if ((argc & 1) == 0) {
2291 interp.setNextLocation(loc);
2292 interp.message(InterpreterMessages::oddKeyArgs);
2293 return interp.makeError();
2295 KeywordObj *keyObj = argv[i - 1]->asKeyword();
2297 interp.setNextLocation(loc);
2298 interp.message(InterpreterMessages::keyArgsNotKey);
2299 return interp.makeError();
2301 Identifier::SyntacticKey key;
2302 if (!keyObj->identifier()->syntacticKey(key)) {
2303 interp.setNextLocation(loc);
2304 interp.message(InterpreterMessages::invalidKeyArg,
2305 StringMessageArg(keyObj->identifier()->name()));
2306 return interp.makeError();
2310 case Identifier::keyMin:
2311 if (!interp.convertLengthSpec(argv[i], displaySpace.min))
2312 return argError(interp, loc,
2313 InterpreterMessages::notALengthSpec, i, argv[i]);
2315 case Identifier::keyMax:
2316 if (!interp.convertLengthSpec(argv[i], displaySpace.max))
2317 return argError(interp, loc,
2318 InterpreterMessages::notALengthSpec, i, argv[i]);
2320 case Identifier::keyIsConditional:
2321 if (argv[i] == interp.makeTrue())
2322 displaySpace.conditional = 1;
2323 else if (argv[i] == interp.makeFalse())
2324 displaySpace.conditional = 0;
2326 return argError(interp, loc,
2327 InterpreterMessages::notABoolean, i, argv[i]);
2329 case Identifier::keyPriority:
2330 if (argv[i]->exactIntegerValue(displaySpace.priority))
2331 displaySpace.force = 0;
2333 SymbolObj *sym = argv[i]->asSymbol();
2334 if (sym && sym->cValue() == FOTBuilder::symbolForce)
2335 displaySpace.force = 1;
2337 return argError(interp, loc,
2338 InterpreterMessages::notAPriority, i, argv[i]);
2342 interp.setNextLocation(loc);
2343 interp.message(InterpreterMessages::invalidKeyArg,
2344 StringMessageArg(keyObj->identifier()->name()));
2345 return interp.makeError();
2349 return new (interp) DisplaySpaceObj(displaySpace);
2352 DEFPRIMITIVE(IsInlineSpace, argc, argv, context, interp, loc)
2354 if (argv[0]->asInlineSpace())
2355 return interp.makeTrue();
2357 return interp.makeFalse();
2360 DEFPRIMITIVE(InlineSpace, argc, argv, context, interp, loc)
2362 FOTBuilder::InlineSpace inlineSpace;
2363 if (!interp.convertLengthSpec(argv[0], inlineSpace.nominal))
2364 return argError(interp, loc,
2365 InterpreterMessages::notALengthSpec, 0, argv[0]);
2366 inlineSpace.min = inlineSpace.nominal;
2367 inlineSpace.max = inlineSpace.nominal;
2368 // first specified keyword argument takes priority,
2369 // so scan them backwards...
2370 for (int i = argc - 1; i > 0; i -= 2) {
2371 if ((argc & 1) == 0) {
2372 interp.setNextLocation(loc);
2373 interp.message(InterpreterMessages::oddKeyArgs);
2374 return interp.makeError();
2376 KeywordObj *keyObj = argv[i - 1]->asKeyword();
2378 interp.setNextLocation(loc);
2379 interp.message(InterpreterMessages::keyArgsNotKey);
2380 return interp.makeError();
2382 Identifier::SyntacticKey key;
2383 if (!keyObj->identifier()->syntacticKey(key)) {
2384 interp.setNextLocation(loc);
2385 interp.message(InterpreterMessages::invalidKeyArg,
2386 StringMessageArg(keyObj->identifier()->name()));
2387 return interp.makeError();
2391 case Identifier::keyMin:
2392 if (!interp.convertLengthSpec(argv[i], inlineSpace.min))
2393 return argError(interp, loc,
2394 InterpreterMessages::notALengthSpec, i, argv[i]);
2396 case Identifier::keyMax:
2397 if (!interp.convertLengthSpec(argv[i], inlineSpace.max))
2398 return argError(interp, loc,
2399 InterpreterMessages::notALengthSpec, i, argv[i]);
2402 interp.setNextLocation(loc);
2403 interp.message(InterpreterMessages::invalidKeyArg,
2404 StringMessageArg(keyObj->identifier()->name()));
2405 return interp.makeError();
2409 return new (interp) InlineSpaceObj(inlineSpace);
2413 DEFPRIMITIVE(IsColor, argc, argv, context, interp, loc)
2415 if (argv[0]->asColor())
2416 return interp.makeTrue();
2418 return interp.makeFalse();
2421 DEFPRIMITIVE(IsColorSpace, argc, argv, context, interp, loc)
2423 if (argv[0]->asColorSpace())
2424 return interp.makeTrue();
2426 return interp.makeFalse();
2430 bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
2431 int nKeys, Interpreter &interp, const Location &loc, int *pos);
2433 // return 1 if obj is a list of numbers of length len.
2435 bool decodeNumVector(double *res, int len, ELObj *obj)
2439 for (int i = 0; i < len; i++) {
2441 if (!p || !p->car()->realValue(res[i]))
2449 bool decodeFuncVector(FunctionObj **res, int len, ELObj *obj)
2453 for (int i = 0; i < len; i++) {
2455 if (!p || !(res[i] = p->car()->asFunction()))
2462 DEFPRIMITIVE(ColorSpace, argc, argv, context, interp, loc)
2466 if (!argv[0]->stringData(s, n))
2467 return argError(interp, loc,
2468 InterpreterMessages::notAString, 0, argv[0]);
2469 StringC str(s, (n < 43) ? n : 43);
2470 if (str == interp.makeStringC("ISO/IEC 10179:1996//Color-Space Family::Dev")) {
2471 str.assign(s + 40, n - 40);
2473 if (str == interp.makeStringC("Device RGB"))
2474 res = new (interp) DeviceRGBColorSpaceObj;
2475 else if (str == interp.makeStringC("Device Gray"))
2476 res = new (interp) DeviceGrayColorSpaceObj;
2477 else if (str == interp.makeStringC("Device CMYK"))
2478 res = new (interp) DeviceCMYKColorSpaceObj;
2479 else if (str == interp.makeStringC("Device KX"))
2480 res = new (interp) DeviceKXColorSpaceObj;
2482 interp.setNextLocation(loc);
2483 interp.message(InterpreterMessages::unknownColorSpaceFamily,
2484 StringMessageArg(StringC(s, n)));
2485 return interp.makeError();
2488 interp.setNextLocation(loc);
2489 interp.message(InterpreterMessages::colorSpaceNoArgs,
2490 StringMessageArg(str));
2494 else if (str == interp.makeStringC("ISO/IEC 10179:1996//Color-Space Family::CIE")) {
2495 str.assign(s + 40, n - 40);
2496 if ( str == interp.makeStringC("CIE LUV")
2497 || str == interp.makeStringC("CIE LAB")
2498 || str == interp.makeStringC("CIE Based ABC")
2499 || str == interp.makeStringC("CIE Based A")) {
2500 static const Identifier::SyntacticKey keys[12] = {
2501 Identifier::keyWhitePoint,
2502 Identifier::keyBlackPoint,
2503 Identifier::keyRange,
2504 Identifier::keyRangeAbc,
2505 Identifier::keyRangeLmn,
2506 Identifier::keyRangeA,
2507 Identifier::keyMatrixAbc,
2508 Identifier::keyMatrixLmn,
2509 Identifier::keyMatrixA,
2510 Identifier::keyDecodeAbc,
2511 Identifier::keyDecodeLmn,
2512 Identifier::keyDecodeA
2516 double wp[3], bp[3], range[6];
2517 double rangeAbc[6], rangeLmn[6], rangeA[2];
2518 double matrixAbc[9], matrixLmn[9], matrixA[3];
2519 FunctionObj *decodeAbc[3], *decodeLmn[3], *decodeA;
2520 if (!decodeKeyArgs(argc - 1, argv + 1, keys, 12, interp, loc, pos)
2522 || (pos[0] >= 0 && !decodeNumVector(wp, 3, argv[pos[0] + 1]))
2523 || (pos[1] >= 0 && !decodeNumVector(bp, 3, argv[pos[1] + 1]))
2524 || (pos[2] >= 0 && !decodeNumVector(range, 6, argv[pos[2] + 1]))
2525 || (pos[3] >= 0 && !decodeNumVector(rangeAbc, 6, argv[pos[3] + 1]))
2526 || (pos[4] >= 0 && !decodeNumVector(rangeLmn, 6, argv[pos[4] + 1]))
2527 || (pos[5] >= 0 && !decodeNumVector(rangeA, 2, argv[pos[5] + 1]))
2528 || (pos[6] >= 0 && !decodeNumVector(matrixAbc, 9, argv[pos[6] + 1]))
2529 || (pos[7] >= 0 && !decodeNumVector(matrixLmn, 9, argv[pos[7] + 1]))
2530 || (pos[8] >= 0 && !decodeNumVector(matrixA, 3, argv[pos[8] + 1]))
2531 || (pos[9] >= 0 && !decodeFuncVector(decodeAbc, 3, argv[pos[9] + 1]))
2532 || (pos[10] >= 0 && !decodeFuncVector(decodeLmn, 3, argv[pos[10] + 1]))
2533 || (pos[11] >= 0 && !(decodeA = argv[pos[11] + 1]->asFunction()))) {
2534 interp.setNextLocation(loc);
2535 interp.message(InterpreterMessages::colorSpaceArgError,
2536 StringMessageArg(str));
2537 return interp.makeError();
2539 if ( str == interp.makeStringC("CIE LUV")
2540 || str == interp.makeStringC("CIE LAB")) {
2541 for (int i = 3; i < 12; i++)
2543 interp.setNextLocation(loc);
2544 interp.message(InterpreterMessages::colorSpaceArgError,
2545 StringMessageArg(str));
2546 return interp.makeError();
2548 if (str == interp.makeStringC("CIE LUV"))
2549 return new (interp) CIELUVColorSpaceObj(wp, (pos[1] >= 0) ? bp : 0,
2550 (pos[2] >= 0) ? range : 0);
2552 return new (interp) CIELABColorSpaceObj(wp, (pos[1] >= 0) ? bp : 0,
2553 (pos[2] >= 0) ? range : 0);
2555 else if (str == interp.makeStringC("CIE Based ABC")) {
2556 if (pos[2] >= 0 || pos[5] >= 0 || pos[8] >= 0 || pos[11] >= 0) {
2557 interp.setNextLocation(loc);
2558 interp.message(InterpreterMessages::colorSpaceArgError,
2559 StringMessageArg(str));
2560 return interp.makeError();
2562 return new (interp) CIEABCColorSpaceObj(wp,
2563 (pos[1] >= 0) ? bp : 0,
2564 (pos[3] >= 0) ? rangeAbc : 0,
2565 (pos[9] >= 0) ? decodeAbc : 0,
2566 (pos[6] >= 0) ? matrixAbc : 0,
2567 (pos[4] >= 0) ? rangeLmn : 0,
2568 (pos[10] >= 0) ? decodeLmn : 0,
2569 (pos[7] >= 0) ? matrixLmn : 0);
2571 else { // CIE Based A
2572 if (pos[2] >= 0 || pos[3] >= 0 || pos[6] >= 0 || pos[9] >= 0) {
2573 interp.setNextLocation(loc);
2574 interp.message(InterpreterMessages::colorSpaceArgError,
2575 StringMessageArg(str));
2576 return interp.makeError();
2578 return new (interp) CIEAColorSpaceObj(wp,
2579 (pos[1] >= 0) ? bp : 0,
2580 (pos[5] >= 0) ? rangeA : 0,
2581 (pos[11] >= 0) ? decodeA : 0,
2582 (pos[8] >= 0) ? matrixA : 0,
2583 (pos[4] >= 0) ? rangeLmn : 0,
2584 (pos[10] >= 0) ? decodeLmn : 0,
2585 (pos[7] >= 0) ? matrixLmn : 0);
2589 interp.setNextLocation(loc);
2590 interp.message(InterpreterMessages::unknownColorSpaceFamily,
2591 StringMessageArg(StringC(s, n)));
2592 return interp.makeError();
2595 DEFPRIMITIVE(Color, argc, argv, context, interp, loc)
2597 ColorSpaceObj *colorSpace = argv[0]->asColorSpace();
2599 return argError(interp, loc,
2600 InterpreterMessages::notAColorSpace, 0, argv[0]);
2601 return colorSpace->makeColor(argc - 1, argv + 1, interp, loc);
2604 DEFPRIMITIVE(IsAddress, argc, argv, context, interp, loc)
2606 if (argv[0]->asAddress())
2607 return interp.makeTrue();
2609 return interp.makeFalse();
2612 DEFPRIMITIVE(IsAddressLocal, argc, argv, context, interp, loc)
2614 AddressObj *address = argv[0]->asAddress();
2616 return argError(interp, loc,
2617 InterpreterMessages::notAnAddress, 0, argv[0]);
2618 if (!context.currentNode)
2619 return noCurrentNodeError(interp, loc);
2620 switch (address->address().type) {
2621 case FOTBuilder::Address::resolvedNode:
2622 if (address->address().node->sameGrove(*context.currentNode))
2623 return interp.makeTrue();
2625 return interp.makeFalse();
2626 case FOTBuilder::Address::idref:
2627 return interp.makeTrue();
2628 case FOTBuilder::Address::entity:
2629 return interp.makeFalse();
2633 return interp.makeFalse();
2636 DEFPRIMITIVE(IsAddressVisited, argc, argv, context, interp, loc)
2638 AddressObj *address = argv[0]->asAddress();
2640 return argError(interp, loc,
2641 InterpreterMessages::notAnAddress, 0, argv[0]);
2643 return interp.makeFalse();
2646 DEFPRIMITIVE(CurrentNodeAddress, argc, argv, context, interp, loc)
2648 if (!context.currentNode)
2649 return noCurrentNodeError(interp, loc);
2650 return new (interp) AddressObj(FOTBuilder::Address::resolvedNode, context.currentNode);
2653 DEFPRIMITIVE(HytimeLinkend, argc, argv, context, interp, loc)
2655 if (!context.currentNode)
2656 return noCurrentNodeError(interp, loc);
2657 return new (interp) AddressObj(FOTBuilder::Address::hytimeLinkend, context.currentNode);
2660 DEFPRIMITIVE(SgmlDocumentAddress, argc, argv, context, interp, loc)
2664 if (!argv[0]->stringData(s, n))
2665 return argError(interp, loc,
2666 InterpreterMessages::notAString, 0, argv[0]);
2667 StringC sysid(s, n);
2668 if (!argv[1]->stringData(s, n))
2669 return argError(interp, loc,
2670 InterpreterMessages::notAString, 1, argv[1]);
2671 return new (interp) AddressObj(FOTBuilder::Address::sgmlDocument, NodePtr(), sysid, StringC(s, n));
2674 DEFPRIMITIVE(IdrefAddress, argc, argv, context, interp, loc)
2676 // The advantage of doing this rather than using an NodeAddressObj,
2677 // is that when it's a forward reference we don't have to
2678 // wait for the node. It might be cleaner to use a ProxyNode class
2682 if (!argv[0]->stringData(s, n))
2683 return argError(interp, loc,
2684 InterpreterMessages::notAString, 0, argv[0]);
2685 if (!context.currentNode)
2686 return noCurrentNodeError(interp, loc);
2687 return new (interp) AddressObj(FOTBuilder::Address::idref, context.currentNode, StringC(s, n));
2690 DEFPRIMITIVE(EntityAddress, argc, argv, context, interp, loc)
2692 // Note that multiple space separated entity names are allowed;
2693 // currently Address doesn't support multiple nodes, so we can't resolve here.
2696 if (!argv[0]->stringData(s, n))
2697 return argError(interp, loc,
2698 InterpreterMessages::notAString, 0, argv[0]);
2699 if (!context.currentNode)
2700 return noCurrentNodeError(interp, loc);
2701 return new (interp) AddressObj(FOTBuilder::Address::entity, context.currentNode, StringC(s, n));
2704 DEFPRIMITIVE(NodeListAddress, argc, argv, context, interp, loc)
2707 if (!argv[0]->optSingletonNodeList(context, interp, node) || !node)
2708 return argError(interp, loc,
2709 InterpreterMessages::notASingletonNode, 0, argv[0]);
2710 return new (interp) AddressObj(FOTBuilder::Address::resolvedNode, node);
2713 DEFPRIMITIVE(CharScriptCase, argc, argv, context, interp, loc)
2715 if (!context.styleStack) {
2716 interp.setNextLocation(loc);
2717 interp.message(InterpreterMessages::notInCharacteristicValue);
2718 return interp.makeError();
2720 for (size_t i = 0; i < argc; i += 2) {
2723 if (!argv[i]->stringData(s, n))
2724 return argError(interp, loc,
2725 InterpreterMessages::notAString, i, argv[i]);
2728 return argv[argc - 1];
2731 DEFPRIMITIVE(IsGlyphId, argc, argv, context, interp, loc)
2733 if (argv[0]->glyphId())
2734 return interp.makeTrue();
2736 return interp.makeFalse();
2739 DEFPRIMITIVE(GlyphId, argc, argv, context, interp, loc)
2743 if (!argv[0]->stringData(s, n))
2744 return argError(interp, loc,
2745 InterpreterMessages::notAString, 0, argv[0]);
2746 return interp.convertGlyphId(s, n, loc);
2749 DEFPRIMITIVE(IsGlyphSubstTable, argc, argv, context, interp, loc)
2751 if (argv[0]->asGlyphSubstTable())
2752 return interp.makeTrue();
2754 return interp.makeFalse();
2757 DEFPRIMITIVE(GlyphSubstTable, argc, argv, context, interp, loc)
2760 Ptr<FOTBuilder::GlyphSubstTable> table = new FOTBuilder::GlyphSubstTable;
2761 table->uniqueId = interp.allocGlyphSubstTableUniqueId();
2762 while (!p->isNil()) {
2763 PairObj *tem = p->asPair();
2765 return argError(interp, loc,
2766 InterpreterMessages::notAGlyphIdPairList, 0, argv[0]);
2768 tem = tem->car()->asPair();
2769 const FOTBuilder::GlyphId *g1, *g2;
2771 || (g1 = tem->car()->glyphId()) == 0
2772 || (g2 = tem->cdr()->glyphId()) == 0)
2773 return argError(interp, loc,
2774 InterpreterMessages::notAGlyphIdPairList, 0, argv[0]);
2775 table->pairs.push_back(*g1);
2776 table->pairs.push_back(*g2);
2778 return new (interp) GlyphSubstTableObj(table);
2781 DEFPRIMITIVE(GlyphSubst, argc, argv, context, interp, loc)
2783 GlyphSubstTableObj *table = argv[0]->asGlyphSubstTable();
2785 return argError(interp, loc,
2786 InterpreterMessages::notAGlyphSubstTable, 0, argv[0]);
2787 const FOTBuilder::GlyphId *glyphId = argv[1]->glyphId();
2789 return argError(interp, loc,
2790 InterpreterMessages::notAGlyphId, 1, argv[1]);
2791 return new (interp) GlyphIdObj(table->glyphSubstTable()->subst(*glyphId));
2794 // Core query language
2796 DEFPRIMITIVE(CurrentNode, argc, argv, context, interp, loc)
2798 if (!context.currentNode)
2799 return noCurrentNodeError(interp, loc);
2800 return new (interp) NodePtrNodeListObj(context.currentNode);
2803 DEFPRIMITIVE(NodeListError, argc, argv, context, interp, loc)
2807 if (!argv[0]->stringData(s, n))
2808 return argError(interp, loc,
2809 InterpreterMessages::notAString, 0, argv[0]);
2810 if (!argv[1]->asNodeList())
2811 return argError(interp, loc,
2812 InterpreterMessages::notANodeList, 1, argv[1]);
2816 if (argv[1]->optSingletonNodeList(context, interp, nd)
2817 && (lnp = LocNode::convert(nd)) != 0
2818 && lnp->getLocation(nodeLoc) == accessOK)
2819 interp.setNextLocation(nodeLoc);
2821 interp.setNextLocation(loc);
2822 interp.message(InterpreterMessages::errorProc,
2823 StringMessageArg(StringC(s, n)));
2824 return interp.makeError();
2827 DEFPRIMITIVE(IsNodeListEmpty, argc, argv, context, interp, loc)
2829 NodeListObj *nl = argv[0]->asNodeList();
2831 return argError(interp, loc,
2832 InterpreterMessages::notANodeList, 0, argv[0]);
2833 if (nl->nodeListFirst(context, interp))
2834 return interp.makeFalse();
2836 return interp.makeTrue();
2839 DEFPRIMITIVE(IsNodeList, argc, argv, context, interp, loc)
2841 if (argv[0]->asNodeList())
2842 return interp.makeTrue();
2844 return interp.makeFalse();
2847 DEFPRIMITIVE(Parent, argc, argv, context, interp, loc)
2851 if (!argv[0]->optSingletonNodeList(context, interp, node))
2852 return argError(interp, loc,
2853 InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2858 node = context.currentNode;
2860 return noCurrentNodeError(interp, loc);
2862 if (node->getParent(node) != accessOK)
2863 return interp.makeEmptyNodeList();
2864 return new (interp) NodePtrNodeListObj(node);
2868 bool convertGeneralName(ELObj *obj, const NodePtr &node, StringC &result)
2872 if (!obj->stringData(s, n))
2874 result.assign(s, n);
2876 node->getGroveRoot(root);
2877 NamedNodeListPtr elements;
2878 root->getElements(elements);
2879 result.resize(elements->normalize(result.begin(), result.size()));
2883 DEFPRIMITIVE(Ancestor, argc, argv, context, interp, loc)
2887 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
2888 return argError(interp, loc,
2889 InterpreterMessages::notASingletonNode, 1, argv[1]);
2892 node = context.currentNode;
2894 return noCurrentNodeError(interp, loc);
2897 if (!convertGeneralName(argv[0], node, gi))
2898 return argError(interp, loc,
2899 InterpreterMessages::notAString, 0, argv[0]);
2900 while (node->getParent(node) == accessOK) {
2902 if (node->getGi(str) == accessOK && str == GroveString(gi.data(), gi.size()))
2903 return new (interp) NodePtrNodeListObj(node);
2905 return interp.makeEmptyNodeList();
2908 DEFPRIMITIVE(Gi, argc, argv, context, interp, loc)
2912 if (!argv[0]->optSingletonNodeList(context, interp, node))
2913 return argError(interp, loc,
2914 InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2917 if (!context.currentNode)
2918 return noCurrentNodeError(interp, loc);
2919 node = context.currentNode;
2922 if (node && node->getGi(str) == accessOK)
2923 return new (interp) StringObj(str.data(), str.size());
2925 return interp.makeFalse();
2928 DEFPRIMITIVE(FirstChildGi, argc, argv, context, interp, loc)
2932 if (!argv[0]->optSingletonNodeList(context, interp, node))
2933 return argError(interp, loc,
2934 InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2936 return interp.makeFalse();
2939 if (!context.currentNode)
2940 return noCurrentNodeError(interp, loc);
2941 node = context.currentNode;
2943 if (node.assignFirstChild() != accessOK)
2944 return interp.makeFalse();
2947 if (node->getGi(str) == accessOK)
2948 return new (interp) StringObj(str.data(), str.size());
2949 if (node.assignNextChunkSibling() != accessOK)
2952 return interp.makeFalse();
2955 DEFPRIMITIVE(Id, argc, argv, context, interp, loc)
2959 if (!argv[0]->optSingletonNodeList(context, interp, node))
2960 return argError(interp, loc,
2961 InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
2964 if (!context.currentNode)
2965 return noCurrentNodeError(interp, loc);
2966 node = context.currentNode;
2969 if (node && node->getId(str) == accessOK)
2970 return new (interp) StringObj(str.data(), str.size());
2972 return interp.makeFalse();
2976 bool nodeAttributeString(const NodePtr &node, const Char *s, size_t n,
2977 const SdataMapper &mapper, StringC &value)
2979 NamedNodeListPtr atts;
2980 if (node->getAttributes(atts) != accessOK)
2983 if (atts->namedNode(GroveString(s, n), att) != accessOK)
2986 if (att->getImplied(implied) == accessOK && implied)
2989 if (att->tokens(tokens) == accessOK) {
2990 value.assign(tokens.data(), tokens.size());
2995 if (att->firstChild(tem) == accessOK) {
2998 if (tem->charChunk(mapper, chunk) == accessOK)
2999 value.append(chunk.data(), chunk.size());
3000 } while (tem.assignNextChunkSibling() == accessOK);
3005 DEFPRIMITIVE(AttributeString, argc, argv, context, interp, loc)
3009 if (!argv[1]->optSingletonNodeList(context, interp, node))
3010 return argError(interp, loc,
3011 InterpreterMessages::notAnOptSingletonNode, 1, argv[1]);
3013 return interp.makeFalse();
3016 if (!context.currentNode)
3017 return noCurrentNodeError(interp, loc);
3018 node = context.currentNode;
3022 if (!argv[0]->stringData(s, n))
3023 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3025 if (nodeAttributeString(node, s, n, interp, value))
3026 return new (interp) StringObj(value);
3027 return interp.makeFalse();
3030 DEFPRIMITIVE(InheritedAttributeString, argc, argv, context, interp, loc)
3034 if (!argv[1]->optSingletonNodeList(context, interp, node))
3035 return argError(interp, loc,
3036 InterpreterMessages::notAnOptSingletonNode, 1, argv[1]);
3038 return interp.makeFalse();
3041 if (!context.currentNode)
3042 return noCurrentNodeError(interp, loc);
3043 node = context.currentNode;
3047 if (!argv[0]->stringData(s, n))
3048 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3051 if (nodeAttributeString(node, s, n, interp, value))
3052 return new (interp) StringObj(value);
3053 } while (node->getParent(node) == accessOK);
3054 return interp.makeFalse();
3057 DEFPRIMITIVE(InheritedElementAttributeString, argc, argv, context, interp, loc)
3061 if (!argv[2]->optSingletonNodeList(context, interp, node))
3062 return argError(interp, loc,
3063 InterpreterMessages::notAnOptSingletonNode, 2, argv[2]);
3065 return interp.makeFalse();
3068 if (!context.currentNode)
3069 return noCurrentNodeError(interp, loc);
3070 node = context.currentNode;
3073 if (!convertGeneralName(argv[0], node, gi))
3074 return argError(interp, loc,
3075 InterpreterMessages::notAString, 0, argv[0]);
3078 if (!argv[1]->stringData(s, n))
3079 return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
3083 if (node->getGi(nodeGi) == accessOK
3084 && nodeGi == GroveString(gi.data(), gi.size())
3085 && nodeAttributeString(node, s, n, interp, value))
3086 return new (interp) StringObj(value);
3087 } while (node->getParent(node) == accessOK);
3088 return interp.makeFalse();
3091 DEFPRIMITIVE(IsFirstSibling, argc, argv, context, interp, loc)
3095 if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3096 return argError(interp, loc,
3097 InterpreterMessages::notASingletonNode, 0, argv[0]);
3100 if (!context.currentNode)
3101 return noCurrentNodeError(interp, loc);
3102 nd = context.currentNode;
3106 if (nd->firstSibling(p) != accessOK
3107 || nd->getGi(gi) != accessOK)
3108 return interp.makeFalse();
3111 if (p->getGi(tem) == accessOK && tem == gi)
3112 return interp.makeFalse();
3113 if (p.assignNextChunkSibling() != accessOK)
3116 return interp.makeTrue();
3119 DEFPRIMITIVE(IsAbsoluteFirstSibling, argc, argv, context, interp, loc)
3123 if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3124 return argError(interp, loc,
3125 InterpreterMessages::notASingletonNode, 0, argv[0]);
3128 if (!context.currentNode)
3129 return noCurrentNodeError(interp, loc);
3130 nd = context.currentNode;
3133 if (nd->firstSibling(p) != accessOK)
3134 return interp.makeFalse();
3137 if (p->getGi(tem) == accessOK)
3138 return interp.makeFalse();
3139 if (p.assignNextChunkSibling() != accessOK)
3142 return interp.makeTrue();
3145 DEFPRIMITIVE(IsLastSibling, argc, argv, context, interp, loc)
3149 if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3150 return argError(interp, loc,
3151 InterpreterMessages::notASingletonNode, 0, argv[0]);
3154 if (!context.currentNode)
3155 return noCurrentNodeError(interp, loc);
3156 nd = context.currentNode;
3159 if (nd->getGi(gi) != accessOK)
3160 return interp.makeFalse();
3161 while (nd.assignNextChunkSibling() == accessOK) {
3163 if (nd->getGi(tem) == accessOK && tem == gi)
3164 return interp.makeFalse();
3166 return interp.makeTrue();
3169 DEFPRIMITIVE(IsAbsoluteLastSibling, argc, argv, context, interp, loc)
3173 if (!argv[0]->optSingletonNodeList(context, interp, nd) || !nd)
3174 return argError(interp, loc,
3175 InterpreterMessages::notASingletonNode, 0, argv[0]);
3178 if (!context.currentNode)
3179 return noCurrentNodeError(interp, loc);
3180 nd = context.currentNode;
3181 } while (nd.assignNextChunkSibling() == accessOK) {
3183 if (nd->getGi(tem) == accessOK)
3184 return interp.makeFalse();
3186 return interp.makeTrue();
3189 // Return 0 on error.
3191 bool matchAncestors(ELObj *obj, const NodePtr &node, ELObj *&unmatched)
3194 if (node->getParent(parent) != accessOK) {
3198 if (!matchAncestors(obj, parent, unmatched))
3200 if (!unmatched->isNil()) {
3201 PairObj *pair = unmatched->asPair();
3205 if (!convertGeneralName(pair->car(), node, gi))
3208 if (parent->getGi(tem) == accessOK
3209 && tem == GroveString(gi.data(), gi.size()))
3210 unmatched = pair->cdr();
3215 DEFPRIMITIVE(IsHaveAncestor, argc, argv, context, interp, loc)
3219 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3220 return argError(interp, loc,
3221 InterpreterMessages::notASingletonNode, 1, argv[1]);
3224 if (!context.currentNode)
3225 return noCurrentNodeError(interp, loc);
3226 node = context.currentNode;
3229 if (convertGeneralName(argv[0], node, gi)) {
3230 while (node->getParent(node) == accessOK) {
3232 if (node->getGi(tem) == accessOK && tem == GroveString(gi.data(), gi.size()))
3233 return interp.makeTrue();
3235 return interp.makeFalse();
3238 if (!matchAncestors(argv[0], node, unmatched))
3239 return argError(interp, loc,
3240 InterpreterMessages::notAList, 0, argv[0]);
3241 else if (unmatched->isNil())
3242 return interp.makeTrue();
3244 return interp.makeFalse();
3247 DEFPRIMITIVE(ChildNumber, argc, argv, context, interp, loc)
3251 if (!argv[0]->optSingletonNodeList(context, interp, node) || !node)
3252 return argError(interp, loc,
3253 InterpreterMessages::notASingletonNode, 0, argv[0]);
3256 if (!context.currentNode)
3257 return noCurrentNodeError(interp, loc);
3258 node = context.currentNode;
3261 if (!interp.childNumber(node, num))
3262 return interp.makeFalse();
3263 return interp.makeInteger(num + 1);
3266 DEFPRIMITIVE(AncestorChildNumber, argc, argv, context, interp, loc)
3270 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3271 return argError(interp, loc,
3272 InterpreterMessages::notASingletonNode, 1, argv[1]);
3275 if (!context.currentNode)
3276 return noCurrentNodeError(interp, loc);
3277 node = context.currentNode;
3280 if (!convertGeneralName(argv[0], node, gi))
3281 return argError(interp, loc,
3282 InterpreterMessages::notAString, 0, argv[0]);
3283 while (node->getParent(node) == accessOK) {
3285 if (node->getGi(str) == accessOK
3286 && str == GroveString(gi.data(), gi.size())) {
3288 interp.childNumber(node, num);
3289 return interp.makeInteger(num + 1);
3292 return interp.makeFalse();
3295 DEFPRIMITIVE(HierarchicalNumber, argc, argv, context, interp, loc)
3299 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3300 return argError(interp, loc,
3301 InterpreterMessages::notASingletonNode, 1, argv[1]);
3304 if (!context.currentNode)
3305 return noCurrentNodeError(interp, loc);
3306 node = context.currentNode;
3308 // Make a reversed copy of the list of GIs.
3309 ELObjDynamicRoot list(interp, 0);
3311 while (!p->isNil()) {
3312 PairObj *tem = p->asPair();
3314 return argError(interp, loc,
3315 InterpreterMessages::notAList, 0, argv[0]);
3316 list = new (interp) PairObj(tem->car(), list);
3321 PairObj *pair = (PairObj *)p;
3323 // FIXME error message not quite right
3324 if (!convertGeneralName(pair->car(), node, gi))
3325 return argError(interp, loc,
3326 InterpreterMessages::notAString, 0, pair->car());
3328 // Replace the GI by its number.
3329 if (node->getParent(node) != accessOK) {
3330 pair->setCar(interp.makeInteger(0));
3334 if (node->getGi(str) == accessOK
3335 && str == GroveString(gi.data(), gi.size())) {
3337 interp.childNumber(node, num);
3338 pair->setCar(interp.makeInteger(num + 1));
3344 // Reverse the list of numbers in place.
3346 ELObj *result = interp.makeNil();
3348 PairObj *tem = (PairObj *)p;
3350 tem->setCdr(result);
3356 DEFPRIMITIVE(HierarchicalNumberRecursive, argc, argv, context, interp, loc)
3360 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3361 return argError(interp, loc,
3362 InterpreterMessages::notASingletonNode, 1, argv[1]);
3365 if (!context.currentNode)
3366 return noCurrentNodeError(interp, loc);
3367 node = context.currentNode;
3370 if (!convertGeneralName(argv[0], node, gi))
3371 return argError(interp, loc,
3372 InterpreterMessages::notAString, 0, argv[0]);
3373 ELObjDynamicRoot result(interp, interp.makeNil());
3374 while (node->getParent(node) == accessOK) {
3376 if (node->getGi(str) == accessOK
3377 && str == GroveString(gi.data(), gi.size())) {
3379 interp.childNumber(node, num);
3380 PairObj *pair = new (interp) PairObj(0, result);
3382 pair->setCar(interp.makeInteger(num + 1));
3388 DEFPRIMITIVE(ElementNumber, argc, argv, context, interp, loc)
3392 if (!argv[0]->optSingletonNodeList(context, interp, node) || !node)
3393 return argError(interp, loc,
3394 InterpreterMessages::notASingletonNode, 0, argv[0]);
3397 if (!context.currentNode)
3398 return noCurrentNodeError(interp, loc);
3399 node = context.currentNode;
3402 if (node->getGi(gi) != accessOK)
3403 return interp.makeFalse();
3404 StringC buf(gi.data(), gi.size());
3405 unsigned long num = interp.elementNumber(node, buf);
3406 return interp.makeInteger(num);
3409 DEFPRIMITIVE(ElementNumberList, argc, argv, context, interp, loc)
3413 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3414 return argError(interp, loc,
3415 InterpreterMessages::notASingletonNode, 1, argv[1]);
3418 if (!context.currentNode)
3419 return noCurrentNodeError(interp, loc);
3420 node = context.currentNode;
3422 ELObjDynamicRoot list(interp, 0);
3424 while (!p->isNil()) {
3425 PairObj *tem = p->asPair();
3427 return argError(interp, loc,
3428 InterpreterMessages::notAList, 0, argv[0]);
3429 list = new (interp) PairObj(tem->car(), list);
3432 ELObjDynamicRoot result(interp, interp.makeNil());
3435 PairObj *pair = (PairObj *)p;
3437 if (!convertGeneralName(pair->car(), node, gi))
3438 return argError(interp, loc,
3439 InterpreterMessages::notAString, 0, pair->car());
3442 pair = (PairObj *)p;
3444 if (!convertGeneralName(pair->car(), node, gi))
3445 return argError(interp, loc,
3446 InterpreterMessages::notAString, 0, pair->car());
3447 unsigned long num = interp.elementNumberAfter(node, numGi, gi);
3448 PairObj *tem = new (interp) PairObj(0, result);
3450 tem->setCar(interp.makeInteger(num));
3453 unsigned long num = interp.elementNumber(node, gi);
3454 PairObj *tem = new (interp) PairObj(0, result);
3456 tem->setCar(interp.makeInteger(num));
3461 DEFPRIMITIVE(EntityAttributeString, argc, argv, context, interp, loc)
3463 const Char *entityName;
3464 size_t entityNameLen;
3465 if (!argv[0]->stringData(entityName, entityNameLen))
3466 return argError(interp, loc,
3467 InterpreterMessages::notAString, 0, argv[0]);
3468 const Char *attName;
3470 if (!argv[1]->stringData(attName, attNameLen))
3471 return argError(interp, loc,
3472 InterpreterMessages::notAString, 1, argv[1]);
3475 if (!argv[2]->optSingletonNodeList(context, interp, node) || !node)
3476 return argError(interp, loc,
3477 InterpreterMessages::notASingletonNode, 2, argv[2]);
3480 node = context.currentNode;
3482 return noCurrentNodeError(interp, loc);
3484 NamedNodeListPtr entities;
3486 if (node->getGroveRoot(node) == accessOK
3487 && node->getEntities(entities) == accessOK
3488 && entities->namedNode(GroveString(entityName, entityNameLen), node) == accessOK
3489 && nodeAttributeString(node, attName, attNameLen, interp, value))
3490 return new (interp) StringObj(value);
3491 return interp.makeFalse();
3494 DEFPRIMITIVE(EntityGeneratedSystemId, argc, argv, context, interp, loc)
3498 if (!argv[0]->stringData(s, n))
3499 return argError(interp, loc,
3500 InterpreterMessages::notAString, 0, argv[0]);
3503 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3504 return argError(interp, loc,
3505 InterpreterMessages::notASingletonNode, 1, argv[1]);
3508 node = context.currentNode;
3510 return noCurrentNodeError(interp, loc);
3513 NamedNodeListPtr entities;
3514 if (node->getGroveRoot(node) == accessOK
3515 && node->getEntities(entities) == accessOK
3516 && entities->namedNode(GroveString(s, n), node) == accessOK
3517 && node->getExternalId(node) == accessOK
3518 && node->getGeneratedSystemId(str) == accessOK)
3519 return new (interp) StringObj(str.data(), str.size());
3520 return interp.makeFalse();
3523 DEFPRIMITIVE(EntitySystemId, argc, argv, context, interp, loc)
3527 if (!argv[0]->stringData(s, n))
3528 return argError(interp, loc,
3529 InterpreterMessages::notAString, 0, argv[0]);
3532 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3533 return argError(interp, loc,
3534 InterpreterMessages::notASingletonNode, 1, argv[1]);
3537 node = context.currentNode;
3539 return noCurrentNodeError(interp, loc);
3542 NamedNodeListPtr entities;
3543 if (node->getGroveRoot(node) == accessOK
3544 && node->getEntities(entities) == accessOK
3545 && entities->namedNode(GroveString(s, n), node) == accessOK
3546 && node->getExternalId(node) == accessOK
3547 && node->getSystemId(str) == accessOK)
3548 return new (interp) StringObj(str.data(), str.size());
3549 return interp.makeFalse();
3552 DEFPRIMITIVE(EntityPublicId, argc, argv, context, interp, loc)
3556 if (!argv[0]->stringData(s, n))
3557 return argError(interp, loc,
3558 InterpreterMessages::notAString, 0, argv[0]);
3561 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3562 return argError(interp, loc,
3563 InterpreterMessages::notASingletonNode, 1, argv[1]);
3566 node = context.currentNode;
3568 return noCurrentNodeError(interp, loc);
3571 NamedNodeListPtr entities;
3572 if (node->getGroveRoot(node) == accessOK
3573 && node->getEntities(entities) == accessOK) {
3575 tem.resize(entities->normalize(tem.begin(), tem.size()));
3576 if (entities->namedNode(GroveString(tem.data(), tem.size()), node) == accessOK
3577 && node->getExternalId(node) == accessOK
3578 && node->getPublicId(str) == accessOK)
3579 return new (interp) StringObj(str.data(), str.size());
3581 return interp.makeFalse();
3584 DEFPRIMITIVE(EntityNotation, argc, argv, context, interp, loc)
3588 if (!argv[0]->stringData(s, n))
3589 return argError(interp, loc,
3590 InterpreterMessages::notAString, 0, argv[0]);
3593 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3594 return argError(interp, loc,
3595 InterpreterMessages::notASingletonNode, 1, argv[1]);
3598 node = context.currentNode;
3600 return noCurrentNodeError(interp, loc);
3603 NamedNodeListPtr entities;
3604 if (node->getGroveRoot(node) == accessOK
3605 && node->getEntities(entities) == accessOK
3606 && entities->namedNode(GroveString(s, n), node) == accessOK
3607 && node->getNotation(node) == accessOK
3608 && node->getName(str) == accessOK)
3609 return new (interp) StringObj(str.data(), str.size());
3610 return interp.makeFalse();
3613 DEFPRIMITIVE(EntityText, argc, argv, context, interp, loc)
3617 if (!argv[0]->stringData(s, n))
3618 return argError(interp, loc,
3619 InterpreterMessages::notAString, 0, argv[0]);
3622 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3623 return argError(interp, loc,
3624 InterpreterMessages::notASingletonNode, 1, argv[1]);
3627 node = context.currentNode;
3629 return noCurrentNodeError(interp, loc);
3632 NamedNodeListPtr entities;
3633 if (node->getGroveRoot(node) == accessOK
3634 && node->getEntities(entities) == accessOK
3635 && entities->namedNode(GroveString(s, n), node) == accessOK
3636 && node->getText(str) == accessOK)
3637 return new (interp) StringObj(str.data(), str.size());
3638 return interp.makeFalse();
3641 DEFPRIMITIVE(EntityType, argc, argv, context, interp, loc)
3645 if (!argv[0]->stringData(s, n))
3646 return argError(interp, loc,
3647 InterpreterMessages::notAString, 0, argv[0]);
3650 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3651 return argError(interp, loc,
3652 InterpreterMessages::notASingletonNode, 1, argv[1]);
3655 node = context.currentNode;
3657 return noCurrentNodeError(interp, loc);
3659 NamedNodeListPtr entities;
3660 Node::EntityType::Enum type;
3661 if (node->getGroveRoot(node) == accessOK
3662 && node->getEntities(entities) == accessOK
3663 && entities->namedNode(GroveString(s, n), node) == accessOK
3664 && node->getEntityType(type) == accessOK) {
3667 case Node::EntityType::text:
3670 case Node::EntityType::cdata:
3673 case Node::EntityType::sdata:
3676 case Node::EntityType::ndata:
3679 case Node::EntityType::subdocument:
3682 case Node::EntityType::pi:
3688 return interp.makeSymbol(interp.makeStringC(s));
3690 return interp.makeFalse();
3693 DEFPRIMITIVE(NotationSystemId, argc, argv, context, interp, loc)
3697 if (!argv[0]->stringData(s, n))
3698 return argError(interp, loc,
3699 InterpreterMessages::notAString, 0, argv[0]);
3702 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3703 return argError(interp, loc,
3704 InterpreterMessages::notASingletonNode, 1, argv[1]);
3707 node = context.currentNode;
3709 return noCurrentNodeError(interp, loc);
3712 NamedNodeListPtr notations;
3713 if (node->getGroveRoot(node) == accessOK
3714 && node->getGoverningDoctype(node) == accessOK
3715 && node->getNotations(notations) == accessOK
3716 && notations->namedNode(GroveString(s, n), node) == accessOK
3717 && node->getExternalId(node) == accessOK
3718 && node->getSystemId(str) == accessOK)
3719 return new (interp) StringObj(str.data(), str.size());
3720 return interp.makeFalse();
3723 DEFPRIMITIVE(NotationPublicId, argc, argv, context, interp, loc)
3727 if (!argv[0]->stringData(s, n))
3728 return argError(interp, loc,
3729 InterpreterMessages::notAString, 0, argv[0]);
3732 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3733 return argError(interp, loc,
3734 InterpreterMessages::notASingletonNode, 1, argv[1]);
3737 node = context.currentNode;
3739 return noCurrentNodeError(interp, loc);
3742 NamedNodeListPtr notations;
3743 if (node->getGroveRoot(node) == accessOK
3744 && node->getGoverningDoctype(node) == accessOK
3745 && node->getNotations(notations) == accessOK
3746 && notations->namedNode(GroveString(s, n), node) == accessOK
3747 && node->getExternalId(node) == accessOK
3748 && node->getPublicId(str) == accessOK)
3749 return new (interp) StringObj(str.data(), str.size());
3750 return interp.makeFalse();
3753 DEFPRIMITIVE(NotationGeneratedSystemId, argc, argv, context, interp, loc)
3757 if (!argv[0]->stringData(s, n))
3758 return argError(interp, loc,
3759 InterpreterMessages::notAString, 0, argv[0]);
3762 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3763 return argError(interp, loc,
3764 InterpreterMessages::notASingletonNode, 1, argv[1]);
3767 node = context.currentNode;
3769 return noCurrentNodeError(interp, loc);
3772 NamedNodeListPtr notations;
3773 if (node->getGroveRoot(node) == accessOK
3774 && node->getGoverningDoctype(node) == accessOK
3775 && node->getNotations(notations) == accessOK
3776 && notations->namedNode(GroveString(s, n), node) == accessOK
3777 && node->getExternalId(node) == accessOK
3778 && node->getGeneratedSystemId(str) == accessOK)
3779 return new (interp) StringObj(str.data(), str.size());
3780 return interp.makeFalse();
3783 DEFPRIMITIVE(GeneralNameNormalize, argc, argv, context, interp, loc)
3787 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3788 return argError(interp, loc,
3789 InterpreterMessages::notASingletonNode, 1, argv[1]);
3792 node = context.currentNode;
3794 return noCurrentNodeError(interp, loc);
3797 if (!convertGeneralName(argv[0], node, result))
3798 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3799 return new (interp) StringObj(result);
3802 DEFPRIMITIVE(EntityNameNormalize, argc, argv, context, interp, loc)
3806 if (!argv[0]->stringData(s, n))
3807 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3810 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
3811 return argError(interp, loc,
3812 InterpreterMessages::notASingletonNode, 1, argv[1]);
3815 node = context.currentNode;
3817 return noCurrentNodeError(interp, loc);
3819 StringC result(s, n);
3821 node->getGroveRoot(node);
3822 NamedNodeListPtr entities;
3823 node->getEntities(entities);
3824 result.resize(entities->normalize(result.begin(), result.size()));
3825 return new (interp) StringObj(result);
3828 DEFPRIMITIVE(NodeListFirst, argc, argv, context, interp, loc)
3830 NodeListObj *nl = argv[0]->asNodeList();
3832 return argError(interp, loc,
3833 InterpreterMessages::notANodeList, 0, argv[0]);
3834 NodePtr nd = nl->nodeListFirst(context, interp);
3835 return new (interp) NodePtrNodeListObj(nd);
3838 DEFPRIMITIVE(NodeListRest, argc, argv, context, interp, loc)
3840 NodeListObj *nl = argv[0]->asNodeList();
3842 return argError(interp, loc,
3843 InterpreterMessages::notANodeList, 0, argv[0]);
3844 return nl->nodeListRest(context, interp);
3847 DEFPRIMITIVE(NodeList, argc, argv, context, interp, loc)
3850 return interp.makeEmptyNodeList();
3852 NodeListObj *nl = argv[i]->asNodeList();
3854 return argError(interp, loc,
3855 InterpreterMessages::notANodeList, i, argv[i]);
3857 ELObjDynamicRoot protect(interp, nl);
3860 NodeListObj *tem = argv[i]->asNodeList();
3862 return argError(interp, loc,
3863 InterpreterMessages::notANodeList, i, argv[i]);
3864 nl = new (interp) PairNodeListObj(tem, nl);
3873 DEFPRIMITIVE(NodeListNoOrder, argc, argv, context, interp, loc)
3875 NodeListObj *nl = argv[0]->asNodeList();
3877 return argError(interp, loc,
3878 InterpreterMessages::notANodeList, 0, argv[0]);
3879 return nl->nodeListNoOrder(interp);
3882 DEFPRIMITIVE(IsNodeListEqual, argc, argv, context, interp, loc)
3884 NodeListObj *nl1 = argv[0]->asNodeList();
3886 return argError(interp, loc,
3887 InterpreterMessages::notANodeList, 0, argv[0]);
3889 return interp.makeTrue();
3890 NodeListObj *nl2 = argv[1]->asNodeList();
3892 return argError(interp, loc,
3893 InterpreterMessages::notANodeList, 1, argv[1]);
3894 ELObjDynamicRoot protect1(interp, nl1);
3895 ELObjDynamicRoot protect2(interp, nl2);
3897 NodePtr nd1 = nl1->nodeListFirst(context, interp);
3898 NodePtr nd2 = nl2->nodeListFirst(context, interp);
3901 return interp.makeFalse();
3906 return interp.makeFalse();
3907 else if (*nd1 != *nd2)
3908 return interp.makeFalse();
3909 nl1 = nl1->nodeListRest(context, interp);
3911 nl2 = nl2->nodeListRest(context, interp);
3914 return interp.makeTrue();
3917 DEFPRIMITIVE(IsNamedNodeList, argc, argv, context, interp, loc)
3919 if (argv[0]->asNamedNodeList())
3920 return interp.makeTrue();
3922 return interp.makeFalse();
3925 DEFPRIMITIVE(NamedNode, argc, argv, context, interp, loc)
3929 if (!argv[0]->stringData(s, n))
3930 return argError(interp, loc,
3931 InterpreterMessages::notAString, 0, argv[0]);
3932 NamedNodeListObj *nnl = argv[1]->asNamedNodeList();
3934 return argError(interp, loc,
3935 InterpreterMessages::notANamedNodeList, 1, argv[1]);
3936 return new (interp) NodePtrNodeListObj(nnl->namedNode(s, n));
3939 DEFPRIMITIVE(NamedNodeListNormalize, argc, argv, context, interp, loc)
3943 if (!argv[0]->stringData(s, n))
3944 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
3945 NamedNodeListObj *nnl = argv[1]->asNamedNodeList();
3947 return argError(interp, loc,
3948 InterpreterMessages::notANamedNodeList, 1, argv[1]);
3949 if (!argv[2]->asSymbol())
3950 return argError(interp, loc,
3951 InterpreterMessages::notASymbol, 2, argv[2]);
3952 StringC result(s, n);
3953 result.resize(nnl->normalize(result.begin(), result.size()));
3954 return new (interp) StringObj(result);
3957 DEFPRIMITIVE(NamedNodeListNames, argc, argv, context, interp, loc)
3959 NamedNodeListObj *nnl = argv[0]->asNamedNodeList();
3961 return argError(interp, loc,
3962 InterpreterMessages::notANamedNodeList, 0, argv[0]);
3963 NodeListObj *nl = nnl;
3964 PairObj *tail = interp.makePair(0, 0);
3965 PairObj *head = tail;
3966 ELObjDynamicRoot protect(interp, head);
3968 ELObjDynamicRoot protect(interp, nl);
3969 NodePtr nd = nl->nodeListFirst(context, interp);
3973 if (nnl->nodeName(nd, str)) {
3974 // protect the StringObj by putting in the head's car
3975 head->setCar(new (interp) StringObj(str.data(), str.size()));
3976 PairObj *newTail = new (interp) PairObj(head->car(), 0);
3977 tail->setCdr(newTail);
3980 nl = nl->nodeListRest(context, interp);
3982 tail->setCdr(interp.makeNil());
3986 DEFPRIMITIVE(Children, argc, argv, context, interp, loc)
3989 if (!argv[0]->optSingletonNodeList(context, interp, node)) {
3990 NodeListObj *nl = argv[0]->asNodeList();
3992 return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
3993 return argError(interp, loc,
3994 InterpreterMessages::notANodeList, 0, argv[0]);
3999 if (node->children(nl) != accessOK)
4000 return interp.makeEmptyNodeList();
4001 return new (interp) NodeListPtrNodeListObj(nl);
4004 DEFPRIMITIVE(Follow, argc, argv, context, interp, loc)
4007 if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4008 NodeListObj *nl = argv[0]->asNodeList();
4010 return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4011 return argError(interp, loc,
4012 InterpreterMessages::notANodeList, 0, argv[0]);
4017 if (node->follow(nl) != accessOK)
4018 return interp.makeEmptyNodeList();
4019 return new (interp) NodeListPtrNodeListObj(nl);
4022 DEFPRIMITIVE(Descendants, argc, argv, context, interp, loc)
4025 if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4026 NodeListObj *nl = argv[0]->asNodeList();
4028 return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4029 return argError(interp, loc,
4030 InterpreterMessages::notANodeList, 0, argv[0]);
4032 return new (interp) DescendantsNodeListObj(node);
4035 DEFPRIMITIVE(Preced, argc, argv, context, interp, loc)
4038 if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4039 NodeListObj *nl = argv[0]->asNodeList();
4041 return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4042 return argError(interp, loc,
4043 InterpreterMessages::notANodeList, 0, argv[0]);
4046 if (!node || node->firstSibling(first) != accessOK)
4047 return interp.makeEmptyNodeList();
4048 return new (interp) SiblingNodeListObj(first, node);
4051 DEFPRIMITIVE(Attributes, argc, argv, context, interp, loc)
4054 if (!argv[0]->optSingletonNodeList(context, interp, node)) {
4055 NodeListObj *nl = argv[0]->asNodeList();
4057 return new (interp) MapNodeListObj(this, nl, new MapNodeListObj::Context(context, loc));
4058 return argError(interp, loc,
4059 InterpreterMessages::notANodeList, 0, argv[0]);
4063 NamedNodeListPtr nnl;
4064 if (node->getAttributes(nnl) != accessOK)
4065 return interp.makeEmptyNodeList();
4066 return new (interp) NamedNodeListPtrNodeListObj(nnl);
4070 void nodeData(const NodePtr &nd, const SdataMapper &mapper, bool chunk, StringC &s)
4073 if (nd->charChunk(mapper, tem) == accessOK) {
4074 s.append(tem.data(), chunk ? tem.size() : 1);
4077 if (nd->tokens(tem) == accessOK) {
4078 s.append(tem.data(), tem.size());
4082 if (nd->firstChild(cnd) == accessOK) {
4084 nodeData(cnd, mapper, 1, s);
4085 } while (cnd.assignNextChunkSibling() == accessOK);
4088 // This happens if the data procedure is called on an AVT node
4089 if (nd->getToken(tem) == accessOK)
4090 s.append(tem.data(), tem.size());
4093 DEFPRIMITIVE(Data, argc, argv, context, interp, loc)
4095 NodeListObj *nl = argv[0]->asNodeList();
4097 return argError(interp, loc,
4098 InterpreterMessages::notANodeList, 0, argv[0]);
4099 StringObj *s = new (interp) StringObj;
4100 ELObjDynamicRoot protect(interp, s);
4102 ELObjDynamicRoot protect(interp, nl);
4103 NodePtr nd = nl->nodeListFirst(context, interp);
4107 nl = nl->nodeListChunkRest(context, interp, chunk);
4108 nodeData(nd, interp, chunk, *s);
4113 DEFPRIMITIVE(ElementWithId, argc, argv, context, interp, loc)
4117 if (!argv[0]->stringData(s, n))
4118 return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
4121 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
4122 return argError(interp, loc,
4123 InterpreterMessages::notASingletonNode, 1, argv[1]);
4126 node = context.currentNode;
4128 return noCurrentNodeError(interp, loc);
4130 NamedNodeListPtr elements;
4131 if (node->getGroveRoot(node) == accessOK
4132 && node->getElements(elements) == accessOK
4133 && elements->namedNode(GroveString(s, n), node) == accessOK)
4134 return new (interp) NodePtrNodeListObj(node);
4135 return interp.makeEmptyNodeList();
4138 DEFPRIMITIVE(EmptyNodeList, argc, argv, context, interp, loc)
4140 return interp.makeEmptyNodeList();
4144 bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
4145 int nKeys, Interpreter &interp, const Location &loc, int *pos)
4147 if ((argc & 1) == 1) {
4148 interp.setNextLocation(loc);
4149 interp.message(InterpreterMessages::oddKeyArgs);
4152 for (int i = 0; i < nKeys; i++)
4154 // First has priority, so scan in reverse order
4155 for (int i = argc - 1; i > 0; i -= 2) {
4156 KeywordObj *keyObj = argv[i - 1]->asKeyword();
4158 interp.setNextLocation(loc);
4159 interp.message(InterpreterMessages::keyArgsNotKey);
4163 Identifier::SyntacticKey key;
4164 if (keyObj->identifier()->syntacticKey(key)) {
4165 for (int j = 0; j < nKeys; j++) {
4166 if (key == keys[j]) {
4173 interp.setNextLocation(loc);
4174 interp.message(InterpreterMessages::invalidKeyArg,
4175 StringMessageArg(keyObj->identifier()->name()));
4182 DEFPRIMITIVE(NodeProperty, argc, argv, context, interp, loc)
4184 StringObj *str = argv[0]->convertToString();
4186 return argError(interp, loc,
4187 InterpreterMessages::notAStringOrSymbol, 0, argv[0]);
4189 if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
4190 return argError(interp, loc,
4191 InterpreterMessages::notASingletonNode, 1, argv[1]);
4192 static const Identifier::SyntacticKey keys[3] = {
4193 Identifier::keyDefault, Identifier::keyNull, Identifier::keyIsRcs
4196 if (!decodeKeyArgs(argc - 2, argv + 2, keys, 3, interp, loc, pos))
4197 return interp.makeError();
4198 //FIXME: this is just a hack to fix the single duplicate rcsname 'tokens';
4199 // should really be handled in Interpreter.
4201 ComponentName::Id cls;
4202 ComponentName::Id id = ComponentName::noId;
4203 if (*str == "tokens"
4204 && node->getClassName(cls) == accessOK
4205 && cls == ComponentName::idModelGroup)
4206 id = ComponentName::idContentTokens;
4208 interp.lookupNodeProperty(*str, id);
4209 if (id != ComponentName::noId) {
4210 ELObjPropertyValue value(interp,
4212 && argv[pos[2] + 2] != interp.makeFalse());
4213 AccessResult ret = node->property(id, interp, value);
4214 if (ret == accessOK)
4216 if (ret == accessNull && pos[1] >= 0)
4217 return argv[pos[1] + 2];
4220 interp.setNextLocation(loc);
4221 interp.message(InterpreterMessages::noNodePropertyValue,
4222 StringMessageArg(*str));
4223 return interp.makeError();
4225 return argv[pos[0] + 2];
4228 DEFPRIMITIVE(SelectByClass, argc, argv, context, interp, loc)
4230 NodeListObj *nl = argv[0]->asNodeList();
4232 return argError(interp, loc,
4233 InterpreterMessages::notANodeList, 0, argv[0]);
4234 StringObj *str = argv[1]->convertToString();
4236 return argError(interp, loc,
4237 InterpreterMessages::notAStringOrSymbol, 1, argv[1]);
4238 ComponentName::Id id;
4239 if (!interp.lookupNodeProperty(*str, id))
4240 return interp.makeEmptyNodeList();
4241 return new (interp) SelectByClassNodeListObj(nl, id);
4244 DEFPRIMITIVE(NodeListMap, argc, argv, context, interp, loc)
4246 FunctionObj *func = argv[0]->asFunction();
4248 return argError(interp, loc,
4249 InterpreterMessages::notAProcedure, 0, argv[0]);
4250 if (func->nRequiredArgs() > 1) {
4251 interp.setNextLocation(loc);
4253 interp.message(InterpreterMessages::missingArg);
4254 return interp.makeError();
4256 if (func->nRequiredArgs() + func->nOptionalArgs() + func->restArg() == 0) {
4257 interp.setNextLocation(loc);
4259 interp.message(InterpreterMessages::tooManyArgs);
4260 return interp.makeError();
4262 interp.makeReadOnly(func);
4263 NodeListObj *nl = argv[1]->asNodeList();
4265 return argError(interp, loc,
4266 InterpreterMessages::notANodeList, 1, argv[1]);
4267 return new (interp) MapNodeListObj(func, nl, new MapNodeListObj::Context(context, loc));
4270 DEFPRIMITIVE(NodeListRef, argc, argv, context, interp, loc)
4272 NodeListObj *nl = argv[0]->asNodeList();
4274 return argError(interp, loc,
4275 InterpreterMessages::notANodeList, 0, argv[0]);
4277 if (!argv[1]->exactIntegerValue(k))
4278 return argError(interp, loc,
4279 InterpreterMessages::notAnExactInteger, 1, argv[1]);
4280 // Must use temporary variable, because operator new may bew called before nodeListRef.
4281 NodePtr nd(nl->nodeListRef(k, context, interp));
4282 return new (interp) NodePtrNodeListObj(nd);
4285 DEFPRIMITIVE(NodeListReverse, argc, argv, context, interp, loc)
4287 NodeListObj *nl = argv[0]->asNodeList();
4289 return argError(interp, loc,
4290 InterpreterMessages::notANodeList, 0, argv[0]);
4291 return nl->nodeListReverse(context, interp);
4294 DEFPRIMITIVE(NodeListLength, argc, argv, context, interp, loc)
4296 NodeListObj *nl = argv[0]->asNodeList();
4298 return argError(interp, loc,
4299 InterpreterMessages::notANodeList, 0, argv[0]);
4300 return interp.makeInteger(nl->nodeListLength(context, interp));
4303 DEFPRIMITIVE(SgmlParse, argc, argv, context, interp, loc)
4307 if (!argv[0]->stringData(s, n))
4308 return argError(interp, loc,
4309 InterpreterMessages::notAString, 0, argv[0]);
4310 StringC sysid(s, n);
4311 static const Identifier::SyntacticKey keys[2] = {
4312 Identifier::keyActive, Identifier::keyParent
4315 if (!decodeKeyArgs(argc - 1, argv + 1, keys, 2, interp, loc, pos))
4316 return interp.makeError();
4317 Vector<StringC> lists[2];
4319 ELObj *obj = argv[pos[0] + 1];
4320 while (!obj->isNil()) {
4321 PairObj *pair = obj->asPair();
4323 return argError(interp, loc,
4324 InterpreterMessages::notAList, pos[0] + 1, argv[pos[0] + 1]);
4325 if (!pair->car()->stringData(s, n))
4326 return argError(interp, loc,
4327 InterpreterMessages::notAString, pos[0] + 1, pair->car());
4328 lists[0].resize(lists[0].size() + 1);
4329 lists[0].back().assign(s, n);
4336 if (!argv[pos[1] + 1]->optSingletonNodeList(context, interp, parent) || !parent)
4337 return argError(interp, loc,
4338 InterpreterMessages::notASingletonNode, pos[1] + 1, argv[pos[1] + 1]);
4342 if (!interp.groveManager()->load(sysid, lists[0], parent, nd, lists[1]))
4343 return interp.makeEmptyNodeList();
4344 return new (interp) NodePtrNodeListObj(nd);
4347 DEFPRIMITIVE(XSgmlParse, argc, argv, context, interp, loc)
4351 if (!argv[0]->stringData(s, n))
4352 return argError(interp, loc,
4353 InterpreterMessages::notAString, 0, argv[0]);
4354 StringC sysid(s, n);
4355 static const Identifier::SyntacticKey keys[3] = {
4356 Identifier::keyActive, Identifier::keyArchitecture, Identifier::keyParent
4359 if (!decodeKeyArgs(argc - 1, argv + 1, keys, 3, interp, loc, pos))
4360 return interp.makeError();
4361 Vector<StringC> lists[2];
4362 for (int i = 0; i < 3; i++) {
4364 ELObj *obj = argv[pos[0] + 1];
4365 while (!obj->isNil()) {
4366 PairObj *pair = obj->asPair();
4368 return argError(interp, loc,
4369 InterpreterMessages::notAList, pos[i] + 1, argv[pos[i] + 1]);
4370 if (!pair->car()->stringData(s, n))
4371 return argError(interp, loc,
4372 InterpreterMessages::notAString, pos[i] + 1, pair->car());
4373 lists[i].resize(lists[i].size() + 1);
4374 lists[i].back().assign(s, n);
4382 if (!argv[pos[2] + 1]->optSingletonNodeList(context, interp, parent) || !parent)
4383 return argError(interp, loc,
4384 InterpreterMessages::notASingletonNode, pos[2] + 1, argv[pos[2] + 1]);
4388 if (!interp.groveManager()->load(sysid, lists[0], parent, nd, lists[1]))
4389 return interp.makeEmptyNodeList();
4390 return new (interp) NodePtrNodeListObj(nd);
4393 DEFPRIMITIVE(ReadEntity, argc, argv, context, interp, loc)
4397 if (!argv[0]->stringData(s, n))
4398 return argError(interp, loc,
4399 InterpreterMessages::notAString, 0, argv[0]);
4400 StringC sysid(s, n);
4401 StringObj *contents = new (interp) StringObj;
4402 if (interp.groveManager()->readEntity(sysid, *contents))
4404 return interp.makeError();
4407 DEFPRIMITIVE(Debug, argc, argv, context, interp, loc)
4409 interp.setNextLocation(loc);
4410 interp.message(InterpreterMessages::debug, ELObjMessageArg(argv[0], interp));
4414 DEFPRIMITIVE(IfFirstPage, argc, argv, context, interp, loc)
4416 SosofoObj *sosofo[2];
4417 for (int i = 0; i < 2; i++) {
4418 sosofo[i] = argv[i]->asSosofo();
4420 return argError(interp, loc, InterpreterMessages::notASosofo,
4423 return new (interp) PageTypeSosofoObj(FOTBuilder::firstHF, sosofo[0], sosofo[1]);
4426 DEFPRIMITIVE(IfFrontPage, argc, argv, context, interp, loc)
4428 SosofoObj *sosofo[2];
4429 for (int i = 0; i < 2; i++) {
4430 sosofo[i] = argv[i]->asSosofo();
4432 return argError(interp, loc, InterpreterMessages::notASosofo,
4435 return new (interp) PageTypeSosofoObj(FOTBuilder::frontHF, sosofo[0], sosofo[1]);
4438 DEFPRIMITIVE(AllElementNumber, argc, argv, context, interp, loc)
4442 if (!argv[0]->optSingletonNodeList(context, interp, node))
4443 return argError(interp, loc,
4444 InterpreterMessages::notAnOptSingletonNode, 0, argv[0]);
4447 if (!context.currentNode)
4448 return noCurrentNodeError(interp, loc);
4449 node = context.currentNode;
4452 if (node && node->elementIndex(n) == accessOK)
4453 return interp.makeInteger(long(n) + 1);
4455 return interp.makeFalse();
4458 DEFPRIMITIVE(IsVector, argc, argv, context, interp, loc)
4460 if (argv[0]->asVector())
4461 return interp.makeTrue();
4463 return interp.makeFalse();
4466 DEFPRIMITIVE(Vector, argc, argv, context, interp, loc)
4468 Vector<ELObj *> v(argc);
4469 for (size_t i = 0; i < argc; i++)
4471 return new (interp) VectorObj(v);
4474 DEFPRIMITIVE(MakeVector, argc, argv, context, interp, loc)
4477 if (!argv[0]->exactIntegerValue(k))
4478 return argError(interp, loc,
4479 InterpreterMessages::notAnExactInteger, 0, argv[0]);
4481 interp.setNextLocation(loc);
4482 interp.message(InterpreterMessages::outOfRange);
4483 return interp.makeError();
4485 ELObj *fill = argc > 1 ? argv[1] : interp.makeUnspecified();
4486 Vector<ELObj *> v((size_t)k);
4487 for (size_t i = 0; i < v.size(); i++)
4489 return new (interp) VectorObj(v);
4492 DEFPRIMITIVE(VectorSet, argc, argv, context, interp, loc)
4494 VectorObj *v = argv[0]->asVector();
4496 return argError(interp, loc,
4497 InterpreterMessages::notAVector, 0, argv[0]);
4499 if (!argv[1]->exactIntegerValue(k))
4500 return argError(interp, loc,
4501 InterpreterMessages::notAnExactInteger, 1, argv[1]);
4502 if (k < 0 || (unsigned long)k >= v->size()) {
4503 interp.setNextLocation(loc);
4504 interp.message(InterpreterMessages::outOfRange);
4505 return interp.makeError();
4507 if (v->readOnly()) {
4508 interp.setNextLocation(loc);
4509 interp.message(InterpreterMessages::readOnly);
4510 return interp.makeError();
4513 return interp.makeUnspecified();
4516 DEFPRIMITIVE(VectorRef, argc, argv, context, interp, loc)
4518 VectorObj *v = argv[0]->asVector();
4520 return argError(interp, loc,
4521 InterpreterMessages::notAVector, 0, argv[0]);
4523 if (!argv[1]->exactIntegerValue(k))
4524 return argError(interp, loc,
4525 InterpreterMessages::notAnExactInteger, 1, argv[1]);
4526 if (k < 0 || (unsigned long)k >= v->size()) {
4527 interp.setNextLocation(loc);
4528 interp.message(InterpreterMessages::outOfRange);
4529 return interp.makeError();
4534 DEFPRIMITIVE(VectorToList, argc, argv, context, interp, loc)
4536 VectorObj *v = argv[0]->asVector();
4538 return argError(interp, loc,
4539 InterpreterMessages::notAVector, 0, argv[0]);
4540 Vector<ELObj *> &vec = *v;
4541 ELObjDynamicRoot result(interp, interp.makeNil());
4542 for (size_t i = vec.size(); i > 0; i--)
4543 result = new (interp) PairObj(vec[i - 1], result);
4547 DEFPRIMITIVE(ListToVector, argc, argv, context, interp, loc)
4550 ELObj *obj = argv[0];
4551 while (!obj->isNil()) {
4552 PairObj *pair = obj->asPair();
4554 return argError(interp, loc, InterpreterMessages::notAList, 0, obj);
4555 v.push_back(pair->car());
4558 return new (interp) VectorObj(v);
4561 DEFPRIMITIVE(VectorFill, argc, argv, context, interp, loc)
4563 VectorObj *v = argv[0]->asVector();
4565 return argError(interp, loc,
4566 InterpreterMessages::notAVector, 0, argv[0]);
4567 if (v->readOnly()) {
4568 interp.setNextLocation(loc);
4569 interp.message(InterpreterMessages::readOnly);
4570 return interp.makeError();
4572 Vector<ELObj *> &vec = *v;
4573 for (size_t i = 0; i < vec.size(); i++)
4575 return interp.makeUnspecified();
4578 DEFPRIMITIVE(Language, argc, argv, context, interp, loc)
4580 StringObj *lang = argv[0]->convertToString();
4582 return argError(interp, loc,
4583 InterpreterMessages::notAStringOrSymbol, 0, argv[0]);
4584 StringObj *country = argv[1]->convertToString();
4586 return argError(interp, loc,
4587 InterpreterMessages::notAStringOrSymbol, 1, argv[1]);
4588 #ifdef SP_HAVE_LOCALE
4589 #ifdef SP_HAVE_WCHAR
4590 if (RefLangObj::supportedLanguage(*lang, *country))
4591 return new (interp) RefLangObj (*lang, *country);
4595 return interp.makeFalse();
4598 DEFPRIMITIVE(IsLanguage, argc, argv, context, interp, loc)
4600 if (argv[0]->asLanguage())
4601 return interp.makeTrue();
4603 return interp.makeFalse();
4606 DEFPRIMITIVE(CurrentLanguage, argc, argv, context, interp, loc)
4608 if (context.currentLanguage)
4609 return context.currentLanguage;
4611 return interp.defaultLanguage();
4614 DEFPRIMITIVE(WithLanguage, argc, argv, context, interp, loc)
4616 // Check that argv[0] is a language
4617 LanguageObj *lang = argv[0]->asLanguage();
4619 return argError(interp, loc,
4620 InterpreterMessages::notALanguage, 0, argv[0]);
4621 // Check that argv[1] is a thunk
4622 FunctionObj *func = argv[1]->asFunction();
4624 return argError(interp, loc,
4625 InterpreterMessages::notAProcedure, 1, argv[1]);
4626 if (func->totalArgs() > 0) {
4627 interp.message(InterpreterMessages::tooManyArgs);
4628 return interp.makeError();
4630 LanguageObj *savedLanguage = context.currentLanguage;
4631 context.currentLanguage = lang;
4632 VM vm(context, interp);
4633 InsnPtr insn(func->makeCallInsn(0, interp, loc, InsnPtr()));
4634 ELObj *ret = vm.eval(insn.pointer());
4635 context.currentLanguage = savedLanguage;
4639 #define GETCURLANG(lang,context,interp) \
4640 const LanguageObj *lang; \
4641 if (context.currentLanguage != 0) \
4642 lang = context.currentLanguage; \
4643 else if (interp.defaultLanguage()->asLanguage() != 0) \
4644 lang = interp.defaultLanguage()->asLanguage(); \
4646 interp.message(InterpreterMessages::noCurrentLanguage); \
4647 return interp.makeError(); \
4650 DEFPRIMITIVE(CharLess, argc, argv, context, interp, loc)
4652 GETCURLANG(lang, context, interp);
4654 for (unsigned i = 0; i < 2; i++)
4655 if (!argv[i]->charValue(c[i]))
4656 return argError(interp, loc,
4657 InterpreterMessages::notAChar, i, argv[i]);
4658 if (lang->isLess(StringC(c, 1), StringC(c + 1, 1)))
4659 return interp.makeTrue();
4661 return interp.makeFalse();
4664 DEFPRIMITIVE(CharLessOrEqual, argc, argv, context, interp, loc)
4666 GETCURLANG(lang, context, interp);
4668 for (unsigned i = 0; i < 2; i++)
4669 if (!argv[i]->charValue(c[i]))
4670 return argError(interp, loc,
4671 InterpreterMessages::notAChar, i, argv[i]);
4672 if (lang->isLessOrEqual(StringC(c, 1), StringC(c + 1, 1)))
4673 return interp.makeTrue();
4675 return interp.makeFalse();
4678 DEFPRIMITIVE(CharUpcase, argc, argv, context, interp, loc)
4680 GETCURLANG(lang, context, interp);
4682 if (!argv[0]->charValue(c))
4683 return argError(interp, loc,
4684 InterpreterMessages::notAChar, 0, argv[0]);
4685 return interp.makeChar(lang->toUpper(c));
4688 DEFPRIMITIVE(CharDowncase, argc, argv, context, interp, loc)
4690 GETCURLANG(lang, context, interp);
4692 if (!argv[0]->charValue(c))
4693 return argError(interp, loc,
4694 InterpreterMessages::notAChar, 0, argv[0]);
4695 return interp.makeChar(lang->toLower(c));
4698 DEFPRIMITIVE(StringEquiv, argc, argv, context, interp, loc)
4700 GETCURLANG(lang, context, interp);
4703 for (unsigned i = 0; i < 2; i++)
4704 if (!argv[i]->stringData(s[i], n[i]))
4705 return argError(interp, loc,
4706 InterpreterMessages::notAString, i, argv[i]);
4708 if (!argv[2]->exactIntegerValue(k) || (k <= 0))
4709 return argError(interp, loc,
4710 InterpreterMessages::notAPositiveInteger, 2, argv[2]);
4711 if (lang->areEquivalent(StringC(s[0], n[0]), StringC(s[1], n[1]), k))
4712 return interp.makeTrue();
4714 return interp.makeFalse();
4717 DEFPRIMITIVE(StringLess, argc, argv, context, interp, loc)
4719 GETCURLANG(lang, context, interp);
4722 for (unsigned i = 0; i < 2; i++)
4723 if (!argv[i]->stringData(s[i], n[i]))
4724 return argError(interp, loc,
4725 InterpreterMessages::notAString, i, argv[i]);
4726 if (lang->isLess(StringC(s[0], n[0]), StringC(s[1], n[1])))
4727 return interp.makeTrue();
4729 return interp.makeFalse();
4732 DEFPRIMITIVE(StringLessOrEqual, argc, argv, context, interp, loc)
4734 GETCURLANG(lang, context, interp);
4737 for (unsigned i = 0; i < 2; i++)
4738 if (!argv[i]->stringData(s[i], n[i]))
4739 return argError(interp, loc,
4740 InterpreterMessages::notAString, i, argv[i]);
4741 if (lang->isLessOrEqual(StringC(s[0], n[0]), StringC(s[1], n[1])))
4742 return interp.makeTrue();
4744 return interp.makeFalse();
4747 DEFPRIMITIVE(Assoc, argc, argv, context, interp, loc)
4749 ELObj *list = argv[1];
4751 PairObj *pair = list->asPair();
4753 PairObj *car = pair->car()->asPair();
4755 return argError(interp, loc,
4756 InterpreterMessages::notAnAlist, 1, argv[1]);
4757 if (ELObj::equal(*car->car(), *argv[0]))
4760 } else if (list->isNil())
4763 return argError(interp, loc,
4764 InterpreterMessages::notAList, 1, argv[1]);
4766 return interp.makeFalse();
4769 DEFPRIMITIVE(KeywordToString, argc, argv, context, interp, loc)
4771 KeywordObj *obj = argv[0]->asKeyword();
4773 return argError(interp, loc,
4774 InterpreterMessages::notAKeyword, 0, argv[0]);
4775 return new (interp) StringObj(obj->identifier()->name());
4778 DEFPRIMITIVE(StringToKeyword, argc, argv, context, interp, loc)
4782 if (!argv[0]->stringData(s, n))
4783 return argError(interp, loc,
4784 InterpreterMessages::notAString, 0, argv[0]);
4785 return interp.makeKeyword(StringC(s, n));
4788 DEFPRIMITIVE(IsExact, argc, argv, context, interp, loc)
4793 switch (argv[0]->quantityValue(n, d, dim)) {
4794 case ELObj::noQuantity:
4795 return argError(interp, loc,
4796 InterpreterMessages::notAQuantity, 0, argv[0]);
4797 case ELObj::doubleQuantity:
4798 return interp.makeFalse();
4799 case ELObj::longQuantity:
4800 return interp.makeTrue();
4806 DEFPRIMITIVE(IsInexact, argc, argv, context, interp, loc)
4811 switch (argv[0]->quantityValue(n, d, dim)) {
4812 case ELObj::noQuantity:
4813 return argError(interp, loc,
4814 InterpreterMessages::notAQuantity, 0, argv[0]);
4815 case ELObj::doubleQuantity:
4816 return interp.makeTrue();
4817 case ELObj::longQuantity:
4818 return interp.makeFalse();
4824 #define DEFNUMPRED(NAME, OP) \
4825 DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
4830 switch (argv[0]->quantityValue(n, d, dim)) { \
4831 case ELObj::noQuantity: \
4832 return argError(interp, loc, \
4833 InterpreterMessages::notAQuantity, 0, argv[0]); \
4834 case ELObj::doubleQuantity: \
4836 return interp.makeTrue(); \
4838 return interp.makeFalse(); \
4839 case ELObj::longQuantity: \
4841 return interp.makeTrue(); \
4843 return interp.makeFalse(); \
4849 DEFNUMPRED(IsZero, == )
4850 DEFNUMPRED(IsPositive, > )
4851 DEFNUMPRED(IsNegative, < )
4853 DEFPRIMITIVE(IsOdd, argc, argv, context, interp, loc)
4858 switch (argv[0]->quantityValue(n, d, dim)) {
4859 case ELObj::noQuantity:
4860 case ELObj::doubleQuantity:
4861 return argError(interp, loc,
4862 InterpreterMessages::notAnInteger, 0, argv[0]);
4863 case ELObj::longQuantity:
4865 return interp.makeTrue();
4867 return interp.makeFalse();
4873 DEFPRIMITIVE(IsEven, argc, argv, context, interp, loc)
4878 switch (argv[0]->quantityValue(n, d, dim)) {
4879 case ELObj::noQuantity:
4880 case ELObj::doubleQuantity:
4881 return argError(interp, loc,
4882 InterpreterMessages::notAnInteger, 0, argv[0]);
4883 case ELObj::longQuantity:
4885 return interp.makeFalse();
4887 return interp.makeTrue();
4893 DEFPRIMITIVE(Exp, argc, argv, context, interp, loc)
4896 if (!argv[0]->realValue(d))
4897 return argError(interp, loc,
4898 InterpreterMessages::notANumber, 0, argv[0]);
4899 return new (interp) RealObj(exp(d));
4902 DEFPRIMITIVE(Log, argc, argv, context, interp, loc)
4905 if (!argv[0]->realValue(d))
4906 return argError(interp, loc,
4907 InterpreterMessages::notANumber, 0, argv[0]);
4909 interp.setNextLocation(loc);
4910 interp.message(InterpreterMessages::outOfRange);
4911 return interp.makeError();
4913 return new (interp) RealObj(log(d));
4916 DEFPRIMITIVE(Sin, argc, argv, context, interp, loc)
4919 if (!argv[0]->realValue(d))
4920 return argError(interp, loc,
4921 InterpreterMessages::notANumber, 0, argv[0]);
4922 return new (interp) RealObj(sin(d));
4925 DEFPRIMITIVE(Cos, argc, argv, context, interp, loc)
4928 if (!argv[0]->realValue(d))
4929 return argError(interp, loc,
4930 InterpreterMessages::notANumber, 0, argv[0]);
4931 return new (interp) RealObj(cos(d));
4934 DEFPRIMITIVE(Tan, argc, argv, context, interp, loc)
4937 if (!argv[0]->realValue(d))
4938 return argError(interp, loc,
4939 InterpreterMessages::notANumber, 0, argv[0]);
4940 return new (interp) RealObj(tan(d));
4943 DEFPRIMITIVE(Asin, argc, argv, context, interp, loc)
4946 if (!argv[0]->realValue(d))
4947 return argError(interp, loc,
4948 InterpreterMessages::notANumber, 0, argv[0]);
4949 if (d < -1 || d > 1) {
4950 interp.setNextLocation(loc);
4951 interp.message(InterpreterMessages::outOfRange);
4952 return interp.makeError();
4954 return new (interp) RealObj(asin(d));
4957 DEFPRIMITIVE(Acos, argc, argv, context, interp, loc)
4960 if (!argv[0]->realValue(d))
4961 return argError(interp, loc,
4962 InterpreterMessages::notANumber, 0, argv[0]);
4963 if (d < -1 || d > 1) {
4964 interp.setNextLocation(loc);
4965 interp.message(InterpreterMessages::outOfRange);
4966 return interp.makeError();
4968 return new (interp) RealObj(acos(d));
4971 DEFPRIMITIVE(Atan, argc, argv, context, interp, loc)
4976 ELObj::QuantityType type =
4977 argv[0]->quantityValue(lResult, dResult, dim);
4980 if (type == ELObj::noQuantity || dim != 0)
4981 return argError(interp, loc,
4982 InterpreterMessages::notANumber, 0, argv[0]);
4983 if (type == ELObj::longQuantity)
4985 return new (interp) RealObj(atan(dResult));
4991 ELObj::QuantityType type2 =
4992 argv[1]->quantityValue(lResult2, dResult2, dim2);
4995 case ELObj::noQuantity:
4996 return argError(interp, loc,
4997 InterpreterMessages::notAQuantity, 0, argv[0]);
4998 case ELObj::doubleQuantity:
5000 case ELObj::longQuantity:
5008 case ELObj::noQuantity:
5009 return argError(interp, loc,
5010 InterpreterMessages::notAQuantity, 1, argv[1]);
5011 case ELObj::doubleQuantity:
5013 case ELObj::longQuantity:
5014 dResult2 = lResult2;
5021 interp.setNextLocation(loc);
5022 interp.message(InterpreterMessages::incompatibleDimensions);
5023 return interp.makeError();
5025 // FIXME: the standard is a bit vague about the range
5026 // of atan with two arguments. The description sounds like
5027 // it should be [0,2pi] or [-pi,pi], but then it says
5028 // the range is [-pi/2,pi/2]. I guess that the last sentence
5029 // applies only to the one-argument version of atan, so that
5030 // the semantics would parallel that of the C libraries
5032 return new (interp) RealObj(atan2(dResult, dResult2));
5035 DEFPRIMITIVE(XExpt, argc, argv, context, interp, loc)
5041 ELObj::QuantityType q1 = argv[0]->quantityValue(n1, d1, dim1);
5042 ELObj::QuantityType q2 = argv[0]->quantityValue(n2, d2, dim2);
5043 if (q1 == ELObj::noQuantity)
5044 return argError(interp, loc,
5045 InterpreterMessages::notAQuantity, 0, argv[0]);
5046 else if (dim1 != 0) {
5047 if (!argv[1]->exactIntegerValue(n2))
5048 return argError(interp, loc,
5049 InterpreterMessages::notAnExactInteger, 1, argv[1]);
5050 return new (interp) QuantityObj(pow(d1,n2), dim1*n2);
5053 if ((q2 == ELObj::noQuantity) || (dim2 != 0))
5054 return argError(interp, loc,
5055 InterpreterMessages::notANumber, 1, argv[1]);
5056 double res = pow(d1, d2);
5058 if (argv[0]->exactIntegerValue(tem) &&
5059 argv[1]->exactIntegerValue(tem) &&
5060 fabs(res) < LONG_MAX)
5061 return interp.makeInteger((long)res);
5062 return new (interp) RealObj(res);
5066 DEFPRIMITIVE(Expt, argc, argv, context, interp, loc)
5069 if (!argv[0]->realValue(d))
5070 return argError(interp, loc,
5071 InterpreterMessages::notANumber, 0, argv[0]);
5072 if (!argv[1]->realValue(d2))
5073 return argError(interp, loc,
5074 InterpreterMessages::notANumber, 1, argv[1]);
5075 double res = pow(d, d2);
5077 if (argv[0]->exactIntegerValue(tem) &&
5078 argv[1]->exactIntegerValue(tem) &&
5079 fabs(res) < LONG_MAX)
5080 return interp.makeInteger((long)res);
5081 return new (interp) RealObj(res);
5084 DEFPRIMITIVE(ExactToInexact, argc, argv, context, interp, loc)
5089 switch (argv[0]->quantityValue(n, d, dim)) {
5090 case ELObj::noQuantity:
5091 return argError(interp, loc,
5092 InterpreterMessages::notAQuantity, 0, argv[0]);
5093 case ELObj::doubleQuantity:
5095 case ELObj::longQuantity:
5096 argv[0]->realValue(d);
5097 return new (interp) RealObj(d);
5103 DEFPRIMITIVE(InexactToExact, argc, argv, context, interp, loc)
5108 switch (argv[0]->quantityValue(n, d, dim)) {
5109 case ELObj::noQuantity:
5110 return argError(interp, loc,
5111 InterpreterMessages::notAQuantity, 0, argv[0]);
5112 case ELObj::doubleQuantity:
5113 if (argv[0]->realValue(d) && modf(d, &d) == 0.0
5114 && fabs(d) < LONG_MAX && dim == 0)
5115 return interp.makeInteger((long)d);
5116 interp.setNextLocation(loc);
5117 interp.message(InterpreterMessages::noExactRepresentation,
5118 ELObjMessageArg(argv[0], interp));
5119 case ELObj::longQuantity: // fall through
5126 DEFPRIMITIVE(QuantityToNumber, argc, argv, context, interp, loc)
5128 // FIXME this is wrong, but what exactly is the
5129 // `number of the quantity' ???
5133 switch (argv[0]->quantityValue(n, d, dim)) {
5134 case ELObj::noQuantity:
5135 return argError(interp, loc,
5136 InterpreterMessages::notAQuantity, 0, argv[0]);
5137 case ELObj::doubleQuantity:
5139 return new (interp) RealObj(d);
5141 return new (interp) RealObj(d * pow(0.0254/interp.unitsPerInch(), dim));
5142 case ELObj::longQuantity:
5144 return interp.makeInteger(n);
5146 return new (interp) RealObj(n * pow(0.0254/interp.unitsPerInch(), dim));
5152 DEFPRIMITIVE(StringToList, argc, argv, context, interp, loc)
5156 if (!argv[0]->stringData(s, n))
5157 return argError(interp, loc,
5158 InterpreterMessages::notAString, 0, argv[0]);
5159 ELObjDynamicRoot protect(interp, interp.makeNil());
5160 for (int i = n; i > 0; i--) {
5161 // We have to do it in this order, to ensure that no object is GC'ed
5162 PairObj *p = interp.makePair(0, protect);
5164 p->setCar(interp.makeChar(s[i - 1]));
5169 DEFPRIMITIVE(ListToString, argc, argv, context, interp, loc)
5171 StringObj *obj = new (interp) StringObj;
5172 ELObj *list = argv[0];
5174 PairObj *pair = list->asPair();
5177 if (!pair->car()->charValue(c))
5178 return argError(interp, loc,
5179 InterpreterMessages::notACharList, 0, list);
5182 } else if (list->isNil())
5185 return argError(interp, loc,
5186 InterpreterMessages::notAList, 0, list);
5191 static time_t timeConv(const Char *s, size_t n)
5196 for ( i = 0; i < n && i < (sizeof(buf) - 1); i++)
5197 buf[i] = char(s[i]);
5199 time_t today_sec = time(NULL);
5200 struct tm tim, *today;
5203 today = localtime(&today_sec);
5205 /* First try to parse as time string without date */
5206 /* Defaults are same as of today */
5207 memcpy(&tim, today, sizeof(tim));
5208 nparsed = sscanf(buf, "%d:%d:%d",
5213 /* If we got only one number, it could be
5214 a year so try to parse complete format */
5215 if ( nparsed < 2 ) {
5216 /* Defaults are set to zero */
5217 memset( &tim, 0, sizeof(tim) );
5219 /* This accepts any non digit character between
5220 the date and time spec
5222 nparsed = sscanf(buf, "%d-%d-%d%*[^0-9]%d:%d:%d",
5235 /* We only got a year set to January First
5236 Month is already set to 0
5241 /* Fall through to month normalization */
5247 if (tim.tm_year < 38 )
5248 tim.tm_year += 100; /* Y2K workaround */
5249 else if (tim.tm_year >= 1900)
5250 tim.tm_year -= 1900;
5253 return mktime(&tim);
5256 #define DEFTIMECOMP(NAME, OP) \
5257 DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
5259 const Char *s1, *s2; \
5262 if (!argv[0]->stringData(s1, n1)) \
5263 return argError(interp, loc, \
5264 InterpreterMessages::notAString, 0, argv[0]); \
5265 if (!argv[1]->stringData(s2, n2)) \
5266 return argError(interp, loc, \
5267 InterpreterMessages::notAString, 1, argv[1]); \
5268 if ( (t1 = timeConv(s1, n1)) == (time_t)-1 ) \
5269 return argError(interp, loc, \
5270 InterpreterMessages::notATimeString, 0, argv[0]); \
5271 if ( (t2 = timeConv(s2, n2)) == (time_t)-1 ) \
5272 return argError(interp, loc, \
5273 InterpreterMessages::notATimeString, 1, argv[1]); \
5274 if (timeConv(s1, n1) OP timeConv(s2, n2)) \
5275 return interp.makeTrue(); \
5277 return interp.makeFalse(); \
5280 DEFTIMECOMP(TimeLess, < )
5281 DEFTIMECOMP(TimeGreater, > )
5282 DEFTIMECOMP(TimeLessOrEqual, <= )
5283 DEFTIMECOMP(TimeGreaterOrEqual, >= )
5285 DEFPRIMITIVE(MapConstructor, argc, argv, context, interp, loc)
5287 FunctionObj *func = argv[0]->asFunction();
5289 return argError(interp, loc,
5290 InterpreterMessages::notAProcedure, 0, argv[0]);
5291 if (func->totalArgs() > 0) {
5292 interp.setNextLocation(loc);
5293 interp.message(InterpreterMessages::tooManyArgs);
5294 return interp.makeError();
5296 NodeListObj *nl = argv[1]->asNodeList();
5297 ELObjDynamicRoot protect1(interp, nl);
5299 return argError(interp, loc,
5300 InterpreterMessages::notANodeList, 1, argv[1]);
5301 AppendSosofoObj *obj = new (interp) AppendSosofoObj;
5302 ELObjDynamicRoot protect2(interp, obj);
5305 InsnPtr insn(func->makeCallInsn(0, interp, loc, InsnPtr()));
5306 VM vm(context, interp);
5307 while (nd = nl->nodeListFirst(context, interp)) {
5308 nl = nl->nodeListRest(context, interp);
5310 EvalContext::CurrentNodeSetter cns(nd, context.processingMode, vm);
5311 ret = vm.eval(insn.pointer());
5312 if (!ret->asSosofo()) {
5313 interp.setNextLocation(loc);
5314 interp.message(InterpreterMessages::returnNotSosofo);
5315 return interp.makeError();
5317 obj->append(ret->asSosofo());
5322 void Interpreter::installPrimitives()
5324 #define PRIMITIVE(name, string, nRequired, nOptional, rest) \
5325 installPrimitive(string, new (*this) name ## PrimitiveObj);
5326 #define XPRIMITIVE(name, string, nRequired, nOptional, rest) \
5327 installXPrimitive("UNREGISTERED::James Clark//Procedure::", \
5328 string, new (*this) name ## PrimitiveObj);
5329 #define XXPRIMITIVE(name, string, nRequired, nOptional, rest) \
5330 installXPrimitive("UNREGISTERED::OpenJade//Procedure::", \
5331 string, new (*this) name ## PrimitiveObj);
5333 #define PRIMITIVE2(name, string, nRequired, nOptional, rest) \
5334 if (dsssl2()) installPrimitive(string, new (*this) name ## PrimitiveObj);
5335 #include "primitive.h"
5340 FunctionObj *apply = new (*this) ApplyPrimitiveObj;
5341 makePermanent(apply);
5342 lookup(makeStringC("apply"))->setValue(apply);
5344 FunctionObj *callCC = new (*this) CallWithCurrentContinuationPrimitiveObj;
5345 makePermanent(callCC);
5346 lookup(makeStringC("call-with-current-continuation"))->setValue(callCC);
5349 lookup(makeStringC("string->quantity"))
5350 ->setValue(lookup(makeStringC("string->number"))->computeValue(0, *this));
5353 void Interpreter::installPrimitive(const char *s, PrimitiveObj *value)
5355 makePermanent(value);
5356 Identifier *ident = lookup(makeStringC(s));
5357 ident->setValue(value);
5358 value->setIdentifier(ident);
5359 StringC pubid(makeStringC("ISO/IEC 10179:1996//Procedure::"));
5360 pubid += makeStringC(s);
5361 externalProcTable_.insert(pubid, value);
5364 void Interpreter::installXPrimitive(const char *prefix, const char *s,
5365 PrimitiveObj *value)
5367 makePermanent(value);
5368 value->setIdentifier(lookup(makeStringC(s)));
5369 StringC pubid(makeStringC(prefix));
5370 pubid += makeStringC(s);
5371 externalProcTable_.insert(pubid, value);
5374 DescendantsNodeListObj::DescendantsNodeListObj(const NodePtr &start, unsigned depth)
5375 : start_(start), depth_(depth)
5377 advance(start_, depth_);
5380 NodePtr DescendantsNodeListObj::nodeListFirst(EvalContext &, Interpreter &)
5385 NodeListObj *DescendantsNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5387 DescendantsNodeListObj *obj = new (interp) DescendantsNodeListObj(*this);
5388 advance(obj->start_, obj->depth_);
5392 NodeListObj *DescendantsNodeListObj::nodeListChunkRest(EvalContext &context, Interpreter &interp, bool &chunk)
5394 DescendantsNodeListObj *obj = new (interp) DescendantsNodeListObj(*this);
5395 chunkAdvance(obj->start_, obj->depth_);
5400 void DescendantsNodeListObj::advance(NodePtr &nd, unsigned &depth)
5404 if (nd.assignFirstChild() == accessOK) {
5412 while (nd.assignNextSibling() != accessOK) {
5413 if (depth == 1 || nd.assignOrigin() != accessOK) {
5421 void DescendantsNodeListObj::chunkAdvance(NodePtr &nd, unsigned &depth)
5425 if (nd.assignFirstChild() == accessOK) {
5433 while (nd.assignNextChunkSibling() != accessOK) {
5434 if (depth == 1 || nd.assignOrigin() != accessOK) {
5442 SelectByClassNodeListObj::SelectByClassNodeListObj(NodeListObj *nl, ComponentName::Id cls)
5443 : nodeList_(nl), cls_(cls)
5448 NodePtr SelectByClassNodeListObj::nodeListFirst(EvalContext &context, Interpreter &interp)
5451 NodePtr nd = nodeList_->nodeListFirst(context, interp);
5452 if (!nd || nd->classDef().className == cls_)
5454 // All nodes in a chunk have the same class
5456 nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5462 NodeListObj *SelectByClassNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5465 NodePtr nd = nodeList_->nodeListFirst(context, interp);
5466 if (!nd || nd->classDef().className == cls_)
5468 // All nodes in a chunk have the same class
5470 nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5472 NodeListObj *tem = nodeList_->nodeListRest(context, interp);
5473 ELObjDynamicRoot protect(interp, tem);
5474 return new (interp) SelectByClassNodeListObj(tem, cls_);
5477 NodeListObj *SelectByClassNodeListObj::nodeListChunkRest(EvalContext &context, Interpreter &interp, bool &chunk)
5480 NodePtr nd = nodeList_->nodeListFirst(context, interp);
5482 return interp.makeEmptyNodeList();
5483 if (nd->classDef().className == cls_)
5486 nodeList_ = nodeList_->nodeListChunkRest(context, interp, tem);
5488 NodeListObj *tem = nodeList_->nodeListChunkRest(context, interp, chunk);
5489 ELObjDynamicRoot protect(interp, tem);
5490 return new (interp) SelectByClassNodeListObj(tem, cls_);
5493 void SelectByClassNodeListObj::traceSubObjects(Collector &c) const
5498 MapNodeListObj::MapNodeListObj(FunctionObj *func, NodeListObj *nl,
5499 const ConstPtr<Context> &context,
5500 NodeListObj *mapped)
5501 : func_(func), nl_(nl), context_(context), mapped_(mapped)
5506 NodePtr MapNodeListObj::nodeListFirst(EvalContext &context, Interpreter &interp)
5510 mapNext(context, interp);
5514 NodePtr nd = mapped_->nodeListFirst(context, interp);
5522 NodeListObj *MapNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5526 mapNext(context, interp);
5530 NodePtr nd = mapped_->nodeListFirst(context, interp);
5532 NodeListObj *tem = mapped_->nodeListRest(context, interp);
5533 ELObjDynamicRoot protect(interp, tem);
5534 return new (interp) MapNodeListObj(func_, nl_, context_, tem);
5538 return interp.makeEmptyNodeList();
5541 void MapNodeListObj::mapNext(EvalContext &context, Interpreter &interp)
5545 NodePtr nd = nl_->nodeListFirst(context, interp);
5548 VM vm(context, interp);
5550 InsnPtr insn(func_->makeCallInsn(1, interp, context_->loc, InsnPtr()));
5551 ELObj *ret = vm.eval(insn.pointer(), 0, new (interp) NodePtrNodeListObj(nd));
5552 if (interp.isError(ret)) {
5556 mapped_ = ret->asNodeList();
5558 interp.setNextLocation(context_->loc);
5559 interp.message(InterpreterMessages::returnNotNodeList);
5563 nl_ = nl_->nodeListRest(context, interp);
5566 void MapNodeListObj::traceSubObjects(Collector &c) const
5571 context_->traceSubObjects(c);
5574 bool MapNodeListObj::suppressError()
5579 MapNodeListObj::Context::Context(const EvalContext &context, const Location &l)
5581 haveStyleStack_(context.styleStack != 0),
5582 processingMode_(context.processingMode),
5583 currentNode_(context.currentNode),
5584 overridingStyle_(context.overridingStyle)
5588 void MapNodeListObj::Context::set(EvalContext &context) const
5590 context.processingMode = processingMode_;
5591 context.currentNode = currentNode_;
5592 context.overridingStyle = overridingStyle_;
5593 if (!haveStyleStack_)
5594 context.styleStack = 0;
5597 void MapNodeListObj::Context::traceSubObjects(Collector &c) const
5599 c.trace(overridingStyle_);
5602 SelectElementsNodeListObj::SelectElementsNodeListObj(NodeListObj *nodeList,
5603 const ConstPtr<PatternSet> &patterns)
5604 : nodeList_(nodeList), patterns_(patterns)
5606 ASSERT(!patterns_.isNull());
5610 SelectElementsNodeListObj::SelectElementsNodeListObj(NodeListObj *nodeList,
5611 NCVector<Pattern> &patterns)
5612 : nodeList_(nodeList)
5615 Ptr<PatternSet> tem(new PatternSet);
5616 tem->swap(patterns);
5620 void SelectElementsNodeListObj::traceSubObjects(Collector &c) const
5625 NodePtr SelectElementsNodeListObj::nodeListFirst(EvalContext &context, Interpreter &interp)
5628 NodePtr nd = nodeList_->nodeListFirst(context, interp);
5631 for (size_t i = 0; i < patterns_->size(); i++)
5632 if ((*patterns_)[i].matches(nd, interp))
5635 nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5641 NodeListObj *SelectElementsNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5644 NodePtr nd = nodeList_->nodeListFirst(context, interp);
5648 for (size_t i = 0; i < patterns_->size(); i++) {
5649 if ((*patterns_)[i].matches(nd, interp)) {
5657 nodeList_ = nodeList_->nodeListChunkRest(context, interp, chunk);
5660 NodeListObj *tem = nodeList_->nodeListChunkRest(context, interp, chunk);
5661 ELObjDynamicRoot protect(interp, tem);
5662 return new (interp) SelectElementsNodeListObj(tem, patterns_);
5665 SiblingNodeListObj::SiblingNodeListObj(const NodePtr &first, const NodePtr &end)
5666 : first_(first), end_(end)
5670 NodePtr SiblingNodeListObj::nodeListFirst(EvalContext &, Interpreter &)
5672 if (*first_ == *end_)
5677 NodeListObj *SiblingNodeListObj::nodeListRest(EvalContext &context, Interpreter &interp)
5679 if (*first_ == *end_)
5680 return interp.makeEmptyNodeList();
5682 if (first_->nextSibling(nd) != accessOK)
5684 return new (interp) SiblingNodeListObj(nd, end_);
5687 NodeListObj *SiblingNodeListObj::nodeListChunkRest(EvalContext &context, Interpreter &interp, bool &chunk)
5689 if (first_->chunkContains(*end_)) {
5691 return nodeListRest(context, interp);
5694 if (first_->nextChunkSibling(nd) != accessOK)
5697 return new (interp) SiblingNodeListObj(nd, end_);
5700 #ifdef DSSSL_NAMESPACE
5704 #include "primitive_inst.cxx"