🚀 go-pugleaf

Several weeks ago, I promised to post code for a generic linked-list
sort.  For various reasons, I never got around to it.  However, last
night I got all enthusiastic and I managed to code the sorting routine
and today (at work, while I was burning EPROMS) I coded the
test/example routine.  In any case, here it is.

(* Start of file 1:  SORT.DEF *)

DEFINITION MODULE Sort;

  FROM SYSTEM IMPORT ADDRESS;

  TYPE
    GetType   = PROCEDURE(ADDRESS) : ADDRESS;
    SetType   = PROCEDURE(ADDRESS, ADDRESS);
    CompType  = PROCEDURE(ADDRESS, ADDRESS) : INTEGER;
    
  PROCEDURE SortL(VAR List : ADDRESS; GetNext : GetType;
    SetNext : SetType; Compare : CompType);
  
END Sort.

(* End of file 1, start of file 2:  SORT.MOD *)

IMPLEMENTATION MODULE Sort;

  FROM SYSTEM IMPORT ADDRESS;
  
  PROCEDURE SortL(VAR List : ADDRESS; GetNext : GetType;
    SetNext : SetType; Compare : CompType);
    
    PROCEDURE Sort(VAR P : ADDRESS);
    VAR
      Q, R, Head  : ADDRESS;
    
    BEGIN
      IF NIL # P THEN
        R := P;
        Q := GetNext(R);
        WHILE Q # NIL DO
          Q := GetNext(Q);
          IF Q # NIL THEN
            R := GetNext(R);
            Q := GetNext(Q)
          END
        END; (* WHILE *)
        
        Q := GetNext(R);
        SetNext(R, NIL);
        IF Q # NIL THEN
          Sort(P);
          Sort(Q);
      
          IF Compare(Q, P) < 0 THEN
            Head := Q;
            Q := GetNext(Q)
          ELSE 
            Head := P;
            P := GetNext(P)
          END; (* IF *)
          
          R := Head;
          WHILE (P # NIL) AND (Q # NIL) DO
            IF Compare(Q, P) < 0 THEN
              SetNext(R, Q);
              R := Q;
              Q := GetNext(Q)
            ELSE
              SetNext(R, P);
              R := P;
              P := GetNext(P)
            END (* IF *)
          END; (* WHILE *)
      
          IF P = NIL THEN
            SetNext(R, Q)
          ELSE
            SetNext(R, P)
          END; (* IF *)
          P := Head
        END (* IF *)
      END  (* IF *)
    END Sort;
  
  BEGIN
    Sort(List)
  END SortL;

BEGIN
END Sort.



--  
uucp: uunet!m2xenix!puddle!106!506.25!Jon.Guthrie
Internet: Jon.Guthrie@p25.f506.n106.z1.fidonet.org