Here is a code fragment from the VM.

MODULE Boxes;
Import Out;

TYPE Box* = POINTER TO RECORD;
VAR
next*: Box;
PROCEDURE Exec*(stack: BoxStack);
END Exec;
PROCEDURE Print*;
END Print;
END Box;

TYPE Int = POINTER TO RECORD(Box);
VAR
n: LONGINT;
PROCEDURE Exec*(stack: BoxStack);
BEGIN
stack.Push(n);
END Exec;
PROCEDURE Print*;
BEGIN
Out.String(' Int Box containing: '); Out.Int(n,10);
Out.Ln;
IF next # NIL THEN next.Print END
END Print;
END Int;

TYPE Op = POINTER TO RECORD(Box);
END Op;

TYPE Pop: POINTER TO RECORD(Op);
PROCEDURE Exec*(stack: BoxStack);
BEGIN
stack.Pop;
END Exec;
END pop;
TYPE Push: POINTER TO RECORD(Op);
PROCEDURE Exec*(stack: BoxStack);
BEGIN
stack.Push;
END Exec;
END Push;
*
TYPE Plus: POINTER TO RECORD(Op);
PROCEDURE Exec*(stack: BoxStack);
BEGIN
WITH stack[stack.top-1]: Int DO
WITH stack[stack.top].n: Int DO
stack[stack.top-1].n := stack[stack.top].n +
stack[stack.top-1].n;
stack.top := stack.top - 1
END
END
END Exec;
END Plus;

TYPE Mul: POINTER TO RECORD(Op);
PROCEDURE Exec*(stack: BoxStack);
BEGIN
WITH stack[stack.top-1]: Int DO
WITH stack[stack.top].n: Int DO
stack[stack.top-1].n := stack[stack.top].n *
stack[stack.top-1].n;
stack.top := stack.top - 1
END
END
END Exec;
END Mul;
....

....

END Boxes.

NOTICE the type guards (WITH..DO..END) in Plus.Exec and Mul.Exec. If
the two top boxes on the stack are not Int boxes (boxes containing
integers) then the type guards will throw run-time exceptions, since
there are no ELSE clauses. This is where polymorphic dispatch on
argument types would be implemented. "Plus" could be defined for two
Int boxes, 3 Quark boxes, two String boxes, architectural types
(gazebo cupola plus pagoda mod), etc. Types that aren't used in a
program shouldn't be tested for. (Efficiency).

sr

Example of (potentially) polymorphic dispatch on argument types found on the sta

srenner@mail.ru — 2000-05-06 19:41:26