Modula-3

Writing Programs

Modula-3 programs are composed of one or more module files, along with a makefile that tells the compiler how to put everything together. All of these files must be located in a subdirectory called src.

IMPORTANT: Case is significant in Modula-3 programs. This means that

The Main Module

Every Modula-3 program must have a single main module. For small programs, the main module may be the only module. Here is a short example.

MODULE Main;

IMPORT IO; (* So we can print things *)

VAR name: TEXT;  (* a string called `name' *)

BEGIN
  IO.Put("Enter your name: ");
  name := IO.GetLine();
  IO.Put("Your name is: " & name & "\n");
END Main.

The Makefile

An SRC Modula-3 makefile (named m3makefile) contains instructions (one per line) that instruct the compiler how to build a program or library. A makefile instruction is followed by one or more arguments in parenthesis, like a procedure call. Each instruction generally specifies a library, interface, or module to be included as part of the final library or program. Comments are denoted by %.

A Simple Makefile

Here is a simple m3makefile:

% Makefile for Modula-3 program 'myprog' 

import(libm3)
implementation(main)
program(myprog)

The first line is a comment. Text after % is ignored by the compiler in m3makefiles.

The import command tells the compiler that the program uses routines in the library libm3. This command is present in most m3makefiles. If you use routines from other libraries, you must include other import commands that tell the compiler which libraries to include.

There must be one implementation command for each .m3 file in your program. In this case, there was only one such file: main.m3.

Finally, the program command tells the compiler what to name the resulting executable file. The compiler will name this program's executable myprog.

Basic Makefile Commands

The following are some of the commands that may be used in an m3makefile. They declare their arguments as private: visible only within the current package. To declare an interface or module as public, use the capitalized version (e.g., Interface(), Implementation(), etc.).

interface(X) / generic_interface(X)
Declares that the file X.i3 (or X.ig for generics) contains an interface. All interface files that you create must appear in interface commands. Leave the .i3/.ig extension off.
implementation(X) / generic_implementation(X)
Declares that the file X.m3 (or X.mg for generics) contains a module. All module files that you create must appear in implementation commands. Leave the .m3/.mg extension off.
module(X) / generic_module(X)
Declares X.i3 and X.m3 with one command (X.ig and X.mg for generics).
program(<name>)
An m3makefile generally has one program command. This specifies what to name the program executable.
library(<name>)
If the m3makefile describes a collection of interfaces and modules that are designed to be a library instead of a program, use this command instead of program().
import(<lib>)
This command specifies packages to be imported. The libm3 package must be included in all Modula-3 programs with the import command.

Other Makefile Commands

override(P, D)
Look in directory D/P for the package P instead of in the public repository. Use this command in conjunction with the import(P) command when you want to build and use your own private libraries.
c_source(X)
Declares that the file X.c contains C source code.
import_lib(X, P)
If P/libX.a is a library, includes -LP -lX in the final link command. Otherwise, includes -lX in the final link command.
import_obj(X)
Include X in the final link command.
m3_option(X) / remove_m3_option(X)
Add or remove option X to/from list of compiler options. X should be a string (enclosed in "") containing one of the following:
-why
Explain why each compilation is needed (default).
-commands
Print the compilation commands as they are started.
-verbose
Print what happens to each file.
-times
Print a breakdown of elapsed time.
-g
Generate debugging symbols (default).
-O
Optimize code.
-a
Turn off <*ASSERT*> checking.
-keep
Preserve intermediate files.
-once
Don't recompile modules with new opaque info.

Language Elements

Modula-3 programs include declarations, statements, expressions, and pragmas.

Modules

Modules are the basic building blocks of Modula-3 programs. A module is a named collection of declarations, including constants, types, variables, and procedures. A module can make its facilities available to other modules, called clients.

Modules are composed of two pieces: one public, the other private. The public part is called an interface and gives only the types and procedure interfaces that are needed for clients to use the module. The private section, called the implementation or module, fills in the details with procedure definitions and other private declarations that are hidden from clients.

Interface

The interface is the public portion of a module. All declarations in the interface are visible to clients of the module.

Interface files have the name of the module with an .i3 extension, and have the following format:

INTERFACE <interface-name>;

{Imports}      (* See section Imports *)

{Declarations} (* See section Declarations *)

END <interface-name>.

Generally, <interface-name> is the same as the name of the corresponding module.

Here is an example of an interface for a module MyModule which is in a file called MyModule.i3:

INTERFACE MyModule;

CONST MaxEntries = 53;
TYPE Thing = RECORD name: TEXT; size: INTEGER END;

PROCEDURE PrintThing(READONLY r: Thing);
PROCEDURE MakeThing(n: TEXT; s: INTEGER): Thing;

END MyModule.

Implementation

The implementation is the private portion of a module. Implementation files have the name of the module with an .m3 extension, and have the following format:

MODULE <module-name> [ EXPORTS <interface> { "," <interface> ... } ];

{Imports}      (* See section Imports *)

{Declarations} (* See section Declarations *)

BEGIN  (* Optional Module startup code; BEGIN required *)
END <module-name>.

Generally, <module-name> is the same as the name of the interface being implemented, but if not, the EXPORTS clause can be used to specify which interface(s) are being implemented.

Here is an example of an implementation file MyModule.m3 that implements MyModule:

MODULE MyModule;

IMPORT IO;

PROCEDURE PrintThing(READONLY r: Thing) = 
  BEGIN
    IO.Put(r.name&"\t");
    IO.PutInt(r.size);
    IO.Put("\n");
  END PrintThing;

PROCEDURE MakeThing(n: TEXT; s: INTEGER): Thing =
  BEGIN
    RETURN Thing{n, s};
  END MakeThing;

END MyModule.

Imports

Modules gain access to declarations in other modules via the import mechanism. For example, a main module cannot use types or procedures defined in the IO Interface until it explicitly imports the definitions using the IMPORT statement like this:

IMPORT IO;

Once a module's declarations are imported, they are referenced by prefixing their names with the name of the module and a period (.) like this:

IO.Put("Hello, world.");

IMPORT Statement

IMPORT <module-name> [ AS <alias> ] { "," ... } ";"
  or
FROM <module-name> IMPORT <decl-name> { "," <decl-name>...} ";"

The IMPORT statement allows a module to see declarations such as procedures and types that appear in another module's interface. IMPORT statements must appear after the MODULE or INTERFACE statement and before any declarations.

When using declarations imported from another module, the nonlocal declaration name must be qualified with the name of the module it was imported from unless the second form of the IMPORT statement is used. For example:

INTERFACE Box;

CONST Size = 30;

END Box;

(* Client Module *)
MODULE Toys;

IMPORT Box;

VAR boxSize := Box.Size;  (* Nonlocal declaration Size qualified
                             by module name Box *)
END Toys.

(* Another Client Module *)
MODULE Toys2;

FROM Box IMPORT Size;

VAR boxSize := Size; (* Nonlocal reference Size not qualified *)

END Toys2;

Declarations

Declarations bind names with values or types. They appear in the outermost level of module interfaces and implementations after the IMPORT statement, as well as at the beginning of blocks. Kinds of declarations include constants, types, variables, procedures, and exceptions. They can appear in any order.

Declarations Examples

CONST
	Pi = 3.14;		(* REAL *)
	Maxsize = 30;		(* INTEGER *)
	Space = ' ';		(* CHAR *)

TYPE
	Index = [1..Maxsize];	                (* Subrange *)
	Letters = ['a'..'z'];	                (* Subrange *)
	Colors = {Red, Green, Blue, Yellow};	(* Enumerated *)
	ArrType = ARRAY Colors OF INTEGER;	(* ARRAY *)
	ArrType2 = ARRAY [1..5] OF CHAR;	(* ARRAY *)
	SetType = SET OF Letters;	        (* SET *)
	Ptr = REF Student;		        (* Pointer *)
	Student = RECORD		        (* RECORD *)
	   name : TEXT;
	   id   : INTEGER;
	   gpa  : REAL;
	   next : Ptr;
	END;

VAR
	n	: INTEGER	:= -15;	                (* INTEGER *)
	nonneg	: CARDINAL	:= 5;	                (* CARDINAL *)
	x	: REAL	        := 3.0;	                (* REAL *)
	ch	: CHAR	        := 'Q';	                (* CHAR *)
	done	: BOOLEAN	:= TRUE;	        (* BOOLEAN *)
	str	: TEXT	        := "Test";	        (* TEXT *)
	arr	: ArrType	:= ArrType{0,1,2,3};	(* ARRAY *)
	arr2	: ArrType2	:= ArrType2{' ', ..};	(* ARRAY *)
	inFile	: Rd.T;		                        (* Reader *)
	outFile	: Wr.T;		                        (* Writer *)
	ltrSet	: SetType := SetType{'a'..'d','z'};	(* SET *)
	head	: Ptr	        := NIL	                (* Pointer *)
	st	: Student		                (* RECORD *)
		:= Student{"Joe", 15426, 3.35, NIL};

PROCEDURE One(y: REAL; VAR c: ArrType; x: INTEGER := 5) =
(* Sample procedure definition.  y is a value parameter;
   c is a variable parameter; x is a value parameter with
   a default value *)
VAR i: INTEGER;	(* local var *)
BEGIN		(* procedure body *)
  <statement1>;
  .
  .
  .
  <statementn>;
END One;

PROCEDURE Max(a, b: INTEGER): INTEGER =
(* Sample function definition. *)
VAR max: INTEGER;
BEGIN
   max := a;
   IF a < b THEN max := b END;
   RETURN max;
END Max;

Constants

CONST <identifier> [ ":" <type> ] "=" <constant expression> ";"

Constant declarations are used to give names to values that can be computed at compile time. Here are some examples:

CONST
  MaxValue: INTEGER = 5 * (25 - 3);       (* INTEGER *)
  MinValue = 2;                           (* INTEGER *)
  RangeValue = MaxValue - MinValue + 1;   (* INTEGER *)
  Name = "Arnie Shoestring";              (* TEXT *)
  Caps = SET OF CHARACTER{'A'..'Z'};    (* SET OF CHARACTER *)

Types

TYPE <identifier> "=" <type> ";"

It is convenient to be able to give names to types, and the TYPE declaration allows you to do this. <type> may be one of the following:

Ordinal Types

INTEGER | CARDINAL | BOOLEAN | CHAR       (* Built-in *)
"{" <id>"," <id>"," ... "}" ";"    (* Enumerated types *)
"[" <lo>..<hi> "]" ";"         (* Subrange types *)

Ordinal types denote sets of values in which each value has a unique successor.

INTEGER
The set of 32-bit signed integers (positive and negative).
CARDINAL
A synonym for the subrange [0..LAST(INTEGER)]
BOOLEAN
The enumeration {FALSE, TRUE}
CHAR
The set of ISO-Latin-1 characters (an extension of ASCII)
Enumerated
An enumerated type is an ordered set of values whose names are specified by the user, as follows:
TYPE Day = {Sunday, Monday, Tuesday, Wednesday, Thursday,
            Friday, Saturday};
Values of an enumeration are specified as <typename>.<value>: for example, Day.Sunday rather than just Sunday. Thus, you should keep enumeration type names short.
Subrange
A subrange is a subset of the values of the base type specified by the range <lo>..<hi>. <lo> and <hi> must both be values of the same ordinal type. Integer subranges are the most common:
TYPE Digit = [0 .. 9];         (* subrange of INTEGER *)
     WeekDay = [Day.Monday .. Day.Friday];   (* subrange of Day *)

Array Types

ARRAY { <indextype> "," ... } OF <slottype> ";"

<indextype> must be an ordinal type (see section Ordinal Types). The common case is an integer subrange such as [1..numslots], but Modula-3 programs frequently use user-defined enumerations as well.

<slottype> can be any Modula-3 type, even another array.

Here are some examples of array types:

TYPE
  OneDimArray  = ARRAY [1..20] OF REAL;
  OneDimArray2 = ARRAY ['A'..'Z'] OF INTEGER;
  TwoDimArray  = ARRAY [1..20], [1..40] OF BOOLEAN;
  TwoDimArray2 = ARRAY [1..20] OF ARRAY [1..40] OF BOOLEAN;

The built-in functions FIRST, LAST, and NUMBER can be used with array types and variables to return the index of the first and last slot and number of slots, respectively. For example, FIRST(OneDimArray) = 1; NUMBER(OneDimArray2) = 26.

Record Types

RECORD <fieldDecl> { ";" <fieldDecl> ... } END ";"

where

<fieldDecl> = <id> [ ":" <type> ]  [ ":=" <constant expr> ]

Record types group related data items together in a unified data structure. Each data item, or field, has a name, a type, and an optional constant initializer. If you supply the constant initializer, you can omit the type; it will be inferred from the constant. Here are some examples:

TYPE
  (* Record type with uninitialized fields *)
  Rec1 = RECORD
    x, y: INTEGER;
    name: TEXT
  END;  

  (* Record type with initialized fields *)
  Rec2 = RECORD
    x, y := 0; (* Type is INTEGER *)
    name := "" (* Type is TEXT *)
  END; 

Object Types

[ <parentObjType> ] OBJECT
                      <fields> 
                    [ METHODS <methods> ] 
                    [ OVERRIDES <overrides> ]
                    END 

An object is a record paired with a method suite: a collection of procedures that operate on the object. The fields of an object are specified just like those of records (see section Record Types). Methods are fields that hold procedure values. They are specified as follows:

<methods> = { <method> ";" ... }
  where
<method> = <id> <sig> [ ":=" <proc id> ]

A method signature <sig> is a procedure signature (see section Procedure Types). If a procedure identifier <proc id> is given, it must refer to a procedure which takes as its first parameter the object being defined, and other parameters as specified by the signature <sig>.

Overrides specify new procedures for methods of the supertype:

<overrides> = { <override> ";" ... }
  where
<override> = <id> ":=" <proc id>

Set Types

SET OF <basetype>

<basetype> can be any ordinal type (see section Ordinal Types) with a "reasonable" number of elements. For example, CHAR has 256 elements, a reasonable number, but a (32-bit) INTEGER has over 4 billion, an unreasonable number. So SET OF INTEGER is not possible, but SET OF [-100..100] is legal.

Reference Types

REF <type>

<type> can be any type, even a reference type. This specifies a reference (pointer) to a value of type <type>. For example:

TYPE
  IntPtrType = REF INTEGER;                 (* A pointer to an integer *)
  ArrPtrType = REF ARRAY [1..5] OF CHAR;    (* A pointer to an array *)

Procedure Types

PROCEDURE <sig>
  where
<sig> = "(" { <formal> ";" ... } ")" 
           [ ":" <result type> ]
           [ RAISES ( ANY | "{" { <exception> "," ... } "}" ) ] 
 
<formal> = [ VAR | READONLY | VALUE ] <id> { "," <id> ... } 
           [ ":" <type> ] [ ":=" <const expr> ]

If a result type for the procedure is specified, then the procedure must return a value of that type.

If a constant expression <const expr> is supplied as a default value for a formal parameter, the type may be omitted, and when the procedure is called, if an argument is not supplied for a formal with a default value, the default value is used to initialize the formal.

The RAISES section specifies which exceptions the procedure is allowed to raise. Any exceptions that occur in the procedure, possibly as the result of a call to another procedure, that are not handled by the procedure and that do not appear in the RAISES clause cause a checked run-time error. If the RAISES section is omitted, then any exceptions raised cause a checked run-time error.

The VAR, VALUE, and READONLY parameter modes determine how the actual argument is associated with the formal parameter:

@bullet{VALUE}
This is the default mode, and means "call by value." The formal parameter contains a copy of the value of the actual argument. Changes to the formal parameter do not affect the actual argument.
@bullet{VAR}
This means "call by reference." The formal parameter is linked to the actual argument. Changes to the formal parameter are reflected in the actual argument. In general, the actual argument must be a variable. No default value may be specified.
@bullet{READONLY}
This means generally "call by reference," but the procedure may not modify the formal parameter. This provides the protection of call by value with the efficiency of call by reference, and should be used when large arrays or records need to be passed as parameters but should not be changed.

Variables

VAR <id> { "," <id> ... } [ ":" <type> ] [ ":=" <expr> ] ";"

Declaring variables in Modula-3 is much like Pascal, except that the type can be omitted if an initialization expression is provided. The initialization expression <expr> need not be constant. Here are some examples:

VAR
  x: INTEGER;
  s := "Hello";    (* type TEXT is implied *)
  chars := SET OF CHAR{'a'..'z'};    (* type SET OF CHAR is implied *)
  y, z := 0;       (* both y and z are INTEGER initialized to 0 *)

Procedures

PROCEDURE <id> <sig> "="
  <decls>
  BEGIN
    <stmts>
  END <id> ";"

A procedure declaration is composed of an identifier, a signature (see section Procedure Types), optional local declarations, and statements. The identifier <id> at the end of the procedure must match the id at the beginning. Declarations made in a procedure are local to the procedure: they exist only while the procedure is executing.

If the procedure signature specifies a result type, the procedure is called a function procedure, and it must include a RETURN statement which returns an expression of the specified type. It is a checked runtime error for a function procedure to fail to return a result.

Exceptions

EXCEPTION <id> [ "(" <parm type> ")" ] ";"

Exceptions can only be declared at the top-level of a module or interface. If they will take an argument, a parameter type <parm type> must be specified in parentheses.

EXCEPTION
  UserAbort(TEXT);
  EndOfFile;

Statements

Statements appear in procedures and in a module's top-level block. The statement terminator is the semicolon, which may be omitted after the last statement in a sequence (in which case it is a statement separator).

Constructs such as FOR, WHILE, REPEAT, WITH, etc. can contain multiple statements and must be terminated by END. In general, whenever a Modula-3 language construct requires an END, it can contain zero, one, or more elements.

Assignment Statements

<v> ":=" <e>

Sets <v> to the value of <e>. <v> must be a writable designator (generally, a variable or non-READONLY procedure parameter).

INC "(" x { "," n} ")"
DEC "(" x { "," n} ")"

These are shortcuts for x := x + n and x := x - n, respectively. If omitted, n defaults to 1. x must be an ordinal value (INTEGER, CHAR, or enumerated value). n must be an integer expression. Some examples are in order;

intvar := 53;   
DEC(intvar);     (* intvar = 52 *)

charvar := 'a'; 
INC(charvar, 3); (* charvar = 'd' *)

Procedure Call and Return Statements

To call a procedure, use one of the following two forms:

1) <procexpr> "(" { <arg> "," ... } ")"
     where
   <arg> = [ <argname> ":=" ] <expr> 

2) EVAL <expr>

The first form is used to call a proper procedure (one that does not specify a return type and thus has no return value). The second is used to call a function procedure when you want to throw away the return value. For example:

IO.Put("Hello");    (* Call a proper procedure *)
EVAL IO.EOF();      (* Call a function procedure and throw away result *)

To return from a procedure, use the following statement:

RETURN [ <expr> ]

The RETURN statement is used inside procedures only to return control to the caller. A return value must be supplied if the procedure is a function procedure, but may not appear if the procedure is a proper procedure.

Selection Statements

IF Statement

IF <expr> THEN <stmts> { ELSIF <expr> THEN <stmts> ... } 
[ ELSE <stmts> ] END

<expr> must be a boolean-valued expression. Here is an example:

IF Text.Equal(txt,"Strawberry") THEN
  IO.Put("Not bad")
ELSIF Text.Equal(txt,"Avacado") THEN
  IO.Put("Yuck!")
ELSIF Text.Equal(txt,"Chocolate") THEN
  IO.Put("Yum")
ELSE
  IO.Put("Nah.")
END

CASE Statement

CASE <expr> OF { "|" <case> ... } [ ELSE <stmts> ] END
  where
    <case> = { <label> "," ... } "=>" <stmts>
    <label> = <const expr> [ ".." <const expr> ]

The case statement is a specialization of the IF/THEN/ELSIF statement that allows discrimination among a set of possible values of some ordinal expression <expr>. If a case is encountered that is not handled by one of the arms of the case statement, the ELSE arm is taken; if no ELSE arm is present in this situation, a checked run-time error occurs.

CASE IO.GetChar() OF
| 'a'..'z' => IO.Put("Lowercase");
| 'A'..'Z' => IO.Put("Uppercase");
| '0'..'9' => IO.Put("Digit");
| '!', '.', ':', ';', '?' => IO.Put("Punctuation");
ELSE
  IO.Put("Other")
END

The compiler will generate a warning if no ELSE arm appears and not all cases are covered. This can be ignored at risk of a possible runtime error, or an empty ELSE arm can be inserted to pacify the compiler and runtime system.

TYPECASE Statement

TYPECASE <ref expr> OF { "|" <case> ... } [ ELSE <stmts> ] END
  where
    <case> = { <type> "," ... } { "(" <id> ")" } "=>" <stmts>

<ref expr> is a pointer of some sort, and <id> is bound to the value of the reference if specified. For example:

VAR ptrVar: REFANY;

TYPECASE ptrVar OF
| NULL =>  (* <ptrVar> contains NIL *)
| REF CHAR =>  (* <ptrVar> is a pointer to a character *)
| REF INTEGER(intPtr) =>  (* <ptrVar> is a pointer to an integer, and
                             <intPtr> gets bound to that pointer value *)
ELSE
  (* <ptrVar> points to something else *)
END;

Looping Statements

Modula-3 provides the Pascal loop constructs FOR, WHILE and REPEAT, as well as the LOOP statement, which loops infinitely. In addition, the EXIT statement can appear in any loop construct, and causes the innermost loop to terminate when it is executed.

FOR Statement

FOR <id> ":=" <expr1> TO <expr2> [ BY <stepval> ] DO <stmts> END

Initializes <id> to <expr1>, evaluates <expr1> and <expr2>, then executes <stmts>, increments <id> by <stepval> (by 1 if <stepval> is not specified), and loops if <id> <= <expr2>. If <stepval> is negative, then loops while <id> >= <expr2>.

<expr1> and <expr2> must both be of the same ordinal type (see section Ordinal Types). <id> is defined locally by the FOR loop as a READONLY variable, and its type is the type common to <expr1> and <expr2>. For example:

VAR i: INTEGER := 5;
    x: INTEGER;
BEGIN
  FOR i := 1 TO 10 DO  x := i;  END; (* FOR *)
  IO.PutInt(i);   (* Puts '5', because the 'i' in the FOR loop isn't the same 
                     as this 'i' *)
  IO.PutInt(x);   (* Puts '10' because 'x' was assigned the value of the 'i'
                     in the FOR loop *)
END

Another example prints the letters 'A'..'E' using the CHAR ordinal type for the FOR limits:

FOR i := 'A' TO 'E' DO IO.PutChar(i); END  (* 'i' is of type CHAR *)

WHILE Statement

WHILE <expr> DO <stmts> END

<expr> must be a boolean-valued expression. <stmts> are executed until <expr> becomes FALSE. If <expr> is FALSE at the start <stmts> are not executed at all.

REPEAT Statement

REPEAT <stmts> UNTIL <expr>

<expr> must be a boolean-valued expression.

LOOP Statement

LOOP <stmts> END

The LOOP statement executes <stmts> repeatedly in an infinite loop. Normally an EXIT statement appears in some IF statement in <stmts> to exit the loop when some condition becomes true. The following example prints "Hello" forever.

LOOP
  IO.Put("Hello\n");
END (* LOOP *)

EXIT Statement

EXIT

The EXIT statement must appear inside a WHILE, REPEAT, or LOOP statement. It causes the flow of execution to branch to the statement immediately following the innermost loop in which it appears. For example:

FOR x := 1 TO 5 DO
  i := 1;
  WHILE i < 3 DO
    i := i + 1;
    IF CheckIt(i, x) THEN
      EXIT  (* Transfers control to the IO.Put below *)
    END
  END; (* WHILE *)
  IO.Put("x = " & Fmt.Int(x) & "\n")
END; (* FOR *)

Compound Statements

The following statements allow local declarations that are visible only within the scope of the statement.

Block Statement

<decls>
BEGIN
  <stmts>
END

The block statement is not needed nearly as frequently in Modula-3 as in other languages because Modula-3 loops, if/then statements, etc. can contain multiple statements. It allows the declaration of local variables that are visible only within the block. For example:

VAR b := FALSE;
    x := 0;
BEGIN (* block *)
  WHILE NOT b DO 
    INC(x);
    b := (x > 5);
  END (* while *)
END (* block *)

WITH Statement

WITH <id> "=" <expr> { "," <id> "=" <expr> ... } DO <stmts> END

The WITH statement binds identifiers <id> to the value of expressions <expr>. The expressions are evaluated once at the beginning of the statement, and the identifiers are defined only within the scope of the WITH statement. If <expr> is a variable or other writable designator, <id> becomes an alias for it, so modifying <id> modifies the variable it is bound to.

The following example prints the contents of a file "data.txt" on standard output.

WITH rd = IO.OpenRead("data.txt") DO
  WHILE NOT IO.EOF(rd) DO
    IO.Put(IO.GetLine(rd) & "\n");
  END; (* WHILE *)
  Rd.Close(rd);
END; (* WITH *)

Error Handling Statements

Modula-3 provides an exception mechanism for raising and handling error conditions that occur in programs.

RAISE Statement

RAISE <exception> [ "(" <exception parm> ") ]

Use the RAISE statement to raise an exception <exception>. If <exception> as defined requires a parameter, one must be supplied in parenthesis.

TRY-EXCEPT Statement

TRY
  <guarded stmts>
EXCEPT
"|" <exception id> { "," <exception id> ... } "=>" <stmts>
    (* Non-parameterized exceptions *)

"|" <exception id> "(" <parm id> ")" "=>" <stmts>
    (* Parameterized exception handler *)

[ ELSE <stmts> ]
END

The TRY-EXCEPT statement guards statements between TRY and EXCEPT with the exception handlers between EXCEPT and END. An exception raised by a <guarded stmt> is handled by <stmts> in the corresponding handler, or by ELSE <stmts>, if present, and execution continues with the statement following END.

EXCEPTION Failure(Severity);
TYPE Severity = {Low, Medium, High};
...

TRY
  ...
EXCEPT
| IO.Error =>
    IO.Put("An I/O error occurred.")
| Lex.Error =>
    IO.Put("Unable to convert datatype.")
| Severity(x) => 
    IF x = Severity.Low THEN IO.Put("Not bad") ELSE IO.Put("Bail out") END
END;

TRY-FINALLY Statement

TRY
  <guarded stmts>
FINALLY
  <cleanup stmts>
END

When an exception occurs in a <guarded stmt>, control is transferred to <cleanup stmts>, and when they have completed, the exception is re-raised. Thus, the TRY-FINALLY statement does not trap exceptions as TRY-EXCEPT does; it merely allows some "cleaning up" before the exception is passed up to be handled by a TRY-EXCEPT statement in a calling routine.

NOTE: The TRY-FINALLY statement catches internal exceptions raised by all EXIT and RETURN statements.

Expressions

Modula-3 supports a rich variety of strongly type-checked expressions.

Expression Building Blocks

Literal
A literal is a constant value that can be either a number, a character, or a string.
Number | CharLiteral | TextLiteral
Identifier
Identifiers are names given to types, procedures, constants, etc. They consist of a letter followed by one or more letters, digits, and underscores. Modula-3 is case sensitive, so identifiers with the same letters in different cases are different identifiers. Example: test, a_5
Letter { Letter | Digit | "_" ... }
CharLiteral
A character literal represents a single ASCII character (type CHAR). Example: 'A', '\n', '\015'
"'" (PrintingChar | Escape | ") "'"
A PrintingChar is a letter, digit, punctuation mark, or any ISO-Latin-1 code in [ 160..255 ]. An Escape is one of the following:
TextLiteral
A text literal represents a value of type TEXT (a string). Example: "Hello.\n"
" { PrintingChar | Escape | "'" ... } "
PrintingChar and Escape have the same meanings as given above.
Number
A number is an integer or floating point number. Integers can be expressed in any base [2..16] by writing the base followed by "_" and the number in that base. Example: 2_1010 (base 2) = 8_12 (base 8) = 10 (base 10) = 16_A (base 16). Floating point numbers can be expressed in the conventional scientific notation as follows:
Digit { Digit ... } "." Digit { Digit ... } [ Exponent ]
  where
Exponent = "E" | "D" | "X" [ "+" | "-" ] Digit { Digit ... }

Arithmetic Expressions

The usual arithmetic operators are available for numeric computation. Some of the operators work for both INTEGERs and REALs, but an INTEGERs and REALs may not be mixed in an expression. For example, the expression 5 + 6.9 is illegal. Instead, use FLOAT(5) + 6.9 or 5.0 + 6.9. Here are the common infix binary operators:

+ (addition)
computes sum of operands
- (subtraction)
computes difference of operands
* (multiplication)
computes product of operands
DIV (integer division)
computes integer quotient of operands
/ (REAL division)
computes floating point quotient of operands
MOD (modulus)
computes integer remainder after a division

The following built-in arithmetic functions are also useful:

ABS(a)
returns -a if a < 0; otherwise, returns a
MAX(a,b)
returns the greater of a and b
MIN(a,b)
returns the lesser of a and b

For converting between INTEGERs and REALs, use the following built-in functions:

FLOAT(x [ "," REAL | LONGREAL | EXTENDED ])
converts any kind of numeric value x to a floating point value (REAL is the default).
ROUND(x)
converts a floating point value x to the nearest integer
TRUNC(x)
converts a floating point value x to the nearest integer in the direction of 0.0
FLOOR(x)
returns the greatest integer not exceeding a floating point value x
CEILING(x)
returns the least integer not less than a floating point value x

Logical Expressions

Modula-3 supports the usual boolean operators. Short-circuit (conditional) evaluation is used. From highest to lowest precedence, they are:

NOT <expr>
TRUE if <expr> is FALSE; FALSE if <expr> is TRUE
<expr1> AND <expr2>
TRUE iff <expr1> and <expr2> are both TRUE, otherwise FALSE
<expr1> OR <expr2>
TRUE iff either <expr1> or <expr2> is TRUE, otherwise FALSE

Modula-3 also supports bitwise logical computation on unsigned numbers using the procedures in the Word interface (see section Word Interface).

Relational Expressions

In Modula-3, comparisons between two types are done with the following binary operators (see caution about comparing TEXTs below):

= (Equal), # (Not Equal)
These operators can be used with any Modula-3 type:
  • Ordinals are equal if they have the same value
  • Floats are equal if the underlying implementation defines them to be
  • References are equal if they address the same location
  • Procedures are equal if they refer to the same procedure body and environment
  • Sets are equal if they have the same elements
  • Arrays are equal if they have the same length and corresponding elements are equal
  • Records are equal if they have the same fields and corresponding fields are equal
< (Less Than), <= (Less Than or Equal To)
Ordinal types: the usual meaning. For sets, proper subset and subset, respectively.
> (Greater Than), >= (Greater Than or Equal To)
Ordinal types: the usual meaning. For sets, proper superset and superset, respectively.
IN
For sets only, the expression (<e> IN <s>) is TRUE iff <e> is an element of the set <s>.

CAUTION: These operators should not be used to compare TEXT values. Use Text.Equal and Text.Compare to compare two TEXTs (see section Text Interface). The compiler will allow = and # with TEXTs, but it is the addresses at which the TEXTs are stored that are compared, not the contents of the TEXTs.

Constructors

A constructor is an expression used to represent a set, record, or array value. Constructors are used to initialize variables and constant values. The general form of a constructor is

<type> "{" <expr1> "," ... "," <exprn> "}"

where <type> is a set, record, or array type, and <expr1> .. <exprn> are expressions used to initialize the components of <type>.

Set Constructor

<set type> "{" <expr1> "," ... "," <exprn> "}"

A set constructor is an set-valued expression. <set type> may be any set type (see section Set Types). The expressions <expr1> .. <exprn> must be expressions that evaluate to elements of the set's base type. An <expr> may also be of the form <lo>..<hi>, as a shortcut for including several values. For example:

CONST 
  Letters = SET OF CHAR{'A'..'Z', 'a'..'z'};
VAR
  punctuation: SET OF CHAR := SET OF CHAR{'.', '!', ',', ';', '?'};

Array Constructor

<arr type> "{" <expr1> "," ... "," <exprn> [ ", .." ] "}"

An array constructor is an array-valued expression. <arr type> must be a fixed or open array type (see section Array Types). Each <expr> must be assignable to the element type of A. Thus, multidimensional array constructors are built by nesting array constructors (see tictactoe example below). For fixed array constructors, there must be one expression per slot, with the shortcut that if ", .." is included at the end, the last expression is repeated as many times as is needed to fill out the array.

In some of the examples below, the type of the constant or variable is explicitly specified apart from the constructor. In others, the constructor itself provides the type. Either case is valid (except when an open array type is used as a constructor).

CONST
  vowels: ARRAY [1..5] OF CHAR =
             ARRAY [1..5] OF CHAR{'a','e','i','o','u'};

  names = ARRAY [1..10] OF TEXT{"John", "Suzie", "Helen", "", ..}; 
              (* names[4] thru names[10] are set to empty strings *)

  invalid = ARRAY [1..20] OF INTEGER{5, 10, 15};
              (* not enough elements provided *)

VAR
  openarr := ARRAY OF CHAR{'a', 'b', 'c'};
              (* invalid: a variable may not be an open array *)

  vowels2: ARRAY [1..5] OF CHAR := ARRAY OF CHAR{'a','e','i','o','u'};
              (* But an open array constructor can be assigned to a 
                 fixed array type *)

  tictactoe := ARRAY [1..3], [1..3] OF CHAR{
                  ARRAY OF CHAR{' ', ' ', ' '},
                  ARRAY OF CHAR{' ', ' ', ' '},
                  ARRAY OF CHAR{' ', ' ', ' '} 
               };

Record Constructor

<rec type> "{" <expr1> "," ... "," <exprn> "}"

A record constructor is a record-valued expression. <rec type> must be a record type (see section Record Types). Each <expr> must evaluate to the type of the field in the record whose position it corresponds with. For greater clarity, each <expr> can be specified in an assignment expression (see example below). Every field must be provided with a value for the constructor to be valid.

TYPE
  Rec = RECORD x, y: INTEGER; s: TEXT; END;
VAR
  r1: Rec := Rec{5, 10, "Hello"};
  r2 := Rec{x := -5, y := 25, s := "Greetings"};

Operator Precedence

Operators below are listed in order of precedence from highest to lowest:

  1. Built-in functions (ABS, FIRST, MAX, NARROW, NEW, etc.)
  2. Field and method selection (x.a)
  3. Function calls, subscripts, constructors (F(x), a[i], t{x})
  4. Dereferencing (x^)
  5. Unary plus and minus (+, -)
  6. Multiplicative operators (*, DIV, /, MOD)
  7. Additive operators and string concatenation (+, -, &)
  8. Relational operators and set inclusion (=, #, <, <=, >=, >, IN)
  9. Logical negation (NOT)
  10. Logical conjuncation (AND)
  11. Logical disjunction (OR)

Pragmas

A pragma is a compiler directive. It is an arbitrary sequence of characters bracketed by <* and *>.

INLINE Pragma

<*INLINE*>

The <*INLINE*> pragma, which should appear before a procedure declaration, is intended to indicate that calls to the procedure should be expanded in-line, eliminating the overhead of an actual call. It is ignored by the SRC compiler.

ASSERT Pragma

<*ASSERT <boolean expr>*>

The pragma <*ASSERT expr*> may appear anywhere a statement may appear. It is a static error if "expr" is not of type BOOLEAN. At runtime "expr" is evaluated. It is a checked runtime error if the result is FALSE. Assertion checking can be disabled with the -a compiler switch.

TRACE Pragma

<*TRACE <trace proc>*>

The pragma <*TRACE <trace proc>*> may appear at the end of any variable or formal declaration. This pragma will generate tracing calls whenever the declared variable is modified. The <trace proc> must evaluate to a procedure of two arguments. The first argument is the name of the traced variable, a TEXT. The second argument is the traced variable. Note that any of the formal passing modes may be used with the second argument. For example:

MODULE M;
VAR x: Foo <*TRACE MyTrace.FooChanged*>;

will cause

MyTrace.FooChanged ("M.x", x)

to be generated after each statement that modifies x. Variable aliasing is not tracked, so

WITH  alias = x DO  INC(alias) END

will not generate any tracing. The pragma <*TRACE stmt-list*> may appear immediately after any BEGIN. The specified "stmt-list" will be inserted after each statement of the block started by the BEGIN. For example:

BEGIN <* TRACE  INC(cnt); MyTrace(cnt) *>
  i := j;
  j := i;
END;

will generate INC(cnt); MyTrace(cnt) after each of the assignment statements.

FATAL Pragma

<*FATAL (<exception-list> | ANY)*>

The pragma <*FATAL id-list*> may appear anywhere a declaration may appear. It asserts that the exceptions named in "id-list" may be raised, but unhandled in the containing scope. If they are, it's fatal and the program should crash. Effectively, the <*FATAL*> pragma disables a specific set of "potentially unhandled exception" warnings. If "id-list" is ANY, the pragma applies to all exceptions. The effects of the <*FATAL*> pragma are limited to its containing scope -- they cannot be imported from interfaces. For example:

EXCEPTION InternalError;
<*FATAL InternalError*>

at the top-level of a module M means that no warnings will be generated for procedures in M that raise but don't list InternalError in their RAISES clauses. Similarly,

PROCEDURE X() RAISES {} =
  BEGIN
    ...
    <*FATAL ANY*> BEGIN
       List.Walk (list, proc);
    END;
    ...
  END X;

specifies that although X raises no exceptions and List.Walk may, no warnings should be generated.

UNUSED Pragma

<*UNUSED*>

The pragma <*UNUSED*> may precede any declaration. It asserts that the entity in the following declaration is not used and no warnings should be generated. For example, the procedures that implement the default methods for an object may not need all of the actual parameters:

PROCEDURE DefaultClose (<*UNUSED*> wr: Wr.T) =
   BEGIN (* do nothing *) END DefaultClose;

OBSOLETE Pragma

<*OBSOLETE*>

The pragma <*OBSOLETE*> may precede any declaration (e.g. <*OBSOLETE*> PROCEDURE P ();). A warning is emitted in any module that references an obsolete symbol. This feature is used to warn clients that an evolving interface that they are using includes features which will disappear in the future.

NOWARN Pragma

<*NOWARN*>

The pragma <*NOWARN*> may appear anywhere. It prevents warning messages from being issued for the line containing the pragma. It is probably better to use this pragma in a few places and enable all warnings with the -w1 switch than to ignore all warnings.

Compiling and Running Programs

The SRC Modula-3 compiler imposes strict requirements on how you organize your source files. In general terms, it expects that you will organize your program as a collection of packages, which are themselves collections of interfaces and modules. Each package resides in its own package directory containing two subdirectories: the src directory, which contains the source code files; and the build directory, which is created when you run the compiler to hold the compiled code. For example, a package 'List' residing in the directory /proj/harry/m3 would contain source code in the directory /proj/harry/m3/List/src, and if your platform is SPARC, the build directory would be /proj/harry/m3/List/SPARC.

The m3build command is used to compile a Modula-3 package. It expects to be run from within a package directory, and executes instructions in an file named 'm3makefile' located in the directory named 'src' in the current directory. This means that if you are inside the src directory, you must issue the command cd .. to move to the parent directory before you issue the m3build command. Mysterious error messages (like "Cannot find build directory SPARC") result if you do not abide by this scheme.

Simple Compile Example

Let's take the simple program example presented earlier see section Writing Programs. First, you need to create a package directory for this program. Let's say you create a directory ~/m3/simple for this purpose. Then you need to create a subdirectory called 'src' in that directory to hold the m3makefile and source code file main.m3. So you should have the following two files in the given directories:

Finally, cd ~/m3/simple and enter the m3build command. If your m3makefile is correctly formatted and the main.m3 is correct, the compiler will create a build directory ~/m3/simple/SPARC (or whatever your platform is) and place in it the executable file myprog. So to execute, enter the command SPARC/myprog at the command prompt.

If this seems like a lot of work for a simple program, it is. That's why it's convenient to keep a test directory and m3makefile in place to test small programs. At any rate, Modula-3 is designed to manage large programs, composed of several packages, and this system works well for that purpose.

Multiple-Package Example

Consider a program Foo, which makes use of two custom Modula-3 libraries, LibA and LibB. Let's say that these packages are all located in your personal ~/m3 directory, so you have ~/m3/Foo/src, ~/m3/LibA/src, and ~/m3/LibB/src directories, each with its own collection of modules and an m3makefile.

The library m3makefiles would look something like this:

Interface(PublicModule)
Implementation(PublicModule)
interface(PrivateModule)
implementation(PrivateModule)
Library(LibA)

And the m3makefile for the main program Foo might look like this:

import(libm3)
override(LibA,"../../")  % Path is relative to Foo/src
import(LibA)
override(LibB,"../../")
import(LibB)
implementation(Main)
program(Myprog)

First, you need to compile the two library packages. So, execute the following commands:

Then, m3build the main program Foo, and you're done.

m3build Options

The following command line options are interpreted by m3build:

clean
Specifies that all compiled code is to be removed from the build directory.
-b dir
Use the <dir> configuration and build in the directory named dir. The default build directory is configured into m3build when it is installed. For example,
m3build -b SPARC
will build using the SPARC configuration instead of the default.
-d dir
Change the current directory to dir before doing anything. This option is most useful when you're editing in the src subdirectory; to compile, issue the following command:
m3build -d ..
-S
Generate derived objects regardless of the current directory's name. Normally, if the current working directory is src, m3build will refuse to build derived objects.
-O
Read the m3overrides file if present.
-v
Be verbose, i.e. echo the quake comand before executing it.
-n
Operations that invoke external programs, e.g. the Modula-3 compiler, are processed but the external programs are not executed.
-V
This option causes all the directories in which m3makefiles are read to be echoed to the standard output. It can be helpful in debugging a complex package structure.

Standard Library

The SRC Modula-3 standard library is quite comprehensive, and only the basic routines are covered here.

NOTE: Many interfaces define a type named "T": for example, Text.T, Rd.T, Wr.T. The procedure declarations in such an interface take a parameter of type T, but from the programmer's point of view, the parameter is of type Text.T, Rd.T, etc.

String Routines

Modula-3 supports strings via the built-in type TEXT and the Text module. The Text interface contains routines to convert between TEXT and ARRAY OF CHAR, as well as comparing two different strings and extracting a substring from a string. In addition to the Text interface, routines in the Fmt interface allow conversions from other data types such as INTEGER and REAL to TEXT, and the Scan interface converts from TEXT to other data types.

Text Interface

The Text interface provides procedures that work on strings. The `T' type in the procedure declarations below is really the built-in type `TEXT'.

PROCEDURE Equal(t, u: T): BOOLEAN;
Return "TRUE" if "t" and "u" have the same length and (case-sensitive) contents.
PROCEDURE Compare(t1, t2: T): [-1..1];
Compares strings "t1" and "t2" using lexicographic rules. Returns:
PROCEDURE GetChar(t: T; i: CARDINAL): CHAR;
Return the i'th character of "t", i IN [0..LENGTH(t)-1]. It is a checked runtime error if i >= Length(t).
PROCEDURE Length(t: T): CARDINAL;
Return the number of characters in "t".
PROCEDURE Empty(t: T): BOOLEAN;
Equivalent to "Length(t) = 0".
PROCEDURE Sub(t: T; start: CARDINAL; length: CARDINAL := LAST(CARDINAL)): T;
Return a sub-sequence of "t": empty if "start >= Length(t)" or "length = 0"; otherwise the subsequence ranging from "start" to the minimum of "start+length-1" and "Length(t)-1".
PROCEDURE FindChar(t: T; c: CHAR; start := 0): INTEGER;
If "c = t[i]" for some "i" in "[start~..~Length(t)-1]", return the smallest such "i"; otherwise, return -1.
PROCEDURE SetChars(VAR a: ARRAY OF CHAR; t: T);
For each "i" from 0 to "MIN(LAST(a), Length(t)-1)", set "a[i]" to "GetChar(t, i)".
PROCEDURE FromChar(ch: CHAR): T;
Return a text containing the single character "ch".
PROCEDURE FromChars(READONLY a: ARRAY OF CHAR): T;
Return a text containing the characters of "a".
PROCEDURE Hash(t: T): Word.T;
Return a hash function of the contents of "t".
PROCEDURE FindCharR(t: T; c: CHAR; start := LAST(INTEGER)): INTEGER;
If "c = t[i]" for some "i" in "[0~..~MIN(start, Length(t)-1)]", return the largest such "i"; otherwise, return -1.

Fmt Interface

The Fmt Interface converts BOOLEAN, CHAR, INTEGER, and floating point values to TEXT. The Pad routine also allows justifying TEXT in a field of spaces or other character.

The following TYPE definitions are used in the formatting routines:

TYPE Base = [2..16];
     Style = {Sci, Fix, Auto};
     Align = {Left, Right};
PROCEDURE Bool(b: BOOLEAN): TEXT;
Format "b" as "TRUE" or "FALSE".
PROCEDURE Char(c: CHAR): TEXT;
Return a text containing the character "c".
PROCEDURE Int(n: INTEGER; base: Base := 10): TEXT;
PROCEDURE Unsigned(n: Word.T; base: Base := 16): TEXT;
Format the signed or unsigned number "n" in the specified base. For example:
Fmt.Int(15) = "15"
Fmt.Int(-25) = "-25"
PROCEDURE Real(num: REAL,style,prec,literal): TEXT
PROCEDURE LongReal(num: LONGREAL,style,prec,literal): TEXT
PROCEDURE Extended(num: EXTENDED,style,prec,literal): TEXT
style: Style := Style.Auto;
prec: CARDINAL := R.MaxSignifDigits - 1;
literal := FALSE
Format the floating-point number "num" using "style" with "prec" digits after the decimal point. If "literal" is TRUE, the result is a legal Modula-3 literal.
Fmt.Real(5.5678,prec := 2) = "5.57"
PROCEDURE Pad(text: TEXT; length: CARDINAL; padChar: CHAR := ' ';
align: Align := Align.Right): TEXT;
If Text.Length(text) >= length, then "text" is returned unchanged. Otherwise, "text" is padded with "padChar" until it has the given "length". The text goes to the right or left, according to "align". For example:
Fmt.Pad("Info",6) = "  Info"
Fmt.Pad("Database",5) = "Database"
Fmt.Pad("15.55",8,'*') = "***15.55"

Scan Interface

The Scan interface contains procedures that convert a text representation to its corresponding Modula-3 value. Leading and trailing blanks (ie. characters in "Lex.Blanks") are ignored. "Lex.Error" is raised if the first non-blank substring is not generated by the corresponding "Lex" grammar or if there are zero or more than one non-blank substrings. "FloatMode.Trap" is raised as per "Lex".

PROCEDURE Bool(txt: TEXT): BOOLEAN RAISES {Lex.Error};

PROCEDURE Int(txt: TEXT; defaultBase: [2..16] := 10): INTEGER
  RAISES {Lex.Error, FloatMode.Trap};

PROCEDURE Unsigned(txt: TEXT; defaultBase: [2..16] := 16): Word.T
  RAISES {Lex.Error, FloatMode.Trap};

PROCEDURE Real(txt: TEXT): REAL
  RAISES {Lex.Error, FloatMode.Trap};

PROCEDURE LongReal(txt: TEXT): LONGREAL
  RAISES {Lex.Error, FloatMode.Trap};

PROCEDURE Extended(txt: TEXT): EXTENDED 
  RAISES {Lex.Error, FloatMode.Trap};

I/O Routines

Modula-3 uses the concept of readers and writers to perform I/O. A reader is a character input stream, and a writer is a character output stream. The Stdio interface defines a reader stdin for standard input (normally the keyboard) and a writer stdout for standard output (the video display).

The most common I/O routines for readers and writers are packaged in the IO module. More flexible IO routines exist in the Rd, Wr, and Lex modules.

I/O Examples

Here are some short programs that demonstrate using simple I/O. The first example uses only standard input and standard output, so reader and writer variables do not explicitly appear.

MODULE Main;
IMPORT IO;

VAR x: INTEGER;

BEGIN
  IO.Put("Welcome.  Enter a number: ");
  x := IO.GetInt();

  IF x < 0 THEN
    IO.Put("The number was negative.\n");
  ELSE
    IO.Put("The number was not negative.\n");
  ENDIF
END Main.

The next example does some simple file I/O. It introduces reader and writer variables:

MODULE Main;
IMPORT IO,Rd,Wr;

VAR inFile: Rd.T;
    outFile: Wr.T;
    num: INTEGER;

BEGIN
  outFile := IO.OpenWrite("numbers.dat");
  FOR i := 1 TO 10 DO 
    IO.PutInt(i, outFile);
    IO.Put("\n", outFile); 
  END;
  Wr.Close(outFile);

  inFile := IO.OpenRead("numbers.dat");
  REPEAT
    num := IO.GetInt(inFile);
  UNTIL num = 10;
  Rd.Close(inFile);

END Main.

IO Interface

The IO interface includes the most common I/O routines on readers and writers. In the descriptions below, "wr" refers to a writer and "rd" to a reader. In this module, the reader or writer parameter for each routine may be omitted. If the reader parameter is omitted, Stdio.stdin is used; if the writer parameter is omitted, Stdio.stdout is used.

The following routines send characters to a writer. They flush the output before returning, so they are not recommended for use with large files. For information on more efficient writer routines, see section Wr Interface. To output numbers, these routines use procedures in the Fmt interface (see section Fmt Interface).

PROCEDURE Put(txt: TEXT; wr: Wr.T := NIL);
Output "txt" to "wr" and flush "wr".
PROCEDURE PutInt(n: INTEGER; wr: Wr.T := NIL);
Output "Fmt.Int(n)" to "wr" and flush "wr".
PROCEDURE PutReal(r: REAL; wr: Wr.T := NIL);
Output "Fmt.Real(r)" to "wr" and flush "wr".

The following routines are used to get information from a reader. The exception "Error" is raised whenever a "Get" procedure encounters syntactically invalid input, including unexpected end-of-file. Routines in the Lex interface are used to read numbers (see section Lex Interface).

PROCEDURE EOF(rd: Rd.T := NIL): BOOLEAN;
Return "TRUE" iff "rd" is at end-of-file.
PROCEDURE GetLine(rd: Rd.T := NIL): TEXT RAISES {Error};
Read a line of text from "rd" and return it. A line of text is either zero or more characters terminated by a line break, or one or more characters terminated by an end-of-file. In the former case, "GetLine" consumes the line break but does not include it in the returned value.
PROCEDURE GetChar(rd: Rd.T := NIL): CHAR RAISES {Error};
Read the next character from "rd" and return it.
PROCEDURE GetInt(rd: Rd.T := NIL): INTEGER RAISES {Error};
Read a decimal numeral from "rd" using "Lex.Int" and return its value.
PROCEDURE GetReal(rd: Rd.T := NIL): REAL RAISES {Error};
Read a real number from "rd" using "Lex.Real" and return its value.
PROCEDURE OpenRead(f: TEXT): Rd.T;
Open the file name "f" for reading and return a reader on its contents. If the file doesn't exist or is not readable, return "NIL".
PROCEDURE OpenWrite(f: TEXT): Wr.T;
Open the file named "f" for writing and return a writer on its contents. If the file exists it will be erased. If the file does not exist it will be created. If the process does not have the authority to modify or create the file, return "NIL".

Rd Interface

An Rd.T (or "reader") is a character input stream. The basic operation on a reader is "GetChar", which returns the source character at the current position and advances the current position by one. Some readers are seekable, which means that they also allow setting the current position anywhere in the source. For example, readers from random access files are seekable; readers from terminals and sequential files are not.

EXCEPTION EndOfFile; Failure(AtomList.T); 

Since there are many classes of readers, there are many ways that a reader can break--for example, the connection to a terminal can be broken, the disk can signal a read error, etc. All problems of this sort are reported by raising the exception "Failure". The documentation of a reader class should specify what failures the class can raise and how they are encoded in the argument to "Failure".

Illegal operations cause a checked runtime error.

PROCEDURE GetChar(rd: T): CHAR RAISES {EndOfFile, Failure, Alerted};
Return the next character from "rd".
PROCEDURE EOF(rd: T): BOOLEAN RAISES {Failure, Alerted};
Return "TRUE" iff "rd" is at end-of-file.
PROCEDURE UnGetChar(rd: T);
"Push back" the last character read from "rd", so that the next call to "GetChar" will read it again. "UnGetChar(rd)" is guaranteed to work only if "GetChar(rd)" was the last operation on "rd". Thus "UnGetChar" cannot be called twice in a row, or after "Seek" or "EOF". If this rule is violated, a checked runtime error may result.
PROCEDURE CharsReady(rd: T): CARDINAL RAISES {Failure};
Return some number of characters that can be read without indefinite waiting. The "end of file marker" counts as one character for this purpose, so "CharsReady" will return 1, not 0, if "EOF(rd)" is true.
PROCEDURE GetSub(rd: T; VAR (*OUT*) str: ARRAY OF CHAR)
: CARDINAL RAISES {Failure, Alerted};
Read from "rd" into "str" until "rd" is exhausted or "str" is filled.
PROCEDURE GetSubLine(rd: T; VAR (*OUT*) str: ARRAY OF CHAR)
: CARDINAL RAISES {Failure, Alerted};
Read from "rd" into "str" until a newline is read, "rd" is exhausted, or "str" is filled. The newline character is not stripped out.
PROCEDURE GetText(rd: T; len: CARDINAL): TEXT RAISES {Failure, Alerted};
Read from "rd" until it is exhausted or "len" characters have been read, and return the result as a "TEXT".
PROCEDURE GetLine(rd: T): TEXT RAISES {EndOfFile, Failure, Alerted};
If "EOF(rd)" then raise "EndOfFile". Otherwise, read characters until a line break is read or "rd" is exhausted, and return the result as a "TEXT"---but discard the line break if it is present.
PROCEDURE Seek(rd: T; n: CARDINAL) RAISES {Failure, Alerted};
If "rd" is seekable, makes the current position := MIN(n, len(rd)).
PROCEDURE Close(rd: T) RAISES {Failure, Alerted};
If "rd" is not already closed, release any resources associated with "rd" and set "closed(rd) := TRUE".
PROCEDURE Index(rd: T): CARDINAL;
Returns the current position of "rd".
PROCEDURE Length(rd: T): INTEGER RAISES {Failure, Alerted};
Returns the total number of characters in "rd". If "len(rd)" is unknown to the implementation of an intermittent reader, "Length(rd)" returns -1.
PROCEDURE Intermittent(rd: T): BOOLEAN;
PROCEDURE Seekable(rd: T): BOOLEAN;
PROCEDURE Closed(rd: T): BOOLEAN;
Return "intermittent(rd)", "seekable(rd)", and "closed(rd)", respectively. These can be applied to closed readers.

Wr Interface

A Wr.T (or "writer") is a character output stream. The basic operation on a writer is "PutChar", which extends a writer's character sequence by one character. Some writers (called seekable writers) also allow overwriting in the middle of the sequence. For example, writers to random access files are seekable, but writers to terminals and sequential files are not.

PROCEDURE PutChar(wr: T; ch: CHAR) RAISES {Failure, Alerted};
Output "ch" to "wr". Many operations on a writer can wait indefinitely. For example, "PutChar" can wait if the user has suspended output to his terminal. These waits can be alertable, so each procedure that might wait includes "Thread.Alerted" in its raises clause.
PROCEDURE PutText(wr: T; t: TEXT) RAISES {Failure, Alerted};
Output "t" to "wr".
PROCEDURE PutString(wr: T; READONLY a: ARRAY OF CHAR) RAISES {Failure, Alerted};
Output "a" to "wr".
PROCEDURE Seek(wr: T; n: CARDINAL) RAISES {Failure, Alerted};
Set the current position of "wr" to "n". This is an error if "wr" is closed.
PROCEDURE Flush(wr: T) RAISES {Failure, Alerted};
Perform all buffered operations. That is, set "target(wr) := c(wr)". It is a checked runtime error if "wr" is closed.
PROCEDURE Close(wr: T) RAISES {Failure, Alerted};
Flush "wr", release any resources associated with "wr", and set "closed(wr) := TRUE". This leaves "closed(wr)" equal to "TRUE" even if it raises an exception, and is a no-op if "wr" is closed.
PROCEDURE Length(wr: T): CARDINAL RAISES {Failure, Alerted};
PROCEDURE Index(wr: T): CARDINAL;
PROCEDURE Seekable(wr: T): BOOLEAN;
PROCEDURE Closed(wr: T): BOOLEAN;
PROCEDURE Buffered(wr: T): BOOLEAN;
These procedures return "len(wr)", "cur(wr)", "seekable(wr)", "closed(wr)", and "buffered(wr)", respectively. "Length" and "Index" cause a checked runtime error if "wr" is closed; the other three procedures do not.

Lex Interface

The Lex interface provides procedures for reading strings, booleans, integers, and floating-point numbers from an input stream. Similar functionality on text strings is available from the "Scan" module (see section Scan Interface).

The following constant sets are provided to define what characters Lex considers 'blank' and 'nonblank':

CONST
   Blanks = SET OF CHAR{
     ' ', '\t', '\n', '\r', '\013'  vertical tab , '\f'};
   NonBlanks = SET OF CHAR{'!' .. '~'};

Each of the procedures in this interface reads a sequence of characters from the reader passed to the procedure, and leaves the reader positioned immediately after that sequence, perhaps at end-of-file. You may not use Rd.UnGetChar() after calling any of these routines.

PROCEDURE Scan(rd: Rd.T; READONLY cs: SET OF CHAR := NonBlanks): TEXT
RAISES {Rd.Failure, Alerted};
PROCEDURE Skip(rd: Rd.T; READONLY cs: SET OF CHAR := Blanks)
RAISES {Rd.Failure, Alerted};
Read characters until one is found that is not in the character set "cs" or EOF is reached. Scan returns characters read up but not including the terminating character; Skip discards them. A common task in processing data from a reader involves throwing away blanks. This can be accomplished with the call "Lex.Skip(rd, Blanks)" or just "Lex.Skip(rd)".
PROCEDURE Match(rd: Rd.T; t: TEXT) RAISES {Error, Rd.Failure, Alerted};
Read the longest sequence of characters from "rd" that matches the sequence of characters in "t". Raise "Error" if "t" is not completely matched.
PROCEDURE Bool(rd: Rd.T): BOOLEAN RAISES {Error, Rd.Failure, Alerted};
Read a boolean from "rd" and return its value. "Bool" skips blanks, then reads the longest sequence of "rd" that is a sequence of a "Boolean" in the following grammar: | Boolean = "F" "A" "L" "S" "E" | "T" "R" "U" "E". The case of letters in a "Boolean" is not significant. If the character sequence read from "rd" is an entire "Boolean", "Bool" returns that boolean; else it raises "Error".
PROCEDURE Int(rd: Rd.T; defaultBase: [2..16] := 10)
: INTEGER RAISES {Error, FloatMode.Trap, Rd.Failure, Alerted};
PROCEDURE Unsigned(rd: Rd.T; defaultBase: [2..16] := 16)
: Word.T RAISES {Error, FloatMode.Trap, Rd.Failure, Alerted};
Read a number from "rd" and return its value.
PROCEDURE Real(rd: Rd.T): REAL
RAISES {Error, FloatMode.Trap, Rd.Failure, Alerted};
PROCEDURE LongReal(rd: Rd.T): LONGREAL
RAISES {Error, FloatMode.Trap, Rd.Failure, Alerted};
PROCEDURE Extended(rd: Rd.T): EXTENDED
RAISES {Error, FloatMode.Trap, Rd.Failure, Alerted};
Read a real number from "rd" and return its value.

Misc Routines

This section describes some miscellaneous, useful interfaces.

Params Interface

The Params interface allows you to access command-line parameters. Params.Count is the number of parameters. Params.Get(0) returns the first parameter (the program name); Params.Get(Params.Count-1) returns the last parameter.

INTERFACE Params;

VAR (*CONST*) Count: CARDINAL;
(* Parameters are indexed from "0" (the command name) to "Count-1". *)

PROCEDURE Get(n: CARDINAL): TEXT;
(* Return the parameter with index "n".  It is a checked runtime error
   if "n >= Count". *)

END Params.

Env Interface

The Env interface allows you to access the values of environment variables.

INTERFACE Env;

PROCEDURE Get(nm: TEXT): TEXT;
(* Return the value of the environment variable whose name is equal to
   "nm", or "NIL" if there is no such variable. *)

VAR (*CONST*) Count: CARDINAL;
(* Environment variables are indexed from "0" to "Count-1". *)

PROCEDURE GetNth(n: CARDINAL; VAR (*OUT*) nm, val: TEXT);
(* Set "nm" and "val" to the name and value of the environment
   variable with index "n".  It is a checked runtime error if "n >=
   Count".  *)

END Env.

Word Interface

The Word interface defines the unsigned numeric type Word.T and arithmetic and bitwise operations on unsigned numbers. Note that because Word.T = INTEGER, these routines can take INTEGER arguments as well.

INTERFACE Word;

TYPE
  T = INTEGER;

CONST
  Size : INTEGER = BITSIZE (T);  (* implementation-dependent;
                                    probably at least 32      *)

PROCEDURE Plus (x, y: T): T;         (* (x + y) MOD 2^[Word.Size] *)
PROCEDURE Times (x, y: T): T;        (* (x * y) MOD 2^[Word.Size] *)
PROCEDURE Minus (x, y: T): T;        (* (x - y) MOD 2^[Word.Size] *)
PROCEDURE Divide (x, y: T): T;       (* x divided by y *)
PROCEDURE Mod (x, y: T): T;          (* x MOD y *)
PROCEDURE LT (x, y: T): BOOLEAN;     (* x < y *)
PROCEDURE LE (x, y: T): BOOLEAN;     (* x <= y *)
PROCEDURE GT (x, y: T): BOOLEAN;     (* x > y *)
PROCEDURE GE (x, y: T): BOOLEAN;     (* x >= y *)
PROCEDURE And (x, y: T): T;          (* Bitwise AND of x and y *)
PROCEDURE Or (x, y: T): T;           (* Bitwise OR of x and y *)
PROCEDURE Xor (x, y: T): T;          (* Bitwise XOR of x and y *)
PROCEDURE Not (x: T): T;             (* Bitwise complement of x *)

PROCEDURE Shift (x: T; n: INTEGER): T;
(* For all i such that both i and i - n are in the range [0 .. Word.Size - 1],
   bit i of the result equals bit i - n of x. The other bits of the result are
   0. Thus, shifting by n > 0 is like multiplying by 2^(n) *)

PROCEDURE LeftShift (x: T; n: [0..Size-1]): T;
(* = Shift (x, n) *)

PROCEDURE RightShift (x: T; n: [0..Size-1]): T;
(* = Shift (x, -n) *)

PROCEDURE Rotate (x: T; n: INTEGER): T;
(* Bit i of the result equals bit (i - n) MOD Word.Size of x. *)

PROCEDURE LeftRotate (x: T; n: [0..Size-1]): T;
(* = Rotate (x, n) *)

PROCEDURE RightRotate (x: T; n: [0..Size-1]): T;
(* = Rotate (x, -n) *)
 
PROCEDURE Extract (x: T; i, n: CARDINAL): T;
(* Take n bits from x, with bit i as the least significant bit, and return them
   as the least significant n bits of a word whose other bits are 0. A checked
   runtime error if n + i > Word.Size. *)

PROCEDURE Insert (x, y: T; i, n: CARDINAL): T;
(* Return x with n bits replaced, with bit i as the least significant bit, by
   the least significant n bits of y. The other bits of x are unchanged. A
   checked runtime error if n + i > Word.Size. *)

END Word.