The Unsorted BBS Collection/thegreatunsorted.tar/thegreatunsorted/programming/misc_programming/mod3.asc

Text File | 1995-02-02 | 10.9 KB | 327 lines

_THE MODULA-3 PROGRAMMING LANGUAGE_
by Sam Harbison

Listing One

INTERFACE FieldList;
(* Breaks text lines into a list of fields which can be treated
 as text or numbers. This interface is thread-safe. *)
IMPORT Rd, Wr, Thread;
EXCEPTION Error;
CONST
    DefaultWS = SET OF CHAR{' ', '\t', '\n', '\f', ','};
    Zero: NumberType = 0.0D0;
TYPE
    FieldNumber = [0..LAST(INTEGER)]; (* Fields are numbered 0, 1, ... *)
    NumberType = LONGREAL; (* Type of field as floating-point number *)
    T <: Public; (* A field list *)
    Public = MUTEX OBJECT (* The visible part of a field list *)
    METHODS
        init(ws := DefaultWS): T;
            (* Define whitespace characters. *)
        getLine(rd: Rd.T := NIL)
           RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted};
           (* Reads a line and breaks it into fields that can be
                   examined by other methods. Default reader is Stdio.stdin.
        numberOfFields(): CARDINAL;
           (* The number of fields in the last-read line. *)
        line(): TEXT;
           (* The entire line. *)
        isANumber(n: FieldNumber): BOOLEAN RAISES {Error};
           (* Is the field some number (either integer or real)? *)
        number(n: FieldNumber): NumberType RAISES {Error};
           (* The field's floating-poinnt value *)
        text(n: FieldNumber): TEXT RAISES {Error};
           (* The field's text value *)
    END;
END FieldList.


Listing Two

MODULE Sum EXPORTS Main; (* Reads lines of numbers and prints their sums. *)
IMPORT FieldList, Wr, Stdio, Fmt, Rd, Thread;
CONST WhiteSpace = FieldList.DefaultWS + SET OF CHAR{','};
VAR
    sum: FieldList.NumberType;
    fl  := NEW(FieldList.T).init(ws := WhiteSpace);
PROCEDURE Put(t: TEXT) =
    <*FATAL Wr.Failure, Thread.Alerted*>
    BEGIN
        Wr.PutText(Stdio.stdout, t);
        Wr.Flush (Stdio.stdout);
    END Put;
BEGIN
    TRY
        LOOP             Put("Type some numbers: ");
            fl.getLine();
            sum := FieldList.Zero;
            WITH nFields = fl.numberOfFields() DO
                FOR f := 0 TO nFields - 1 DO
                    IF fl.isANumber(f) THEN
                        sum := sum + fl.number(f);
                    END;
               END;
               WITH sumText = Fmt.LongReal(FLOAT(sum, LONGREAL)) DO
                    Put("The sum is " & sumText & ".\n");
               END(*WITH*);
            END(*WITH*);
        END(*LOOP*)
    EXCEPT
        Rd.EndOfFile =>
            Put("Done.\n");
        ELSE
            Put("Unknown exception; quit.\n");
    END(*TRY*);
END Sum.


Listing Three

MODULE FieldList;
(* Designed for ease of programming, not efficiency. We don't bother to reuse
   data structures; we allocate new ones each time a line is read. *)
IMPORT Rd, Wr, Text, Stdio, Fmt, Thread, Scan;
CONST DefaultFields = 20;      (* How many fields we expect at first. *)
TYPE
    DescriptorArray = REF ARRAY OF FieldDescriptor;
    FieldDescriptor = RECORD
        (* Description of a single field. The 'text' field and 'real'
           fields are invalid until field's value is first requested.
           (Invalid is signaled by 'text' being NIL. *)
        start  : CARDINAL   := 0; (* start of field in line *)
        len    : CARDINAL   := 0; (* length of field *)
        numeric: BOOLEAN    := FALSE; (* Does field contain number? *)
        text   : TEXT       := NIL; (* The field text *)
        number : NumberType := 0.0D0; (* The field as a real. *)
    END;
REVEAL
    T = Public BRANDED OBJECT
        originalLine: TEXT; (* the original input line *)
        chars      : REF ARRAY OF CHAR := NIL; (* copy of input line *)
        nFields    : CARDINAL := 0; (* number of fields found *)
        fds   : DescriptorArray := NIL; (* descriptor for each field *)
        ws    : SET OF CHAR := DefaultWS; (* our whitespace *)
    OVERRIDES  (* supply real procedures for the methods *)
        init           := init;         getLine        := getLine;
        numberOfFields := numberOfFields;
        line           := line;
        isANumber      := isANumber;
        number         := number;
        text           := text;
    END;
PROCEDURE AddDescriptor(t: T; READONLY fd: FieldDescriptor) =
    (* Increment the number of fields, and store fd as the
    descriptor for the new field. Extend the fd array if necessary. *)
    BEGIN
        IF t.nFields >= NUMBER(t.fds^) THEN
           WITH
              n  = NUMBER(t.fds^), (* current length; will double it *)
              new = NEW(DescriptorArray, 2 * n)
           DO
              SUBARRAY(new^, 0, n) := t.fds^;   (* copy in old data *)
            t.fds := new;
           END;
        END;
        t.fds[t.nFields] := fd;
        INC(t.nFields);
    END AddDescriptor;
PROCEDURE getLine(self: T; rd: Rd.T := NIL)
    RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
    (* Read an input line; store it in the object; finds all the
    whitespace-terminated fields. *)
    VAR
        next      : CARDINAL; (* index of next char in line *)
        len       : CARDINAL; (* # of characters in current field *)
        lineLength: CARDINAL; (* length of input line *)
    BEGIN
        IF rd = NIL THEN rd := Stdio.stdin; END;  (* default reader *)
        LOCK self DO
            WITH text = Rd.GetLine(rd) DO
             lineLength        := Text.Length(text);
             self.originalLine := text;
             self.fds       := NEW(DescriptorArray, DefaultFields);
             self.nFields   := 0;
             self.chars     := NEW(REF ARRAY OF CHAR, lineLength);
             Text.SetChars(self.chars^, text);
            END;
            next := 0;
            WHILE next < lineLength DO (* for each field *)
              (* Skip whitespace characters *)
                   WHILE next < lineLength AND (self.chars[next] IN
                                               self.ws) DO INC(next);
                END;
                (* Collect next field *)
                len := 0;
                WHILE next < lineLength
                   AND NOT (self.chars[next] IN self.ws) DO
                    INC(len); INC(next);
                END;
                (* Save information about the field *)                 IF len > 0 THEN
                       AddDescriptor(self, FieldDescriptor{start:=
                                                    next - len, len := len});
                END;
            END(*WHILE*);
        END(*LOCK*);
    END getLine;
PROCEDURE GetDescriptor(t: T; n: FieldNumber): FieldDescriptor RAISES {Error}
    (* Return the descriptor for field n. Depending on user's wishes,
    treat too-large field numbers as empty fields or as an error. *)
    BEGIN
        (* Handle bad field number first. *)
        IF n >= t.nFields THEN
            RAISE Error;
        END;
        (* Be sure text and numeric values are set. *)
        WITH fd = t.fds[n] DO
          IF fd.text # NIL THEN RETURN fd; END; (* Already done this *)
          fd.text := Text.FromChars(SUBARRAY(t.chars^, fd.start,
                                                                      fd.len)
          TRY (* to interpret field as floating-point number *)
              fd.number  := FLOAT(Scan.LongReal(fd.text), NumberType);
              fd.numeric := TRUE;
            EXCEPT
                Scan.BadFormat =>
                    TRY (* to interpret field as integer *)
                        fd.number  := FLOAT(Scan.Int(fd.text),
                                                                   NumberType
                        fd.numeric := TRUE;
                    EXCEPT
                       Scan.BadFormat => (* not a number *)
                            fd.number  := Zero;
                            fd.numeric := FALSE;
                    END;
            END;
            RETURN fd;
        END(*WITH*);
    END GetDescriptor;
PROCEDURE numberOfFields(self: T): CARDINAL =
    BEGIN
        LOCK self DO RETURN self.nFields; END;
    END numberOfFields;
PROCEDURE isANumber(self: T; n: FieldNumber): BOOLEAN RAISES {Error} =
    BEGIN
        LOCK self DO
            WITH fd = GetDescriptor(self, n) DO RETURN fd.numeric; END;
        END;
    END isANumber;
PROCEDURE number(self: T; n: FieldNumber): NumberType RAISES {Error} =
    BEGIN
        LOCK self DO
             WITH fd = GetDescriptor(self, n) DO RETURN fd.number; END;
        END;
    END number;
PROCEDURE line(self: T): TEXT =     BEGIN
        LOCK self DO RETURN self.originalLine; END;
    END line;
PROCEDURE text(self: T; n: FieldNumber): TEXT RAISES {Error} =
    BEGIN
        LOCK self DO
            WITH fd = GetDescriptor(self, n) DO
                RETURN self.fds[n].text;
            END;
        END(*LOCK*);
    END text;
PROCEDURE init(self: T; ws := DefaultWS): T =
    BEGIN
        LOCK self DO
            self.ws           := ws;
        END;
        RETURN self;
    END init;
BEGIN
    (* No module initialization code needed *)
END FieldList.



Figure 1: Modula_3 version of the classic "Hello, World!" program


MODULE Hello EXPORTS Main;
IMPORT Wr, Stdio;
BEGIN
    Wr.PutText(Stdio.stdout, "Hello, World!\n");
    Wr.Close(Stdio.stdout);
END Hello.




Figure 2. Signatures for isANumber.

Method  Procedure
isANumber(n: FieldNumber): BOOLEAN
 RAISES {Error} isANumber(self: T; n: FieldNumber): BOOLEAN
 RAISES {Error}


Figure 3. Procedure to accept a pointer of any type and return as
a floating-point number the value pointed to.


PROCEDURE GetReal(ptr: REFANY): REAL = (* Return ptr^ as a REAL *)
    VAR realPtr := NARROW(ptr, REF REAL);
    BEGIN
        RETURN realPtr^;
    END GetReal;

Figure 4. Making explicit run-time type testing in the GetReal
procedure

PROCEDURE GetReal2(ptr: REFANY): REAL = (* Return ptr^, or 0.0 *)
    BEGIN
        IF ptr # NIL AND ISTYPE(ptr, REF REAL) THEN
            RETURN NARROW(ptr, REF REAL)^;
        ELSE
            RETURN 0.0; (* ptr is not what we expected *)
        END;
    END GetReal2;



Figure 1:

  MODULE Hello EXPORTS Main;   IMPORT Wr, Stdio;
  BEGIN
      Wr. PutText(Stdio.stdout, "Hello, World!\n");
      Wr. Close(Stdio.stdout);
  END Hello.



Figure 2:

  Method:
      isANumber (n: FieldNumber) : BOOLEAN RAISES {Error}
  Procedure:
      isANumber (self: T; n: FieldNumber) : BOOLEAN RAISES {Error}



Figure 3:


  PROCEDURE GetReal(ptr: REFANY) : REAL = (* Return ptr^ as a REAL *)
      VAR realPtr:= NARROW(ptr, REF REAL);
      BEGIN
          RETURN realPtr^;
      END GetReal;




Figure 4:

  PROCEDURE GetReal2(ptr: REFANY) : REAL = (* Return prt^, or 0.0*)
      BEGIN
          IF ptr # NIL AND ISTYPE(ptr, REF REAL) THEN
              RETURN NARROW(ptr, REF REAL)^;
          ELSE
              RETURN 0.0; (* ptr is not what we expected *)
          END;
       END GetReal2;