PageRenderTime 76ms CodeModel.GetById 11ms RepoModel.GetById 1ms app.codeStats 0ms

/branches/jade_query/style/primitive.cxx

#
C++ | 2526 lines | 2378 code | 124 blank | 24 comment | 536 complexity | 3f6139792bdf8fadf89a4838b8af68e7 MD5 | raw file
Possible License(s): LGPL-2.1, LGPL-2.0
  1. // Copyright (c) 1996 James Clark, 2000 Peter Nilsson
  2. // See the file copying.txt for copying permission.
  3. #include "stylelib.h"
  4. #include "Interpreter.h"
  5. #include "InterpreterMessages.h"
  6. #include "EvalContext.h"
  7. #include "SosofoObj.h"
  8. #include "Style.h"
  9. #include "Insn.h"
  10. #include <OpenSP/macros.h>
  11. #include "ELObjMessageArg.h"
  12. #include "LocNode.h"
  13. #include "VM.h"
  14. #include "Pattern.h"
  15. #include "ELObjPropVal.h"
  16. #include <math.h>
  17. #include <limits.h>
  18. #include <stdio.h>
  19. #include <time.h>
  20. #include "LangObj.h"
  21. #include <ctype.h>
  22. #ifdef DSSSL_NAMESPACE
  23. namespace DSSSL_NAMESPACE {
  24. #endif
  25. class TreeNodeListObj : public NodeListObj {
  26. public:
  27. void *operator new(size_t, Collector &c) {
  28. return c.allocateObject(1);
  29. }
  30. TreeNodeListObj(const NodePtr &);
  31. NodePtr nodeListFirst(EvalContext &, Interpreter &);
  32. NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  33. NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  34. protected:
  35. virtual void advance(EvalContext &, Interpreter &) = 0;
  36. virtual void chunkAdvance(EvalContext &, Interpreter &) = 0;
  37. virtual TreeNodeListObj *copy(Interpreter &) = 0;
  38. NodePtr root_;
  39. // nodes in node list are strictly after this node
  40. NodePtr start_;
  41. };
  42. class SubtreeNodeListObj : public TreeNodeListObj {
  43. public:
  44. SubtreeNodeListObj(const NodePtr &);
  45. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  46. protected:
  47. void advance(EvalContext &, Interpreter &);
  48. void chunkAdvance(EvalContext &, Interpreter &);
  49. SubtreeNodeListObj *copy(Interpreter &);
  50. unsigned depth_;
  51. };
  52. class SubgroveNodeListObj : public TreeNodeListObj {
  53. public:
  54. SubgroveNodeListObj(const NodePtr &);
  55. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  56. protected:
  57. void advance(EvalContext &, Interpreter &);
  58. void chunkAdvance(EvalContext &, Interpreter &);
  59. SubgroveNodeListObj *copy(Interpreter &);
  60. unsigned depth_;
  61. };
  62. class DescendantsNodeListObj : public SubtreeNodeListObj {
  63. public:
  64. DescendantsNodeListObj(const NodePtr &, Interpreter &);
  65. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  66. protected:
  67. DescendantsNodeListObj *copy(Interpreter &);
  68. };
  69. class SiblingNodeListObj : public NodeListObj {
  70. public:
  71. void *operator new(size_t, Collector &c) {
  72. return c.allocateObject(1);
  73. }
  74. SiblingNodeListObj(const NodePtr &first, const NodePtr &end);
  75. NodePtr nodeListFirst(EvalContext &, Interpreter &);
  76. NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  77. NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  78. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  79. private:
  80. NodePtr first_;
  81. NodePtr end_;
  82. };
  83. class SelectByClassNodeListObj : public NodeListObj {
  84. public:
  85. SelectByClassNodeListObj(NodeListObj *nl, ComponentName::Id);
  86. NodePtr nodeListFirst(EvalContext &, Interpreter &);
  87. NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  88. NodeListObj *nodeListChunkRest(EvalContext &, Interpreter &, bool &);
  89. void traceSubObjects(Collector &) const;
  90. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  91. private:
  92. NodeListObj *nodeList_;
  93. ComponentName::Id cls_;
  94. };
  95. class MapNodeListObj : public NodeListObj {
  96. public:
  97. class Context : public Resource {
  98. public:
  99. Context(const EvalContext &, const Location &);
  100. void set(EvalContext &) const;
  101. void traceSubObjects(Collector &) const;
  102. Location loc;
  103. private:
  104. NodePtr currentNode_;
  105. const ProcessingMode *processingMode_;
  106. StyleObj *overridingStyle_;
  107. bool haveStyleStack_;
  108. };
  109. void *operator new(size_t, Collector &c) {
  110. return c.allocateObject(1);
  111. }
  112. MapNodeListObj(FunctionObj *func, NodeListObj *nl, const ConstPtr<Context> &, NodeListObj *mapped = 0);
  113. NodePtr nodeListFirst(EvalContext &, Interpreter &);
  114. NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  115. void traceSubObjects(Collector &) const;
  116. bool suppressError();
  117. private:
  118. void mapNext(EvalContext &, Interpreter &);
  119. NodeListObj *mapped_;
  120. protected:
  121. FunctionObj *func_;
  122. NodeListObj *nl_;
  123. ConstPtr<Context> context_;
  124. };
  125. class FilterNodeListObj : public MapNodeListObj {
  126. public:
  127. FilterNodeListObj(FunctionObj *func, NodeListObj *nl, const ConstPtr<Context> &);
  128. NodePtr nodeListFirst(EvalContext &, Interpreter &);
  129. NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  130. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  131. private:
  132. bool maybeIn(EvalContext &, Interpreter &, const NodePtr &);
  133. };
  134. class SelectElementsNodeListObj : public NodeListObj {
  135. public:
  136. struct PatternSet : public Resource, public NCVector<Pattern> { };
  137. void *operator new(size_t, Collector &c) {
  138. return c.allocateObject(1);
  139. }
  140. void traceSubObjects(Collector &c) const;
  141. SelectElementsNodeListObj(NodeListObj *, NCVector<Pattern> &);
  142. SelectElementsNodeListObj(NodeListObj *, const ConstPtr<PatternSet> &);
  143. NodePtr nodeListFirst(EvalContext &, Interpreter &);
  144. NodeListObj *nodeListRest(EvalContext &, Interpreter &);
  145. bool contains(EvalContext &, Interpreter &, const NodePtr &);
  146. private:
  147. NodeListObj *nodeList_;
  148. ConstPtr<PatternSet> patterns_;
  149. };
  150. #define PRIMITIVE(name, string, nRequired, nOptional, rest, feature) \
  151. class name ## PrimitiveObj : public PrimitiveObj { \
  152. public: \
  153. static const Signature signature_; \
  154. name ## PrimitiveObj() : PrimitiveObj(&signature_) { } \
  155. ELObj *primitiveCall(int, ELObj **, EvalContext &, Interpreter &, const Location &); \
  156. }; \
  157. const Signature name ## PrimitiveObj::signature_ \
  158. = { nRequired, nOptional, rest };
  159. #define SPRIMITIVE PRIMITIVE
  160. #define TPRIMITIVE PRIMITIVE
  161. #define XPRIMITIVE(name, string, nRequired, nOptional, rest) \
  162. PRIMITIVE(name, string, nRequired, nOptional, rest, noFeature)
  163. #define XXPRIMITIVE XPRIMITIVE
  164. #define PRIMITIVE2 XPRIMITIVE
  165. #include "primitive.h"
  166. #undef PRIMITIVE
  167. #undef SPRIMITIVE
  168. #undef TPRIMITIVE
  169. #undef XPRIMITIVE
  170. #undef XXPRIMITIVE
  171. #undef PRIMITIVE2
  172. #define DEFPRIMITIVE(name, argc, argv, context, interp, loc) \
  173. ELObj *name ## PrimitiveObj \
  174. ::primitiveCall(int argc, ELObj **argv, EvalContext &context, Interpreter &interp, \
  175. const Location &loc)
  176. DEFPRIMITIVE(Cons, argc, argv, context, interp, loc)
  177. {
  178. return new (interp) PairObj(argv[0], argv[1]);
  179. }
  180. DEFPRIMITIVE(List, argc, argv, context, interp, loc)
  181. {
  182. if (argc == 0)
  183. return interp.makeNil();
  184. PairObj *head = new (interp) PairObj(argv[0], 0);
  185. ELObjDynamicRoot protect(interp, head);
  186. PairObj *tail = head;
  187. for (int i = 1; i < argc; i++) {
  188. PairObj *tem = new (interp) PairObj(argv[i], 0);
  189. tail->setCdr(tem);
  190. tail = tem;
  191. }
  192. tail->setCdr(interp.makeNil());
  193. return head;
  194. }
  195. DEFPRIMITIVE(IsNull, argc, argv, context, interp, loc)
  196. {
  197. if (argv[0]->isNil())
  198. return interp.makeTrue();
  199. else
  200. return interp.makeFalse();
  201. }
  202. DEFPRIMITIVE(IsList, argc, argv, context, interp, loc)
  203. {
  204. ELObj *obj = argv[0];
  205. for (;;) {
  206. PairObj *pair = obj->asPair();
  207. if (pair)
  208. obj = pair->cdr();
  209. else if (obj->isNil())
  210. return interp.makeTrue();
  211. else
  212. break;
  213. }
  214. return interp.makeFalse();
  215. }
  216. DEFPRIMITIVE(IsEqual, argc, argv, context, interp, loc)
  217. {
  218. if (ELObj::equal(*argv[0], *argv[1]))
  219. return interp.makeTrue();
  220. else
  221. return interp.makeFalse();
  222. }
  223. DEFPRIMITIVE(IsEqv, argc, argv, context, interp, loc)
  224. {
  225. if (ELObj::eqv(*argv[0], *argv[1]))
  226. return interp.makeTrue();
  227. else
  228. return interp.makeFalse();
  229. }
  230. DEFPRIMITIVE(Car, argc, argv, context, interp, loc)
  231. {
  232. PairObj *pair = argv[0]->asPair();
  233. if (!pair)
  234. return argError(interp, loc,
  235. InterpreterMessages::notAPair, 0, argv[0]);
  236. else
  237. return pair->car();
  238. }
  239. DEFPRIMITIVE(Cdr, argc, argv, context, interp, loc)
  240. {
  241. PairObj *pair = argv[0]->asPair();
  242. if (!pair)
  243. return argError(interp, loc,
  244. InterpreterMessages::notAPair, 0, argv[0]);
  245. else
  246. return pair->cdr();
  247. }
  248. DEFPRIMITIVE(Append, argc, argv, context, interp, loc)
  249. {
  250. if (argc == 0)
  251. return interp.makeNil();
  252. PairObj *tail = interp.makePair(0, 0);
  253. PairObj *head = tail;
  254. ELObjDynamicRoot protect(interp, head);
  255. for (int i = 0; i < argc - 1; i++) {
  256. for (ELObj *p = argv[i]; !p->isNil();) {
  257. PairObj *tem = p->asPair();
  258. if (!tem)
  259. return argError(interp, loc,
  260. InterpreterMessages::notAList, i, p);
  261. PairObj *newTail = new (interp) PairObj(tem->car(), 0);
  262. tail->setCdr(newTail);
  263. tail = newTail;
  264. p = tem->cdr();
  265. }
  266. }
  267. tail->setCdr(argv[argc - 1]);
  268. return head->cdr();
  269. }
  270. DEFPRIMITIVE(Reverse, argc, argv, context, interp, loc)
  271. {
  272. ELObjDynamicRoot protect(interp, interp.makeNil());
  273. ELObj *p = argv[0];
  274. while (!p->isNil()) {
  275. PairObj *tem = p->asPair();
  276. if (!tem)
  277. return argError(interp, loc,
  278. InterpreterMessages::notAList, 0, argv[0]);
  279. protect = new (interp) PairObj(tem->car(), protect);
  280. p = tem->cdr();
  281. }
  282. return protect;
  283. }
  284. DEFPRIMITIVE(ListTail, argc, argv, context, interp, loc)
  285. {
  286. long k;
  287. if (!argv[1]->exactIntegerValue(k))
  288. return argError(interp, loc,
  289. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  290. if (k < 0) {
  291. interp.setNextLocation(loc);
  292. interp.message(InterpreterMessages::outOfRange);
  293. return interp.makeError();
  294. }
  295. ELObj *p = argv[0];
  296. for (; k > 0; k--) {
  297. PairObj *tem = p->asPair();
  298. if (!tem) {
  299. if (p->isNil()) {
  300. interp.setNextLocation(loc);
  301. interp.message(InterpreterMessages::outOfRange);
  302. return interp.makeError();
  303. }
  304. else
  305. return argError(interp, loc,
  306. InterpreterMessages::notAList, 0, argv[0]);
  307. }
  308. p = tem->cdr();
  309. }
  310. return p;
  311. }
  312. DEFPRIMITIVE(ListRef, argc, argv, context, interp, loc)
  313. {
  314. long k;
  315. if (!argv[1]->exactIntegerValue(k))
  316. return argError(interp, loc,
  317. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  318. if (k < 0) {
  319. interp.setNextLocation(loc);
  320. interp.message(InterpreterMessages::outOfRange);
  321. return interp.makeError();
  322. }
  323. ELObj *p = argv[0];
  324. for (;;) {
  325. PairObj *tem = p->asPair();
  326. if (!tem)
  327. break;
  328. if (k == 0)
  329. return tem->car();
  330. --k;
  331. p = tem->cdr();
  332. }
  333. if (p->isNil()) {
  334. interp.setNextLocation(loc);
  335. interp.message(InterpreterMessages::outOfRange);
  336. return interp.makeError();
  337. }
  338. else
  339. return argError(interp, loc,
  340. InterpreterMessages::notAList, 0, argv[0]);
  341. }
  342. DEFPRIMITIVE(Member, argc, argv, context, interp, loc)
  343. {
  344. ELObj *p = argv[1];
  345. while (!p->isNil()) {
  346. PairObj *tem = p->asPair();
  347. if (!tem)
  348. return argError(interp, loc,
  349. InterpreterMessages::notAList, 1, argv[1]);
  350. if (ELObj::equal(*argv[0], *tem->car()))
  351. return p;
  352. p = tem->cdr();
  353. }
  354. return interp.makeFalse();
  355. }
  356. DEFPRIMITIVE(Memv, argc, argv, context, interp, loc)
  357. {
  358. ELObj *p = argv[1];
  359. while (!p->isNil()) {
  360. PairObj *tem = p->asPair();
  361. if (!tem)
  362. return argError(interp, loc,
  363. InterpreterMessages::notAList, 1, argv[1]);
  364. if (ELObj::eqv(*argv[0], *tem->car()))
  365. return p;
  366. p = tem->cdr();
  367. }
  368. return interp.makeFalse();
  369. }
  370. DEFPRIMITIVE(Length, argc, argv, context, interp, loc)
  371. {
  372. ELObj *obj = argv[0];
  373. long n = 0;
  374. for (;;) {
  375. PairObj *pair = obj->asPair();
  376. if (pair) {
  377. n++;
  378. obj = pair->cdr();
  379. }
  380. else if (obj->isNil())
  381. break;
  382. else if (interp.isError(obj))
  383. return obj;
  384. else
  385. return argError(interp, loc,
  386. InterpreterMessages::notAList, 0, obj);
  387. }
  388. return interp.makeInteger(n);
  389. }
  390. DEFPRIMITIVE(Not, argc, argv, context, interp, loc)
  391. {
  392. if (argv[0]->isTrue())
  393. return interp.makeFalse();
  394. else
  395. return interp.makeTrue();
  396. }
  397. DEFPRIMITIVE(IsSymbol, argc, argv, context, interp, loc)
  398. {
  399. if (argv[0]->asSymbol())
  400. return interp.makeTrue();
  401. else
  402. return interp.makeFalse();
  403. }
  404. DEFPRIMITIVE(IsKeyword, argc, argv, context, interp, loc)
  405. {
  406. if (argv[0]->asKeyword())
  407. return interp.makeTrue();
  408. else
  409. return interp.makeFalse();
  410. }
  411. DEFPRIMITIVE(IsInteger, argc, argv, context, interp, loc)
  412. {
  413. long n;
  414. if (argv[0]->exactIntegerValue(n))
  415. return interp.makeTrue();
  416. double x;
  417. if (argv[0]->realValue(x) && modf(x, &x) == 0.0)
  418. return interp.makeTrue();
  419. else
  420. return interp.makeFalse();
  421. }
  422. DEFPRIMITIVE(IsReal, argc, argv, context, interp, loc)
  423. {
  424. double x;
  425. if (argv[0]->realValue(x))
  426. return interp.makeTrue();
  427. else
  428. return interp.makeFalse();
  429. }
  430. DEFPRIMITIVE(IsNumber, argc, argv, context, interp, loc)
  431. {
  432. double x;
  433. if (argv[0]->realValue(x))
  434. return interp.makeTrue();
  435. else
  436. return interp.makeFalse();
  437. }
  438. DEFPRIMITIVE(IsQuantity, argc, argv, context, interp, loc)
  439. {
  440. long n;
  441. double d;
  442. int dim;
  443. if (argv[0]->quantityValue(n, d, dim) != ELObj::noQuantity)
  444. return interp.makeTrue();
  445. else
  446. return interp.makeFalse();
  447. }
  448. DEFPRIMITIVE(IsPair, argc, argv, context, interp, loc)
  449. {
  450. if (argv[0]->asPair())
  451. return interp.makeTrue();
  452. else
  453. return interp.makeFalse();
  454. }
  455. DEFPRIMITIVE(IsProcedure, argc, argv, context, interp, loc)
  456. {
  457. if (argv[0]->asFunction())
  458. return interp.makeTrue();
  459. else
  460. return interp.makeFalse();
  461. }
  462. DEFPRIMITIVE(IsBoolean, argc, argv, context, interp, loc)
  463. {
  464. if (argv[0] == interp.makeTrue())
  465. return argv[0];
  466. else if (argv[0] == interp.makeFalse())
  467. return interp.makeTrue();
  468. else
  469. return interp.makeFalse();
  470. }
  471. DEFPRIMITIVE(IsChar, argc, argv, context, interp, loc)
  472. {
  473. Char c;
  474. if (argv[0]->charValue(c))
  475. return interp.makeTrue();
  476. else
  477. return interp.makeFalse();
  478. }
  479. DEFPRIMITIVE(IsCharEqual, argc, argv, context, interp, loc)
  480. {
  481. Char c1, c2;
  482. if (!argv[0]->charValue(c1))
  483. return argError(interp, loc,
  484. InterpreterMessages::notAChar, 0, argv[0]);
  485. if (!argv[1]->charValue(c2))
  486. return argError(interp, loc,
  487. InterpreterMessages::notAChar, 1, argv[1]);
  488. if (c1 == c2)
  489. return interp.makeTrue();
  490. else
  491. return interp.makeFalse();
  492. }
  493. DEFPRIMITIVE(String, argc, argv, context, interp, loc)
  494. {
  495. StringObj *obj = new (interp) StringObj;
  496. for (int i = 0; i < argc; i++) {
  497. Char c;
  498. if (!argv[i]->charValue(c))
  499. return argError(interp, loc,
  500. InterpreterMessages::notAChar, i, argv[i]);
  501. *obj += c;
  502. }
  503. return obj;
  504. }
  505. DEFPRIMITIVE(SymbolToString, argc, argv, context, interp, loc)
  506. {
  507. SymbolObj *obj = argv[0]->asSymbol();
  508. if (!obj)
  509. return argError(interp, loc,
  510. InterpreterMessages::notASymbol, 0, argv[0]);
  511. return obj->name();
  512. }
  513. DEFPRIMITIVE(StringToSymbol, argc, argv, context, interp, loc)
  514. {
  515. const Char *s;
  516. size_t n;
  517. if (!argv[0]->stringData(s, n))
  518. return argError(interp, loc,
  519. InterpreterMessages::notAString, 0, argv[0]);
  520. return interp.makeSymbol(StringC(s, n));
  521. }
  522. DEFPRIMITIVE(IsString, argc, argv, context, interp, loc)
  523. {
  524. const Char *s;
  525. size_t n;
  526. if (argv[0]->stringData(s, n))
  527. return interp.makeTrue();
  528. else
  529. return interp.makeFalse();
  530. }
  531. DEFPRIMITIVE(StringLength, argc, argv, context, interp, loc)
  532. {
  533. const Char *s;
  534. size_t n;
  535. if (!argv[0]->stringData(s, n))
  536. return argError(interp, loc,
  537. InterpreterMessages::notAString, 0, argv[0]);
  538. return interp.makeInteger(n);
  539. }
  540. DEFPRIMITIVE(IsStringEqual, argc, argv, context, interp, loc)
  541. {
  542. const Char *s1, *s2;
  543. size_t n1, n2;
  544. if (!argv[0]->stringData(s1, n1))
  545. return argError(interp, loc,
  546. InterpreterMessages::notAString, 0, argv[0]);
  547. if (!argv[1]->stringData(s2, n2))
  548. return argError(interp, loc,
  549. InterpreterMessages::notAString, 1, argv[1]);
  550. if (n1 == n2
  551. && (n1 == 0 || memcmp(s1, s2, n1*sizeof(Char)) == 0))
  552. return interp.makeTrue();
  553. else
  554. return interp.makeFalse();
  555. }
  556. DEFPRIMITIVE(StringAppend, argc, argv, context, interp, loc)
  557. {
  558. StringObj *result = new (interp) StringObj;
  559. for (int i = 0; i < argc; i++) {
  560. const Char *s;
  561. size_t n;
  562. if (!argv[i]->stringData(s, n))
  563. return argError(interp, loc,
  564. InterpreterMessages::notAString, i,
  565. argv[i]);
  566. result->append(s, n);
  567. }
  568. return result;
  569. }
  570. DEFPRIMITIVE(StringRef, argc, argv, context, interp, loc)
  571. {
  572. const Char *s;
  573. size_t n;
  574. if (!argv[0]->stringData(s, n))
  575. return argError(interp, loc,
  576. InterpreterMessages::notAString, 0, argv[0]);
  577. long k;
  578. if (!argv[1]->exactIntegerValue(k))
  579. return argError(interp, loc,
  580. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  581. if (k < 0 || (unsigned long)k >= n) {
  582. interp.setNextLocation(loc);
  583. interp.message(InterpreterMessages::outOfRange);
  584. return interp.makeError();
  585. }
  586. return interp.makeChar(s[size_t(k)]);
  587. }
  588. DEFPRIMITIVE(Substring, argc, argv, context, interp, loc)
  589. {
  590. const Char *s;
  591. size_t n;
  592. if (!argv[0]->stringData(s, n))
  593. return argError(interp, loc,
  594. InterpreterMessages::notAString, 0, argv[0]);
  595. long start;
  596. if (!argv[1]->exactIntegerValue(start))
  597. return argError(interp, loc,
  598. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  599. long end;
  600. if (!argv[2]->exactIntegerValue(end))
  601. return argError(interp, loc,
  602. InterpreterMessages::notAnExactInteger, 2, argv[2]);
  603. if (start < 0 || (unsigned long)end > n || start > end) {
  604. interp.setNextLocation(loc);
  605. interp.message(InterpreterMessages::outOfRange);
  606. return interp.makeError();
  607. }
  608. return new (interp) StringObj(s + size_t(start), size_t(end - start));
  609. }
  610. DEFPRIMITIVE(Equal, argc, argv, context, interp, loc)
  611. {
  612. if (argc == 0)
  613. return interp.makeTrue();
  614. long lResult;
  615. double dResult;
  616. int dim;
  617. int i = 1;
  618. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  619. case ELObj::noQuantity:
  620. return argError(interp, loc,
  621. InterpreterMessages::notAQuantity, 0, argv[0]);
  622. case ELObj::longQuantity:
  623. break;
  624. case ELObj::doubleQuantity:
  625. goto useDouble;
  626. break;
  627. default:
  628. CANNOT_HAPPEN();
  629. }
  630. long lResult2;
  631. double dResult2;
  632. int dim2;
  633. for (; i < argc; i++) {
  634. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  635. case ELObj::noQuantity:
  636. return argError(interp, loc,
  637. InterpreterMessages::notAQuantity, i, argv[i]);
  638. case ELObj::longQuantity:
  639. if (lResult2 != lResult || dim2 != dim)
  640. return interp.makeFalse();
  641. break;
  642. case ELObj::doubleQuantity:
  643. dResult = lResult;
  644. if (dResult2 != dResult || dim2 != dim)
  645. return interp.makeFalse();
  646. i++;
  647. goto useDouble;
  648. default:
  649. CANNOT_HAPPEN();
  650. }
  651. }
  652. return interp.makeTrue();
  653. useDouble:
  654. for (; i < argc; i++) {
  655. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  656. case ELObj::noQuantity:
  657. return argError(interp, loc,
  658. InterpreterMessages::notAQuantity, i, argv[i]);
  659. case ELObj::longQuantity:
  660. if (lResult2 != dResult || dim2 != dim)
  661. return interp.makeFalse();
  662. break;
  663. case ELObj::doubleQuantity:
  664. if (dResult2 != dResult || dim2 != dim)
  665. return interp.makeFalse();
  666. break;
  667. }
  668. }
  669. return interp.makeTrue();
  670. }
  671. DEFPRIMITIVE(Plus, argc, argv, context, interp, loc)
  672. {
  673. if (argc == 0)
  674. return interp.makeInteger(0);
  675. long lResult;
  676. double dResult;
  677. bool usingD;
  678. bool spec = 0;
  679. int dim;
  680. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  681. case ELObj::noQuantity:
  682. dim = 1;
  683. spec = 1;
  684. break;
  685. case ELObj::longQuantity:
  686. usingD = 0;
  687. break;
  688. case ELObj::doubleQuantity:
  689. usingD = 1;
  690. break;
  691. default:
  692. CANNOT_HAPPEN();
  693. }
  694. for (int i = 1; !spec && i < argc; i++) {
  695. long lResult2;
  696. double dResult2;
  697. int dim2;
  698. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  699. case ELObj::noQuantity:
  700. // FIXME shouldn't quantityValue set dim to 1 for length-specs ?
  701. dim2 = 1;
  702. spec = 1;
  703. break;
  704. case ELObj::longQuantity:
  705. if (!usingD) {
  706. if (lResult2 < 0) {
  707. if (lResult >= LONG_MIN - lResult2) {
  708. lResult += lResult2;
  709. break;
  710. }
  711. }
  712. else {
  713. if (lResult <= LONG_MAX - lResult2) {
  714. lResult += lResult2;
  715. break;
  716. }
  717. }
  718. usingD = 1;
  719. dResult = double(lResult);
  720. }
  721. dResult += double(lResult2);
  722. break;
  723. case ELObj::doubleQuantity:
  724. if (!usingD) {
  725. dResult = lResult;
  726. usingD = 1;
  727. }
  728. dResult += dResult2;
  729. break;
  730. default:
  731. CANNOT_HAPPEN();
  732. }
  733. if (dim2 != dim) {
  734. interp.setNextLocation(loc);
  735. interp.message(InterpreterMessages::incompatibleDimensions);
  736. return interp.makeError();
  737. }
  738. }
  739. if (spec) {
  740. LengthSpec ls;
  741. for (int i = 0; i < argc; i++) {
  742. const LengthSpec *lsp = argv[i]->lengthSpec();
  743. if (lsp)
  744. ls += *lsp;
  745. else {
  746. switch (argv[i]->quantityValue(lResult, dResult, dim)) {
  747. case ELObj::noQuantity:
  748. return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
  749. i, argv[i]);
  750. case ELObj::longQuantity:
  751. dResult = lResult;
  752. // fall through
  753. case ELObj::doubleQuantity:
  754. if (dim != 1) {
  755. interp.setNextLocation(loc);
  756. interp.message(InterpreterMessages::incompatibleDimensions);
  757. return interp.makeError();
  758. }
  759. ls += dResult;
  760. break;
  761. }
  762. }
  763. }
  764. return new (interp) LengthSpecObj(ls);
  765. }
  766. if (!usingD) {
  767. if (dim == 0)
  768. return interp.makeInteger(lResult);
  769. else if (dim == 1)
  770. return new (interp) LengthObj(lResult);
  771. else
  772. dResult = lResult;
  773. }
  774. if (dim == 0)
  775. return new (interp) RealObj(dResult);
  776. else
  777. return new (interp) QuantityObj(dResult, dim);
  778. }
  779. DEFPRIMITIVE(Minus, argc, argv, context, interp, loc)
  780. {
  781. long lResult;
  782. double dResult;
  783. bool usingD;
  784. bool spec = 0;
  785. int dim;
  786. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  787. case ELObj::noQuantity:
  788. spec = 1;
  789. break;
  790. case ELObj::longQuantity:
  791. usingD = 0;
  792. break;
  793. case ELObj::doubleQuantity:
  794. usingD = 1;
  795. break;
  796. default:
  797. CANNOT_HAPPEN();
  798. }
  799. if (argc == 1) {
  800. if (usingD)
  801. dResult = -dResult;
  802. else
  803. lResult = -lResult;
  804. }
  805. else {
  806. for (int i = 1; !spec && i < argc; i++) {
  807. long lResult2;
  808. double dResult2;
  809. int dim2;
  810. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  811. case ELObj::noQuantity:
  812. dim2 = dim;
  813. spec = 1;
  814. break;
  815. case ELObj::longQuantity:
  816. if (!usingD) {
  817. if (lResult2 > 0) {
  818. if (lResult >= LONG_MIN + lResult2) {
  819. lResult -= lResult2;
  820. break;
  821. }
  822. }
  823. else {
  824. if (lResult <= LONG_MAX + lResult2) {
  825. lResult -= lResult2;
  826. break;
  827. }
  828. }
  829. usingD = 1;
  830. dResult = double(lResult);
  831. }
  832. dResult -= double(lResult2);
  833. break;
  834. case ELObj::doubleQuantity:
  835. if (!usingD) {
  836. dResult = lResult;
  837. usingD = 1;
  838. }
  839. dResult -= dResult2;
  840. break;
  841. default:
  842. CANNOT_HAPPEN();
  843. }
  844. if (dim2 != dim) {
  845. interp.setNextLocation(loc);
  846. interp.message(InterpreterMessages::incompatibleDimensions);
  847. return interp.makeError();
  848. }
  849. }
  850. }
  851. if (spec) {
  852. LengthSpec ls;
  853. for (int i = 0; i < argc; i++) {
  854. const LengthSpec *lsp = argv[i]->lengthSpec();
  855. if (lsp) {
  856. if (i > 0 || argc == 1)
  857. ls -= *lsp;
  858. else
  859. ls += *lsp;
  860. }
  861. else {
  862. switch (argv[i]->quantityValue(lResult, dResult, dim)) {
  863. case ELObj::noQuantity:
  864. return argError(interp, loc, InterpreterMessages::notAQuantityOrLengthSpec,
  865. i, argv[i]);
  866. case ELObj::longQuantity:
  867. dResult = lResult;
  868. // fall through
  869. case ELObj::doubleQuantity:
  870. if (dim != 1) {
  871. interp.setNextLocation(loc);
  872. interp.message(InterpreterMessages::incompatibleDimensions);
  873. return interp.makeError();
  874. }
  875. if (i > 0 || argc == 1)
  876. ls -= dResult;
  877. else
  878. ls += dResult;
  879. break;
  880. }
  881. }
  882. }
  883. return new (interp) LengthSpecObj(ls);
  884. }
  885. if (!usingD) {
  886. if (dim == 0)
  887. return interp.makeInteger(lResult);
  888. else if (dim == 1)
  889. return new (interp) LengthObj(lResult);
  890. else
  891. dResult = lResult;
  892. }
  893. if (dim == 0)
  894. return new (interp) RealObj(dResult);
  895. else
  896. return new (interp) QuantityObj(dResult, dim);
  897. }
  898. DEFPRIMITIVE(Multiply, argc, argv, context, interp, loc)
  899. {
  900. if (argc == 0)
  901. return interp.makeInteger(1);
  902. long lResult;
  903. double dResult;
  904. int dim;
  905. int i = 1;
  906. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  907. case ELObj::noQuantity:
  908. {
  909. const LengthSpec *ls = argv[0]->lengthSpec();
  910. if (ls) {
  911. LengthSpec result(*ls);
  912. double d;
  913. for (; i < argc; i++) {
  914. if (!argv[i]->realValue(d))
  915. return argError(interp, loc,
  916. InterpreterMessages::notANumber, 1, argv[1]);
  917. result *= d;
  918. }
  919. return new (interp) LengthSpecObj(result);
  920. }
  921. }
  922. return argError(interp, loc,
  923. InterpreterMessages::notAQuantity, 0, argv[0]);
  924. case ELObj::longQuantity:
  925. break;
  926. case ELObj::doubleQuantity:
  927. goto useDouble;
  928. default:
  929. CANNOT_HAPPEN();
  930. }
  931. long lResult2;
  932. double dResult2;
  933. int dim2;
  934. for (; i < argc; i++) {
  935. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  936. case ELObj::noQuantity:
  937. return argError(interp, loc,
  938. InterpreterMessages::notAQuantity, i, argv[i]);
  939. case ELObj::longQuantity:
  940. dim += dim2;
  941. if (dim > 1
  942. || (lResult2 != 0
  943. && (lResult2 < 0
  944. ? (lResult > 0
  945. ? lResult > -(unsigned)LONG_MIN / -(unsigned)lResult2
  946. : -(unsigned)lResult > LONG_MAX / -(unsigned)lResult2)
  947. : (lResult > 0
  948. ? lResult > LONG_MAX / lResult2
  949. : -(unsigned)lResult > -(unsigned)LONG_MIN / lResult2)))) {
  950. dResult = double(lResult) * lResult2;
  951. i++;
  952. goto useDouble;
  953. }
  954. lResult *= lResult2;
  955. break;
  956. case ELObj::doubleQuantity:
  957. dim += dim2;
  958. dResult = lResult * dResult2;
  959. i++;
  960. goto useDouble;
  961. default:
  962. CANNOT_HAPPEN();
  963. }
  964. }
  965. if (dim == 0)
  966. return interp.makeInteger(lResult);
  967. else
  968. return new (interp) LengthObj(lResult);
  969. useDouble:
  970. for (; i < argc; i++) {
  971. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  972. case ELObj::noQuantity:
  973. return argError(interp, loc,
  974. InterpreterMessages::notAQuantity, i, argv[i]);
  975. case ELObj::longQuantity:
  976. dResult *= lResult2;
  977. break;
  978. case ELObj::doubleQuantity:
  979. dResult *= dResult2;
  980. break;
  981. }
  982. dim += dim2;
  983. }
  984. if (dim == 0)
  985. return new (interp) RealObj(dResult);
  986. else
  987. return new (interp) QuantityObj(dResult, dim);
  988. }
  989. DEFPRIMITIVE(Divide, argc, argv, context, interp, loc)
  990. {
  991. long lResult;
  992. double dResult;
  993. int dim;
  994. if (argc == 1) {
  995. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  996. case ELObj::noQuantity:
  997. return argError(interp, loc,
  998. InterpreterMessages::notAQuantity, 0, argv[0]);
  999. case ELObj::longQuantity:
  1000. if (lResult == 0)
  1001. goto divide0;
  1002. dResult = 1.0/lResult;
  1003. break;
  1004. case ELObj::doubleQuantity:
  1005. if (dResult == 0.0)
  1006. goto divide0;
  1007. dResult = 1.0/dResult;
  1008. break;
  1009. default:
  1010. CANNOT_HAPPEN();
  1011. }
  1012. dim = -dim;
  1013. }
  1014. else {
  1015. int i = 1;
  1016. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  1017. case ELObj::noQuantity:
  1018. {
  1019. const LengthSpec *ls = argv[0]->lengthSpec();
  1020. if (ls) {
  1021. LengthSpec result(*ls);
  1022. double d;
  1023. for (; i < argc; i++) {
  1024. if (!argv[i]->realValue(d))
  1025. return argError(interp, loc,
  1026. InterpreterMessages::notANumber, 1, argv[1]);
  1027. if (d == 0.0)
  1028. goto divide0;
  1029. result /= d;
  1030. }
  1031. return new (interp) LengthSpecObj(result);
  1032. }
  1033. }
  1034. return argError(interp, loc,
  1035. InterpreterMessages::notAQuantity, 0, argv[0]);
  1036. case ELObj::longQuantity:
  1037. break;
  1038. case ELObj::doubleQuantity:
  1039. goto useDouble;
  1040. default:
  1041. CANNOT_HAPPEN();
  1042. }
  1043. long lResult2;
  1044. double dResult2;
  1045. int dim2;
  1046. for (; i < argc; i++) {
  1047. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  1048. case ELObj::noQuantity:
  1049. return argError(interp, loc,
  1050. InterpreterMessages::notAQuantity, 0, argv[0]);
  1051. case ELObj::longQuantity:
  1052. if (lResult2 == 0)
  1053. goto divide0;
  1054. dim -= dim2;
  1055. // If dim and dim2 are both 1, must goto useDouble:
  1056. // since lengths are inexact, result must be inexact.
  1057. if (dim2 == 0 && lResult % lResult2 == 0) {
  1058. lResult /= lResult2;
  1059. break;
  1060. }
  1061. dResult = double(lResult)/lResult2;
  1062. i++;
  1063. goto useDouble;
  1064. case ELObj::doubleQuantity:
  1065. dim -= dim2;
  1066. dResult = lResult;
  1067. if (dResult2 == 0.0)
  1068. goto divide0;
  1069. dResult /= dResult2;
  1070. i++;
  1071. goto useDouble;
  1072. default:
  1073. CANNOT_HAPPEN();
  1074. }
  1075. }
  1076. if (dim == 0)
  1077. return interp.makeInteger(lResult);
  1078. else
  1079. return new (interp) LengthObj(lResult);
  1080. useDouble:
  1081. for (; i < argc; i++) {
  1082. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  1083. case ELObj::noQuantity:
  1084. return argError(interp, loc,
  1085. InterpreterMessages::notAQuantity, i, argv[i]);
  1086. case ELObj::longQuantity:
  1087. if (lResult2 == 0)
  1088. goto divide0;
  1089. dResult /= lResult2;
  1090. break;
  1091. case ELObj::doubleQuantity:
  1092. dResult /= dResult2;
  1093. if (dResult2 == 0.0)
  1094. goto divide0;
  1095. break;
  1096. }
  1097. dim -= dim2;
  1098. }
  1099. }
  1100. if (dim == 0)
  1101. return new (interp) RealObj(dResult);
  1102. else
  1103. return new (interp) QuantityObj(dResult, dim);
  1104. divide0:
  1105. interp.setNextLocation(loc);
  1106. interp.message(InterpreterMessages::divideBy0);
  1107. return interp.makeError();
  1108. }
  1109. DEFPRIMITIVE(Quotient, argc, argv, context, interp, loc)
  1110. {
  1111. long n1;
  1112. long n2;
  1113. if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
  1114. if (n2 == 0) {
  1115. interp.setNextLocation(loc);
  1116. interp.message(InterpreterMessages::divideBy0);
  1117. return interp.makeError();
  1118. }
  1119. // This isn't strictly portable.
  1120. return interp.makeInteger(n1 / n2);
  1121. }
  1122. double d1;
  1123. if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
  1124. return argError(interp, loc,
  1125. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  1126. double d2;
  1127. if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
  1128. return argError(interp, loc,
  1129. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  1130. if (d2 == 0.0) {
  1131. interp.setNextLocation(loc);
  1132. interp.message(InterpreterMessages::divideBy0);
  1133. return interp.makeError();
  1134. }
  1135. return new (interp) RealObj((d1 - fmod(d1, d2))/d2);
  1136. }
  1137. DEFPRIMITIVE(Remainder, argc, argv, context, interp, loc)
  1138. {
  1139. long n1;
  1140. long n2;
  1141. if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
  1142. if (n2 == 0) {
  1143. interp.setNextLocation(loc);
  1144. interp.message(InterpreterMessages::divideBy0);
  1145. return interp.makeError();
  1146. }
  1147. // This isn't strictly portable.
  1148. return interp.makeInteger(n1 % n2);
  1149. }
  1150. double d1;
  1151. if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
  1152. return argError(interp, loc,
  1153. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  1154. double d2;
  1155. if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
  1156. return argError(interp, loc,
  1157. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  1158. if (d2 == 0.0) {
  1159. interp.setNextLocation(loc);
  1160. interp.message(InterpreterMessages::divideBy0);
  1161. return interp.makeError();
  1162. }
  1163. return new (interp) RealObj(fmod(d1, d2));
  1164. }
  1165. DEFPRIMITIVE(Modulo, argc, argv, context, interp, loc)
  1166. {
  1167. long n1;
  1168. long n2;
  1169. if (argv[0]->exactIntegerValue(n1) && argv[1]->exactIntegerValue(n2)) {
  1170. if (n2 == 0) {
  1171. interp.setNextLocation(loc);
  1172. interp.message(InterpreterMessages::divideBy0);
  1173. return interp.makeError();
  1174. }
  1175. long r = n1 % n2;
  1176. if (n2 > 0 ? r < 0 : r > 0)
  1177. r += n2;
  1178. return interp.makeInteger(r);
  1179. }
  1180. double d1;
  1181. if (!argv[0]->realValue(d1) || modf(d1, &d1) != 0.0)
  1182. return argError(interp, loc,
  1183. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  1184. double d2;
  1185. if (!argv[1]->realValue(d2) || modf(d2, &d2) != 0.0)
  1186. return argError(interp, loc,
  1187. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  1188. if (d2 == 0.0) {
  1189. interp.setNextLocation(loc);
  1190. interp.message(InterpreterMessages::divideBy0);
  1191. return interp.makeError();
  1192. }
  1193. double r = fmod(d1, d2);
  1194. if (d2 > 0 ? r < 0 : r > 0)
  1195. r += d2;
  1196. return new (interp) RealObj(r);
  1197. }
  1198. #define DEFCOMPARE(NAME, OP) \
  1199. DEFPRIMITIVE(NAME, argc, argv, context, interp, loc) \
  1200. { \
  1201. if (argc == 0) \
  1202. return interp.makeTrue(); \
  1203. long lResult; \
  1204. double dResult; \
  1205. int dim; \
  1206. bool lastWasDouble; \
  1207. switch (argv[0]->quantityValue(lResult, dResult, dim)) { \
  1208. case ELObj::noQuantity: \
  1209. return argError(interp, loc, \
  1210. InterpreterMessages::notAQuantity, 0, argv[0]); \
  1211. case ELObj::longQuantity: \
  1212. lastWasDouble = 0; \
  1213. break; \
  1214. case ELObj::doubleQuantity: \
  1215. lastWasDouble = 1; \
  1216. break; \
  1217. default: \
  1218. CANNOT_HAPPEN(); \
  1219. } \
  1220. for (int i = 1; i < argc; i++) { \
  1221. long lResult2; \
  1222. double dResult2; \
  1223. int dim2; \
  1224. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) { \
  1225. case ELObj::noQuantity: \
  1226. return argError(interp, loc, \
  1227. InterpreterMessages::notAQuantity, i, argv[i]); \
  1228. case ELObj::longQuantity: \
  1229. if (dim2 != dim) \
  1230. goto badDim; \
  1231. if (!(lastWasDouble \
  1232. ? (dResult OP lResult2) \
  1233. : (lResult OP lResult2))) \
  1234. return interp.makeFalse(); \
  1235. lResult = lResult2; \
  1236. lastWasDouble = 0; \
  1237. break; \
  1238. case ELObj::doubleQuantity: \
  1239. if (dim != dim2) \
  1240. goto badDim; \
  1241. if (!(lastWasDouble \
  1242. ? (dResult OP dResult2) \
  1243. : (lResult OP dResult2))) \
  1244. return interp.makeFalse(); \
  1245. dResult = dResult2; \
  1246. lastWasDouble = 1; \
  1247. break; \
  1248. } \
  1249. } \
  1250. return interp.makeTrue(); \
  1251. badDim: \
  1252. interp.setNextLocation(loc); \
  1253. interp.message(InterpreterMessages::incompatibleDimensions); \
  1254. return interp.makeError(); \
  1255. }
  1256. DEFCOMPARE(Less, <)
  1257. DEFCOMPARE(Greater, >)
  1258. DEFCOMPARE(LessEqual, <=)
  1259. DEFCOMPARE(GreaterEqual, >=)
  1260. DEFPRIMITIVE(Min, argc, argv, context, interp, loc)
  1261. {
  1262. long lResult;
  1263. double dResult;
  1264. int dim;
  1265. int i = 1;
  1266. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  1267. case ELObj::noQuantity:
  1268. return argError(interp, loc,
  1269. InterpreterMessages::notAQuantity, 0, argv[0]);
  1270. case ELObj::longQuantity:
  1271. break;
  1272. case ELObj::doubleQuantity:
  1273. goto useDouble;
  1274. default:
  1275. CANNOT_HAPPEN();
  1276. }
  1277. // Note that result is inexact if any of the arguments are
  1278. for (; i < argc; i++) {
  1279. long lResult2;
  1280. double dResult2;
  1281. int dim2;
  1282. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  1283. case ELObj::noQuantity:
  1284. return argError(interp, loc,
  1285. InterpreterMessages::notAQuantity, i, argv[i]);
  1286. case ELObj::longQuantity:
  1287. if (dim2 != dim)
  1288. goto badDim;
  1289. if (lResult2 < lResult)
  1290. lResult = lResult2;
  1291. break;
  1292. case ELObj::doubleQuantity:
  1293. if (dim != dim2)
  1294. goto badDim;
  1295. if (dResult2 < lResult)
  1296. dResult = dResult2;
  1297. else if (dim)
  1298. break;
  1299. else
  1300. dResult = lResult;
  1301. i++;
  1302. goto useDouble;
  1303. }
  1304. }
  1305. if (dim == 0)
  1306. return interp.makeInteger(lResult);
  1307. else
  1308. return new (interp) LengthObj(lResult);
  1309. useDouble:
  1310. for (; i < argc; i++) {
  1311. long lResult2;
  1312. double dResult2;
  1313. int dim2;
  1314. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  1315. case ELObj::noQuantity:
  1316. return argError(interp, loc,
  1317. InterpreterMessages::notAQuantity, i, argv[i]);
  1318. case ELObj::longQuantity:
  1319. if (dim2 != dim)
  1320. goto badDim;
  1321. if (lResult2 < dResult)
  1322. dResult = lResult2;
  1323. break;
  1324. case ELObj::doubleQuantity:
  1325. if (dim != dim2)
  1326. goto badDim;
  1327. if (dResult2 < dResult)
  1328. dResult = dResult2;
  1329. break;
  1330. }
  1331. }
  1332. if (dim == 0)
  1333. return new (interp) RealObj(dResult);
  1334. else
  1335. return new (interp) QuantityObj(dResult, dim);
  1336. badDim:
  1337. interp.setNextLocation(loc);
  1338. interp.message(InterpreterMessages::incompatibleDimensions);
  1339. return interp.makeError();
  1340. }
  1341. DEFPRIMITIVE(Max, argc, argv, context, interp, loc)
  1342. {
  1343. long lResult;
  1344. double dResult;
  1345. int dim;
  1346. int i = 1;
  1347. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  1348. case ELObj::noQuantity:
  1349. return argError(interp, loc,
  1350. InterpreterMessages::notAQuantity, 0, argv[0]);
  1351. case ELObj::longQuantity:
  1352. break;
  1353. case ELObj::doubleQuantity:
  1354. goto useDouble;
  1355. default:
  1356. CANNOT_HAPPEN();
  1357. }
  1358. // Note that result is inexact if any of the arguments are
  1359. for (; i < argc; i++) {
  1360. long lResult2;
  1361. double dResult2;
  1362. int dim2;
  1363. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  1364. case ELObj::noQuantity:
  1365. return argError(interp, loc,
  1366. InterpreterMessages::notAQuantity, i, argv[i]);
  1367. case ELObj::longQuantity:
  1368. if (dim2 != dim)
  1369. goto badDim;
  1370. if (lResult2 > lResult)
  1371. lResult = lResult2;
  1372. break;
  1373. case ELObj::doubleQuantity:
  1374. if (dim != dim2)
  1375. goto badDim;
  1376. if (dResult2 > lResult)
  1377. dResult = dResult2;
  1378. else if (dim)
  1379. break;
  1380. else
  1381. dResult = lResult;
  1382. i++;
  1383. goto useDouble;
  1384. }
  1385. }
  1386. if (dim == 0)
  1387. return interp.makeInteger(lResult);
  1388. else
  1389. return new (interp) LengthObj(lResult);
  1390. useDouble:
  1391. for (; i < argc; i++) {
  1392. long lResult2;
  1393. double dResult2;
  1394. int dim2;
  1395. switch (argv[i]->quantityValue(lResult2, dResult2, dim2)) {
  1396. case ELObj::noQuantity:
  1397. return argError(interp, loc,
  1398. InterpreterMessages::notAQuantity, i, argv[i]);
  1399. case ELObj::longQuantity:
  1400. if (dim2 != dim)
  1401. goto badDim;
  1402. if (lResult2 > dResult)
  1403. dResult = lResult2;
  1404. break;
  1405. case ELObj::doubleQuantity:
  1406. if (dim != dim2)
  1407. goto badDim;
  1408. if (dResult2 > dResult)
  1409. dResult = dResult2;
  1410. break;
  1411. }
  1412. }
  1413. if (dim == 0)
  1414. return new (interp) RealObj(dResult);
  1415. else
  1416. return new (interp) QuantityObj(dResult, dim);
  1417. badDim:
  1418. interp.setNextLocation(loc);
  1419. interp.message(InterpreterMessages::incompatibleDimensions);
  1420. return interp.makeError();
  1421. }
  1422. DEFPRIMITIVE(Floor, argc, argv, context, interp, loc)
  1423. {
  1424. double d;
  1425. if (argv[0]->inexactRealValue(d))
  1426. return new (interp) RealObj(floor(d));
  1427. long n;
  1428. if (argv[0]->exactIntegerValue(n))
  1429. return argv[0];
  1430. return argError(interp, loc,
  1431. InterpreterMessages::notANumber, 0, argv[0]);
  1432. }
  1433. DEFPRIMITIVE(Ceiling, argc, argv, context, interp, loc)
  1434. {
  1435. double d;
  1436. if (argv[0]->inexactRealValue(d))
  1437. return new (interp) RealObj(ceil(d));
  1438. long n;
  1439. if (argv[0]->exactIntegerValue(n))
  1440. return argv[0];
  1441. return argError(interp, loc,
  1442. InterpreterMessages::notANumber, 0, argv[0]);
  1443. }
  1444. DEFPRIMITIVE(Round, argc, argv, context, interp, loc)
  1445. {
  1446. double d;
  1447. if (argv[0]->inexactRealValue(d)) {
  1448. double result = floor(d + .5);
  1449. // That rounded it upwards.
  1450. // Now figure out if that was different from round to
  1451. // even.
  1452. if (result - d == 0.5 && fmod(result, 2.0) != 0)
  1453. result -= 1.0;
  1454. return new (interp) RealObj(result);
  1455. }
  1456. long n;
  1457. if (argv[0]->exactIntegerValue(n))
  1458. return argv[0];
  1459. return argError(interp, loc,
  1460. InterpreterMessages::notANumber, 0, argv[0]);
  1461. }
  1462. DEFPRIMITIVE(Truncate, argc, argv, context, interp, loc)
  1463. {
  1464. double d;
  1465. if (argv[0]->inexactRealValue(d)) {
  1466. double iPart;
  1467. modf(d, &iPart);
  1468. return new (interp) RealObj(iPart);
  1469. }
  1470. long n;
  1471. if (argv[0]->exactIntegerValue(n))
  1472. return argv[0];
  1473. return argError(interp, loc,
  1474. InterpreterMessages::notANumber, 0, argv[0]);
  1475. }
  1476. DEFPRIMITIVE(Abs, argc, argv, context, interp, loc)
  1477. {
  1478. long lResult;
  1479. double dResult;
  1480. int dim;
  1481. switch (argv[0]->quantityValue(lResult, dResult, dim)) {
  1482. case ELObj::noQuantity:
  1483. return argError(interp, loc,
  1484. InterpreterMessages::notAQuantity, 0, argv[0]);
  1485. case ELObj::longQuantity:
  1486. if (lResult != LONG_MIN) {
  1487. if (lResult >= 0)
  1488. return argv[0];
  1489. if (dim == 0)
  1490. return interp.makeInteger(-lResult);
  1491. else
  1492. return new (interp) LengthObj(-lResult);
  1493. }
  1494. dResult = lResult;
  1495. break;
  1496. case ELObj::doubleQuantity:
  1497. break;
  1498. default:
  1499. CANNOT_HAPPEN();
  1500. }
  1501. if (dResult >= 0)
  1502. return argv[0];
  1503. if (dim == 0)
  1504. return new (interp) RealObj(-dResult);
  1505. else
  1506. return new (interp) QuantityObj(-dResult, dim);
  1507. }
  1508. DEFPRIMITIVE(Sqrt, argc, argv, context, interp, loc)
  1509. {
  1510. long lResult;
  1511. double dResult;
  1512. int dim;
  1513. ELObj::QuantityType type
  1514. = argv[0]->quantityValue(lResult, dResult, dim);
  1515. switch (type) {
  1516. case ELObj::noQuantity:
  1517. return argError(interp, loc,
  1518. InterpreterMessages::notAQuantity, 0, argv[0]);
  1519. case ELObj::longQuantity:
  1520. dResult = lResult;
  1521. break;
  1522. case ELObj::doubleQuantity:
  1523. break;
  1524. default:
  1525. CANNOT_HAPPEN();
  1526. }
  1527. if ((dim & 1) || dResult < 0.0) {
  1528. interp.setNextLocation(loc);
  1529. interp.message(InterpreterMessages::outOfRange);
  1530. return interp.makeError();
  1531. }
  1532. dim /= 2;
  1533. dResult = sqrt(dResult);
  1534. if (type == ELObj::longQuantity && dim == 0) {
  1535. long n = long(dResult);
  1536. if (n*n == lResult)
  1537. return interp.makeInteger(n);
  1538. }
  1539. return new (interp) QuantityObj(dResult, dim);
  1540. }
  1541. DEFPRIMITIVE(Time, argc, argv, context, interp, loc)
  1542. {
  1543. // This assumes a Posix compatible time().
  1544. time_t t = time(0);
  1545. return interp.makeInteger(long(t));
  1546. }
  1547. DEFPRIMITIVE(TimeToString, argc, argv, context, interp, loc)
  1548. {
  1549. long k;
  1550. if (!argv[0]->exactIntegerValue(k))
  1551. return argError(interp, loc,
  1552. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  1553. time_t t = time_t(k);
  1554. const struct tm *p;
  1555. if (argc > 1 && argv[1] != interp.makeFalse())
  1556. p = gmtime(&t);
  1557. else
  1558. p = localtime(&t);
  1559. char buf[64];
  1560. sprintf(buf, "%04d-%02d-%02dT%02d:%02d:%02d",
  1561. p->tm_year + 1900, p->tm_mon + 1, p->tm_mday,
  1562. p->tm_hour, p->tm_min, p->tm_sec);
  1563. return new (interp) StringObj(interp.makeStringC(buf));
  1564. }
  1565. DEFPRIMITIVE(CharProperty, argc, argv, context, interp, loc)
  1566. {
  1567. SymbolObj *sym = argv[0]->asSymbol();
  1568. if (!sym)
  1569. return argError(interp, loc,
  1570. InterpreterMessages::notASymbol, 0, argv[0]);
  1571. StringObj *prop = argv[0]->asSymbol()->convertToString();
  1572. Char c;
  1573. if (!argv[1]->charValue(c))
  1574. return argError(interp, loc,
  1575. InterpreterMessages::notAChar, 1, argv[1]);
  1576. return interp.lookupCharProperty(*prop)->
  1577. value(c, (argc > 2) ? argv[2] : 0, loc, interp);
  1578. }
  1579. DEFPRIMITIVE(Literal, argc, argv, context, interp, loc)
  1580. {
  1581. if (argc == 0)
  1582. return new (interp) EmptySosofoObj;
  1583. const Char *s;
  1584. size_t n;
  1585. if (!argv[0]->stringData(s, n))
  1586. return argError(interp, loc, InterpreterMessages::notAString,
  1587. 0, argv[0]);
  1588. if (argc == 1)
  1589. return new (interp) LiteralSosofoObj(argv[0], loc);
  1590. StringObj *strObj = new (interp) StringObj(s, n);
  1591. for (int i = 1; i < argc; i++) {
  1592. if (!argv[i]->stringData(s, n))
  1593. return argError(interp, loc, InterpreterMessages::notAString,
  1594. i, argv[i]);
  1595. strObj->append(s, n);
  1596. }
  1597. ELObjDynamicRoot protect(interp, strObj);
  1598. return new (interp) LiteralSosofoObj(strObj, loc);
  1599. }
  1600. DEFPRIMITIVE(ProcessChildren, argc, argv, context, interp, loc)
  1601. {
  1602. if (!context.processingMode) {
  1603. interp.setNextLocation(loc);
  1604. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1605. return interp.makeError();
  1606. }
  1607. return new (interp) ProcessChildrenSosofoObj(context.processingMode, loc);
  1608. }
  1609. DEFPRIMITIVE(ProcessChildrenTrim, argc, argv, context, interp, loc)
  1610. {
  1611. if (!context.processingMode) {
  1612. interp.setNextLocation(loc);
  1613. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1614. return interp.makeError();
  1615. }
  1616. return new (interp) ProcessChildrenTrimSosofoObj(context.processingMode,
  1617. loc);
  1618. }
  1619. DEFPRIMITIVE(SosofoAppend, argc, argv, context, interp, loc)
  1620. {
  1621. AppendSosofoObj *obj = new (interp) AppendSosofoObj;
  1622. for (int i = 0; i < argc; i++) {
  1623. SosofoObj *sosofo = argv[i]->asSosofo();
  1624. if (!sosofo)
  1625. return argError(interp, loc, InterpreterMessages::notASosofo,
  1626. i, argv[i]);
  1627. obj->append(sosofo);
  1628. }
  1629. return obj;
  1630. }
  1631. DEFPRIMITIVE(NextMatch, argc, argv, context, interp, loc)
  1632. {
  1633. if (!context.processingMode) {
  1634. interp.setNextLocation(loc);
  1635. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1636. return interp.makeError();
  1637. }
  1638. StyleObj *style;
  1639. if (argc == 0)
  1640. style = 0;
  1641. else {
  1642. style = argv[0]->asStyle();
  1643. if (!style)
  1644. return argError(interp, loc, InterpreterMessages::notAStyle, 0, argv[0]);
  1645. }
  1646. return new (interp) NextMatchSosofoObj(style, loc);
  1647. }
  1648. DEFPRIMITIVE(EmptySosofo, argc, argv, context, interp, loc)
  1649. {
  1650. return new (interp) EmptySosofoObj;
  1651. }
  1652. DEFPRIMITIVE(SosofoLabel, argc, argv, context, interp, loc)
  1653. {
  1654. SosofoObj *sosofo = argv[0]->asSosofo();
  1655. if (!sosofo)
  1656. return argError(interp, loc, InterpreterMessages::notASosofo,
  1657. 0, argv[0]);
  1658. SymbolObj *sym = argv[1]->asSymbol();
  1659. if (!sym)
  1660. return argError(interp, loc,
  1661. InterpreterMessages::notASymbol, 1, argv[1]);
  1662. return new (interp) LabelSosofoObj(sym, loc, sosofo);
  1663. }
  1664. DEFPRIMITIVE(SosofoDiscardLabeled, argc, argv, context, interp, loc)
  1665. {
  1666. SosofoObj *sosofo = argv[0]->asSosofo();
  1667. if (!sosofo)
  1668. return argError(interp, loc, InterpreterMessages::notASosofo,
  1669. 0, argv[0]);
  1670. SymbolObj *sym = argv[1]->asSymbol();
  1671. if (!sym)
  1672. return argError(interp, loc,
  1673. InterpreterMessages::notASymbol, 1, argv[1]);
  1674. return new (interp) DiscardLabeledSosofoObj(sym, sosofo);
  1675. }
  1676. DEFPRIMITIVE(IsSosofo, argc, argv, context, interp, loc)
  1677. {
  1678. if (argv[0]->asSosofo())
  1679. return interp.makeTrue();
  1680. else
  1681. return interp.makeFalse();
  1682. }
  1683. DEFPRIMITIVE(MergeStyle, argc, argv, context, interp, loc)
  1684. {
  1685. MergeStyleObj *merged = new (interp) MergeStyleObj;
  1686. for (int i = 0; i < argc; i++) {
  1687. StyleObj *style = argv[i]->asStyle();
  1688. if (!style)
  1689. return argError(interp, loc,
  1690. InterpreterMessages::notAStyle, i, argv[i]);
  1691. merged->append(style);
  1692. }
  1693. return merged;
  1694. }
  1695. DEFPRIMITIVE(IsStyle, argc, argv, context, interp, loc)
  1696. {
  1697. if (argv[0]->asStyle())
  1698. return interp.makeTrue();
  1699. else
  1700. return interp.makeFalse();
  1701. }
  1702. DEFPRIMITIVE(CurrentNodePageNumberSosofo, argc, argv, context, interp, loc)
  1703. {
  1704. if (!context.currentNode)
  1705. return noCurrentNodeError(interp, loc);
  1706. return new (interp) CurrentNodePageNumberSosofoObj(context.currentNode);
  1707. }
  1708. DEFPRIMITIVE(PageNumberSosofo, argc, argv, context, interp, loc)
  1709. {
  1710. return new (interp) PageNumberSosofoObj;
  1711. }
  1712. DEFPRIMITIVE(ProcessElementWithId, argc, argv, context, interp, loc)
  1713. {
  1714. const Char *s;
  1715. size_t n;
  1716. if (!argv[0]->stringData(s, n))
  1717. return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
  1718. if (!context.currentNode)
  1719. return noCurrentNodeError(interp, loc);
  1720. if (!context.processingMode) {
  1721. interp.setNextLocation(loc);
  1722. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1723. return interp.makeError();
  1724. }
  1725. NodePtr root;
  1726. NamedNodeListPtr elements;
  1727. if (context.currentNode->getGroveRoot(root) == accessOK
  1728. && root->getElements(elements) == accessOK) {
  1729. NodePtr node;
  1730. if (elements->namedNode(GroveString(s, n), node) == accessOK)
  1731. return new (interp) ProcessNodeSosofoObj(node, context.processingMode,
  1732. loc);
  1733. }
  1734. return new (interp) EmptySosofoObj;
  1735. }
  1736. DEFPRIMITIVE(ProcessFirstDescendant, argc, argv, context, interp, loc)
  1737. {
  1738. if (!context.processingMode) {
  1739. interp.setNextLocation(loc);
  1740. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1741. return interp.makeError();
  1742. }
  1743. if (!context.currentNode)
  1744. return noCurrentNodeError(interp, loc);
  1745. NCVector<Pattern> patterns(argc);
  1746. for (size_t i = 0; i < argc; i++) {
  1747. if (!interp.convertToPattern(argv[i], loc, patterns[i]))
  1748. return interp.makeError();
  1749. }
  1750. NodeListObj *nl = new (interp) DescendantsNodeListObj(context.currentNode, interp);
  1751. ELObjDynamicRoot protect(interp, nl);
  1752. nl = new (interp) SelectElementsNodeListObj(nl, patterns);
  1753. protect = nl;
  1754. NodePtr nd(nl->nodeListFirst(context, interp));
  1755. if (!nd)
  1756. return new (interp) EmptySosofoObj;
  1757. return new (interp) ProcessNodeSosofoObj(nd, context.processingMode, loc);
  1758. }
  1759. DEFPRIMITIVE(ProcessMatchingChildren, argc, argv, context, interp, loc)
  1760. {
  1761. if (!context.processingMode) {
  1762. interp.setNextLocation(loc);
  1763. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1764. return interp.makeError();
  1765. }
  1766. if (!context.currentNode)
  1767. return noCurrentNodeError(interp, loc);
  1768. NCVector<Pattern> patterns(argc);
  1769. for (size_t i = 0; i < argc; i++) {
  1770. if (!interp.convertToPattern(argv[i], loc, patterns[i]))
  1771. return interp.makeError();
  1772. }
  1773. NodeListPtr nlPtr;
  1774. // FIXME handle root
  1775. if (patterns.size() == 0 || context.currentNode->children(nlPtr) != accessOK)
  1776. return new (interp) EmptySosofoObj;
  1777. NodeListObj *nl = new (interp) NodeListPtrNodeListObj(nlPtr);
  1778. ELObjDynamicRoot protect(interp, nl);
  1779. nl = new (interp) SelectElementsNodeListObj(nl, patterns);
  1780. protect = nl;
  1781. return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode,
  1782. loc);
  1783. }
  1784. DEFPRIMITIVE(SelectElements, argc, argv, context, interp, loc)
  1785. {
  1786. NodeListObj *nl = argv[0]->asNodeList();
  1787. if (!nl)
  1788. return argError(interp, loc,
  1789. InterpreterMessages::notANodeList, 0, argv[0]);
  1790. NCVector<Pattern> patterns(1);
  1791. if (!interp.convertToPattern(argv[1], loc, patterns[0]))
  1792. return interp.makeError();
  1793. return new (interp) SelectElementsNodeListObj(nl, patterns);
  1794. }
  1795. DEFPRIMITIVE(IsMatchElement, argc, argv, context, interp, loc)
  1796. {
  1797. Pattern pattern;
  1798. if (!interp.convertToPattern(argv[0], loc, pattern))
  1799. return interp.makeError();
  1800. NodePtr node;
  1801. if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
  1802. return argError(interp, loc,
  1803. InterpreterMessages::notASingletonNode, 1, argv[1]);
  1804. if (pattern.matches(node, interp))
  1805. return interp.makeTrue();
  1806. return interp.makeFalse();
  1807. }
  1808. DEFPRIMITIVE(IsNodeListContains, argc, argv, context, interp, loc)
  1809. {
  1810. NodeListObj *nl = argv[0]->asNodeList();
  1811. if (!nl)
  1812. return argError(interp, loc,
  1813. InterpreterMessages::notANodeList, 0, argv[0]);
  1814. NodePtr node;
  1815. if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
  1816. return argError(interp, loc,
  1817. InterpreterMessages::notASingletonNode, 1, argv[1]);
  1818. if (nl->contains(context, interp, node))
  1819. return interp.makeTrue();
  1820. return interp.makeFalse();
  1821. }
  1822. DEFPRIMITIVE(ProcessNodeList, argc, argv, context, interp, loc)
  1823. {
  1824. if (!context.processingMode) {
  1825. interp.setNextLocation(loc);
  1826. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1827. return interp.makeError();
  1828. }
  1829. NodeListObj *nl = argv[0]->asNodeList();
  1830. if (!nl)
  1831. return argError(interp, loc,
  1832. InterpreterMessages::notANodeList, 0, argv[0]);
  1833. return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode, loc);
  1834. }
  1835. static
  1836. void reverse(StringC &s)
  1837. {
  1838. size_t i = 0;
  1839. size_t j = s.size() - 1;
  1840. while (i < j) {
  1841. Char tem = s[i];
  1842. s[i] = s[j];
  1843. s[j] = tem;
  1844. i++;
  1845. j--;
  1846. }
  1847. }
  1848. static
  1849. StringC formatNumberLetter(long n, const char *letters)
  1850. {
  1851. StringC result;
  1852. if (n == 0)
  1853. result += '0';
  1854. else {
  1855. bool neg;
  1856. // FIXME possibility of overflow
  1857. if (n < 0) {
  1858. n = -n;
  1859. neg = 1;
  1860. }
  1861. else
  1862. neg = 0;
  1863. do {
  1864. n--;
  1865. int r = n % 26;
  1866. n -= r;
  1867. n /= 26;
  1868. result += letters[r];
  1869. } while (n > 0);
  1870. if (neg)
  1871. result += '-';
  1872. reverse(result);
  1873. }
  1874. return result;
  1875. }
  1876. static
  1877. StringC formatNumberDecimal(long n, size_t minWidth)
  1878. {
  1879. StringC result;
  1880. char buf[32];
  1881. sprintf(buf, "%ld", n);
  1882. const char *p = buf;
  1883. if (*p == '-') {
  1884. p++;
  1885. result += '-';
  1886. }
  1887. size_t len = strlen(p);
  1888. while (len < minWidth) {
  1889. result += '0';
  1890. len++;
  1891. }
  1892. while (*p)
  1893. result += *p++;
  1894. return result;
  1895. }
  1896. static
  1897. StringC formatNumberRoman(long n, const char *letters)
  1898. {
  1899. StringC result;
  1900. if (n > 5000 || n < -5000 || n == 0)
  1901. return formatNumberDecimal(n, 1);
  1902. if (n < 0) {
  1903. n = -n;
  1904. result += '-';
  1905. }
  1906. while (n >= 1000) {
  1907. result += letters[0];
  1908. n -= 1000;
  1909. }
  1910. for (int i = 100; i > 0; i /= 10, letters += 2) {
  1911. long q = n / i;
  1912. n -= q * i;
  1913. switch (q) {
  1914. case 1:
  1915. result += letters[2];
  1916. break;
  1917. case 2:
  1918. result += letters[2];
  1919. result += letters[2];
  1920. break;
  1921. case 3:
  1922. result += letters[2];
  1923. result += letters[2];
  1924. result += letters[2];
  1925. break;
  1926. case 4:
  1927. result += letters[2];
  1928. result += letters[1];
  1929. break;
  1930. case 5:
  1931. result += letters[1];
  1932. break;
  1933. case 6:
  1934. result += letters[1];
  1935. result += letters[2];
  1936. break;
  1937. case 7:
  1938. result += letters[1];
  1939. result += letters[2];
  1940. result += letters[2];
  1941. break;
  1942. case 8:
  1943. result += letters[1];
  1944. result += letters[2];
  1945. result += letters[2];
  1946. result += letters[2];
  1947. break;
  1948. case 9:
  1949. result += letters[2];
  1950. result += letters[0];
  1951. break;
  1952. }
  1953. }
  1954. return result;
  1955. }
  1956. static
  1957. bool formatNumber(long n, const Char *s, size_t len, StringC &result)
  1958. {
  1959. if (len > 0) {
  1960. switch (s[len - 1]) {
  1961. case 'a':
  1962. result += formatNumberLetter(n, "abcdefghijklmnopqrstuvwxyz");
  1963. return 1;
  1964. case 'A':
  1965. result += formatNumberLetter(n, "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
  1966. return 1;
  1967. case 'i':
  1968. result += formatNumberRoman(n, "mdclxvi");
  1969. return 1;
  1970. case 'I':
  1971. result += formatNumberRoman(n, "MDCLXVI");
  1972. return 1;
  1973. case '1':
  1974. result += formatNumberDecimal(n, len);
  1975. return 1;
  1976. default:
  1977. break;
  1978. }
  1979. }
  1980. result += formatNumberDecimal(n, 1);
  1981. return 0;
  1982. }
  1983. DEFPRIMITIVE(FormatNumber, argc, argv, context, interp, loc)
  1984. {
  1985. long n;
  1986. if (!argv[0]->exactIntegerValue(n))
  1987. return argError(interp, loc,
  1988. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  1989. const Char *s;
  1990. size_t len;
  1991. if (!argv[1]->stringData(s, len))
  1992. return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
  1993. StringObj *result = new (interp) StringObj;
  1994. if (!formatNumber(n, s, len, *result)) {
  1995. interp.setNextLocation(loc);
  1996. interp.message(InterpreterMessages::invalidNumberFormat,
  1997. StringMessageArg(StringC(s, len)));
  1998. }
  1999. return result;
  2000. }
  2001. DEFPRIMITIVE(FormatNumberList, argc, argv, context, interp, loc)
  2002. {
  2003. ELObj *numbers = argv[0];
  2004. ELObj *formats = argv[1];
  2005. ELObj *seps = argv[2];
  2006. StringObj *result = new (interp) StringObj;
  2007. while (!numbers->isNil()) {
  2008. PairObj *tem;
  2009. const Char *s;
  2010. size_t len;
  2011. if (numbers != argv[0]) {
  2012. if (!seps->stringData(s, len)) {
  2013. tem = seps->asPair();
  2014. if (!tem)
  2015. return argError(interp, loc,
  2016. InterpreterMessages::notAList, 2, argv[2]);
  2017. if (!tem->car()->stringData(s, len))
  2018. return argError(interp, loc,
  2019. InterpreterMessages::notAString, 2, tem->car());
  2020. seps = tem->cdr();
  2021. }
  2022. result->append(s, len);
  2023. }
  2024. tem = numbers->asPair();
  2025. if (!tem)
  2026. return argError(interp, loc,
  2027. InterpreterMessages::notAList, 0, argv[0]);
  2028. long k;
  2029. if (!tem->car()->exactIntegerValue(k))
  2030. // FIXME message not quite right
  2031. return argError(interp, loc,
  2032. InterpreterMessages::notAnExactInteger, 0, tem->car());
  2033. numbers = tem->cdr();
  2034. if (!formats->stringData(s, len)) {
  2035. tem = formats->asPair();
  2036. if (!tem)
  2037. return argError(interp, loc,
  2038. InterpreterMessages::notAList, 1, argv[1]);
  2039. if (!tem->car()->stringData(s, len))
  2040. return argError(interp, loc,
  2041. InterpreterMessages::notAString, 0, tem->car());
  2042. formats = tem->cdr();
  2043. }
  2044. if (!formatNumber(k, s, len, *result)) {
  2045. interp.setNextLocation(loc);
  2046. interp.message(InterpreterMessages::invalidNumberFormat,
  2047. StringMessageArg(StringC(s, len)));
  2048. }
  2049. }
  2050. return result;
  2051. }
  2052. DEFPRIMITIVE(ExternalProcedure, argc, argv, context, interp, loc)
  2053. {
  2054. const Char *s;
  2055. size_t n;
  2056. if (!argv[0]->stringData(s, n))
  2057. return argError(interp, loc,
  2058. InterpreterMessages::notAString, 0, argv[0]);
  2059. StringC tem(s, n);
  2060. FunctionObj *func = interp.lookupExternalProc(tem);
  2061. if (func)
  2062. return func;
  2063. return interp.makeFalse();
  2064. }
  2065. DEFPRIMITIVE(Error, argc, argv, context, interp, loc)
  2066. {
  2067. const Char *s;
  2068. size_t n;
  2069. if (!argv[0]->stringData(s, n))
  2070. return argError(interp, loc,
  2071. InterpreterMessages::notAString, 0, argv[0]);
  2072. interp.setNextLocation(loc);
  2073. interp.message(InterpreterMessages::errorProc,
  2074. StringMessageArg(StringC(s, n)));
  2075. return interp.makeError();
  2076. }
  2077. DEFPRIMITIVE(StringToNumber, argc, argv, context, interp, loc)
  2078. {
  2079. const Char *s;
  2080. size_t n;
  2081. if (!argv[0]->stringData(s, n))
  2082. return argError(interp, loc,
  2083. InterpreterMessages::notAString, 0, argv[0]);
  2084. long radix;
  2085. if (argc > 1) {
  2086. if (!argv[1]->exactIntegerValue(radix))
  2087. return argError(interp, loc,
  2088. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  2089. switch (radix) {
  2090. case 2:
  2091. case 8:
  2092. case 10:
  2093. case 16:
  2094. break;
  2095. default:
  2096. interp.setNextLocation(loc);
  2097. interp.message(InterpreterMessages::invalidRadix);
  2098. radix = 10;
  2099. break;
  2100. }
  2101. }
  2102. else
  2103. radix = 10;
  2104. ELObj *result = interp.convertNumber(StringC(s, n), int(radix));
  2105. if (result) {
  2106. result = result->resolveQuantities(0, interp, loc);
  2107. if (interp.isError(result))
  2108. return result;
  2109. long n;
  2110. double d;
  2111. int dim;
  2112. if (result->quantityValue(n, d, dim) != ELObj::noQuantity)
  2113. return result;
  2114. }
  2115. return interp.makeFalse();
  2116. }
  2117. DEFPRIMITIVE(NumberToString, argc, argv, context, interp, loc)
  2118. {
  2119. double x;
  2120. if (!argv[0]->realValue(x))
  2121. return argError(interp, loc,
  2122. InterpreterMessages::notANumber, 0, argv[0]);
  2123. unsigned radix;
  2124. if (argc > 1) {
  2125. long r;
  2126. if (!argv[1]->exactIntegerValue(r))
  2127. return argError(interp, loc,
  2128. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  2129. switch (r) {
  2130. case 2:
  2131. case 8:
  2132. case 10:
  2133. case 16:
  2134. radix = unsigned(r);
  2135. break;
  2136. default:
  2137. interp.setNextLocation(loc);
  2138. interp.message(InterpreterMessages::invalidRadix);
  2139. radix = 10;
  2140. break;
  2141. }
  2142. }
  2143. else
  2144. radix = 10;
  2145. StrOutputCharStream os;
  2146. argv[0]->print(interp, os, radix);
  2147. StringC tem;
  2148. os.extractString(tem);
  2149. return new (interp) StringObj(tem);
  2150. }
  2151. DEFPRIMITIVE(QuantityToString, argc, argv, context, interp, loc)
  2152. {
  2153. long lResult;
  2154. double dResult;
  2155. int dim;
  2156. if (argv[0]->quantityValue(lResult, dResult, dim) == ELObj::noQuantity)
  2157. return argError(interp, loc,
  2158. InterpreterMessages::notAQuantity, 0, argv[0]);
  2159. unsigned radix;
  2160. if (argc > 1) {
  2161. long r;
  2162. if (!argv[1]->exactIntegerValue(r))
  2163. return argError(interp, loc,
  2164. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  2165. switch (r) {
  2166. case 2:
  2167. case 8:
  2168. case 10:
  2169. case 16:
  2170. radix = unsigned(r);
  2171. break;
  2172. default:
  2173. interp.setNextLocation(loc);
  2174. interp.message(InterpreterMessages::invalidRadix);
  2175. radix = 10;
  2176. break;
  2177. }
  2178. }
  2179. else
  2180. radix = 10;
  2181. StrOutputCharStream os;
  2182. argv[0]->print(interp, os, radix);
  2183. StringC tem;
  2184. os.extractString(tem);
  2185. return new (interp) StringObj(tem);
  2186. }
  2187. DEFPRIMITIVE(DisplaySize, argc, argv, context, interp, loc)
  2188. {
  2189. return new (interp) LengthSpecObj(LengthSpec(LengthSpec::displaySize, 1.0));
  2190. }
  2191. DEFPRIMITIVE(TableUnit, argc, argv, context, interp, loc)
  2192. {
  2193. long k;
  2194. if (!argv[0]->exactIntegerValue(k))
  2195. return argError(interp, loc,
  2196. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  2197. return new (interp) LengthSpecObj(LengthSpec(LengthSpec::tableUnit, double(k)));
  2198. }
  2199. DEFPRIMITIVE(IsDisplaySpace, argc, argv, context, interp, loc)
  2200. {
  2201. if (argv[0]->asDisplaySpace())
  2202. return interp.makeTrue();
  2203. else
  2204. return interp.makeFalse();
  2205. }
  2206. DEFPRIMITIVE(DisplaySpace, argc, argv, context, interp, loc)
  2207. {
  2208. FOTBuilder::DisplaySpace displaySpace;
  2209. if (!interp.convertLengthSpec(argv[0], displaySpace.nominal))
  2210. return argError(interp, loc,
  2211. InterpreterMessages::notALengthSpec, 0, argv[0]);
  2212. displaySpace.min = displaySpace.nominal;
  2213. displaySpace.max = displaySpace.nominal;
  2214. // first specified keyword argument takes priority,
  2215. // so scan them backwards...
  2216. for (int i = argc - 1; i > 0; i -= 2) {
  2217. if ((argc & 1) == 0) {
  2218. interp.setNextLocation(loc);
  2219. interp.message(InterpreterMessages::oddKeyArgs);
  2220. return interp.makeError();
  2221. }
  2222. KeywordObj *keyObj = argv[i - 1]->asKeyword();
  2223. if (!keyObj) {
  2224. interp.setNextLocation(loc);
  2225. interp.message(InterpreterMessages::keyArgsNotKey);
  2226. return interp.makeError();
  2227. }
  2228. Identifier::SyntacticKey key;
  2229. if (!keyObj->identifier()->syntacticKey(key)) {
  2230. interp.setNextLocation(loc);
  2231. interp.message(InterpreterMessages::invalidKeyArg,
  2232. StringMessageArg(keyObj->identifier()->name()));
  2233. return interp.makeError();
  2234. }
  2235. else {
  2236. switch (key) {
  2237. case Identifier::keyMin:
  2238. if (!interp.convertLengthSpec(argv[i], displaySpace.min))
  2239. return argError(interp, loc,
  2240. InterpreterMessages::notALengthSpec, i, argv[i]);
  2241. break;
  2242. case Identifier::keyMax:
  2243. if (!interp.convertLengthSpec(argv[i], displaySpace.max))
  2244. return argError(interp, loc,
  2245. InterpreterMessages::notALengthSpec, i, argv[i]);
  2246. break;
  2247. case Identifier::keyIsConditional:
  2248. if (argv[i] == interp.makeTrue())
  2249. displaySpace.conditional = 1;
  2250. else if (argv[i] == interp.makeFalse())
  2251. displaySpace.conditional = 0;
  2252. else
  2253. return argError(interp, loc,
  2254. InterpreterMessages::notABoolean, i, argv[i]);
  2255. break;
  2256. case Identifier::keyPriority:
  2257. if (argv[i]->exactIntegerValue(displaySpace.priority))
  2258. displaySpace.force = 0;
  2259. else {
  2260. SymbolObj *sym = argv[i]->asSymbol();
  2261. if (sym && sym->cValue() == FOTBuilder::symbolForce)
  2262. displaySpace.force = 1;
  2263. else
  2264. return argError(interp, loc,
  2265. InterpreterMessages::notAPriority, i, argv[i]);
  2266. }
  2267. break;
  2268. default:
  2269. interp.setNextLocation(loc);
  2270. interp.message(InterpreterMessages::invalidKeyArg,
  2271. StringMessageArg(keyObj->identifier()->name()));
  2272. return interp.makeError();
  2273. }
  2274. }
  2275. }
  2276. return new (interp) DisplaySpaceObj(displaySpace);
  2277. }
  2278. DEFPRIMITIVE(IsInlineSpace, argc, argv, context, interp, loc)
  2279. {
  2280. if (argv[0]->asInlineSpace())
  2281. return interp.makeTrue();
  2282. else
  2283. return interp.makeFalse();
  2284. }
  2285. DEFPRIMITIVE(InlineSpace, argc, argv, context, interp, loc)
  2286. {
  2287. FOTBuilder::InlineSpace inlineSpace;
  2288. if (!interp.convertLengthSpec(argv[0], inlineSpace.nominal))
  2289. return argError(interp, loc,
  2290. InterpreterMessages::notALengthSpec, 0, argv[0]);
  2291. inlineSpace.min = inlineSpace.nominal;
  2292. inlineSpace.max = inlineSpace.nominal;
  2293. // first specified keyword argument takes priority,
  2294. // so scan them backwards...
  2295. for (int i = argc - 1; i > 0; i -= 2) {
  2296. if ((argc & 1) == 0) {
  2297. interp.setNextLocation(loc);
  2298. interp.message(InterpreterMessages::oddKeyArgs);
  2299. return interp.makeError();
  2300. }
  2301. KeywordObj *keyObj = argv[i - 1]->asKeyword();
  2302. if (!keyObj) {
  2303. interp.setNextLocation(loc);
  2304. interp.message(InterpreterMessages::keyArgsNotKey);
  2305. return interp.makeError();
  2306. }
  2307. Identifier::SyntacticKey key;
  2308. if (!keyObj->identifier()->syntacticKey(key)) {
  2309. interp.setNextLocation(loc);
  2310. interp.message(InterpreterMessages::invalidKeyArg,
  2311. StringMessageArg(keyObj->identifier()->name()));
  2312. return interp.makeError();
  2313. }
  2314. else {
  2315. switch (key) {
  2316. case Identifier::keyMin:
  2317. if (!interp.convertLengthSpec(argv[i], inlineSpace.min))
  2318. return argError(interp, loc,
  2319. InterpreterMessages::notALengthSpec, i, argv[i]);
  2320. break;
  2321. case Identifier::keyMax:
  2322. if (!interp.convertLengthSpec(argv[i], inlineSpace.max))
  2323. return argError(interp, loc,
  2324. InterpreterMessages::notALengthSpec, i, argv[i]);
  2325. break;
  2326. default:
  2327. interp.setNextLocation(loc);
  2328. interp.message(InterpreterMessages::invalidKeyArg,
  2329. StringMessageArg(keyObj->identifier()->name()));
  2330. return interp.makeError();
  2331. }
  2332. }
  2333. }
  2334. return new (interp) InlineSpaceObj(inlineSpace);
  2335. return argv[0];
  2336. }
  2337. DEFPRIMITIVE(IsColor, argc, argv, context, interp, loc)
  2338. {
  2339. if (argv[0]->asColor())
  2340. return interp.makeTrue();
  2341. else
  2342. return interp.makeFalse();
  2343. }
  2344. DEFPRIMITIVE(IsColorSpace, argc, argv, context, interp, loc)
  2345. {
  2346. if (argv[0]->asColorSpace())
  2347. return interp.makeTrue();
  2348. else
  2349. return interp.makeFalse();
  2350. }
  2351. static
  2352. bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
  2353. int nKeys, Interpreter &interp, const Location &loc, int *pos);
  2354. // return 1 if obj is a list of numbers of length len.
  2355. static
  2356. bool decodeNumVector(double *res, int len, ELObj *obj)
  2357. {
  2358. ELObj *e = obj;
  2359. PairObj *p;
  2360. for (int i = 0; i < len; i++) {
  2361. p = e->asPair();
  2362. if (!p || !p->car()->realValue(res[i]))
  2363. return 0;
  2364. e = p->cdr();
  2365. }
  2366. return 1;
  2367. }
  2368. static
  2369. bool decodeFuncVector(FunctionObj **res, int len, ELObj *obj)
  2370. {
  2371. ELObj *e = obj;
  2372. PairObj *p;
  2373. for (int i = 0; i < len; i++) {
  2374. p = e->asPair();
  2375. if (!p || !(res[i] = p->car()->asFunction()))
  2376. return 0;
  2377. e = p->cdr();
  2378. }
  2379. return 1;
  2380. }
  2381. DEFPRIMITIVE(ColorSpace, argc, argv, context, interp, loc)
  2382. {
  2383. const Char *s;
  2384. size_t n;
  2385. if (!argv[0]->stringData(s, n))
  2386. return argError(interp, loc,
  2387. InterpreterMessages::notAString, 0, argv[0]);
  2388. StringC str(s, (n < 43) ? n : 43);
  2389. if (str == interp.makeStringC("ISO/IEC 10179:1996//Color-Space Family::Dev")) {
  2390. str.assign(s + 40, n - 40);
  2391. ELObj *res;
  2392. if (str == interp.makeStringC("Device RGB"))
  2393. res = new (interp) DeviceRGBColorSpaceObj;
  2394. else if (str == interp.makeStringC("Device Gray"))
  2395. res = new (interp) DeviceGrayColorSpaceObj;
  2396. else if (str == interp.makeStringC("Device CMYK"))
  2397. res = new (interp) DeviceCMYKColorSpaceObj;
  2398. else if (str == interp.makeStringC("Device KX"))
  2399. res = new (interp) DeviceKXColorSpaceObj;
  2400. else {
  2401. interp.setNextLocation(loc);
  2402. interp.message(InterpreterMessages: