PageRenderTime 31ms CodeModel.GetById 20ms RepoModel.GetById 1ms app.codeStats 0ms

/trunk/jade/style/primitive.cxx

#
C++ | 2536 lines | 2375 code | 127 blank | 34 comment | 530 complexity | c9594c69e1b005e797f09c46b05da9eb MD5 | raw file
Possible License(s): LGPL-2.1, LGPL-2.0
  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. /* Optimize the case where there is no or only
  1622. one argument */
  1623. if (argc == 0)
  1624. return new (interp) EmptySosofoObj;
  1625. else if (argc == 1) {
  1626. SosofoObj *sosofo = argv[0]->asSosofo();
  1627. if (!sosofo)
  1628. return argError(interp, loc, InterpreterMessages::notASosofo,
  1629. 0, argv[0]);
  1630. return sosofo;
  1631. }
  1632. /* Don't create another object if the first argument is
  1633. already an AppendSosofoObj, this handles gracefully
  1634. case like
  1635. (let loop ( (res (empty-sosofo))
  1636. (nl (node-list-rest (children (current-node)))))
  1637. (loop (sosofo-append res (process-node-list (node-list-first nl)))
  1638. (node-list-rest nl)))
  1639. */
  1640. AppendSosofoObj *obj;
  1641. int i = 0;
  1642. if ( argv[i]->asAppendSosofo() )
  1643. obj = argv[i++]->asAppendSosofo();
  1644. else
  1645. obj = new (interp) AppendSosofoObj;
  1646. for ( ; i < argc; i++) {
  1647. SosofoObj *sosofo = argv[i]->asSosofo();
  1648. if (!sosofo)
  1649. return argError(interp, loc, InterpreterMessages::notASosofo,
  1650. i, argv[i]);
  1651. obj->append(sosofo);
  1652. }
  1653. return obj;
  1654. }
  1655. DEFPRIMITIVE(NextMatch, argc, argv, context, interp, loc)
  1656. {
  1657. if (!context.processingMode) {
  1658. interp.setNextLocation(loc);
  1659. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1660. return interp.makeError();
  1661. }
  1662. StyleObj *style;
  1663. if (argc == 0)
  1664. style = 0;
  1665. else {
  1666. style = argv[0]->asStyle();
  1667. if (!style)
  1668. return argError(interp, loc, InterpreterMessages::notAStyle, 0, argv[0]);
  1669. }
  1670. return new (interp) NextMatchSosofoObj(style, loc);
  1671. }
  1672. DEFPRIMITIVE(EmptySosofo, argc, argv, context, interp, loc)
  1673. {
  1674. return new (interp) EmptySosofoObj;
  1675. }
  1676. DEFPRIMITIVE(SosofoLabel, argc, argv, context, interp, loc)
  1677. {
  1678. SosofoObj *sosofo = argv[0]->asSosofo();
  1679. if (!sosofo)
  1680. return argError(interp, loc, InterpreterMessages::notASosofo,
  1681. 0, argv[0]);
  1682. SymbolObj *sym = argv[1]->asSymbol();
  1683. if (!sym)
  1684. return argError(interp, loc,
  1685. InterpreterMessages::notASymbol, 1, argv[1]);
  1686. return new (interp) LabelSosofoObj(sym, loc, sosofo);
  1687. }
  1688. DEFPRIMITIVE(SosofoDiscardLabeled, argc, argv, context, interp, loc)
  1689. {
  1690. SosofoObj *sosofo = argv[0]->asSosofo();
  1691. if (!sosofo)
  1692. return argError(interp, loc, InterpreterMessages::notASosofo,
  1693. 0, argv[0]);
  1694. SymbolObj *sym = argv[1]->asSymbol();
  1695. if (!sym)
  1696. return argError(interp, loc,
  1697. InterpreterMessages::notASymbol, 1, argv[1]);
  1698. return new (interp) DiscardLabeledSosofoObj(sym, sosofo);
  1699. }
  1700. DEFPRIMITIVE(IsSosofo, argc, argv, context, interp, loc)
  1701. {
  1702. if (argv[0]->asSosofo())
  1703. return interp.makeTrue();
  1704. else
  1705. return interp.makeFalse();
  1706. }
  1707. DEFPRIMITIVE(MergeStyle, argc, argv, context, interp, loc)
  1708. {
  1709. MergeStyleObj *merged = new (interp) MergeStyleObj;
  1710. for (int i = 0; i < argc; i++) {
  1711. StyleObj *style = argv[i]->asStyle();
  1712. if (!style)
  1713. return argError(interp, loc,
  1714. InterpreterMessages::notAStyle, i, argv[i]);
  1715. merged->append(style);
  1716. }
  1717. return merged;
  1718. }
  1719. DEFPRIMITIVE(IsStyle, argc, argv, context, interp, loc)
  1720. {
  1721. if (argv[0]->asStyle())
  1722. return interp.makeTrue();
  1723. else
  1724. return interp.makeFalse();
  1725. }
  1726. DEFPRIMITIVE(CurrentNodePageNumberSosofo, argc, argv, context, interp, loc)
  1727. {
  1728. if (!context.currentNode)
  1729. return noCurrentNodeError(interp, loc);
  1730. return new (interp) CurrentNodePageNumberSosofoObj(context.currentNode);
  1731. }
  1732. DEFPRIMITIVE(PageNumberSosofo, argc, argv, context, interp, loc)
  1733. {
  1734. return new (interp) PageNumberSosofoObj;
  1735. }
  1736. DEFPRIMITIVE(ProcessElementWithId, argc, argv, context, interp, loc)
  1737. {
  1738. const Char *s;
  1739. size_t n;
  1740. if (!argv[0]->stringData(s, n))
  1741. return argError(interp, loc, InterpreterMessages::notAString, 0, argv[0]);
  1742. if (!context.currentNode)
  1743. return noCurrentNodeError(interp, loc);
  1744. if (!context.processingMode) {
  1745. interp.setNextLocation(loc);
  1746. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1747. return interp.makeError();
  1748. }
  1749. NodePtr root;
  1750. NamedNodeListPtr elements;
  1751. if (context.currentNode->getGroveRoot(root) == accessOK
  1752. && root->getElements(elements) == accessOK) {
  1753. NodePtr node;
  1754. if (elements->namedNode(GroveString(s, n), node) == accessOK)
  1755. return new (interp) ProcessNodeSosofoObj(node, context.processingMode,
  1756. loc);
  1757. }
  1758. return new (interp) EmptySosofoObj;
  1759. }
  1760. DEFPRIMITIVE(ProcessFirstDescendant, argc, argv, context, interp, loc)
  1761. {
  1762. if (!context.processingMode) {
  1763. interp.setNextLocation(loc);
  1764. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1765. return interp.makeError();
  1766. }
  1767. if (!context.currentNode)
  1768. return noCurrentNodeError(interp, loc);
  1769. NCVector<Pattern> patterns(argc);
  1770. for (size_t i = 0; i < argc; i++) {
  1771. if (!interp.convertToPattern(argv[i], loc, patterns[i]))
  1772. return interp.makeError();
  1773. }
  1774. NodeListObj *nl = new (interp) DescendantsNodeListObj(context.currentNode, interp);
  1775. ELObjDynamicRoot protect(interp, nl);
  1776. nl = new (interp) SelectElementsNodeListObj(nl, patterns);
  1777. protect = nl;
  1778. NodePtr nd(nl->nodeListFirst(context, interp));
  1779. if (!nd)
  1780. return new (interp) EmptySosofoObj;
  1781. return new (interp) ProcessNodeSosofoObj(nd, context.processingMode, loc);
  1782. }
  1783. DEFPRIMITIVE(ProcessMatchingChildren, argc, argv, context, interp, loc)
  1784. {
  1785. if (!context.processingMode) {
  1786. interp.setNextLocation(loc);
  1787. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1788. return interp.makeError();
  1789. }
  1790. if (!context.currentNode)
  1791. return noCurrentNodeError(interp, loc);
  1792. NCVector<Pattern> patterns(argc);
  1793. for (size_t i = 0; i < argc; i++) {
  1794. if (!interp.convertToPattern(argv[i], loc, patterns[i]))
  1795. return interp.makeError();
  1796. }
  1797. NodeListPtr nlPtr;
  1798. // FIXME handle root
  1799. if (patterns.size() == 0 || context.currentNode->children(nlPtr) != accessOK)
  1800. return new (interp) EmptySosofoObj;
  1801. NodeListObj *nl = new (interp) NodeListPtrNodeListObj(nlPtr);
  1802. ELObjDynamicRoot protect(interp, nl);
  1803. nl = new (interp) SelectElementsNodeListObj(nl, patterns);
  1804. protect = nl;
  1805. return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode,
  1806. loc);
  1807. }
  1808. DEFPRIMITIVE(SelectElements, 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. NCVector<Pattern> patterns(1);
  1815. if (!interp.convertToPattern(argv[1], loc, patterns[0]))
  1816. return interp.makeError();
  1817. return new (interp) SelectElementsNodeListObj(nl, patterns);
  1818. }
  1819. DEFPRIMITIVE(IsMatchElement, argc, argv, context, interp, loc)
  1820. {
  1821. Pattern pattern;
  1822. if (!interp.convertToPattern(argv[0], loc, pattern))
  1823. return interp.makeError();
  1824. NodePtr node;
  1825. if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
  1826. return argError(interp, loc,
  1827. InterpreterMessages::notASingletonNode, 1, argv[1]);
  1828. if (pattern.matches(node, interp))
  1829. return interp.makeTrue();
  1830. return interp.makeFalse();
  1831. }
  1832. DEFPRIMITIVE(IsNodeListContains, argc, argv, context, interp, loc)
  1833. {
  1834. NodeListObj *nl = argv[0]->asNodeList();
  1835. if (!nl)
  1836. return argError(interp, loc,
  1837. InterpreterMessages::notANodeList, 0, argv[0]);
  1838. NodePtr node;
  1839. if (!argv[1]->optSingletonNodeList(context, interp, node) || !node)
  1840. return argError(interp, loc,
  1841. InterpreterMessages::notASingletonNode, 1, argv[1]);
  1842. if (nl->contains(context, interp, node))
  1843. return interp.makeTrue();
  1844. return interp.makeFalse();
  1845. }
  1846. DEFPRIMITIVE(ProcessNodeList, argc, argv, context, interp, loc)
  1847. {
  1848. if (!context.processingMode) {
  1849. interp.setNextLocation(loc);
  1850. interp.message(InterpreterMessages::noCurrentProcessingMode);
  1851. return interp.makeError();
  1852. }
  1853. NodeListObj *nl = argv[0]->asNodeList();
  1854. if (!nl)
  1855. return argError(interp, loc,
  1856. InterpreterMessages::notANodeList, 0, argv[0]);
  1857. return new (interp) ProcessNodeListSosofoObj(nl, context.processingMode, loc);
  1858. }
  1859. static
  1860. void reverse(StringC &s)
  1861. {
  1862. size_t i = 0;
  1863. size_t j = s.size() - 1;
  1864. while (i < j) {
  1865. Char tem = s[i];
  1866. s[i] = s[j];
  1867. s[j] = tem;
  1868. i++;
  1869. j--;
  1870. }
  1871. }
  1872. static
  1873. StringC formatNumberLetter(long n, const char *letters)
  1874. {
  1875. StringC result;
  1876. if (n == 0)
  1877. result += '0';
  1878. else {
  1879. bool neg;
  1880. // FIXME possibility of overflow
  1881. if (n < 0) {
  1882. n = -n;
  1883. neg = 1;
  1884. }
  1885. else
  1886. neg = 0;
  1887. do {
  1888. n--;
  1889. int r = n % 26;
  1890. n -= r;
  1891. n /= 26;
  1892. result += letters[r];
  1893. } while (n > 0);
  1894. if (neg)
  1895. result += '-';
  1896. reverse(result);
  1897. }
  1898. return result;
  1899. }
  1900. static
  1901. StringC formatNumberDecimal(long n, size_t minWidth)
  1902. {
  1903. StringC result;
  1904. char buf[32];
  1905. sprintf(buf, "%ld", n);
  1906. const char *p = buf;
  1907. if (*p == '-') {
  1908. p++;
  1909. result += '-';
  1910. }
  1911. size_t len = strlen(p);
  1912. while (len < minWidth) {
  1913. result += '0';
  1914. len++;
  1915. }
  1916. while (*p)
  1917. result += *p++;
  1918. return result;
  1919. }
  1920. static
  1921. StringC formatNumberRoman(long n, const char *letters)
  1922. {
  1923. StringC result;
  1924. if (n > 5000 || n < -5000 || n == 0)
  1925. return formatNumberDecimal(n, 1);
  1926. if (n < 0) {
  1927. n = -n;
  1928. result += '-';
  1929. }
  1930. while (n >= 1000) {
  1931. result += letters[0];
  1932. n -= 1000;
  1933. }
  1934. for (int i = 100; i > 0; i /= 10, letters += 2) {
  1935. long q = n / i;
  1936. n -= q * i;
  1937. switch (q) {
  1938. case 1:
  1939. result += letters[2];
  1940. break;
  1941. case 2:
  1942. result += letters[2];
  1943. result += letters[2];
  1944. break;
  1945. case 3:
  1946. result += letters[2];
  1947. result += letters[2];
  1948. result += letters[2];
  1949. break;
  1950. case 4:
  1951. result += letters[2];
  1952. result += letters[1];
  1953. break;
  1954. case 5:
  1955. result += letters[1];
  1956. break;
  1957. case 6:
  1958. result += letters[1];
  1959. result += letters[2];
  1960. break;
  1961. case 7:
  1962. result += letters[1];
  1963. result += letters[2];
  1964. result += letters[2];
  1965. break;
  1966. case 8:
  1967. result += letters[1];
  1968. result += letters[2];
  1969. result += letters[2];
  1970. result += letters[2];
  1971. break;
  1972. case 9:
  1973. result += letters[2];
  1974. result += letters[0];
  1975. break;
  1976. }
  1977. }
  1978. return result;
  1979. }
  1980. static
  1981. bool formatNumber(long n, const Char *s, size_t len, StringC &result)
  1982. {
  1983. if (len > 0) {
  1984. switch (s[len - 1]) {
  1985. case 'a':
  1986. result += formatNumberLetter(n, "abcdefghijklmnopqrstuvwxyz");
  1987. return 1;
  1988. case 'A':
  1989. result += formatNumberLetter(n, "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
  1990. return 1;
  1991. case 'i':
  1992. result += formatNumberRoman(n, "mdclxvi");
  1993. return 1;
  1994. case 'I':
  1995. result += formatNumberRoman(n, "MDCLXVI");
  1996. return 1;
  1997. case '1':
  1998. result += formatNumberDecimal(n, len);
  1999. return 1;
  2000. default:
  2001. break;
  2002. }
  2003. }
  2004. result += formatNumberDecimal(n, 1);
  2005. return 0;
  2006. }
  2007. DEFPRIMITIVE(FormatNumber, argc, argv, context, interp, loc)
  2008. {
  2009. long n;
  2010. if (!argv[0]->exactIntegerValue(n))
  2011. return argError(interp, loc,
  2012. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  2013. const Char *s;
  2014. size_t len;
  2015. if (!argv[1]->stringData(s, len))
  2016. return argError(interp, loc, InterpreterMessages::notAString, 1, argv[1]);
  2017. StringObj *result = new (interp) StringObj;
  2018. if (!formatNumber(n, s, len, *result)) {
  2019. interp.setNextLocation(loc);
  2020. interp.message(InterpreterMessages::invalidNumberFormat,
  2021. StringMessageArg(StringC(s, len)));
  2022. }
  2023. return result;
  2024. }
  2025. DEFPRIMITIVE(FormatNumberList, argc, argv, context, interp, loc)
  2026. {
  2027. ELObj *numbers = argv[0];
  2028. ELObj *formats = argv[1];
  2029. ELObj *seps = argv[2];
  2030. StringObj *result = new (interp) StringObj;
  2031. while (!numbers->isNil()) {
  2032. PairObj *tem;
  2033. const Char *s;
  2034. size_t len;
  2035. if (numbers != argv[0]) {
  2036. if (!seps->stringData(s, len)) {
  2037. tem = seps->asPair();
  2038. if (!tem)
  2039. return argError(interp, loc,
  2040. InterpreterMessages::notAList, 2, argv[2]);
  2041. if (!tem->car()->stringData(s, len))
  2042. return argError(interp, loc,
  2043. InterpreterMessages::notAString, 2, tem->car());
  2044. seps = tem->cdr();
  2045. }
  2046. result->append(s, len);
  2047. }
  2048. tem = numbers->asPair();
  2049. if (!tem)
  2050. return argError(interp, loc,
  2051. InterpreterMessages::notAList, 0, argv[0]);
  2052. long k;
  2053. if (!tem->car()->exactIntegerValue(k))
  2054. // FIXME message not quite right
  2055. return argError(interp, loc,
  2056. InterpreterMessages::notAnExactInteger, 0, tem->car());
  2057. numbers = tem->cdr();
  2058. if (!formats->stringData(s, len)) {
  2059. tem = formats->asPair();
  2060. if (!tem)
  2061. return argError(interp, loc,
  2062. InterpreterMessages::notAList, 1, argv[1]);
  2063. if (!tem->car()->stringData(s, len))
  2064. return argError(interp, loc,
  2065. InterpreterMessages::notAString, 0, tem->car());
  2066. formats = tem->cdr();
  2067. }
  2068. if (!formatNumber(k, s, len, *result)) {
  2069. interp.setNextLocation(loc);
  2070. interp.message(InterpreterMessages::invalidNumberFormat,
  2071. StringMessageArg(StringC(s, len)));
  2072. }
  2073. }
  2074. return result;
  2075. }
  2076. DEFPRIMITIVE(ExternalProcedure, argc, argv, context, interp, loc)
  2077. {
  2078. const Char *s;
  2079. size_t n;
  2080. if (!argv[0]->stringData(s, n))
  2081. return argError(interp, loc,
  2082. InterpreterMessages::notAString, 0, argv[0]);
  2083. StringC tem(s, n);
  2084. FunctionObj *func = interp.lookupExternalProc(tem);
  2085. if (func)
  2086. return func;
  2087. return interp.makeFalse();
  2088. }
  2089. DEFPRIMITIVE(Error, argc, argv, context, interp, loc)
  2090. {
  2091. const Char *s;
  2092. size_t n;
  2093. if (!argv[0]->stringData(s, n))
  2094. return argError(interp, loc,
  2095. InterpreterMessages::notAString, 0, argv[0]);
  2096. interp.setNextLocation(loc);
  2097. interp.message(InterpreterMessages::errorProc,
  2098. StringMessageArg(StringC(s, n)));
  2099. return interp.makeError();
  2100. }
  2101. DEFPRIMITIVE(StringToNumber, argc, argv, context, interp, loc)
  2102. {
  2103. const Char *s;
  2104. size_t n;
  2105. if (!argv[0]->stringData(s, n))
  2106. return argError(interp, loc,
  2107. InterpreterMessages::notAString, 0, argv[0]);
  2108. long radix;
  2109. if (argc > 1) {
  2110. if (!argv[1]->exactIntegerValue(radix))
  2111. return argError(interp, loc,
  2112. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  2113. switch (radix) {
  2114. case 2:
  2115. case 8:
  2116. case 10:
  2117. case 16:
  2118. break;
  2119. default:
  2120. interp.setNextLocation(loc);
  2121. interp.message(InterpreterMessages::invalidRadix);
  2122. radix = 10;
  2123. break;
  2124. }
  2125. }
  2126. else
  2127. radix = 10;
  2128. ELObj *result = interp.convertNumber(StringC(s, n), int(radix));
  2129. if (result) {
  2130. result = result->resolveQuantities(0, interp, loc);
  2131. if (interp.isError(result))
  2132. return result;
  2133. long n;
  2134. double d;
  2135. int dim;
  2136. if (result->quantityValue(n, d, dim) != ELObj::noQuantity)
  2137. return result;
  2138. }
  2139. return interp.makeFalse();
  2140. }
  2141. DEFPRIMITIVE(NumberToString, argc, argv, context, interp, loc)
  2142. {
  2143. double x;
  2144. if (!argv[0]->realValue(x))
  2145. return argError(interp, loc,
  2146. InterpreterMessages::notANumber, 0, argv[0]);
  2147. unsigned radix;
  2148. if (argc > 1) {
  2149. long r;
  2150. if (!argv[1]->exactIntegerValue(r))
  2151. return argError(interp, loc,
  2152. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  2153. switch (r) {
  2154. case 2:
  2155. case 8:
  2156. case 10:
  2157. case 16:
  2158. radix = unsigned(r);
  2159. break;
  2160. default:
  2161. interp.setNextLocation(loc);
  2162. interp.message(InterpreterMessages::invalidRadix);
  2163. radix = 10;
  2164. break;
  2165. }
  2166. }
  2167. else
  2168. radix = 10;
  2169. StrOutputCharStream os;
  2170. argv[0]->print(interp, os, radix);
  2171. StringC tem;
  2172. os.extractString(tem);
  2173. return new (interp) StringObj(tem);
  2174. }
  2175. DEFPRIMITIVE(QuantityToString, argc, argv, context, interp, loc)
  2176. {
  2177. long lResult;
  2178. double dResult;
  2179. int dim;
  2180. if (argv[0]->quantityValue(lResult, dResult, dim) == ELObj::noQuantity)
  2181. return argError(interp, loc,
  2182. InterpreterMessages::notAQuantity, 0, argv[0]);
  2183. unsigned radix;
  2184. if (argc > 1) {
  2185. long r;
  2186. if (!argv[1]->exactIntegerValue(r))
  2187. return argError(interp, loc,
  2188. InterpreterMessages::notAnExactInteger, 1, argv[1]);
  2189. switch (r) {
  2190. case 2:
  2191. case 8:
  2192. case 10:
  2193. case 16:
  2194. radix = unsigned(r);
  2195. break;
  2196. default:
  2197. interp.setNextLocation(loc);
  2198. interp.message(InterpreterMessages::invalidRadix);
  2199. radix = 10;
  2200. break;
  2201. }
  2202. }
  2203. else
  2204. radix = 10;
  2205. StrOutputCharStream os;
  2206. argv[0]->print(interp, os, radix);
  2207. StringC tem;
  2208. os.extractString(tem);
  2209. return new (interp) StringObj(tem);
  2210. }
  2211. DEFPRIMITIVE(DisplaySize, argc, argv, context, interp, loc)
  2212. {
  2213. return new (interp) LengthSpecObj(LengthSpec(LengthSpec::displaySize, 1.0));
  2214. }
  2215. DEFPRIMITIVE(TableUnit, argc, argv, context, interp, loc)
  2216. {
  2217. long k;
  2218. if (!argv[0]->exactIntegerValue(k))
  2219. return argError(interp, loc,
  2220. InterpreterMessages::notAnExactInteger, 0, argv[0]);
  2221. return new (interp) LengthSpecObj(LengthSpec(LengthSpec::tableUnit, double(k)));
  2222. }
  2223. DEFPRIMITIVE(IsDisplaySpace, argc, argv, context, interp, loc)
  2224. {
  2225. if (argv[0]->asDisplaySpace())
  2226. return interp.makeTrue();
  2227. else
  2228. return interp.makeFalse();
  2229. }
  2230. DEFPRIMITIVE(DisplaySpace, argc, argv, context, interp, loc)
  2231. {
  2232. FOTBuilder::DisplaySpace displaySpace;
  2233. if (!interp.convertLengthSpec(argv[0], displaySpace.nominal))
  2234. return argError(interp, loc,
  2235. InterpreterMessages::notALengthSpec, 0, argv[0]);
  2236. displaySpace.min = displaySpace.nominal;
  2237. displaySpace.max = displaySpace.nominal;
  2238. // first specified keyword argument takes priority,
  2239. // so scan them backwards...
  2240. for (int i = argc - 1; i > 0; i -= 2) {
  2241. if ((argc & 1) == 0) {
  2242. interp.setNextLocation(loc);
  2243. interp.message(InterpreterMessages::oddKeyArgs);
  2244. return interp.makeError();
  2245. }
  2246. KeywordObj *keyObj = argv[i - 1]->asKeyword();
  2247. if (!keyObj) {
  2248. interp.setNextLocation(loc);
  2249. interp.message(InterpreterMessages::keyArgsNotKey);
  2250. return interp.makeError();
  2251. }
  2252. Identifier::SyntacticKey key;
  2253. if (!keyObj->identifier()->syntacticKey(key)) {
  2254. interp.setNextLocation(loc);
  2255. interp.message(InterpreterMessages::invalidKeyArg,
  2256. StringMessageArg(keyObj->identifier()->name()));
  2257. return interp.makeError();
  2258. }
  2259. else {
  2260. switch (key) {
  2261. case Identifier::keyMin:
  2262. if (!interp.convertLengthSpec(argv[i], displaySpace.min))
  2263. return argError(interp, loc,
  2264. InterpreterMessages::notALengthSpec, i, argv[i]);
  2265. break;
  2266. case Identifier::keyMax:
  2267. if (!interp.convertLengthSpec(argv[i], displaySpace.max))
  2268. return argError(interp, loc,
  2269. InterpreterMessages::notALengthSpec, i, argv[i]);
  2270. break;
  2271. case Identifier::keyIsConditional:
  2272. if (argv[i] == interp.makeTrue())
  2273. displaySpace.conditional = 1;
  2274. else if (argv[i] == interp.makeFalse())
  2275. displaySpace.conditional = 0;
  2276. else
  2277. return argError(interp, loc,
  2278. InterpreterMessages::notABoolean, i, argv[i]);
  2279. break;
  2280. case Identifier::keyPriority:
  2281. if (argv[i]->exactIntegerValue(displaySpace.priority))
  2282. displaySpace.force = 0;
  2283. else {
  2284. SymbolObj *sym = argv[i]->asSymbol();
  2285. if (sym && sym->cValue() == FOTBuilder::symbolForce)
  2286. displaySpace.force = 1;
  2287. else
  2288. return argError(interp, loc,
  2289. InterpreterMessages::notAPriority, i, argv[i]);
  2290. }
  2291. break;
  2292. default:
  2293. interp.setNextLocation(loc);
  2294. interp.message(InterpreterMessages::invalidKeyArg,
  2295. StringMessageArg(keyObj->identifier()->name()));
  2296. return interp.makeError();
  2297. }
  2298. }
  2299. }
  2300. return new (interp) DisplaySpaceObj(displaySpace);
  2301. }
  2302. DEFPRIMITIVE(IsInlineSpace, argc, argv, context, interp, loc)
  2303. {
  2304. if (argv[0]->asInlineSpace())
  2305. return interp.makeTrue();
  2306. else
  2307. return interp.makeFalse();
  2308. }
  2309. DEFPRIMITIVE(InlineSpace, argc, argv, context, interp, loc)
  2310. {
  2311. FOTBuilder::InlineSpace inlineSpace;
  2312. if (!interp.convertLengthSpec(argv[0], inlineSpace.nominal))
  2313. return argError(interp, loc,
  2314. InterpreterMessages::notALengthSpec, 0, argv[0]);
  2315. inlineSpace.min = inlineSpace.nominal;
  2316. inlineSpace.max = inlineSpace.nominal;
  2317. // first specified keyword argument takes priority,
  2318. // so scan them backwards...
  2319. for (int i = argc - 1; i > 0; i -= 2) {
  2320. if ((argc & 1) == 0) {
  2321. interp.setNextLocation(loc);
  2322. interp.message(InterpreterMessages::oddKeyArgs);
  2323. return interp.makeError();
  2324. }
  2325. KeywordObj *keyObj = argv[i - 1]->asKeyword();
  2326. if (!keyObj) {
  2327. interp.setNextLocation(loc);
  2328. interp.message(InterpreterMessages::keyArgsNotKey);
  2329. return interp.makeError();
  2330. }
  2331. Identifier::SyntacticKey key;
  2332. if (!keyObj->identifier()->syntacticKey(key)) {
  2333. interp.setNextLocation(loc);
  2334. interp.message(InterpreterMessages::invalidKeyArg,
  2335. StringMessageArg(keyObj->identifier()->name()));
  2336. return interp.makeError();
  2337. }
  2338. else {
  2339. switch (key) {
  2340. case Identifier::keyMin:
  2341. if (!interp.convertLengthSpec(argv[i], inlineSpace.min))
  2342. return argError(interp, loc,
  2343. InterpreterMessages::notALengthSpec, i, argv[i]);
  2344. break;
  2345. case Identifier::keyMax:
  2346. if (!interp.convertLengthSpec(argv[i], inlineSpace.max))
  2347. return argError(interp, loc,
  2348. InterpreterMessages::notALengthSpec, i, argv[i]);
  2349. break;
  2350. default:
  2351. interp.setNextLocation(loc);
  2352. interp.message(InterpreterMessages::invalidKeyArg,
  2353. StringMessageArg(keyObj->identifier()->name()));
  2354. return interp.makeError();
  2355. }
  2356. }
  2357. }
  2358. return new (interp) InlineSpaceObj(inlineSpace);
  2359. return argv[0];
  2360. }
  2361. DEFPRIMITIVE(IsColor, argc, argv, context, interp, loc)
  2362. {
  2363. if (argv[0]->asColor())
  2364. return interp.makeTrue();
  2365. else
  2366. return interp.makeFalse();
  2367. }
  2368. DEFPRIMITIVE(IsColorSpace, argc, argv, context, interp, loc)
  2369. {
  2370. if (argv[0]->asColorSpace())
  2371. return interp.makeTrue();
  2372. else
  2373. return interp.makeFalse();
  2374. }
  2375. static
  2376. bool decodeKeyArgs(int argc, ELObj **argv, const Identifier::SyntacticKey *keys,
  2377. int nKeys, Interpreter &interp, const Location &loc, int *pos);
  2378. // return 1 if obj is a list of numbers of length len.
  2379. static
  2380. bool decodeNumVector(double *res, int len, ELObj *obj)
  2381. {
  2382. ELObj *e = obj;
  2383. PairObj *p;
  2384. for (int i = 0; i < len; i++) {
  2385. p = e->asPair();
  2386. if (!p || !p->car()->realValue(res[i]))
  2387. return 0;
  2388. e = p->cdr();
  2389. }
  2390. return 1;
  2391. }
  2392. static
  2393. bool decodeFuncVector(FunctionObj **res, int len, ELObj *obj)
  2394. {
  2395. ELObj *e = obj;
  2396. PairObj *p;
  2397. for (int i = 0; i < len; i++) {
  2398. p = e->asPair();
  2399. if (!p || !(res[i] = p->car()->asFunction()))
  2400. return 0;
  2401. e = p->cdr();
  2402. }
  2403. return 1;
  2404. }
  2405. DEFPRIMITIVE(ColorSpace, argc, argv, context, interp, loc)
  2406. {
  2407. const Char *s;
  2408. size_t n;
  2409. if (!argv[0]->stringData(s, n))