From 7e2a433a026f96462245a008ae6cae604f63022b Mon Sep 17 00:00:00 2001 From: Jason Self Date: Sun, 2 Jun 2019 10:06:11 -0700 Subject: [PATCH] Add INSTRUCTOR For reformatting Inform source programs From http://www.firthworks.com/roger/downloads/Instruct.zip --- instruct/Instruct.inf | 1354 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1354 insertions(+) create mode 100644 instruct/Instruct.inf diff --git a/instruct/Instruct.inf b/instruct/Instruct.inf new file mode 100644 index 0000000..3453c16 --- /dev/null +++ b/instruct/Instruct.inf @@ -0,0 +1,1354 @@ +!% -GS +!% $MAX_STATIC_DATA=20000; +!% +! ================================================================================================= +! INSTRUCTOR -- reformat Inform source files -- Roger Firth (roger@firthworks.com) +! +! V1.2 11Oct04 - fixed support for dynamic Class declarations +! V1.1 29Jan04 - changed ReadSourceLine() to handle cross-platform End-Of-Line characters +! V1.0 13Nov03 - first public release +! +! This program is a pretty-printer -- it reads an Inform source file, and writes the same +! information, neatly formatted, to an output file (which must be DIFFERENT FROM the input file). +! Use it only on source files which compile without any errors. +! +! The program is a standalone Glulx utility which does not used the Inform library files. +! To compile it, you will need to include on the command line: $MAX_STATIC_DATA=20000 +! and you will require the "infglk.h" header file. To run it, any Glulx interpreter should do. +! +! This program is copyright Roger Firth 2003-2004. Copying and distribution, with or without +! modification, are permitted in any medium without royalty provided the copyright notice and +! this notice are preserved. +! +! ================================================================================================= +! These settings should be sufficient, but may need adjusting for an enormous game. + +Constant MAX_SOURCE 4100; ! Line of source input. +Array theSource -> MAX_SOURCE; + +Constant MAX_STRING 4100; ! Double-quoted string. +Array theString -> MAX_STRING; + +Constant MAX_OUTPUT 200; ! Line of source output. +Array theOutput -> MAX_OUTPUT; + +Constant MAX_INPUT 50; ! Line of keyboard input. +Array theInput -> MAX_INPUT; + +Constant MAX_TOKENS 2; ! Input tokens. +Array TokenStart -> MAX_TOKENS; +Array TokenEnd -> MAX_TOKENS; +Array Tokens --> MAX_TOKENS; ! Command, optional numbers. + + +Constant DEFAULT_INDENT 4; ! Tab size. +Constant DEFAULT_COMMENT 40; ! Comment alignment; +Constant DEFAULT_MARGIN 80; ! Wrap long lines. + +Constant fixBadSyntax = true; ! " to ' in name properties, etc. +!Constant indentWithTabs = false; ! Leading spaces become tabs. + +! ================================================================================================= +! Since we're not using the Glulx Inform library files, we need to set up our own Glk +! Input/Output. + +Include "infglk"; ! Use sensible names for calls to Glk. + +Array gg_event --> 4; ! The event handler uses a four-word array. +Global gg_mainwin = 0; ! There is only one window. + +Constant ANY_OLD_ROCK 0; ! Rock values don't seem necessary here. + +! ================================================================================================= +! General constants used by the tool. + +Constant TAB $09; +Constant NEWLINE $0A; +Constant RETURN $0D; +Constant SPACE $20; +Constant SQUOTE $27; +Constant COMMA $2C; +Constant ATSIGN $40; + +Constant LEX_INVALID 0; +Constant LEX_NEWLINE 100; +Constant LEX_COMMENT 200; + +Constant LEX_VALUE 300; ! context-sensitive spacing +Constant LEX_IDENT 310; ! ABC123_ +Constant LEX_STATEMENT 320; ! do if else objectloop print print_ret switch until while +Constant LEX_NUMBER 370; ! 123 $FF $$1010 +Constant LEX_DQ_STRING 380; ! "..." +Constant LEX_SQ_STRING 390; ! '...' +Constant LEX_VALUE_END 399; + +Constant LEX_SEPARATE 400; + +Constant LEX_SEPG0 400; ! space before:NO after:NO +Constant LEX_ARROW 410; ! -> +Constant LEX_DOT 420; ! . +Constant LEX_SEPG0_END 499; ! --> >> .# .& .. ..# ..& :: + +Constant LEX_SEPG1 500; ! space before:NO after:YES +Constant LEX_COLON 510; ! : +Constant LEX_SEMIC 520; ! ; +Constant LEX_COMMA 530; ! , +Constant LEX_RPAREN 540; ! ) +Constant LEX_RBRACE 550; ! } +Constant LEX_RBRCKT 560; ! ] +Constant LEX_SEPG1_END 599; ! + +Constant LEX_SEPG2 600; ! space before:YES after:NO +Constant LEX_LPAREN 610; ! ( +Constant LEX_LBRACE 620; ! { +Constant LEX_LTLT 630; ! << +Constant LEX_HASH 640; ! # +Constant LEX_TILDE 650; ! ~ +Constant LEX_SEPG2_END 699; ! ~~ ## #a$ #n$ #r$ #w$ @ ? ?~ + +Constant LEX_SEPG3 700; ! space before:YES after:YES +Constant LEX_LBRCKT 710; ! [ +Constant LEX_ASTERISK 720; ! * +Constant LEX_SEPG3_END 799; ! = + / % | || & && == ~= < > <= >= + +Constant LEX_SEPG4 800; ! context-sensitive spacing +Constant LEX_MINUS 810; ! - +Constant LEX_MINUSMINUS 820; ! -- +Constant LEX_PLUSPLUS 830; ! ++ +Constant LEX_SEPG4_END 899; ! + +Constant LEX_SEPARATE_END 999; + + +Array DirEnd string "End"; +Array DirIf3 string "Ifv3"; +Array DirIf5 string "Ifv5"; +Array DirLnk string "Link"; +Array DirStb string "Stub"; +Array DirVrb string "Verb"; +Array DirArr string "Array"; +Array DirCla string "Class"; + +Array DirEnf string "Endif"; +Array DirIfd string "Ifdef"; +Array DirIfn string "Ifnot"; +Array DirTra string "Trace"; +Array DirUnd string "Undef"; +Array DirExt string "Extend"; +Array DirGlo string "Global"; +Array DirIfu string "Ifndef"; + +Array DirIft string "Iftrue"; +Array DirImp string "Import"; +Array DirNby string "Nearby"; +Array DirObj string "Object"; +Array DirSer string "Serial"; +Array DirDef string "Default"; +Array DirIff string "Iffalse"; +Array DirInc string "Include"; + +Array DirMsg string "Message"; +Array DirRel string "Release"; +Array DirRep string "Replace"; +Array DirVer string "Version"; +Array DirCon string "Constant"; +Array DirPro string "Property"; +Array DirSwi string "Switches"; +Array DirAtt string "Attribute"; + +Array DirLow string "Lowstring"; +Array DirAbb string "Abbreviate"; +Array DirDct string "Dictionary"; +Array DirSts string "Statusline"; +Array DirZch string "Zcharacter"; +Array DirFak string "Fake_action"; +Array DirSys string "System_file"; + +Array Directives table + DirEnd DirIf3 DirIf5 DirLnk DirStb DirVrb DirArr DirCla + DirEnf DirIfd DirIfn DirTra DirUnd DirExt DirGlo DirIfu + DirIft DirImp DirNby DirObj DirSer DirDef DirIff DirInc + DirMsg DirRel DirRep DirVer DirCon DirPro DirSwi DirAtt + DirLow DirAbb DirDct DirSts DirZch DirFak DirSys; + + +Array ObjHas string "has"; +Array ObjWth string "with"; +Array ObjCla string "class"; +Array ObjPri string "private"; + +Array ObjSegments table + ObjHas ObjWth ObjCla ObjPri; + + +Array SmtDo_ string "do"; +Array SmtIf_ string "if"; +!Array SmtBox string "box"; +Array SmtFor string "for"; +Array SmtEls string "else"; +!Array SmtFnt string "font"; +!Array SmtGiv string "give"; +!Array SmtJmp string "jump"; + +!Array SmtMov string "move"; +!Array SmtQit string "quit"; +!Array SmtRed string "read"; +!Array SmtSav string "save"; +!Array SmtBrk string "break"; +Array SmtPri string "print"; +!Array SmtRtr string "rtrue"; +!Array SmtSty string "style"; + +Array SmtUnt string "until"; +Array SmtWhi string "while"; +!Array SmtRem string "remove"; +!Array SmtRet string "return"; +!Array SmtRfa string "rfalse"; +!Array SmtSpa string "spaces"; +!Array SmtStr string "string"; +Array SmtSwi string "switch"; + +!Array SmtRes string "restore"; +!Array SmtNew string "new_line"; +!Array SmtCon string "continue"; +!Array SmtInv string "inversion"; +Array SmtPrt string "print_ret"; +Array SmtObj string "objectloop"; + +! Array Statements table +! SmtDo_ SmtIf_ SmtBox SmtFor SmtEls SmtFnt SmtGiv SmtJmp +! SmtMov SmtQit SmtRed SmtSav SmtBrk SmtPri SmtRtr SmtSty +! SmtUnt SmtWhi SmtRem SmtRet SmtRfa SmtSpa SmtStr SmtSwi +! SmtRes SmtNew SmtCon SmtInv SmtPrt SmtObj; + +Array Statements table + SmtDo_ SmtIf_ SmtFor SmtEls SmtPri SmtUnt SmtWhi SmtSwi SmtPrt SmtObj; + + +Array PrpNam string "name"; + +Array Properties table + PrpNam PrpNam; + +! ================================================================================================= +! Variables used by the tool. + +Global indentSize = DEFAULT_INDENT; +Global commentColumn = DEFAULT_COMMENT; +Global marginColumn = DEFAULT_MARGIN; + +Global sourceStream; +Global targetStream; + +Global currentState; +Constant STATE_NONE 0; +Constant STATE_CLASS_HEADER 100; +Constant STATE_OBJECT_HEADER 200; +Constant STATE_OBJECT_BODY 250; +Constant STATE_VERB 300; +Constant STATE_ROUTINE 400; +Constant STATE_OTHER_DIR 500; + +Global nextWhite; +Constant NEXT_NONE 0; +Constant NEXT_SPACE 1; +Constant NEXT_NEWLINE 2; +Constant NEXT_BLANKLINE 3; + +Global savedChar; ! read one character too many +Global sourceLine; ! source line count +Global sourceLen; ! source line length +Global sourceP1; ! start of lexeme +Global sourceP2; ! end of lexeme + 1 +Global sourceP3; ! end of string + 1 +Global previousLex; ! previous lexeme +Global parenCount; ! unmatched parentheses + +Global outputLen; ! output line length +Global currentIndent; ! units of indentation + +Global prevLineBlank; ! a few flags +Global routineIsEmbedded; +Global directiveIsEmbedded; +Global mapDQtoSQ; + + +! ================================================================================================= +! Instructions for use. + +[ ShowHelp; + font off; + print "This tool pretty-prints an Inform source file. It is driven by these commands:^ + ^ + N - reformat a new source file. You are prompted for the name of the input + ^ source file, and for a second file to receive the output. Ensure that + ^ the output file is DIFFERENT FROM the input file, or the input will be + ^ overwritten.^ + ^ + Q - quit.^ + ^ + I - specify the size of each indentation.^ + I - reset to default of ", DEFAULT_INDENT, ".^ + C - specify the column to align inline comment (0 for no alignment).^ + C - reset to default of ", DEFAULT_COMMENT, ".^ + M - specify the column to wrap long lines (0 for no wrap).^ + M - reset to default of ", DEFAULT_MARGIN, ".^ + ^ + ? - display these instructions.^"; + font on; +]; + +[ ShowStatus; + font off; + new_line; + print + " Indent:", indentSize, + " Inline comment col:", commentColumn, + " Right margin col:", marginColumn; + new_line; new_line; + font on; +]; + +! ================================================================================================= +! This is the top-level control loop. + +[ Main; + + @setiosys 2 0; ! Set Glk as the VM's I/O layer. + gg_mainwin = ! Open the main window. + glk_window_open(0, 0, 0, wintype_TextBuffer, ANY_OLD_ROCK); + glk_set_window(gg_mainwin); ! Make it the current window. + + glk_set_style(style_Header); + print "INSTRUCTOR 1.2"; + glk_set_style(style_Normal); + print "^A tool for reformatting Inform source files.^^"; + ShowHelp(); ! Explain what they can do. + + while (true) { ! Loop here until "Q" typed. + ShowStatus(); + print "> "; ! Prompt for a line of input. + if (~~ParseLine()) continue; ! Nothing typed + Tokens-->0 = theInput->(TokenStart->0); + Tokens-->1 = ParseNumber(TokenStart->1, TokenEnd->1); + switch (Tokens-->0) { ! Deal with the character, then loop back. + 'C','c': DoCommentColumn(); + 'I','i': DoIndentSize(); + 'M','m': DoMarginColumn(); + 'N','n': DoReformat(); + 'Q','q': DoQuit(); + '?','/': ShowHelp(); + default: print "Possible keys are N, Q, I, C, M and ?^"; + } + } +]; + +! ================================================================================================= +! I/O handling. + +[ InputLine buf buflen; ! Input a line of characters. + glk_request_line_event(gg_mainwin, buf, buflen, 0); + while (true) { ! Wait for RETURN to be pressed. + glk_select(gg_event); ! LineInput is the only interesting event. + if (gg_event-->0 == evtype_LineInput && gg_event-->1 == gg_mainwin) + return (gg_event-->2); ! Number of characters. + } +]; + +[ ParseLine ! Read line of input, find tokens + i j n; + for (i=0 : ii = TokenEnd->i = 0; + n = InputLine(theInput, MAX_INPUT); + glk_select_poll(gg_event); + if (n == 0) rfalse; ! Nothing typed. + for (i=j=0 : ij == SPACE or COMMA) { + j++; + if (j >= n) return i; + } + TokenStart->i = j; + while (theInput->j ~= SPACE or COMMA) { + j++; + TokenEnd->i = j; + if (j >= n) return i+1; + } + } + return i; +]; + +[ ParseNumber a b ! Parse token as bin/dec/hex number. + char base num i; + if (a == b) return -1; + base = 10; num = 0; + i = a; + if (theInput->i == '-') i++; + if (theInput->i == '$') { + base = 16; i++; + if (theInput->i == '$') { base = 2; i++; } + } + for ( : ii; + if (char >= '0' && char <= '9') char = char - '0'; + else { + if (char >= 'A' && char <= 'Z') char = char - 'A' + 10; + else { + if (char >= 'a' && char <= 'z') char = char - 'a' + 10; + else return -1; + } + } + if (char < base) num = (num * base) + char; + else return -1; + } + if (theInput->a == '-') num = -num; + return num; +]; + +[ OpenSourceForRead + fileref; + fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Read, ANY_OLD_ROCK); + if (fileref == GLK_NULL) "Failed to create Source fileref."; + sourceStream = glk_stream_open_file(fileref, filemode_Read, ANY_OLD_ROCK); + if (sourceStream == GLK_NULL) "Failed to open Source stream."; + glk_fileref_destroy(fileref); + rfalse; ! Successful -- OK to continue. +]; + +[ OpenTargetForWrite + fileref; + fileref = glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Data, filemode_Write, ANY_OLD_ROCK); + if (fileref == GLK_NULL) "Failed to create Target fileref."; + targetStream = glk_stream_open_file(fileref, filemode_Write, ANY_OLD_ROCK); + if (targetStream == GLK_NULL) "Failed to open Target stream."; + glk_fileref_destroy(fileref); + rfalse; ! Successful -- OK to continue. +]; + +! ================================================================================================= +! Quit from the utility. + +[ DoQuit; + print "Hit any key to exit.^"; quit; +]; + +! ================================================================================================= +! Set indent size. + +[ DoIndentSize; + if (Tokens-->1 < 0) + indentSize = DEFAULT_INDENT; + else + indentSize = Tokens-->1; +]; + +! ================================================================================================= +! Set inline comment column. + +[ DoCommentColumn; + if (Tokens-->1 < 0) + commentColumn = DEFAULT_COMMENT; + else + commentColumn = Tokens-->1; +]; + +! ================================================================================================= +! Set right margin column. + +[ DoMarginColumn; + if (Tokens-->1 < 0) + marginColumn = DEFAULT_MARGIN; + else + marginColumn = Tokens-->1; +]; + +! ================================================================================================= +! Reformat the source. + +[ DoReformat + lex x; + + print "First, specify an Inform source file to be reformatted.^"; + glk_select_poll(gg_event); + if (OpenSourceForRead()) return; + + print "Now, specify a DIFFERENT file to hold the reformatted output.^"; + glk_select_poll(gg_event); + if (OpenTargetForWrite()) { glk_stream_close(sourceStream, GLK_NULL); return; } + + currentState = STATE_NONE; + nextWhite = NEXT_NONE; + sourceLine = sourceLen = sourceP1 = sourceP2 = sourceP3 = 0; + previousLex = parenCount = outputLen = currentIndent = 0; + + prevLineBlank = true; + routineIsEmbedded = directiveIsEmbedded = mapDQtoSQ = false; + + ! Break the source file into lexemes. + + for (lex=GetLexeme() : lex : lex=GetLexeme()) { + + ! Deal with newlines and comments. + + if (lex == LEX_NEWLINE) { + switch (nextWhite) { + NEXT_NEWLINE: PutNL(1); + NEXT_BLANKLINE: PutNL(2); + } + continue; + } + if (lex == LEX_COMMENT) { + if (outputLen) { + PutSpace(commentColumn-outputLen); + nextWhite = NEXT_SPACE; + } + else + nextWhite = NEXT_NONE; + PrintLexeme(lex); PutNL(1); + continue; + } + switch (nextWhite) { + NEXT_NEWLINE: PutNL(1); + NEXT_BLANKLINE: PutNL(2); + } + + ! Set up default spacing for this lexeme. + + switch (lex) { + LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG1 to LEX_SEPG1_END: + nextWhite = NEXT_NONE; + LEX_SEPG2 to LEX_SEPG2_END, LEX_SEPG3 to LEX_SEPG3_END: + nextWhite = NEXT_SPACE; + } + + ! Handle the lexeme according to the current major state. + + switch (currentState) { + + ! At outermost level of source. + + STATE_NONE: + print "* "; glk_select_poll(gg_event); + currentIndent = 0; + switch (lex) { + LEX_IDENT: ! New directive. + x = MatchString(theSource, sourceP1, sourceP2, Directives); + if (x) switch (Directives-->x) { + DirCla: + nextWhite = NEXT_BLANKLINE; + currentState = STATE_CLASS_HEADER; + DirObj,DirNby: + nextWhite = NEXT_BLANKLINE; + currentState = STATE_OBJECT_HEADER; + DirVrb,DirExt: + nextWhite = NEXT_BLANKLINE; + currentState = STATE_VERB; + if (fixBadSyntax) mapDQtoSQ = true; + default: + currentState = STATE_OTHER_DIR; + } + else { ! Must be a user-defined class. + nextWhite = NEXT_BLANKLINE; + currentState = STATE_OBJECT_HEADER; + } + if (fixBadSyntax && Directives-->x == DirNby) { + PutChar('O'); PutChar('b'); PutChar('j'); PutChar('e'); PutChar('c'); PutChar('t'); + PutChar(' '); PutChar(' '); PutChar('-'); PutChar('>'); + nextWhite = NEXT_SPACE; + } + else { + PrintDirective(); + if (currentState == STATE_CLASS_HEADER or STATE_OBJECT_HEADER) + PutSpace(indentSize*2-sourceP2+sourceP1); + } + LEX_LBRCKT: ! New standalone routine. + nextWhite = NEXT_BLANKLINE; PrintLexeme(lex); + currentIndent = 1; ControlReset(); + currentState = STATE_ROUTINE; routineIsEmbedded = false; + LEX_HASH: ! Prefix to new directive. + PrintLexeme(lex); + default: + PrintLexeme(lex); + "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_NONE."; + } + + ! Standalone or Embedded routine. + + STATE_ROUTINE: + switch (ControlGet()) { + CONTROL_IF_SCOPE: + if (lex == LEX_LBRACE) + ControlSet(CONTROL_IF_MULTI); + else { + ControlSet(CONTROL_IF_SINGLE); + currentIndent++; + nextWhite = NEXT_NEWLINE; + } + CONTROL_XX_SCOPE: + if (lex == LEX_LBRACE) + ControlSet(CONTROL_XX_MULTI); + else { + ControlSet(CONTROL_XX_SINGLE); + currentIndent++; + nextWhite = NEXT_NEWLINE; + } + } + switch (lex) { + LEX_SEMIC: + PrintLexeme(lex); + if (previousLex == LEX_RBRCKT && ~~routineIsEmbedded) { + currentState = STATE_NONE; + nextWhite = NEXT_BLANKLINE; + } + while (ControlGet() == CONTROL_XX_SINGLE) { + ControlPop(); + currentIndent--; + } + if (ControlGet() == CONTROL_IF_SINGLE) { + ControlSet(CONTROL_IF_ELSE); + currentIndent--; + } + LEX_RBRCKT: + if (routineIsEmbedded) { + currentState = STATE_OBJECT_BODY; + currentIndent = 2; + } + else + currentIndent = 0; + PrintLexeme(lex); + LEX_HASH: + if (outputLen == 0) { ! Prefix to new directive. + PrintLexeme(lex); + lex = GetLexeme(); + PrintDirective(); + currentState = STATE_OTHER_DIR; directiveIsEmbedded = true; + } + else + PrintLexeme(lex); + LEX_LBRACE: + PrintLexeme(lex); + currentIndent++; + LEX_RBRACE: + currentIndent--; + if (ControlGet() == CONTROL_IF_MULTI) { + ControlSet(CONTROL_IF_ELSE); + PrintLexeme(lex); + } + else { + if (ControlGet() == CONTROL_IF_ELSE) { + ControlPop(); + while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) { + ControlPop(); + currentIndent--; + } + if (ControlGet() == CONTROL_IF_MULTI) + ControlSet(CONTROL_IF_ELSE); + } + PrintLexeme(lex); + if (ControlGet() == CONTROL_XX_MULTI) { + ControlPop(); + while (ControlGet() == CONTROL_XX_SINGLE) { + ControlPop(); + currentIndent--; + } + if (ControlGet() == CONTROL_IF_SINGLE) { + ControlSet(CONTROL_IF_ELSE); + currentIndent--; + } + } + } + LEX_COLON: + if (parenCount == 0) { + PullSpace(indentSize/2); PrintLexeme(lex); nextWhite = NEXT_NEWLINE; + } else { + nextWhite = NEXT_SPACE; PrintLexeme(lex); + } + LEX_DOT: + if (outputLen) + PrintLexeme(lex); + else + { nextWhite = NEXT_NEWLINE; PrintLexeme(lex); PullSpace(indentSize/2); } + LEX_LPAREN, LEX_PLUSPLUS, LEX_MINUSMINUS: + if (previousLex == LEX_IDENT or LEX_LPAREN or LEX_PLUSPLUS or LEX_MINUSMINUS) + nextWhite = NEXT_NONE; + PrintLexeme(lex); + LEX_RPAREN: + PrintLexeme(lex); + if (parenCount == 0) { + if (ControlGet() == CONTROL_IF_COND) ControlSet(CONTROL_IF_SCOPE); + if (ControlGet() == CONTROL_XX_COND) ControlSet(CONTROL_XX_SCOPE); + } + LEX_MINUS: + PrintLexeme(lex); + if (previousLex ~= LEX_IDENT or LEX_NUMBER or LEX_RPAREN) + nextWhite = NEXT_NONE; + LEX_IDENT: + x = MatchString(theSource, sourceP1, sourceP2, Statements); + if (ControlGet() == CONTROL_IF_ELSE && ~~(x && Statements-->x == SmtEls)) { + ControlPop(); + while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) { + ControlPop(); + currentIndent--; + } + } + if (x) { + lex = LEX_STATEMENT; + switch (Statements-->x) { + SmtIf_: + ControlPush(CONTROL_IF_COND); + SmtFor, SmtWhi, SmtSwi, SmtObj: + ControlPush(CONTROL_XX_COND); + SmtDo_: + ControlPush(CONTROL_XX_SCOPE); + SmtEls: + ControlSet(CONTROL_XX_SCOPE); + } + } + if (previousLex == LEX_PLUSPLUS or LEX_MINUSMINUS) + nextWhite = NEXT_NONE; + PrintLexeme(lex); + LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END: + if (ControlGet() == CONTROL_IF_ELSE) { + ControlPop(); + while (ControlGet() == CONTROL_IF_SINGLE or CONTROL_XX_SINGLE) { + ControlPop(); + currentIndent--; + } + } + PrintLexeme(lex); + default: + PrintLexeme(lex); + "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_ROUTINE."; + } + + ! Class or Object directive, in header. + + STATE_CLASS_HEADER, + STATE_OBJECT_HEADER: + switch (lex) { + LEX_SEMIC: + PrintLexeme(lex); nextWhite = NEXT_BLANKLINE; + currentState = STATE_NONE; + LEX_IDENT: + if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) { + PutNL(1); + currentIndent = 2; + PrintLexeme(lex); + PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1); + currentState = STATE_OBJECT_BODY; + } + else { + if (currentState == STATE_CLASS_HEADER) + PrintDirective(); + else + PrintLexeme(lex); + } + LEX_ARROW, LEX_DQ_STRING: + nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE; + LEX_LPAREN, LEX_NUMBER, LEX_RPAREN: + nextWhite = NEXT_NONE; PrintLexeme(lex); + LEX_COMMA: ! don't need a comma here + if (~~fixBadSyntax) PrintLexeme(lex); + default: + PrintLexeme(lex); + "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_CLASS/OBJECT_HEADER."; + } + + ! Class or Object directive, in body. + + STATE_OBJECT_BODY: + switch (lex) { + LEX_SEMIC: + PrintLexeme(lex); nextWhite = NEXT_BLANKLINE; + currentState = STATE_NONE; + currentIndent = 0; + mapDQtoSQ = false; + LEX_LBRCKT: ! New embedded routine. + PrintLexeme(lex); + currentIndent++; ControlReset(); + currentState = STATE_ROUTINE; routineIsEmbedded = true; + LEX_COMMA: + PrintLexeme(lex); nextWhite = NEXT_NEWLINE; + mapDQtoSQ = false; + LEX_IDENT: + if (MatchString(theSource, sourceP1, sourceP2, ObjSegments)) { + if (previousLex ~= LEX_COMMA) { + if (fixBadSyntax) PutChar(','); + PutNL(1); + } + PrintLexeme(lex); + PullSpace(2*indentSize-2); PutSpace(2*indentSize-2-sourceP2+sourceP1); + mapDQtoSQ = false; + } + else { + if (fixBadSyntax && MatchString(theSource, sourceP1, sourceP2, Properties)) mapDQtoSQ = true; + PrintLexeme(lex); + } + LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END: + PrintLexeme(lex); + default: + PrintLexeme(lex); + "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OBJECT_BODY."; + } + + ! Verb directive. + + STATE_VERB: + switch (lex) { + LEX_SEMIC: + PrintLexeme(lex); nextWhite = NEXT_BLANKLINE; + currentState = STATE_NONE; + currentIndent = 0; + mapDQtoSQ = false; + LEX_ASTERISK: + currentIndent = 1; + nextWhite = NEXT_NEWLINE; PrintLexeme(lex); + LEX_ARROW: + nextWhite = NEXT_SPACE; PrintLexeme(lex); nextWhite = NEXT_SPACE; + LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END: + PrintLexeme(lex); + default: + PrintLexeme(lex); + "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_VERB."; + } + + ! Other directive (not Class/Object/Verb). + + STATE_OTHER_DIR: + switch (lex) { + LEX_SEMIC: + PrintLexeme(lex); + if (directiveIsEmbedded) { + currentState = STATE_ROUTINE; directiveIsEmbedded = false; + } + else { + currentState = STATE_NONE; + currentIndent = 0; + } + LEX_VALUE to LEX_VALUE_END, LEX_SEPARATE to LEX_SEPARATE_END: + PrintLexeme(lex); + default: + PrintLexeme(lex); + "INSPECTOR bug at source line ", sourceLine, ": unexpected lexeme in STATE_OTHER_DIR."; + } + + } ! end of switch(currentState) + previousLex = lex; + } + if (outputlen) PutNL(1); + + glk_stream_close(sourceStream, GLK_NULL); + glk_stream_close(targetStream, GLK_NULL); + "^^OK"; +]; + +[ MatchString buf p1 p2 tab + i j k len str; + len = p2 - p1; + for (i=1 : i<=tab-->0 : i++) { + str = tab-->i; + if (str->0 < len) continue; + if (str->0 > len) rfalse; + for (j=1,k=p1 : j<=len : j++,k++) + if ((str->j | $20) ~= (buf->k | $20)) jump tryNext; + return i; + .tryNext; + } + rfalse; +]; + +! ================================================================================================= +! Stack for control structuress. + +Constant MAX_STACK 20; ! Nested control structures. +Array controlStack --> MAX_STACK; + +Constant CONTROL_IF_COND 10; ! Looking for end of IF condition +Constant CONTROL_IF_SCOPE 11; ! Looking for { after IF condition +Constant CONTROL_IF_SINGLE 12; ! Controlling a single statement +Constant CONTROL_IF_MULTI 13; ! Controlling multiple statements +Constant CONTROL_IF_ELSE 14; ! Looking for ELSE after IF statement +Constant CONTROL_XX_COND 20; ! Looking for end of other condition +Constant CONTROL_XX_SCOPE 21; ! Looking for { after other condition +Constant CONTROL_XX_SINGLE 22; ! Controlling a single statement +Constant CONTROL_XX_MULTI 23; ! Controlling multiple statements + +[ ControlPush val + p; + p = (controlStack-->0) + 1; + if (p == MAX_STACK) { + print "Stack overflow: increase MAX_STACK and recompile.^"; + DoQuit(); + } + controlStack-->0 = p; + controlStack-->p = val; +]; + +[ ControlPop + p; + p = controlStack-->0; + if (p) { + (controlStack-->0)--; + p = controlStack-->p; + } + return p; +]; + +[ ControlSet val + p; + p = controlStack-->0; + if (p) + controlStack-->p = val; + else + "INSPECTOR bug at source line ", sourceLine, ": StackSet on empty stack."; +]; + +[ ControlGet + p; + p = controlStack-->0; + if (p) + p = controlStack-->p; + return p; +]; + +[ ControlReset; controlStack-->0 = 0; ]; + +! [ ControlDebug x +! i; +! new_line; +! switch (x) { +! 0: print "Xxx "; +! 1: print "Psh "; +! 2: print "Pop "; +! 3: print "Set "; +! 4: print "Get "; +! default: print x, " "; +! } +! for (i=1 : i<=controlStack-->0 : i++) { +! print i,":"; +! switch (controlStack-->i) { +! 0: print "none "; +! CONTROL_IF_COND: print "IfCo "; +! CONTROL_IF_SCOPE: print "IfSc "; +! CONTROL_IF_SINGLE:print "IfSi "; +! CONTROL_IF_MULTI: print "IfMu "; +! CONTROL_IF_ELSE: print "IfEl "; +! CONTROL_XX_COND: print "XxCo "; +! CONTROL_XX_SCOPE: print "XxSc "; +! CONTROL_XX_SINGLE:print "XxSi "; +! CONTROL_XX_MULTI: print "XxMu "; +! } +! } +! new_line; +! ]; + +! ================================================================================================= + +[ GetLexeme + c rval; + + if (sourceLen == 0) { ! Need next line of source. + sourceLen = ReadSourceLine(); + if (sourceLen == 0) rfalse; ! End-of-file. + sourceP1 = 0; ! Start of buffer. + } + else + sourceP1 = sourceP2; ! Continue from last time. + + ! Ignore leading whitespace. + + while (isWhiteSpace(theSource->sourceP1)) sourceP1++; + if (theSource->sourceP1 == NEWLINE) { + sourceLen = 0; + return LEX_NEWLINE; + } + + ! Found start of lexeme. + + sourceP2 = sourceP1 + 1; + switch (theSource->sourceP1) { + + '_', 'A' to 'Z', 'a' to 'z': ! identifier + while (isIdentifier(theSource->sourceP2)) sourceP2++; + rval = LEX_IDENT; + + '0' to '9': ! decimal number + while (isDecimal(theSource->sourceP2)) sourceP2++; + rval = LEX_NUMBER; + + '$': ! hex/binary number + if (theSource->sourceP2 == '$') { + sourceP2++; + while(isBinary(theSource->sourceP2)) sourceP2++; + } + else { + while(isHex(theSource->sourceP2)) sourceP2++; + } + rval = LEX_NUMBER; + + '"': ! "..." string + theString->0 = theSource->sourceP1; + sourceP3 = 1; + do { + if (sourceP3 == MAX_STRING) { + print "String too long: increase MAX_STRING and recompile.^"; + DoQuit(); + } + c = theSource->(sourceP2++); theString->(sourceP3++) = c; + if (c == NEWLINE) { + do { + sourceLen = ReadSourceLine(); + sourceP2 = 0; + while (isWhiteSpace(theSource->sourceP2)) sourceP2++; + } until (theSource->sourceP2 ~= NEWLINE); + } + } until (c == '"'); + rval = LEX_DQ_STRING; + + SQUOTE: ! '...' string + while (theSource->sourceP2 ~= SQUOTE) sourceP2++; + sourceP2++; + rval = LEX_SQ_STRING; + + '!': ! comment + sourceP2 = sourceLen - 1; + rval = LEX_COMMENT; + + '#': + switch (theSource->sourceP2) { + '#': sourceP2++; rval = LEX_SEPG2_END; ! ## + 'a': + switch (theSource->(sourceP2+1)) { + '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #a$ + default: rval = LEX_HASH; ! # + } + 'n': + switch (theSource->(sourceP2+1)) { + '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #n$ + default: rval = LEX_HASH; ! # + } + 'r': + switch (theSource->(sourceP2+1)) { + '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #r$ + default: rval = LEX_HASH; ! # + } + 'w': + switch (theSource->(sourceP2+1)) { + '$': sourceP2 = sourceP2+2; rval = LEX_SEPG2_END; ! #w$ + default: rval = LEX_HASH; ! # + } + default: rval = LEX_HASH; ! # + } + + '%': rval = LEX_SEPG3_END; ! % + + '&': + switch (theSource->sourceP2) { + '&': sourceP2++; rval = LEX_SEPG3_END; ! && + default: rval = LEX_SEPG3_END; ! & + } + + '(': rval = LEX_LPAREN; ! ( + parenCount++; + + ')': rval = LEX_RPAREN; ! ) + parenCount--; + + '*': rval = LEX_ASTERISK; ! * + + '+': + switch (theSource->sourceP2) { + '+': sourceP2++; rval = LEX_PLUSPLUS; ! ++ + default: rval = LEX_SEPG3_END; ! + + } + + ',': rval = LEX_COMMA; ! , + + '-': + switch (theSource->sourceP2) { + '-': + sourceP2++; switch (theSource->sourceP2) { + '>': sourceP2++; rval = LEX_SEPG0_END; ! --> + default: rval = LEX_MINUSMINUS; ! -- + } + '>': sourceP2++; rval = LEX_ARROW; ! -> + default: rval = LEX_MINUS; ! - + } + + '.': + switch (theSource->sourceP2) { + '.': + sourceP2++; switch (theSource->sourceP2) { + '#': sourceP2++; rval = LEX_SEPG0_END; ! ..# + '&': sourceP2++; rval = LEX_SEPG0_END; ! ..& + default: rval = LEX_SEPG0_END; ! .. + } + '#': sourceP2++; rval = LEX_SEPG0_END; ! .# + '&': sourceP2++; rval = LEX_SEPG0_END; ! .& + default: rval = LEX_DOT; ! . + } + + '/': rval = LEX_SEPG3_END; ! / + + ':': + switch (theSource->sourceP2) { + ':': sourceP2++; rval = LEX_SEPG0_END; ! :: + default: rval = LEX_COLON; ! : + } + + ';': rval = LEX_SEMIC; ! ; + + '<': + switch (theSource->sourceP2) { + '=': sourceP2++; rval = LEX_SEPG3_END; ! <= + '<': sourceP2++; rval = LEX_LTLT; ! << + default: rval = LEX_SEPG3_END; ! < + } + + '=': + switch (theSource->sourceP2) { + '=': sourceP2++; rval = LEX_SEPG3_END; ! == + default: rval = LEX_SEPG3_END; ! = + } + + '>': + switch (theSource->sourceP2) { + '=': sourceP2++; rval = LEX_SEPG3_END; ! >= + '>': sourceP2++; rval = LEX_SEPG0_END; ! >> + default: rval = LEX_SEPG3_END; ! > + } + + '?': + switch (theSource->sourceP2) { + '~': sourceP2++; rval = LEX_SEPG2_END; ! ?~ + default: rval = LEX_SEPG2_END; ! ? + } + + ATSIGN: rval = LEX_SEPG2_END; ! @ + + '[': rval = LEX_LBRCKT; ! [ + + ']': rval = LEX_RBRCKT; ! ] + + '{': rval = LEX_LBRACE; ! { + + '}': rval = LEX_RBRACE; ! } + + '|': + switch (theSource->sourceP2) { + '|': sourceP2++; rval = LEX_SEPG3_END; ! || + default: rval = LEX_SEPG3_END; ! | + } + + '~': + switch (theSource->sourceP2) { + '=': sourceP2++; rval = LEX_SEPG3_END; ! ~= + '~': sourceP2++; rval = LEX_SEPG2_END; ! ~~ + default: rval = LEX_TILDE; ! ~ + } + + default: rval = LEX_INVALID; ! Not valid. + } + return rval; +]; + +[ isWhiteSpace c; + if (c == ' ' or TAB) rtrue; + rfalse; +]; + +[ isBinary c; + if (c == '0' or '1') rtrue; + rfalse; +]; + +[ isDecimal c; + if (c >= '0' && c <= '9') rtrue; + rfalse; +]; + +[ isHex c; + if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f')) rtrue; + rfalse; +]; + +[ isIdentifier c; + if ((c >= '0' && c <='9') || (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c == '_')) rtrue; + rfalse; +]; + +[ ReadSourceChar + c; + if (savedChar) { c = savedChar; savedChar = 0; } + else c = glk_get_char_stream(sourceStream); + if (c == NEWLINE or RETURN) { + savedChar = glk_get_char_stream(sourceStream); + if (savedChar == NEWLINE or RETURN && savedChar ~= c) savedChar = 0; + c = NEWLINE; + } + return c; +]; + +[ ReadSourceLine + c len; + do { + c = ReadSourceChar(); + if (c == -1) ! end of stream + if (len) c = NEWLINE; else return 0; + if (len == MAX_SOURCE) { + print "Source line too long: increase MAX_SOURCE and recompile.^"; + DoQuit(); + break; + } + theSource->len++ = c; + } until (c == NEWLINE); + sourceLine++; + return len; +]; + +! [ ReadSourceLine +! len; +! len = glk_get_line_stream(sourceStream, theSource, MAX_SOURCE); +! sourceLine++; +! if (len && theSource->(len-1) ~= NEWLINE) +! if (len == MAX_SOURCE-1) { +! print "Source line too long: increase MAX_SOURCE and recompile.^"; +! DoQuit(); +! } +! else +! theSource->(len++) = NEWLINE; +! return len; +! ]; + +! ================================================================================================= + +[ PrintDirective + i; + switch (nextWhite) { + NEXT_NONE: + ; + NEXT_SPACE: + if (marginColumn > 0 && outputLen > marginColumn) + PutNL(1); + else + PutSpace(1); + NEXT_NEWLINE: + PutNL(1); + NEXT_BLANKLINE: + PutNL(2); + } + i = sourceP1; + PutUpper(theSource->i); + for (i++ : ii); + nextWhite = NEXT_SPACE; +]; + +[ PrintLexeme lex + i; + switch (nextWhite) { + NEXT_NONE: + ; + NEXT_SPACE: + if (marginColumn > 0 && outputLen > marginColumn && lex ~= LEX_COMMENT) + PutNL(1); + else + PutSpace(1); + NEXT_NEWLINE: + PutNL(1); + NEXT_BLANKLINE: + PutNL(2); + } + + if (lex == LEX_DQ_STRING) { + if (outputLen) + for (i=0 : ii == NEWLINE) { + currentIndent++; + PutNL(1); + for (i=0 : ii); + currentIndent--; + jump Done; + } + if (mapDQtoSQ) { +! theString->0 = theString->(sourceP3-1) = SQUOTE; ! avoid compiler bug + theString->0 = SQUOTE; + theString->(sourceP3-1) = SQUOTE; + } + for (i=0 : ii); + } + else + for (i=sourceP1 : ii == TAB) + PutChar(SPACE); + else + PutChar(theSource->i); + + .Done; + + switch (lex) { + LEX_SEMIC, LEX_LBRACE, LEX_RBRACE: + nextWhite = NEXT_NEWLINE; + LEX_VALUE to LEX_VALUE_END, LEX_SEPG4 to LEX_SEPG4_END, + LEX_SEPG1 to LEX_SEPG1_END, LEX_SEPG3 to LEX_SEPG3_END: + nextWhite = NEXT_SPACE; + LEX_SEPG0 to LEX_SEPG0_END, LEX_SEPG2 to LEX_SEPG2_END: + nextWhite = NEXT_NONE; + } +]; + +[ PutChar c; + if (c == NEWLINE) return PutNL(1); + if (outputLen == 0) { + for ( : outputLenoutputLen = SPACE; + if (c == SPACE) return; + } + if (outputLen == MAX_OUTPUT) { + print "Output line too long: increase MAX_OUTPUT and recompile.^"; + DoQuit(); + } + theOutput->outputLen = c; + outputLen++; +]; + +[ PutUpper c; PutChar(glk_char_to_upper(c)); ]; + +[ PutLower c; PutChar(glk_char_to_lower(c)); ]; + +[ PutSpace n; + if (n < 1) n = 1; + if (outputLen && theOutput->(outputLen-1) ~= SPACE) + while (n-- > 0) PutChar(SPACE); + nextWhite = NEXT_NONE; +]; + +[ PullSpace n + i; + for (i=0 : ii ~= SPACE) break; + n = i; + for ( : i(i-n) = theOutput->i; + outputLen = outputLen - n; +]; + +[ PutNL n; +! i j; + while (n--) { + if (outputLen) { +! j = 0; +! if (indentWithTabs) { +! for (j=0 : jj ~= SPACE) break; +! for (i=0 : i