FoxPrintout.Mod 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988
  1. MODULE FoxPrintout; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler Module Output for SymbolFile, Pretty Printing and Testing"; *)
  2. (* (c) fof ETHZ 2009 *)
  3. IMPORT
  4. Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Basic := FoxBasic, FingerPrinter := FoxFingerPrinter, Streams, D:=Debugging, SYSTEM;
  5. CONST
  6. (* print modes *)
  7. Exported*=0; SymbolFile*=1; SourceCode*=2; All*=3;
  8. TYPE
  9. Printer*= OBJECT (SyntaxTree.Visitor)
  10. VAR
  11. w-: Basic.Writer; mode: LONGINT; singleStatement: BOOLEAN;
  12. currentScope: SyntaxTree.Scope; ws: Streams.StringWriter;
  13. info: BOOLEAN; case: LONGINT;
  14. useCase: BOOLEAN; (* TRUE to enable case conversion in "Identifier" *)
  15. alertCount, commentCount: LONGINT;
  16. fingerPrinter:FingerPrinter.FingerPrinter;
  17. PROCEDURE Small(CONST name: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
  18. VAR ch: CHAR; i: LONGINT;
  19. BEGIN
  20. i := 0;
  21. REPEAT
  22. ch := name[i];
  23. IF (ch >= 'A') & (ch <= 'Z') THEN
  24. ch := CHR(ORD(ch)-ORD('A')+ORD('a'));
  25. END;
  26. result[i] := ch; INC(i);
  27. UNTIL ch = 0X;
  28. END Small;
  29. PROCEDURE Big(CONST name: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
  30. VAR ch: CHAR; i: LONGINT;
  31. BEGIN
  32. i := 0;
  33. REPEAT
  34. ch := name[i];
  35. IF (ch >= 'a') & (ch <= 'z') THEN
  36. ch := CHR(ORD(ch)-ORD('a')+ORD('A'));
  37. END;
  38. result[i] := ch; INC(i);
  39. UNTIL ch = 0X;
  40. END Big;
  41. PROCEDURE Keyword(CONST a: ARRAY OF CHAR);
  42. VAR str: ARRAY 64 OF CHAR;
  43. BEGIN
  44. IF case= Scanner.Lowercase THEN Small(a,str) ELSE COPY(a,str) END;
  45. w.BeginKeyword;
  46. w.String(str);
  47. w.EndKeyword;
  48. END Keyword;
  49. PROCEDURE AlertString(CONST s: ARRAY OF CHAR);
  50. BEGIN
  51. w.BeginAlert; w.String(s); w.EndAlert;
  52. END AlertString;
  53. PROCEDURE Indent;
  54. BEGIN w.Ln;
  55. END Indent;
  56. PROCEDURE Identifier*(x: SyntaxTree.Identifier);
  57. VAR str: Scanner.IdentifierString;
  58. BEGIN
  59. Basic.GetString(x,str);
  60. IF useCase THEN
  61. IF case = Scanner.Lowercase THEN Small(str,str); ELSE Big(str,str); END;
  62. END;
  63. w.String(str);
  64. END Identifier;
  65. PROCEDURE QualifiedIdentifier*(x: SyntaxTree.QualifiedIdentifier);
  66. BEGIN
  67. IF x.prefix # SyntaxTree.invalidIdentifier THEN Identifier(x.prefix); w.String("."); END;
  68. Identifier(x.suffix);
  69. END QualifiedIdentifier;
  70. PROCEDURE Type*(x: SyntaxTree.Type);
  71. BEGIN
  72. IF x= NIL THEN
  73. AlertString("nil type");
  74. ELSE
  75. x.Accept(SELF);
  76. END;
  77. END Type;
  78. PROCEDURE VisitType(x: SyntaxTree.Type);
  79. BEGIN
  80. IF x = SyntaxTree.importType THEN w.String("importType")
  81. ELSIF x = SyntaxTree.typeDeclarationType THEN w.String("typeDeclarationType");
  82. ELSE
  83. AlertString("InvalidType");
  84. END;
  85. END VisitType;
  86. PROCEDURE VisitBasicType(x: SyntaxTree.BasicType);
  87. BEGIN
  88. IF x.typeDeclaration # NIL THEN
  89. Identifier(x.typeDeclaration.name);
  90. ELSE
  91. Identifier(x.name);
  92. END
  93. END VisitBasicType;
  94. PROCEDURE VisitBooleanType(x: SyntaxTree.BooleanType);
  95. BEGIN
  96. VisitBasicType(x);
  97. END VisitBooleanType;
  98. PROCEDURE VisitSetType(x: SyntaxTree.SetType);
  99. BEGIN
  100. VisitBasicType(x);
  101. END VisitSetType;
  102. PROCEDURE VisitSizeType(x: SyntaxTree.SizeType);
  103. BEGIN
  104. VisitBasicType(x);
  105. END VisitSizeType;
  106. PROCEDURE VisitCharacterType(x: SyntaxTree.CharacterType);
  107. BEGIN
  108. VisitBasicType(x);
  109. END VisitCharacterType;
  110. PROCEDURE VisitIntegerType(x: SyntaxTree.IntegerType);
  111. BEGIN
  112. VisitBasicType(x);
  113. END VisitIntegerType;
  114. PROCEDURE VisitFloatType(x: SyntaxTree.FloatType);
  115. BEGIN
  116. VisitBasicType(x);
  117. END VisitFloatType;
  118. PROCEDURE VisitComplexType(x: SyntaxTree.ComplexType);
  119. BEGIN
  120. VisitBasicType(x);
  121. END VisitComplexType;
  122. PROCEDURE VisitByteType(x: SyntaxTree.ByteType);
  123. BEGIN
  124. VisitBasicType(x);
  125. END VisitByteType;
  126. PROCEDURE VisitQualifiedType(x: SyntaxTree.QualifiedType);
  127. BEGIN
  128. IF x.resolved = SyntaxTree.invalidType THEN
  129. AlertString("(*unresolved*)");
  130. END;
  131. IF x.qualifiedIdentifier # NIL THEN
  132. (* Problem: how to distinguish betwteen type aliases, e.g. Status = LONGINT and actual use of LONGINT?
  133. This tries to use scope level: if the type is declared in the global scope, it should be a basic type use. *)
  134. IF x.resolved # NIL THEN
  135. useCase := (x.resolved IS SyntaxTree.BasicType) & (x.scope.Level() = 0);
  136. END;
  137. QualifiedIdentifier(x.qualifiedIdentifier);
  138. useCase := FALSE;
  139. ELSE
  140. AlertString("NIL (* missing qualified identifier *)");
  141. END;
  142. END VisitQualifiedType;
  143. PROCEDURE VisitStringType(x: SyntaxTree.StringType);
  144. BEGIN
  145. w.String("STRING"); w.String("(* len = "); w.Int(x.length,1); w.String(" *)");
  146. END VisitStringType;
  147. PROCEDURE VisitEnumerationType(x: SyntaxTree.EnumerationType);
  148. VAR e: SyntaxTree.Constant; first: BOOLEAN;
  149. BEGIN
  150. Keyword("ENUM ");
  151. IF x.enumerationBase # NIL THEN
  152. w.String("(");
  153. Type(x.enumerationBase);
  154. w.String(") ");
  155. END;
  156. e := x.enumerationScope.firstConstant; first := TRUE;
  157. WHILE (e # NIL) DO
  158. IF ~first THEN w.String(", ") ELSE first := FALSE END;
  159. VisitConstant(e);
  160. e := e.nextConstant;
  161. END;
  162. Keyword(" END");
  163. END VisitEnumerationType;
  164. PROCEDURE VisitRangeType(x: SyntaxTree.RangeType);
  165. BEGIN VisitBasicType(x);
  166. END VisitRangeType;
  167. PROCEDURE VisitArrayType(x: SyntaxTree.ArrayType);
  168. BEGIN
  169. Keyword("ARRAY " );
  170. IF x.length # NIL THEN Expression(x.length);
  171. w.String( " " ); END;
  172. Keyword("OF " );
  173. Type(x.arrayBase);
  174. END VisitArrayType;
  175. PROCEDURE VisitNilType(x: SyntaxTree.NilType);
  176. BEGIN
  177. w.String("NILTYPE");
  178. END VisitNilType;
  179. PROCEDURE VisitAddressType(x: SyntaxTree.AddressType);
  180. BEGIN
  181. w.String("ADDRESSTYPE");
  182. END VisitAddressType;
  183. PROCEDURE VisitObjectType(x: SyntaxTree.ObjectType);
  184. BEGIN
  185. VisitBasicType(x);
  186. END VisitObjectType;
  187. PROCEDURE VisitAnyType(x: SyntaxTree.AnyType);
  188. BEGIN
  189. VisitBasicType(x);
  190. END VisitAnyType;
  191. PROCEDURE VisitMathArrayType(x: SyntaxTree.MathArrayType);
  192. BEGIN
  193. Keyword("ARRAY " );
  194. IF x.form = SyntaxTree.Tensor THEN w.String("[?] ");
  195. ELSE
  196. w.String("[");
  197. IF x.length = NIL THEN
  198. w.String("*")
  199. ELSE
  200. Expression(x.length);
  201. END;
  202. WHILE(x.arrayBase # NIL) & (x.arrayBase IS SyntaxTree.MathArrayType) DO
  203. x := x.arrayBase(SyntaxTree.MathArrayType);
  204. w.String(", ");
  205. IF x.length = NIL THEN
  206. w.String("*")
  207. ELSE
  208. Expression(x.length);
  209. END;
  210. END;
  211. w.String("] ");
  212. END;
  213. IF x.arrayBase # NIL THEN
  214. Keyword("OF " );
  215. Type(x.arrayBase);
  216. END;
  217. END VisitMathArrayType;
  218. PROCEDURE PointerFlags(x: SyntaxTree.PointerType);
  219. VAR first: BOOLEAN;
  220. BEGIN
  221. first := TRUE;
  222. IF x.isUnsafe THEN Flag(Global.NameUnsafe,first) END;
  223. IF x.isRealtime THEN Flag(Global.NameRealtime,first) END;
  224. IF x.isDisposable THEN Flag(Global.NameDisposable,first) END;
  225. IF x.isPlain THEN Flag(Global.NamePlain,first) END;
  226. FlagEnd(first);
  227. END PointerFlags;
  228. PROCEDURE ObjectFlags ( rec: SyntaxTree.RecordType; x: SyntaxTree.PointerType);
  229. VAR first: BOOLEAN;
  230. BEGIN
  231. first := TRUE;
  232. IF x.isUnsafe THEN Flag(Global.NameUnsafe,first) END;
  233. IF x.isRealtime THEN Flag(Global.NameRealtime,first) END;
  234. IF x.isDisposable THEN Flag(Global.NameDisposable,first) END;
  235. IF x.isPlain THEN Flag(Global.NamePlain,first) END;
  236. IF rec.IsProtected() THEN Flag(Global.NameExclusive, first) END;
  237. FlagEnd(first);
  238. END ObjectFlags;
  239. PROCEDURE VisitPointerType(x: SyntaxTree.PointerType);
  240. VAR pointerBase: SyntaxTree.Type;
  241. BEGIN
  242. IF x.pointerBase = NIL THEN
  243. w.BeginAlert; Keyword("POINTER TO NIL"); w.EndAlert;
  244. ELSE
  245. pointerBase := x.pointerBase;
  246. IF x.isHidden THEN
  247. Type(x.pointerBase);
  248. ELSIF (pointerBase IS SyntaxTree.RecordType) & (pointerBase(SyntaxTree.RecordType).isObject) THEN
  249. VisitRecordType(pointerBase(SyntaxTree.RecordType))
  250. ELSE
  251. Keyword("POINTER "); PointerFlags(x); Keyword("TO " ); Type(x.pointerBase);
  252. END;
  253. END;
  254. END VisitPointerType;
  255. PROCEDURE VisitPortType(x: SyntaxTree.PortType);
  256. BEGIN
  257. Keyword("PORT");
  258. IF x.direction = SyntaxTree.OutPort THEN
  259. Keyword(" OUT")
  260. ELSE
  261. ASSERT(x.direction = SyntaxTree.InPort);
  262. Keyword(" IN");
  263. END;
  264. IF x.sizeExpression # NIL THEN
  265. w.String(" ("); Expression(x.sizeExpression); w.String(")");
  266. END;
  267. END VisitPortType;
  268. PROCEDURE VisitCellType(x: SyntaxTree.CellType);
  269. BEGIN
  270. IF x.isCellNet THEN
  271. Keyword("CELLNET ")
  272. ELSE
  273. Keyword("CELL ");
  274. END;
  275. Modifiers(x.modifiers);
  276. IF x.firstParameter # NIL THEN ParameterList(x.firstParameter) END;
  277. Scope(x.cellScope);
  278. IF (x.cellScope IS SyntaxTree.CellScope) & (x.cellScope(SyntaxTree.CellScope).bodyProcedure # NIL) THEN
  279. Body(x.cellScope(SyntaxTree.CellScope).bodyProcedure.procedureScope.body, mode >= SourceCode)
  280. END;
  281. Indent; Keyword("END ");
  282. IF (x.typeDeclaration # NIL) THEN
  283. Identifier(x.typeDeclaration.name);
  284. END;
  285. END VisitCellType;
  286. PROCEDURE VisitRecordType(x: SyntaxTree.RecordType);
  287. VAR prevScope: SyntaxTree.Scope;
  288. BEGIN
  289. IF x.isObject THEN
  290. Keyword("OBJECT ");
  291. IF x.pointerType # NIL THEN ObjectFlags(x, x.pointerType) END;
  292. IF info THEN
  293. BeginComment; w.String("ObjectType");
  294. IF x.HasArrayStructure() THEN
  295. w.String(" (array structure: ");
  296. VisitMathArrayType(x.arrayStructure);
  297. w.String(")");
  298. END;
  299. EndComment;
  300. END;
  301. IF (x.baseType # NIL) THEN
  302. w.String( "(" );
  303. IF (x.baseType IS SyntaxTree.RecordType) & (x.baseType(SyntaxTree.RecordType).pointerType # NIL) THEN
  304. Type(x.baseType(SyntaxTree.RecordType).pointerType)
  305. ELSE
  306. Type(x.baseType);
  307. END;
  308. w.String( ")" );
  309. END;
  310. Scope(x.recordScope);
  311. IF (x.recordScope.bodyProcedure # NIL) THEN
  312. Body(x.recordScope.bodyProcedure.procedureScope.body, mode >= SourceCode)
  313. END;
  314. Indent; Keyword("END ");
  315. IF (x.pointerType # NIL) & (x.pointerType.typeDeclaration # NIL) THEN
  316. Identifier(x.pointerType.typeDeclaration.name);
  317. END;
  318. ELSE
  319. Keyword("RECORD ");
  320. IF (x.baseType # NIL) THEN
  321. w.String( "(" );
  322. IF (x.baseType IS SyntaxTree.RecordType) & (x.baseType(SyntaxTree.RecordType).pointerType # NIL) THEN
  323. Type(x.baseType(SyntaxTree.RecordType).pointerType)
  324. ELSE
  325. Type(x.baseType);
  326. END;
  327. w.String( ")" );
  328. END;
  329. prevScope := currentScope;
  330. currentScope := x.recordScope;
  331. VariableList(x.recordScope.firstVariable);
  332. currentScope := prevScope;
  333. Indent; Keyword("END" );
  334. END;
  335. END VisitRecordType;
  336. PROCEDURE Flag(identifier: SyntaxTree.Identifier; VAR first: BOOLEAN);
  337. VAR name: SyntaxTree.IdentifierString;
  338. BEGIN
  339. IF first THEN w.String("{") ELSE w.String(", ") END;
  340. first := FALSE;
  341. Basic.GetString(identifier,name);
  342. w.String(name);
  343. END Flag;
  344. PROCEDURE FlagEnd(first: BOOLEAN);
  345. BEGIN
  346. IF ~first THEN w.String("} ") END;
  347. END FlagEnd;
  348. PROCEDURE Value(identifier: SyntaxTree.Identifier; value: LONGINT; VAR first: BOOLEAN);
  349. BEGIN
  350. Flag(identifier,first);
  351. w.String("("); w.Int(value,1); w.String(")");
  352. END Value;
  353. PROCEDURE VisitProcedureType(x: SyntaxTree.ProcedureType);
  354. VAR first: BOOLEAN;
  355. BEGIN
  356. Keyword("PROCEDURE " );
  357. first := TRUE;
  358. IF x.isDelegate THEN Flag(Global.NameDelegate,first) END;
  359. IF x.isInterrupt THEN Flag(Global.NameInterrupt,first) END;
  360. IF x.noPAF THEN Flag(Global.NameNoPAF,first) END;
  361. IF x.noReturn THEN Flag(Global.NameNoReturn,first) END;
  362. IF x.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  363. Flag(Global.NameWinAPI,first)
  364. ELSIF x.callingConvention = SyntaxTree.CCallingConvention THEN
  365. Flag(Global.NameC,first)
  366. END;
  367. IF x.stackAlignment > 1 THEN Value(Global.NameStackAligned,x.stackAlignment,first) END;
  368. IF ~first THEN w.String("}") END;
  369. IF (x.modifiers # NIL) & info THEN
  370. BeginComment;
  371. Modifiers(x.modifiers);
  372. EndComment;
  373. END;
  374. (*
  375. CallingConvention(x.callingConvention);
  376. IF x.isDelegate THEN w.String("{DELEGATE}") END;
  377. *)
  378. IF (x.firstParameter # NIL) OR (x.returnType # NIL) THEN
  379. ParameterList(x.firstParameter)
  380. END;
  381. IF x.returnType # NIL THEN
  382. w.String( ":" );
  383. IF x.hasUntracedReturn THEN
  384. first := TRUE;
  385. Flag(Global.NameUntraced, first);
  386. FlagEnd(first);
  387. END;
  388. Type(x.returnType)
  389. END;
  390. IF info & (x.returnParameter # NIL) THEN
  391. BeginComment;
  392. VisitParameter(x.returnParameter);
  393. EndComment;
  394. END;
  395. END VisitProcedureType;
  396. (*** expressions ****)
  397. PROCEDURE ExpressionList(x: SyntaxTree.ExpressionList);
  398. VAR i: LONGINT; expression: SyntaxTree.Expression;
  399. BEGIN
  400. FOR i := 0 TO x.Length() - 1 DO
  401. expression := x.GetExpression( i ); Expression(expression);
  402. IF i < x.Length() - 1 THEN w.String( ", " ); END;
  403. END;
  404. END ExpressionList;
  405. PROCEDURE Expression*(x: SyntaxTree.Expression);
  406. BEGIN
  407. IF x = NIL THEN
  408. AlertString("nil expression");
  409. ELSE
  410. x.Accept(SELF);
  411. IF info & (x.resolved # NIL) & (x.resolved # x) THEN
  412. BeginComment; w.String("value = "); Expression(x.resolved); EndComment;
  413. END;
  414. END;
  415. w.Update;
  416. END Expression;
  417. PROCEDURE VisitExpression(x: SyntaxTree.Expression);
  418. BEGIN
  419. AlertString("InvalidExpression");
  420. END VisitExpression;
  421. PROCEDURE VisitSet(x: SyntaxTree.Set);
  422. BEGIN
  423. w.String( "{" ); ExpressionList(x.elements); w.String( "}" );
  424. END VisitSet;
  425. PROCEDURE VisitMathArrayExpression(x: SyntaxTree.MathArrayExpression);
  426. BEGIN
  427. w.String( "[" ); ExpressionList(x.elements); w.String( "]" );
  428. END VisitMathArrayExpression;
  429. PROCEDURE VisitUnaryExpression(x: SyntaxTree.UnaryExpression);
  430. VAR identifier: SyntaxTree.Identifier;
  431. BEGIN
  432. w.String(" ");
  433. IF x.operator = Scanner.Transpose THEN
  434. identifier := Global.GetIdentifier(x.operator,case);
  435. Expression(x.left);
  436. Identifier(identifier);
  437. ELSIF (x.operator = Scanner.Address) OR (x.operator = Scanner.Size) OR (x.operator = Scanner.Alias) THEN
  438. identifier := Global.GetIdentifier(x.operator,case);
  439. Identifier(identifier);
  440. Keyword(" OF ");
  441. Expression(x.left);
  442. ELSE
  443. identifier := Global.GetIdentifier(x.operator,case);
  444. Identifier(identifier);
  445. Expression(x.left);
  446. END;
  447. END VisitUnaryExpression;
  448. PROCEDURE VisitBinaryExpression(x: SyntaxTree.BinaryExpression);
  449. VAR identifier: SyntaxTree.Identifier;
  450. BEGIN
  451. w.String( "(" );
  452. Expression(x.left);
  453. identifier := Global.GetIdentifier(x.operator,case);
  454. w.String(" "); Identifier(identifier); w.String(" ");
  455. Expression(x.right);
  456. w.String(")");
  457. END VisitBinaryExpression;
  458. PROCEDURE VisitRangeExpression(x: SyntaxTree.RangeExpression);
  459. BEGIN
  460. IF x.missingFirst & x.missingLast & x.missingStep THEN
  461. (* open range expression *)
  462. (* the surrounding spaces prevent the asterisk from being next to a parenthesis,
  463. which could be confused with the beginning or end of a comment *)
  464. w.String(" * ")
  465. ELSE
  466. IF ~x.missingFirst THEN Expression(x.first) END;
  467. w.String(" .. ");
  468. IF ~x.missingLast THEN Expression(x.last) END;
  469. IF ~x.missingStep THEN
  470. Keyword(" BY ");
  471. Expression(x.step)
  472. END
  473. END;
  474. IF info THEN
  475. BeginComment;
  476. w.String("<RangeExpression:");
  477. ShortType(x.type);
  478. w.String(">");
  479. EndComment
  480. END
  481. END VisitRangeExpression;
  482. PROCEDURE VisitTensorRangeExpression(x: SyntaxTree.TensorRangeExpression);
  483. BEGIN
  484. w.String(" ? ");
  485. END VisitTensorRangeExpression;
  486. PROCEDURE VisitConversion(x: SyntaxTree.Conversion);
  487. BEGIN
  488. IF x.typeExpression # NIL THEN Expression(x.typeExpression); w.String("(");
  489. ELSIF info THEN BeginComment; ShortType(x.type); w.String("<-"); EndComment;
  490. END;
  491. Expression(x.expression);
  492. IF x.typeExpression # NIL THEN w.String(")") END;
  493. END VisitConversion;
  494. PROCEDURE VisitDesignator(x: SyntaxTree.Designator);
  495. BEGIN
  496. AlertString("InvalidDesignator");
  497. END VisitDesignator;
  498. PROCEDURE VisitIdentifierDesignator(x: SyntaxTree.IdentifierDesignator);
  499. BEGIN
  500. IF info THEN AlertString("(*<IdentifierDesignator>*)") END;
  501. Identifier(x.identifier)
  502. END VisitIdentifierDesignator;
  503. PROCEDURE VisitSelectorDesignator(x: SyntaxTree.SelectorDesignator);
  504. BEGIN
  505. Expression(x.left);
  506. w.String(".");
  507. IF info THEN AlertString("(*<SelectorDesignator>*)") END;
  508. Identifier(x.identifier);
  509. END VisitSelectorDesignator;
  510. PROCEDURE VisitBracketDesignator(x: SyntaxTree.BracketDesignator);
  511. BEGIN
  512. Expression(x.left);
  513. IF info THEN AlertString("(*<BracketDesignator>*)") END;
  514. w.String("["); ExpressionList(x.parameters); w.String("]");
  515. END VisitBracketDesignator;
  516. PROCEDURE VisitParameterDesignator(x: SyntaxTree.ParameterDesignator);
  517. BEGIN
  518. Expression(x.left);
  519. IF info THEN AlertString("(*<ParameterDesignator>*)") END;
  520. w.String("("); ExpressionList(x.parameters); w.String(")");
  521. END VisitParameterDesignator;
  522. PROCEDURE VisitIndexDesignator(x: SyntaxTree.IndexDesignator);
  523. BEGIN
  524. Expression(x.left);
  525. w.String("["); ExpressionList(x.parameters); w.String("]");
  526. IF info THEN
  527. BeginComment;
  528. w.String("<IndexDesignator:");
  529. ShortType(x.type);
  530. w.String(">");
  531. EndComment
  532. END;
  533. END VisitIndexDesignator;
  534. PROCEDURE VisitArrowDesignator(x: SyntaxTree.ArrowDesignator);
  535. BEGIN
  536. Expression(x.left);
  537. IF info THEN AlertString("(*<ArrowDesignator>*)") END;
  538. w.String( "^" );
  539. END VisitArrowDesignator;
  540. PROCEDURE ShortType(x: SyntaxTree.Type); (* for debug information, to prevent recursion *)
  541. BEGIN
  542. IF x = NIL THEN w.String("NIL TYPE")
  543. ELSIF x IS SyntaxTree.QualifiedType THEN Type(x)
  544. ELSIF x IS SyntaxTree.BasicType THEN Type(x)
  545. ELSIF x IS SyntaxTree.ProcedureType THEN w.String("ProcedureType:");ShortType(x(SyntaxTree.ProcedureType).returnType);
  546. ELSE w.String("(other)") END;
  547. END ShortType;
  548. PROCEDURE VisitSymbolDesignator(x: SyntaxTree.SymbolDesignator);
  549. BEGIN
  550. IF (x.left # NIL) & ~x.left.isHidden THEN
  551. Expression(x.left); w.String(".");
  552. END;
  553. IF x.symbol IS SyntaxTree.Operator THEN
  554. w.String('"'); Identifier(x.symbol.name); w.String('"');
  555. ELSE
  556. useCase :=
  557. (x.symbol IS SyntaxTree.Builtin)
  558. OR ((x.symbol IS SyntaxTree.TypeDeclaration) & (x.symbol(SyntaxTree.TypeDeclaration).declaredType IS SyntaxTree.BasicType))
  559. OR (x.symbol IS SyntaxTree.Module) & ((x.symbol.name = Global.systemName) OR (x.symbol.name = Global.SystemName));
  560. Identifier(x.symbol.name);
  561. useCase := FALSE;
  562. END;
  563. IF info THEN
  564. BeginComment;
  565. w.String("<SymbolDesignator:");
  566. ShortType(x.symbol.type);
  567. w.String(">");
  568. EndComment
  569. END;
  570. END VisitSymbolDesignator;
  571. PROCEDURE VisitSupercallDesignator(x: SyntaxTree.SupercallDesignator);
  572. BEGIN
  573. Expression(x.left);
  574. w.String( "^" );
  575. IF info THEN
  576. BeginComment;
  577. w.String("<SupercallDesignator:");
  578. ShortType(x.type);
  579. w.String(">");
  580. EndComment
  581. END;
  582. END VisitSupercallDesignator;
  583. PROCEDURE VisitSelfDesignator(x: SyntaxTree.SelfDesignator);
  584. BEGIN
  585. ASSERT(x.left = NIL);
  586. IF case = Scanner.Lowercase THEN w.String("self"); ELSE w.String("SELF"); END;
  587. IF info THEN
  588. BeginComment;
  589. w.String("<SelfDesignator:");
  590. ShortType(x.type);
  591. w.String(">");
  592. EndComment
  593. END;
  594. END VisitSelfDesignator;
  595. PROCEDURE VisitResultDesignator(x: SyntaxTree.ResultDesignator);
  596. BEGIN
  597. ASSERT(x.left = NIL);
  598. w.String("RESULT");
  599. IF info THEN
  600. BeginComment;
  601. w.String("<ResultDesignator:");
  602. ShortType(x.type);
  603. w.String(">");
  604. EndComment
  605. END;
  606. END VisitResultDesignator;
  607. PROCEDURE VisitDereferenceDesignator(x: SyntaxTree.DereferenceDesignator);
  608. BEGIN
  609. Expression(x.left);
  610. w.String( "^" );
  611. IF info THEN
  612. BeginComment;
  613. w.String("<DereferenceDesignator:");
  614. ShortType(x.type);
  615. w.String(">");
  616. EndComment
  617. END;
  618. END VisitDereferenceDesignator;
  619. PROCEDURE VisitTypeGuardDesignator(x: SyntaxTree.TypeGuardDesignator);
  620. BEGIN
  621. Expression(x.left);
  622. IF info THEN
  623. BeginComment;
  624. w.String("<TypeGuardDesignator:");
  625. ShortType(x.type);
  626. w.String(">");
  627. EndComment
  628. END;
  629. w.String("(");
  630. IF x.typeExpression # NIL THEN Expression(x.typeExpression) ELSE Type(x.type) END;
  631. w.String(")");
  632. END VisitTypeGuardDesignator;
  633. PROCEDURE VisitProcedureCallDesignator(x: SyntaxTree.ProcedureCallDesignator);
  634. BEGIN
  635. Expression(x.left);
  636. IF info THEN
  637. BeginComment;
  638. w.String("<ProcedureCallDesignator:");
  639. ShortType(x.type);
  640. w.String(">");
  641. EndComment
  642. END;
  643. w.String("("); ExpressionList(x.parameters); w.String(")");
  644. END VisitProcedureCallDesignator;
  645. PROCEDURE VisitStatementDesignator(x: SyntaxTree.StatementDesignator);
  646. BEGIN
  647. Indent; Keyword("STATEMENT-DESIGNATOR ");
  648. IF x.result # NIL THEN
  649. Keyword("RETURNS ");
  650. Expression(x.result)
  651. END;
  652. Indent; Statement(x.statement);
  653. END VisitStatementDesignator;
  654. PROCEDURE VisitBuiltinCallDesignator(x: SyntaxTree.BuiltinCallDesignator);
  655. BEGIN
  656. IF x.left # NIL THEN
  657. Expression(x.left);
  658. ELSE
  659. w.String("BUILTIN(");
  660. w.Int(x.id,1);
  661. w.String(")");
  662. END;
  663. IF info THEN
  664. BeginComment;
  665. w.String("<BuiltinCallDesignator:");
  666. ShortType(x.type);
  667. w.String(">");
  668. EndComment
  669. END;
  670. w.String("("); ExpressionList(x.parameters); w.String(")");
  671. END VisitBuiltinCallDesignator;
  672. PROCEDURE VisitValue(x: SyntaxTree.Value);
  673. BEGIN
  674. AlertString("InvalidValue");
  675. END VisitValue;
  676. PROCEDURE VisitBooleanValue(x: SyntaxTree.BooleanValue);
  677. BEGIN
  678. IF Scanner.Uppercase = case THEN
  679. IF x.value THEN w.String("TRUE" ) ELSE w.String( "FALSE" ) END
  680. ELSE
  681. IF x.value THEN w.String("true" ) ELSE w.String( "false" ) END
  682. END
  683. END VisitBooleanValue;
  684. PROCEDURE Hex(x: HUGEINT);
  685. VAR i: LONGINT; a: ARRAY 20 OF CHAR; y: HUGEINT;
  686. BEGIN
  687. i := 0;
  688. REPEAT
  689. y := x MOD 10H;
  690. IF y < 10 THEN a[i] := CHR(y+ORD('0'))
  691. ELSE a[i] := CHR(y-10+ORD('A'))
  692. END;
  693. x := x DIV 10H;
  694. INC(i);
  695. UNTIL (x=0) OR (i=16);
  696. IF y >=10 THEN w.Char("0") END;
  697. REPEAT DEC( i ); w.Char( a[i] ) UNTIL i = 0
  698. END Hex;
  699. PROCEDURE VisitIntegerValue(x: SyntaxTree.IntegerValue);
  700. PROCEDURE InBounds(val: HUGEINT; bits: LONGINT): BOOLEAN;
  701. VAR m: HUGEINT;
  702. BEGIN
  703. m := ASH(HUGEINT(1),bits-1);
  704. RETURN (val < m) & (-val <= m)
  705. END InBounds;
  706. BEGIN
  707. (*! use subtype for representation form ? *)
  708. IF x.hvalue = MIN(HUGEINT) THEN
  709. (* special case: display 8000000000000000H without leading minus sign
  710. to avoid double minus sign for unary expression -8000000000000000H
  711. *)
  712. w.Char("0"); w.Hex(x.hvalue,-16); w.Char("H");
  713. ELSIF InBounds(x.hvalue,32) THEN
  714. w.Int(SHORT(x.hvalue),1);
  715. ELSE
  716. Hex(x.hvalue); w.Char("H");
  717. END;
  718. END VisitIntegerValue;
  719. PROCEDURE VisitCharacterValue(x: SyntaxTree.CharacterValue);
  720. BEGIN
  721. Hex( ORD(x.value)); w.String( "X" );
  722. END VisitCharacterValue;
  723. PROCEDURE VisitSetValue(x: SyntaxTree.SetValue);
  724. VAR i: LONGINT;
  725. BEGIN
  726. w.String("{");
  727. i := 0;
  728. WHILE (i<MAX(SET)) & ~(i IN x.value) DO
  729. INC(i);
  730. END;
  731. IF i<MAX(SET) THEN
  732. w.Int(i,1);
  733. INC(i);
  734. WHILE i < MAX(SET) DO
  735. IF i IN x.value THEN w.String(","); w.Int(i,1); END;
  736. INC(i)
  737. END
  738. END;
  739. w.String("}");
  740. END VisitSetValue;
  741. PROCEDURE VisitMathArrayValue(x: SyntaxTree.MathArrayValue);
  742. BEGIN
  743. VisitMathArrayExpression(x.array);
  744. END VisitMathArrayValue;
  745. PROCEDURE FormatedFloat(value: LONGREAL; subtype: LONGINT);
  746. VAR string: ARRAY 128 OF CHAR; i: LONGINT;
  747. BEGIN
  748. IF subtype = Scanner.Real THEN
  749. ws.SetPos(0); ws.Float(value,11(*mantissa X.XXXXXXX *)+5(*exponent E+XXX *)); ws.Get(string);
  750. i := 0;
  751. WHILE(i<LEN(string)) & (string[i] # 0X) DO
  752. IF string[i] = "D" THEN string[i] := "E" END;
  753. INC(i);
  754. END;
  755. w.String(string);
  756. ELSIF subtype = Scanner.Longreal THEN
  757. ws.SetPos(0); ws.Float(value,20(*mantissa X.X..(16)..X *)+5(*exponent E+XXX *) ); ws.Get(string);
  758. i := 0;
  759. WHILE(i<LEN(string)) & (string[i] # 0X) DO
  760. IF string[i] = "E" THEN string[i] := "D" END;
  761. INC(i);
  762. END;
  763. w.String(string);
  764. ELSE
  765. w.Float(value,64)
  766. END;
  767. END FormatedFloat;
  768. PROCEDURE VisitRealValue(x: SyntaxTree.RealValue);
  769. BEGIN FormatedFloat(x.value, x.subtype)
  770. END VisitRealValue;
  771. PROCEDURE VisitComplexValue(x: SyntaxTree.ComplexValue);
  772. BEGIN
  773. IF (x.realValue = 0) & (x.imagValue = 1) THEN
  774. w.String("IMAG")
  775. ELSE
  776. w.String("(");
  777. FormatedFloat(x.realValue, x.subtype) ;
  778. w.String(" ");
  779. IF x.imagValue > 0 THEN w.String("+") END;
  780. FormatedFloat(x.imagValue, x.subtype);
  781. w.String("*IMAG)")
  782. END
  783. END VisitComplexValue;
  784. PROCEDURE VisitStringValue(x: SyntaxTree.StringValue);
  785. VAR i: LONGINT; ch: CHAR;
  786. BEGIN
  787. i := 0;
  788. w.Char('\');
  789. w.Char('"');
  790. WHILE (i < LEN( x.value )) & (x.value[i] # 0X) DO
  791. ch := x.value[i];
  792. IF ch = Scanner.CR THEN w.String("\n")
  793. ELSIF ch = Scanner.LF THEN (* ignore *)
  794. ELSIF ch = Scanner.TAB THEN w.String("\t")
  795. ELSIF ch = '\' THEN w.String("\\")
  796. ELSIF ch = '"' THEN w.String(\"""\); (* " *)
  797. ELSE w.Char(ch)
  798. END;
  799. INC( i );
  800. END;
  801. w.Char('"');
  802. w.Char('\');
  803. END VisitStringValue;
  804. PROCEDURE VisitNilValue(x: SyntaxTree.NilValue);
  805. BEGIN IF case = Scanner.Lowercase THEN w.String( "nil" ); ELSE w.String( "NIL" ); END; IF info THEN BeginComment; Type(x.type); EndComment; END;
  806. END VisitNilValue;
  807. PROCEDURE VisitEnumerationValue(x: SyntaxTree.EnumerationValue);
  808. BEGIN w.Int(x.value,1);
  809. END VisitEnumerationValue;
  810. (**** symbols ****)
  811. PROCEDURE Symbol*(x: SyntaxTree.Symbol);
  812. BEGIN
  813. IF x = NIL THEN
  814. AlertString("nil symbol");
  815. ELSE
  816. x.Accept(SELF);
  817. END
  818. END Symbol;
  819. PROCEDURE VisitSymbol(x: SyntaxTree.Symbol);
  820. BEGIN
  821. AlertString("InvalidSymbol");
  822. END VisitSymbol;
  823. PROCEDURE Visible(symbol: SyntaxTree.Symbol): BOOLEAN;
  824. BEGIN
  825. RETURN TRUE (* (SyntaxTree.Public * symbol.access # {}) OR (mode > SymbolFile) *)
  826. (* using only exported symbols does not work since there might be dependencies ... *)
  827. END Visible;
  828. PROCEDURE PrintSymbol(x: SyntaxTree.Symbol);
  829. BEGIN
  830. IF x IS SyntaxTree.Operator THEN
  831. w.String('"');Identifier(x.name); w.String('"')
  832. ELSE
  833. Identifier(x.name)
  834. END;
  835. IF SyntaxTree.PublicWrite IN x.access THEN w.String( "*" )
  836. ELSIF SyntaxTree.PublicRead IN x.access THEN w.String( "-" )
  837. ELSIF x.access = {} THEN ASSERT(mode > SourceCode);
  838. IF info THEN BeginComment; w.String("<- hidden"); EndComment END;
  839. END;
  840. IF x.externalName # NIL THEN
  841. Keyword(" EXTERN " ); w.Char('"');
  842. w.String(x.externalName^); w.Char('"');
  843. END;
  844. IF info THEN
  845. BeginComment;
  846. w.String("access= {");
  847. Access(x.access);
  848. w.String("}");
  849. IF x.offsetInBits # MIN(LONGINT) THEN
  850. w.String("@"); w.Hex(x.offsetInBits,1);
  851. END;
  852. IF x.type # NIL THEN
  853. IF x.type.resolved.alignmentInBits >=0 THEN
  854. w.String("@@"); w.Hex(x.type.resolved.alignmentInBits,1);
  855. END;
  856. END;
  857. EndComment;
  858. END;
  859. END PrintSymbol;
  860. PROCEDURE VisitTypeDeclaration(x: SyntaxTree.TypeDeclaration);
  861. BEGIN
  862. IF Visible(x) THEN
  863. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  864. Comments(x.comment,x,FALSE);
  865. PrintSymbol(x);
  866. w.String(" = ");
  867. IF x.access # SyntaxTree.Hidden THEN
  868. Type(x.declaredType);
  869. ELSE ShortType(x.declaredType)
  870. END;
  871. Comments(x.comment,x,TRUE);
  872. END;
  873. END;
  874. END VisitTypeDeclaration;
  875. PROCEDURE TypeDeclarationList(x: SyntaxTree.TypeDeclaration);
  876. BEGIN
  877. Indent;
  878. Keyword("TYPE " );
  879. w.IncIndent;
  880. WHILE(x # NIL) DO
  881. Indent;
  882. Symbol(x);
  883. w.String( "; " );
  884. x := x.nextTypeDeclaration;
  885. IF x # NIL THEN w.Ln END;
  886. END;
  887. w.DecIndent;
  888. END TypeDeclarationList;
  889. PROCEDURE VisitConstant(x: SyntaxTree.Constant);
  890. BEGIN
  891. IF Visible(x) THEN
  892. IF (mode > SourceCode) OR (x.access # SyntaxTree.Hidden) THEN
  893. Comments(x.comment,x,FALSE);
  894. PrintSymbol(x);
  895. IF x.value # NIL THEN
  896. w.String( " = " ); Expression(x.value);
  897. END;
  898. IF info THEN BeginComment; ShortType(x.type); EndComment; END;
  899. IF info & (x.value.resolved = NIL) THEN AlertString("(*NOT A CONSTANT*)") END;
  900. Comments(x.comment,x,TRUE);
  901. END;
  902. END;
  903. END VisitConstant;
  904. PROCEDURE ConstantList(x: SyntaxTree.Constant);
  905. BEGIN
  906. Indent; Keyword("CONST " );
  907. w.IncIndent;
  908. WHILE(x # NIL) DO
  909. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  910. Indent;
  911. Symbol(x);
  912. w.String( "; " );
  913. END;
  914. x := x.nextConstant;
  915. END;
  916. w.DecIndent;
  917. END ConstantList;
  918. PROCEDURE VisitVariable(x: SyntaxTree.Variable);
  919. BEGIN
  920. IF Visible(x) THEN
  921. IF (x.access # SyntaxTree.Hidden) THEN
  922. Comments(x.comment,x,FALSE);
  923. PrintSymbol(x);
  924. IF x.modifiers # NIL THEN w.String(" "); Modifiers(x.modifiers); END;
  925. IF x.initializer # NIL THEN
  926. w.String( " := " ); Expression (x.initializer);
  927. END;
  928. w.String( ": " );
  929. Type(x.type);
  930. Comments(x.comment,x,TRUE);
  931. ELSIF mode>SourceCode THEN
  932. Comments(x.comment,x,FALSE);
  933. PrintSymbol(x);
  934. IF x.initializer # NIL THEN
  935. w.String( " := " ); Expression (x.initializer);
  936. END;
  937. Comments(x.comment,x,TRUE);
  938. END
  939. END;
  940. END VisitVariable;
  941. PROCEDURE VariableList(x: SyntaxTree.Variable);
  942. VAR next: SyntaxTree.Variable;
  943. PROCEDURE Flags(x: SyntaxTree.Variable);
  944. VAR first: BOOLEAN;
  945. BEGIN
  946. first := TRUE;
  947. IF x.fixed THEN
  948. Value(Global.NameFixed,x.alignment,first)
  949. ELSIF x.alignment > 1 THEN
  950. Value(Global.NameAligned,x.alignment,first)
  951. ELSIF x.fictive THEN
  952. Value(Global.NameFictive, x.fictiveOffset, first);
  953. END;
  954. IF x.untraced THEN
  955. Flag(Global.NameUntraced,first)
  956. END;
  957. FlagEnd(first);
  958. END Flags;
  959. BEGIN
  960. w.IncIndent;
  961. WHILE(x # NIL) DO
  962. next := x.nextVariable;
  963. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  964. Indent;
  965. Comments(x.comment, x, FALSE);
  966. PrintSymbol(x); Flags(x);
  967. WHILE(next # NIL) & (next.type = x.type) & ((next.access # SyntaxTree.Hidden) OR (mode > SourceCode)) DO
  968. w.String(", "); PrintSymbol(next); Flags(next);
  969. next := next.nextVariable;
  970. END;
  971. IF x.access # SyntaxTree.Hidden THEN
  972. w.String(": ");
  973. Type(x.type);
  974. ELSE
  975. w.String(": ");
  976. ShortType(x.type);
  977. END;
  978. w.String("; ");
  979. Comments(x.comment,x, TRUE);
  980. END;
  981. x := next;
  982. END;
  983. w.DecIndent
  984. END VariableList;
  985. PROCEDURE VisitParameter(x: SyntaxTree.Parameter);
  986. BEGIN
  987. IF (x.access # SyntaxTree.Hidden) THEN
  988. Comments(x.comment,x,TRUE);
  989. IF x.kind = SyntaxTree.VarParameter THEN Keyword("VAR " );
  990. ELSIF x.kind = SyntaxTree.ConstParameter THEN Keyword("CONST " );
  991. END;
  992. PrintSymbol(x);
  993. IF x.modifiers # NIL THEN w.String(" "); Modifiers(x.modifiers); END;
  994. IF x.defaultValue # NIL THEN
  995. w.String("= "); Expression(x.defaultValue);
  996. END;
  997. w.String( ": " );
  998. Type(x.type);
  999. Comments(x.comment,x,TRUE);
  1000. ELSIF (mode > SourceCode) THEN
  1001. Comments(x.comment,x,FALSE);
  1002. PrintSymbol(x);
  1003. Comments(x.comment,x,TRUE);
  1004. END;
  1005. END VisitParameter;
  1006. PROCEDURE ParameterList*(x: SyntaxTree.Parameter);
  1007. VAR next: SyntaxTree.Parameter; first: BOOLEAN;
  1008. PROCEDURE Flags(x: SyntaxTree.Parameter);
  1009. VAR first: BOOLEAN;
  1010. BEGIN
  1011. IF x.modifiers # NIL THEN
  1012. Modifiers(x.modifiers)
  1013. ELSE
  1014. first := TRUE;
  1015. IF x.untraced THEN
  1016. Flag(Global.NameUntraced,first)
  1017. END;
  1018. FlagEnd(first);
  1019. END;
  1020. END Flags;
  1021. BEGIN
  1022. first := TRUE;
  1023. w.String( "(" );
  1024. WHILE(x # NIL) DO
  1025. next := x.nextParameter;
  1026. IF (x.access # SyntaxTree.Hidden) OR (mode > SourceCode) THEN
  1027. IF ~first THEN w.String("; ") END;
  1028. first := FALSE;
  1029. IF x.kind = SyntaxTree.VarParameter THEN Keyword("VAR " );
  1030. ELSIF x.kind = SyntaxTree.ConstParameter THEN Keyword("CONST " );
  1031. END;
  1032. PrintSymbol(x); Flags(x);
  1033. IF x.defaultValue # NIL THEN
  1034. w.String("= "); Expression(x.defaultValue);
  1035. END;
  1036. WHILE (next # NIL) & (next.type = x.type) & (next.kind = x.kind) & ((next.access # SyntaxTree.Hidden) OR (mode > SourceCode)) DO
  1037. w.String(", ");
  1038. PrintSymbol(next); Flags(next);
  1039. IF next.defaultValue # NIL THEN
  1040. w.String("= "); Expression(next.defaultValue);
  1041. END;
  1042. next := next.nextParameter;
  1043. END;
  1044. IF x.access # SyntaxTree.Hidden THEN
  1045. w.String(": ");
  1046. Type(x.type);
  1047. ELSE
  1048. w.String(": ");
  1049. ShortType(x.type);
  1050. END;
  1051. END;
  1052. x := next;
  1053. END;
  1054. w.String( ")" );
  1055. END ParameterList;
  1056. PROCEDURE Access(access: SET);
  1057. BEGIN
  1058. IF SyntaxTree.PublicWrite IN access THEN w.String(" PublicWrite") END;
  1059. IF SyntaxTree.ProtectedWrite IN access THEN w.String(" ProtectedWrite") END;
  1060. IF SyntaxTree.InternalWrite IN access THEN w.String(" InternalWrite") END;
  1061. IF SyntaxTree.PublicRead IN access THEN w.String(" PublicRead") END;
  1062. IF SyntaxTree.ProtectedRead IN access THEN w.String(" ProtectedRead") END;
  1063. IF SyntaxTree.InternalRead IN access THEN w.String(" InternalRead") END;
  1064. END Access;
  1065. PROCEDURE VisitProcedure(x: SyntaxTree.Procedure);
  1066. VAR type: SyntaxTree.ProcedureType; first: BOOLEAN; fp: SyntaxTree.FingerPrint;
  1067. BEGIN
  1068. IF Visible(x) THEN
  1069. Indent;
  1070. Comments(x.comment,x,FALSE);
  1071. Keyword("PROCEDURE " );
  1072. IF (mode = SymbolFile) & ~x.isInline & ~x.isOberonInline THEN
  1073. w.String("^ ");
  1074. END;
  1075. (*
  1076. CallingConvention(x.type(SyntaxTree.ProcedureType).callingConvention);
  1077. *)
  1078. type := x.type(SyntaxTree.ProcedureType);
  1079. (*
  1080. flags := type.flags;
  1081. *)
  1082. first := TRUE;
  1083. IF type.stackAlignment > 1 THEN Value(Global.NameStackAligned,type.stackAlignment,first) END;
  1084. IF (type.isRealtime) THEN Flag(Global.NameRealtime,first) END;
  1085. IF (type.noReturn) THEN Flag(Global.NameNoReturn,first) END;
  1086. IF (x.fixed) THEN Value(Global.NameFixed, x.alignment,first)
  1087. ELSIF (x.alignment >1) THEN Value(Global.NameAligned, x.alignment, first)
  1088. END;
  1089. IF type.callingConvention = SyntaxTree.WinAPICallingConvention THEN
  1090. Flag(Global.NameWinAPI,first)
  1091. ELSIF type.callingConvention = SyntaxTree.CCallingConvention THEN
  1092. Flag(Global.NameC,first)
  1093. END;
  1094. IF x.isInline & (mode = SymbolFile) THEN
  1095. IF fingerPrinter = NIL THEN NEW(fingerPrinter) END;
  1096. fp := fingerPrinter.SymbolFP(x);
  1097. Value(Global.NameFingerprint, fp.shallow, first)
  1098. END;
  1099. FlagEnd(first);
  1100. IF x.isInline OR x.isOberonInline THEN w.String(" - ") END;
  1101. IF x.isConstructor THEN w.String(" & ") END;
  1102. IF x.isFinalizer THEN w.String(" ~ ") END;
  1103. IF type.selfParameter # NIL THEN
  1104. ParameterList(type.selfParameter);
  1105. END;
  1106. IF info THEN
  1107. BeginComment;
  1108. Modifiers(x.type(SyntaxTree.ProcedureType).modifiers);
  1109. EndComment;
  1110. END;
  1111. PrintSymbol(x);
  1112. IF (type.firstParameter # NIL) OR (type.returnType # NIL ) THEN (* print parentheses only if not parameterless procedure *)
  1113. ParameterList(type.firstParameter);
  1114. END;
  1115. IF type.returnType # NIL THEN
  1116. w.String( ": " );
  1117. IF type.hasUntracedReturn THEN
  1118. first := TRUE;
  1119. Flag(Global.NameUntraced, first);
  1120. FlagEnd(first);
  1121. END;
  1122. Type(type.returnType);
  1123. END;
  1124. IF info & (type.returnParameter # NIL) THEN
  1125. BeginComment;
  1126. w.String("retPar = ");
  1127. Symbol(type.returnParameter);
  1128. EndComment;
  1129. END;
  1130. IF x.externalName = NIL THEN
  1131. IF (mode > SymbolFile) OR (mode = SymbolFile) & (x.isInline OR x.isOberonInline) THEN
  1132. w.String( ";" );
  1133. Comments(x.comment,x,TRUE);
  1134. IF (mode >= SymbolFile) OR x.isOberonInline THEN
  1135. ProcedureScope(x.procedureScope);
  1136. END;
  1137. Indent; Keyword("END " ); Identifier(x.name);
  1138. END;
  1139. END;
  1140. END;
  1141. END VisitProcedure;
  1142. PROCEDURE VisitOperator(x: SyntaxTree.Operator);
  1143. VAR type: SyntaxTree.ProcedureType;
  1144. recordType: SyntaxTree.RecordType;
  1145. i: LONGINT;
  1146. valid, first: BOOLEAN;
  1147. BEGIN
  1148. IF Visible(x) THEN
  1149. Indent;
  1150. Comments(x.comment,x,FALSE);
  1151. (* mark array access operators for array-structured object types *)
  1152. IF info THEN
  1153. IF (x.scope # NIL) & (x.scope IS SyntaxTree.RecordScope) THEN
  1154. recordType := x.scope(SyntaxTree.RecordScope).ownerRecord;
  1155. IF recordType.HasArrayStructure() THEN
  1156. BeginComment;
  1157. valid := FALSE;
  1158. IF x = recordType.arrayAccessOperators.len THEN w.String("the length operator: "); valid := TRUE;
  1159. ELSIF x = recordType.arrayAccessOperators.generalRead THEN w.String("the general read operator"); valid := TRUE;
  1160. ELSIF x = recordType.arrayAccessOperators.generalWrite THEN w.String("the general write operator"); valid := TRUE;
  1161. ELSE
  1162. FOR i := 0 TO LEN(recordType.arrayAccessOperators.read, 0) - 1 DO
  1163. IF x = recordType.arrayAccessOperators.read[i] THEN w.String("a read operator (hash="); w.Int(i, 1); w.String("):"); valid := TRUE;
  1164. ELSIF x = recordType.arrayAccessOperators.write[i] THEN w.String("a write operator (hash="); w.Int(i, 1); w.String("):"); valid := TRUE;
  1165. END
  1166. END
  1167. END;
  1168. IF ~valid THEN w.String("an invalid operator:") END;
  1169. EndComment;
  1170. w.String(" ");
  1171. END
  1172. END
  1173. END;
  1174. Keyword("OPERATOR ");
  1175. first := TRUE;
  1176. IF x.isInline OR x.isOberonInline THEN
  1177. ASSERT(~x.isDynamic);
  1178. w.String("-");
  1179. ELSE
  1180. IF mode = SymbolFile THEN w.String("^ ") END;
  1181. IF x.isDynamic THEN Flag(Global.NameDynamic, first) END;
  1182. IF ~first THEN w.String("}") END;
  1183. END;
  1184. type := x.type(SyntaxTree.ProcedureType);
  1185. PrintSymbol(x);
  1186. ParameterList(type.firstParameter);
  1187. IF type.returnType # NIL THEN
  1188. w.String( ": " );
  1189. IF type.hasUntracedReturn THEN
  1190. first := TRUE;
  1191. Flag(Global.NameUntraced, first);
  1192. FlagEnd(first);
  1193. END;
  1194. Type(type.returnType);
  1195. END;
  1196. IF info & (type.returnParameter # NIL) THEN
  1197. BeginComment;
  1198. (*w.String("retPar = ");*) (*! this is present in VisitProcedure - should it be present here as well??? *)
  1199. Symbol(type.returnParameter);
  1200. EndComment;
  1201. END;
  1202. IF x.externalName = NIL THEN
  1203. IF (mode > SymbolFile) OR (mode = SymbolFile) & (x.isInline OR x.isOberonInline) THEN
  1204. w.String( ";" );
  1205. Comments(x.comment,x,TRUE);
  1206. IF mode >= SymbolFile THEN
  1207. ProcedureScope(x.procedureScope);
  1208. END;
  1209. Indent; Keyword("END " ); w.String( '"' ); Identifier(x.name); w.String( '"' );
  1210. END;
  1211. END;
  1212. END
  1213. END VisitOperator;
  1214. PROCEDURE ProcedureList(list: SyntaxTree.ProcedureList);
  1215. VAR x: SyntaxTree.Procedure; i: LONGINT;
  1216. BEGIN
  1217. w.IncIndent;
  1218. FOR i := 0 TO list.Length()-1 DO
  1219. x := list.GetProcedure(i);
  1220. IF (x.access # SyntaxTree.Hidden) & ~(x.isBodyProcedure) OR (mode > SourceCode) THEN
  1221. Symbol(x);
  1222. w.String( "; " );
  1223. END;
  1224. IF (i# list.Length()-1) & (mode > SymbolFile) & ((x.access # SyntaxTree.Hidden) OR (mode > SourceCode)) THEN w.Ln END;
  1225. END;
  1226. w.DecIndent;
  1227. END ProcedureList;
  1228. PROCEDURE VisitImport(x: SyntaxTree.Import);
  1229. VAR context: SyntaxTree.Identifier;
  1230. BEGIN
  1231. IF x.moduleName # x.name THEN Identifier(x.name); w.String( " := " ); END;
  1232. IF (x.scope = NIL) OR (x.scope.ownerModule = NIL) THEN context := SyntaxTree.invalidIdentifier ELSE context := x.scope.ownerModule.context END;
  1233. Identifier(x.moduleName);
  1234. IF (x.context # SyntaxTree.invalidIdentifier) & (x.context#context) THEN
  1235. w.String(" IN ");
  1236. Identifier(x.context)
  1237. END;
  1238. END VisitImport;
  1239. PROCEDURE ImportList(x: SyntaxTree.Import);
  1240. VAR first: BOOLEAN;
  1241. BEGIN
  1242. first := TRUE;
  1243. WHILE(x # NIL) DO
  1244. IF x.direct & (x.module # NIL) OR (mode > SymbolFile) THEN
  1245. IF ~first THEN w.String(", ") ELSE Indent; Keyword("IMPORT "); first := FALSE END;
  1246. Symbol(x);
  1247. END;
  1248. x := x.nextImport;
  1249. END;
  1250. IF ~first THEN w.String( ";" ); END;
  1251. END ImportList;
  1252. PROCEDURE VisitBuiltin(x: SyntaxTree.Builtin);
  1253. BEGIN
  1254. Indent; Keyword("BUILTIN ");
  1255. Identifier(x.name);
  1256. END VisitBuiltin;
  1257. PROCEDURE BuiltinList(x: SyntaxTree.Builtin);
  1258. BEGIN
  1259. WHILE(x # NIL) DO
  1260. VisitBuiltin(x);
  1261. x := x.nextBuiltin;
  1262. END;
  1263. END BuiltinList;
  1264. PROCEDURE BeginComment;
  1265. BEGIN
  1266. w.BeginComment; w.String("(*");
  1267. END BeginComment;
  1268. PROCEDURE EndComment;
  1269. BEGIN
  1270. w.String("*)");w.EndComment
  1271. END EndComment;
  1272. PROCEDURE Comment(x: SyntaxTree.Comment);
  1273. VAR i: LONGINT; ch: CHAR;
  1274. BEGIN
  1275. BeginComment;
  1276. WHILE (i<LEN(x.source^)) & (x.source[i] # 0X) DO
  1277. ch := x.source[i];
  1278. IF ch = 0DX THEN w.Ln
  1279. ELSE w.Char(ch)
  1280. END;
  1281. INC(i);
  1282. END;
  1283. EndComment;
  1284. END Comment;
  1285. PROCEDURE Comments(c: SyntaxTree.Comment; x: ANY; sameLine: BOOLEAN);
  1286. BEGIN
  1287. IF mode >= SourceCode THEN
  1288. WHILE (c # NIL) & (c.item = x) DO
  1289. IF c.sameLine = sameLine THEN
  1290. Comment(c);
  1291. IF ~sameLine THEN
  1292. Indent;
  1293. END;
  1294. END;
  1295. c := c.nextComment;
  1296. END;
  1297. END;
  1298. END Comments;
  1299. PROCEDURE CommentList(x: SyntaxTree.Comment);
  1300. BEGIN
  1301. IF info THEN
  1302. WHILE (x#NIL) DO
  1303. Indent;
  1304. w.String("comment at position "); w.Int(x.position.start,1);
  1305. IF x.sameLine THEN w.String("(in line with item)") END;
  1306. IF x.item = NIL THEN w.String("(no item)"); END;
  1307. w.String(":");
  1308. Comment(x);
  1309. x := x.nextComment;
  1310. END;
  1311. END;
  1312. END CommentList;
  1313. (*** scopes ****)
  1314. PROCEDURE Scope*(x: SyntaxTree.Scope);
  1315. VAR prevScope: SyntaxTree.Scope;
  1316. BEGIN
  1317. prevScope := currentScope;
  1318. currentScope := x;
  1319. (* ASSERT(currentScope.outerScope = prevScope); (* sanity check *) *)
  1320. WITH x: SyntaxTree.CellScope DO
  1321. IF x.firstImport # NIL THEN ImportList(x.firstImport) END;
  1322. ELSE
  1323. END;
  1324. IF x.firstConstant # NIL THEN ConstantList(x.firstConstant); END;
  1325. IF x.firstTypeDeclaration # NIL THEN TypeDeclarationList(x.firstTypeDeclaration); END;
  1326. IF x.firstVariable # NIL THEN Indent; Keyword("VAR " ); VariableList(x.firstVariable); END;
  1327. IF x.procedures # NIL THEN w.Ln; ProcedureList(x.procedures) END;
  1328. currentScope := prevScope;
  1329. END Scope;
  1330. PROCEDURE ProcedureScope(x: SyntaxTree.ProcedureScope);
  1331. VAR prevScope: SyntaxTree.Scope;
  1332. BEGIN
  1333. prevScope := currentScope;
  1334. currentScope := x;
  1335. IF (mode >= SourceCode) OR (x.ownerProcedure.isInline) OR (x.ownerProcedure.isOberonInline) THEN
  1336. Scope(x);
  1337. END;
  1338. IF (mode >= SymbolFile) & (x.body # NIL) THEN Body(x.body, (mode >= SourceCode) OR (x.ownerProcedure.isInline) OR (x.ownerProcedure.isOberonInline) ) END;
  1339. currentScope := prevScope;
  1340. END ProcedureScope;
  1341. PROCEDURE Statement*(x: SyntaxTree.Statement);
  1342. BEGIN
  1343. IF x = NIL THEN
  1344. AlertString("nil statement")
  1345. ELSE
  1346. Comments(x.comment, x, FALSE);
  1347. x.Accept(SELF);
  1348. Comments(x.comment,x,TRUE);
  1349. END
  1350. END Statement;
  1351. PROCEDURE StatementSequence*(x: SyntaxTree.StatementSequence);
  1352. VAR statement: SyntaxTree.Statement; i: LONGINT;
  1353. BEGIN
  1354. IF singleStatement THEN
  1355. w.String("...")
  1356. ELSE
  1357. FOR i := 0 TO x.Length() - 1 DO
  1358. statement := x.GetStatement( i );
  1359. Indent; Statement(statement);
  1360. IF i < x.Length() - 1 THEN w.String( "; " ); END;
  1361. END;
  1362. END;
  1363. END StatementSequence;
  1364. PROCEDURE VisitStatement(x: SyntaxTree.Statement);
  1365. BEGIN
  1366. AlertString("InvalidStatement");
  1367. END VisitStatement;
  1368. PROCEDURE VisitProcedureCallStatement(x: SyntaxTree.ProcedureCallStatement);
  1369. BEGIN Expression(x.call) END VisitProcedureCallStatement;
  1370. PROCEDURE VisitAssignment(x: SyntaxTree.Assignment);
  1371. BEGIN
  1372. Expression(x.left); w.String( " := " ); Expression(x.right);
  1373. END VisitAssignment;
  1374. PROCEDURE VisitCommunicationStatement(x: SyntaxTree.CommunicationStatement);
  1375. VAR identifier: SyntaxTree.Identifier;
  1376. BEGIN
  1377. Expression(x.left);
  1378. identifier := Global.GetIdentifier(x.op,case);
  1379. w.String(" "); Identifier(identifier); w.String(" ");
  1380. Expression(x.right);
  1381. END VisitCommunicationStatement;
  1382. PROCEDURE IfPart(x: SyntaxTree.IfPart);
  1383. BEGIN
  1384. Comments(x.comment, x, FALSE);
  1385. Keyword("IF " );
  1386. Expression(x.condition);
  1387. Keyword(" THEN " );
  1388. Comments(x.comment,x,TRUE);
  1389. w.IncIndent;
  1390. StatementSequence(x.statements);
  1391. w.DecIndent;
  1392. END IfPart;
  1393. PROCEDURE VisitIfStatement(x: SyntaxTree.IfStatement);
  1394. VAR i: LONGINT; elsif: SyntaxTree.IfPart;
  1395. BEGIN
  1396. IfPart(x.ifPart);
  1397. FOR i := 0 TO x.ElsifParts() - 1 DO
  1398. elsif := x.GetElsifPart( i );
  1399. Indent; Keyword("ELS");
  1400. IfPart(elsif);
  1401. END;
  1402. IF x.elsePart # NIL THEN
  1403. Indent; Keyword("ELSE" );
  1404. w.IncIndent;
  1405. StatementSequence(x.elsePart);
  1406. w.DecIndent;
  1407. END;
  1408. Indent; Keyword("END" );
  1409. END VisitIfStatement;
  1410. PROCEDURE WithPart(x: SyntaxTree.WithPart);
  1411. BEGIN
  1412. Comments(x.comment, x, FALSE);
  1413. Expression(x.variable);
  1414. w.String(" : ");
  1415. Type(x.type);
  1416. Keyword(" DO " );
  1417. Comments(x.comment,x, TRUE);
  1418. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1419. END WithPart;
  1420. PROCEDURE VisitWithStatement(x: SyntaxTree.WithStatement);
  1421. VAR i: LONGINT;
  1422. BEGIN
  1423. Indent; Keyword("WITH " );
  1424. WithPart(x.GetWithPart(0));
  1425. FOR i := 1 TO x.WithParts()-1 DO
  1426. Indent; w.String("| ");
  1427. WithPart(x.GetWithPart(i));
  1428. END;
  1429. IF x.elsePart # NIL THEN
  1430. Indent; w.String("ELSE ");
  1431. w.IncIndent; StatementSequence(x.elsePart); w.DecIndent;
  1432. END;
  1433. Indent; Keyword("END" );
  1434. END VisitWithStatement;
  1435. PROCEDURE CasePart(x: SyntaxTree.CasePart);
  1436. VAR case: SyntaxTree.CaseConstant;
  1437. BEGIN
  1438. Comments(x.comment, x, FALSE);
  1439. ExpressionList(x.elements);
  1440. IF info THEN
  1441. w.BeginComment;
  1442. case := x.firstConstant;
  1443. WHILE(case # NIL) DO
  1444. IF case # x.firstConstant THEN w.String(",") END;
  1445. w.Int(case.min,1); w.String(".."); w.Int(case.max,1);
  1446. case := case.next;
  1447. END;
  1448. EndComment;
  1449. END;
  1450. w.String( ":" );
  1451. Comments(x.comment,x,TRUE);
  1452. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1453. END CasePart;
  1454. PROCEDURE VisitCaseStatement(x: SyntaxTree.CaseStatement);
  1455. VAR i: LONGINT; case: SyntaxTree.CasePart;
  1456. BEGIN
  1457. Keyword("CASE " );
  1458. Expression(x.variable);
  1459. Keyword(" OF " );
  1460. FOR i := 0 TO x.CaseParts() - 1 DO
  1461. case := x.GetCasePart( i );
  1462. Indent;
  1463. w.String( "| " );
  1464. CasePart(case);
  1465. END;
  1466. IF x.elsePart # NIL THEN
  1467. Indent;
  1468. Keyword("ELSE" );
  1469. w.IncIndent;
  1470. StatementSequence(x.elsePart);
  1471. w.DecIndent;
  1472. END;
  1473. Indent;
  1474. Keyword("END" );
  1475. END VisitCaseStatement;
  1476. PROCEDURE VisitWhileStatement(x: SyntaxTree.WhileStatement);
  1477. BEGIN
  1478. Keyword("WHILE " );
  1479. Expression(x.condition);
  1480. Keyword(" DO " );
  1481. w.IncIndent;
  1482. StatementSequence(x.statements);
  1483. w.DecIndent;
  1484. Indent;
  1485. Keyword("END" );
  1486. END VisitWhileStatement;
  1487. PROCEDURE VisitRepeatStatement(x: SyntaxTree.RepeatStatement);
  1488. BEGIN
  1489. Keyword("REPEAT " );
  1490. w.IncIndent;
  1491. StatementSequence(x.statements);
  1492. w.DecIndent;
  1493. Indent; Keyword("UNTIL " );
  1494. Expression(x.condition);
  1495. END VisitRepeatStatement;
  1496. PROCEDURE VisitForStatement(x: SyntaxTree.ForStatement);
  1497. BEGIN
  1498. Keyword("FOR " );
  1499. Expression(x.variable);
  1500. w.String( " := " );
  1501. Expression(x.from);
  1502. Keyword(" TO " );
  1503. Expression(x.to);
  1504. IF x.by # NIL THEN
  1505. Keyword(" BY " );
  1506. Expression(x.by);
  1507. END;
  1508. Keyword(" DO " );
  1509. w.IncIndent;
  1510. StatementSequence(x.statements);
  1511. w.DecIndent;
  1512. Indent;
  1513. Keyword("END" );
  1514. END VisitForStatement;
  1515. PROCEDURE VisitLoopStatement(x: SyntaxTree.LoopStatement);
  1516. BEGIN
  1517. Keyword("LOOP " );
  1518. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1519. Indent; Keyword("END" );
  1520. END VisitLoopStatement;
  1521. PROCEDURE VisitExitableBlock(x: SyntaxTree.ExitableBlock);
  1522. BEGIN
  1523. Keyword("EXITABLE " );
  1524. w.IncIndent; StatementSequence(x.statements); w.DecIndent;
  1525. Indent; Keyword("END " );
  1526. END VisitExitableBlock;
  1527. PROCEDURE VisitExitStatement(x: SyntaxTree.ExitStatement);
  1528. BEGIN Keyword("EXIT" ) END VisitExitStatement;
  1529. PROCEDURE VisitReturnStatement(x: SyntaxTree.ReturnStatement);
  1530. BEGIN
  1531. Keyword("RETURN " );
  1532. IF x.returnValue # NIL THEN Expression(x.returnValue) END
  1533. END VisitReturnStatement;
  1534. PROCEDURE VisitAwaitStatement(x: SyntaxTree.AwaitStatement);
  1535. BEGIN
  1536. Keyword("AWAIT (" ); Expression(x.condition); w.String( ")" );
  1537. END VisitAwaitStatement;
  1538. PROCEDURE Modifiers(x: SyntaxTree.Modifier);
  1539. VAR name: Scanner.IdentifierString; first: BOOLEAN;
  1540. BEGIN
  1541. first := TRUE;
  1542. WHILE x # NIL DO
  1543. IF first THEN w.String("{"); first := FALSE ELSE w.String(", ") END;
  1544. Basic.GetString(x.identifier,name);
  1545. w.String(name);
  1546. IF x.expression # NIL THEN
  1547. w.String("(");
  1548. Expression(x.expression);
  1549. w.String(")");
  1550. END;
  1551. x := x.nextModifier;
  1552. END;
  1553. IF ~first THEN w.String("} ") END;
  1554. END Modifiers;
  1555. (*
  1556. PROCEDURE BlockModifier(x: SyntaxTree.StatementBlock);
  1557. VAR first: BOOLEAN;
  1558. PROCEDURE Comma;
  1559. BEGIN
  1560. IF first THEN first := FALSE ELSE w.String(", "); END;
  1561. END Comma;
  1562. BEGIN
  1563. first := TRUE;
  1564. IF x.flags # {} THEN
  1565. w.String("{");
  1566. IF SyntaxTree.ActiveFlag IN x.flags THEN Comma; w.String("ACTIVE") END;
  1567. IF SyntaxTree.PriorityFlag IN x.flags THEN Comma; w.String("PRIORITY("); Expression(x(SyntaxTree.Body).priority); w.String(")"); first := FALSE; END;
  1568. IF SyntaxTree.SafeFlag IN x.flags THEN Comma; w.String("SAFE") END;
  1569. IF SyntaxTree.ExclusiveFlag IN x.flags THEN Comma; w.String("EXCLUSIVE") END;
  1570. w.String("}");
  1571. END;
  1572. END BlockModifier;
  1573. *)
  1574. PROCEDURE VisitStatementBlock(x: SyntaxTree.StatementBlock);
  1575. BEGIN
  1576. Keyword("BEGIN"); Modifiers(x.blockModifiers);
  1577. w.IncIndent;
  1578. IF x.statements # NIL THEN StatementSequence(x.statements); END;
  1579. w.DecIndent;
  1580. Indent; Keyword("END");
  1581. END VisitStatementBlock;
  1582. PROCEDURE Code(x: SyntaxTree.Code);
  1583. VAR i: LONGINT; ch: CHAR; cr: BOOLEAN; procedure: SyntaxTree.Procedure; procedureType: SyntaxTree.ProcedureType;
  1584. CONST CR=0DX;
  1585. BEGIN
  1586. IF (currentScope # NIL) & (currentScope IS SyntaxTree.ProcedureScope) THEN
  1587. procedure := currentScope(SyntaxTree.ProcedureScope).ownerProcedure;
  1588. procedureType := procedure.type(SyntaxTree.ProcedureType);
  1589. END;
  1590. IF (mode >= SourceCode) OR (procedure = NIL) OR (procedure.access * SyntaxTree.Public # {}) & (procedure.isInline OR procedure.isOberonInline) THEN
  1591. (*
  1592. IF x.inlineCode # NIL THEN
  1593. unit := 8;
  1594. w.String(" D"); w.Int(unit,1);
  1595. i := 0; size := x.inlineCode.GetSize();
  1596. WHILE i < size DO
  1597. value := x.inlineCode.GetBits(i,unit);
  1598. w.String(" "); w.Int(value,1);
  1599. INC(i,unit);
  1600. END;
  1601. ELS*)
  1602. IF (x.sourceCode # NIL) THEN
  1603. i := 0;
  1604. ch := x.sourceCode[0];
  1605. WHILE (ch # 0X) DO
  1606. IF ch = CR THEN
  1607. cr := TRUE;
  1608. ELSE
  1609. IF cr THEN Indent; cr := FALSE END;
  1610. w.Char(ch);
  1611. END;
  1612. INC(i); ch := x.sourceCode[i];
  1613. END;
  1614. END;
  1615. (*
  1616. IF x.inlineCode # NIL THEN
  1617. w.String("; ");
  1618. size := x.inlineCode.GetSize() DIV 8;
  1619. FOR i := 0 TO size-1 DO
  1620. value := x.inlineCode.GetBits(i*8,8);
  1621. w.Hex(value,-2); w.String(" ");
  1622. END;
  1623. END;
  1624. *)
  1625. END;
  1626. END Code;
  1627. PROCEDURE VisitCode(x: SyntaxTree.Code);
  1628. VAR in, out: BOOLEAN;
  1629. BEGIN
  1630. Indent; Keyword("CODE");
  1631. Code(x);
  1632. in := x.inRules.Length()>0;
  1633. out := x.outRules.Length() >0;
  1634. IF in OR out THEN
  1635. Indent; Keyword("WITH ");
  1636. IF in THEN
  1637. Indent; Keyword("IN "); StatementSequence(x.inRules)
  1638. END;
  1639. IF out THEN
  1640. Indent; Keyword("OUT "); StatementSequence(x.outRules)
  1641. END;
  1642. END;
  1643. Indent; Keyword("END");
  1644. END VisitCode;
  1645. PROCEDURE Body(x: SyntaxTree.Body; implementation: BOOLEAN);
  1646. VAR
  1647. BEGIN
  1648. IF x.code # NIL THEN
  1649. Indent; Keyword("CODE");
  1650. IF implementation THEN
  1651. Code(x.code);
  1652. END;
  1653. ELSE
  1654. Indent; Keyword("BEGIN" ); Modifiers(x.blockModifiers);
  1655. IF implementation THEN
  1656. IF x.statements # NIL THEN
  1657. w.IncIndent;
  1658. StatementSequence(x.statements);
  1659. w.DecIndent;
  1660. END;
  1661. IF x.finally # NIL THEN
  1662. Indent; Keyword("FINALLY" );
  1663. w.IncIndent;
  1664. StatementSequence(x.finally);
  1665. w.DecIndent
  1666. END;
  1667. END;
  1668. END;
  1669. (* "END" written by caller *)
  1670. END Body;
  1671. PROCEDURE Module*(x: SyntaxTree.Module);
  1672. BEGIN
  1673. IF x = NIL THEN
  1674. AlertString("(* no module *)");
  1675. ELSE
  1676. case := x.case;
  1677. currentScope := x.moduleScope.outerScope;
  1678. Comments(x.comment,x,FALSE);
  1679. Keyword("MODULE ");
  1680. Identifier(x.name);
  1681. IF (x.context # SyntaxTree.invalidIdentifier) & (x.context#Global.A2Name) THEN
  1682. w.String(" IN ");
  1683. Identifier(x.context)
  1684. END;
  1685. IF (x.type IS SyntaxTree.CellType) & (x.type(SyntaxTree.CellType).firstParameter # NIL) THEN (* for actors *)
  1686. ParameterList(x.type(SyntaxTree.CellType).firstParameter);
  1687. END;
  1688. w.String(";");
  1689. Comments(x.comment,x,TRUE);
  1690. w.IncIndent;
  1691. IF x.moduleScope.firstImport # NIL THEN
  1692. ImportList(x.moduleScope.firstImport)
  1693. END;
  1694. w.DecIndent;
  1695. Scope(x.moduleScope);
  1696. IF x.moduleScope.firstBuiltin # NIL THEN
  1697. BuiltinList(x.moduleScope.firstBuiltin)
  1698. END;
  1699. IF (x.moduleScope.bodyProcedure # NIL) & (x.moduleScope.bodyProcedure.procedureScope.body # NIL) THEN
  1700. Body(x.moduleScope.bodyProcedure.procedureScope.body, mode >= SourceCode)
  1701. END;
  1702. Indent; Keyword("END "); Identifier(x.name); w.String( "." ); w.Ln; w.Update;
  1703. Comments(x.closingComment,x, FALSE);
  1704. IF (mode > SourceCode) & (x.moduleScope.firstComment # NIL) THEN w.Ln; CommentList(x.moduleScope.firstComment) END;
  1705. END
  1706. END Module;
  1707. PROCEDURE SingleStatement*(b: BOOLEAN);
  1708. BEGIN singleStatement := b
  1709. END SingleStatement;
  1710. PROCEDURE &Init*(w: Streams.Writer; mode: LONGINT; info: BOOLEAN);
  1711. BEGIN
  1712. SELF.w := Basic.GetWriter(w);
  1713. SELF.mode := mode; NEW(ws,128); SELF.info := info; case := Scanner.Uppercase;
  1714. commentCount := 0; alertCount := 0; singleStatement := FALSE;
  1715. END Init;
  1716. END Printer;
  1717. (* debugging helper *)
  1718. VAR
  1719. debug: Printer;
  1720. PROCEDURE NewPrinter*(w: Streams.Writer; mode: LONGINT; info: BOOLEAN): Printer;
  1721. VAR p: Printer;
  1722. BEGIN
  1723. NEW(p,w,mode,info); RETURN p
  1724. END NewPrinter;
  1725. PROCEDURE Info*(CONST info: ARRAY OF CHAR; a: ANY);
  1726. VAR symbol: SyntaxTree.Symbol; scope: SyntaxTree.Scope;
  1727. BEGIN
  1728. debug.w := Basic.GetWriter(D.Log);
  1729. D.Ln;
  1730. D.Str(" --------> ");
  1731. D.Str(info);
  1732. D.Str(" ");
  1733. D.Hex(SYSTEM.VAL(LONGINT,a),8);
  1734. D.Str(" : ");
  1735. IF a = NIL THEN
  1736. D.Str("NIL");
  1737. ELSIF a IS SyntaxTree.Expression THEN
  1738. debug.Expression(a(SyntaxTree.Expression));
  1739. Info("with type",a(SyntaxTree.Expression).type);
  1740. ELSIF a IS SyntaxTree.Type THEN
  1741. IF a IS SyntaxTree.QualifiedType THEN
  1742. D.Str("[QualifiedType] ");
  1743. END;
  1744. debug.Type(a(SyntaxTree.Type))
  1745. ELSIF a IS SyntaxTree.Symbol THEN
  1746. debug.Symbol(a(SyntaxTree.Symbol))
  1747. ELSIF a IS SyntaxTree.Statement THEN
  1748. debug.Statement(a(SyntaxTree.Statement))
  1749. ELSIF a IS SyntaxTree.StatementSequence THEN
  1750. debug.StatementSequence(a(SyntaxTree.StatementSequence));
  1751. ELSIF a IS SyntaxTree.Scope THEN
  1752. scope := a(SyntaxTree.Scope);
  1753. WHILE(scope # NIL) DO
  1754. D.Ln; D.Str(" ");
  1755. IF scope IS SyntaxTree.ModuleScope THEN D.Str("ModuleScope: ")
  1756. ELSIF scope IS SyntaxTree.ProcedureScope THEN D.Str("ProcedureScope: ");
  1757. ELSIF scope IS SyntaxTree.RecordScope THEN D.Str("RecordScope: ");
  1758. ELSE D.Str("Scope: ");
  1759. END;
  1760. symbol := scope.firstSymbol;
  1761. WHILE(symbol # NIL) DO
  1762. debug.Identifier(symbol.name); D.Str(" ");
  1763. symbol := symbol.nextSymbol;
  1764. END;
  1765. scope := scope.outerScope;
  1766. END;
  1767. (*
  1768. ELSIF a IS SyntaxTree.Identifier THEN
  1769. debug.Identifier(a(SyntaxTree.Identifier));
  1770. *)
  1771. ELSIF a IS SyntaxTree.QualifiedIdentifier THEN
  1772. debug.QualifiedIdentifier(a(SyntaxTree.QualifiedIdentifier));
  1773. ELSIF a IS SyntaxTree.Module THEN
  1774. debug.Module(a(SyntaxTree.Module))
  1775. ELSE
  1776. debug.w.String("unknown");
  1777. END;
  1778. D.Update();
  1779. END Info;
  1780. PROCEDURE Init;
  1781. BEGIN
  1782. NEW(debug,D.Log,All,TRUE);
  1783. debug.case := Scanner.Uppercase;
  1784. END Init;
  1785. BEGIN
  1786. Init;
  1787. END FoxPrintout.