7.3 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 *)


Mjolner Integrated Development Tool - Tutorial
© 1991-2004 Mjølner Informatics
[Modified: Thursday January 16th 2003 at 10:14]