home *** CD-ROM | disk | FTP | other *** search
/ Shareware Supreme Volume 6 #1 / swsii.zip / swsii / 215 / DDJ9210.ZIP / MOD3.ASC < prev    next >
Text File  |  1992-08-26  |  10KB  |  288 lines
  1. _SAFE PROGRAMMING WITH MODULA-3_
  2. by Sam Harbison
  3.  
  4. [LISTING ONE]
  5.  
  6. INTERFACE FieldList;
  7. (* Breaks text lines into a list of fields which can be treated
  8.  as text or numbers. This interface is thread-safe. *)
  9. IMPORT Rd, Wr, Thread;
  10. EXCEPTION Error;
  11. CONST 
  12.     DefaultWS = SET OF CHAR{' ', '\t', '\n', '\f', ','};
  13.     Zero: NumberType = 0.0D0;
  14. TYPE 
  15.     FieldNumber = [0..LAST(INTEGER)]; (* Fields are numbered 0, 1, ... *)
  16.     NumberType = LONGREAL; (* Type of field as floating-point number *)
  17.     T <: Public; (* A field list *)
  18.     Public = MUTEX OBJECT (* The visible part of a field list *)
  19.     METHODS
  20.         init(ws := DefaultWS): T;
  21.             (* Define whitespace characters. *)
  22.         getLine(rd: Rd.T := NIL) 
  23.            RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted};
  24.            (* Reads a line and breaks it into fields that can be 
  25.                    examined by other methods. Default reader is Stdio.stdin. *)
  26.         numberOfFields(): CARDINAL; 
  27.            (* The number of fields in the last-read line. *)
  28.         line(): TEXT;
  29.            (* The entire line. *)
  30.         isANumber(n: FieldNumber): BOOLEAN RAISES {Error};
  31.            (* Is the field some number (either integer or real)? *)
  32.         number(n: FieldNumber): NumberType RAISES {Error};
  33.            (* The field's floating-poinnt value *)
  34.         text(n: FieldNumber): TEXT RAISES {Error};
  35.            (* The field's text value *)
  36.     END;
  37. END FieldList.
  38.  
  39.  
  40.  
  41. [LISTING TWO]
  42.  
  43. MODULE Sum EXPORTS Main; (* Reads lines of numbers and prints their sums. *)
  44. IMPORT FieldList, Wr, Stdio, Fmt, Rd, Thread;
  45. CONST WhiteSpace = FieldList.DefaultWS + SET OF CHAR{','};
  46. VAR 
  47.     sum: FieldList.NumberType;
  48.     fl  := NEW(FieldList.T).init(ws := WhiteSpace);
  49. PROCEDURE Put(t: TEXT) =
  50.     <*FATAL Wr.Failure, Thread.Alerted*>
  51.     BEGIN
  52.         Wr.PutText(Stdio.stdout, t);
  53.         Wr.Flush (Stdio.stdout);
  54.     END Put;
  55. BEGIN
  56.     TRY
  57.         LOOP
  58.             Put("Type some numbers: ");
  59.             fl.getLine();
  60.             sum := FieldList.Zero;
  61.             WITH nFields = fl.numberOfFields() DO
  62.                 FOR f := 0 TO nFields - 1 DO
  63.                     IF fl.isANumber(f) THEN
  64.                         sum := sum + fl.number(f);
  65.                     END;
  66.                END;
  67.                WITH sumText = Fmt.LongReal(FLOAT(sum, LONGREAL)) DO
  68.                     Put("The sum is " & sumText & ".\n");
  69.                END(*WITH*);
  70.             END(*WITH*);
  71.         END(*LOOP*)
  72.     EXCEPT
  73.         Rd.EndOfFile => 
  74.             Put("Done.\n");
  75.         ELSE 
  76.             Put("Unknown exception; quit.\n");
  77.     END(*TRY*);
  78. END Sum.
  79.  
  80.  
  81.  
  82. [LISTING THREE]
  83.  
  84. MODULE FieldList;
  85. (* Designed for ease of programming, not efficiency. We don't bother to reuse
  86.    data structures; we allocate new ones each time a line is read. *)
  87. IMPORT Rd, Wr, Text, Stdio, Fmt, Thread, Scan;
  88. CONST DefaultFields = 20;      (* How many fields we expect at first. *)
  89. TYPE
  90.     DescriptorArray = REF ARRAY OF FieldDescriptor;
  91.     FieldDescriptor = RECORD 
  92.         (* Description of a single field. The 'text' field and 'real' 
  93.            fields are invalid until field's value is first requested.
  94.            (Invalid is signaled by 'text' being NIL. *)
  95.         start  : CARDINAL   := 0; (* start of field in line *)
  96.         len    : CARDINAL   := 0; (* length of field *)
  97.         numeric: BOOLEAN    := FALSE; (* Does field contain number? *)
  98.         text   : TEXT       := NIL; (* The field text *)
  99.         number : NumberType := 0.0D0; (* The field as a real. *)
  100.     END;
  101. REVEAL
  102.     T = Public BRANDED OBJECT
  103.         originalLine: TEXT; (* the original input line *)
  104.         chars      : REF ARRAY OF CHAR := NIL; (* copy of input line *)
  105.         nFields    : CARDINAL := 0; (* number of fields found *)
  106.         fds   : DescriptorArray := NIL; (* descriptor for each field *)
  107.         ws    : SET OF CHAR := DefaultWS; (* our whitespace *)
  108.     OVERRIDES  (* supply real procedures for the methods *)
  109.         init           := init;
  110.         getLine        := getLine;
  111.         numberOfFields := numberOfFields;
  112.         line           := line;
  113.         isANumber      := isANumber;
  114.         number         := number;
  115.         text           := text;
  116.     END;
  117. PROCEDURE AddDescriptor(t: T; READONLY fd: FieldDescriptor) =
  118.     (* Increment the number of fields, and store fd as the 
  119.     descriptor for the new field. Extend the fd array if necessary. *)
  120.     BEGIN
  121.         IF t.nFields >= NUMBER(t.fds^) THEN
  122.            WITH 
  123.               n  = NUMBER(t.fds^), (* current length; will double it *)
  124.               new = NEW(DescriptorArray, 2 * n)
  125.            DO
  126.               SUBARRAY(new^, 0, n) := t.fds^;   (* copy in old data *)
  127.             t.fds := new;
  128.            END;
  129.         END;
  130.         t.fds[t.nFields] := fd; 
  131.         INC(t.nFields);
  132.     END AddDescriptor;
  133. PROCEDURE getLine(self: T; rd: Rd.T := NIL)
  134.     RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  135.     (* Read an input line; store it in the object; finds all the
  136.     whitespace-terminated fields. *)
  137.     VAR
  138.         next      : CARDINAL; (* index of next char in line *)
  139.         len       : CARDINAL; (* # of characters in current field *)
  140.         lineLength: CARDINAL; (* length of input line *)
  141.     BEGIN
  142.         IF rd = NIL THEN rd := Stdio.stdin; END;  (* default reader *)
  143.         LOCK self DO
  144.             WITH text = Rd.GetLine(rd) DO
  145.              lineLength        := Text.Length(text);
  146.              self.originalLine := text;
  147.              self.fds       := NEW(DescriptorArray, DefaultFields);
  148.              self.nFields   := 0;
  149.              self.chars     := NEW(REF ARRAY OF CHAR, lineLength);
  150.              Text.SetChars(self.chars^, text);
  151.             END;
  152.             next := 0;
  153.             WHILE next < lineLength DO (* for each field *)
  154.               (* Skip whitespace characters *)
  155.                    WHILE next < lineLength AND (self.chars[next] IN 
  156.                                                self.ws) DO INC(next);
  157.                 END;
  158.                 (* Collect next field *)
  159.                 len := 0;
  160.                 WHILE next < lineLength 
  161.                    AND NOT (self.chars[next] IN self.ws) DO
  162.                     INC(len); INC(next);
  163.                 END;
  164.                 (* Save information about the field *)
  165.                 IF len > 0 THEN
  166.                        AddDescriptor(self, FieldDescriptor{start:=
  167.                                                     next - len, len := len});
  168.                 END;
  169.             END(*WHILE*);
  170.         END(*LOCK*);
  171.     END getLine;
  172. PROCEDURE GetDescriptor(t: T; n: FieldNumber): FieldDescriptor RAISES {Error} =
  173.     (* Return the descriptor for field n. Depending on user's wishes,
  174.     treat too-large field numbers as empty fields or as an error. *)
  175.     BEGIN
  176.         (* Handle bad field number first. *)
  177.         IF n >= t.nFields THEN
  178.             RAISE Error;
  179.         END;
  180.         (* Be sure text and numeric values are set. *)
  181.         WITH fd = t.fds[n] DO
  182.           IF fd.text # NIL THEN RETURN fd; END; (* Already done this *)
  183.           fd.text := Text.FromChars(SUBARRAY(t.chars^, fd.start, 
  184.                                                                       fd.len));
  185.           TRY (* to interpret field as floating-point number *)
  186.               fd.number  := FLOAT(Scan.LongReal(fd.text), NumberType); 
  187.               fd.numeric := TRUE;
  188.             EXCEPT
  189.                 Scan.BadFormat => 
  190.                     TRY (* to interpret field as integer *)
  191.                         fd.number  := FLOAT(Scan.Int(fd.text), 
  192.                                                                    NumberType);
  193.                         fd.numeric := TRUE;
  194.                     EXCEPT
  195.                        Scan.BadFormat => (* not a number *)
  196.                             fd.number  := Zero;
  197.                             fd.numeric := FALSE;
  198.                     END;
  199.             END;
  200.             RETURN fd;
  201.         END(*WITH*);
  202.     END GetDescriptor;
  203. PROCEDURE numberOfFields(self: T): CARDINAL =
  204.     BEGIN
  205.         LOCK self DO RETURN self.nFields; END;
  206.     END numberOfFields;
  207. PROCEDURE isANumber(self: T; n: FieldNumber): BOOLEAN RAISES {Error} =
  208.     BEGIN
  209.         LOCK self DO
  210.             WITH fd = GetDescriptor(self, n) DO RETURN fd.numeric; END;
  211.         END;
  212.     END isANumber;
  213. PROCEDURE number(self: T; n: FieldNumber): NumberType RAISES {Error} =
  214.     BEGIN
  215.         LOCK self DO
  216.              WITH fd = GetDescriptor(self, n) DO RETURN fd.number; END;
  217.         END;
  218.     END number;
  219. PROCEDURE line(self: T): TEXT =
  220.     BEGIN
  221.         LOCK self DO RETURN self.originalLine; END;
  222.     END line;
  223. PROCEDURE text(self: T; n: FieldNumber): TEXT RAISES {Error} =
  224.     BEGIN
  225.         LOCK self DO
  226.             WITH fd = GetDescriptor(self, n) DO
  227.                 RETURN self.fds[n].text;
  228.             END;
  229.         END(*LOCK*);
  230.     END text;
  231. PROCEDURE init(self: T; ws := DefaultWS): T =
  232.     BEGIN
  233.         LOCK self DO
  234.             self.ws           := ws;
  235.         END;
  236.         RETURN self;
  237.     END init; 
  238. BEGIN
  239.     (* No module initialization code needed *)
  240. END FieldList.
  241.  
  242.  
  243.  
  244. Figure 1: Modula_3 version of the classic "Hello, World!" program
  245.  
  246.  
  247. MODULE Hello EXPORTS Main;
  248. IMPORT Wr, Stdio;
  249. BEGIN
  250.     Wr.PutText(Stdio.stdout, "Hello, World!\n");
  251.     Wr.Close(Stdio.stdout);
  252. END Hello.
  253.  
  254.  
  255.  
  256.  
  257. Figure 2. Signatures for isANumber.
  258.  
  259. Method  Procedure
  260. isANumber(n: FieldNumber): BOOLEAN 
  261.  RAISES {Error} isANumber(self: T; n: FieldNumber): BOOLEAN
  262.  RAISES {Error}
  263.  
  264.  
  265. Figure 3. Procedure to accept a pointer of any type and return as 
  266. a floating-point number the value pointed to. 
  267.  
  268.  
  269. PROCEDURE GetReal(ptr: REFANY): REAL = (* Return ptr^ as a REAL *)
  270.     VAR realPtr := NARROW(ptr, REF REAL);
  271.     BEGIN
  272.         RETURN realPtr^;
  273.     END GetReal;
  274.  
  275.  
  276. Figure 4. Making explicit run-time type testing in the GetReal
  277. procedure
  278.  
  279. PROCEDURE GetReal2(ptr: REFANY): REAL = (* Return ptr^, or 0.0 *)
  280.     BEGIN
  281.         IF ptr # NIL AND ISTYPE(ptr, REF REAL) THEN
  282.             RETURN NARROW(ptr, REF REAL)^;
  283.         ELSE 
  284.             RETURN 0.0; (* ptr is not what we expected *)
  285.         END;
  286.     END GetReal2;
  287.  
  288.