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