7.12 Appendix A

This appendix contains the source code for the BETA program used as example in the tutorial. The source consists of the files record.bet and recordlib.bet.

Program 1: record.bet

ORIGIN '~beta/basiclib/betaenv'; INCLUDE './recordlib'; --- PROGRAM: descriptor --- (# (* This fragment is an example of using virtual patterns in BETA. * The following classification hierarchy is defined in the * library fragment 'recordlib' * 1. Record * 2. Person * 3. Employee * 3. Student * 2. Book * Record has a virtual (procedure) pattern: * Display, that displays the attributes of a record. * Display is further bound in the sub-patterns. * The patterns NewRecord, NewPerson, etc may be used for * generating new instances of the record-patterns. * The pattern Register has two virtual attributes: * regCat:< record, the elements in the register. * Display, that displays the elements of the register. * * In this application two instances of Register are generated: * Greg is a general register where regCat is not further bound * Ereg is an employee register where only Emplyoee-records may * be inserted *) (**** The following are declaring a number of reference variables ****) Birger, PeterA, Bible, LarsB, ClausN, ElmerS, KimJ: ^Record; Greg: @Register; (* Greg is a general register for all types of Records *) Ereg: @Register (* Ereg is a specific register only for Employee records (and subpatterns of Employee) *) (# RegCat::< Employee; (* a further binding of RegCat to restrict to Employee *) Display::< (# (* Displays the restriction on this particular register *) do '/Employee ' -> s.putText; INNER #); #); do (* the following creates and instantiates a number of Record objects *) (0 ,'Bimmer Moller-Pedersen','Unknown',- 200,'Piccolo') -> NewEmployee -> Birger[]; (1,'Peter Andersen','male','missing M.D.') -> NewStudent -> peterA[]; (2,'Lars Bak','male',1000000,'Garbage collector') -> NewEmployee -> LarsB[]; (3,'Claus Norgaard','male',1000010,'Senior Coder') -> NewEmployee -> ClausN[]; (4,'Elmer Sandvad','male',1000050,'Senior Supporter') -> NewEmployee -> ElmerS[]; (5,'Kim Jensen M|ller','male',999990,'Painter') -> NewEmployee -> KimJ[]; (9,'Kristensen et al.','Object Oriented Programming in the BETA programming language') -> NewBook -> Bible[]; (* the following displayes the Birger, PeterA and Bible objects on the * screen *) screen[] -> Birger.Display; (* not a nice view (: -) *) screen[] -> PeterA.Display; screen[] -> Bible.Display; '===========================' -> putLine; (* initialization of the Greg and Ereg registers *) Greg.init; Ereg.init; (*inserts all Record objects in the Greg and/or Ereg registers *) Birger[] -> Greg.insert; Bible[] -> Greg.insert; PeterA[] -> Greg.insert; ClausN[] -> Ereg.insert; LarsB[] -> Ereg.insert; ElmerS[] -> Ereg.insert; KimJ[] -> Ereg.insert; (* displays the Greg and Ereg registers on the screen *) screen[] -> Greg.display; screen[] -> Ereg.display; (if (LarsB[] -> Ereg.has) (* test if LarsB is in the Ereg register *) // true then 'LarsB in employee register' -> putLine // false then 'LarsB not in employee register' -> putLine if); (if (LarsB[] -> Greg.has) (* test if LarsB is in the Greg register *) // true then 'LarsB in general register' -> putLine // false then 'LarsB not in general register' -> putLine if); (* end of program *) #)

Program 2: recordlib.bet

ORIGIN '~beta/basiclib/betaenv'; -- lib: Attributes -- (* This fragment is an example of using virtual patterns in BETA. * The following classification hierarchy is defined * 1. Record * 2. Person * 3. Employee * 3. Student * 2. Book * Record has a virtual (procedure) pattern: * Display, that displays the attributes of a record. * Display is further bound in the sub-patterns. * The patterns NewRecord, NewPerson, etc may be used for * generating new instances of the record-patterns. * The pattern Register has two virtual attributes: * regCat:< record, the elements in the register. * Display, that displays the elements of the register. * * This fragment is a library containing the declarations * It is used in the program "record" *) Record: (* Record objects contain two attributes: key and Display. Key contains * the ID of this record (supplied by the programmar). Display is a * virtual, enabling printing Records on the screen *) (# Key: @integer; Display:< (* declaration of a virtual (procedure) pattern *) (# s: ^stream (* the input parameter is where to display this record *) enter s[] do s.newline; '-------------------'->s.putLine; 'Record: Key = '->s.putText; Key->s.putInt; s.newline; INNER #); #); Person: Record (# (* Person is a suppattern of Record, declaring two additional attributes: * Name and Sex. Furthermore Display (inherited form Record) is extended * to print the Name and Sex attributes as well as the Key attribute. *) Name,Sex: @text; Display::< (* a further binding of Display from Record *) (# do 'Person: Name = '->s.putText; Name[]->s.putLine; ' Sex = '->s.putText; Sex[]->s.putLine; INNER #); #); Employee: Person (# (* analog til Person *) Salary: @integer; Position: @text; Display::< (# do 'Employee: Salary = '->s.putText; salary->s.putInt; s.newline; ' Position = '->s.putText; Position[]->s.putLine; INNER #); #); Student: Person (# (* analog til Person *) Status: @text; Display::< (# do 'Student: Status = '->s.putText; Status[]->s.putLine; INNER #) #); Book: Record (# (* analog til Person *) Author,Title: @text; Display::< (# do 'Book: Author = '->s.putText; Author[]->s.putLine; ' Title = '->s.putText; Title[]->s.putLine; INNER #) #); doc0: (*** Temporary initialization ***) (# #); NewRecord: (* creation and initialization procedure for Record objects *) (# RegCat:< Record; Rec: ^RegCat; K: @integer; R: ^Record enter K do &RegCat[]->Rec[]; K->Rec.Key; INNER ; Rec[]->R[] exit R[] #); NewPerson: NewRecord (* creation and initialization procedure for Person objects *) (# RegCat::< Person; N,S: @text enter (N,S) do N->Rec.Name; S->Rec.Sex; INNER ; #); NewEmployee: NewPerson (* creation and initialization procedure for Employee objects *) (# RegCat::< Employee; S: @integer; P: @text enter (S,P) do S->Rec.Salary; P->Rec.Position; INNER ; #); NewStudent: NewPerson (* creation and initialization procedure for Student objects *) (# RegCat::< Student; S: @text enter S do S->Rec.Status; INNER ; #); (* This is a declaration of a register pattern. Register objects will be able * to contain Records (or instances of suntarrerns of Record. *) NewBook: NewRecord (* creation and initialization procedure for Book objects *) (# RegCat::< Book; A,T: @text enter (A,T) do A->Rec.Author; T->Rec.Title; INNER ; #); Register: (* Register is a container pattern with operations insert (insert an object) * scan (traverse the register), has (test for presence of an object in the * register), display (display the objects in the register). * * Register may contain objects, that are instances of Record (of subpatterns * hereof). Specializations of Register may restrict the classes of objects * allowed in the specialized register pattern by further binding the regCat * virtual pattern *) (# regCat:< Record; regLst (* private pattern *) : (# succ: ^regLst; elm: ^regCat #); head: ^regLst; init: (* initialization pattern to be invoked before first usage fo an * register object *) (# do none ->head[] #); scan: (* walks through the register, executing INNIR for each element in the * register. P will refer to the current element in the register. *) (# elm: ^regCat; p: ^regLst do head[]->P[]; search: (if (P[] = none ) // false then P.elm[]->elm[]; INNER ; P.succ[]->P[]; restart search if) #); Display:< (* display the entire register by printing header and trailer text, * and scanning the entire register in between, invoking display on * each element in the register. *) (# s: ^stream enter s[] do s.newline; '############ Register Display '->s.putText; INNER ; s.newline; scan (# do s[]->elm.display #); '############ End Register Display #######'->s.putLine #); Has: (* takes an object reference, and checks whether that object is in the * register *) (# E: ^regCat; found: @boolean; enter E[] do false->found; search: scan (# do (if E.key // elm.key then true->found; leave search if) #) exit found #); Insert: (* Takes an object reference and inserts that object in the register * (if not already in the register) *) (# E: ^regCat; P: ^regLst enter E[] do (if (E[]->Has) // false then &regLst[]->P[]; head[]->P.succ[]; E[]->P.elm[]; P[]->head[] if); #); #) (* Register *)