2 !% $MAX_STATIC_DATA=20000;
\r
4 ! =================================================================================================
\r
5 ! INSTRUCTOR -- reformat Inform source files -- Roger Firth (roger@firthworks.com)
\r
7 ! V1.2 11Oct04 - fixed support for dynamic Class declarations
\r
8 ! V1.1 29Jan04 - changed ReadSourceLine() to handle cross-platform End-Of-Line characters
\r
9 ! V1.0 13Nov03 - first public release
\r
11 ! This program is a pretty-printer -- it reads an Inform source file, and writes the same
\r
12 ! information, neatly formatted, to an output file (which must be DIFFERENT FROM the input file).
\r
13 ! Use it only on source files which compile without any errors.
\r
15 ! The program is a standalone Glulx utility which does not used the Inform library files.
\r
16 ! To compile it, you will need to include on the command line: $MAX_STATIC_DATA=20000
\r
17 ! and you will require the "infglk.h" header file. To run it, any Glulx interpreter should do.
\r
19 ! This program is copyright Roger Firth 2003-2004. Copying and distribution, with or without
\r
20 ! modification, are permitted in any medium without royalty provided the copyright notice and
\r
21 ! this notice are preserved.
\r
23 ! =================================================================================================
\r
24 ! These settings should be sufficient, but may need adjusting for an enormous game.
\r
26 Constant MAX_SOURCE 4100; ! Line of source input.
\r
27 Array theSource -> MAX_SOURCE;
\r
29 Constant MAX_STRING 4100; ! Double-quoted string.
\r
30 Array theString -> MAX_STRING;
\r
32 Constant MAX_OUTPUT 200; ! Line of source output.
\r
33 Array theOutput -> MAX_OUTPUT;
\r
35 Constant MAX_INPUT 50; ! Line of keyboard input.
\r
36 Array theInput -> MAX_INPUT;
\r
38 Constant MAX_TOKENS 2; ! Input tokens.
\r
39 Array TokenStart -> MAX_TOKENS;
\r
40 Array TokenEnd -> MAX_TOKENS;
\r
41 Array Tokens --> MAX_TOKENS; ! Command, optional numbers.
\r
44 Constant DEFAULT_INDENT 4; ! Tab size.
\r
45 Constant DEFAULT_COMMENT 40; ! Comment alignment;
\r
46 Constant DEFAULT_MARGIN 80; ! Wrap long lines.
\r
48 Constant fixBadSyntax = true; ! " to ' in name properties, etc.
\r
49 !Constant indentWithTabs = false; ! Leading spaces become tabs.
\r
51 ! =================================================================================================
\r
52 ! Since we're not using the Glulx Inform library files, we need to set up our own Glk
\r
55 Include "infglk"; ! Use sensible names for calls to Glk.
\r
57 Array gg_event --> 4; ! The event handler uses a four-word array.
\r
58 Global gg_mainwin = 0; ! There is only one window.
\r
60 Constant ANY_OLD_ROCK 0; ! Rock values don't seem necessary here.
\r
62 ! =================================================================================================
\r
63 ! General constants used by the tool.
\r
66 Constant NEWLINE $0A;
\r
67 Constant RETURN $0D;
\r
69 Constant SQUOTE $27;
\r
71 Constant ATSIGN $40;
\r
73 Constant LEX_INVALID 0;
\r
74 Constant LEX_NEWLINE 100;
\r
75 Constant LEX_COMMENT 200;
\r
77 Constant LEX_VALUE 300; ! context-sensitive spacing
\r
78 Constant LEX_IDENT 310; ! ABC123_
\r
79 Constant LEX_STATEMENT 320; ! do if else objectloop print print_ret switch until while
\r
80 Constant LEX_NUMBER 370; ! 123 $FF $$1010
\r
81 Constant LEX_DQ_STRING 380; ! "..."
\r
82 Constant LEX_SQ_STRING 390; ! '...'
\r
83 Constant LEX_VALUE_END 399;
\r
85 Constant LEX_SEPARATE 400;
\r
87 Constant LEX_SEPG0 400; ! space before:NO after:NO
\r
88 Constant LEX_ARROW 410; ! ->
\r
89 Constant LEX_DOT 420; ! .
\r
90 Constant LEX_SEPG0_END 499; ! --> >> .# .& .. ..# ..& ::
\r
92 Constant LEX_SEPG1 500; ! space before:NO after:YES
\r
93 Constant LEX_COLON 510; ! :
\r
94 Constant LEX_SEMIC 520; ! ;
\r
95 Constant LEX_COMMA 530; ! ,
\r
96 Constant LEX_RPAREN 540; ! )
\r
97 Constant LEX_RBRACE 550; ! }
\r
98 Constant LEX_RBRCKT 560; ! ]
\r
99 Constant LEX_SEPG1_END 599; !
\r
101 Constant LEX_SEPG2 600; ! space before:YES after:NO
\r
102 Constant LEX_LPAREN 610; ! (
\r
103 Constant LEX_LBRACE 620; ! {
\r
104 Constant LEX_LTLT 630; ! <<
\r
105 Constant LEX_HASH 640; ! #
\r
106 Constant LEX_TILDE 650; ! ~
\r
107 Constant LEX_SEPG2_END 699; ! ~~ ## #a$ #n$ #r$ #w$ @ ? ?~
\r
109 Constant LEX_SEPG3 700; ! space before:YES after:YES
\r
110 Constant LEX_LBRCKT 710; ! [
\r
111 Constant LEX_ASTERISK 720; ! *
\r
112 Constant LEX_SEPG3_END 799; ! = + / % | || & && == ~= < > <= >=
\r
114 Constant LEX_SEPG4 800; ! context-sensitive spacing
\r
115 Constant LEX_MINUS 810; ! -
\r
116 Constant LEX_MINUSMINUS 820; ! --
\r
117 Constant LEX_PLUSPLUS 830; ! ++
\r
118 Constant LEX_SEPG4_END 899; !
\r
120 Constant LEX_SEPARATE_END 999;
\r
123 Array DirEnd string "End";
\r
124 Array DirIf3 string "Ifv3";
\r
125 Array DirIf5 string "Ifv5";
\r
126 Array DirLnk string "Link";
\r
127 Array DirStb string "Stub";
\r
128 Array DirVrb string "Verb";
\r
129 Array DirArr string "Array";
\r
130 Array DirCla string "Class";
\r
132 Array DirEnf string "Endif";
\r
133 Array DirIfd string "Ifdef";
\r
134 Array DirIfn string "Ifnot";
\r
135 Array DirTra string "Trace";
\r
136 Array DirUnd string "Undef";
\r
137 Array DirExt string "Extend";
\r
138 Array DirGlo string "Global";
\r
139 Array DirIfu string "Ifndef";
\r
141 Array DirIft string "Iftrue";
\r
142 Array DirImp string "Import";
\r
143 Array DirNby string "Nearby";
\r
144 Array DirObj string "Object";
\r
145 Array DirSer string "Serial";
\r
146 Array DirDef string "Default";
\r
147 Array DirIff string "Iffalse";
\r
148 Array DirInc string "Include";
\r
150 Array DirMsg string "Message";
\r
151 Array DirRel string "Release";
\r
152 Array DirRep string "Replace";
\r
153 Array DirVer string "Version";
\r
154 Array DirCon string "Constant";
\r
155 Array DirPro string "Property";
\r
156 Array DirSwi string "Switches";
\r
157 Array DirAtt string "Attribute";
\r
159 Array DirLow string "Lowstring";
\r
160 Array DirAbb string "Abbreviate";
\r
161 Array DirDct string "Dictionary";
\r
162 Array DirSts string "Statusline";
\r
163 Array DirZch string "Zcharacter";
\r
164 Array DirFak string "Fake_action";
\r
165 Array DirSys string "System_file";
\r
167 Array Directives table
\r
168 DirEnd DirIf3 DirIf5 DirLnk DirStb DirVrb DirArr DirCla
\r
169 DirEnf DirIfd DirIfn DirTra DirUnd DirExt DirGlo DirIfu
\r
170 DirIft DirImp DirNby DirObj DirSer DirDef DirIff DirInc
\r
171 DirMsg DirRel DirRep DirVer DirCon DirPro DirSwi DirAtt
\r
172 DirLow DirAbb DirDct DirSts DirZch DirFak DirSys;
\r
175 Array ObjHas string "has";
\r
176 Array ObjWth string "with";
\r
177 Array ObjCla string "class";
\r
178 Array ObjPri string "private";
\r
180 Array ObjSegments table
\r
181 ObjHas ObjWth ObjCla ObjPri;
\r
184 Array SmtDo_ string "do";
\r
185 Array SmtIf_ string "if";
\r
186 !Array SmtBox string "box";
\r
187 Array SmtFor string "for";
\r
188 Array SmtEls string "else";
\r
189 !Array SmtFnt string "font";
\r
190 !Array SmtGiv string "give";
\r
191 !Array SmtJmp string "jump";
\r
193 !Array SmtMov string "move";
\r
194 !Array SmtQit string "quit";
\r
195 !Array SmtRed string "read";
\r
196 !Array SmtSav string "save";
\r
197 !Array SmtBrk string "break";
\r
198 Array SmtPri string "print";
\r
199 !Array SmtRtr string "rtrue";
\r
200 !Array SmtSty string "style";
\r
202 Array SmtUnt string "until";
\r
203 Array SmtWhi string "while";
\r
204 !Array SmtRem string "remove";
\r
205 !Array SmtRet string "return";
\r
206 !Array SmtRfa string "rfalse";
\r
207 !Array SmtSpa string "spaces";
\r
208 !Array SmtStr string "string";
\r
209 Array SmtSwi string "switch";
\r
211 !Array SmtRes string "restore";
\r
212 !Array SmtNew string "new_line";
\r
213 !Array SmtCon string "continue";
\r
214 !Array SmtInv string "inversion";
\r
215 Array SmtPrt string "print_ret";
\r
216 Array SmtObj string "objectloop";
\r
218 ! Array Statements table
\r
219 ! SmtDo_ SmtIf_ SmtBox SmtFor SmtEls SmtFnt SmtGiv SmtJmp
\r
220 ! SmtMov SmtQit SmtRed SmtSav SmtBrk SmtPri SmtRtr SmtSty
\r
221 ! SmtUnt SmtWhi SmtRem SmtRet SmtRfa SmtSpa SmtStr SmtSwi
\r
222 ! SmtRes SmtNew SmtCon SmtInv SmtPrt SmtObj;
\r
224 Array Statements table
\r
225 SmtDo_ SmtIf_ SmtFor SmtEls SmtPri SmtUnt SmtWhi SmtSwi SmtPrt SmtObj;
\r
228 Array PrpNam string "name";
\r
230 Array Properties table
\r
233 ! =================================================================================================
\r
234 ! Variables used by the tool.
\r
236 Global indentSize = DEFAULT_INDENT;
\r
237 Global commentColumn = DEFAULT_COMMENT;
\r
238 Global marginColumn = DEFAULT_MARGIN;
\r
240 Global sourceStream;
\r
241 Global targetStream;
\r
243 Global currentState;
\r
244 Constant STATE_NONE 0;
\r
245 Constant STATE_CLASS_HEADER 100;
\r
246 Constant STATE_OBJECT_HEADER 200;
\r
247 Constant STATE_OBJECT_BODY 250;
\r
248 Constant STATE_VERB 300;
\r
249 Constant STATE_ROUTINE 400;
\r
250 Constant STATE_OTHER_DIR 500;
\r
253 Constant NEXT_NONE 0;
\r
254 Constant NEXT_SPACE 1;
\r
255 Constant NEXT_NEWLINE 2;
\r
256 Constant NEXT_BLANKLINE 3;
\r
258 Global savedChar; ! read one character too many
\r
259 Global sourceLine; ! source line count
\r
260 Global sourceLen; ! source line length
\r
261 Global sourceP1; ! start of lexeme
\r
262 Global sourceP2; ! end of lexeme + 1
\r
263 Global sourceP3; ! end of string + 1
\r
264 Global previousLex; ! previous lexeme
\r
265 Global parenCount; ! unmatched parentheses
\r
267 Global outputLen; ! output line length
\r
268 Global currentIndent; ! units of indentation
\r
270 Global prevLineBlank; ! a few flags
\r
271 Global routineIsEmbedded;
\r
272 Global directiveIsEmbedded;
\r
276 ! =================================================================================================
\r
277 ! Instructions for use.
\r
281 print "This tool pretty-prints an Inform source file. It is driven by these commands:^
\r
283 N - reformat a new source file. You are prompted for the name of the input
\r
284 ^ source file, and for a second file to receive the output. Ensure that
\r
285 ^ the output file is DIFFERENT FROM the input file, or the input will be
\r
290 I <num> - specify the size of each indentation.^
\r
291 I - reset to default of ", DEFAULT_INDENT, ".^
\r
292 C <num> - specify the column to align inline comment (0 for no alignment).^
\r
293 C - reset to default of ", DEFAULT_COMMENT, ".^
\r
294 M <num> - specify the column to wrap long lines (0 for no wrap).^
\r
295 M - reset to default of ", DEFAULT_MARGIN, ".^
\r
297 ? - display these instructions.^";
\r
305 " Indent:", indentSize,
\r
306 " Inline comment col:", commentColumn,
\r
307 " Right margin col:", marginColumn;
\r
308 new_line; new_line;
\r
312 ! =================================================================================================
\r
313 ! This is the top-level control loop.
\r
317 @setiosys 2 0; ! Set Glk as the VM's I/O layer.
\r
318 gg_mainwin = ! Open the main window.
\r
319 glk_window_open(0, 0, 0, wintype_TextBuffer, ANY_OLD_ROCK);
\r
320 glk_set_window(gg_mainwin); ! Make it the current window.
\r
322 glk_set_style(style_Header);
\r
323 print "INSTRUCTOR 1.2";
\r
324 glk_set_style(style_Normal);
\r
325 print "^A tool for reformatting Inform source files.^^";
\r
326 ShowHelp(); ! Explain what they can do.
\r
328 while (true) { ! Loop here until "Q" typed.
\r
330 print "> "; ! Prompt for a line of input.
\r
331 if (~~ParseLine()) continue; ! Nothing typed
\r
332 Tokens-->0 = theInput->(TokenStart->0);
\r
333 Tokens-->1 = ParseNumber(TokenStart->1, TokenEnd->1);
\r
334 switch (Tokens-->0) { ! Deal with the character, then loop back.
\r
335 'C','c': DoCommentColumn();
\r
336 'I','i': DoIndentSize();
\r
337 'M','m': DoMarginColumn();
\r
338 'N','n': DoReformat();
\r
340 '?','/': ShowHelp();
\r
341 default: print "Possible keys are N, Q, I, C, M and ?^";
\r
346 ! =================================================================================================
\r
349 [ InputLine buf buflen; ! Input a line of characters.
\r
350 glk_request_line_event(gg_mainwin, buf, buflen, 0);
\r
351 while (true) { ! Wait for RETURN to be pressed.
\r
352 glk_select(gg_event); ! LineInput is the only interesting event.
\r
353 if (gg_event-->0 == evtype_LineInput && gg_event-->1 == gg_mainwin)
\r
354 return (gg_event-->2); ! Number of characters.
\r
358 [ ParseLine ! Read line of input, find tokens
\r
360 for (i=0 : i<MAX_TOKENS : i++) TokenStart->i = TokenEnd->i = 0;
\r
361 n = InputLine(theInput, MAX_INPUT);
\r
362 glk_select_poll(gg_event);
\r
363 if (n == 0) rfalse; ! Nothing typed.
\r
364 for (i=j=0 : i<MAX_TOKENS : i++) {
\r
365 while (theInput->j == SPACE or COMMA) {
\r
367 if (j >= n) return i;
\r
370 while (theInput->j ~= SPACE or COMMA) {
\r
373 if (j >= n) return i+1;
\r
379 [ ParseNumber a b ! Parse token as bin/dec/hex number.
\r
381 if (a == b) return -1;
\r
382 base = 10; num = 0;
\r
384 if (theInput->i == '-') i++;
\r
385 if (theInput->i == '$') {
\r
387 if (theInput->i == '$') { base = 2; i++; }
\r
389 for ( : i<b : i++) {
\r
390 char = theInput->i;
\r
391 if (char >= '0' && char <= '9') char = char - '0';
\r
393 if (char >= 'A' && char <= 'Z') char = char - 'A' + 10;
\r
395 if (char >= 'a' && char <= 'z') char = char - 'a' + 10;
\r
399 if (char < base) num = (num * base) + char;
\r
402 if (theInput->a == '-') num = -num;
\r
406 [ OpenSourceForRead
\r
408 fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Read, ANY_OLD_ROCK);
\r
409 if (fileref == GLK_NULL) "Failed to create Source fileref.";
\r
410 sourceStream = glk_stream_open_file(fileref, filemode_Read, ANY_OLD_ROCK);
\r
411 if (sourceStream == GLK_NULL) "Failed to open Source stream.";
\r
412 glk_fileref_destroy(fileref);
\r
413 rfalse; ! Successful -- OK to continue.
\r
416 [ OpenTargetForWrite
\r
418 fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Write, ANY_OLD_ROCK);
\r
419 if (fileref == GLK_NULL) "Failed to create Target fileref.";
\r
420 targetStream = glk_stream_open_file(fileref, filemode_Write, ANY_OLD_ROCK);
\r
421 if (targetStream == GLK_NULL) "Failed to open Target stream.";
\r
422 glk_fileref_destroy(fileref);
\r
423 rfalse; ! Successful -- OK to continue.
\r
426 ! =================================================================================================
\r
427 ! Quit from the utility.
\r
430 print "Hit any key to exit.^"; quit;
\r
433 ! =================================================================================================
\r
437 if (Tokens-->1 < 0)
\r
438 indentSize = DEFAULT_INDENT;
\r
440 indentSize = Tokens-->1;
\r
443 ! =================================================================================================
\r
444 ! Set inline comment column.
\r
447 if (Tokens-->1 < 0)
\r
448 commentColumn = DEFAULT_COMMENT;
\r
450 commentColumn = Tokens-->1;
\r
453 ! =================================================================================================
\r
454 ! Set right margin column.
\r
457 if (Tokens-->1 < 0)
\r
458 marginColumn = DEFAULT_MARGIN;
\r
460 marginColumn = Tokens-->1;
\r
463 ! =================================================================================================
\r
464 ! Reformat the source.
\r
469 print "First, specify an Inform source file to be reformatted.^";
\r
470 glk_select_poll(gg_event);
\r
471 if (OpenSourceForRead()) return;
\r
473 print "Now, specify a DIFFERENT file to hold the reformatted output.^";
\r
474 glk_select_poll(gg_event);
\r
475 if (OpenTargetForWrite()) { glk_stream_close(sourceStream, GLK_NULL); return; }
\r
477 currentState = STATE_NONE;
\r
478 nextWhite = NEXT_NONE;
\r
479 sourceLine = sourceLen = sourceP1 = sourceP2 = sourceP3 = 0;
\r
480 previousLex = parenCount = outputLen = currentIndent = 0;
\r
482 prevLineBlank = true;
\r
483 routineIsEmbedded = directiveIsEmbedded = mapDQtoSQ = false;
\r
485 ! Break the source file into lexemes.
\r
487 for (lex=GetLexeme() : lex : lex=GetLexeme()) {
\r
489 ! Deal with newlines and comments.
\r
491 if (lex == LEX_NEWLINE) {
\r
492 switch (nextWhite) {
\r
493 NEXT_NEWLINE: PutNL(1);
\r
494 NEXT_BLANKLINE: PutNL(2);
\r
498 if (lex == LEX_COMMENT) {
\r
500 PutSpace(commentColumn-outputLen);
\r
501 nextWhite = NEXT_SPACE;
\r
504 nextWhite = NEXT_NONE;
\r
505 PrintLexeme(lex); PutNL(1);
\r
508 switch (nextWhite) {
\r
509 NEXT_NEWLINE: PutNL(1);
\r
510 NEXT_BLANKLINE: PutNL(2);
\r
513 ! Set up default spacing for this lexeme.
\r
516 LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG1 to LEX_SEPG1_END:
\r
517 nextWhite = NEXT_NONE;
\r
518 LEX_SEPG2 to LEX_SEPG2_END, LEX_SEPG3 to LEX_SEPG3_END:
\r
519 nextWhite = NEXT_SPACE;
\r
522 ! Handle the lexeme according to the current major state.
\r
524 switch (currentState) {
\r
526 ! At outermost level of source.
\r
529 print "* "; glk_select_poll(gg_event);
\r
532 LEX_IDENT: ! New directive.
\r
533 x = MatchString(theSource, sourceP1, sourceP2, Directives);
\r
534 if (x) switch (Directives-->x) {
\r
536 nextWhite = NEXT_BLANKLINE;
\r
537 currentState = STATE_CLASS_HEADER;
\r
539 nextWhite = NEXT_BLANKLINE;
\r
540 currentState = STATE_OBJECT_HEADER;
\r
542 nextWhite = NEXT_BLANKLINE;
\r
543 currentState = STATE_VERB;
\r
544 if (fixBadSyntax) mapDQtoSQ = true;
\r
546 currentState = STATE_OTHER_DIR;
\r
548 else { ! Must be a user-defined class.
\r
549 nextWhite = NEXT_BLANKLINE;
\r
550 currentState = STATE_OBJECT_HEADER;
\r
552 if (fixBadSyntax && Directives-->x == DirNby) {
\r
553 PutChar('O'); PutChar('b'); PutChar('j'); PutChar('e'); PutChar('c'); PutChar('t');
\r
554 PutChar(' '); PutChar(' '); PutChar('-'); PutChar('>');
\r
555 nextWhite = NEXT_SPACE;
\r
559 if (currentState == STATE_CLASS_HEADER or STATE_OBJECT_HEADER)
\r
560 PutSpace(indentSize*2-sourceP2+sourceP1);
\r
562 LEX_LBRCKT: ! New standalone routine.
\r
563 nextWhite = NEXT_BLANKLINE; PrintLexeme(lex);
\r
564 currentIndent = 1; ControlReset();
\r
565 currentState = STATE_ROUTINE; routineIsEmbedded = false;
\r
566 LEX_HASH: ! Prefix to new directive.
\r
570 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_NONE.";
\r
573 ! Standalone or Embedded routine.
\r
576 switch (ControlGet()) {
\r
578 if (lex == LEX_LBRACE)
\r
579 ControlSet(CONTROL_IF_MULTI);
\r
581 ControlSet(CONTROL_IF_SINGLE);
\r
583 nextWhite = NEXT_NEWLINE;
\r
586 if (lex == LEX_LBRACE)
\r
587 ControlSet(CONTROL_XX_MULTI);
\r
589 ControlSet(CONTROL_XX_SINGLE);
\r
591 nextWhite = NEXT_NEWLINE;
\r
597 if (previousLex == LEX_RBRCKT && ~~routineIsEmbedded) {
\r
598 currentState = STATE_NONE;
\r
599 nextWhite = NEXT_BLANKLINE;
\r
601 while (ControlGet() == CONTROL_XX_SINGLE) {
\r
605 if (ControlGet() == CONTROL_IF_SINGLE) {
\r
606 ControlSet(CONTROL_IF_ELSE);
\r
610 if (routineIsEmbedded) {
\r
611 currentState = STATE_OBJECT_BODY;
\r
618 if (outputLen == 0) { ! Prefix to new directive.
\r
622 currentState = STATE_OTHER_DIR; directiveIsEmbedded = true;
\r
631 if (ControlGet() == CONTROL_IF_MULTI) {
\r
632 ControlSet(CONTROL_IF_ELSE);
\r
636 if (ControlGet() == CONTROL_IF_ELSE) {
\r
638 while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {
\r
642 if (ControlGet() == CONTROL_IF_MULTI)
\r
643 ControlSet(CONTROL_IF_ELSE);
\r
646 if (ControlGet() == CONTROL_XX_MULTI) {
\r
648 while (ControlGet() == CONTROL_XX_SINGLE) {
\r
652 if (ControlGet() == CONTROL_IF_SINGLE) {
\r
653 ControlSet(CONTROL_IF_ELSE);
\r
659 if (parenCount == 0) {
\r
660 PullSpace(indentSize/2); PrintLexeme(lex); nextWhite = NEXT_NEWLINE;
\r
662 nextWhite = NEXT_SPACE; PrintLexeme(lex);
\r
668 { nextWhite = NEXT_NEWLINE; PrintLexeme(lex); PullSpace(indentSize/2); }
\r
669 LEX_LPAREN, LEX_PLUSPLUS, LEX_MINUSMINUS:
\r
670 if (previousLex == LEX_IDENT or LEX_LPAREN or LEX_PLUSPLUS or LEX_MINUSMINUS)
\r
671 nextWhite = NEXT_NONE;
\r
675 if (parenCount == 0) {
\r
676 if (ControlGet() == CONTROL_IF_COND) ControlSet(CONTROL_IF_SCOPE);
\r
677 if (ControlGet() == CONTROL_XX_COND) ControlSet(CONTROL_XX_SCOPE);
\r
681 if (previousLex ~= LEX_IDENT or LEX_NUMBER or LEX_RPAREN)
\r
682 nextWhite = NEXT_NONE;
\r
684 x = MatchString(theSource, sourceP1, sourceP2, Statements);
\r
685 if (ControlGet() == CONTROL_IF_ELSE && ~~(x && Statements-->x == SmtEls)) {
\r
687 while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {
\r
693 lex = LEX_STATEMENT;
\r
694 switch (Statements-->x) {
\r
696 ControlPush(CONTROL_IF_COND);
\r
697 SmtFor, SmtWhi, SmtSwi, SmtObj:
\r
698 ControlPush(CONTROL_XX_COND);
\r
700 ControlPush(CONTROL_XX_SCOPE);
\r
702 ControlSet(CONTROL_XX_SCOPE);
\r
705 if (previousLex == LEX_PLUSPLUS or LEX_MINUSMINUS)
\r
706 nextWhite = NEXT_NONE;
\r
708 LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:
\r
709 if (ControlGet() == CONTROL_IF_ELSE) {
\r
711 while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) {
\r
719 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_ROUTINE.";
\r
722 ! Class or Object directive, in header.
\r
724 STATE_CLASS_HEADER,
\r
725 STATE_OBJECT_HEADER:
\r
728 PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;
\r
729 currentState = STATE_NONE;
\r
731 if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) {
\r
735 PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1);
\r
736 currentState = STATE_OBJECT_BODY;
\r
739 if (currentState == STATE_CLASS_HEADER)
\r
744 LEX_ARROW, LEX_DQ_STRING:
\r
745 nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE;
\r
746 LEX_LPAREN, LEX_NUMBER, LEX_RPAREN:
\r
747 nextWhite = NEXT_NONE; PrintLexeme(lex);
\r
748 LEX_COMMA: ! don't need a comma here
\r
749 if (~~fixBadSyntax) PrintLexeme(lex);
\r
752 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_CLASS/OBJECT_HEADER.";
\r
755 ! Class or Object directive, in body.
\r
760 PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;
\r
761 currentState = STATE_NONE;
\r
764 LEX_LBRCKT: ! New embedded routine.
\r
766 currentIndent++; ControlReset();
\r
767 currentState = STATE_ROUTINE; routineIsEmbedded = true;
\r
769 PrintLexeme(lex); nextWhite = NEXT_NEWLINE;
\r
772 if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) {
\r
773 if (previousLex ~= LEX_COMMA) {
\r
774 if (fixBadSyntax) PutChar(',');
\r
778 PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1);
\r
782 if (fixBadSyntax && MatchString(theSource, sourceP1, sourceP2, Properties)) mapDQtoSQ = true;
\r
785 LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:
\r
789 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OBJECT_BODY.";
\r
797 PrintLexeme(lex); nextWhite = NEXT_BLANKLINE;
\r
798 currentState = STATE_NONE;
\r
803 nextWhite = NEXT_NEWLINE; PrintLexeme(lex);
\r
805 nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE;
\r
806 LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:
\r
810 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_VERB.";
\r
813 ! Other directive (not Class/Object/Verb).
\r
819 if (directiveIsEmbedded) {
\r
820 currentState = STATE_ROUTINE; directiveIsEmbedded = false;
\r
823 currentState = STATE_NONE;
\r
826 LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END:
\r
830 "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OTHER_DIR.";
\r
833 } ! end of switch(currentState)
\r
836 if (outputlen) PutNL(1);
\r
838 glk_stream_close(sourceStream, GLK_NULL);
\r
839 glk_stream_close(targetStream, GLK_NULL);
\r
843 [ MatchString buf p1 p2 tab
\r
846 for (i=1 : i<=tab-->0 : i++) {
\r
848 if (str->0 < len) continue;
\r
849 if (str->0 > len) rfalse;
\r
850 for (j=1,k=p1 : j<=len : j++,k++)
\r
851 if ((str->j | $20) ~= (buf->k | $20)) jump tryNext;
\r
858 ! =================================================================================================
\r
859 ! Stack for control structuress.
\r
861 Constant MAX_STACK 20; ! Nested control structures.
\r
862 Array controlStack --> MAX_STACK;
\r
864 Constant CONTROL_IF_COND 10; ! Looking for end of IF condition
\r
865 Constant CONTROL_IF_SCOPE 11; ! Looking for { after IF condition
\r
866 Constant CONTROL_IF_SINGLE 12; ! Controlling a single statement
\r
867 Constant CONTROL_IF_MULTI 13; ! Controlling multiple statements
\r
868 Constant CONTROL_IF_ELSE 14; ! Looking for ELSE after IF statement
\r
869 Constant CONTROL_XX_COND 20; ! Looking for end of other condition
\r
870 Constant CONTROL_XX_SCOPE 21; ! Looking for { after other condition
\r
871 Constant CONTROL_XX_SINGLE 22; ! Controlling a single statement
\r
872 Constant CONTROL_XX_MULTI 23; ! Controlling multiple statements
\r
876 p = (controlStack-->0) + 1;
\r
877 if (p == MAX_STACK) {
\r
878 print "Stack overflow: increase MAX_STACK and recompile.^";
\r
881 controlStack-->0 = p;
\r
882 controlStack-->p = val;
\r
887 p = controlStack-->0;
\r
889 (controlStack-->0)--;
\r
890 p = controlStack-->p;
\r
897 p = controlStack-->0;
\r
899 controlStack-->p = val;
\r
901 "INSPECTOR bug at source line ", sourceLine, ": StackSet on empty stack.";
\r
906 p = controlStack-->0;
\r
908 p = controlStack-->p;
\r
912 [ ControlReset; controlStack-->0 = 0; ];
\r
923 ! default: print x, " ";
\r
925 ! for (i=1 : i<=controlStack-->0 : i++) {
\r
927 ! switch (controlStack-->i) {
\r
928 ! 0: print "none ";
\r
929 ! CONTROL_IF_COND: print "IfCo ";
\r
930 ! CONTROL_IF_SCOPE: print "IfSc ";
\r
931 ! CONTROL_IF_SINGLE:print "IfSi ";
\r
932 ! CONTROL_IF_MULTI: print "IfMu ";
\r
933 ! CONTROL_IF_ELSE: print "IfEl ";
\r
934 ! CONTROL_XX_COND: print "XxCo ";
\r
935 ! CONTROL_XX_SCOPE: print "XxSc ";
\r
936 ! CONTROL_XX_SINGLE:print "XxSi ";
\r
937 ! CONTROL_XX_MULTI: print "XxMu ";
\r
943 ! =================================================================================================
\r
948 if (sourceLen == 0) { ! Need next line of source.
\r
949 sourceLen = ReadSourceLine();
\r
950 if (sourceLen == 0) rfalse; ! End-of-file.
\r
951 sourceP1 = 0; ! Start of buffer.
\r
954 sourceP1 = sourceP2; ! Continue from last time.
\r
956 ! Ignore leading whitespace.
\r
958 while (isWhiteSpace(theSource->sourceP1)) sourceP1++;
\r
959 if (theSource->sourceP1 == NEWLINE) {
\r
961 return LEX_NEWLINE;
\r
964 ! Found start of lexeme.
\r
966 sourceP2 = sourceP1 + 1;
\r
967 switch (theSource->sourceP1) {
\r
969 '_', 'A' to 'Z', 'a' to 'z': ! identifier
\r
970 while (isIdentifier(theSource->sourceP2)) sourceP2++;
\r
973 '0' to '9': ! decimal number
\r
974 while (isDecimal(theSource->sourceP2)) sourceP2++;
\r
977 '$': ! hex/binary number
\r
978 if (theSource->sourceP2 == '$') {
\r
980 while(isBinary(theSource->sourceP2)) sourceP2++;
\r
983 while(isHex(theSource->sourceP2)) sourceP2++;
\r
987 '"': ! "..." string
\r
988 theString->0 = theSource->sourceP1;
\r
991 if (sourceP3 == MAX_STRING) {
\r
992 print "String too long: increase MAX_STRING and recompile.^";
\r
995 c = theSource->(sourceP2++); theString->(sourceP3++) = c;
\r
996 if (c == NEWLINE) {
\r
998 sourceLen = ReadSourceLine();
\r
1000 while (isWhiteSpace(theSource->sourceP2)) sourceP2++;
\r
1001 } until (theSource->sourceP2 ~= NEWLINE);
\r
1003 } until (c == '"');
\r
1004 rval = LEX_DQ_STRING;
\r
1006 SQUOTE: ! '...' string
\r
1007 while (theSource->sourceP2 ~= SQUOTE) sourceP2++;
\r
1009 rval = LEX_SQ_STRING;
\r
1012 sourceP2 = sourceLen - 1;
\r
1013 rval = LEX_COMMENT;
\r
1016 switch (theSource->sourceP2) {
\r
1017 '#': sourceP2++; rval = LEX_SEPG2_END; ! ##
\r
1019 switch (theSource->(sourceP2+1)) {
\r
1020 '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #a$
\r
1021 default: rval = LEX_HASH; ! #
\r
1024 switch (theSource->(sourceP2+1)) {
\r
1025 '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #n$
\r
1026 default: rval = LEX_HASH; ! #
\r
1029 switch (theSource->(sourceP2+1)) {
\r
1030 '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #r$
\r
1031 default: rval = LEX_HASH; ! #
\r
1034 switch (theSource->(sourceP2+1)) {
\r
1035 '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #w$
\r
1036 default: rval = LEX_HASH; ! #
\r
1038 default: rval = LEX_HASH; ! #
\r
1041 '%': rval = LEX_SEPG3_END; ! %
\r
1044 switch (theSource->sourceP2) {
\r
1045 '&': sourceP2++; rval = LEX_SEPG3_END; ! &&
\r
1046 default: rval = LEX_SEPG3_END; ! &
\r
1049 '(': rval = LEX_LPAREN; ! (
\r
1052 ')': rval = LEX_RPAREN; ! )
\r
1055 '*': rval = LEX_ASTERISK; ! *
\r
1058 switch (theSource->sourceP2) {
\r
1059 '+': sourceP2++; rval = LEX_PLUSPLUS; ! ++
\r
1060 default: rval = LEX_SEPG3_END; ! +
\r
1063 ',': rval = LEX_COMMA; ! ,
\r
1066 switch (theSource->sourceP2) {
\r
1068 sourceP2++; switch (theSource->sourceP2) {
\r
1069 '>': sourceP2++; rval = LEX_SEPG0_END; ! -->
\r
1070 default: rval = LEX_MINUSMINUS; ! --
\r
1072 '>': sourceP2++; rval = LEX_ARROW; ! ->
\r
1073 default: rval = LEX_MINUS; ! -
\r
1077 switch (theSource->sourceP2) {
\r
1079 sourceP2++; switch (theSource->sourceP2) {
\r
1080 '#': sourceP2++; rval = LEX_SEPG0_END; ! ..#
\r
1081 '&': sourceP2++; rval = LEX_SEPG0_END; ! ..&
\r
1082 default: rval = LEX_SEPG0_END; ! ..
\r
1084 '#': sourceP2++; rval = LEX_SEPG0_END; ! .#
\r
1085 '&': sourceP2++; rval = LEX_SEPG0_END; ! .&
\r
1086 default: rval = LEX_DOT; ! .
\r
1089 '/': rval = LEX_SEPG3_END; ! /
\r
1092 switch (theSource->sourceP2) {
\r
1093 ':': sourceP2++; rval = LEX_SEPG0_END; ! ::
\r
1094 default: rval = LEX_COLON; ! :
\r
1097 ';': rval = LEX_SEMIC; ! ;
\r
1100 switch (theSource->sourceP2) {
\r
1101 '=': sourceP2++; rval = LEX_SEPG3_END; ! <=
\r
1102 '<': sourceP2++; rval = LEX_LTLT; ! <<
\r
1103 default: rval = LEX_SEPG3_END; ! <
\r
1107 switch (theSource->sourceP2) {
\r
1108 '=': sourceP2++; rval = LEX_SEPG3_END; ! ==
\r
1109 default: rval = LEX_SEPG3_END; ! =
\r
1113 switch (theSource->sourceP2) {
\r
1114 '=': sourceP2++; rval = LEX_SEPG3_END; ! >=
\r
1115 '>': sourceP2++; rval = LEX_SEPG0_END; ! >>
\r
1116 default: rval = LEX_SEPG3_END; ! >
\r
1120 switch (theSource->sourceP2) {
\r
1121 '~': sourceP2++; rval = LEX_SEPG2_END; ! ?~
\r
1122 default: rval = LEX_SEPG2_END; ! ?
\r
1125 ATSIGN: rval = LEX_SEPG2_END; ! @
\r
1127 '[': rval = LEX_LBRCKT; ! [
\r
1129 ']': rval = LEX_RBRCKT; ! ]
\r
1131 '{': rval = LEX_LBRACE; ! {
\r
1133 '}': rval = LEX_RBRACE; ! }
\r
1136 switch (theSource->sourceP2) {
\r
1137 '|': sourceP2++; rval = LEX_SEPG3_END; ! ||
\r
1138 default: rval = LEX_SEPG3_END; ! |
\r
1142 switch (theSource->sourceP2) {
\r
1143 '=': sourceP2++; rval = LEX_SEPG3_END; ! ~=
\r
1144 '~': sourceP2++; rval = LEX_SEPG2_END; ! ~~
\r
1145 default: rval = LEX_TILDE; ! ~
\r
1148 default: rval = LEX_INVALID; ! Not valid.
\r
1154 if (c == ' ' or TAB) rtrue;
\r
1159 if (c == '0' or '1') rtrue;
\r
1164 if (c >= '0' && c <= '9') rtrue;
\r
1169 if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f')) rtrue;
\r
1174 if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c == '_')) rtrue;
\r
1180 if (savedChar) { c = savedChar; savedChar = 0; }
\r
1181 else c = glk_get_char_stream(sourceStream);
\r
1182 if (c == NEWLINE or RETURN) {
\r
1183 savedChar = glk_get_char_stream(sourceStream);
\r
1184 if (savedChar == NEWLINE or RETURN && savedChar ~= c) savedChar = 0;
\r
1193 c = ReadSourceChar();
\r
1194 if (c == -1) ! end of stream
\r
1195 if (len) c = NEWLINE; else return 0;
\r
1196 if (len == MAX_SOURCE) {
\r
1197 print "Source line too long: increase MAX_SOURCE and recompile.^";
\r
1201 theSource->len++ = c;
\r
1202 } until (c == NEWLINE);
\r
1207 ! [ ReadSourceLine
\r
1209 ! len = glk_get_line_stream(sourceStream, theSource, MAX_SOURCE);
\r
1211 ! if (len && theSource->(len-1) ~= NEWLINE)
\r
1212 ! if (len == MAX_SOURCE-1) {
\r
1213 ! print "Source line too long: increase MAX_SOURCE and recompile.^";
\r
1217 ! theSource->(len++) = NEWLINE;
\r
1221 ! =================================================================================================
\r
1225 switch (nextWhite) {
\r
1229 if (marginColumn > 0 && outputLen > marginColumn)
\r
1239 PutUpper(theSource->i);
\r
1240 for (i++ : i<sourceP2 : i++) PutLower(theSource->i);
\r
1241 nextWhite = NEXT_SPACE;
\r
1246 switch (nextWhite) {
\r
1250 if (marginColumn > 0 && outputLen > marginColumn && lex ~= LEX_COMMENT)
\r
1260 if (lex == LEX_DQ_STRING) {
\r
1262 for (i=0 : i<sourceP3 : i++)
\r
1263 if (theString->i == NEWLINE) {
\r
1266 for (i=0 : i<sourceP3 : i++) PutChar(theString->i);
\r
1271 ! theString->0 = theString->(sourceP3-1) = SQUOTE; ! avoid compiler bug
\r
1272 theString->0 = SQUOTE;
\r
1273 theString->(sourceP3-1) = SQUOTE;
\r
1275 for (i=0 : i<sourceP3 : i++) PutChar(theString->i);
\r
1278 for (i=sourceP1 : i<sourceP2 : i++)
\r
1279 if (theSource->i == TAB)
\r
1282 PutChar(theSource->i);
\r
1287 LEX_SEMIC, LEX_LBRACE, LEX_RBRACE:
\r
1288 nextWhite = NEXT_NEWLINE;
\r
1289 LEX_VALUE to LEX_VALUE_END, LEX_SEPG4 to LEX_SEPG4_END,
\r
1290 LEX_SEPG1 to LEX_SEPG1_END, LEX_SEPG3 to LEX_SEPG3_END:
\r
1291 nextWhite = NEXT_SPACE;
\r
1292 LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG2 to LEX_SEPG2_END:
\r
1293 nextWhite = NEXT_NONE;
\r
1298 if (c == NEWLINE) return PutNL(1);
\r
1299 if (outputLen == 0) {
\r
1300 for ( : outputLen<indentSize*currentIndent : outputLen++) theOutput->outputLen = SPACE;
\r
1301 if (c == SPACE) return;
\r
1303 if (outputLen == MAX_OUTPUT) {
\r
1304 print "Output line too long: increase MAX_OUTPUT and recompile.^";
\r
1307 theOutput->outputLen = c;
\r
1311 [ PutUpper c; PutChar(glk_char_to_upper(c)); ];
\r
1313 [ PutLower c; PutChar(glk_char_to_lower(c)); ];
\r
1317 if (outputLen && theOutput->(outputLen-1) ~= SPACE)
\r
1318 while (n-- > 0) PutChar(SPACE);
\r
1319 nextWhite = NEXT_NONE;
\r
1324 for (i=0 : i<n : i++) if (theOutput->i ~= SPACE) break;
\r
1326 for ( : i<outputLen : i++) theOutput->(i-n) = theOutput->i;
\r
1327 outputLen = outputLen - n;
\r
1335 ! if (indentWithTabs) {
\r
1336 ! for (j=0 : j<outputLen : j++) if (theOutput->j ~= SPACE) break;
\r
1337 ! for (i=0 : i<j/indentSize : i++) print (char) TAB;
\r
1338 ! j = j - j%indentSize;
\r
1340 glk_put_buffer_stream(targetStream, theOutput, outputLen);
\r
1342 glk_put_char_stream(targetStream, NEWLINE);
\r
1343 prevLineBlank = false;
\r
1346 if (~~prevLineBlank) {
\r
1347 glk_put_char_stream(targetStream, NEWLINE);
\r
1348 prevLineBlank = true;
\r
1351 nextWhite = NEXT_NONE;
\r
1354 ! =================================================================================================
\r