This script takes a COBOL program, searches for ALTER statements, and replaces them by more readable equivalent code, based on variables and explicit tests.

This is a very typical example of RainCode's ability not to just find things in a piece of COBOL source code, but to actually correct it automatically as well.

<>=
  <On clauses>
  <Visiting an ALTER statement>
  <Patching the source code>
  <Structure-related procedures>
  <TERMINATE procedure>
This code is written to a file (or else not used).

Whenever an ALTER statement is found, call the VisitAlter procedure.
<On clauses>=
ON AlterStatement DO
  VisitAlter (X);
  END;
Used above.

AlteredBlocks holds a list of all the statement blocks that contain a single GOTO statement, and which are altered by an ALTER statement.
<Visiting an ALTER statement>=
VAR
  AlteredBlocks := {};
Used above; next definition.

<Visiting an ALTER statement>+=
PROCEDURE VisitAlter(Alt);
VAR
  target, bl;
BEGIN
target := Alt.Source.Image;
bl := ROOT.ProcedureDivision.FindBlock (target);
IF bl = VOID THEN
  <Error handling if the block cannot be found>
 ELSE
  <Attach Alt to bl>
  AlteredBlocks := AlteredBlocks & { bl };
  END;
END VisitAlter;  
Used above; previous definition.

<Error handling if the block cannot be found>=
ERR.WriteLn ("Label not found: [", target, "]");
Used above.

This attachment is performed by an annotation. The annotation cannot be used just like that; one must first check whether it has been defined by using the CAN operator.
<Attach Alt to bl>=
IF NOT (bl CAN Alters) THEN
  bl.Alters := {};
  END;
bl.Alters := bl.Alters & { Alt };
ASSERT bl CAN Alters;
Used above.

Then, after that the entire source code has been visited, all ALTER statement have been handled, and the various annotation have been set, we can consider whether we must take action or not. The rule is rather simple: if there is at least a single recognized ALTER statement, we proceed with the patching mechanism.
<TERMINATE procedure>=
PROCEDURE TERMINATE;
VAR
  Count := 1, VarName, Stat, Targets,
  a, i, l, OriginalTarget;
BEGIN
IF AlteredBlocks <> VOID THEN
  FOR Bl IN LIST.Unique(AlteredBlocks) DO
    <Handle block Bl>
    END;
  END;
IF PATCH.PatchCount > 0 THEN
  OUT.WriteLn ("Saving " & PATCH.PatchCount & " patches");
  PATCH.Save (ROOT.SourceName & '.p');
  END;
END TERMINATE;
Used above.

ExtractAlterGoto will return the GOTO statement in the block Bl that is altered by at least a single ALTER statement. If no such statement can be found in this block, ExtractAlterGoto returns VOID.
<Handle block Bl>=
Stat := ExtractAlterGoto (Bl);
Used above; next definition.

<Handle block Bl>+=
IF Stat = VOID THEN
  OUT.WriteLine ("Cannot alter block: " , X.Label);
 ELSE
Used above; previous and next definitions.

<Handle block Bl>+=
VarName := "ALTER-CTRL-" & Count;
InsertVarDecl (VarName);
OriginalTarget := STR.UpperCase(Stat.Target.Image);
Targets := (Bl.Alters || STR.UpperCase(X.NewSource.Image));
Targets := LIST.Unique(Targets);
Targets := LIST.Diff(Targets, {OriginalTarget});
Targets := { OriginalTarget } & Targets;
<Replace ALTERs related to Bl by MOVEs>
<Replace the original GOTO by a conditional one>
Count := Count + 1;
END;
Used above; previous definition.

*
<Replace ALTERs related to Bl by MOVEs>=
FOR AlterStmt IN Bl.Alters DO
  a := STR.UpperCase(AlterStmt.NewSource.Image);
  i := LIST.Index (Targets, a);
  PATCH.ReplaceNt (AlterStmt,"MOVE " & i-1 & " TO " & VarName);
  END;
Used above.

<Replace the original GOTO by a conditional one>=
a := {};
FOR IN 1 TO #Targets DO
  IF a = {} THEN
    l := 'IF ';
   ELSE
    l := STR.Pad(Stat.ColNr ) & 'ELSE IF ';
    END;
  l := l & VarName & " = " & X-1 & " GO TO " & Targets[X];
  a := a & {l};  
  END;  
PATCH.ReplaceNt (Stat, a);
Used above.

<Patching the source code>=
PROCEDURE InsertVarDecl (VarName);
VAR
  LineNr;
BEGIN
ASSERT SYS.IsString (VarName);
LineNr := (ROOT.DataDivision.WorkingStorageSection.Data.Fields[1]).LineNr;
PATCH.InsertLines (LineNr, {'01 ' & VarName & ' PIC 99 USAGE COMP VALUE 0.'});
END InsertVarDecl;  
Used above.

The ExtractAlterGoto procedure takes a block Bl, supposedly altered by an ALTER statement. Such a block must contain a single GOTO statement. This procedure ensures that Bl matches this pattern, and returns this GOTO statement. In all other cases, it returns VOID.
<Structure-related procedures>=
PROCEDURE ExtractAlterGoto (Bl);
BEGIN
ASSERT Bl IS StatementBlock;
IF #Bl.StatementList.List = 1 THEN
  RESULT := Bl.StatementList.List[1];
  IF NOT (RESULT IS GotoStatement) THEN
    RESULT := VOID;
    END;
  END;
END ExtractAlterGoto;
Used above.