Source Code Examples from the BETA book
ORIGIN '~beta/basiclib/v1.5/betaenv'
(*
* COPYRIGHT
* Copyright (C) Mjolner Informatics, 1992-95
* All rights reserved.
*
* This fragment group contains the BETA code examples from the BETA
* book (that is, except trivial examples).
*
* The fragments are named in such a way, that their names reflect
* their position in the book.
*
* Two naming schemes are used: one for code from figures, and one for
* code in the running text.
*
* The examples from figures are named:
*
* fig<nn>x<yy> (example: fig7x5)
*
* This means that the code is from figure nn.yy.
*
* The examples for the running text are named:
*
* p<nn><u|m|b> (example: p122m)
*
* This means that the code is from page nn. 'u', 'm' and 'b' means
* that the code in in the _u_pper, _m_iddle, or _b_uttom part of the
* page.
*)
(****************************************************************************)
(* Chapter 3: Objects and Patterns ******************************************)
(****************************************************************************)
--- fig3x1: descriptor ---
(# Account:
(# balance: @integer;
Deposit:
(# amount: @integer
enter amount
do balance+amount->balance
exit balance
#);
Withdraw:
(# amount: @integer
enter amount
do balance-amount->balance
exit balance
#);
#);
account1, account2, account3: @Account;
K1,K2,K3: @integer;
do (* L1 *)
100->&account1.Deposit;
200->&account2.Deposit;
300->&account3.Deposit;
(* L2 *)
150->&account1.Deposit->K1;
90->&account3.Withdraw->K3;
90->&account2.Deposit->K2;
80->&account3.Withdraw->K3;
(* L3 *)
#)
--- p37m: descriptor ---
(# A1: ^Account;
C1: ^Customer;
A2: ^Account;
C2: ^Customer;
A3: ^Account;
do &Customer[]->C1[]; &Customer[]->C2[];
&Account[]->A1[]; C1[]->A1.owner[];
&Account[]->A2[]; C1[]->A2.owner[];
&Account[]->A3[]; C2[]->A3.owner[];
#)
--- p39m: attributes ---
Point:
(# x,y: @integer; (* two reference attributes *)
Move: (* a pattern attribute *)
(# dx,dy: @integer
enter(dx,dy)
do x+dx->x;
y+dy->y
#)
#)
---p41m: attributes ---
Point:
(# x,y: @integer; (* two reference attributes *)
Move: (* a pattern attribute *)
(# dx,dy: @integer
enter(dx,dy)
do this(Point).x+dx->this(Point).x;
this(Point).y+dy->this(Point).y
#)
#)
--- p43u: attributes ---
Interest:
(# sum,interestRate,res: @integer
enter(sum,interestRate)
do (sum*interestRate) div 100->res
exit res
#)
--- p43m: attributes ---
TotalBalance:
(# sum: @integer
do account1.balance->sum;
sum+account2.balance->sum;
sum+account3.balance->sum;
exit sum
#)
--- fig3x8: attributes ---
Link: (* Link describes a linked list *)
(# succ: ^Link; (* tail of this Link *)
elm: @integer; (* content element of this Link *)
Insert: (* Insert an element after this Link *)
(# E: @integer; R: ^Link;
enter E
do &Link[]->R[]; (* R denotes a new instance of Link *)
E->R.elm; (* E=R.elm *)
succ[]->R.succ[]; (* tail of this Link = tail of R *)
R[]->succ[]; (* R=tail of this Link *)
#)
#)
--- p44m: descriptor ---
(# head: @Link
do 1->head.Insert;
2->head.Insert;
6->head.Insert;
24->head.Insert;
(* head = (0 24 6 2 1) *)
#)
(****************************************************************************)
(* Chapter 4: Repetitions ***************************************************)
(****************************************************************************)
--- fig4x1: attributes ---
Account:
(# (* ... *)
transactions: [50] @integer; Top: @integer;
Deposit:
(# amount: @integer
enter amount
do balance+amount->balance;
amount->&SaveTransaction
exit balance
#);
Withdraw:
(# amount: @integer
enter amount
do balance-amount->balance;
-amount->&SaveTransaction
exit balance
#);
SaveTransaction:
(# amount: @integer
enter amount
do (if (top+1->top) > transactions.range then
(* Send statement of transactions to the customer *)
1->top
if);
amount->transactions[top]
#)
#)
--- fig4x2: attributes ---
BankSystem: @
(# Account: (# (* ... *) #);
Customer: (# (* ... *) #);
AccountFile: [200] ^Account;
noOfAccounts: @integer;
CustomerFile: [100] ^Customer;
noOfCustomers: @integer;
NewAccount:
(# C: ^Customer; rA: ^Account
enter C[]
do noOfAccounts+1->noOfAccounts;
&Account[]->rA[]->AccountFile[noOfAccounts][];
C[]->AccountFile[noOfAccounts].owner[]
exit rA[]
#);
NewCustomer: (# (* ... *) #)
#)
(****************************************************************************)
(* Chapter 5: Imperatives ***************************************************)
(****************************************************************************)
--- fig5x1: descriptor ---
(#
Power: (* Compute X^n where n>0 *)
(# X,Y: @real; n: @integer;
enter(X,n)
do 1->Y;
(for inx: n repeat Y*X->Y for)
exit Y
#);
Reciproc: (* Compute (Q,1/Q) *)
(# Q,R: @real
enter Q
do (if Q = 0 then 0->R
else (1 div Q)->R
if)
exit(Q,R)
#);
A,B: @real
do (3.14,2)->&Power->&Reciproc->(A,B);
(* A=3.14*3.14, B=1/A *)
#)
--- fig5x2: attributes ---
Register:
(# Table: [100] @integer; Top: @integer;
Init: (# do 0->Top #);
Has: (* Test if Key in Table[1: Top] *)
(# Key: @integer; Result: @boolean;
enter Key
do False->Result;
Search:
(for inx: Top Repeat
(if (Table[inx]=Key)->Result
then leave Search
if) for)
exit Result
#);
Insert: (* Insert New in Table *)
(# New: @integer
enter New
do (if not (New->&Has) then (* New is not in Table *)
Top+1->Top;
(if Top<=Table.Range then (* Table.Range=100 *)
New->Table[Top]
else (* Overflow *)
if) if) #);
Remove: (* Remove Key from Table *)
(# Key: @integer
enter key
do Search:
(for inx: Top repeat
(if Table[inx] = Key then
(for i: Top-inx repeat
Table[inx+i]->Table[inx+i-1]
for);
Top-1->Top;
leave Search
if) for) #);
#)
--- p63m: descriptor ---
(# R: @Register
do &R.Init;
(for inx: 6 repeat
inx*inx->&R.Insert
for);
(for elm: 100 repeat
(if elm->&R.Has then
(* elm is in R *)
(* ... *)
if) for)
#)
--- p65m: descriptor ---
(# R1,R2: @Point;
R3,R4: ^Point
do &Point[]->R3[]; &Point[]->R4[];
(1,1)->(R1.x,R1.y); (2,2)->(R2.x,R2.y);
(3,3)->(R3.x,R3.y); (4,4)->(R4.x,R4.y);
L1:
R3[]->R4[]; R1[]->R3[];
L2:
(100,200)->&R1.Move;
#)
--- p70b: attributes ---
GetAccount:
(# C: ^Customer; rA: ^Account
enter C[]
do (for i: noOfCustomers repeat
(if C.name[]->CustomerFile[i].name.equal then
AccountFile[i][]->rA[]
if)
for);
(if rA[]=NONE then C[]->NewAccount->rA[] if)
exit rA[]
#)
--- p71m: descriptor ---
(# Joe: ^Customer; acc: ^Account; bal: @integer
do Joe[]->BankSystem.getAccount->acc[];
acc.balance->bal;
(Joe[]->BankSystem.getAccount).balance->bal
#)
--- p74b: descriptor ---
(# x,y,z: @integer;
A,B: @
(# i,j,k: @integer
enter(i,j,k)
do i+2->i; j+3->j; k+4->k
exit(k,j,i)
#)
do 111->x; 222->y; 333->z;
(x,y,z); (* 1 *)
(x,y,z)->A; (* 2: A.i=113, A.j=225, A.k=337 *)
A->(x,y,z); (* 3: A.k=x=341, A.j=y=228, A.i=z=115 *)
A->(x,y,z)->B; (* 4: A.k=345=x, B.i=347,
* A.j=231=y, B.j=234,
* A.i=117=z, B.k=121
*)
#)
--- fig5x6: descriptor ---
(# P: (# I,J: @integer;
enter(I,J)
do I+J->I
exit(J,I)
#);
E: @P; (* declaration of a static (part) item *)
X: ^P; (* declaration of reference to an item *)
N,M: @integer;
do (* generation of a dynamic P-item and
* subsequent assignment of the reference X
*)
&P[]->X[];
(* an evaluation using static, inserted and dynamic items *)
(3,4)->E->P->E->&P->X->P->(N,M)
#)
(****************************************************************************)
(* Chapter 6: Sub-patterns **************************************************)
(****************************************************************************)
--- p87m: attributes ---
Reservation:
(# Date: @DateType;
Customer: ^CustomerRecord
#);
FlightReservation: Reservation
(# ReservedFlight: ^Flight;
ReservedSeat: ^Seat;
#);
TrainReservation: Reservation
(# ReservedTrain: ^Train;
ReservedCarriage: ^Carriage;
ReservedSeat: ^Seat;
#)
--- p89u: descriptor ---
(# T1: @TrainReservation;
F1: @FlightReservation;
T2: ^TrainReservation;
F2: ^FlightReservation;
R1: @Reservation;
R2: ^Reservation
do T1[]->T2[]; &FlightReservation[]->F2[];
(* ... *)
&Reservation[]->R2[];
(* ... *)
#)
--- p91m: attributes ---
Record: (# key: @integer #);
Person: Record
(# name: @Text; sex: @SexType #);
Employee: Person
(# salary: @integer; position: @PositionType #);
Student: Person
(# status: @StatusType #);
Book: Record
(# author: @Person; title: @TitleType #);
--- p91b: descriptor ---
(# ReservationRegister:
(# (* The reservations are stored in Table[1: top] *)
Table: [100] ^Reservation; top: @integer;
Insert: (* Insert a reservation into the register *)
(# R: ^Reservation
enter R[]
do R[]->Table[top+1->top][]
#);
NoOfElm: (* Return no. of reservations in register *)
(# exit top #);
GetElm: (* Get reservation no. 'inx' *)
(# inx: @integer
enter inx
exit Table[inx][]
#);
#);
Reservations: @ReservationRegister;
(* ... *)
F: ^FlightReservation;
T: ^TrainReservation;
do (* ... *)
F[]->Reservations.Insert; (* ... *)
T[]->Reservations.Insert; (* ... *)
#)
--- p93b: descriptor ---
(# R: ^Reservation; Olsen: ^CustomerRecord;
OlsensReservations: @ReservationRegister
do (* ... *)
(for i: Reservations.NoOfElm repeat
i->Reservations.GetElm->R[];
(if R.Customer[] = Olsen[] then
R[]->OlsensReservations.Insert
if)
for)
#)
--- p94u: descriptor ---
(# R: ^Reservation; Olsen: ^Customer; NTR,NFR: @integer
do (* ... *)
(for i: Reservations.NoOfElm repeat
i->Reservations.GetElm->R[];
(if R##
//TrainReservation## then NTR+1->NTR
//FlightReservation## then NFR+1->NFR
if)
for)
#)
--- p96u: descriptor ---
(# F,G: @File
do (* Open the files F and G *)
L: Cycle (* Copy F to G *)
(#
do (if F.eos then (* end-of-stream *)
leave L
if);
F.get->G.put
#);
(* Close the files F and G *)
#)
--- p96m: attributes ---
CountCycle: Cycle
(# inx: @integer
enter inx
do INNER CountCycle;
inx + 1->inx ;
#);
--- p96b: descriptor ---
(#
do (* ... *);
L: 1->CountCycle
(# F: @integer
do (if inx = 10 then leave L if);
inx->& Factorial->F;
(* Factorial is computed for inx in [1,9] *)
#);
(* ... *)
#)
--- p97u: descriptor ---
(#
do L: 1 ->
(# inx: @integer; F: @integer
enter inx
do Loop:
(#
do (if inx = 10 then leave L if);
inx->& Factorial->F;
inx + 1->inx;
restart Loop
#)
#)
#)
--- p97b: attributes ---
ForAll:
(# Current: ^Record;
Index: (# exit Current[] #)
do (* ... *) (* As before *) (* ... *)
#)
--- p98: descriptor ---
(#
do R1.ForAll
(# I: @Index
do R2.ForAll
(# J: @Index
do (I,J)->DoMore
#)
#)
#)
--- fig6x6: attributes ---
Register:
(# Table: [100] ^Record;
Top: @integer;
Init: (# (* ... *) #);
Has: (# key: ^Record enter key[] do (* ... *) #);
Insert: (# (* ... *) #);
Remove: (# (* ... *) #);
ForAll:
(# Current: ^Record
do (for inx: Top repeat
Table[inx][]->Current[];
INNER ForAll
for)
#)
#)
--- p99b: descriptor ---
(# Point:
(# X,Y: @integer;
move:
(# x1,y1: @integer
enter(x1,y1)
do x1->X; y1->Y; INNER
#)
enter (X,Y)
exit (X,Y)
#);
P1,P2: @Point;
do (* ... *); P1->P2; (* ... *); (3,14)->P1.move; (* ... *)
#)
--- p100m: descriptor ---
(# ThreeDpoint: Point
(# Z: @integer;
move3D: move
(# z1: @integer enter z1 do z1->Z; INNER #)
enter Z
exit Z
#);
P1,P2: @ThreeDpoint;
do (* ... *); P1->P2; (* ... *); (111,222,333)->P1.move3D
#)
--- p102u: descriptor ---
(# X: @integer;
Y: @integerObject;
Z1,Z2: ^integerObject
do (* ... *)
111->X;
222->Y;
Y[]->Z1[];
333->Z1;
&integerObject[]->Z2[];
444->Z2;
#)
(****************************************************************************)
(* Chapter 7: Virtual Procedure Patterns *************************************)
(****************************************************************************)
--- p110m: attributes ---
TrainReservation: Reservation
(# (* ... *)
Display:
(#
do Date.Display; Customer.Display;
ReservedTrain.Display;
ReservedCarriage.Display;
ReservedSeat.Display
#)
#);
FlightReservation: Reservation
(# (* ... *)
Display:
(#
do Date.Display; Customer.Display;
ReservedFlight.Display; ReservedSeat.Display
#)
#);
--- p111m: attributes ---
Reservation:
(# (* ... *)
DisplayReservation:
(#
do Date.Display; Customer.Display; INNER
#)
#);
TrainReservation: Reservation
(# (* ... *)
DisplayTrainReservation: DisplayReservation
(#
do ReservedTrain.Display;
ReservedCarriage.Display;
ReservedSeat.Display;
INNER
#)
#);
FlightReservation: Reservation
(# (* ... *)
DisplayFlightReservation: DisplayReservation
(#
do ReservedFlight.Display; ReservedSeat.Display;
INNER
#)
#)
--- p114u: attributes ---
Reservation:
(# (* ... *)
DisplayReservation:
(#
do Date.Display; Customer.Display; INNER
#);
Display:< DisplayReservation
#);
TrainReservation: Reservation
(# (* ... *)
DisplayTrainReservation: DisplayReservation
(#
do ReservedTrain.Display;
ReservedCarriage.Display;
ReservedSeat.Display;
INNER
#);
Display::< DisplayTrainReservation
#);
FlightReservation: Reservation
(# (* ... *)
DisplayFlightReservation: DisplayReservation
(#
do ReservedFlight.Display; ReservedSeat.Display;
INNER
#);
Display::< DisplayFlightReservation
#)
--- p115b: descriptor ---
(#
do (for i: Reservations.NoOfElm repeat
i->Reservations.GetElm->R[];
(if R.Customer[] = Olsen[] then R.Display if)
for)
#)
--- p117m: attributes ---
Reservation:
(# (* ... *)
Display:<
(#
do Date.Display; Customer.Display; INNER
#)
#);
TrainReservation: Reservation
(# (* ... *)
Display::<
(#
do ReservedTrain.Display;
ReservedCarriage.Display;
ReservedSeat.Display;
INNER
#)
#);
FlightReservation: Reservation
(# (* ... *)
Display::<
(#
do ReservedFlight.Display; ReservedSeat.Display;
INNER
#)
#)
--- p118m: attributes ---
Record:
(# Key: @integer;
Display:< (# do (* Display Key *); INNER #)
#);
Person: Record
(# Name: @text; Sex: @SexType;
Display::< (# do (* Display Name,Sex *) ; INNER #)
#);
Employee: Person
(# Salary: @integer; Position: @PositionType;
Display::< (# do (* Display Salary,Position *); INNER #)
#);
Student: Person
(# Status: @StatusType;
Display::< (# do (* Display Status *); INNER #);
#);
Book: Record
(# Author: @Person; Title: @TitleType;
Display::< (# do (* Display Author,Title *); INNER #)
#)
--- p119m: attributes ---
Point:
(# X,Y: @integer;
Init:< (# do 0->X; 0->Y; INNER #);
#)
--- p119b: attributes ---
ThreeDPoint: Point
(# Z: @integer;
Init::< (# do 0->Z; INNER #);
#)
--- fig7x3: attributes ---
Job:
(# name: @text;
Value: (# V: @integer do INNER exit V #);
Tax: Value(# do (Salary-Deductible)*45 div 100->V #);
Salary:< Value;
Deductible:< Value(# do 10000->V; INNE #)
#);
PermanentJob: Job(# #);
NonPermanentJob: Job
(# noOfHours: @integer;
Salary::< (# do noOfHours*hourlyWage->V #);
Deductible::< (# do 3000+V->V; INNER #);
hourlyWage:< Value
#);
Job1: PermanentJob
(# Salary::< (# do 35000->V #);
Deductible::< (# do 2000+V->V #)
#);
Job2: PermanentJob
(# Salary::< (# do 45000->V #);
Deductible::< (# do 2500+V->V #)
#);
Job3: NonPermanentJob
(# hourlyWage::< (# do 80->V #); (* 80 pr. hour *)
#);
Job4: NonPermanentJob
(# hourlyWage::< (# do 85->V #); (* 85 pr. hour *)
#);
Staff: [100] ^Job;
ComputeSalarySum:
(# Sum: @integer
do 0->Sum;
(for i: Staff.range repeat Staff[i].salary+sum->sum for)
exit Sum
#)
--- p122m: attributes ---
Find:
(# Subject: ^Record;
NotFound:< Object;
index: @integer
enter Subject[] (* The Record to be searched *)
do 1->index;
Search:
(if index<=Top then
(if table[index][] = Subject[] then
INNER;
leave Search
if);
index+1->index;
restart Search
else NotFound
if)
#)
--- p123m: attributes ---
Has: Find
(# Result: @boolean;
NotFound::< (# do False->Result #)
do True->Result
exit Result
#)
--- fig7x5: descriptor ---
(# Expression:
(# value:< (# V: @integer do INNER exit V #);
#);
Const: Expression
(# C: @integer;
value::< (# do C->V #)
enter C
exit this(Const)[]
#);
BinOp: Expression
(# E1,E2: ^Expression
enter(E1[],E2[])
exit this(BinOp)[]
#);
Plus: BinOp(# Value::< (# do E1.value+E2.value->V #) #);
Mult: BinOp(# Value::< (# do E1.value*E2.value->V #) #);
E: ^Expression
do (* Assign (111+222)*2->E *)
((111->Const,222->Const)->Plus,2->Const)->Mult->E[];
E.value->putInt
#)
--- p124m: attributes ---
Job:
(# name: @text;
jobType: @integer;
(* ... *)
#)
--- fig7x6: attributes ---
ComputeSalary:
(# R: ^Job; sum: @integer
enter R[]
do (if R.jobType
//1 then (* Job1 *) sum + 35000->sum
//2 then (* Job2 *) sum + 45000->sum
//3 then (* job3 *)
(# S: ^Job3
do R[]->S[]; S.noOfHours*80 + sum->sum
#)
//4 then (* job4 *)
(# S: ^Job4
do R[]->S[]; S.noOfHours*85 + sum->sum
#)
if)
exit sum
#);
ComputeSalarySum:
(# Sum: @integer
do 0->Sum;
(for i: Staff.range repeat
(Staff[i][]->ComputeSalary)+sum->sum
for)
exit Sum
#);
--- p124b: descriptor ---
(#
do (if R##
//Job1## then (* ... *)
//Job2## then (* ... *)
//Job3## then (* ... *)
//Job4## then (* ... *)
if)
#)
--- p125b: attributes ---
Job5: PermanentStaff
(# Salary::< (# do 50000->V #);
Deductible::< (# do 1500->V #)
#)
(****************************************************************************)
(* Chapter 8: Block Structure ***********************************************)
(****************************************************************************)
--- p132u: attributes ---
HandleReservations:
(* Handle one or more reservations for a customer *)
(# GetReservation:
(* Get reservation request from customer *)
(# (* ... *) #);
MakeReservation:
(* Perform temporary reservation *)
(# (* ... *) #);
ReleaseReservation:
(* Release a temporary reservation *)
(# (* ... *) #);
CompleteReservation:
(* Book desired reservations *)
(# (* ... *) #)
do (* Investigate one or more possible reservations
* from customer using GetReservation and
* MakeReservation. Release reservations not used
* and finalize desired reservations using
* ReleaseReservation and CompleteReservation.
*)
#)
--- fig8x1: attributes ---
Grammar:
(# noOfRules: @integer;
(* ... *) (* Other attributes for representing a grammar *)
Parse:<
(# input: ^text; output: ^AbstractSyntaxTree
enter input[]
do (* Parse the input string according to the grammar *)
(* and produce an abstract syntax tree *)
exit output[]
#);
Symbol:
(# id: @integer; printName: @text; (* ... *)
isTerminal: (# (* ... *) exit aBoolean #);
#);
#)
--- fig8x4: attributes ---
FlightType:
(# source, destination: ^City;
departureTime,
arrivalTime: @TimeOfDay;
flyingTime: @TimePeriod;
Flight:
(# Seats: [NoOfSeats] @Seat;
actualDepartureTime,
actualArrivalTime: @TimeOfDay;
actualFlyingTime: @TimePeriod;
DepartureDelay:
(#
exit(actualDepartureTime - departureTime)
#)
#);
DisplayTimeTableEntry: (# (* ... *) #);
(* ... *)
#)
--- fig8x5: attributes ---
TimeTable90: @
(# (* ... *)
SK451: @FlightType;
SK273: @FlightType;
(* ... *)
Init:<
(# (* ... *)
do (* ... *)
'Copenhagen'->SK451.source;
'Los Angeles'->SK451.destination;
(* ... *)
#)
#);
ReservationTable90: @
(#
SK451Flights: [365] ^TimeTable90.SK451.Flight;
SK273Flights: [365] ^TimeTable90.SK273.Flight
(* ... *)
#)
(****************************************************************************)
(* Chapter 9: Virtual Class Patterns ****************************************)
(****************************************************************************)
--- fig9x1: attributes ---
Graph:
(# Node:< (# Connected: @boolean #);
Link:< (# Source, Dest: ^Node #);
Root: ^Node;
Connect:<
(# S,D: ^Node; L: ^Link
enter(S[],D[])
do &Link[]->L[];
S[]->L.source[]; D[]->L.Dest[];
true->S.Connected->D.Connected;
INNER
#);
#);
DisplayableGraph: Graph
(# Node::< (# DispSymb: ^DisplaySymbol #);
Link::< (# DispLine: ^DisplayLine #);
Connect::<
(# DL: ^DisplayLine
enter DL[]
do DL[]->L.DispLine[]; INNER
#);
Display:< (# (* ... *) #)
#);
TravellingSalesmanGraph: Graph
(# Node::< (# Name: ^Text #);
Link::< (# Distance: @integer #);
Connect::<
(# D: @integer
enter D
do D->L.Distance; INNER
#);
#);
DG: ^DisplayableGraph;
TG: ^TravellingSalesmanGraph;
--- fig9x2: attributes ---
Register:
(# Content:< Object;
Table: [100] ^Content; Top: @integer;
Init:< (# (* ... *) #);
Has: Find
(# Result: @boolean;
NotFound:: (# do false->Result #)
do true->Result
exit Result
#);
Insert:
(# New: ^Content
enter New[]
do (if not (New[]->Has) then (* ... *) if)
#);
Remove: (# (* ... *) #);
ForAll:
(# Current: ^Content
do (for inx: Top repeat
Table[inx][]->Current[];
INNER
for) #);
Find:
(# Subject: ^Content; index: @integer;
NotFound:< Object
enter Subject[]
do 1->index;
Search:
(if index<=Top then
(if Subject[] = Table[index][] then
INNER;
leave Search
if);
index+1->index;
restart Search
else &NotFound
if) #);
#)
--- fig9x3: attributes ---
RecordRegister: Register
(# Content::< Record;
Init::< (# (* ... *) #);
Display:<
(#
do ForAll(# do Current.Display #); INNER
#)
#)
--- fig9x4: attributes ---
StudentRegister: RecordRegister
(# Content:: Student;
UpdateStatus: Find
(# Status: @StatusType;
NotFound:: (# (* ... *) #)
enter Status
do Status->Table[index].Status
#)
#)
(****************************************************************************)
(* Chapter 10: Part Objects and Reference Attributes ************************)
(****************************************************************************)
--- fig10x1: attributes ---
StickMan:
(# theHead: @Head;
theBody: @Body;
LeftArm,RightArm: @Arm;
LeftLeg,RightLeg: @Leg;
move: (# (* ... *) #);
draw: (# (* ... *) #);
clear: (# (* ... *) #);
(* ... *)
#);
Head: (# (* ... *) #);
Body: (# (* ... *) #);
Arm: (# theHand: @Hand; (* ... *) #);
Leg: (# theFoot: @Foot; (* ... *) #);
Hand: (# wave: (# #); (* ... *) #);
Foot: (# bigToe: @Toe; (* ... *) #);
Toe: (# wriggle: (# #); (* ... *) #)
--- p150b: attributes ---
move:
(# pos: @point
enter pos
do pos->theHead.move; pos->theBody.move;
pos->LeftArm.move; pos->RightArm.move;
pos->LeftLeg.move; pos->RightArm.move;
#)
--- p151b: attributes ---
Address:
(# Street: @text;
StreetNo: @integer;
Town,Country: @text;
printLabel:<
(#
do INNER;
(* print Street, StreetNo, Town, Country *);
#)
#)
--- p152u: attributes ---
Person:
(# name: @text;
adr: @Address
(# printLabel::< (# do (* print name *) #) #);
#);
Company:
(# name,director: @text;
adr: @Address
(# printLabel::< (# do (* print name and director *) #) #);
#)
--- p153u: attributes ---
Person: Address
(# name: @text;
printLabel::< (# do (* print name *) #);
#);
Company: Address
(# name,director: @text;
printLabel::< (# do (* print name and directory *) #);
#)
(****************************************************************************)
(* Chapter 11: Pattern Variables ********************************************)
(****************************************************************************)
--- fig11x1: attributes ---
DrawingTool:
(# Symbol: (# (* ... *) #);
Box: Symbol(# (* ... *) #);
Ellipse: Symbol(# (* ... *) #);
Action: (# (* ... *) #);
DrawAction: Action
(# F: ^Symbol
do (* ... *) &CurrentSymbol[]->F[]; (* ... *)
#);
MoveAction: Action(# (* ... *) #);
CurrentSymbol: ##Symbol;
CurrentAction: ##Action;
SelectAction:
(# item: @text
enter item
do (if item
//'draw' then DrawAction##->CurrentAction##
//'move' then MoveAction##->CurrentAction##
if)
#);
SelectSymbol:
(# item: @text
enter item
do (if item
//'box' then Box##->CurrentSymbol##
//'ellipse' then Ellipse##->CurrentSymbol##
if) #);
DoAction:
(#
do CurrentAction
#)
#)
(****************************************************************************)
(* Chapter 12: Procedural Programming ***************************************)
(****************************************************************************)
--- fig12x1: descriptor ---
(# Complex:
(# I,R: @real;
Plus:
(# X,Y: @Complex
enter X
do X.I+I->Y.I; X.R+R->Y.R
exit Y
#);
Mult: (# (* ... *) #)
enter(I,J)
exit(I,J)
#);
C1,C2,C3: @Complex
do (* ... *)
C2->C1.Plus->C3
#)
--- fig12x2: descriptor ---
(#
ComplexRing:
(#
Complex:
(# I,R: @real
enter(I,R)
exit(I,R)
#);
Create:
(# R,I: @real; C: @Complex
enter(R,I)
do R->C.R; I->C.I
exit C
#);
Plus:
(# A,B,C: @Complex
enter(A,B)
do A.I+B.I->C.I; A.R+B.R->C.R
exit C
#);
Mult: (# (* ... *) #)
#);
CR: @ComplexRing; (* package object *)
X,Y,Z: @CR.Complex;
do (1.1,2.2)->CR.create->X;
(3.1,0.2)->CR.create->Y;
(X,Y)->CR.plus->Z
#)
--- fig12x3: descriptor ---
(# T: (# T1: (# (* ... *) #);
T2: (# (* ... *) #);
(* ... *)
Tn: (# (* ... *) #);
F1: (# X: @T2; y: @T3; z: @T1
enter(x,y)
do (* ... *)
exit z
#);
F2: (# (* ... *) #);
(* ... *)
Fm: (# (* ... *) #)
#);
aT: @T;
a: @aT.T1; b: @aT.T2; c: @aT.T3;
do (* ... *)
(b,c)->aT.F1->a
#)
--- fig12x4: attributes ---
VectorMatrixPackage:
(# Vector:
(# S: [100] @Integer;
Get: (# i: @integer enter i exit S[i] #);
Put: (# e,i: @integer enter(e,i) do e->S[i] #)
#);
Matrix:
(# R: [100] ^Vector;
Init:<
(# do (for i: R.range repeat &Vector[]->R[i][] for); INNER #);
Get: (# i,j: @integer enter(i,j) exit R[i].S[j] #);
Put: (# e,i,j: @integer enter(e,i,j) do e->R[i].S[j] #)
#);
VectorBinOp:
(# V1,V2: ^Vector
enter(V1[],V2[]) do &Vector[]->V3[]; INNER exit V3[]
#);
AddVector: VectorBinOp
(# do (for i: V1.S.range repeat V1.S[i]+V2.S[i]->V3.S[i] for) #);
(* ... *)
MatrixBinOp:
(# M1,M2,M3: ^Matrix
enter(M1[],M2[]) do &Matrix[]->M3[]; M3.init; INNER exit M3[]
#);
AddMatrix: MatrixBinOp
(# do (for i: M1.R.range repeat
(for j: M1.R[i].S.range repeat
M1.R[i].S[j] + M2.R[i].S[j]->M3.R[i].S[j]
for) for) #);
(* ... *)
MultMatrixByVector: (# (* ... *) #)
#);
--- fig12x5: attributes ---
MultMatrixByVector:
(# V: ^Vector; M1,M2: ^Matrix
enter(M1[],V[])
do &Matrix[]->M2[];
(for i: V.S.range repeat
(for j: M1.R[i].S.range repeat
V.S[i] * M1.R[i].S[j]->M2.R[i].S[j]
for) for)
exit M2[]
#)
--- p172u: descriptor ---
(# VMP: @VectorMatrixPackage;
V1,V2,V3: @VMP.Vector; M1,M2: @VMP.Matrix;
do (* ... *)
(for i: 100 repeat (i,i)->V1.put for); (* ... *)
(V1[],V2[])->VMP.AddVector->V3[]; (M1[],M2[])->VMP.AddMatrix->M3[];
(M1[],V1[])->VMP.MultMatrixByVector->M2[]
#)
--- p173u: attributes ---
IntFunc: (# X,Y: @integer enter X do INNER exit Y #);
PlotFunc:
(# F:< IntFunc;
first,last: @Integer;
Device: ^Image
enter(first,last,Device[])
do (first,last)->forTo
(# inx: @Index
do (inx,(inx->F))->Device.PutDot
#) #);
Square: IntFunc(# do X*X->Y #);
Double: IntFunc(# do X+X->Y #)
--- p173m: descriptor ---
(#
do (15,30,somePlotter[])->PlotFunc(# F:: Square #);
(20,40,somePlotter[])->PlotFunc(# F:: Double #);
(* ... *)
(1,6,somePlotter[])->PlotFunc(# F:: (# do X->Factorial->Y #) #)
#)
--- p173b: descriptor ---
(# PlotFunc:
(# F: ##IntFunc;
first,last: @Integer;
Device: ^Image
enter(F##,first,last,Device[])
do (first,last)->forTo
(# inx: @Index
do (inx,(inx->F))->Device.PutDot
#) #);
do (* ... *)
(Square##,15,30,somePlotter[])->PlotFunc;
(Double##,20,40,somePlotter[])->PlotFunc;
#)
--- p174m: descriptor ---
(# comp:
(# f,g: ##IntFunc; h: IntFunc(# do x->f->g->y #)
enter(f##,g##)
exit h##
#);
C: ##IntFunc;
do (* ... *)
(Double##,Square##)->comp->C##;
5->C->x (* x=100 *)
#)
--- fig12x6: descriptor ---
(# Ring:
(# ThisClass:< Ring;
Plus:< (# A: ^ThisClass enter A[] do INNER #);
Mult:< (# A: ^ThisClass enter A[] do INNER #);
Zero:< (# do INNER #);
Unity:< (# do INNER #)
#);
Complex: Ring
(# ThisClass::< Complex;
I,R: @real;
Plus::< (# do A.I->I.Plus; A.R->R.Plus #);
Mult::< (# (* ... *) #);
Zero::< (# do 0->I->R #);
Unity::< (# (* ... *) #)
#);
Vector: Ring
(# ThisClass::< Vector;
ElementType:< Ring;
R: [100] ^ElementType;
Plus::<
(#
do (for i: 100 repeat
A.R[i]->R[i].Plus
for) #);
Mult: (# (* ... *) #);
Zero: (# (* ... *) #);
Unity: (# (* ... *) #)
#);
ComplexVector: Vector
(# ThisClass::< ComplexVector;
ElementType::< Complex
#);
C1,C2: @Complex;
V1,V2: @ComplexVector
do (* ... *)
C1.Unity; C2.Zero; C1[]->C2.Plus;
V1.Unity; V2.Unity; V1[]->V2.Plus;
#)
--- fig12x7: descriptor ---
(# Ring:
(# Type:< Object;
Plus:<
(# X, Y, Z: ^Type
enter(X[],Y[])
do &Type[]->Z[];
INNER
exit Z[]
#);
Mult: (# (* ... *) #);
Zero: (# (* ... *) #);
Unity: (# (* ... *) #)
#);
ComplexRing: Ring
(# Type::< (# I,R: @real #);
Plus::< (# do X.I + Y.I->Z.I; X.R + Y.R->Z.R #);
Mult: (# (* ... *) #);
Zero: (# (* ... *) #);
Unity: (# (* ... *) #)
#);
CR: @ComplexRing;
C1,C2,C3: ^CR.Type
do (* ... *)
CR.Unity->C1[]; CR.Zero->C2[];
(C1[],C2[])->CR.Plus->C3[]
#)
--- fig12x8: descriptor ---
(# VectorRing: Ring
(# RingElement:< Ring;
actualRingElement: ^RingElement;
Type::< (# V: [100] ^actualRingElement.Type #);
Init:<
(# aRing: ^RingElement
enter aRing[]
do aRing[]->actualRingElement[]
#);
Plus::<
(#
do (for i: 100 repeat
(X.V[i][],Y.V[i][])
->actualRingElement.Plus
->Z.V[i]
for)
#);
Mult: (# (* ... *) #);
Zero: (# (* ... *) #);
Unity: (# (* ... *) #)
#);
ComplexVectorRing: VectorRing
(# RingElement::< ComplexRing #);
CVR: @ComplexVectorRing;
A,B,C: @CVR.Type
do (* ... *)
CR[]->CVR.Init
#)
--- fig12x9: attributes ---
ComplexRing: Ring
(# Type::<
(# I,R: @real;
Incr: (# do I+1->I; R+1->R #)
#);
(* ... *)
#);
--- fig12x10: attributes ---
VectorOfVector: Vector
(# ElementType:: Vector(# ElementType:: Elm #);
Elm:< Ring;
ThisClass::< VectorOfVector
#);
VectorOfVectorOfComplex: VectorOfVector
(# ThisClass::< VectorOfVectorOfComplex;
Elm::< Complex
#)
(****************************************************************************)
(* Chapter 13: Deterministic Alternation ************************************)
(****************************************************************************)
--- fig13x4: descriptor ---
(# TrafficLight:
(# state: @Color
do Cycle(#
do red->state;
SUSPEND;
green->state;
SUSPEND
#) #);
North,South: @| TrafficLight;
(* Declaration of two component instances of TrafficLight *)
Controller: @| (* Declaration of a singular component *)
(#
do North; (* attachment of North *)
(* North.state=red *)
South; South; (* two attachments of South *)
(* South.state=green *)
Cycle(#
do (* wait some time *)
South; North; (* switch the states *)
#) #)
do Controller (* attachment of Controller *)
#)
--- fig13x5: descriptor ---
(# Factorial: @| (* a singular component *)
(# T: [100] @Integer; N,Top: @Integer;
enter N
do 1->Top->T[1];
Cycle(#
do (if Top<N then
(* Compute and save (Top+1)!...N! *)
(Top+1,N)->ForTo
(# do (* T[inx-1]=(inx-1)! *)
T[inx-1]*i->T[inx]
(* T[inx]=inx! *)
#);
N->Top
if);
N+1->N;
(* suspend and exit T[N-1]: *)
SUSPEND;
(* When execution is resumed after SUSPEND, *)
(* a new value may have been assigned *)
(* to N through enter *)
#)
exit T[N-1]
#);
F: @Integer
do 4->Factorial->F; (* F=4! *)
(* This execution of Factorial will result in
computation of 1!, 2!, 3! and 4! *)
Factorial->F; (* F=5! *)
(* Here 5! was computed *)
3->Factorial->F; (* F=3! *)
(* No new factorials were computed by this call *)
#)
--- fig13x6: descriptor ---
(# Factorial: @|
(# Next:
(# n: @integer
enter n
do n*F->F;
SUSPEND;
n+1->&Next
#);
F: @Integer
do 1->F-> &Next
exit F
#);
v: @Integer
do Factorial->v; (* v=1 *)
Factorial->v; (* v=2 *)
Factorial->v; (* v=6 *)
L:
Factorial->v; (* v=24 *)
#)
--- fig13x8: descriptor ---
(# BinTree:
(# Node: (* The nodes of the binary tree *)
(# elem: @Integer;
left,right: ^Node
#);
root: ^Node;
Traverse: @|
(# next: @Integer;
Scan:
(# current: ^Node
enter current[]
do (if Current[]<>NONE then
current.left[]->&Scan;
current.elem->next;
SUSPEND;
current.right[]->&Scan
if) #);
do root[]->&Scan;
MaxInt->next; Cycle(# do SUSPEND #);
(* Exit maxInt hereafter *)
exit next
#); (* Traverse *)
#); (* BinTree *)
b1,b2: @Bintree; e1,e2: @Integer
do (* ... *)
b1.Traverse->e1; b2.Traverse->e2;
Merge:
Cycle(# (* ... *)
do (if (e1=MaxInt) and (e2=MaxInt) then leave Merge if);
(if e1<e2 then e1->print; b1.Traverse->e1
else e2->print; b2.Traverse->e2
if) #)
(* ... *)
#)
--- fig13x10: attributes ---
SymmetricCoroutineSystem:
(# SymmetricCoroutine:
(# Resume:<
(#
do this(SymmetricCoroutine)[]->next[];
SUSPEND (* suspend caller *)
#)
do INNER
#);
Run: (* start of initial SymmetricCoroutine *)
(#
enter next[] (* global reference declared below *)
do ScheduleLoop:
Cycle
(# active: ^| SymmetricCoroutine
(* currently operating component *)
do (if (next[]->active[]) = NONE
then leave ScheduleLoop
if);
NONE->next[];
active; (* attach next SymmetricCoroutine *)
(* Active terminates when it executes either *)
(* resume, or suspend or it terminates *)
#) #);
next: ^| SymmetricCoroutine;
(* Next SymmetricCoroutine to be resumed *)
do INNER
#)
--- fig13x11: descriptor ---
(# Converter: @| SymmetricCoroutineSystem
(# DoubleAtoB: @| SymmetricCoroutine
(# ch: @Char
do Cycle(#
do Keyboard.GetNonBlank->ch;
(if ch = 'a' then
Keyboard.GetNonBlank->ch;
(if ch = 'a' then 'b'->DoubleBtoC.Resume
else
'a'->DoubleBtoC.Resume;
ch->DoubleBtoC.Resume
if)
else ch->DoubleBtoC.Resume
if) #) #);
DoubleBtoC: @| SymmetricCoroutine
(# ch: @Char;
Resume::< (# enter ch #);
do Cycle(#
do (if ch
//'b' then
DoubleAtoB.Resume;
(if ch = 'b' then 'c'->Screen.put
else
'b'->Screen.put;
ch->Screen.put
if)
//nl then SUSPEND
else ch->Screen.put
if);
DoubleAtoB.Resume
#) #)
do DoubleAtoB[]->Run
#)
#)
--- fig13x12: attributes ---
QuasiParallelSystem:
(# ProcessQueue:
(# Insert: (* Insert a process; insert of NONE has no effect *)
(# (* ... *) #);
Next:
(* Exit and remove some process;
* If the queue is empty, then NONE is returned *)
(# (* ... *) #);
Remove: (* Remove a specific process *)
(# (* ... *) #);
#);
Active: @ProcessQueue; (* The active processes *)
Process: (* General quasi-parallel processes *)
(# Wait: (* Make this(Process) wait for a send to S *)
(# S: ^ProcessQueue
enter S[]
do this(Process)[]->S.Insert;
this(Process)[]->Active.Remove;
SUSPEND
#);
Send: (* Activate a process from S *)
(# S: ^ProcessQueue
enter S[]
do S.Next->Active.Insert;
SUSPEND
#)
do INNER;
this(Process)[]->Active.Remove
#); (* Process *)
Run: (* The scheduler *)
(# Ap: ^| Process (* Currently active Process *)
do ScheduleLoop:
Cycle(#
do (if (Active.Next->Ap[]) = NONE then leave ScheduleLoop
if);
Ap[]->Active.Insert; (* Ap is still active *)
Ap; (* Attach Ap *)
#) #)
do INNER
#)
--- fig13x13: descriptor ---
(# ProducerConsumer: @| QuasiParallelSystem
(# B: @Buffer;
notFull,notEmpty: @ProcessQueue; (* Signals *)
Producer: Process
(# Deposit:
(# E: @BufferElement
enter E
do (if B.Full then notFull[]->Wait if);
E->B.put;
notEmpty[]->Send
#)
do INNER
#);
Consumer: Process
(# Fetch:
(# E: @BufferElement
do (if B.Empty then notEmpty[]->Wait if);
B.Get->E;
notFull[]->Send
exit E
#);
do INNER
#);
P1: @| Producer(# do (* ... *) E1->Deposit; (* ... *) #);
C1: @| Consumer(# do (* ... *) Fetch->E1; (* ... *) #);
do P1[]->Active.Insert; C1[]->Active.Insert;
&Run
#)
#)
(****************************************************************************)
(* Chapter 14: Concurrency **************************************************)
(****************************************************************************)
--- p206m: descriptor ---
(# Account: (# (* ... *) #);
JoesAccount: @Account;
bankAgent: @|
(#
do cycle(# do (* ... *); 500->JoesAccount.deposit; (* ... *) #)
#);
Joe: @|
(# myPocket: @integer
do cycle
(# do (* ... *);
100->JoesAccount.Withdraw->myPocket; (* ... *)
#)
#)
do (* ... *)
bankAgent.fork;(* start concurrent execution of bankAgent *)
Joe.fork; (* start concurrent execution of Joe *)
#)
--- p209b: attributes ---
Account:
(# mutex: @Semaphore; (* semaphore controlling access *)
balance: @integer;
Deposit:
(# amount,bal: @integer
enter amount
do mutex.P;
balance+amount->balance->bal;
mutex.V
exit bal
#);
Withdraw:
(# amount,bal: @integer
enter amount
do mutex.P;
balance-amount->balance->bal;
mutex.V
exit bal
#);
Init:< (# do INNER; mutex.V; (* Initially open *) #)
#)
--- p211u: attributes ---
Account: Monitor
(# balance: @integer;
Deposit: Entry
(# amount,bal: @integer
enter amount
do balance+amount->balance->bal
exit bal
#);
Withdraw: Entry
(# amount,bal: @integer
enter amount
do balance-amount->balance->bal
exit bal
#);
#)
--- p211b: attributes ---
buffer: Monitor
(# R: [100] @char; in,out: @integer;
Put: Entry
(# ch: @char
enter ch
do (* wait if buffer is full *);
ch->R[in]; (in mod R.range)+1->in;
#);
Get: Entry
(# ch: @char
do (* wait if buffer is empty *)
R[(out mod R.range)+1->out]->ch;
exit ch
#);
#)
--- p212b: descriptor ---
(# buffer: @Monitor
(# R: [100] @char; in,out: @integer;
full: (# exit in=out #);
empty: (# exit (in = (out mod R.range)+1) #);
Put: Entry
(# ch: @char
enter ch
do wait(# do (not full)->cond #);
ch->R[in]; (in mod R.range)+1->in;
#);
get: Entry
(# ch: @char
do wait(# do (not empty)->cond #);
R[(out mod R.range)+1->out]->ch;
exit ch
#);
init::< (# do 1->in; R.range->out #)
#);
prod: @| (# do cycle(# do (* ... *); ch->buffer.put; (* ... *) #) #);
cons: @| (# do cycle(# do (* ... *); buffer.get->ch; (* ... *) #) #)
do buffer.init;
prod.fork; cons.fork
#)
--- p215b: descriptor ---
(# SingleBuf: @| System
(# PutPort,GetPort: @Port;
bufCh: @char;
Put: PutPort.entry
(# ch: @char enter ch do ch->bufCh #);
Get: GetPort.entry
(# ch: @char do bufCh->ch exit ch #);
do cycle(# do PutPort.accept; GetPort.accept #)
#);
Prod: @| System
(#
do cycle(# do (* ... *); c->SingleBuf.put; (* ... *) #)
#);
Cons: @| System
(#
do cycle(# do (* ... *); SingleBuf.get->c; (* ... *) #)
#)
do Prod.fork; SingleBuf.fork; Cons.fork;
#)
--- fig14x1: descriptor ---
(# Slave: System
(# receive: @Port;
Clear: receive.entry(# do 0->sum #);
Add: receive.entry
(# V: @integer enter V do sum+V->sum #);
Result: receive.entry(# S: @integer do sum->S exit S #);
sum: @integer;
do 0->Sum;
Cycle(# do receive.accept #);
#);
Slave1: @| Slave;
Slave2: @| Slave;
Master: @| System
(# Pos,Neg: @integer; V: [100] @integer;
do (* Read values to V *)
Slave1.Clear; Slave2.Clear;
(for inx: V.Range repeat
(if True
//V[inx] > 0 then V[inx]->Slave1.Add
//V[inx] < 0 then V[inx]->Slave2.Add
if) for);
Slave1.Result->Pos;
Slave2.Result->Neg;
#)
do Master.fork; Slave1.fork; Slave2.fork
#)
--- fig14x2: descriptor ---
(# ReservationHandler: System
(# start: @Port;
Lock: start.entry
(# S: ^| System
enter S
do S[]->sender[]; false->closed; INNER
#);
sender: ^| System;
request: @ObjectPort;
Reserve:< request.Entry;
Close:< request.Entry(# do true->closed; INNER #);
closed: @boolean
do cycle
(#
do start.accept;
loop: cycle
(#
do sender[]->request.accept;
(if closed then leave loop if)
#) #)
#);
HotelResHandler: @| ReservationHandler
(# Reserve::<
(# guestName: @text; noOfPersons,roomNo: @integer
enter(GuestName,noOfPersons)
do (* ... *)
exit roomNo
#);
(* Representation of register of hotel reservations *)
#);
P: @| System
(# rno1,rno2: @integer
do P[]->HotelResHandler.Lock;
('Peter Olsen',4)->HotelResHandler.Reserve->rno1;
('Anne Nielsen',1)->HotelResHandler.Reserve->rno2;
HotelResHandler.Close
#)
#)
--- fig14x3: descriptor ---
(# Producer: (# (* ... *) #);
Consumer: (# (* ... *) #);
SingleBuf: @| System
(# PutPort,GetPort: @QualifiedPort;
bufCh: @char;
Put: PutPort.entry(# ch: @char enter ch do ch->bufCh #);
Get: GetPort.entry(# ch: @char do bufCh->ch exit ch #);
do cycle
(# do Producer##->PutPort.accept;
Consumer##->GetPort.accept
#)
#);
Prod: @| Producer
(#
do cycle(# do (* ... *); c->SingleBuf.put; (* ... *) #)
#);
Cons: @| Consumer
(#
do cycle(# do (* ... *); SingleBuf.get->c; (* ... *) #)
#)
do Prod.fork; SingleBuf.fork; Cons.fork
#)
--- fig14x4: descriptor ---
(# Histogram: @| system
(# histogramData: @monitor
(* representation of the histogram *)
(# R: [100] @integer;
Add: entry (# i: @integer enter i do R[i]+1->R[i] #);
Sub: entry
(# i: @integer enter i do (R[i]-1,0)->Min->R[i] #);
Get: entry(# i,V: @integer enter i do R[i]->V exit V #)
#);
Display: @| system
(# i: @integer
do cycle(#
do (i+1) mod 100->i;
(i,i->histogramData.Get)->Screen.show
#) #);
Update: @| system(# do cycle(# do request.accept #) #);
request: @Port;
newValue: request.entry
(# V: @integer
enter V
do (if V>0 then V->histogramData.Add
else -V->histogramData.Sub
if)
#)
do conc(# do Display.start; Update.start #)
#);
S: @| system
(# do cycle(# do (* ... *); someValue->Histogram.newValue #) #)
do conc(# do Histogram.start; S.start #)
#)
--- fig14x5: descriptor ---
(# Prod: @| System(# do cycle(# do getLine->Pipe.Put #) #);
Pipe: @| System
(# In: @Port;
Put: In.Entry(# L: @text enter L do L->inLine #);
inLine: @text;
DisAsm: @| System
(#
do cycle(#
do In.accept;
inLine.scan(# do ch->Squash.put #);
' '->Squash.put
#) #);
Squash: @| System
(# P: @Port; ch: @char;
Put: P.Entry(# c: @char enter c do c->ch #);
do cycle(#
do P.accept;
(if ch = '*' then
P.accept;
(if ch = '*' then '^'->Asm.put
else '*'->asm.put; ch->asm.put if)
else ch->Asm.put
if) #) #);
Asm: @| System
(# P: @Port; ch: @char;
Put: P.entry(# c: @char enter c do c->ch #);
do cycle(#
do OutLine.clear;
(for i: 80 repeat P.accept; ch->OutLine.put for);
Out.accept
#) #);
Out: @port;
Get: Out.Entry(# L: @text do OutLine->L exit L #);
OutLine: @text
do conc(# do DisAsm.start; Squash.start; Asm.start #)
#);
Cons: @| System(# do cycle(# do Pipe.Get->putLine #) #)
do conc(# do Prod.start; Pipe.start; Cons.start #)
#)
--- p224m: attributes ---
Document: monitor
(# doc: @text;
Insert: entry
(# i,j: @integer; T: @text
enter(i,j,T)
do (* insert T between pos. i and j in doc *)
#);
Delete: entry
(# i,j: @integer
enter(i,j)
do (* delete characters from pos. i to j in doc *)
#);
GetSub: readerEntry
(# i,j: @integer; T: @text
enter(i,j)
do (* get from doc substring i-j to T *)
exit T
#);
Print: readerEntry
(# P: ^printer
enter P[]
do (* send document to printer P *)
#)
#)
(****************************************************************************)
(* Chapter 15: Nondeterministic Alternation *********************************)
(****************************************************************************)
--- p231u: descriptor ---
(# A: @| system
(# PB: @port; putB: PB.entry(# (* ... *) #);
X1: @| system
(#
do cycle(# do PB.accept; I1; C.putC; I2 #)
#);
PD: @port; putD: PD.entry(# (* ... *) #);
X2: @| system
(#
do cycle(# do PD.accept; J1; E.putE; J2 #)
#)
do alt(# do X1.start; X2.start #)
#);
B: @| system(# do (* ... *); A.putB; (* ... *) #);
C: @| system
(# PC: @port; putC: PC.entry(# (* ... *) #)
do (* ... *); PC.accept; (* ... *)
#);
D: @| system(# do (* ... *); A.putD; (* ... *) #);
E: @| system
(# PE: @port; putD: PE.entry(# (* ... *) #)
do (* ... *); PE.accept; (* ... *)
#);
do conc(# do A.start; B.start; C.start; D.start; E.start #)
#)
--- fig15x2: attributes ---
Calendar: system
(# days: [365] @integer; (* representation of the calendar dates *)
ownerHandler: @| system
(# day: @integer; (* date for initiated meeting *)
group: ^Calendars; (* involved Calendars *)
start: @port;
reserve: @start.entry
(# D: @day; G: ^Calendars
enter(D,G[]) do D->day; G[]->Group[]
#);
Ok: @boolean;
checkGroup:
(#
do (if days[day] = free then
tmpBooked->days[day]; true->Ok;
group.scan
(#
do (day->theCalendar.othersHandler.reserve)
and Ok->Ok
#);
group.scan
(#
do Ok->theCalendar.othersHandler.confirm
#);
(if Ok then booked->days[day]
else free->days[day]
if) if) #);
end: @port;
confirm: end.entry
(# ok: @boolean do Ok->ok exit ok #);
do cycle(# do start.accept; checkGroup; end.accept #)
#);
othersHandler: @| system (# (* ... *) #)
do alt(# do ownerHandler.start; othersHandler.start #)
#)
--- p234u: descriptor ---
(# othersHandler: @| system
(# start: @port;
day: @integer;
reserve: @start.entry
(# d: @integer;
enter d
do (if (days[d->day]=free)->ok
then tmpBooked->days[d]
if)
exit ok
#);
end: @port;
confirm: end.port
(# ok: @boolean
enter ok
do (if ok then booked->days[day]
else free->days[day]
if) #);
do cycle(# do start.accept; end.accept #)
#)
#)
--- fig15x4: descriptor ---
(# Buffer: System
(# S: [S.range] @char; in,out: @integer;
InPort,OutPort: @Port;
Put: InPort.entry
(# ch: @char
enter ch
do ch->S[in]; (in mod S.range)+1->in
#);
Get: OutPort.entry
(# ch: @char
do S[(out mod S.range)+1->out]->ch
exit ch
#);
PutHandler: @| System
(#
do Cycle(#
do (if in = out then Pause (* Buffer is full *)
else InPort.accept; (* accept Put *)
if) #) #);
GetHandler: @| System
(#
do Cycle(#
do (if in = (out mod S.range +1)
then (* Buffer is empty *)
else OutPort.accept; (* accept Put *)
if) #) #)
do 1->in; S.range->out;
alt(# do PutHandler.start; Gethandler.start #)
#);
Prod: @| System(# do (* ... *) ch->Buf.Put; (* ... *) #);
Buf: @| Buffer;
Cons: @| System(# do (* ... *) Buf.Get->ch; (* ... *) #)
do conc(# do Prod.start; Buf.start; Cons.start #)
#)
--- fig15x5: attributes ---
ExtendedBuffer: Buffer
(# GetRear: OutPort.entry
(# ch: @char
do S[(in+S.range-1) mod S.range->in]->ch
exit ch
#);
#)
--- fig15x6: descriptor ---
system
(# game: @| system
(# odd: (# exit 1 #); even: (# exit 0 #);
state,score,inc: @integer;
playerHandler: @| system(# (* ... *) #);
demonHandler: @| system(# (* ... *) #);
do alt(# do playerHandler.start; demonHandler.start #)
#);
demon: @| system
(#
do cycle
(# score: @integer
do game.demonHandler.bump; random->pause;
(if (random mod 2) = 1 then
game.demonHandler.changeInc->score;
(if score<100 then
1->game.demonHandler.setInc
else 10->game.demonHandler.setInc
if) if) #) #);
player: @| system
(#
do game.playerHandler.startGame; (* ... *)
game.playerHandler.probe;(* ... *)
game.PlayerHandler.endGame
#)
do conc(# do game.start; demon.start; player.start #)
#)
--- fig15x7: descriptor ---
(# playerHandler: @| system
(# start: @port; (* initial state: accepting StartGame *)
startGame: start.entry
(#
do 0->score; false->stopped; even->state; 1->inc
#);
playing: @port; (* playing state: accepting Result, EndGame *)
probe: playing.entry
(#
do (if state
//even then score-inc->score
//odd then score+inc->score
if)
#);
endGame: playing.entry(# do true->stop #);
final: @port; (* final state: accepting score *)
score: playing.entry(# do (* display final value of score *) #);
stop: @boolean
do start.accept;
play:
(#
do playing.accept; (if not stop then restart play if)
#);
final.accept
#);
demonHandler: @| system
(# P1: @port;
bump: P1.entry(# do (state+1) mod 2->state #);
changeInc: P1.entry
(# v: @integer do score->v; true->newInc exit v #);
P2: @port;
setInc: P2.entry(# v: @integer enter v do v->inc #);
newInc: @boolean
do cycle
(# do P1.accept;
(if newInc then P2.accept; false->newInc if)
#)
#);
#)
(****************************************************************************)
(* Chapter 16: Exception Handling *******************************************)
(****************************************************************************)
--- fig16x1: attributes ---
Register:
(# Table: [100] @integer; Top: @integer;
Init: (# do 0->Top #);
Has: (* Test if Key in Table[1: Top] *)
(# Key: @integer; Result: @boolean;
enter Key
do (* ... *)
exit Result
#);
Insert: (* Insert New in Table *)
(# New: @integer
enter New
do (if not (New->&Has) then (* New is not in Table *)
Top+1->Top;
(if Top<=Table.Range
then New->Table[Top]
else
Overflow (* An Overflow exception is raised *)
if) if) #);
Remove: (* Remove Key from Table *)
(# Key: @integer
enter key
do Search:
(#
do (for inx: Top repeat
(if Table[inx] = Key then
(* remove key *)
leave Search
if) for);
key->NotFound; (* A NotFound exception is raised *)
#) #);
Overflow:< Exception
(# do 'Register overflow'->msg.Append; INNER #);
NotFound:< Exception
(# key: @integer
enter key
do key->msg.putInt;
' is not in register'->msg.Append;
INNER
#);
#)
--- p244b: descriptor ---
(# Registrations: @Register
(# Overflow::<
(#
do 'Too many registration numbers.'->msg.append;
'Program terminates.'->msg.append
#);
NotFound::<
(#
do 'Attempt to delete: '->PutText;
key->screen.putInt;
'which is not in the register'->PutText;
Continue
#)
#)
#)
--- p247b: attributes ---
Register:
(# Overflow:< Exception
(#
do Continue;
INNER;
(Table.range div 4)->Table.extend
#);
Insert:
(# New: @integer
enter New
do (if not (New->&Has) then
(* New is not in Table *)
Top+1->Top;
(if Top>Table.Range
then Overflow
if);
New->Table[Top]
if) #);
(* ... *)
#)
--- p249m: attributes ---
Register:
(# (* ... *)
Insert: (* Insert New in Table *)
(# Overflow:< (* Procedure level exception *)
Exception(# (* ... *) #);
New: @integer
enter New
do (if not (New->&Has) then (* New is not in Table *)
Top+1->Top;
(if Top>Table.Range
then Overflow if);
New->Table[Top]
if) #);
Overflow:<
Exception(# (* ... *) #); (* Class level exception *)
#)
--- p250b: attributes ---
File:
(# name: @text; (* The logical name of the file *)
Open:
(* General super-pattern for OpenRead and OpenWrite *)
(# OpenError: FileException
(#
do 'Error during open.'->msg.append; INNER
#);
NoSuchFile:< OpenError
(#
do 'No such file.'->msg.append; INNER
#)
enter name
do INNER
#);
OpenRead: Open
(# NoReadAcess:< OpenError
(#
do 'No permission to read.'->msg.append;
INNER
#)
do (* open the file for read *)
(* May raise NoSuchFile or NoReadAccess *)
#);
OpenWrite: Open
(# NoReadAccess:< OpenError
(#
do 'No permission to write.'->msg.append;
INNER
#)
do (* Open this(File) for write *)
(* May raise NoSuchFile or NoReadAccess *)
#);
Get:
(# ch: @char
do (* Get next char to ch *)
(* May raise EOFerror *)
exit ch
#);
Put:
(# ch: @char
enter ch
do (* Write ch to file *)
(* May raise DiskFull *)
#);
Close: (# do (* close the file *) #);
Remove: (# do (* Remove the file from the disk *) #);
FileException: Exception
(# do 'Error in file: '->PutText; name[]->PutText;
INNER
#);
DiskFull:< FileException
(# do 'No more space on disk'->msg.append;
INNER
#);
EOFerror:< FileException
(# do 'Attempt to read past end-of-file'
->msg.append;
INNER
#)
#)
--- p252b: descriptor ---
(# F: @File
(# DiskFull::<
(#
do 'Please remove some files from the disk'
->PutText;
close; Remove; (* Close and remove the file *)
#)
#)
do GetFileName:
(#
do (* Prompt user for file name *)
N->F.openWrite
(# NoSuchFile::<
(#
do 'File does not exist. Try again'
->PutText;
Restart GetFileName
#);
NoWritePermission::<
(#
do 'You do not have write permission'
->PutText;
'Try again'->PutText;
restart getFileName
#)
#) #);
(* ... *)
ch->F.put;
(* ... *)
F.close
#)
--- p255m: attributes ---
Program:
(# Exception:
(# msg: @text;
cont: @boolean;
Continue: (# do true->cont #);
Terminate: (# do false->cont #)
do 'Program execution terminated due to exception'
->msg;
INNER;
(if not cont then
(if outerMostProgram then msg[]->PutText if);
CleanUp;
leave Program
if)
#);
CleanUp:< (# do INNER #);
IndexError:< Exception
(#
do (if (* No binding *)true! then
(if Outer[]<>NONE then
Outer.IndexError if) if);
'Index out of range'->msg.append;
INNER
#);
RefIsNone:< (# (* ... *) #);
ArithmeticOverflow:< (# (* ... *) #);
DivisionByZero:< (# (* ... *) #);
Outer: ^Program;
DefineOuter:< (# do INNER #)
do DefineOuter;
INNER
#);
--- p256u: descriptor ---
(# Main: Program
(# IndexError::< (# (* ... *) #);
RefIsNone::< (# (* ... *) #);
do (* ... *)
L0:
Program
(# IndexError::< (# (* ... *) #);
(* New handler for index error *)
DefineOuter::< (# do Main[]->Outer[] #);
(* Propagate other exceptions *)
(* to handlers in Main *)
CleanUp::<
(# do (* executed before termination *)
(* of this(Program) *)
#)
do (* ... *)
L1:
(# Register: (# (* ... *) #)
do L2:
(# Registrations: @Register
(# Overflow::< (# do (* ... *) #);
NotFound::< (# do (* ... *) #)
#)
do (* ... *)
#);
(* ... *)
#);
(* ... *)
#)
#)
do Main
#)
(****************************************************************************)
(* Chapter 17: Modularization ***********************************************)
(****************************************************************************)
--- p272m: attributes ---
Counter:
(# Up: (# n: @integer enter n <<SLOT Up: DoPart>> #);
Down: (# n: @integer <<SLOT Down: DoPart>> exit n #);
Private: @<<SLOT Private: Descriptor>>
#)
--- Private: Descriptor ---
(# V: @integer #)
--- Up: DoPart ---
do Private.V+7->Private.V->n
--- Down: DoPart ---
do Private.V-5->Private.V->n
--- CounterProgram: descriptor ---
(# C: @Counter; N: @integer
do 3->C.up; C.down->N
#)
--- fig17x4: attributes ---
SpreadText:
(* A blank is inserted between all chars in the text 'T' *)
(# T: @Text
enter T
<<SLOT SpreadText: DoPart>>
exit T
#);
BreakIntoLines:
(* 'T' refers to a Text which is to be split into a
* no. of lines. 'w' is the width of the lines.
*)
(# T: ^Text; w: @integer
enter(T[],w)
<<SLOT BreakIntoLines: DoPart>>
#)
--- SpreadText: DoPart ---
do (# L: @integer
do (for i: (T.length->L)-1 repeat
(' ',L-i+1)->T.InsertCh
for) #)
--- BreakIntoLines: DoPart ---
do T.scan
(# sepInx,i,l: @integer;
do i+1->i; l+1->l;
(if ch<=' ' then i->sepInx if);
(if l=w then
(nl,sepInx)->T.InxPut;
i-sepInx->l
if) #);
T.newline;
--- textProgram: Descriptor ---
(# T: @Text;
do 'Here I am!'->SpreadText->PutLine;
'Once upon a time in the west '->T;
'a man came riding from east'->T.putText;
(T[],10)->BreakIntoLines;
T[]->putText;
#)
--- fig17x7: attributes ---
Stack:
(# Private: @<<SLOT privat: ObjectDescriptor>>;
Push: (# e: ^Text enter e[] <<SLOT Push: DoPart>> #);
Pop: (# e: ^Text <<SLOT Pop: DoPart>> exit e[] #);
New: (# <<SLOT New: DoPart>> #);
isEmpty:
(# Result: @boolean
<<SLOT isEmpty: DoPart>>
exit Result
#)
#)
--- privat: Descriptor ---
(# A: [100] ^Text; Top: @integer #)
--- Push: DoPart ---
do private.top+1->private.top;
e[]->private.A[private.top][]
--- Pop: DoPart ---
do private.A[private.top][]->e[];
private.top-1->private.top
--- new: DoPart ---
do 0->private.top
--- isEmpty: DoPart ---
do (0 = private.Top)->result
--- stackProgram: Descriptor ---
(# T: @Text; S: @Stack
do 'To be or not to be'->T; T.reset;
Get:
cycle
(# T1: ^Text
do &Text[]->T1[]; T.getText->T1;
(if T1.empty then leave Get if);
T1[]->S.push
#);
Print:
cycle
(# T1: ^Text
do (if S.isEmpty then leave Print if);
S.pop->T1[];
T1[]->putText; ' '->put
#)
#)