Clean up your code with the Hanson Loop

Do me a favor, would you? Have a quick look at this code and tell me what you think it does...

MysteryProcedureUsingCodeBlock  (long StudentID)!,long ! Declare Procedure


FilesOpened     BYTE(0)
Result                                              long
StepNumber                                          long
MostAvoidedTeacher                                  cstring(100)
CourseTakenQ                                        Queue
CourseID                                                long
TeacherID                                               long
                                                    end
CourseNotTakenQ                                     Queue
CourseID                                                long
TeacherID                                               long
                                                    end
CourseQ                                             Queue
CourseID                                                long
Taken                                                   BOOL
                                                    end
TeacherQ                                            Queue
TeacherID                                               Long
ClassesTaught                                           Long
                                                    end
x                                                   long
WasTaken                                            bool

    CODE
    do OpenFiles
    STU:StudentID = StudentID
    get(Student,STU:pkStudentID)
    if errorcode()
        do CloseFiles
        return FALSE
    end
    set(Course)
    loop
        next(Course)
        if errorcode() then break.
        clear(CRSI:Record)
        CRSI:CourseID = CRS:CourseID
        set(CRSI:kCourseIDTeacherID,CRSI:kCourseIDTeacherID)
        WasTaken = false
        loop 
            next(CourseInstance)
            if errorcode() or CRSI:CourseID <> CRS:CourseID then break.
            ENR:StudentID = StudentID
            ENR:CourseInstanceID = crsi:CourseInstanceID
            get(Enrollment,ENR:kCourseInstanceUDStudentID)
            if not errorcode()
                WasTaken = TRUE
                break
            end
        end
        if WasTaken
            clear(CourseTakenQ)
            CourseTakenQ.CourseID = CRS:CourseID
            CourseTakenQ.TeacherID = CRSI:TeacherID
            add(CourseTakenQ)
        else
            clear(CourseNotTakenQ)
            CourseNotTakenQ.CourseID = CRS:CourseID
            CourseNotTakenQ.TeacherID = CRSI:TeacherID
            add(CourseNotTakenQ)           
        end
    end
    set(Teacher)
    loop
        next(Teacher)
        if errorcode() then break.
        TeacherQ.TeacherID = TEA:TeacherID
        add(TeacherQ)
    end
    loop x = 1 to records(CourseTakenQ)
        get(CourseTakenQ,x)
        TeacherQ.TeacherID = CourseTakenQ.TeacherID
        get(TeacherQ,TeacherQ.TeacherID)
        if not errorcode() ! should always find a record
            TeacherQ.ClassesTaught += 1
            put(TeacherQ)
        end
    end
    sort(TeacherQ,-TeacherQ.ClassesTaught)
    loop while not errorcode()
        get(TeacherQ,6)
        delete(TeacherQ)
    end
    x = 1
    loop 
        get(CourseNotTakenQ,x)
        if errorcode() then break.
        TeacherQ.TeacherID = CourseNotTakenQ.TeacherID
        get(TeacherQ,TeacherQ.TeacherID)
        if not errorcode()
            x += 1
        else
            delete(CourseNotTakenQ)
        end
    end
    TeacherQ.TeacherID = CourseNotTakenQ.TeacherID
    get(TeacherQ,TeacherQ.TeacherID)
    get(CourseNotTakenQ,random(1,records(CourseNotTakenQ)))
    do CloseFiles
    return false  ! because this code is not yet complete

How are you making out? Do you have a clear idea of what this code does?

If you study the code long enough you should be able to figure out what it does, but you probably still won't know why it's doing what it does.

