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
Main
and main
are two different identifiers.
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.
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 %
.
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
.
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.).
libm3
package must be included in all Modula-3 programs with the import
command.
Modula-3 programs include declarations, statements, expressions, and pragmas.
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.
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.
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.
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 <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 declarationSize
qualified by module nameBox
*) END Toys. (* Another Client Module *) MODULE Toys2; FROM Box IMPORT Size; VAR boxSize := Size; (* Nonlocal referenceSize
not qualified *) END Toys2;
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.
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;
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 *)
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:
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.
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.
TYPE Digit = [0 .. 9]; (* subrange of INTEGER *) WeekDay = [Day.Monday .. Day.Friday]; (* subrange of Day *)
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 <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;
[ <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 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.
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 <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:
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 *)
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.
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 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.
<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' *)
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.
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 <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 <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;
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 <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 <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 <stmts> UNTIL <expr>
<expr> must be a boolean-valued expression.
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
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 *)
The following statements allow local declarations that are visible only within the scope of the 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 <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 *)
Modula-3 provides an exception mechanism for raising and handling error conditions that occur in programs.
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 <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 <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.
Modula-3 supports a rich variety of strongly type-checked expressions.
Number | CharLiteral | TextLiteral
Letter { Letter | Digit | "_" ... }
"'" (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:
" { PrintingChar | Escape | "'" ... } "
PrintingChar
and Escape
have the same meanings as given above.
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 ... }
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:
The following built-in arithmetic functions are also useful:
For converting between INTEGERs and REALs, use the following built-in functions:
Modula-3 supports the usual boolean operators. Short-circuit (conditional) evaluation is used. From highest to lowest precedence, they are:
Modula-3 also supports bitwise logical computation on unsigned numbers using the procedures in the Word interface (see section Word Interface).
In Modula-3, comparisons between two types are done with the following binary operators (see caution about comparing TEXTs below):
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.
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 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{'.', '!', ',', ';', '?'};
<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{' ', ' ', ' '} };
<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"};
Operators below are listed in order of precedence from highest to lowest:
A pragma is a compiler directive. It is an arbitrary sequence of characters bracketed by <* and *>.
<*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 <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 <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 (<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*>
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*>
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*>
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.
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.
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.
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:
m3build -d ~/m3/LibA
m3build -d ~/m3/LibB
Then, m3build the main program Foo, and you're done.
The following command line options are interpreted by m3build:
m3build -b SPARCwill build using the SPARC configuration instead of the default.
m3build -d ..
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.
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.
The Text interface provides procedures that work on strings. The `T' type in the procedure declarations below is really the built-in type `TEXT'.
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};
Fmt.Int(15) = "15" Fmt.Int(-25) = "-25"
style: Style := Style.Auto; prec: CARDINAL := R.MaxSignifDigits - 1; literal := FALSEFormat 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"
Fmt.Pad("Info",6) = " Info" Fmt.Pad("Database",5) = "Database" Fmt.Pad("15.55",8,'*') = "***15.55"
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};
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.
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.
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).
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).
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.
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.
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.
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)".
This section describes some miscellaneous, useful interfaces.
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.
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.
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.