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
     #)
#)

(****************************************************************************)
(****************************************************************************)
(****************************************************************************)