!% -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 <num> - specify the size of each indentation.^
     I       - reset to default of ", DEFAULT_INDENT, ".^
     C <num> - specify the column to align inline comment (0 for no alignment).^
     C       - reset to default of ", DEFAULT_COMMENT, ".^
     M <num> - 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 : i<MAX_TOKENS : i++) TokenStart->i = TokenEnd->i = 0;
    n = InputLine(theInput, MAX_INPUT);
    glk_select_poll(gg_event);
    if (n == 0) rfalse;                 ! Nothing typed.
    for (i=j=0 : i<MAX_TOKENS : i++) {
        while (theInput->j == 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 ( : i<b : i++) {
        char = theInput->i;
        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++ : i<sourceP2 : i++) PutLower(theSource->i);
    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 : i<sourceP3 : i++)
                if (theString->i == NEWLINE) {
                    currentIndent++;
                    PutNL(1);
                    for (i=0 : i<sourceP3 : i++) PutChar(theString->i);
                    currentIndent--;
                    jump Done;
                }
        if (mapDQtoSQ) {
!           theString->0 = theString->(sourceP3-1) = SQUOTE; ! avoid compiler bug
            theString->0 = SQUOTE;
            theString->(sourceP3-1) = SQUOTE;
        }
        for (i=0 : i<sourceP3 : i++) PutChar(theString->i);
    }
    else
        for (i=sourceP1 : i<sourceP2 : i++)
            if (theSource->i == 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 ( : outputLen<indentSize*currentIndent : outputLen++) theOutput->outputLen = 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 : i<n : i++) if (theOutput->i ~= SPACE) break;
    n = i;
    for ( : i<outputLen : i++) theOutput->(i-n) = theOutput->i;
    outputLen = outputLen - n;
];

[ PutNL n;
!   i j;
    while (n--) {
        if (outputLen) {
!           j = 0;
!           if (indentWithTabs) {
!               for (j=0 : j<outputLen : j++) if (theOutput->j ~= SPACE) break;
!               for (i=0 : i<j/indentSize : i++) print (char) TAB;
!               j = j - j%indentSize;
!           }
            glk_put_buffer_stream(targetStream, theOutput, outputLen);
            outputLen = 0;
            glk_put_char_stream(targetStream, NEWLINE);
            prevLineBlank = false;
        }
        else
            if (~~prevLineBlank) {
                glk_put_char_stream(targetStream, NEWLINE);
                prevLineBlank = true;
            }
    }
    nextWhite = NEXT_NONE;
];

! =================================================================================================