Category : Files from Magazines
Archive   : DDJ9210.ZIP
Filename : MOD3.ASC

 
Output of file : MOD3.ASC contained in archive : DDJ9210.ZIP
_SAFE PROGRAMMING WITH MODULA-3_
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;



  3 Responses to “Category : Files from Magazines
Archive   : DDJ9210.ZIP
Filename : MOD3.ASC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/