Example linked list program using matching

 The following is a sample program which uses a static type system similar to that presented in section 11. The program defines and uses heterogeous linked lists of elements, each element of which must have a type matching ${\it {rect\_type}}$. Because ${\it {OrdList\_class}}$ is polymorphic in the type of the nodes in the list, we can easily instantiate the lists to be either singly or doubly-linked.

We have left out inessential portions of the code the program in order to conserve space. The keyword include used in the definition of ${\it {DbleNode\_type}}$ simply indicates that all methods declared in ${\it {Node\_type}}$ are also included in ${\it {DbleNode\_type}}$.

program heterogeneous_linked_lists;
-- Program developing heterogeneous singly- and doubly-linked lists.  
-- Elements of the linked list must be of type which matches rect_type.

type

  rect_type = ObjectType
       gt: func(#rect_type):bool;
       eq: func(#rect_type):bool;
       get_height: func():integer;
       draw: proc();
    end ObjectType;
    
  Node_type = ObjectType
        get_next: func():mytype;
        get_val: func():#rect_type;
        set_next: proc(mytype); 
        set_val: proc(#rect_type);
        attach_right: proc(mytype)
    end ObjectType;
  
  DbleNode_type = ObjectType include Node_type
        get_prev:func():mytype; 
        set_prev:proc(mytype);
    end ObjectType;
            
  TypeFunction OrdList_type(U <# Node_type) = ObjectType 
        find: func(#rect_type):bool;
        add: proc(U);
        drawall: proc();
    end ObjectType;

classes

  class gen_rect_class(tp,lft,bot,rght,newz: integer)
    var
       top = tp: integer;
       left = lft: integer;
       bottom = bot: integer;
       right = rght: integer;
       z = newz: integer;
    methods
       function gt(other: #rect_type): bool
         begin
            return (z > other.get_height()) 
         end;
       function eq(other: #rect_type): bool
         ...
       function get_height(): integer
         ...
       procedure draw
         ...
    end class;

  class Node_class(v: #rect_type)       
    var
       val = v: #rect_type;
       next = nil: mytype;
    methods
       function get_next(): mytype
         begin
            return next  
         end;
       function get_val(): #rect_type
         begin
            return val  
         end;
       procedure set_next(nxt:mytype)
         begin
            next := nxt  
         end;
       procedure set_val(vl: #rect_type)
         begin
            val := vl  
         end;
       procedure attach_right = procedure(newNext: mytype)
         begin
            self.set_next(newNext)  
         end;
    end class;

  class DbleNode_class(v: #rect_type) 
           inherits Node_class(v) modifying attach_right
    var
       prev = nil: MyType
    methods
       function getPrev():MyType
         ...
       procedure setPrev(newPrev: MyType)
         ...
       procedure attachRight(newNext: MyType)
         begin 
            self.setNext(newNext);
            newNext.setPrev(self)
         end
  end class;

  class OrdList_class(U <# Node_type)
    var
       head = nil: U;
    methods
       function find(match:#rect_type): bool
         var
           current: U;
         begin
           current := head;
           while (current != nil) & match.gt(current.get_val()) do
             current := current.get_next() 
           end;
           if (current != nil) & (current.get_val()).eq(match)) then
             return true
           else
             return false 
         end;
         
       procedure add(new_node:U)
        var
          prev: U;
          current: U;
        begin
          if head = nil then
            head := new_node;
            new_node.set_next(nil);
          else if head.get_val().gt(new_node.get_val()) then
                  new_node.attach_right(head);
                  head := new_node;
                else
                  prev := head;
                  current := head.get_next();
                  while (current != nil) &
                      current.get_val().gt(new_node.get_val()) do
                    prev := current;
                    current := current.get_next();
                  end;
                  if current = nil then
                    prev.attach_right(new_node);
                    new_node.set_next(nil);
                  else
                    new_node.attach_right(current);
                    prev.attach_right(new_node);
                  end;
                end;
           end;
         end;
         
       drawall = procedure()
         var 
           current: U;
           cur_val: #rect_type;
         begin
           current := head;
           while (current != nil) do
             cur_val := current.get_val();
             cur_val.draw();
             current := current.get_next();   
           end;
         end;
       end;
   end class;

var
   temp_rect: rect_type;
   shape: #rect_type;
   lnode: Node_type;
   dnode: DbleNode_type
   some_node: #Node_type;
   slist: #OrdList_type[Node_type];
   dlist: OrdList_type[DbleNode_type];
   
begin -- main program
   temp_rect := new(gen_rect_class(1,1,4,4,5));
   lnode := new(Node_class(temp_rect));   
   slist := new(OrdList_class(Node_type));
   dnode := new(DbleNode_class(temp_rect));
   dlist := new(OrdList_class(DbleNode_type));
   slist.add(lnode.clone());
 -- illegal: slist.add(dnode.clone());  
 --    Can't add a doubly-linked node to a singly-linked list.
 -- illegal: slist := dlist
 --    OrdList_type[DbleNode_type] does not match OrdList_type[Node_type].
   temp_rect := new(gen_rect_class (2,2,3,3,2));
   lnode.set_val(temp_rect);
   slist.add(lnode);
   some_node := dnode.get_next();
   lnode := lnode.get_next();
   shape := lnode.get_val();
 -- illegal: temp_rect := lnode.get_val();
 --    Result of get_val() has type #rect_type.
   lnode.setval(shape)
   PrintNum(shape.get_height());
end.

The two new type-checking rules for #-types introduced in section 11 are necessary to type check this program. The first states that if an expression ${\it {e}}$ has type ${\it {T}}$, then ${\it {e}}$ also has type #T. The second states that if ${\it {e}}$ has type #T and ${\it {T {\rm \, <\!\!\!\char93 \, }U}}$, then ${\it {e}}$ also has type #U. The first of these rules allows the assignment to ${\it {slist}}$ and the use of ${\it {temp\_rect}}$ as a parameter in the message send ${\it {lnode.set\_val(temp\_rect)}}$. Both of these rules are used in type checking the assignment to ${\it {some\_node}}$.

The program is written with a syntax and style similar to that of the language LOOM [BP96]. LOOM differs from the above in a few syntactic details. It also supports the use of classes as first-class values (e.g., classes can be returned as values from functions), provides finer control over the visibility of methods, and includes a module system for programming in the large. A description of the module facilities can be found in [Pet96].