PROG8.LST 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383
  1. Listing:
  2. 1 MODULE prog8;
  3. 2 (* This program implements a simple interactive calculator *)
  4. 3 IMPORT IO,Str,Storage;
  5. 4
  6. 5 TYPE
  7. 6 TokenType = (number, add, sub, mul, div, LeftParen,
  8. 7 RightParen, end);
  9. 8 SyntacticType = (main, exp, term, factor);
  10. 9 TreeType = POINTER TO TreeRecordType;
  11. ***** ^ undeclared identifier
  12. 10
  13. 11 TreeRecordType = RECORD
  14. 12 CASE kind:TokenType OF
  15. ***** ^ not supported yet
  16. 13 | number :
  17. ***** ^ not supported yet
  18. 14 NumberValue : LONGREAL;
  19. 15 | add,sub,mul,div :
  20. ***** ^ not supported yet
  21. ***** ^ not supported yet
  22. ***** ^ not supported yet
  23. ***** ^ not supported yet
  24. 16 left : TreeType;
  25. 17 right : TreeType;
  26. 18 END;
  27. 19 END;
  28. ***** ^ not supported yet
  29. 20
  30. 21 VAR
  31. 22 c:CHAR;
  32. 23 token:TokenType;
  33. ***** ^ not supported yet
  34. 24 TokenNumberValue:LONGREAL;
  35. 25
  36. 26 PROCEDURE error(s:ARRAY OF CHAR);
  37. ***** ^ not supported yet
  38. 27 BEGIN
  39. 28 IO.WrStr(s);
  40. ***** ^ not supported yet
  41. ***** ^ not supported yet
  42. ***** ^ not supported yet
  43. 29 IO.WrLn;
  44. ***** ^ not supported yet
  45. ***** ^ not supported yet
  46. 30 HALT;
  47. ***** ^ undeclared identifier
  48. 31 END error;
  49. ***** ^ not supported yet
  50. 32
  51. 33 PROCEDURE readtoken;
  52. 34 VAR
  53. 35 s:ARRAY[0..99] OF CHAR;
  54. ***** ^ not supported yet
  55. ***** ^ not supported yet
  56. 36 i:[0..99];
  57. 37 done:BOOLEAN;
  58. 38 oldc:CHAR;
  59. 39 BEGIN
  60. 40 LOOP
  61. 41 oldc := c;
  62. 42 c := IO.RdChar();
  63. ***** ^ not supported yet
  64. ***** ^ not supported yet
  65. ***** ^ not supported yet
  66. 43 CASE oldc OF
  67. 44 | ' ' :
  68. 45 | '+' : token := add; EXIT;
  69. ***** ^ not supported yet
  70. ***** ^ not supported yet
  71. 46 | '-' : token := sub; EXIT;
  72. ***** ^ not supported yet
  73. ***** ^ not supported yet
  74. 47 | '*' : token := mul; EXIT;
  75. ***** ^ not supported yet
  76. ***** ^ not supported yet
  77. 48 | '/' : token := div; EXIT;
  78. ***** ^ not supported yet
  79. ***** ^ not supported yet
  80. 49 | '(' : token := LeftParen; EXIT;
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. 50 | ')' : token := RightParen; EXIT;
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 51 | CHAR(10),CHAR(13),CHAR(26) : token := end; EXIT;
  87. ***** ^ not supported yet
  88. ***** ^ not supported yet
  89. ***** ^ not supported yet
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. 52
  93. 53 | '0'..'9' : (* read a real number *)
  94. 54 i := 1; s[0] := oldc;
  95. ***** ^ not supported yet
  96. ***** ^ not supported yet
  97. 55 WHILE (c >= '0') AND (c <= '9') DO
  98. 56 s[i] := c;
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. 57 INC(i);
  102. ***** ^ undeclared identifier
  103. ***** ^ not supported yet
  104. 58 c := IO.RdChar();
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. ***** ^ not supported yet
  108. 59 END;
  109. 60 IF c<>'.' THEN (* add decimal point if none in input *)
  110. 61 s[i] := '.';
  111. ***** ^ not supported yet
  112. ***** ^ not supported yet
  113. 62 INC(i);
  114. ***** ^ undeclared identifier
  115. ***** ^ not supported yet
  116. 63 ELSE
  117. 64 REPEAT (* read fraction part *)
  118. 65 s[i] := c;
  119. ***** ^ not supported yet
  120. ***** ^ not supported yet
  121. 66 INC(i);
  122. ***** ^ undeclared identifier
  123. ***** ^ not supported yet
  124. 67 c := IO.RdChar();
  125. ***** ^ not supported yet
  126. ***** ^ not supported yet
  127. ***** ^ not supported yet
  128. 68 UNTIL (c < '0') OR (c > '9');
  129. 69 END;
  130. 70 s[i] := CHAR(0);
  131. ***** ^ not supported yet
  132. ***** ^ not supported yet
  133. ***** ^ not supported yet
  134. 71 TokenNumberValue := Str.StrToReal(s, done);
  135. ***** ^ not supported yet
  136. ***** ^ not supported yet
  137. ***** ^ not supported yet
  138. ***** ^ not supported yet
  139. 72 IF NOT done THEN
  140. 73 error('Bad number?');
  141. ***** ^ not supported yet
  142. ***** ^ not supported yet
  143. 74 END;
  144. 75 token := number;
  145. ***** ^ not supported yet
  146. ***** ^ not supported yet
  147. 76 EXIT;
  148. 77 ELSE
  149. 78 error('Bad character');
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. 79 END;
  153. 80 END;
  154. 81 END readtoken;
  155. ***** ^ not supported yet
  156. 82
  157. 83 PROCEDURE read(what:SyntacticType):TreeType;
  158. 84 VAR t,t1:TreeType;
  159. ***** ^ not supported yet
  160. 85 BEGIN
  161. 86 CASE what OF
  162. ***** ^ not supported yet
  163. 87 | factor :
  164. ***** ^ not supported yet
  165. 88 IF token = LeftParen THEN
  166. ***** ^ not supported yet
  167. ***** ^ not supported yet
  168. 89 readtoken;
  169. ***** ^ not supported yet
  170. 90 t := read(exp);
  171. ***** ^ not supported yet
  172. ***** ^ not supported yet
  173. ***** ^ not supported yet
  174. 91 IF token = RightParen THEN
  175. ***** ^ not supported yet
  176. ***** ^ not supported yet
  177. 92 readtoken;
  178. ***** ^ not supported yet
  179. 93 ELSE
  180. 94 error("Missing ')'");
  181. ***** ^ not supported yet
  182. ***** ^ not supported yet
  183. 95 END;
  184. 96 ELSIF token = number THEN
  185. ***** ^ not supported yet
  186. ***** ^ not supported yet
  187. 97 Storage.ALLOCATE(t, SIZE(t^));
  188. ***** ^ not supported yet
  189. ***** ^ not supported yet
  190. ***** ^ not supported yet
  191. ***** ^ undeclared identifier
  192. ***** ^ not supported yet
  193. 98 t^.kind := number;
  194. ***** ^ not supported yet
  195. ***** ^ not supported yet
  196. ***** ^ not supported yet
  197. 99 t^.NumberValue := TokenNumberValue;
  198. ***** ^ not supported yet
  199. ***** ^ not supported yet
  200. 100 readtoken;
  201. ***** ^ not supported yet
  202. 101 ELSE
  203. 102 error('Missing number?');
  204. ***** ^ not supported yet
  205. ***** ^ not supported yet
  206. 103 END;
  207. 104 | term:
  208. ***** ^ not supported yet
  209. 105 t := read(factor);
  210. ***** ^ not supported yet
  211. ***** ^ not supported yet
  212. ***** ^ not supported yet
  213. 106 WHILE (token = mul) OR (token = div) DO
  214. ***** ^ not supported yet
  215. ***** ^ not supported yet
  216. ***** ^ not supported yet
  217. ***** ^ not supported yet
  218. 107 t1 := t;
  219. ***** ^ not supported yet
  220. ***** ^ not supported yet
  221. 108 Storage.ALLOCATE(t, SIZE(t^));
  222. ***** ^ not supported yet
  223. ***** ^ not supported yet
  224. ***** ^ not supported yet
  225. ***** ^ undeclared identifier
  226. ***** ^ not supported yet
  227. 109 t^.kind := token;
  228. ***** ^ not supported yet
  229. ***** ^ not supported yet
  230. ***** ^ not supported yet
  231. 110 readtoken;
  232. ***** ^ not supported yet
  233. 111 t^.left := t1;
  234. ***** ^ not supported yet
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. 112 t^.right := read(factor);
  238. ***** ^ not supported yet
  239. ***** ^ not supported yet
  240. ***** ^ not supported yet
  241. ***** ^ not supported yet
  242. 113 END;
  243. 114 | exp:
  244. ***** ^ not supported yet
  245. 115 t := read(term);
  246. ***** ^ not supported yet
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. 116 WHILE (token = add) OR (token = sub) DO
  250. ***** ^ not supported yet
  251. ***** ^ not supported yet
  252. ***** ^ not supported yet
  253. ***** ^ not supported yet
  254. 117 t1 := t;
  255. ***** ^ not supported yet
  256. ***** ^ not supported yet
  257. 118 Storage.ALLOCATE(t, SIZE(t^));
  258. ***** ^ not supported yet
  259. ***** ^ not supported yet
  260. ***** ^ not supported yet
  261. ***** ^ undeclared identifier
  262. ***** ^ not supported yet
  263. 119 t^.kind := token;
  264. ***** ^ not supported yet
  265. ***** ^ not supported yet
  266. ***** ^ not supported yet
  267. 120 readtoken;
  268. ***** ^ not supported yet
  269. 121 t^.left := t1;
  270. ***** ^ not supported yet
  271. ***** ^ not supported yet
  272. ***** ^ not supported yet
  273. 122 t^.right := read(term);
  274. ***** ^ not supported yet
  275. ***** ^ not supported yet
  276. ***** ^ not supported yet
  277. ***** ^ not supported yet
  278. 123 END;
  279. 124 | main :
  280. ***** ^ not supported yet
  281. 125 c := IO.RdChar();
  282. ***** ^ not supported yet
  283. ***** ^ not supported yet
  284. ***** ^ not supported yet
  285. 126 readtoken;
  286. ***** ^ not supported yet
  287. 127 t := read(exp);
  288. ***** ^ not supported yet
  289. ***** ^ not supported yet
  290. ***** ^ not supported yet
  291. 128 IF (token <> end) THEN
  292. ***** ^ not supported yet
  293. ***** ^ not supported yet
  294. 129 error('Missing operator?');
  295. ***** ^ not supported yet
  296. ***** ^ not supported yet
  297. 130 END;
  298. 131 END;
  299. 132 RETURN t;
  300. ***** ^ not supported yet
  301. 133 END read;
  302. ***** ^ not supported yet
  303. 134
  304. 135 PROCEDURE eval(t:TreeType):LONGREAL;
  305. 136 BEGIN
  306. 137 CASE t^.kind OF
  307. ***** ^ not supported yet
  308. ***** ^ not supported yet
  309. 138 | number : RETURN t^.NumberValue;
  310. ***** ^ not supported yet
  311. ***** ^ not supported yet
  312. ***** ^ not supported yet
  313. 139 | add : RETURN eval(t^.left) + eval(t^.right);
  314. ***** ^ not supported yet
  315. ***** ^ not supported yet
  316. ***** ^ not supported yet
  317. ***** ^ not supported yet
  318. ***** ^ not supported yet
  319. ***** ^ not supported yet
  320. ***** ^ not supported yet
  321. 140 | sub : RETURN eval(t^.left) - eval(t^.right);
  322. ***** ^ not supported yet
  323. ***** ^ not supported yet
  324. ***** ^ not supported yet
  325. ***** ^ not supported yet
  326. ***** ^ not supported yet
  327. ***** ^ not supported yet
  328. ***** ^ not supported yet
  329. 141 | mul : RETURN eval(t^.left) * eval(t^.right);
  330. ***** ^ not supported yet
  331. ***** ^ not supported yet
  332. ***** ^ not supported yet
  333. ***** ^ not supported yet
  334. ***** ^ not supported yet
  335. ***** ^ not supported yet
  336. ***** ^ not supported yet
  337. 142 | div : RETURN eval(t^.left) / eval(t^.right);
  338. ***** ^ not supported yet
  339. ***** ^ not supported yet
  340. ***** ^ not supported yet
  341. ***** ^ not supported yet
  342. ***** ^ not supported yet
  343. ***** ^ not supported yet
  344. ***** ^ not supported yet
  345. 143 END;
  346. 144 END eval;
  347. ***** ^ not supported yet
  348. 145
  349. 146 VAR
  350. 147 t:TreeType;
  351. ***** ^ not supported yet
  352. 148 result:LONGREAL;
  353. 149 BEGIN
  354. 150 LOOP
  355. 151 IO.WrStr('Enter expression : ');
  356. ***** ^ not supported yet
  357. ***** ^ not supported yet
  358. ***** ^ not supported yet
  359. 152 t := read(main);
  360. ***** ^ not supported yet
  361. ***** ^ not supported yet
  362. ***** ^ not supported yet
  363. 153 result := eval(t);
  364. ***** ^ not supported yet
  365. ***** ^ not supported yet
  366. 154 IO.WrStr(' = ');
  367. ***** ^ not supported yet
  368. ***** ^ not supported yet
  369. ***** ^ not supported yet
  370. 155 IO.WrLngReal(result, 4, 0);
  371. ***** ^ not supported yet
  372. ***** ^ not supported yet
  373. ***** ^ not supported yet
  374. 156 IO.WrLn;
  375. ***** ^ not supported yet
  376. ***** ^ not supported yet
  377. 157 END;
  378. 158 END prog8.
  379. 219 errors