Now consider this version of the same code (I've omitted the OpenFiles/CloseFiles routines in both cases):

MysteryProcedureUsingLocalProcedures  (long StudentID)!,long ! Declare Procedure

                                        map
                                            GetStudentRecord(),long
                                            BuildListsOfCoursesTakenAndNotTaken(),long
                                            CourseWasTaken(),long
                                            BuildListOfTeachers(),long
                                            CountCoursesTaughtToStudent(),long
                                            SortTeacherListByCountOfCoursesTaughtToStudent(),long
                                            NarrowTeacherListToFiveMostAvoided(),long
                                            NarrowCourseNotTakenListToThoseTaughtByFiveMostAvoidedTeachers(),long
                                            CourseIsTaughtByOneOfFiveMostAvoidedTeachers(),long
                                            RegisterStudentForRandomlyChosenCourse(),long
                                        end
FilesOpened                                         BYTE(0)
Result                                              long
StepNumber                                          long
MostAvoidedTeacher                                  cstring(100)
CourseTakenQ                                        Queue
CourseID                                                long
TeacherID                                               long
                                                    end
CourseNotTakenQ                                     Queue
CourseID                                                long
TeacherID                                               long
                                                    end
CourseQ                                             Queue
CourseID                                                long
Taken                                                   BOOL
                                                    end
TeacherQ                                            Queue
TeacherID                                               Long
ClassesTaught                                           Long
                                                    end

    CODE
    do OpenFiles
    StepNumber = 0
    Result = Level:Benign
    Loop while Result = Level:Benign
        StepNumber += 1
        execute StepNumber
            Result = GetStudentRecord()
            Result = BuildListsOfCoursesTakenAndNotTaken()
            Result = BuildListOfTeachers()
            Result = CountCoursesTaughtToStudent()
            Result = SortTeacherListByCountOfCoursesTaughtToStudent()
            Result = NarrowTeacherListToFiveMostAvoided()
            Result = NarrowCourseNotTakenListToThoseTaughtByFiveMostAvoidedTeachers()
            Result = RegisterStudentForRandomlyChosenCourse()
            break
        end
    end
    do CloseFiles
    Return result
    
GetStudentRecord                        procedure()!,long
    code
    STU:StudentID = StudentID
    get(Student,STU:pkStudentID)
    if not errorcode() then return level:benign.
    return level:notify
    
BuildListsOfCoursesTakenAndNotTaken     procedure()!,long
    code
    set(Course)
    loop
        next(Course)
        if errorcode() then break.
        if CourseWasTaken() = Level:Benign
            clear(CourseTakenQ)
            CourseTakenQ.CourseID = CRS:CourseID
            CourseTakenQ.TeacherID = CRSI:TeacherID
            add(CourseTakenQ)
        else
            clear(CourseNotTakenQ)
            CourseNotTakenQ.CourseID = CRS:CourseID
            CourseNotTakenQ.TeacherID = CRSI:TeacherID
            add(CourseNotTakenQ)           
        end
    end
    return Level:Benign
    
CourseWasTaken                          procedure()!,long
WasTaken                                    bool
    code
    clear(CRSI:Record)
    CRSI:CourseID = CRS:CourseID
    set(CRSI:kCourseIDTeacherID,CRSI:kCourseIDTeacherID)
    loop 
        next(CourseInstance)
        if errorcode() or CRSI:CourseID <> CRS:CourseID then break.
        ENR:StudentID = StudentID
        ENR:CourseInstanceID = crsi:CourseInstanceID
        get(Enrollment,ENR:kCourseInstanceUDStudentID)
        if not errorcode()
            WasTaken = TRUE
            break
        end
    end
    if WasTaken then return level:benign.
    return level:notify
    
BuildListOfTeachers                     procedure()!,long
    code
    set(Teacher)
    loop
        next(Teacher)
        if errorcode() then break.
        TeacherQ.TeacherID = TEA:TeacherID
        add(TeacherQ)
    end
    return Level:Benign
            
CountCoursesTaughtToStudent             procedure()!,long
x                                           long
    code
    loop x = 1 to records(CourseTakenQ)
        get(CourseTakenQ,x)
        TeacherQ.TeacherID = CourseTakenQ.TeacherID
        get(TeacherQ,TeacherQ.TeacherID)
        if not errorcode() ! should always find a record
            TeacherQ.ClassesTaught += 1
            put(TeacherQ)
        end
    end
    return Level:Benign
SortTeacherListByCountOfCoursesTaughtToStudent  procedure()!,long
    code
    sort(TeacherQ,-TeacherQ.ClassesTaught)
    return Level:Benign
    
NarrowTeacherListToFiveMostAvoided      procedure()!,long
x                                           Long
    code
    loop while not errorcode()
        get(TeacherQ,6)
        delete(TeacherQ)
    end
    return Level:Benign
NarrowCourseNotTakenListToThoseTaughtByFiveMostAvoidedTeachers  procedure()!,long
x                                                                   long
    code
    x = 1
    loop 
        get(CourseNotTakenQ,x)
        if errorcode() then break.
        if CourseIsTaughtByOneOfFiveMostAvoidedTeachers() = Level:Benign
            x += 1
        else
            delete(CourseNotTakenQ)
        end
    end
    return Level:Benign
    
CourseIsTaughtByOneOfFiveMostAvoidedTeachers    procedure()!,long
    code
    TeacherQ.TeacherID = CourseNotTakenQ.TeacherID
    get(TeacherQ,TeacherQ.TeacherID)
    if not errorcode() then return Level:Benign.
    return Level:Notify
    
    
RegisterStudentForRandomlyChosenCourse  procedure()!,long
    code
    get(CourseNotTakenQ,random(1,records(CourseNotTakenQ)))
    return Level:Notify  ! because this code is not yet complete
        

I'm pretty confident that you'll find the second version a lot easier to understand, because it breaks up all those blocks of code into procedures with descriptive names. 

While this code does compile, and does use a real dictionary, I make no claims as to whether it works. Certainly it is incomplete, because I haven't yet written the final local procedure. In any case the purpose is not to register students for courses taught by teachers they avoid but to demonstrate how complicated code can be improved.

 

There are a couple of things you may find unfamiliar about this code. One is the use of a local map and local procedures. Just as you can (and almost always do) have a map in a program module, you can have maps within modules and within procedures. 

Also each procedure is quite short because short blocks of code are generally easier to understand than long blocks of code. 

The Hanson Loop

But the real beauty of this procedure is a construct Mike Hanson recently showed me, and which I've christened the Hanson Loop:

    StepNumber = 0
    Result = Level:Benign
    Loop while Result = Level:Benign
        StepNumber += 1
        execute StepNumber
            Result = GetStudentRecord()
            Result = BuildListsOfCoursesTakenAndNotTaken()
            Result = BuildListOfTeachers()
            Result = CountCoursesTaughtToStudent()
            Result = SortTeacherListByCountOfCoursesTaughtToStudent()
            Result = NarrowTeacherListToFiveMostAvoided()
            Result = NarrowCourseNotTakenListToThoseTaughtByFiveMostAvoidedTeachers()
            Result = RegisterStudentForRandomlyChosenCourse()
            break
        end
    end
    do CloseFiles
    Return result

The Hanson Loop is a while loop - it keeps executing as long as the Result variable is equal to Level:Benign. You could write a similar loop testing for Result = True, but I think there are some important benefits to using the Clarion return levels, which I'll get to in a moment.

Within the Hanson Loop there's an Execute structure. When the StepNumber variable has a value of 1, the first line in the Execute structure is executed; when the StepNumber variable has a value of 2, the second line executes, and so on. 

The very last statement in the Execute structure is simply a break command, which exits the loop. 

The beauty of the Hanson Loop is it provides a clear overview of the code being executed by the main procedure, while allowing for clean and efficient error handling. At any time in the sequence of procedure calls a non-benign result will terminate the loop. Do you need to wrap this code in a transaction? It's as easy as doing a logout before the loop, and either a commit or a rollback depending on the value of Result. 

Now, about those Clarion error levels.

The Clarion error levels

It has taken me years, nearly two decades, to adopt Clarion error levels in my own coding. 

I'm almost completely convinced.

The Clarion help has this to say about error levels, in the context of the ABC ErrorManager object:

Six Levels of Treatment

By default, the error manager recognizes six different levels of error severity. The default actions for these levels range from no action for benign errors to halting the program for fatal errors. The error manager also supports the intermediate actions of simply notifying the user, or of notifying the user and letting the user decide whether to continue or abort.

Customizable Treatments

These various levels of treatment are implemented with virtual methods so they are easy to customize. The error manager calls a different virtual method for each severity level, so you can override the default error actions with your own application specific error actions. See the various Take methods for examples.

The recognized severity EQUATEs are declared in EQUATES.CLW. These severity levels and their default actions are:

 

Level:Benign (0)

no action, returns Level:Benign

Level:User (1)

displays message, returns Level:Benign or Level:Cancel

Level:Notify (5)

displays message, returns Level:Benign

Level:Fatal (3)

displays message, halts the program

Level:Program (2)

treated as Level:Fatal

Level:Cancel (4)

used to confirm no action taken by User

any other value

treated as Level:Program

 

You may define your own additional severity levels and their associated actions.

These values specifically indicate actions the ErrorManager may take. But there aren't quite as many of them as there may seem to be at first. Level:User appears nowhere in the ABC class library or the templates, other than as a definition. Level:Program is the same as Level:Fatal, and Level:Fatal means exit the program, so it's not something you're likely to use. So that leaves Benign, Notify, and Cancel.

Over the years I've written may procedures and methods that returned a true/false value, and in those circumstances the Clarion error levels seemed overkill. Of the three really usable levels I seem to only need Benign and Notify, to signify True and False. So why not just use True and False? 

In part I've adopted the Clarion error levels to be more in sync with the ABC classes, and in part because using levels leaves open the possibility of indicating different levels of success or failure, even if it's not a situation I come across often. But as soon as I do have one of those situations I suddenly become inconsistent, returning True/False in most of my code and three or more values in other code. 

As you can see in the example I'm even using Level:Benign when there is only one potential return value, although I've mainly done that to make the code line up neatly and not because I suspect I will need a different value at some point. I could just as easily not assign a value to ReturnValue in any of the lines in the Execute statement - the loop will continue as before and will always move beyond those lines where ReturnValue is never assigned. 

Summary

As I said you can always adapt the Hanson Loop to work with True/False values. That's not so important; what does matter is the Execute nested inside the Loop, and the use of local procedures to break up long blocks of code. 

If you have long blocks of code that are difficult to understand, I highly recommend the Hanson Loop. Be descriptive in your procedure names, keep your procedures short, and your code will become easier to read and easier to maintain.