FoxInterpreter.Mod 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466
  1. MODULE FoxInterpreter; (** AUTHOR ""; PURPOSE ""; *)
  2. IMPORT Scanner := FoxScanner, FoxParser, SyntaxTree := FoxSyntaxTree, Printout := FoxPrintout, Commands, Diagnostics, StringPool, InterpreterSymbols := FoxInterpreterSymbols, D:= Debugging,
  3. Strings, Streams, Modules, PersistentObjects, Basic := FoxBasic, SYSTEM, Machine, Global := FoxGlobal, Heaps;
  4. CONST
  5. EnableTrace = FALSE;
  6. MaxIndex = 8;
  7. TYPE
  8. Result*= InterpreterSymbols.Result;
  9. Value*=InterpreterSymbols.Value;
  10. Integer*=InterpreterSymbols.IntegerValue;
  11. Real*=InterpreterSymbols.RealValue;
  12. String*=InterpreterSymbols.StringValue;
  13. Boolean*=InterpreterSymbols.BooleanValue;
  14. Set*=InterpreterSymbols.SetValue;
  15. Range*=InterpreterSymbols.RangeValue;
  16. Char*=InterpreterSymbols.CharValue;
  17. Any*=InterpreterSymbols.AnyValue;
  18. MathArrayValue*= InterpreterSymbols.MathArrayValue;
  19. Scope*=InterpreterSymbols.Scope;
  20. Container*= InterpreterSymbols.Container;
  21. Builtin*=OBJECT (InterpreterSymbols.Object)
  22. VAR id: LONGINT;
  23. END Builtin;
  24. Item*= RECORD
  25. object*: InterpreterSymbols.Item;
  26. in*: InterpreterSymbols.Item;
  27. name*: StringPool.Index;
  28. i*: ARRAY MaxIndex OF LONGINT; (* indices if applicable *)
  29. END;
  30. CommandStatement = OBJECT (SyntaxTree.Statement)
  31. VAR command: Strings.String;
  32. PROCEDURE & InitCommandStatement(s: Strings.String);
  33. BEGIN
  34. command := s
  35. END InitCommandStatement;
  36. END CommandStatement;
  37. PrintStatement = OBJECT (SyntaxTree.Statement)
  38. VAR expression: SyntaxTree.Expression;
  39. PROCEDURE & InitPrintStatement(e: SyntaxTree.Expression);
  40. BEGIN
  41. expression := e;
  42. END InitPrintStatement;
  43. END PrintStatement;
  44. Parser*= OBJECT(FoxParser.Parser)
  45. PROCEDURE Statement*(statements: SyntaxTree.StatementSequence; outer: SyntaxTree.Statement): BOOLEAN;
  46. VAR statement: SyntaxTree.Statement;
  47. BEGIN
  48. IF (Symbol() = Scanner.ExclamationMark) THEN
  49. statement := Cmd();
  50. IF statement # NIL THEN
  51. statements.AddStatement(statement);
  52. END;
  53. RETURN TRUE
  54. ELSIF (Symbol() = Scanner.Questionmark) THEN
  55. statement := Print();
  56. IF statement # NIL THEN
  57. statements.AddStatement(statement);
  58. END;
  59. RETURN TRUE
  60. ELSE
  61. RETURN Statement^(statements, outer);
  62. END;
  63. END Statement;
  64. PROCEDURE Cmd(): SyntaxTree.Statement;
  65. VAR cmd: CommandStatement; string: Strings.String;
  66. BEGIN
  67. NextToken;
  68. IF MandatoryString(string) THEN
  69. NEW(cmd, string);
  70. (* TRACE(string^) *)
  71. END;
  72. RETURN cmd;
  73. END Cmd;
  74. PROCEDURE Print(): SyntaxTree.Statement;
  75. VAR print: PrintStatement;
  76. BEGIN
  77. NextToken;
  78. NEW(print, Expression());
  79. RETURN print;
  80. END Print;
  81. END Parser;
  82. Interpreter* = OBJECT (SyntaxTree.Visitor)
  83. VAR
  84. value: BOOLEAN;
  85. item-: Item;
  86. module-: Modules.Module;
  87. typeDesc-: Modules.TypeDesc;
  88. scope-: Scope;
  89. exit: BOOLEAN;
  90. error-: BOOLEAN;
  91. diagnostics: Diagnostics.Diagnostics;
  92. context-: Commands.Context;
  93. PROCEDURE & Init*(scope: Scope; diagnostics: Diagnostics.Diagnostics; context: Commands.Context);
  94. BEGIN
  95. IF scope = NIL THEN scope := global END;
  96. SELF.scope := scope;
  97. error := FALSE;
  98. SELF.diagnostics := diagnostics;
  99. SELF.context := context;
  100. END Init;
  101. PROCEDURE SetScope*(s: Scope);
  102. BEGIN
  103. scope := s
  104. END SetScope;
  105. PROCEDURE Reset*;
  106. BEGIN
  107. error := FALSE;
  108. END Reset;
  109. PROCEDURE Error(CONST msg: ARRAY OF CHAR);
  110. BEGIN
  111. IF error THEN RETURN END;
  112. (*! use diagnostics *)
  113. error := TRUE;
  114. Basic.Error(diagnostics, "", Basic.invalidPosition, msg);
  115. D.TraceBack;
  116. END Error;
  117. PROCEDURE ErrorSS(CONST msg: ARRAY OF CHAR; id: StringPool.Index);
  118. VAR name: ARRAY 128 OF CHAR; message: ARRAY 256 OF CHAR;
  119. BEGIN
  120. IF error THEN RETURN END;
  121. (*! use diagnostics *)
  122. error := TRUE;
  123. COPY(msg, message);
  124. IF id # 0 THEN Strings.Append(message," "); StringPool.GetString(id, name); Strings.Append(message, name); END;
  125. Basic.Error(diagnostics, "", Basic.invalidPosition, message);
  126. END ErrorSS;
  127. (** syntax tree types omitted -- unused *)
  128. (** expressions *)
  129. PROCEDURE VisitSet*(x: SyntaxTree.Set);
  130. VAR s: SET; i: LONGINT; value: Value;
  131. BEGIN
  132. FOR i := 0 TO x.elements.Length()-1 DO
  133. IF GetValue(x.elements.GetExpression(i), value) THEN
  134. IF value IS Integer THEN INCL(s, LONGINT(value(Integer).value))
  135. ELSIF value IS Range THEN s := s + {FIRST(value(Range).value)..LAST(value(Range).value)}
  136. ELSE Error("wrong value type")
  137. END;
  138. END;
  139. END;
  140. NewSet(s)
  141. END VisitSet;
  142. PROCEDURE VisitMathArrayExpression*(x: SyntaxTree.MathArrayExpression);
  143. VAR numberElements, i: LONGINT; a: MathArrayValue;
  144. BEGIN
  145. numberElements := x.elements.Length();
  146. NEW(a, numberElements);
  147. FOR i := 0 TO numberElements-1 DO
  148. Expression(x.elements.GetExpression(i));
  149. a.SetValue(i,item.object(Value));
  150. END;
  151. item.object := a; value := TRUE;
  152. END VisitMathArrayExpression;
  153. PROCEDURE NewInt(i: HUGEINT);
  154. VAR v: Integer;
  155. BEGIN
  156. NEW(v, i); item.object := v; value := TRUE
  157. END NewInt;
  158. PROCEDURE NewReal(i: LONGREAL);
  159. VAR v: Real;
  160. BEGIN
  161. NEW(v, i); item.object := v; value := TRUE
  162. END NewReal;
  163. PROCEDURE NewBool(b: BOOLEAN);
  164. VAR v: Boolean;
  165. BEGIN
  166. NEW(v, b); item.object := v; value := TRUE;
  167. END NewBool;
  168. PROCEDURE NewSet(s: SET);
  169. VAR v: Set;
  170. BEGIN
  171. NEW(v, s); item.object := v; value := TRUE;
  172. END NewSet;
  173. PROCEDURE NewString(CONST s: ARRAY OF CHAR);
  174. VAR v: String;
  175. BEGIN
  176. NEW(v, s); item.object := v; value := TRUE;
  177. END NewString;
  178. PROCEDURE NewRange(r: RANGE);
  179. VAR v: Range;
  180. BEGIN
  181. NEW(v, r ); item.object := v; value := TRUE;
  182. END NewRange;
  183. PROCEDURE NewChar(c: CHAR);
  184. VAR v: Char;
  185. BEGIN
  186. NEW(v, c); item.object := v; value := TRUE;
  187. END NewChar;
  188. PROCEDURE VisitUnaryExpression*(x: SyntaxTree.UnaryExpression);
  189. VAR value: Value; i: HUGEINT; r: LONGREAL; b: BOOLEAN; operator: LONGINT;
  190. BEGIN
  191. operator := x.operator;
  192. IF ~GetValue(x.left, value) THEN
  193. Error("no operand");
  194. RETURN
  195. END;
  196. IF value IS Integer THEN
  197. i := value(Integer).value;
  198. CASE operator OF
  199. Scanner.Minus: NewInt(-i)
  200. |Scanner.Plus: NewInt(i)
  201. ELSE Error("unary operator not supported")
  202. END;
  203. ELSIF value IS Real THEN
  204. r := value(Real).value;
  205. CASE operator OF
  206. Scanner.Minus: NewReal(-r)
  207. |Scanner.Plus: NewReal(r)
  208. ELSE Error("unary operator not supported")
  209. END;
  210. ELSIF value IS Boolean THEN
  211. b := value(Boolean).value;
  212. CASE operator OF
  213. Scanner.Not: NewBool(~b)
  214. ELSE Error("unary operator not supported")
  215. END;
  216. ELSIF value IS Set THEN
  217. CASE operator OF
  218. Scanner.Minus: NewSet(-value(Set).value)
  219. ELSE Error("unary operator not supported")
  220. END;
  221. ELSE
  222. Error("unary operation not supported");
  223. END;
  224. END VisitUnaryExpression;
  225. PROCEDURE VisitBinaryExpression*(x: SyntaxTree.BinaryExpression);
  226. VAR left, right: Value; operator: LONGINT; li, ri: HUGEINT; lr, rr: LONGREAL; lb, rb: BOOLEAN; sl, sr: SET;
  227. BEGIN
  228. operator := x.operator;
  229. IF ~GetValue(x.left, left) OR ~GetValue(x.right, right) THEN RETURN END;
  230. IF (left IS Integer) & (right IS Integer) THEN
  231. li := left(Integer).value; ri := right(Integer).value;
  232. CASE operator OF
  233. |Scanner.Plus: NewInt(li+ri)
  234. |Scanner.Minus: NewInt(li-ri);
  235. |Scanner.Times: NewInt(li * ri);
  236. |Scanner.Div: NewInt(li DIV ri);
  237. |Scanner.Mod: NewInt(li MOD ri);
  238. |Scanner.Equal: NewBool(li = ri);
  239. |Scanner.Unequal: NewBool(li # ri)
  240. |Scanner.Less: NewBool(li < ri)
  241. |Scanner.LessEqual: NewBool(li <= ri)
  242. |Scanner.Greater: NewBool(li > ri)
  243. |Scanner.GreaterEqual: NewBool(li >= ri)
  244. |Scanner.Slash: NewReal(li/ri)
  245. ELSE Error("binary operator not supported")
  246. END;
  247. ELSIF ((left IS Integer) OR (left IS Real)) & ((right IS Integer) OR (right IS Real)) THEN
  248. IF left IS Integer THEN lr := left(Integer).value
  249. ELSE lr := left(Real).value
  250. END;
  251. IF right IS Integer THEN rr := right(Integer).value;
  252. ELSE rr := right(Real).value
  253. END;
  254. CASE operator OF
  255. |Scanner.Plus: NewReal(lr+rr)
  256. |Scanner.Minus: NewReal(lr-rr);
  257. |Scanner.Times: NewReal(lr * rr);
  258. |Scanner.Slash: NewReal(lr / rr);
  259. |Scanner.Equal: NewBool(lr = rr);
  260. |Scanner.Unequal: NewBool(lr # rr)
  261. |Scanner.Less: NewBool(lr < rr)
  262. |Scanner.LessEqual: NewBool(lr <= rr)
  263. |Scanner.Greater: NewBool(lr > rr)
  264. |Scanner.GreaterEqual: NewBool(lr >= rr)
  265. ELSE Error("binary operator not supported")
  266. END;
  267. ELSIF (left IS Boolean) & (right IS Boolean) THEN
  268. lb := left(Boolean).value; rb := right(Boolean).value;
  269. CASE operator OF
  270. |Scanner.Or: NewBool(lb OR rb);
  271. |Scanner.And: NewBool(lb & rb);
  272. |Scanner.Equal: NewBool(lb = rb)
  273. |Scanner.Unequal: NewBool(lb # rb)
  274. ELSE Error("operator not supported")
  275. END;
  276. ELSIF (left IS String) & (right IS String) THEN
  277. CASE operator OF
  278. |Scanner.Equal: NewBool(left(String).value^ = right(String).value^);
  279. |Scanner.Unequal: NewBool(left(String).value^ = right(String).value^);
  280. |Scanner.Less: NewBool(left(String).value^ < right(String).value^);
  281. |Scanner.LessEqual: NewBool(left(String).value^ <= right(String).value^);
  282. |Scanner.Greater: NewBool(left(String).value^ > right(String).value^);
  283. |Scanner.GreaterEqual: NewBool(left(String).value^ >= right(String).value^);
  284. ELSE Error("binary operator not supported")
  285. END
  286. ELSIF (left IS Set) & (right IS Set) THEN
  287. sl := left(Set).value; sr := right(Set).value;
  288. CASE operator OF
  289. |Scanner.Plus: NewSet(sl+sr)
  290. |Scanner.Minus: NewSet(sl-sr);
  291. |Scanner.Times: NewSet(sl * sr);
  292. |Scanner.Slash: NewSet(sl / sr);
  293. |Scanner.Equal: NewBool(sl = sr);
  294. |Scanner.Unequal: NewBool(sl # sr)
  295. |Scanner.Less: NewBool(sl < sr)
  296. |Scanner.LessEqual: NewBool(sl <= sr)
  297. |Scanner.Greater: NewBool(sl > sr)
  298. |Scanner.GreaterEqual: NewBool(sl >= sr)
  299. ELSE Error("binary operator not supported")
  300. END;
  301. ELSIF (left IS Integer) & (right IS Set) THEN
  302. CASE operator OF
  303. Scanner.In: NewBool(left(Integer).value IN right(Set).value)
  304. ELSE Error("binary operator not supported")
  305. END;
  306. ELSE
  307. Error("binary operation not supported");
  308. Printout.Info("binary operation", x);
  309. END;
  310. END VisitBinaryExpression;
  311. PROCEDURE VisitRangeExpression*(x: SyntaxTree.RangeExpression);
  312. VAR first,last,step: HUGEINT; value: Integer;
  313. BEGIN
  314. IF ~ExpectInteger(x.first, value) THEN RETURN END;
  315. first := value.value;
  316. IF ~ExpectInteger(x.last, value) THEN RETURN END;
  317. last := value.value;
  318. IF (x.step # NIL) & ExpectInteger(x.step, value) THEN
  319. step := value.value;
  320. ELSE
  321. step := 1
  322. END;
  323. NewRange(first ..last BY step);
  324. END VisitRangeExpression;
  325. PROCEDURE VisitTensorRangeExpression*(x: SyntaxTree.TensorRangeExpression);
  326. BEGIN HALT(100) (* abstract *) END VisitTensorRangeExpression;
  327. PROCEDURE VisitConversion*(x: SyntaxTree.Conversion);
  328. BEGIN HALT(100) (* abstract *) END VisitConversion;
  329. (** designators (expressions) *)
  330. PROCEDURE VisitDesignator*(x: SyntaxTree.Designator);
  331. BEGIN HALT(100) (* abstract *) END VisitDesignator;
  332. PROCEDURE VisitQualifiedType*(x: SyntaxTree.QualifiedType);
  333. VAR moduleName, name: Modules.Name;
  334. BEGIN
  335. IF x.qualifiedIdentifier.prefix # SyntaxTree.invalidIdentifier THEN
  336. item.name := x.qualifiedIdentifier.prefix;
  337. item.object := scope.FindObject1(item.name, -1, item.in);
  338. IF item.object = NIL THEN
  339. StringPool.GetString(item.name, moduleName);
  340. item.object :=InterpreterSymbols.GetModule(moduleName);
  341. END;
  342. END;
  343. item.name := x.qualifiedIdentifier.suffix;
  344. IF (item.object # NIL) THEN
  345. IF item.object IS Result THEN
  346. StringPool.GetString(item.name, name);
  347. item.object := item.object(Result).Find(name);
  348. ELSE
  349. item.in := item.object;
  350. item.object := InterpreterSymbols.FindInObject1(item.object, item.name,-1);
  351. END;
  352. ELSE
  353. ErrorSS("invalid selector",item.name);
  354. item.in := NIL;
  355. END;
  356. END VisitQualifiedType;
  357. (*
  358. PROCEDURE FindInScope(scope: Scope; symbol: StringPool.Index): Value;
  359. VAR item: Value;
  360. BEGIN
  361. REPEAT
  362. item := scope.Find1(symbol);
  363. IF (item = NIL) THEN
  364. scope := scope.outer
  365. ELSE
  366. scope := NIL
  367. END;
  368. UNTIL (scope = NIL);
  369. RETURN item
  370. END FindInScope;
  371. *)
  372. (*
  373. PROCEDURE FindType(CONST types: POINTER TO ARRAY OF Modules.TypeDesc; CONST name: ARRAY OF CHAR): Modules.TypeDesc;
  374. VAR i: LONGINT;
  375. BEGIN
  376. IF types = NIL THEN RETURN NIL END;
  377. FOR i := 0 TO LEN(types)-1 DO
  378. IF types[i].name = name THEN
  379. RETURN types[i];
  380. END;
  381. END;
  382. RETURN NIL;
  383. END FindType;
  384. PROCEDURE FindProc(CONST types: POINTER TO ARRAY OF Modules.ProcedureEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
  385. BEGIN
  386. IF types = NIL THEN RETURN FALSE END;
  387. FOR num := 0 TO LEN(types)-1 DO
  388. IF types[num].name^ = name THEN
  389. RETURN TRUE;
  390. END;
  391. END;
  392. RETURN FALSE;
  393. END FindProc;
  394. PROCEDURE FindField(CONST types: POINTER TO ARRAY OF Modules.FieldEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
  395. BEGIN
  396. IF types = NIL THEN RETURN FALSE END;
  397. FOR num := 0 TO LEN(types)-1 DO
  398. IF types[num].name^ = name THEN
  399. RETURN TRUE;
  400. END;
  401. END;
  402. RETURN FALSE;
  403. END FindField;
  404. *)
  405. PROCEDURE VisitIdentifierDesignator*(x: SyntaxTree.IdentifierDesignator);
  406. VAR moduleName: Modules.Name; msg: ARRAY 128 OF CHAR; res: WORD;
  407. builtin : Builtin; anyValue: Any;
  408. BEGIN
  409. ASSERT(x.left = NIL);
  410. item.name := x.identifier;
  411. (*
  412. item.object := FindInScope(item.scope, item.name);
  413. *)
  414. IF item.name = Basic.MakeString("trace") THEN
  415. NEW(builtin); builtin.id := Global.systemTrace;
  416. item.object := builtin;
  417. ELSIF item.name = Basic.MakeString("context") THEN
  418. NEW(anyValue, context);
  419. item.object := anyValue;
  420. ELSE
  421. item.object := scope.FindObject1(item.name, -1, item.in);
  422. IF item.object = NIL THEN
  423. StringPool.GetString(item.name, moduleName);
  424. item.object :=InterpreterSymbols.GetModule(moduleName);
  425. END;
  426. END;
  427. END VisitIdentifierDesignator;
  428. PROCEDURE VisitSelectorDesignator*(x: SyntaxTree.SelectorDesignator);
  429. VAR traverse: BOOLEAN; name: ARRAY 128 OF CHAR; num: LONGINT;
  430. BEGIN
  431. Expression(x.left); traverse := FALSE;
  432. IF error THEN RETURN END;
  433. item.name := x.identifier;
  434. IF (item.object # NIL) THEN
  435. IF item.object IS Result THEN
  436. StringPool.GetString(item.name, name);
  437. item.object := item.object(Result).Find(name);
  438. ELSE
  439. item.in := item.object;
  440. item.object := InterpreterSymbols.FindInObject1(item.object, x.identifier,-1);
  441. END;
  442. ELSE
  443. ErrorSS("invalid selector",item.name);
  444. item.in := NIL;
  445. END;
  446. END VisitSelectorDesignator;
  447. PROCEDURE VisitParameterDesignator*(x: SyntaxTree.ParameterDesignator);
  448. VAR e: SyntaxTree.Expression; proc: InterpreterSymbols.ProcedureResult; i: LONGINT;
  449. adr: ADDRESS; adrValue: Value; any: InterpreterSymbols.AnyValue;
  450. BEGIN
  451. e := x.left;
  452. Expression(e);
  453. IF (item.object # NIL) THEN
  454. IF (item.object IS InterpreterSymbols.ProcedureResult) THEN
  455. proc := item.object(InterpreterSymbols.ProcedureResult);
  456. (* self pointer *)
  457. proc.Pars();
  458. IF ~(proc.caller IS InterpreterSymbols.ModuleResult) THEN
  459. adrValue := proc.caller.Evaluate();
  460. ASSERT(adrValue.GetAddress(adr));
  461. proc.PushAddress(adr);
  462. END;
  463. (* result pointer *)
  464. IF proc.ReturnsPointer() THEN
  465. NEW(any,NIL);
  466. proc.PushAddress(any.Address());
  467. END;
  468. FOR i := 0 TO x.parameters.Length()-1 DO
  469. e := x.parameters.GetExpression(i);
  470. IF ~proc.Push(Designate(e)) THEN Error("wrong parameter"); RETURN END;
  471. END;
  472. IF ~proc.Check() THEN Error("non-matching parameter number"); RETURN END;
  473. item.object := proc.Evaluate();
  474. IF any # NIL THEN item.object := any END;
  475. ELSIF (item.object IS Builtin) THEN
  476. CASE item.object(Builtin).id OF
  477. Global.systemTrace:
  478. SystemTrace(x.parameters);
  479. ELSE
  480. Error("no builtin?")
  481. END;
  482. ELSE
  483. Error("no procedure")
  484. END;
  485. ELSE
  486. Error("no procedure")
  487. END;
  488. END VisitParameterDesignator;
  489. PROCEDURE VisitArrowDesignator*(x: SyntaxTree.ArrowDesignator);
  490. BEGIN HALT(100) (* abstract *) END VisitArrowDesignator;
  491. PROCEDURE VisitBracketDesignator*(x: SyntaxTree.BracketDesignator);
  492. VAR array: MathArrayValue; i: LONGINT; element: Value; index: Integer; obj: PersistentObjects.Object;
  493. leftValue, rightValue: Value; filter: InterpreterSymbols.ObjectFilter; expression: SyntaxTree.Expression;
  494. attribute, value: ARRAY 128 OF CHAR; val: LONGINT;
  495. BEGIN
  496. Expression(x.left);
  497. IF (item.object # NIL) & (item.object IS MathArrayValue) THEN
  498. element := item.object(MathArrayValue);
  499. FOR i := 0 TO x.parameters.Length()-1 DO
  500. array := element(MathArrayValue);
  501. IF GetInteger(x.parameters.GetExpression(i), index) THEN
  502. element := array.GetValue(LONGINT(index.value));
  503. END;
  504. END;
  505. item.object := element;
  506. ELSIF (item.object # NIL) THEN
  507. NEW(filter); obj := item.object;
  508. FOR i := 0 TO x.parameters.Length()-1 DO
  509. expression := x.parameters.GetExpression(i);
  510. IF (expression IS SyntaxTree.BinaryExpression) & (expression(SyntaxTree.BinaryExpression).operator = Scanner.Equal) THEN
  511. IF (expression(SyntaxTree.BinaryExpression).left IS SyntaxTree.IdentifierDesignator) &
  512. GetValue(expression(SyntaxTree.BinaryExpression).right, rightValue) THEN
  513. StringPool.GetString(
  514. expression(SyntaxTree.BinaryExpression).left(SyntaxTree.IdentifierDesignator).identifier, attribute);
  515. rightValue(Value).GetString(value);
  516. obj := filter.Filter(obj, attribute, value)
  517. ELSE HALT(200)
  518. END;
  519. ELSE
  520. IF GetValue(expression, leftValue) THEN
  521. IF leftValue IS String THEN
  522. leftValue(Value).GetString(value);
  523. obj := filter.Filter(obj, "name", value);
  524. ELSIF leftValue IS Integer THEN
  525. IF obj IS PersistentObjects.ObjectList THEN
  526. item.object := obj(PersistentObjects.ObjectList).GetElement(LONGINT(leftValue(Integer).value))
  527. ELSIF obj IS Container THEN
  528. item.object := obj(Container).GetItem(LONGINT(leftValue(Integer).value))
  529. ELSE Error("cannot be indexed")
  530. END;
  531. END;
  532. END;
  533. END;
  534. END;
  535. IF obj(Container).symbols.Length() > 0 THEN
  536. item.object := obj(Container).GetItem(0);
  537. ELSE
  538. Error("no such symbol")
  539. END;
  540. END;
  541. END VisitBracketDesignator;
  542. PROCEDURE VisitSymbolDesignator*(x: SyntaxTree.SymbolDesignator);
  543. BEGIN HALT(100) (* abstract *) END VisitSymbolDesignator;
  544. PROCEDURE VisitIndexDesignator*(x: SyntaxTree.IndexDesignator);
  545. BEGIN HALT(100) (* abstract *) END VisitIndexDesignator;
  546. PROCEDURE VisitProcedureCallDesignator*(x: SyntaxTree.ProcedureCallDesignator);
  547. BEGIN HALT(100)
  548. END VisitProcedureCallDesignator;
  549. PROCEDURE SystemTrace(x: SyntaxTree.ExpressionList);
  550. VAR
  551. printout: Printout.Printer;
  552. value: Value;
  553. expression: SyntaxTree.Expression;
  554. i: LONGINT;
  555. out: Streams.Writer;
  556. BEGIN
  557. out := context.out;
  558. printout := Printout.NewPrinter(out,Printout.SourceCode,FALSE);
  559. FOR i := 0 TO x.Length()-1 DO
  560. expression := x.GetExpression(i);
  561. IF ~(expression IS SyntaxTree.StringValue) THEN
  562. printout.Expression(expression);
  563. out.String("= ");
  564. END;
  565. value := Evaluate(expression);
  566. IF value # NIL THEN
  567. value.WriteValue(out);
  568. ELSE
  569. out.String("UNKNOWN")
  570. END;
  571. out.String("; ");
  572. END;
  573. out.Ln;
  574. out.Update;
  575. END SystemTrace;
  576. PROCEDURE FindType(type: SyntaxTree.Type): Result;
  577. BEGIN
  578. VType(type);
  579. IF item.object # NIL THEN
  580. RETURN item.object(Result);
  581. END;
  582. RETURN NIL;
  583. END FindType;
  584. PROCEDURE VisitBuiltinCallDesignator*(x: SyntaxTree.BuiltinCallDesignator);
  585. VAR p,p0,p1,p2: SyntaxTree.Expression;
  586. type,t0,t1,t2: SyntaxTree.Type;
  587. len: LONGINT;
  588. i: LONGINT;
  589. parameter: SyntaxTree.Parameter;
  590. name: Basic.SectionName;
  591. modifier: SyntaxTree.Modifier;
  592. position: SyntaxTree.Position;
  593. value: Value;
  594. result: Result;
  595. address: ADDRESS;
  596. o: ANY;
  597. anyValue: InterpreterSymbols.AnyValue;
  598. proc: InterpreterSymbols.ProcedureResult;
  599. ignore: Result;
  600. e: SyntaxTree.Expression;
  601. BEGIN
  602. position := x.position;
  603. p0 := NIL; p1 := NIL; p2 := NIL;
  604. IF x.parameters # NIL THEN
  605. len := x.parameters.Length();
  606. ELSE
  607. len := 0
  608. END;
  609. CASE x.id OF
  610. (* ----- NEW -----*)
  611. Global.New:
  612. result := FindType(x.returnType);
  613. IF (result # NIL) & (result IS InterpreterSymbols.TypeResult) THEN
  614. address := result.Address();
  615. Heaps.NewRec(o, address, FALSE);
  616. NEW(anyValue, o);
  617. proc := result(InterpreterSymbols.TypeResult).Constructor();
  618. IF proc # NIL THEN
  619. proc.Pars();
  620. proc.PushAddress(o);
  621. FOR i := 0 TO x.parameters.Length()-1 DO
  622. e := x.parameters.GetExpression(i);
  623. IF ~proc.Push(Designate(e)) THEN Error("wrong parameter"); item.object := NIL; RETURN END;
  624. END;
  625. IF ~proc.Check() THEN Error("non-matching parameter number"); item.object := NIL; RETURN END;
  626. ignore := proc.Evaluate();
  627. END;
  628. item.object := anyValue;
  629. ELSE
  630. Error("No Type");
  631. END;
  632. |Global.systemTrace:
  633. SystemTrace(x.parameters);
  634. ELSE (* function not yet implemented *)
  635. Error("Not Yet Implemented");
  636. END;
  637. END VisitBuiltinCallDesignator;
  638. PROCEDURE VisitTypeGuardDesignator*(x: SyntaxTree.TypeGuardDesignator);
  639. BEGIN HALT(100) (* abstract *) END VisitTypeGuardDesignator;
  640. PROCEDURE VisitDereferenceDesignator*(x: SyntaxTree.DereferenceDesignator);
  641. BEGIN HALT(100) (* abstract *) END VisitDereferenceDesignator;
  642. PROCEDURE VisitSupercallDesignator*(x: SyntaxTree.SupercallDesignator);
  643. BEGIN HALT(100) (* abstract *) END VisitSupercallDesignator;
  644. PROCEDURE VisitSelfDesignator*(x: SyntaxTree.SelfDesignator);
  645. BEGIN HALT(100) (* abstract *) END VisitSelfDesignator;
  646. PROCEDURE VisitResultDesignator*(x: SyntaxTree.ResultDesignator);
  647. BEGIN HALT(100) (* abstract *) END VisitResultDesignator;
  648. (** values *)
  649. PROCEDURE VisitValue*(x: SyntaxTree.Value);
  650. BEGIN HALT(100) (* abstract *) END VisitValue;
  651. PROCEDURE VisitBooleanValue*(x: SyntaxTree.BooleanValue);
  652. BEGIN
  653. NewBool(x.value)
  654. END VisitBooleanValue;
  655. PROCEDURE VisitIntegerValue*(x: SyntaxTree.IntegerValue);
  656. BEGIN
  657. NewInt(x.value)
  658. END VisitIntegerValue;
  659. PROCEDURE VisitCharacterValue*(x: SyntaxTree.CharacterValue);
  660. BEGIN
  661. NewChar(x.value);
  662. END VisitCharacterValue;
  663. PROCEDURE VisitSetValue*(x: SyntaxTree.SetValue);
  664. BEGIN
  665. NewSet(SET(x.value))
  666. END VisitSetValue;
  667. PROCEDURE VisitMathArrayValue*(x: SyntaxTree.MathArrayValue);
  668. BEGIN HALT(100) (* abstract *) END VisitMathArrayValue;
  669. PROCEDURE VisitRealValue*(x: SyntaxTree.RealValue);
  670. BEGIN
  671. NewReal(x.value)
  672. END VisitRealValue;
  673. PROCEDURE VisitComplexValue*(x: SyntaxTree.ComplexValue);
  674. BEGIN HALT(100) (* abstract *) END VisitComplexValue;
  675. PROCEDURE VisitStringValue*(x: SyntaxTree.StringValue);
  676. BEGIN
  677. NewString(x.value^);
  678. END VisitStringValue;
  679. PROCEDURE VisitNilValue*(x: SyntaxTree.NilValue);
  680. BEGIN HALT(100) (* abstract *) END VisitNilValue;
  681. PROCEDURE VisitEnumerationValue*(x: SyntaxTree.EnumerationValue);
  682. BEGIN HALT(100) (* abstract *) END VisitEnumerationValue;
  683. (** symbols *)
  684. PROCEDURE VisitSymbol*(x: SyntaxTree.Symbol);
  685. BEGIN HALT(100) (* abstract *) END VisitSymbol;
  686. PROCEDURE VisitTypeDeclaration*(x: SyntaxTree.TypeDeclaration);
  687. BEGIN HALT(100) (* abstract *) END VisitTypeDeclaration;
  688. PROCEDURE VisitConstant*(x: SyntaxTree.Constant);
  689. BEGIN HALT(100) (* abstract *) END VisitConstant;
  690. PROCEDURE VisitVariable*(x: SyntaxTree.Variable);
  691. BEGIN HALT(100) (* abstract *) END VisitVariable;
  692. PROCEDURE VisitParameter*(x: SyntaxTree.Parameter);
  693. BEGIN HALT(100) (* abstract *) END VisitParameter;
  694. PROCEDURE VisitProcedure*(x: SyntaxTree.Procedure);
  695. BEGIN HALT(100) (* abstract *) END VisitProcedure;
  696. PROCEDURE VisitBuiltin*(x: SyntaxTree.Builtin);
  697. BEGIN HALT(100) (* abstract *) END VisitBuiltin;
  698. PROCEDURE VisitOperator*(x: SyntaxTree.Operator);
  699. BEGIN HALT(100) (* abstract *) END VisitOperator;
  700. PROCEDURE VisitImport*(x: SyntaxTree.Import);
  701. BEGIN HALT(100) (* abstract *) END VisitImport;
  702. (* copy src to value string replacing substrings that are embraced between refSymbols by expression value *)
  703. PROCEDURE TranslateString*(cmd: CHAR; CONST str: ARRAY OF CHAR; VAR dest: Strings.String): BOOLEAN;
  704. CONST
  705. LeftDelimiter = '{'; RightDelimiter = '}';
  706. VAR
  707. position : LONGINT; ch: CHAR;
  708. destination, expMaker: Scanner.StringMaker; destinationWriter, expressionWriter: Streams.Writer; scanner: Scanner.Scanner; parser: Parser;
  709. expression: SyntaxTree.Expression; value: Value; len: LONGINT;
  710. comment: LONGINT;
  711. PROCEDURE Next(VAR ch: CHAR);
  712. BEGIN
  713. IF position = LEN(str) THEN ch := 0X ELSE ch := str[position]; INC(position) END;
  714. END Next;
  715. PROCEDURE EvaluateExpression();
  716. VAR str: Strings.String; reader: Streams.Reader; done: BOOLEAN;
  717. BEGIN
  718. reader := expMaker.GetReader();
  719. scanner := Scanner.NewScanner("", reader, 0, NIL);
  720. NEW(parser, scanner, NIL, "");
  721. REPEAT
  722. error := FALSE;
  723. expression := parser.Expression();
  724. done := GetValue(expression, value);
  725. UNTIL done OR ~parser.Optional(Scanner.Colon);
  726. IF done THEN value(Value).WriteValue(destinationWriter);
  727. ELSE
  728. destinationWriter.String("#COULD NOT INTERPRETE#");
  729. error := TRUE;
  730. END;
  731. END EvaluateExpression;
  732. BEGIN
  733. error := FALSE;
  734. position := 0;
  735. Next(ch);
  736. NEW(destination,256); destinationWriter := destination.GetWriter();
  737. NEW(expMaker, 256); expressionWriter := expMaker.GetWriter();
  738. comment := 0;
  739. WHILE (ch # 0X) DO
  740. (* copy string literally *)
  741. IF (comment = 0) & (ch = cmd) THEN
  742. Next(ch);
  743. IF ch = LeftDelimiter THEN
  744. Next(ch);
  745. REPEAT
  746. WHILE (ch # 0X) & (ch # RightDelimiter) DO expressionWriter.Char(ch); Next(ch) END;
  747. IF ch = RightDelimiter THEN
  748. Next(ch); IF (ch # cmd) THEN expressionWriter.Char(RightDelimiter) END;
  749. END;
  750. UNTIL (ch=0X) OR (ch = cmd);
  751. IF ch # 0X THEN Next(ch) END;
  752. expressionWriter.Update;
  753. EvaluateExpression();
  754. expMaker.Clear;
  755. ELSE
  756. destinationWriter.Char(cmd);
  757. END;
  758. (* remove comments *)
  759. ELSIF ch = "(" THEN
  760. Next(ch);
  761. IF ch = "*" THEN
  762. INC(comment); Next(ch);
  763. ELSIF comment = 0 THEN
  764. destinationWriter.Char("(");
  765. END;
  766. ELSIF ch="*" THEN
  767. Next(ch);
  768. IF ch = ")" THEN
  769. DEC(comment);
  770. IF comment < 0 THEN comment := 0 END; Next(ch);
  771. ELSIF comment = 0 THEN
  772. destinationWriter.Char("*")
  773. END;
  774. ELSE
  775. IF comment = 0 THEN destinationWriter.Char(ch) END;
  776. Next(ch);
  777. END;
  778. END;
  779. destinationWriter.Update;
  780. dest := destination.GetString(len);
  781. RETURN ~error
  782. END TranslateString;
  783. PROCEDURE VisitCommandStatement(x: CommandStatement);
  784. VAR t: Strings.String; res: WORD; msg: ARRAY 128 OF CHAR; i: LONGINT; array: Strings.StringArray; pos: LONGINT;
  785. command: ARRAY 256 OF CHAR; context: Commands.Context;
  786. PROCEDURE CreateContext(paramString : Strings.String; pos: LONGINT) : Commands.Context;
  787. VAR c : Commands.Context; arg : Streams.StringReader; dummy : ARRAY 1 OF CHAR; len: LONGINT;
  788. BEGIN
  789. IF (paramString = NIL) THEN
  790. NEW(arg, 1); dummy := ""; arg.SetRaw(dummy, 0, 1);
  791. ELSE
  792. len := Strings.Length(paramString^)+1 (*+1 to include 0X *);
  793. NEW(arg, len-pos); arg.SetRaw(paramString^, pos, len-pos);
  794. END;
  795. NEW(c, context.in, arg, context.out, context.error, context.caller);
  796. RETURN c;
  797. END CreateContext;
  798. PROCEDURE IsDelimiter(ch : CHAR) : BOOLEAN;
  799. CONST CR = 0DX; LF = 0AX; TAB = 9X;
  800. BEGIN
  801. RETURN (ch = " ") OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (ch = ";") OR (ch = 0X);
  802. END IsDelimiter;
  803. BEGIN
  804. IF SELF.context = NIL THEN
  805. context := Commands.GetContext();
  806. ELSE
  807. context := SELF.context
  808. END;
  809. IF TranslateString("?", x.command^, t) THEN END;
  810. array := Strings.Split(t^, "~");
  811. FOR i := 0 TO LEN(array)-1 DO
  812. Strings.TrimWS(array[i]^);
  813. IF (array[i]^ # "") THEN
  814. (* extract command *)
  815. pos := 0;
  816. WHILE ~IsDelimiter(array[i][pos]) DO command[pos] := array[i][pos]; INC(pos); END;
  817. command[pos] := 0X;
  818. IF pos # 0 THEN
  819. context := CreateContext(array[i], pos);
  820. Commands.Activate(command, context, {Commands.Wait, Commands.InheritContext}, res, msg);
  821. IF res # 0 THEN
  822. context.out.String("Interpreter: "); context.error.String(command); context.error.String(" failed"); context.error.Ln
  823. END;
  824. END;
  825. END;
  826. END;
  827. IF res # 0 THEN Error(msg) END;
  828. END VisitCommandStatement;
  829. PROCEDURE VisitPrintStatement(x: PrintStatement);
  830. VAR out: Streams.Writer; printout: Printout.Printer; expression: SyntaxTree.Expression; value: Value;
  831. BEGIN
  832. out := context.out;
  833. printout := Printout.NewPrinter(out,Printout.SourceCode,FALSE);
  834. expression := x.expression;
  835. IF ~(expression IS SyntaxTree.StringValue) THEN
  836. printout.Expression(expression);
  837. out.String("= ");
  838. END;
  839. value := Evaluate(expression);
  840. IF value # NIL THEN
  841. value.WriteValue(out);
  842. ELSE
  843. out.String("UNKNOWN")
  844. END;
  845. out.String("; ");
  846. out.Ln;
  847. out.Update;
  848. END VisitPrintStatement;
  849. (** statements *)
  850. PROCEDURE VisitStatement*(x: SyntaxTree.Statement);
  851. BEGIN
  852. IF x IS CommandStatement THEN
  853. VisitCommandStatement(x(CommandStatement));
  854. ELSIF x IS PrintStatement THEN
  855. VisitPrintStatement(x(PrintStatement));
  856. ELSE HALT(100)
  857. END;
  858. END VisitStatement;
  859. PROCEDURE VisitProcedureCallStatement*(x: SyntaxTree.ProcedureCallStatement);
  860. VAR call: SyntaxTree.Designator;
  861. BEGIN
  862. IF ~(x.call IS SyntaxTree.ParameterDesignator) THEN
  863. call := SyntaxTree.NewParameterDesignator(x.position,x.call,SyntaxTree.NewExpressionList());
  864. ELSE
  865. call := x.call;
  866. END;
  867. VExpression(call);
  868. END VisitProcedureCallStatement;
  869. PROCEDURE LoadValue;
  870. BEGIN
  871. IF (item.object # NIL) & (item.object IS Result) THEN
  872. item.object := item.object(Result).Evaluate();
  873. ELSE
  874. ErrorSS("could not load value", item.name);
  875. END;
  876. END LoadValue;
  877. PROCEDURE GetValue*(x: SyntaxTree.Expression; VAR w: Value): BOOLEAN;
  878. BEGIN
  879. IF error THEN RETURN FALSE END;
  880. Expression(x);
  881. IF error THEN RETURN FALSE END;
  882. LoadValue();
  883. IF item.object # NIL THEN
  884. w := item.object(Value);
  885. END;
  886. RETURN ~error
  887. END GetValue;
  888. PROCEDURE Designate(x: SyntaxTree.Expression): Result;
  889. BEGIN
  890. Expression(x);
  891. IF item.object # NIL THEN
  892. RETURN item.object(Result);
  893. ELSE
  894. RETURN NIL
  895. END;
  896. END Designate;
  897. PROCEDURE Evaluate(x: SyntaxTree.Expression): Value;
  898. VAR w: Value;
  899. BEGIN
  900. IF GetValue(x, w) THEN RETURN w ELSE RETURN NIL END;
  901. END Evaluate;
  902. PROCEDURE GetInteger(x: SyntaxTree.Expression; VAR i: Integer): BOOLEAN;
  903. VAR v: Value;
  904. BEGIN
  905. IF GetValue(x, v) & (v IS Integer) THEN i := v(Integer); RETURN TRUE ELSE RETURN FALSE END;
  906. END GetInteger;
  907. PROCEDURE ExpectInteger(x: SyntaxTree.Expression; VAR i: Integer): BOOLEAN;
  908. BEGIN IF ~GetInteger(x, i) THEN Error("invalid value - must be integer"); RETURN FALSE ELSE RETURN TRUE END;
  909. END ExpectInteger;
  910. PROCEDURE GetBoolean(x: SyntaxTree.Expression; VAR i: Boolean): BOOLEAN;
  911. VAR v: Value;
  912. BEGIN
  913. IF GetValue(x, v) & (v IS Boolean) THEN i := v(Boolean); RETURN TRUE ELSE RETURN FALSE END;
  914. END GetBoolean;
  915. PROCEDURE ExpectBoolean(x: SyntaxTree.Expression; VAR b: Boolean): BOOLEAN;
  916. BEGIN IF ~GetBoolean(x, b) THEN Error("invalid value - must be boolean"); RETURN FALSE ELSE RETURN TRUE END;
  917. END ExpectBoolean;
  918. PROCEDURE PutValue(x: SyntaxTree.Designator; v: Value);
  919. BEGIN
  920. VExpression(x);
  921. IF (item.object # NIL) & item.object(Result).SetV(v) THEN
  922. ELSIF (item.in # NIL) & (item.name # 0) & (item.in IS Container) THEN
  923. item.in(Container).Enter1(v, item.name);
  924. END;
  925. END PutValue;
  926. PROCEDURE VisitAssignment*(x: SyntaxTree.Assignment);
  927. VAR value: Value;
  928. BEGIN
  929. IF GetValue(x.right, value) THEN
  930. IF x.left # NIL THEN
  931. PutValue(x.left, value);
  932. END;
  933. END;
  934. END VisitAssignment;
  935. PROCEDURE IfPart(ifPart: SyntaxTree.IfPart): BOOLEAN;
  936. VAR value: Boolean;
  937. BEGIN
  938. IF ExpectBoolean(ifPart.condition,value) THEN
  939. IF value(Boolean).value THEN
  940. StatementSequence(ifPart.statements);
  941. RETURN TRUE
  942. END;
  943. END;
  944. RETURN FALSE
  945. END IfPart;
  946. PROCEDURE VisitIfStatement*(x: SyntaxTree.IfStatement);
  947. VAR i: LONGINT; elsif: SyntaxTree.IfPart;
  948. BEGIN
  949. IF IfPart(x.ifPart) THEN RETURN END;
  950. FOR i := 0 TO x.ElsifParts()-1 DO
  951. elsif := x.GetElsifPart(i);
  952. IF IfPart(elsif) THEN RETURN END;
  953. END;
  954. IF x.elsePart # NIL THEN
  955. StatementSequence(x.elsePart)
  956. END;
  957. END VisitIfStatement;
  958. PROCEDURE VisitWithStatement*(x: SyntaxTree.WithStatement);
  959. BEGIN HALT(100) (* abstract *) END VisitWithStatement;
  960. PROCEDURE CasePart(x: SyntaxTree.CasePart; b: SyntaxTree.BinaryExpression): BOOLEAN;
  961. VAR i: LONGINT; value: Value;
  962. BEGIN
  963. FOR i := 0 TO x.elements.Length()-1 DO
  964. b.SetRight(x.elements.GetExpression(i));
  965. IF GetValue(b, value) & (value IS Boolean) THEN
  966. IF value(Boolean).value THEN StatementSequence(x.statements); RETURN TRUE END;
  967. ELSE Error("invalid non-boolean value")
  968. END
  969. END;
  970. RETURN FALSE
  971. END CasePart;
  972. PROCEDURE VisitCaseStatement*(x: SyntaxTree.CaseStatement);
  973. VAR binary: SyntaxTree.BinaryExpression; i: LONGINT;
  974. BEGIN
  975. binary := SyntaxTree.NewBinaryExpression(Basic.invalidPosition, x.variable, x.variable, Scanner.Equal);
  976. FOR i := 0 TO x.CaseParts()-1 DO
  977. IF CasePart(x.GetCasePart(i), binary) THEN RETURN END;
  978. END;
  979. IF x.elsePart # NIL THEN
  980. StatementSequence(x.elsePart)
  981. END;
  982. END VisitCaseStatement;
  983. PROCEDURE VisitWhileStatement*(x: SyntaxTree.WhileStatement);
  984. VAR value: Boolean;
  985. BEGIN
  986. WHILE ExpectBoolean(x.condition, value) & value.value DO
  987. StatementSequence(x.statements);
  988. END;
  989. END VisitWhileStatement;
  990. PROCEDURE VisitRepeatStatement*(x: SyntaxTree.RepeatStatement);
  991. VAR value: Boolean;
  992. BEGIN
  993. REPEAT
  994. StatementSequence(x.statements);
  995. UNTIL ~ExpectBoolean(x.condition, value) OR value.value
  996. END VisitRepeatStatement;
  997. PROCEDURE VisitForStatement*(x: SyntaxTree.ForStatement);
  998. VAR fromV, toV, byV: Integer; from, to, by,i: HUGEINT; int: Integer;
  999. BEGIN
  1000. IF ExpectInteger(x.from, fromV) & ExpectInteger(x.to, toV) THEN
  1001. from := fromV.value;
  1002. to := toV.value;
  1003. Expression(x.variable);
  1004. NEW(int, from);
  1005. PutValue(x.variable, int);
  1006. i := from;
  1007. WHILE i <= to DO
  1008. int.value := i;
  1009. StatementSequence(x.statements);
  1010. INC(i);
  1011. END;
  1012. END;
  1013. END VisitForStatement;
  1014. PROCEDURE VisitLoopStatement*(x: SyntaxTree.LoopStatement);
  1015. VAR prevExit: BOOLEAN;
  1016. BEGIN
  1017. prevExit := exit;
  1018. exit := FALSE;
  1019. LOOP
  1020. StatementSequence(x.statements);
  1021. IF exit THEN EXIT END;
  1022. END;
  1023. exit := prevExit
  1024. END VisitLoopStatement;
  1025. PROCEDURE VisitExitStatement*(x: SyntaxTree.ExitStatement);
  1026. BEGIN
  1027. exit := TRUE
  1028. END VisitExitStatement;
  1029. PROCEDURE VisitReturnStatement*(x: SyntaxTree.ReturnStatement);
  1030. BEGIN HALT(100) (* abstract *) END VisitReturnStatement;
  1031. PROCEDURE VisitAwaitStatement*(x: SyntaxTree.AwaitStatement);
  1032. BEGIN HALT(100) (* abstract *) END VisitAwaitStatement;
  1033. PROCEDURE VisitStatementBlock*(x: SyntaxTree.StatementBlock);
  1034. BEGIN
  1035. StatementSequence(x.statements)
  1036. END VisitStatementBlock;
  1037. PROCEDURE VisitCode*(x: SyntaxTree.Code);
  1038. BEGIN HALT(100) (* abstract *) END VisitCode;
  1039. PROCEDURE Expression(x: SyntaxTree.Expression);
  1040. BEGIN
  1041. value := FALSE;
  1042. VExpression(x);
  1043. END Expression;
  1044. PROCEDURE Statement*(x: SyntaxTree.Statement);
  1045. BEGIN
  1046. item.object := NIL;
  1047. VStatement(x);
  1048. END Statement;
  1049. PROCEDURE StatementSequence*(x: SyntaxTree.StatementSequence);
  1050. VAR i: LONGINT;
  1051. BEGIN
  1052. FOR i := 0 TO x.Length()-1 DO
  1053. Statement(x.GetStatement(i));
  1054. END;
  1055. END StatementSequence;
  1056. END Interpreter;
  1057. Resolver*= OBJECT
  1058. VAR
  1059. interpreter: Interpreter;
  1060. content: PersistentObjects.Content;
  1061. resolved: Basic.HashTable;
  1062. current: Scope;
  1063. changed: BOOLEAN;
  1064. PROCEDURE & InitResolver*;
  1065. BEGIN
  1066. NEW(content); NEW(resolved,64); NEW(interpreter, NIL, NIL, NIL);
  1067. END InitResolver;
  1068. PROCEDURE Traverse(CONST name: ARRAY OF CHAR; array: BOOLEAN);
  1069. VAR index: LONGINT; success: BOOLEAN;
  1070. BEGIN
  1071. IF array THEN index := 0 ELSE index := -1 END;
  1072. REPEAT
  1073. success := FALSE;
  1074. content.success := FALSE;
  1075. current.object.Get(name, index, content);
  1076. IF content.success & (content.class = PersistentObjects.Class.Object) THEN
  1077. success := content.object # NIL;
  1078. IF content.object # NIL THEN
  1079. DoResolve(current.Enter(content.object)); (* content object can be overwritten as sideeffect! *)
  1080. END;
  1081. END;
  1082. INC(index);
  1083. UNTIL ~array OR ~success
  1084. END Traverse;
  1085. PROCEDURE DoResolve*(scope: Scope);
  1086. VAR translation: PersistentObjects.Interpretation; prev: Scope; str: Strings.String;
  1087. BEGIN
  1088. IF (scope.object # NIL) & ~resolved.Has(scope.object) THEN
  1089. prev := current;
  1090. current := scope;
  1091. resolved.Put(scope.object, SELF);
  1092. interpreter.Init(scope, NIL, NIL);
  1093. translation := scope.object.firstTranslation;
  1094. WHILE translation # NIL DO
  1095. IF EnableTrace THEN D.String("resolve "); D.String(translation.name^); D.String(":"); D.String(translation.str^); END;
  1096. IF interpreter.TranslateString("?", translation.str^, str) THEN
  1097. IF EnableTrace THEN D.String(":"); D.Str(str^); END;
  1098. scope.object.Get(translation.name^, -1, content);
  1099. IF ~content.Equals(str^) THEN
  1100. changed := TRUE;
  1101. content.SetAsString(str^);
  1102. END;
  1103. scope.object.Set(translation.name^, -1, content);
  1104. ELSE
  1105. IF EnableTrace THEN D.String(":could not resolve"); END;
  1106. END;
  1107. IF EnableTrace THEN D.Ln; END;
  1108. translation := translation.next
  1109. END;
  1110. scope.object.Enumerate(Traverse);
  1111. current := prev;
  1112. END;
  1113. END DoResolve;
  1114. PROCEDURE Resolve*(scope: Scope);
  1115. BEGIN
  1116. REPEAT
  1117. changed := FALSE;
  1118. resolved.Clear();
  1119. DoResolve(scope);
  1120. UNTIL ~changed;
  1121. END Resolve;
  1122. END Resolver;
  1123. VAR global-: Scope;
  1124. PROCEDURE Statements*(context: Commands.Context);
  1125. VAR scanner: Scanner.Scanner; parser: Parser; diagnostics: Diagnostics.StreamDiagnostics;
  1126. seq: SyntaxTree.StatementSequence; interpreter: Interpreter;
  1127. BEGIN
  1128. NEW(diagnostics, context.error);
  1129. scanner := Scanner.NewScanner("",context.arg,0,diagnostics);
  1130. NEW(parser, scanner, diagnostics, "");
  1131. seq := parser.StatementSequence(NIL);
  1132. NEW(interpreter, global, diagnostics,context); interpreter.StatementSequence(seq);
  1133. END Statements;
  1134. PROCEDURE Expression*(context: Commands.Context);
  1135. VAR scanner: Scanner.Scanner; parser: Parser; diagnostics: Diagnostics.StreamDiagnostics;
  1136. interpreter: Interpreter; value: Value; expression: SyntaxTree.Expression;
  1137. BEGIN
  1138. NEW(diagnostics, context.error);
  1139. scanner := Scanner.NewScanner("",context.arg,0,diagnostics);
  1140. NEW(parser, scanner, diagnostics, "");
  1141. expression := parser.Expression();
  1142. NEW(interpreter, global, diagnostics,NIL);
  1143. IF interpreter.GetValue(expression, value) THEN
  1144. value(Value).WriteValue(context.out); context.out.Ln
  1145. ELSE
  1146. context.error.String("could not evaluate expression"); context.error.Ln
  1147. END;
  1148. END Expression;
  1149. PROCEDURE TranslateString*(context: Commands.Context);
  1150. VAR dest: Strings.String; testString: ARRAY 256 OF CHAR; interpreter: Interpreter; streamDiagnostics: Diagnostics.StreamDiagnostics;
  1151. BEGIN
  1152. NEW(streamDiagnostics, context.error);
  1153. NEW(interpreter, global, streamDiagnostics,NIL);
  1154. WHILE context.arg.GetString(testString) DO
  1155. IF interpreter.TranslateString("?", testString, dest) THEN
  1156. context.out.String("RESULT: ");
  1157. context.out.String(dest^);
  1158. context.out.Ln;
  1159. ELSE
  1160. context.error.String("could not translate: ");
  1161. context.error.String(dest^);
  1162. context.error.Ln;
  1163. END;
  1164. END;
  1165. END TranslateString;
  1166. PROCEDURE InitGlobalScope;
  1167. VAR container: Container;
  1168. BEGIN
  1169. NEW(container);
  1170. NEW(global, NIL, container);
  1171. END InitGlobalScope;
  1172. VAR c: LONGINT;
  1173. VAR d: RECORD e: LONGINT END;
  1174. PROCEDURE Getter(): LONGINT;
  1175. BEGIN
  1176. RETURN 123;
  1177. END Getter;
  1178. PROCEDURE Setter(a: LONGINT): LONGINT;
  1179. BEGIN
  1180. TRACE(a);
  1181. RETURN a+123;
  1182. END Setter;
  1183. TYPE TestO= OBJECT
  1184. VAR i: LONGINT;
  1185. PROCEDURE &P(s: SHORTINT);
  1186. BEGIN
  1187. i := 999+s;
  1188. END P;
  1189. END TestO;
  1190. BEGIN
  1191. InitGlobalScope;
  1192. c := 10;
  1193. d.e := 20;
  1194. END FoxInterpreter.
  1195. System.FreeDownTo FoxInterpreterSymbols ~ FoxInterpreter FoxInterpreterSymbols Reflection2 ~
  1196. FoxInterpreter.Expression
  1197. FoxInterpreter.c ~
  1198. FoxInterpreter.Expression
  1199. -8 ~
  1200. FoxInterpreter.Expression
  1201. FoxInterpreter.d.e ~
  1202. FoxInterpreter.Expression
  1203. FoxInterpreter.Getter() ~
  1204. FoxInterpreter.Expression
  1205. FoxInterpreter.Setter(1000) ~
  1206. FoxInterpreter.Statements
  1207. a := NEW FoxInterpreter.TestO(-8);
  1208. trace(a.i);
  1209. a.i := 10;
  1210. KernelLog.Int(a.i,1);
  1211. KernelLog.Ln;
  1212. ~
  1213. FoxInterpreter.Expression
  1214. Test.c.b;
  1215. ~
  1216. FoxInterpreter.Expression
  1217. Test.Test(5);
  1218. ~
  1219. FoxInterpreter.Statements
  1220. a := Test.c.b;
  1221. Test.c.b := Test.c.b + 1;
  1222. ~
  1223. FoxInterpreter.Expression
  1224. a;
  1225. ~
  1226. FoxInterpreter.Expression
  1227. Test.c.b;
  1228. ~
  1229. FoxInterpreter.Statements
  1230. Test.Test(123)
  1231. ~
  1232. FoxInterpreter.Statements
  1233. FOR i := 1 TO 100 DO
  1234. CASE i MOD 10 OF
  1235. 1: suffix := "st"
  1236. |2: suffix := "nd"
  1237. |3: suffix := "rd"
  1238. ELSE suffix := "th"
  1239. END;
  1240. IF i MOD 9 = 0 THEN
  1241. ! "System.Show This is the ?{i}??{suffix}? run." ;
  1242. ! "System.Ln";
  1243. END;
  1244. END;
  1245. ~
  1246. FoxInterpreter.Expression
  1247. i MOD 10 ~
  1248. FoxInterpreter.Statements
  1249. o := Test.TestO();
  1250. ~
  1251. FoxInterpreter.Statements
  1252. s := {0..10, 15};
  1253. a := 10;
  1254. b := 10..20;
  1255. c := {a,b};
  1256. x := 10;
  1257. y := 20;
  1258. z := x;
  1259. z := x + y;
  1260. b := x = y;
  1261. nb := x # y;
  1262. FOR i := 0 TO 3 DO
  1263. a := i;
  1264. IF i<2 THEN
  1265. a := 200+i;
  1266. END;
  1267. CASE i OF
  1268. 0: a := 2000;
  1269. |2: HALT(100)
  1270. END;
  1271. END;
  1272. ~
  1273. TRACE(x);
  1274. FOR i := 0 TO 100 DO
  1275. x[i] := i
  1276. END;
  1277. ~
  1278. FoxInterpreter.TranslateString
  1279. "This is a string ?{15+2*20*a:32}? oha."
  1280. "The rest of this string will be evaluated ?{3+5 = 20}?"
  1281. "?{ 100*15"
  1282. "a set in a evaluated expression ?{{1,2,4}}?"
  1283. ~
  1284. FoxInterpreter.Statements
  1285. a := [[1,2,3],[4,5,6],[7,8,9]];
  1286. FOR i := 0 TO 2 DO
  1287. FOR j := 0 TO 2 DO
  1288. ! \+"System.Show ?{a[i,j]}? ;"+\
  1289. END;
  1290. ! \+"System.Ln;"+\
  1291. END;
  1292. ! "System.Show ?{a}? ";
  1293. ? a;
  1294. ? 1+1;
  1295. ? 1+2;
  1296. ~
  1297. System.FreeDownTo FoxInterpreter FoxInterpreterSymbols ~