(*$R-,L-*) PROGRAM INDENT(SOURCE, INPUT, OUTPUT); CONST SMALLINDENT=2; MIDINDENT=2; LARGEINDENT=4; TYPE STATETYPE = (OPENER, MIDDLER, CLOSER, PRAGMENT, DOER, QUOTE, COLON, GO, STROP, OTHER); CLAUSETYPE = (BRIEF, CONDCL, CASECL, CLOSEDCL, LOOPCL, INDEXER, ROUTINE, JUMP, EXIT, SEMICOMMA, STRING, HASH, CO, COMMENT, PR, PRAGMAT, UPPER, POINT, ANY); TREEP=^TREE; TREE=RECORD (*TREE TO HOLD RESERVED WORD DICTIONARY*) C: CHAR; LEFT, RIGHT, NEXT: TREEP; TIP: BOOLEAN; ST: STATETYPE; CL: CLAUSETYPE; END; STACKP=^STACK; STACK=PACKED RECORD C: CLAUSETYPE; G: BOOLEAN; NEXT: STACKP END; ALFA=PACKED ARRAY [1..10] OF CHAR; VAR SOURCE: TEXT; ROOT: TREEP; TOS: STACKP; VETTEDCHARACTER: RECORD WORD: PACKED ARRAY [1..80] OF CHAR; (*THE LONGEST CONCEIVABLE BOLDWORD!*) INDEX: 0..80; END; STARTOFLINE, LINENUMBERS: BOOLEAN; (*TRUE IFF THE SOURCE TEXT INCLUDES LINE NUMBERS*) I: INTEGER; INDENT, (*EXPECTED INDENT FOR SUBSEQUENT LINES*) TEMPINDENT: INTEGER; (*INDENT FOR CURRENT LINE*) INSTRAGMENT: BOOLEAN; STROPSTATE: (INPOINT, INUPPER, INPRAGP, INPRAGUP); GONEON: BOOLEAN; (*TRUE IFF THE LAST TOKEN WAS AN OPENER OR A MIDDLER*) (**) (**) (**) PROCEDURE SETUPTREE; (*TO CREATE THE DICTIONARY*) PROCEDURE INSERT(WORD: ALFA; S: STATETYPE; B: CLAUSETYPE); VAR TREEPTR: TREEP; INDEX: INTEGER; FOUND: BOOLEAN; BEGIN TREEPTR := ROOT; INDEX := 1; WHILE WORD[INDEX]<>' ' DO BEGIN WITH TREEPTR^ DO BEGIN IF TREEPTR^.NEXT=NIL THEN BEGIN NEW(NEXT); WITH NEXT^ DO BEGIN C := WORD[INDEX]; LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL END END; TREEPTR := NEXT END; FOUND := FALSE; WHILE NOT FOUND DO WITH TREEPTR^ DO IF WORD[INDEX]C THEN BEGIN IF RIGHT=NIL THEN BEGIN NEW(RIGHT); WITH RIGHT^ DO BEGIN C := WORD[INDEX]; LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL END; FOUND := TRUE END; TREEPTR := RIGHT END ELSE FOUND := TRUE; INDEX := INDEX+1 END; WITH TREEPTR^ DO BEGIN TIP := TRUE; ST := S; CL := B END END (*INSERT*); (**) BEGIN (*SETUPTREE*) NEW(ROOT); ROOT^.NEXT := NIL; INSERT('( ', OPENER , BRIEF ); INSERT('IF ', OPENER , CONDCL ); INSERT('if ', OPENER , CONDCL ); INSERT('CASE ', OPENER , CASECL ); INSERT('case ', OPENER , CASECL ); INSERT('BEGIN ', OPENER , CLOSEDCL ); INSERT('begin ', OPENER , CLOSEDCL ); INSERT('[ ', OPENER , INDEXER ); INSERT('! ', MIDDLER , BRIEF ); INSERT('THEN ', MIDDLER , CONDCL ); INSERT('then ', MIDDLER , CONDCL ); INSERT('IN ', MIDDLER , CASECL ); INSERT('in ', MIDDLER , CASECL ); INSERT('ELIF ', MIDDLER , CONDCL ); INSERT('elif ', MIDDLER , CONDCL ); INSERT('ELSE ', MIDDLER , CONDCL ); INSERT('else ', MIDDLER , CONDCL ); INSERT('OUSE ', MIDDLER , CASECL ); INSERT('ouse ', MIDDLER , CASECL ); INSERT('OUT ', MIDDLER , CASECL ); INSERT('out ', MIDDLER , CASECL ); INSERT('EXIT ', MIDDLER , EXIT ); INSERT('exit ', MIDDLER , EXIT ); INSERT('; ', MIDDLER , SEMICOMMA); INSERT(', ', MIDDLER , SEMICOMMA); INSERT(') ', CLOSER , BRIEF ); INSERT('FI ', CLOSER , CONDCL ); INSERT('fi ', CLOSER , CONDCL ); INSERT('ESAC ', CLOSER , CASECL ); INSERT('esac ', CLOSER , CASECL ); INSERT('END ', CLOSER , CLOSEDCL ); INSERT('end ', CLOSER , CLOSEDCL ); INSERT('] ', CLOSER , INDEXER ); INSERT('# ', PRAGMENT, HASH ); INSERT('CO ', PRAGMENT, CO ); INSERT('co ', PRAGMENT, CO ); INSERT('COMMENT ', PRAGMENT, COMMENT ); INSERT('comment ', PRAGMENT, COMMENT ); INSERT('PR ', PRAGMENT, PR ); INSERT('pr ', PRAGMENT, PR ); INSERT('PRAGMAT ', PRAGMENT, PRAGMAT ); INSERT('pragmat ', PRAGMENT, PRAGMAT ); INSERT('FOR ', DOER , LOOPCL ); INSERT('for ', DOER , LOOPCL ); INSERT('FROM ', DOER , LOOPCL ); INSERT('from ', DOER , LOOPCL ); INSERT('BY ', DOER , LOOPCL ); INSERT('by ', DOER , LOOPCL ); INSERT('TO ', DOER , LOOPCL ); INSERT('to ', DOER , LOOPCL ); INSERT('WHILE ', DOER , LOOPCL ); INSERT('while ', DOER , LOOPCL ); INSERT('DO ', DOER , LOOPCL ); INSERT('do ', DOER , LOOPCL ); INSERT('OD ', CLOSER , LOOPCL ); INSERT('od ', CLOSER , LOOPCL ); INSERT('GO ', GO , JUMP ); INSERT('go ', GO , JUMP ); INSERT('" ', QUOTE , STRING ); INSERT('UPPER ', STROP , UPPER ); INSERT('upper ', STROP , UPPER ); INSERT('POINT ', STROP , POINT ); INSERT('point ', STROP , POINT ); (*':' AFTER BOLD , COLON , ROUTINE ); *) END; (**) (**) PROCEDURE PUSH(CL: CLAUSETYPE); VAR TEMP: STACKP; BEGIN TEMP := TOS; NEW(TOS); WITH TOS^ DO BEGIN C := CL; G := GONEON; NEXT := TEMP END END; (**) (**) PROCEDURE POP; VAR TEMP: STACKP; BEGIN IF NOT GONEON AND NOT INSTRAGMENT THEN INDENT := INDENT-MIDINDENT; TEMP := TOS; GONEON := TOS^.G; TOS := TOS^.NEXT; DISPOSE(TEMP) END; (**) (**) PROCEDURE VET(VAR SOURCE: TEXT); (*MOVES NEXT INTERESTING TOKEN TO VETTED CHARACTER, AND SETS INDENT AND TEMPINDENT ACCORDINGLY*) VAR TREEPTR: TREEP; CH: CHAR; STATE: STATETYPE; CLAUSE: CLAUSETYPE; BOLD, FOUND: BOOLEAN; (**) PROCEDURE GAP(VAR SOURCE: TEXT); (*ENSURE THAT AT LEAST (SMALLINDENT-1) BLANKS ARE PRESENT IN OUTPUT*) VAR I: INTEGER; BEGIN I := SMALLINDENT-1; WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') AND (I>0) DO BEGIN GET(SOURCE); I := I-1 END; IF NOT EOLN(SOURCE) THEN FOR I := 2 TO SMALLINDENT DO WITH VETTEDCHARACTER DO BEGIN WORD[I] := ' '; INDEX := I END END; (**) PROCEDURE CHECK(CLAUSE: CLAUSETYPE); BEGIN WITH TOS^ DO IF C<>CLAUSE THEN (*ATTEMPT TO FIX BRACKETS MISMATCH*) IF NEXT^.C=CLAUSE THEN (*ASSUME CLOSER WAS OMITTED*) BEGIN IF C IN [BRIEF, INDEXER] THEN INDENT := INDENT-SMALLINDENT ELSE INDENT := INDENT-LARGEINDENT; POP; IF GONEON THEN BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END END ELSE (*ASSUME OPENER WAS OMITTED*) BEGIN IF CLAUSE IN [BRIEF, INDEXER] THEN INDENT := INDENT+SMALLINDENT ELSE INDENT := INDENT+LARGEINDENT; IF NOT GONEON THEN BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END; PUSH(CLAUSE) END END; (**) BEGIN (*VET*) (*ASSERT: (SOURCE^ IN [(!)[],.#";]) OR (UPPER & SOURCE^ IN [A..Z]) OR INPRAGMAT*) CH := SOURCE^; TEMPINDENT := INDENT; VETTEDCHARACTER.INDEX := 0; CASE STROPSTATE OF INPOINT: BOLD := CH='.'; INUPPER: BOLD := CH IN ['.','A'..'Z']; INPRAGUP,INPRAGP: BOLD := CH IN ['.','A'..'Z','a'..'z']; END; IF CH='.' THEN WITH VETTEDCHARACTER DO BEGIN INDEX := 1; WORD[1] := '.'; GET(SOURCE); CH := SOURCE^ END; TREEPTR := ROOT^.NEXT; FOUND := FALSE; WHILE (TREEPTR<>NIL) AND NOT FOUND DO WITH TREEPTR^ DO IF C=CH THEN WITH VETTEDCHARACTER DO BEGIN INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE); CH := SOURCE^; IF BOLD THEN CASE STROPSTATE OF INPRAGUP,INPRAGP,INPOINT: FOUND := NOT(CH IN ['A'..'Z', 'a'..'z']) AND TIP; INUPPER: FOUND := NOT(CH IN ['A'..'Z']) AND TIP; END ELSE FOUND := TIP; IF NOT FOUND THEN TREEPTR := NEXT END ELSE IF CHSTRING THEN INDENT := INDENT-LARGEINDENT; TEMPINDENT := INDENT END ELSE IF (STROPSTATE IN [INPRAGUP,INPRAGP]) AND (STATE=STROP) THEN IF CLAUSE=UPPER THEN STROPSTATE := INPRAGUP ELSE STROPSTATE := INPRAGP ELSE (*NO ACTION*) ELSE (*NOT INSTRAGMENT*) BEGIN IF STATE IN [MIDDLER, CLOSER] THEN (*MAYBE END OF ROUTINE-TEXT*) WHILE TOS^.C=ROUTINE DO BEGIN POP; INDENT := INDENT-SMALLINDENT; IF GONEON THEN BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END END; (**) IF STATE=GO THEN (*.GO OF .GO .TO*) BEGIN PUSH(JUMP); STATE := OTHER END ELSE IF STATE=DOER THEN (*CHANGE IT TO MIDDLER OR OPENER*) IF TOS^.C=JUMP THEN (*.TO OF .GO .TO*) BEGIN POP; STATE := OTHER END ELSE IF (TOS^.C=LOOPCL) AND NOT GONEON THEN STATE := MIDDLER ELSE STATE := OPENER; (**) IF STATE=COLON THEN (*START OF ROUTINE-TEXT*) BEGIN IF NOT GONEON THEN BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END; PUSH(CLAUSE); INDENT := INDENT+SMALLINDENT END ELSE IF STATE=OPENER THEN (*START OF A NEW INDENT*) BEGIN PUSH(CLAUSE); IF CLAUSE IN [BRIEF, INDEXER] THEN BEGIN INDENT := INDENT+SMALLINDENT; IF STARTOFLINE THEN GAP(SOURCE) END ELSE INDENT := INDENT+LARGEINDENT; GONEON := TRUE END ELSE IF STATE=MIDDLER THEN BEGIN IF NOT (CLAUSE IN [EXIT, SEMICOMMA]) THEN CHECK(CLAUSE); IF NOT GONEON THEN BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END; IF CLAUSE=SEMICOMMA THEN BEGIN TEMPINDENT := INDENT-SMALLINDENT; GAP(SOURCE) END ELSE IF TOS^.C=BRIEF THEN (* ! OR !: OR .EXIT AFTER ( *) BEGIN TEMPINDENT := INDENT-SMALLINDENT; IF STARTOFLINE AND (SOURCE^<>':') AND (CLAUSE<>EXIT) THEN GAP(SOURCE) END ELSE TEMPINDENT := INDENT-LARGEINDENT END ELSE IF STATE=CLOSER THEN (*END OF INDENT*) BEGIN CHECK(CLAUSE); POP; IF CLAUSE IN [BRIEF, INDEXER] THEN INDENT := INDENT-SMALLINDENT ELSE INDENT := INDENT-LARGEINDENT; TEMPINDENT := INDENT; IF GONEON THEN BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END END ELSE IF STATE=PRAGMENT THEN BEGIN TEMPINDENT := INDENT; PUSH(CLAUSE); INSTRAGMENT := TRUE; IF CLAUSE IN [PR,PRAGMAT] THEN STROPSTATE := SUCC(SUCC(STROPSTATE)); IF CLAUSE=HASH THEN BEGIN INDENT := INDENT+SMALLINDENT; IF STARTOFLINE THEN GAP(SOURCE) END ELSE INDENT := INDENT+LARGEINDENT END ELSE IF STATE=QUOTE THEN BEGIN IF GONEON THEN BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END; PUSH(STRING); INSTRAGMENT := TRUE END ELSE (*STATE=OTHER*) IF GONEON THEN BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END END END (*OF VET*); (**) (**) PROCEDURE MAIN(VAR SOURCE: TEXT); VAR I: INTEGER; BEGIN INDENT := 0; INSTRAGMENT := FALSE; STROPSTATE := INUPPER; (*THE DEFAULT is UPPER*) GONEON := TRUE; SETUPTREE; LINENUMBERS := SOURCE^ IN ['0'..'9']; TOS := NIL; PUSH(ANY); PUSH(ANY); WHILE NOT EOF(SOURCE) DO BEGIN WHILE EOLN(SOURCE) DO BEGIN GET(SOURCE); WRITELN(OUTPUT) END; BEGIN STARTOFLINE := TRUE; IF LINENUMBERS THEN BEGIN WHILE SOURCE^ IN ['0'..'9'] DO BEGIN WRITE(OUTPUT, SOURCE^); GET(SOURCE) END; IF NOT EOLN(SOURCE) AND (SOURCE^=' ') THEN (*FIRST BLANK AFTER LINE NUMBER IS OBLIGATORY*) BEGIN WRITE(OUTPUT, ' '); GET(SOURCE) END END; IF TOS^.C=STRING THEN (*DO NOT TINKER WITH BLANKS INSIDE STRING-DENOTATIONS*) BEGIN WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') DO BEGIN WRITE(OUTPUT, ' '); GET(SOURCE) END; STARTOFLINE := FALSE END ELSE WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') DO GET(SOURCE); (*GET RID OF EXISTING INDENTATION*) WHILE NOT EOLN(SOURCE) DO BEGIN IF (SOURCE^ IN ['(','!',')','[',']',',','.','#','"',';']) OR ((STROPSTATE<>INPOINT) AND (SOURCE^ IN ['A'..'Z'])) OR (STROPSTATE IN [INPRAGUP,INPRAGP]) THEN (*CHARACTER WHICH MIGHT AFFECT INDENTATION*) BEGIN VET(SOURCE); IF STARTOFLINE THEN FOR I := 1 TO TEMPINDENT DO WRITE(OUTPUT, ' '); WITH VETTEDCHARACTER DO FOR I := 1 TO INDEX DO WRITE(OUTPUT, WORD[I]) END ELSE BEGIN IF STARTOFLINE THEN FOR I := 1 TO INDENT DO WRITE(OUTPUT, ' '); IF (SOURCE^<>' ') AND NOT INSTRAGMENT AND GONEON THEN (*PREPARE TO INDENT ANY CONTINUATION LINE*) BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END; WRITE(OUTPUT, SOURCE^); GET(SOURCE); END; STARTOFLINE := FALSE END; GET(SOURCE); WRITELN(OUTPUT) END; END; END; (**) FUNCTION ARGC: INTEGER; EXTERN; (**) BEGIN (*INDENT*) IF ARGC=1 THEN MAIN(INPUT) ELSE BEGIN RESET(SOURCE); MAIN(SOURCE); END; (*$G-*) END.