🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.modula2
Article #1833

Re: Procedure Variables and Records and Sorting

#1833
From: Bill Seurer
Date: Thu, 21 Mar 1991 19:51
99 lines
3294 bytes
Here's a minimal example that does what you want (I think).  I compiled
it and tried it with the test code and the end and it ran ok but I make
no guarantees!.  A different sorting method might require a slightly
different interface and different compilers might require different
sorts of type coercions.  Of course the interface to sort shown here
can't do much type checking since it uses the ADDRESS type.  A "real" OO
language could do better.
-=-=-=-=-
DEFINITION MODULE sort;
FROM SYSTEM IMPORT ADDRESS;
TYPE
  Result = (LessThan, Equal, GreaterThan);
  CompareProc = PROCEDURE (ADDRESS, ADDRESS): Result;
  SwapProc = PROCEDURE (ADDRESS, ADDRESS);
  NextProc = PROCEDURE (ADDRESS): ADDRESS;
PROCEDURE Sort (list: ADDRESS;
      Compare: CompareProc;
      Swap: SwapProc;
      Next: NextProc);
END sort.
-=-=-=-=-
IMPLEMENTATION MODULE sort;
FROM SYSTEM IMPORT ADDRESS;
PROCEDURE Sort (list: ADDRESS;
      Compare: CompareProc;
      Swap: SwapProc;
      Next: NextProc);
(* Bubble sort shown for example purposes only *)
(* No one would really use it (hopefully) *)
VAR
  this, that: ADDRESS;
BEGIN
  this := list;
  WHILE (this <> NIL) DO
    that := Next(this);
    WHILE (that <> NIL) DO
      IF Compare(this, that) = GreaterThan THEN
        Swap(this, that);
      END (*If*);
      that := Next(that);
    END (*While*);
    this := Next(this);
  END (*While*);
END Sort;
END sort.
-=-=-=-=-
MODULE trySort;
IMPORT InOut, sort;
FROM SYSTEM IMPORT ADDRESS;
FROM Storage IMPORT ALLOCATE;
TYPE
  ListPtr = POINTER TO ListRcd;
  ListRcd = RECORD
    val: CARDINAL;
    next: ListPtr;
  END (*List record*);
VAR
  list, first: ListPtr;
PROCEDURE Comp (a, b: ADDRESS): sort.Result;
 BEGIN
   IF ListPtr(a)^.val < ListPtr(b)^.val THEN
      RETURN sort.LessThan;
   ELSIF ListPtr(a)^.val > ListPtr(b)^.val THEN
      RETURN sort.GreaterThan;
   ELSE (*IF ListPtr(a)^.val = ListPtr(b)^.val THEN*)
      RETURN sort.Equal;
   END (*Else*);
 END Comp;
PROCEDURE Swap (a, b: ADDRESS);
 VAR
   tmp: CARDINAL;
 BEGIN
   tmp := ListPtr(a)^.val;
   ListPtr(a)^.val := ListPtr(b)^.val;
   ListPtr(b)^.val := tmp;
 END Swap;
PROCEDURE Next(a: ADDRESS): ADDRESS;
 BEGIN
    RETURN ListPtr(a)^.next;
 END Next;
BEGIN
  NEW(first);  list := first;  list^.val := 9;
  NEW(list^.next);  list := list^.next;  list^.val := 5;
  NEW(list^.next);  list := list^.next;  list^.val := 3;
  list^.next := NIL;
  sort.Sort(first, Comp, Swap, Next);
  list := first;
  WHILE list <> NIL DO
    InOut.WriteCard(list^.val, 2);
    list := list^.next;
  END (*While*);
  InOut.WriteLn;
END trySort.
-=-=-=-=-=-
Output:
 3 5 9

- Bill Seurer      IBM: seurer@rchland  Prodigy: CNSX71A
  Rochester, MN    Internet: seurer@rchland.vnet.ibm.com
Technical Details
Message-ID: <gbuEuqY91EAfAXHScn@rchland.ibm.com>
Path: arc1-ca.pugleaf.net!utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!panews.awdpa.ibm.com!rchland.ibm.com!seurer+
References: <2848.27E71773@puddle.fidonet.org>

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!panews.awdpa.ibm.com!rchland.ibm.com!seurer+
From: seurer+@rchland.ibm.com (Bill Seurer)
Newsgroups: comp.lang.modula2
Subject: Re: Procedure Variables and Records and Sorting
Message-ID: <gbuEuqY91EAfAXHScn@rchland.ibm.com>
Date: 21 Mar 91 19:51:18 GMT
References: <2848.27E71773@puddle.fidonet.org>
Organization: IBM Rochester, Mn
Lines: 99
In-Reply-To: <2848.27E71773@puddle.fidonet.org>