-- Copyright (c) 1995 John Beidler -- Computing Sciences Dept. -- Univ. of Scranton, Scranton, PA 18510 -- -- (717) 941-7446 voice -- (717) 941-4250 FAX -- beidler@cs.uofs.edu -- -- For use by non-profit educational institutions only. -- This software is GUARANTEED. Please report any errors. All -- corrections will be made as soon as possible (normally within -- one working day). ------------------------------------------------------------------ -- Assertion notation: -- /= not equal -- () empty list -- , and -- | or -- ' If x passed as argument then x' is result after subprog executes -- (...) A list of n objects may be viewed as an n-tuple. If list is -- a list of n objects, then (h, list) is a list of n+1 objects, -- where h is an object and list is a list. ------------------------------------------------------------------ -- For safe use of this package -- Object_Type is UNBOUND NONPOLYMORPHIC -- List_Type is UNBOUND MANAGED ------------------------------------------------------------------ with List_LPBase; generic type Object_Type is limited private; with procedure Initialize (Object: in out Object_Type); with procedure Finalize (Object: in out Object_Type); with procedure Copy (Source: in Object_Type; Target: in out Object_Type); with procedure Swap (Source, Target: in out Object_Type); package List_Lpt_Lpt is ----------------------------------------------------- -- WARNING: DO NOT USE "zqklst" package zqklst is new List_LPBase (Object_Type, Initialize, Finalize, Copy, Swap); ----------------------------------------------------- type List_Type is limited private; List_Underflow : exception renames zqklst.List_Underflow; List_Overflow : exception renames zqklst.List_Overflow; procedure Initialize (List: in out List_Type); ------------------------------------------------------------------ -- Pre Cond : List uninitialized -- Post Cond: List may be used by other subprograms ------------------------------------------------------------------ procedure Finalize (List: in out List_Type); ------------------------------------------------------------------ -- Pre Cond : List initialized -- Post Cond: List uninitialized ------------------------------------------------------------------ function Tail_Of (List: List_Type) return List_Type; ------------------------------------------------------------------ -- Pre Cond : List /= {}, List = (head, tail) head is -- an Object_Type and tail is a List_Type -- Post Cond: Returns tail -- Exception: Invalid_Position, List_Underflow. ------------------------------------------------------------------ function Head_Of (List: List_Type) return Object_Type; ------------------------------------------------------------------ -- Pre Cond : List /= () -- Post Cond: returns copy of a -- 1 -- Exception: List_Underflow or Invalid_Position ------------------------------------------------------------------ function Empty (List: List_Type) return boolean; ------------------------------------------------------------------ -- Pre Cond : None -- Post Cond: returns return (List /= {}) -- Exception: None ------------------------------------------------------------------ procedure New_Head (Object: in out Object_Type; List : in List_Type); ------------------------------------------------------------------ -- Pre Cond : none -- Post Cond: List' = (Object, List) -- Exception: Invalid_Position, List_Overflow -- NOTE: Swap used to exchange value of Object_Type ---------------------------------------------------------- procedure Remove_Head (List : in List_Type; Object: in out Object_Type); ------------------------------------------------------------------ -- Pre Cond : none -- Post Cond: List = (Object, List') -- Exception: Invalid_Position, List_Overflow -- NOTE: Swap used to exchange value of Object_Type ---------------------------------------------------------- procedure Swap_Tail (Source: in List_Type; Target: in List_Type); --------------------------------------------------------------- -- Pre-cond : Source = (s, Stail) or (), Target = (t, Ttail) or () -- where Stail and/or Ttail may be (). -- Post-cond: Source' = (s, Ttail) or (Ttail), -- Target' = (t, Stail) or (Stail) -- Exception: Invalid_Share --------------------------------------------------------------- procedure Append (List : in List_Type; New_Tail: in List_Type); ------------------------------------------------------------------ -- Pre Cond : None -- Post Cond: List' = (List, New_Tail) -- New_Tail' = {} -- Exception: List_Underflow ------------------------------------------------------------------ procedure Append (List : in List_Type; New_Tail: in out Object_Type); -- NOTE: Swap used to exchange value of Object_Type subtype In_Place_Process_Type is zqklst.In_Place_Process_Type; -- access procedure (Object: in out Object_Type); procedure Process_Head (List : in List_Type; Process: In_Place_Process_Type); ---------------------------------------------------------------- -- Pre Cond : List = (x, tail) -- Post Cond: Process (x) performed -- Exception: Depends upon Process ------------------------------------------------------------------ procedure Update_Head (List : in List_Type; Object: in out Object_Type); --------------------------------------------------------- -- Pre Cond : List = (x, tail) -- Post Cond: List' = (Object, tail) -- Exception: Invalid_Position -- NOTE: Swap used to exchange value of Object_Type ---------------------------------------------------------- procedure Copy (Source: in List_Type; Target: in out List_Type); ------------------------------------------------------------------ -- Pre Cond : None -- Post Cond: Target' = Source -- Exception: None ------------------------------------------------------------------ procedure Swap (Source: in out List_Type; Target: in out List_Type); --------------------------------------------------------- -- Pre-Cond : None -- Post-Cond: Target' = Source, Source' = Target -- Exception: None --------------------------------------------------------- private type List_Type is record List: zqklst.LPList_Type; end record; end List_Lpt_Lpt;