File: dbf\deque_types.adb

    1 --::::::::::
    2 --dequtype.adb
    3 --::::::::::
    4 -- Developed by (C) Wasiliy W. Molostoff 1994, 1995.
    5 --                  Moscow, Russia,
    6 --                  Voice:   7 (095) 398-23-38
    7 --                  e-mail:  edv@edv.msk.ru
    8 -- This is free software; you can  freely  redistribute  it  and/or
    9 -- modify  it  without any restrictions.  Please report any errors.
   10 -- All corrections will be made as soon as possible.
   11 package body deque_types is
   12 
   13   package body deques is
   14 
   15     dqsgn: array(edge_type) of integer := (-1, 1);
   16 
   17     function valid (i, w : in integer) return positive is
   18     begin
   19       return ((i + w - 1) mod w) + 1;
   20     end valid;
   21 
   22     pragma inline(valid);
   23 
   24     procedure set_target (deque  : in out object;
   25                           target : in edge_type) is
   26     begin
   27       deque.current.target := target;
   28     end set_target;
   29 
   30     procedure set_source (deque  : in out object;
   31                           source : in edge_type) is
   32     begin
   33       deque.current.source := source;
   34     end set_source;
   35 
   36     procedure set_rule (deque : in out object;
   37                         rule  : in edges_rule) is
   38     begin
   39       deque.current := rule;
   40     end set_rule;
   41 
   42     function source (deque : in object) return edge_type is
   43     begin
   44       return deque.current.source;
   45     end source;
   46 
   47     function target (deque : in object) return edge_type is
   48     begin
   49       return deque.current.target;
   50     end target;
   51 
   52     function current (deque : in object) return edges_rule is
   53     begin
   54       return deque.current;
   55     end current;
   56 
   57     procedure reset_rule (deque : in out object) is
   58     begin
   59       set_rule(deque, (source => default_state.source,
   60                        target => default_state.target));
   61     end reset_rule;
   62 
   63     procedure flip_edges (deque : in out object) is
   64     begin
   65       set_rule(deque, (source => opposite (source(deque)),
   66                        target => opposite (target(deque))));
   67     end flip_edges;
   68 
   69     procedure discard (deque : in out object;
   70                        item  : out element) is
   71     begin
   72       discard(deque, item, deque.current.source);
   73     end discard;
   74 
   75     procedure append (deque : in out object;
   76                       item  : in element) is
   77     begin
   78       append(deque, item, deque.current.target);
   79     end append;
   80 
   81     procedure discard (deque  : in out object;
   82                        item   : out element;
   83                        source : in edge_type) is
   84 
   85       dqei : integer renames deque.index(source);
   86 
   87     begin
   88       if deque.count < 1 then
   89         raise deque_underflow;
   90       end if;
   91       item := deque.data (dqei);
   92       dqei := valid(dqei - dqsgn(source), deque.width);
   93       deque.count := deque.count - 1;
   94     end discard;
   95 
   96     procedure append (deque  : in out object;
   97                       item   : in element;
   98                       target : in edge_type) is
   99       dqei : integer renames deque.index(target);
  100     begin
  101       if deque.count >= deque.width then
  102         raise deque_overflow;
  103       end if;
  104       dqei := valid(dqei + dqsgn(target), deque.width);
  105       deque.data (dqei) := item;
  106       deque.count := deque.count + 1;
  107     end append;
  108 
  109     procedure clear (deque : in out object) is
  110     begin
  111       deque.count := 0;
  112       deque.index := (1, deque.width);
  113     end clear;
  114 
  115     function value (deque  : in object;
  116                     source : in edge_type) return element is
  117     begin
  118       return deque.data (deque.index(source));
  119     end value;
  120 
  121     function value (deque : in object) return element is
  122     begin
  123       return deque.data (deque.index(deque.current.source));
  124     end value;
  125 
  126     function length (deque : in object) return natural is
  127     begin
  128       return deque.count;
  129     end length;
  130 
  131     procedure update (deque  : in out object;
  132                       item   : in element;
  133                       target : in edge_type) is
  134     begin
  135       deque.data (deque.index(target)) := item;
  136     end update;
  137 
  138     procedure update (deque : in out object;
  139                       item  : in element) is
  140     begin
  141       deque.data (deque.index(deque.current.target)) := item;
  142     end update;
  143 
  144     package body array_support is
  145 
  146 --  function value  (deque: in object) return sequence is
  147 --  procedure get (deque : in out object; seq: out sequence);
  148 --  function "&" (left: object; right: object) return sequence;
  149 --  function "&" (left: sequence  ; right: object) return sequence;
  150 --  function "&" (left: object; right: sequence  ) return sequence;
  151 --  procedure set (deque : in out object; seq: in  sequence) is
  152 
  153     end array_support;
  154 
  155   end deques;
  156 
  157 end deque_types;
  158