/*----------------------------------------------------------------------------*/
/*                                                                            */
/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved.             */
/* Copyright (c) 2005-2024 Rexx Language Association. All rights reserved.    */
/*                                                                            */
/* This program and the accompanying materials are made available under       */
/* the terms of the Common Public License v1.0 which accompanies this         */
/* distribution. A copy is also available at the following address:           */
/* https://www.oorexx.org/license.html                                        */
/*                                                                            */
/* Redistribution and use in source and binary forms, with or                 */
/* without modification, are permitted provided that the following            */
/* conditions are met:                                                        */
/*                                                                            */
/* Redistributions of source code must retain the above copyright             */
/* notice, this list of conditions and the following disclaimer.              */
/* Redistributions in binary form must reproduce the above copyright          */
/* notice, this list of conditions and the following disclaimer in            */
/* the documentation and/or other materials provided with the distribution.   */
/*                                                                            */
/* Neither the name of Rexx Language Association nor the names                */
/* of its contributors may be used to endorse or promote products             */
/* derived from this software without specific prior written permission.      */
/*                                                                            */
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS        */
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT          */
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS          */
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   */
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,      */
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED   */
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,        */
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY     */
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING    */
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS         */
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.               */
/*                                                                            */
/*----------------------------------------------------------------------------*/

use arg rexxPackage
-- IMPORTANT NOTE: All classes contained in this package must be added to the
-- rexxPackage using either addClass or addPublicClass. In general, all that is
-- needed is to ensure the PUBLIC keyword is specified on the ::CLASS directive
-- for any classes intended to be visible at the user level.


-- add the local server class to the Rexx package as a non public class
rexxPackage~addClass('LOCALSERVER', .LocalServer)
-- these only exist as internal classes, but they need to be protected
rexxPackage~addClass('SUPPLIERMIXIN', .SupplierMixin)
rexxPackage~addClass('ManyItemMixin', .ManyItemMixin)
rexxPackage~addClass('SetMixin', .SetMixin)
rexxPackage~addClass('BagMixin', .BagMixin)


.environment~objectname = "The Environment Directory"
rexxPackage~objectname = "The REXX Package"


-- add all of the public classes to .environment and to the
-- REXX package
publicClasses = .context~package~publicClasses

do name over publicClasses
   class = publicClasses[name]
   .environment~put(class, name)
   rexxPackage~addPublicClass(name, class)
end

-- add string class constant methods
do name over "nl", "cr", "tab", "null", -
 "alnum", "alpha", "blank", "cntrl", "digit", "graph", "lower", -
 "print", "punct", "space", "upper", "xdigit"
  .String~defineClassMethod(name~upper, .methods[("string_cls_" || name)~upper])
end

-- Some classes have addtional methods added that are written in Rexx.
-- we do a phony inherit to add those directly to the class instance
-- dictionary.

.supplier~inheritInstanceMethods(.SupplierMixin)
-- bag and relation both get this one, which redefines the set methods
.relation~inheritInstanceMethods(.ManyItemMixin)
.bag~inheritInstanceMethods(.ManyItemMixin)
-- set has its own set methods
.set~inheritInstanceMethods(.SetMixin)
-- as does Bag
.bag~inheritInstanceMethods(.BagMixin)

-- now handle real inherits for the primitive classes.

-- string class is a comparable item

.string~inherit(.Comparable)

-- the ordered collections (which also handles Collection)

.array~inherit(.OrderedCollection)
.list~inherit(.OrderedCollection)
.queue~inherit(.OrderedCollection)

-- the different Map collections

.identityTable~inherit(.MapCollection)
.table~inherit(.MapCollection)
.stringTable~inherit(.MapCollection)
.directory~inherit(.MapCollection)
.relation~inherit(.MapCollection)
.set~inherit(.MapCollection)
.bag~inherit(.MapCollection)
.stem~inherit(.MapCollection)

-- set and bag are also set collections

.set~inherit(.SetCollection)
.bag~inherit(.SetCollection)

-- Message implements two additional interfaces
.message~inherit(.MessageNotification)
.message~inherit(.AlarmNotification)


call 'StreamClasses.orx' rexxPackage

call 'PlatformObjects.orx' rexxPackage       -- now load platform-specific builtin classes

exit

/* ************************************************************************** */
/* ************************************************************************** */
/* *** Start of unattached METHOD definitions for the various enhanced    *** */
/* *** objects created above                                              *** */
/* ************************************************************************** */
/* ************************************************************************** */

--/============================================================================/
--/ Additional S T R I N G methods /
--/============================================================================/
::METHOD string_cls_nl
 use strict arg
 return "0a"x
::METHOD string_cls_cr
 use strict arg
 return "0d"x
::METHOD string_cls_tab
 use strict arg
 return "09"x
::METHOD string_cls_null
 use strict arg
 return "00"x

::method string_cls_alnum; use strict arg; return xrange("alnum")
::method string_cls_alpha; use strict arg; return xrange("alpha")
::method string_cls_blank; use strict arg; return xrange("blank")
::method string_cls_cntrl; use strict arg; return xrange("cntrl")
::method string_cls_digit; use strict arg; return xrange("digit")
::method string_cls_graph; use strict arg; return xrange("graph")
::method string_cls_lower; use strict arg; return xrange("lower")
::method string_cls_print; use strict arg; return xrange("print")
::method string_cls_punct; use strict arg; return xrange("punct")
::method string_cls_space; use strict arg; return xrange("space")
::method string_cls_upper; use strict arg; return xrange("upper")
::method string_cls_xdigit; use strict arg; return xrange("xdigit")


-- Start of classes that exist only to add collections of methods to
-- primitive classes

/*============================================================================*/
/*    Additional S U P P L I E R methods                                      */
/*============================================================================*/

::class "SupplierMixin"
-- retrieve all items from the supplier from the current
-- iteration point
::method allItems
  expose items
  use strict arg    -- enforces no arguments

  self~getArrays

  return items

-- retrieve all indexes from the current iteration point to the end
::method allIndexes
  expose indexes
  use strict arg    -- enforces no arguments

  self~getArrays

  return indexes

-- private method used to build the arrays used for allIndexes and allItems
::method getArrays private
  expose indexes items

  if \var('INDEXES') then do
     indexes = .array~new
     items = .array~new

     do while self~available
         indexes~append(self~index)
         items~append(self~item)
         self~next
     end
  end

-- allow a supplier to be given in any context where
-- an object that implements supplier can be used.  This
-- just returns the current object.
::method supplier
  use strict arg
  return self


/*============================================================================*/
/*    M A N Y I T E M       M I X I N         (for Relation and Bag)          */
/*============================================================================*/
::class "ManyItemMixin"
/*****************************************/
/* UNION         method                  */
/*****************************************/
::METHOD Union                         -- union of collections
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- copy ourself

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end


-- just copy all of the items into the relation
do while supplier~available            -- now iterate over the supplier seeing if
    new~put(supplier~item, supplier~index)
    supplier~next
end

return new                             -- return the union collection

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* DIFFERENCE    method                  */
/*****************************************/
::METHOD difference                    -- take the difference of collections
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- copy ourself

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end


-- remove the tuples from the result collection
do while supplier~available            -- now iterate over the supplier seeing if
    new~removeItem(supplier~item, supplier~index)
    supplier~next
end

return new                             -- return the difference collection

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* XOR           method                  */
/*****************************************/
::METHOD xor                           -- take the exclusive or of a relation
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- we need a copy of our self, plus
catcher = self~class~new               -- a catcher method use to accumulate values

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end

-- now loop over the supplier checking the existance.  If we have this
-- item, we remove it from the copy.  Otherwise, it is put into the
-- catcher.  When we're finished, we merge the two collections.
do while supplier~available
    index = supplier~index
    value = supplier~item
    if new~hasitem(value, index) then  -- in the reference collection?
        new~removeitem(value, index)   -- remove from the reference set
    else
        catcher~put(value, index)      -- add non-located to the catcher
    supplier~next                      -- step to the next item
end

new~putall(catcher)                    -- now copy into the result
return new                             -- now return the merged collection

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")

/*****************************************/
/* INTERSECTION  method                  */
/*****************************************/
::METHOD intersection                  -- take the intersection of relations
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~class~new                   -- start with a new collection
ref = self~copy                        -- our reference copy

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end

-- now loop over the values supplied by the other, checking our
-- reference collection for existance.  We remove any matches from the
-- reference to eliminate duplicate errors

do while supplier~available
    index = supplier~index
    value = supplier~item
    -- if found, copy to the result, and remove from the reference checker
    if ref~hasitem(value, index) then do
        new~put(value, index)
        ref~removeitem(value, index)
    end
    supplier~next
end

return new

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* SUBSET        method                  */
/*****************************************/
::METHOD subset                        -- do we have a subset?
use strict arg other

signal on nomethod                     -- trap unknown method calls

ref = self~copy                        -- make a copy of this object

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end

-- now iterate and try removing the items from the reference.
-- if it's all gone when we're finished
do while supplier~available
  ref~removeitem(supplier~item, supplier~index)
  supplier~next
end

return ref~isEmpty                     -- if nothing left -> proper subset

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


-- a mixin for SET methods written in Rexx code
::CLASS 'SetMixin'

/*****************************************/
/* XOR        method                     */
/*****************************************/
::METHOD xor                           -- take the exclusive or of a set
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- work off of a copy
if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    -- if in the collection, remove it from the result.
    -- otherwise, add to the result
    if self~hasindex(index) then
        new~remove(index)
    else
        new~put(index)
end

return new                             -- return the XOR collection

nomethod:
  raise syntax 93.948 array(1, "Collection") -- no, complain about it

/*****************************************/
/* INTERSECTION  method                  */
/*****************************************/
::METHOD intersection                  -- take the intersection of sets
use strict arg other                   -- get the companion object

signal on nomethod

new = self~class~new                   -- use a new instance

if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    -- if we have one of these, put into the result
    -- NB:  Since this is a SET, there will only be one copy accumulated.
    if self~hasindex(index) then
         new~put(index)
end

return new                             -- return the difference collection

nomethod:                              -- unknown method sent
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* UNION         method                  */
/*****************************************/
::METHOD union                         -- take the union of sets
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- use a copy of this instance

if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    -- only add if not already there
    if \new~hasindex(index) then
         new~put(index)
end

return new                             -- return the union collection

nomethod:                              -- unknown method sent
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* SUBSET        method                  */
/*****************************************/
::METHOD subset                        -- do we have a subset?
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- use a copy of this instance

values = other~allitems                -- get all of the items from the other collection
count = values~items

do i = 1 to count
    index = values[i]
    -- subtract each item
    new~remove(index)
end

return new~isempty                     -- subset of this is empty

nomethod:                              -- unknown method sent
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* PUTALL        method                  */
/*****************************************/
::METHOD putall
  use strict arg other                   -- get the companion object

  signal on nomethod

  if other~isA(.Collection) then
      values = other~allitems            -- get all of the items from the other collection
  else
      values = other~makearray           -- ask for an array version of the source

  count = values~items

  do i = 1 to count
      -- just put each item into the set
      self~put(values[i])
  end

  return self                            -- return receiving set

  nomethod:                              -- unknown method sent
    raise syntax 93.948 array(1, "Collection")


/* *************************************** */
/*    B A G                   C L A S S    */
/* *************************************** */

::CLASS 'BagMixin'

/*****************************************/
/* UNION         method                  */
/*****************************************/
::METHOD union
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- work off of a copy
if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    -- just add each item
    new~put(index)
end

return new                             -- return the XOR collection

nomethod:
  raise syntax 93.948 array(1, "Collection") -- no, complain about it

/*****************************************/
/* XOR           method                  */
/*****************************************/
::METHOD xor
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- copy ourselves
catcher = self~class~new               -- and create an empty result

if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    -- if the index is not in the reference, we
    -- copy it to the catcher, otherwise we remove it from the reference
    if new~hasindex(index) then
        new~remove(index)
    else
        catcher~put(index)
end

new~putall(catcher)                    -- remerge the two collections
return new

nomethod:
  raise syntax 93.948 array(1, "Collection") -- no, complain about it

/*****************************************/
/* INTERSECTION  method                  */
/*****************************************/
::METHOD intersection
use strict arg other                   -- get the companion object

signal on nomethod

new = self~class~new                   -- start with a new collection
object = self~copy                     -- copy the target collection

if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    -- if the reference collection contains this index, then
    -- add to the result and remove from the reference.
    if object~hasindex(index) then do
        new~put(index)
        object~remove(index)
    end
end

return new                             -- and return the new collection

nomethod:
  raise syntax 93.948 array(1, "Collection") -- no, complain about it

/*****************************************/
/* DIFFERENCE method                     */
/*****************************************/
::METHOD difference
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- copy the target collection

if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    new~remove(index)                  -- just subtract this from the copy
end

return new                             -- and return the new collection

nomethod:
  raise syntax 93.948 array(1, "Collection") -- no, complain about it

/*****************************************/
/* SUBSET        method                  */
/*****************************************/
::METHOD subset
use strict arg other                   -- get the companion object

signal on nomethod

new = self~copy                        -- copy the target collection

if other~isA(.Collection) then
    values = other~allitems            -- get all of the items from the other collection
else
    values = other~makearray           -- ask for an array version of the source
count = values~items

do i = 1 to count
    index = values[i]
    new~remove(index)                  -- just subtract this from the copy
end

return new~isempty                     -- and test to see if we used everything up

nomethod:
  raise syntax 93.948 array(1, "Collection") -- no, complain about it


/*****************************************/
/* PUTALL        method                  */
/*****************************************/
::METHOD putall
  use strict arg other                   -- get the companion object

  signal on nomethod

  if other~isA(.Collection) then
      values = other~allitems            -- get all of the items from the other collection
  else
      values = other~makearray           -- ask for an array version of the source

  count = values~items

  do i = 1 to count
      -- just put each item into the bag
      self~put(values[i])
  end

  return self                            -- return receiving bag

  nomethod:                              -- unknown method sent
    raise syntax 93.948 array(1, "Collection")

-- Notification interface for the .Message class
::CLASS 'MessageNotification' MIXINCLASS Object Public
::METHOD messageComplete ABSTRACT

-- Notification interface for the .Alarm class
::CLASS 'AlarmNotification' MIXINCLASS Object Public
-- we signal both triggering and cancellation
::METHOD triggered ABSTRACT
-- we'll make this one a NOP...it does not really need to be implemented.
::METHOD cancel
  return


-- tagging classes for Collection class types
-- methods defined for all collection classes, abstract methods must be implemented
-- by subclasses
::CLASS 'Collection' MIXINCLASS Object Public
::METHOD 'at'           ABSTRACT
::METHOD '[]'           ABSTRACT
::METHOD 'put'          ABSTRACT
::METHOD '[]='          ABSTRACT
::METHOD index          ABSTRACT
::METHOD allIndexes     ABSTRACT
::METHOD allItems       ABSTRACT

::METHOD supplier
  return .supplier~new(self~allItems, self~allIndexes)

::method 'hasIndex'
  use strict arg index
  return self~allIndexes~hasItem(index)

::method 'hasItem'
  use strict arg item
  return self~allItems~hasItem(item)

::method 'items'
  return self~allIndexes~items

::method 'makeArray'
  return self~allItems

-- set methods that are defined in terms of other set methods, so
-- they work for all of the collection types
/*****************************************/
/* EQUIVALENT  method                    */
/*****************************************/
::METHOD equivalent        -- determine collection equivalency
use strict arg other

-- this is like subset, but both collections must have the
-- same number of items
if self~items = other~items, self~subset(other) then return .true
return .false

/*****************************************/
/* DISJOINT  method                      */
/*****************************************/
::METHOD disjoint        -- the two collections have nothing in common
use strict arg other

-- base this off of the intersection results
return self~intersection(other)~isEmpty

/*****************************************/
/* DIFFERENCE method                     */
/*****************************************/
::METHOD 'difference'   -- single_difference             -- take the difference between collections
use strict arg other

signal on nomethod                     -- trap unknown method calls

-- all set operations are done using the receiver index values.  However, the
-- objects we use for the index differ depending on the other class.

if (other~isA(.OrderedCollection))     -- for ordered collections, us the items
    then indexes = other~allItems
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then indexes = other~allIndexes    -- use the index values
else indexes = other~makearray         -- an arbitrary class supporting makearray

new = self~copy                        -- make a new collection we can modify

count = other~items                    -- get the size of the array

-- loop over the other collection using an index do rather than DO OVER so
-- we don't make another copy of the index array
do i = 1 to count
  new~remove(indexes[i])               -- "subtract" this item
end

return new                             -- return the difference collection  */

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* INTERSECTION  method                  */
/*****************************************/
::METHOD 'interSection' -- single_intersection           -- take the intersection of sets
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~class~new                   -- create a new collection

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end

do while supplier~available            -- now iterate over the supplier seeing if
    index = supplier~index             -- the item is defined in the target.  If
    if self~hasIndex(index) then       -- so, we we copy into the result collection
        new~put(supplier~item, index)
    supplier~next
end

return new                             -- return the result collection

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* SUBSET        method                  */
/*****************************************/
::METHOD 'subSet' -- single_subset                 -- is the target a subset of the other?
use strict arg other

signal on nomethod                     -- trap unknown method calls

-- all set operations are done using the receiver index values.  However, the
-- objects we use for the index differ depending on the other class.
haveMap = .false

if (other~isA(.OrderedCollection))     -- for ordered collections, us the items
    then indexes = other~allItems
else if (other~isA(.MapCollection)) then do    -- this includes the SetCollections
    indexes = other~allIndexes         -- use the index values
    haveMap = \other~isA(.set)         -- if a true mapping, we also need to validate value
end
else indexes = other~makearray         -- an arbitrary class supporting makearray

new = self~copy                        -- make a new collection we can modify

count = other~items                    -- get the size of the array

-- loop over the other collection using an index do rather than DO OVER so
-- we don't make another copy of the index array
do index over self                     -- now check all of my indexes against the reference
   if \indexes~hasItem(index)
       then return .false              -- something missing, not a subset
   -- if a real map collection, then we need to verify the full tuple
   if havemap, self[index] \= other[index] then return .false
end

return .true                           -- collection is a proper subset

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* UNION         method                  */
/*****************************************/
::METHOD 'union'  -- single_union                  -- take the union of sets
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- copy the collection

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end

do while supplier~available            -- now iterate over the supplier seeing if
    index = supplier~index             -- the item is not defined in the target.  If
    if \new~hasIndex(index) then       -- so, we we copy into the result collection
        new~put(supplier~item, index)
    supplier~next
end

return new                             -- return the target collection

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* XOR        method                     */
/*****************************************/
::METHOD 'xor' -- single_xor                    -- take the exclusive or of a set
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy

if (other~isA(.OrderedCollection)) then do    -- for ordered collections, us the items
    indexes = other~allItems
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end
else if (other~isA(.MapCollection))    -- this includes the SetCollections
    then supplier = other~supplier     -- get the supplier directly
else do
    indexes = other~makearray          -- an arbitrary class supporting makearray
    supplier = .supplier~new(indexes, indexes)  -- create a supplier from the index values
end

do while supplier~available            -- now iterate over the supplier seeing if
    index = supplier~index             -- the item is defined in the target.  If
    if new~hasIndex(index) then        -- not, then we copy into the result collection
        new~remove(index)
    else
        new~put(supplier~item, index)
    supplier~next
end

return new                             -- return the XOR collection

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")

-- the local server class is a hidden class that holds and
-- processes information related to .local
::CLASS "LocalServer"
::METHOD init
  expose input output error

  -- this init method runs once and creates the standard input streams,
  -- which are global across all of the interpreter instances
  input = .stream~new('STDIN')~~command('open')
  output = .stream~new('STDOUT')~~command('open nobuffer')
  error = .stream~new('STDERR')~~command('open nobuffer')
  self~initinstance

-- initinstance is called for every new instance added to the
-- interpreter environment.  This initializes the values in .local
::METHOD initInstance
  expose input output error

  .local~objectname = "The Local Directory"  -- give the local environment a nicer descriptive name.

  -- set up the system objects in the local environment
  .local~setentry('STDIN', input)
  .local~setentry('INPUT',.monitor~new(.stdin))
  .input~objectname = "The INPUT monitor"
  .local~setentry('DEBUGINPUT', .monitor~new(.input))
  .debuginput~objectname = "The DEBUG INPUT monitor"
  .local~setentry('STDOUT', output)
  .local~setentry('OUTPUT',.monitor~new(.stdout))
  .output~objectname = "The OUTPUT monitor"
  .local~setentry('STDERR', error)
  .local~setentry('ERROR', .monitor~new(.stderr))
  .error~objectname = "The ERROR monitor"
  .local~setentry('TRACEOUTPUT',.monitor~new(.error))
  .traceoutput~objectname = "The TRACE OUTPUT monitor"

  .local~setentry('STDQUE',.RexxQueue~new('SESSION'))


-- methods defined for OrderedCollection classes
::CLASS 'OrderedCollection' MIXINCLASS Collection Public
-- abstract methods for ordered insertion/deletion
::method 'insert' ABSTRACT
::method 'delete' ABSTRACT
::method 'append' ABSTRACT
::method 'section' ABSTRACT
::method 'first' ABSTRACT
::method 'last' ABSTRACT
::method 'next' ABSTRACT
::method 'previous' ABSTRACT
::method 'firstItem' ABSTRACT
::method 'lastItem' ABSTRACT

/*****************************************/
/* APPENDALL     method                  */
/*****************************************/
::method 'appendAll' -- ordered_appendall
  use strict arg other

  signal on nomethod

  do item over other~allItems            /* loop over the other collection    */
    self~append(item)                    -- appending the item
  end
  return self

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* DIFFERENCE method                     */
/*****************************************/
::METHOD 'difference'   -- ordered_difference            -- difference between an array and another collection
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- we need to work off of a copy

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

do item over other~allitems            -- loop over the items of the other collection
  new~removeItem(item)                 -- "subtract" this item from the copy
end


if new~isA(.array) then                -- if this is an array, remove sparse entries
    return new~makearray

return new                             -- not an array

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")



/*****************************************/
/* INTERSECTION  method                  */
/*****************************************/
::METHOD 'interSection' -- ordered_intersection          -- take the intersection of arrays
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~class~new                   -- create a new instance of this class
reference = self~copy                  -- we need a reference we can remove stuff from to eliminate dups

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

do item over other~allitems            -- loop over the items in the collection
  if reference~hasitem(item) then do   -- if in both, this goes into the result
      new~append(item)                 -- add to the target collection
      reference~removeItem(item)       -- remove from the reference so we know we've seen this
  end
end

return new                             -- NB, since we started with an empty collection
                                       -- don't need to send the makearray

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* SUBSET        method                  */
/*****************************************/
::METHOD 'subSet' -- ordered_subset                -- do we have a subset?
use strict arg other

signal on nomethod                     -- trap unknown method calls

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end


object = self~copy                     -- get a reference copy
do item over other~allItems            -- loop over the other collection
    object~removeItem(item)            -- remove from the reference
end

return 0=object~items                  -- if nothing left -> proper subset

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* UNION         method                  */
/*****************************************/
::METHOD 'union'  -- ordered_union                 -- take the union of sets
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- copy the original (this removes sparse entries too)

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

do item over other~allItems            -- iterate over all of the items
    new~append(item)                   -- ordered lists behave more like bags...duplicates are allowed.
end

if new~isA(.array) then                -- if this is an array, remove sparse entries
    return new~makearray

return new                             -- not an array

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* XOR        method                     */
/*****************************************/
::METHOD 'xor' -- ordered_xor                   -- take the exclusive or of an array
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- we need to work off of a copy
reference = self~copy                  -- the reference handles adding duplicates

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

do item over other~allitems            -- iterate over the items of the other collection
  if reference~hasItem(item) then      -- in the accumulator collection still?
  do
      new~removeItem(item)             -- remove it
      reference~removeItem(item)       -- remove it from both the accumulator and the ref
  end
  else
  do
      new~append(item)                 -- append to the end of the accumulator
  end
end

if new~isA(.array) then                -- if this is an array, remove sparse entries
    return new~makearray

return new                             -- not an array

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")

/*****************************************/
/* STABLESORT    method                  */
/*****************************************/
::METHOD stablesort
  use strict arg   -- no arguments
  target = self~makearray    -- use the array sort to order things
  target~sort
  current = self~first
  -- copy all of the items back into the sorted collection
  loop i = 1 for target~size
      self[current] = target[i]
      current = self~next(current)
  end
  return self  -- return value is always the collection

/*****************************************/
/* STABLESORTWITH method                 */
/*****************************************/

::METHOD stablesortwith
  use strict arg comparator  -- must have a single comparator
  target = self~makearray    -- use the array sort to order things
  target~sortwith(comparator)
  current = self~first
  -- copy all of the items back into the sorted collection
  loop i = 1 for target~size
      self[current] = target[i]
      current = self~next(current)
  end
  return self  -- return value is always the collection

/*****************************************/
/* SORT          method                  */
/*****************************************/
::METHOD sort
  forward message('STABLESORT') -- just use the stable variety

/*****************************************/
/* SORTWITH      method                  */
/*****************************************/
::METHOD sortwith
  forward message('STABLESORTWITH') -- just use the stable variety

::CLASS 'MapCollection' MIXINCLASS Collection Public
/*****************************************/
/* OF class      method                  */
/*****************************************/
::method OF class
  args = arg(1, 'a')
  -- get the arguments as an array

  -- create an instance of this class
  collection = self~new

  -- process each of the arguments.  Omitted arguments
  -- are not permitted and each argument must be an
  -- array of exactly two items
  loop i = 1 to args~last
     -- no omitted
     if \args~hasIndex(i) then
        raise syntax 93.903 array(i)
     arg = args[i]
     -- get the argument value.
     if \arg~isA(.array) then
        raise syntax 88.923 array(.context~name, i, arg)
     if \arg~dimension == 1 then
        raise syntax 88.923 array(.context~name, i, arg)
     -- this must have just two items
     if arg~items \= 2 | arg~last \= 2 then
        raise syntax 88.924 array(.context~name, i, 2)

     -- the index is first, the value is second, the reverse of PUT
     collection~put(arg[2], arg[1])
  end

  return collection


/*****************************************/
/* PUTALL        method                  */
/*****************************************/
::method 'putAll' -- collection_putall
  use strict arg other
  signal on nomethod

  supplier = other~supplier              /* get an other supplier             */

  do while supplier~available            /* loop over the other collection    */
    self~put(supplier~item, supplier~index)   -- putting the item using the same index
    supplier~next
  end
  return self

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")

-- MapCollections return all of the indices for makeArray
::method 'makeArray'
  return self~allIndexes


::CLASS 'SetCollection' MIXINCLASS Collection Public

-- sort comparison classes.
::CLASS 'Comparable' MIXINCLASS Object Public
::METHOD compareTo
  -- fallback implementation for classes inheriting from Comparable
  -- (see discussion in [bugs:1406])
  use strict arg other
  numeric digits 18
  return (self~identityHash - other~identityHash)~sign

::CLASS 'Comparator' MIXINCLASS Object Public
::METHOD compare
use strict arg left, right
return left~compareTo(right)

::CLASS 'DescendingComparator' MIXINCLASS Comparator Public
::METHOD compare
use strict arg left, right
return -left~compareTo(right)

::CLASS 'CaselessComparator' MIXINCLASS Comparator Public
::METHOD compare
use strict arg left, right
return left~caselessCompareTo(right)

::CLASS 'CaselessDescendingComparator' MIXINCLASS Comparator Public
::METHOD compare
use strict arg left, right
return -left~caselessCompareTo(right)

::CLASS 'ColumnComparator' MIXINCLASS Comparator Public
::METHOD init
expose start length
use strict arg start, length

::METHOD compare
expose start length

use strict arg left, right
return left~compareTo(right, start, length)

::CLASS 'InvertingComparator' MIXINCLASS Comparator Public
::METHOD init
expose comparator
use strict arg comparator

::METHOD compare
expose comparator

use strict arg left, right
return -comparator~compare(left, right)

-- string sorting comparator to order items
-- based on numeric comparison rules
::CLASS 'NumericComparator' MIXINCLASS Comparator Public
::METHOD init
expose precision
use strict arg precision = (digits())

-- use NUMERIC DIGITS to test the validity of the
-- given precision
numeric digits precision

::METHOD compare
expose precision
use strict arg left, right

numeric digits precision
-- the sign from the subtraction result is the correct return
-- value for an ordering comparison.
return sign(left - right)

::CLASS 'CaselessColumnComparator' MIXINCLASS Comparator Public
::METHOD init
expose start length
use strict arg start, length

::METHOD compare
expose start length

use strict arg left, right
return left~caselessCompareTo(right, start, length)



/* ******************************** */
/*    M O N I T O R    C L A S S    */
/* ******************************** */
 /**************************************************************************/
 /* The monitor class will keep track of a stack of destination objects    */
 /* with the last one being the active destination for message sends that  */
 /* are processed by the monitor unknown method.                           */
 /**************************************************************************/

::CLASS 'Monitor' Public

::METHOD init
 /**************************************************************************/
 /* Class  Monitor                                                         */
 /* Method INIT                                                            */
 /* Function                                                               */
 /*        To initialize the monitor object with a destination for any     */
 /*        non-monitor messages                                            */
 /* Input  Destination object                                              */
 /* Output Self (monitor object)                                           */
 /**************************************************************************/
 expose destination
 use strict arg dest = .nil
 destination = .queue~new
 if arg(1,'e') then
   destination~push(dest)
 return

::METHOD destination
 /**************************************************************************/
 /* Class  Monitor                                                         */
 /* Method DESTINATION                                                     */
 /* Function                                                               */
 /*        To stack a destination if one is passed as an argument.         */
 /*        To unstack a destination if no argument is passed in.           */
 /* Input  Destination object                                              */
 /* Output The destination object to be unstacked next after the current   */
 /*        message function is handled                                     */
 /**************************************************************************/
 expose destination
 use strict arg dest = .nil
 if arg(1,'e') then
   destination~push(dest)
 else
   destination~pull
 return destination~peek


::METHOD current
 /**************************************************************************/
 /* Class  Monitor                                                         */
 /* Method CURRENT                                                         */
 /* Function                                                               */
 /*        To return the active destination for this monitor object        */
 /* Input  None                                                            */
 /* Output Current destination object                                      */
 /**************************************************************************/
 expose destination
 use strict arg
 return destination~peek

::METHOD unknown unguarded
 /**************************************************************************/
 /* Class  Monitor                                                         */
 /* Method UNKNOWN                                                         */
 /* Function                                                               */
 /*        To forward any message sends that are not monitor messages      */
 /*        to the currently active destination                             */
 /* Input  Message name and Argument list                                  */
 /* Output Any return from the forwarded message                           */
 /**************************************************************************/
 /* unknown: forward monitored message to destination */
  expose destination
  use strict arg msgname, arglist

  forward to (destination~peek) message (msgname) arguments (arglist)



/* ******************************** */
/*    A L A R M        C L A S S    */
/* ******************************** */
 /**************************************************************************/
 /* The Alarm class provides timing and notification capability by         */
 /* providing a facility to send any message to any object at a given      */
 /* time. A pending alram request can also be cancelled.                   */
 /**************************************************************************/

::CLASS 'Alarm' SUBCLASS object Public

::METHOD init
 /**************************************************************************/
 /* Class  Alarm                                                           */
 /* Method INIT                                                            */
 /* Function                                                               */
 /*        To set up an alarm for a future time 'atime'. At that time      */
 /*        the alarm object sends the message specified by the message     */
 /*        object 'message'.                                               */
 /* Input  atime - a string. Can be specified in 2 formats.                */
 /*        1. 'hh:mm:ss' - An absolute time. At the specified time         */
 /*            the alarm object send the message specified by the message  */
 /*            object.                                                     */
 /*        2. 'secs'     - number of seconds from the present time.        */
 /*        message - a message object                                      */
 /* Output Nothing                                                         */
 /**************************************************************************/

 expose timer canceled msgobj attachment timerStarted eventSemHandle scheduledTime triggered
 timer = 0                             /* set up initial flag states        */
 eventSemHandle = 0
 timerStarted = 0
 canceled = .false
 triggered = .false

 use strict arg atime, msgobj, attachment = .nil

 -- this must be an object that implements the alarm notification interface
 if \msgobj~isA(.AlarmNotification) then
                                       /* have an error                     */
   raise syntax 88.914 array ("target", .AlarmNotification~id)

 current = .DateTime~new               -- get a current time value

 numeric digits 18                     -- we'll be doing math with large numbers potentially

 if atime~isA(.DateTime) then do
     timespan = atime - current        -- get the interval
     scheduledTime = atime             -- save the scheduled time
 end
 else if atime~isA(.TimeSpan) then do  -- already in timespan form?
     timespan = atime                  -- we can use this directly
     scheduledTime = current + atime   -- and get the future time
 end
 else if datatype(atime, 'N') then do  /* just a delta specification?       */
   -- convert seconds into a timespan
   timespan = .timespan~fromSeconds(atime)
   scheduledTime = current + timespan
 end
 else do
   parse var atime intime ' ' indate   /* split into a date and time        */
   SIGNAL ON syntax NAME invalid_time  /* enable a syntax trap              */
   -- fully specified, this is easy
   if indate \= "" then do
       target = .DateTime~fromNormalDate(indate) + .timespan~fromNormalTime(intime)
       timespan = target - current
       scheduledTime = target
   end
   else do
       -- ok, we need to figure out the next location in the future
       target = current~date + .TimeSpan~fromNormalTime(atime)
       -- if this is in the past, then just step to the next day
       if target < current then do
           target = target~addDays(1)
       end
       -- and calculate the interval
       timespan = target - current
       scheduledTime = target
   end
   signal off syntax                   -- stop trapping syntax to invalid_time
 end

 if timespan~sign < 0 then do
    raise syntax 93.951 array (atime~string)
 end

 -- break this into days and remainder
 numdays = timespan~days
 alarmtime = timespan~totalMicroseconds - .TimeSpan~fromDays(numdays)~totalMicroseconds

 -- the remainder needs to be in milliseconds
 alarmtime %= 1000

 guard off                             /* Allow other processess access     */
 reply                                 /* and go concurrent                 */

 self~!startTimer(numdays, alarmtime)  /* Call native method to start timer */
 eventSemHandle = 0                    /* cleared it to indicate (to cancel)*/
                                       /*  That the timer has expired.      */
 guard on                              /* get exclusive use of object       */

 if \canceled then do                  /* is the timer canceled?            */
   triggered = .true
   -- run the message, but any errors propagate through
   msgobj~triggered(self)
 end
 exit

 invalid_time:
   signal on syntax
   raise syntax 93.951 array (atime)   /* Invalid alarmtime                 */

 exception:                            /* define exception handler          */
 syntax:
   raise propagate                     /* just propagate the error          */

-- read-only access to the attachment object.
::attribute attachment GET UNGUARDED
-- and also to the scheduled time
::attribute scheduledTime GET UNGUARDED
::attribute canceled GET UNGUARDED
::method cancelled UNGUARDED
  expose canceled
  use strict arg
  return canceled

::attribute triggered GET


::METHOD !startTimer PRIVATE unguarded EXTERNAL 'LIBRARY REXX alarm_startTimer'

 /**************************************************************************/
 /* Class  Alarm                                                           */
 /* Method CANCEL                                                          */
 /* Function                                                               */
 /*        To cancel a pending alarm request represented by the receiver.  */
 /*        This method taken no action if the timer has already expired.   */
 /* Input  none                                                            */
 /* Output Nothing                                                         */
 /**************************************************************************/

::METHOD cancel unguarded
 expose canceled eventSemHandle timerStarted msgObj
 use strict arg

 guard on  when timerStarted              /* Wait until timer is actually set  */
                                          /* if time hasn't expired?           */
 if eventSemHandle \= 0 then
   do
                                          /* cancel the timer.                 */
      canceled = .true
      self~!stopTimer(eventSemHandle)
      -- notify the alarm target
      msgObj~cancel(self)
   end
 return

::METHOD !stopTimer PRIVATE unguarded EXTERNAL 'LIBRARY REXX alarm_stopTimer'


/* ******************************** */
/*    T I C K E R      C L A S S    */
/* ******************************** */

-- Ticker sends notification messages to a notification target each time
-- the trigger interval expires and when the trigger is cancelled.
::class Ticker public

-- initialize a ticker object
::METHOD init
 expose canceled target attachment eventSemHandle interval
 eventSemHandle = 0
 canceled = .false
 use strict arg interval, target, attachment = .nil

 -- the notification target must implement the AlarmNotification interface
 .Validate~classType("target", target, .AlarmNotification)

 numeric digits 18                     -- we'll be doing math with large numbers potentially
 if interval~isA(.TimeSpan) then nop   -- already in timespan form?  everything is set up
 -- just a seconds specification?  convert to a Timespan
 else if datatype(interval, 'N') then do
   interval = .timespan~fromSeconds(interval)
 end
 -- this is an invalid time
 else raise syntax 93.951 array (interval)

 if interval~sign < 0 then do
    raise syntax 93.951 array (interval)
 end

 -- break this into days and remainder
 numdays = interval~days
 alarmtime = interval~totalMicroseconds - .TimeSpan~fromDays(numdays)~totalMicroseconds

 -- the remainder needs to be in milliseconds
 alarmtime = (alarmtime + 500) % 1000

 self~!createTimer -- sets timerStarted to .true and the eventSemHandle pointer

 -- release the guard lock and go concurrent
 guard off
 reply

 -- keep pinging until this is canceled
 loop while \canceled
    -- wait the interval
    self~!waitTimer(eventSemHandle, numdays, alarmtime)
    -- get exclusive access again
    guard on
    -- if not canceled, poke the target object
    if \canceled then do
      -- run the message, but any errors propagate through
      target~triggered(self)
    end
    guard off -- allow cancel() to eventually run
 end
 exit

-- read-only access to the attachment object.
::attribute attachment GET UNGUARDED
-- and also to the scheduled time
::attribute interval GET UNGUARDED
::attribute canceled GET UNGUARDED
::method cancelled UNGUARDED
  expose canceled
  use strict arg
  return canceled

::METHOD !createTimer PRIVATE unguarded EXTERNAL 'LIBRARY REXX ticker_createTimer'
::METHOD !waitTimer PRIVATE unguarded EXTERNAL 'LIBRARY REXX ticker_waitTimer'
::METHOD !stopTimer PRIVATE unguarded EXTERNAL 'LIBRARY REXX ticker_stopTimer'

-- cancel a ticker
::METHOD cancel unguarded
 expose canceled eventSemHandle target
 use strict arg

 if eventSemHandle == 0 then
   return

 -- indicate we're canceled and stop the timer
 canceled = .true
 self~!stopTimer(eventSemHandle)
 -- indicate this is cleared
 eventSemHandle = 0
 -- notify the Ticker target
 target~cancel(self)



   -- circular buffer (round-robin queue) of a defined size
::CLASS 'CircularQueue' subclass queue public


::method of class

  storage=self~new(arg())     -- create a circular queue of appropriate size

  do i=1 to arg()
     storage~queue(arg(i))    -- place item object into the circular queue
  end
  return storage              -- return instance


::method init                 -- create an instance, memorizes the size
  expose size
  use strict arg size

  -- check for whole number >= 0, raise error
  if datatype(size, "Whole")=.false | size<0  then
     raise syntax 93.906 array ("size", size)

  self~init:super
  return


::METHOD size                 -- return size
  expose size
  use strict arg
  return size


::METHOD resize               -- allow to resize the circularQueue
  expose size

  use strict arg newSize, order = "F"

   -- check for whole number >= 0, raise error
   if datatype(newSize, "Whole")=.false | newSize<0  then
      raise syntax 93.906 array (1, arg(1))

   order = order~upper~left(1)

   if pos(order, "FL")=0 then  -- oops: not a valid argument!
      raise syntax 93.914 array (2, '"F" (FIFO) or "L" (LIFO)', arg(2))


   if newSize < self~items then -- too many items, we need to remove the superfluous ones
   do
      removeNr=self~items - newSize -- number of elements to remove

      if order="L" then       -- LIFO: remove the newest entries (keep the oldest)
         idx=newSize + 1      -- determine the index to which (includingly) the removes need to take place
      else                    -- FIFO: remove the oldest entries (keep the newest)
         idx=1                -- remove the first element(s)

      do removeNr             -- repeat removal
         self~remove(idx)     -- remove item
      end
   end
   size=newSize               -- remember new size
   return newSize             -- return the new size

-- override of the insert method to ensure we don't override the size
::method insert
  expose size

  forward class(super) continue
  newIndex = result           -- make sure we preserve the return value

                              -- if this caused us to move beyond the queue size, delete the last item
  if self~items > size then self~remove(self~last)

  return newIndex

::METHOD queue                -- put an element into the queue, possibly replacing an existing one
  expose size

  use strict arg item, option = "Normal"

  if size=0 then return .nil  -- size is 0, do not process!

  if option~caselessMatchChar(1,'u')    -- if option is unique remove any instances extant
  then do while self~hasItem(item)
          self~removeItem(item)
       end

  if self~items >= size then
     ret = self~pull           -- if we've gone over the size, remove this
  else
     ret = .nil               -- return value a .nil to indicate that we were not forced to remove an existing item

  forward class (super) continue array (item) -- allow the superclass to handle adding the item
  return ret                  -- return pulled item

::METHOD push
  expose size
  use strict arg item, option = "Normal"

  if size=0 then return .nil  -- size is 0, do not process !

  if option~caselessMatchChar(1,'u')    -- if option is unique remove any instances extant
  then do while self~hasItem(item)
          self~removeItem(item)
       end

  if self~items >= size then
     ret = self~remove(self~items)   -- remove the end item.
  else
     ret = .nil                     -- return value a .nil to indicate that we were not forced to remove an existing item

  forward class (super) continue array (item)   -- allow the superclass to handle adding the item
  return ret                      -- return removed item

-- check to see if we need to remove an item before appending.
::METHOD append
  expose size
  use strict arg item

  if size=0 then return .nil  -- size is 0, do not process!

  if self~items >= size then
     ret = self~pull           -- if we've gone over the size, remove this

  forward class(super) -- allow the superclass to handle adding the item

::METHOD section
  expose size
  use strict arg index, count = (size)   -- the default is to return everything.  This essentially becomes a rotate

   if datatype(count, "Whole") = .false | count < 0  then
      raise syntax 93.906 array (2, count)

   count = min(size, count)  -- cap at the number of items

   newqueue = self~class~new(count)

   do while count > 0
      newqueue~queue(self[index])
      index += 1
      if index > size then index = 1  -- handle wrap arounds
      count -= 1
   end

   return newqueue

-----------------------------


::method makearray            -- return a supplier object
  expose size storage

  use strict arg order="F"

  order = order~upper~left(1)

  if pos(order, "FL")=0 then  -- oops: not a valid argument!
     raise syntax 93.914 array (1, '"F" (FIFO) or "L" (LIFO)', arg(1))

  if order="L" then           -- in LIFO (last-in, first-out) order (stack-like)
  do
     aCopy=self~copy          -- work on a copy (= snapshot)
     items=aCopy~items        -- get number of items
     valArr=.array~new(items)
     k=0
     do i=items to 1 by -1
        k=k+1
        valArr[k]=aCopy~at(i)
     end
     return valArr
  end
  else
  do
     arr=.array~new(0)
     FORWARD class (super) arguments (arr)-- forward to superclass, remove possible argument
     -- FORWARD class super array ()-- forward to superclass, remove possible argument
  end

::method supplier             -- return a supplier object
  expose size

  use strict arg order="F"

  order = order~upper~left(1)
  if pos(order, "FL")=0 then  -- oops: not a valid argument!
     raise syntax 93.914 array (1, '"F" (FIFO) or "L" (LIFO)', arg(1))

  if order="L" then           -- in LIFO (last-in, first-out) order (stack-like)
  do
     aCopy=self~copy          -- work on a copy (= snapshot)
     items=aCopy~items        -- get number of items
     valArr=.array~new(items) -- create value (item) array
     idxArr=.array~new(items) -- create index array
     k=0
     do i=items to 1 by -1    -- iterate through circular queue
        k=k+1
        valArr[k]=aCopy~at(i)
        idxArr[k]=i
     end
     return .supplier~new(valArr, idxArr)
  end
  else                        -- let the superclass create and return the supplier object
  do
     FORWARD class (super) array ()-- forward to superclass, remove possible argument
  end

::method makeString
  forward message "STRING"

::method string               -- create a string representation, using the optional delimiter
  expose size
  use strict arg delimiter = ",", order = "F"

  if \order~caselessStartsWith("F"), \order~caselessStartsWith("L") then
     raise syntax 93.914 array (2, '"F" (FIFO) or "L" (LIFO)', arg(2))

  return self~makeArray(order)~toString(, delimiter)

/*****************************************/
/* UNION         method                  */
/*****************************************/
::METHOD 'union'  -- circularqueue union
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~copy                        -- copy the original (this removes sparse entries too)

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

                                       -- the copy is the same size as the orignal.
                                       -- we need to make sure we don't lose anything.
if self~size < self~items + other~items then new~resize(self~items + other~items)

                                       -- ordered lists behave more like bags...duplicates are allowed.
new~appendAll(other~allItems)          -- append all of the other collection
return new                             -- and return the collected object

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")


/*****************************************/
/* XOR        method                     */
/*****************************************/
::METHOD xor   -- union xor
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~allItems                    -- we need to work off of a copy (as an array)
reference = self~copy                  -- the reference handles adding duplicates

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

do item over other~allitems            -- iterate over the items of the other collection
  if reference~hasItem(item) then      -- in the accumulator collection still?
  do
      new~removeItem(item)             -- remove it
      reference~removeItem(item)       -- remove it from both the accumulator and the ref
  end
  else
  do
      new~append(item)                 -- append to the end of the accumulator
  end
end
                                       -- make sure we have enough room to hold all of the
                                       -- items
newQueue = self~class~new(max(self~size, new~items))
newQueue~appendAll(new)

return newQueue

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")

/*****************************************/
/* INTERSECTION  method                  */
/*****************************************/
::METHOD interSection -- intersection for a circularqueue
use strict arg other

signal on nomethod                     -- trap unknown method calls

new = self~class~new(self~size)        -- create a new instance of this class
reference = self~copy                  -- we need a reference we can remove stuff from to eliminate dups

if \other~isA(.Collection) then do     -- if not a collection, then ask for an
    other = other~makearray            -- array value and use that as the iterator
end

do item over other~allitems            -- loop over the items in the collection
  if reference~hasitem(item) then do   -- if in both, this goes into the result
      new~append(item)                 -- add to the target collection
      reference~removeItem(item)       -- remove from the reference so we know we've seen this
  end
end

return new                             -- NB, since we started with an empty collection
                                       -- don't need to send the makearray

nomethod:
      -- an unknown method is an argument problem.  report it as such.
  raise syntax 93.948 array(1, "Collection")

::CLASS 'Properties' subclass Directory public
::METHOD load class
  use arg input
  properties = .properties~new
  forward to (properties) continue
  return properties


-- load a properties object from a stream.  The source can be
-- a string name of a file, a .File object, or a stream object.
::METHOD load
  use strict arg input

  -- if a string name or a file, create a stream object and close
  -- once we are done.
  if input~isA(.string) | input~isA(.File) then
  do
     stream=.stream~new(input)      -- create stream object
     self~load(stream)              -- load its properties
     stream~close                   -- close stream
     return
  end

  signal on notready

  do forever
     line = input~linein~strip('L')
     -- ignore comment lines
     if line == "" | line~substr(1, 2) == "--" then
         iterate
     parse var line name '=' value
     name = name~strip

     self~put(value, name)

  end
  -- hit EOF, just return
  notready:
  return

-- save a properties object to a file.  The target can be
-- a string name of a file, a .File object, or a stream object.
::METHOD save
  use strict arg output

  -- if a string name or a file, create a stream object and close
  -- once we are done.
  if output~isA(.string) | output~isA(.File) then
  do
     stream=.stream~new(output)     -- create stream object
     stream~open("WRITE REPLACE")   -- make sure we open in replace mode
     self~save(stream)              -- load its properties
     stream~close                   -- close stream
     return
  end

  supplier = self~supplier

  do while supplier~available
      name = supplier~index
      value = supplier~item

      output~lineout(name||"="||value)

      supplier~next
  end


::METHOD setProperty
  use strict arg name, value

  value = value~request('STRING')

  if value~isNil then do
     raise syntax 93.938 array (2)  -- raise an error
  end

  self~put:super(value, name)


::METHOD getProperty
  use strict arg name, default=.nil

  value = self~at(name)
  if value~isNil then do
      if arg(2, 'e') then
          value = default
  end

  return value

::METHOD setWhole
  use strict arg name, value

  if \value~datatype('W') then
     raise syntax 93.905 array (2, value)  -- raise an error

  forward message 'SETPROPERTY'


::METHOD getWhole
  forward message 'GETPROPERTY' continue

  value = result
  if \datatype(value, 'W') then
     raise syntax 26.901 array (value)  -- raise an error

  return value


::METHOD setLogical
  use strict arg name, value

  if \value~datatype('O') then
     raise syntax 34.901 array (value) -- Logical value must be exactly "0" or "1"

  args = arg(1, 'A')
  if value then
     args[2] = "true"
  else
     args[2] = "false"

  forward message 'SETPROPERTY' arguments (args)


::METHOD getLogical
  forward message 'GETPROPERTY' continue

  value = result
  if value == '1' | value == 'true' then
      return .true
  else if value == '0' | value == 'false' then
      return .false
  raise syntax 34.904 array (value)  -- raise an error


::METHOD "[]="
  use strict arg value, name

  value = value~request('STRING')

  if value~isNil then do
     raise syntax 93.938 array (1)  -- raise an error
  end

  forward class (super) array (value, name)


::METHOD put
  use strict arg value, name

  value = value~request('STRING')

  if value~isNil then do
     raise syntax 93.938 array (1)  -- raise an error
  end

  forward class (super) array (value, name)



::CLASS 'DateTime' public inherit Comparable Orderable

-- return the DateTime for the earliest time in the Rexx calendar system
::METHOD minDate class
  use strict arg
  -- this is returned in utc
  return self~new(1, 1, 1, 0)

-- return the DateTime for the end of the supported Rexx calendar system
::METHOD maxDate class
  use strict arg
  -- this is returned in UTC
  return self~new(9999, 12, 31, 23, 59, 59, 999999, 0)

-- return a DateTime object for today's date, and a time
-- of 00:00:00.000000
::METHOD today class
  use strict arg offset=(time('O')/60000000)
  -- just grab the date in standard format and convert
  return self~fromStandardDate(date('s'),, offset)

-- Create a DateTime object from a Normal date string.  An optional
-- separator character can be specified.
::METHOD fromNormalDate class
  use strict arg date, sep = (" "), offset=(time('O')/60000000)

  signal on syntax
  return self~new(date('F', date, 'N', , sep), offset)

  syntax:
  raise syntax 88.918 array("date", date)


-- Create a DateTime object from a European date string.  An optional
-- separator character can be specified.
::METHOD fromEuropeanDate class
  use strict arg date, sep = ("/"), offset=(time('O')/60000000)
  signal on syntax
  return self~new(date('F', date, 'E', , sep), offset)

  syntax:
  raise syntax 88.918 array("date", date)


-- Create a DateTime object from an Ordered date string.  An optional
-- separator character can be specified.
::METHOD fromOrderedDate class
  use strict arg date, sep = ("/"), offset=(time('O')/60000000)
  signal on syntax
  return self~new(date('F', date, 'O', , sep), offset)

  syntax:
  raise syntax 88.918 array("date", date)


-- Create a DateTime object from a Standard date string.  An optional
-- separator character can be specified.
::METHOD fromStandardDate class
  use strict arg date, sep = (""), offset=(time('O')/60000000)
  signal on syntax
  return self~new(date('F', date, 'S', , sep), offset)

  syntax:
  raise syntax 88.918 array("date", date)


-- Create a DateTime object from a Usa date string.  An optional
-- separator character can be specified.
::METHOD fromUsaDate class
  use strict arg date, sep = ("/"), offset=(time('O')/60000000)
  signal on syntax
  return self~new(date('F', date, 'U', , sep), offset)

  syntax:
  raise syntax 88.918 array("date", date)


-- Create a DateTime object from a Normal time string.
::METHOD fromNormalTime class
  use strict arg time, offset=(time('O')/60000000)
  signal on syntax
  return self~new(time('F', time, 'N'), offset)

  syntax:
  raise syntax 88.918 array("time", time)


-- Create a DateTime object from a Civil time string.
::METHOD fromCivilTime class
  use strict arg time, offset=(time('O')/60000000)
  signal on syntax
  return self~new(time('F', time, 'C'), offset)

  syntax:
  raise syntax 88.918 array("time", time)

-- Create a DateTime object from a Long time string.
::METHOD fromLongTime class
  use strict arg time, offset=(time('O')/60000000)
  signal on syntax
  return self~new(time('F', time, 'L'), offset)

  syntax:
  raise syntax 88.918 array("time", time)


-- Create a DateTime object from a ISO date/time string.
::METHOD fromIsoDate class
  use strict arg _date, offset=(time('O')/60000000)
  parse var _date date 'T' time
  numeric digits 18

  signal on syntax
  return self~new(date('F', date, 'S',,"-") + time("F", time, "L"), offset)

  syntax:
  raise syntax 88.918 array("date", _date)

-- Create a DateTime object from a UTC ISO date/time string.
::METHOD fromUtcIsoDate class
  use strict arg basetime
  parse var basetime date 'T' time

  signal on syntax
  if time~right(1) == 'Z' then do
      offset = 0
      time = time~left(time~length - 1)
  end
  else if time~pos('+') > 0 then do
      parse var time time '+' hours ":" minutes
      offset = hours * 60 + minutes
  end
  else if time~pos('-') > 0 then do
      parse var time time '-' hours ":" minutes
      offset = -(hours * 60 + minutes)
  end

  -- our standard format uses 6 digits for the fraction,
  -- but the standard also allows for just 2 or even omitted,
  -- so pad it out to a long time format
  parse var time base '.' fraction
  time = base'.'fraction~left(6, '0')

  numeric digits 18
  -- create the date time object the adjusted time and offset
  return self~new(date('F', date, 'S',,"-") + time("F", time, "L"), offset)

  syntax:
  raise syntax 88.918 array("date", basetime)


-- parse a week number date in either basic ISO format yyyyWwwd
-- or extended ISO format yyyy-Www-d into a date object
::METHOD fromWeekNumberDate class
   use strict arg _date, offset=(time('O')/60000000)
   if _date~contains("-") then
       parse var _date year "-W" weekNumber "-" dayNumber
   else
       parse var _date year "W" +1 weekNumber +2 dayNumber

   signal on syntax

   -- to calculate the start of W01 we use January 4th which is always
   -- a day within W01. Then the start of W01 is -pivot~weekDay
   pivot = self~new(year, 1, 4)

   -- now we need to validate all date components
   -- WholeNumber validation isn't enough here, we don't accept e. g. 1e03
   -- we also require fixed lengths with leading zeros
   if year~verify("0123456789") \= 0 | year~length \= 4 |,
      weekNumber~verify("0123456789") \= 0 | weekNumber~length \= 2 |,
      weekNumber < 1 | weekNumber > pivot~weeksInYear |,
      dayNumber~verify("0123456789") \= 0 | dayNumber~length \= 1 |,
      dayNumber < 1 | dayNumber > 7 then
       signal syntax

   -- we calculate the offset in days relative to pivot day
   offset = (weekNumber - 1) * 7 + dayNumber - pivot~weekDay
   -- even if the offset is negative or larger than 365, addDays will handle
   -- Note that due to good fortune, the week number date for Jan 1, 0001
   -- is 0001-W01-1, so we will never have to deal with the year 0000.
   -- Also, December 31, 9999 has a weekNumberDate of 9999-W52-5, so we
   -- never have to deal with a valid date requiring 5 digits for the year.
   -- We will still raise syntax if we get a request for 9999-W52-6 or -7
   return pivot~addDays(offset)

   syntax:
   raise syntax 88.918 array("date", _date)

-- create a DateTime instance from an ISO ordinal date either in
-- extended format yyyy-ddd or in basic format yyyyddd
::METHOD fromOrdinalDate class
   use strict arg _date, offset=(time('O')/60000000)
   if _date~contains("-") then
       parse var _date year "-" ordinal
   else
       parse var _date year +4 ordinal

   signal on syntax

   -- we get a datetime object based on the first day of the year. We need this so we
   -- can determine if the ordinal value is within the range for this year
   base = .datetime~new(year, 1, 1, offset)

   -- now we need to validate all date components
   -- WholeNumber validation isn't enough here, we don't accept e. g. 1e03
   -- we also require fixed lengths with leading zeros
   if year~verify("0123456789") \= 0 | year~length \= 4 |,
      ordinal~verify("0123456789") \= 0 | ordinal~length \= 3 |,
      ordinal < 1 | ordinal > base~daysInYear then
       signal syntax

   -- the easiest way to calculate this is to add an offset from the first of the year
   return base~addDays(ordinal - 1)

   syntax:
   raise syntax 88.918 array("date", _date)


-- Create a DateTime object from Unix Ticks value
::METHOD fromTicks class
  use strict arg date, offset=(time('O')/60000000)
  signal on syntax
  return self~new(date('F', date, 'T'), offset)

  syntax:
  raise syntax 88.918 array("ticks", date)


-- Create a DateTime object from a basedate value
::METHOD fromBaseDate class
  use strict arg date, offset=(time('O')/60000000)
  signal on syntax
  return self~new(date('F', date, 'B'), offset)

  syntax:
  raise syntax 88.918 array("date", date)


-- initialize a DateTime instance.  There are multiple forms of this:
--
-- init(fulltime<,offset>)
--      input is a full time number such as returned from date('f')
-- init(year, month, day<,offset>)
--      initialize from a year/month/day value.  The time will be set to
--      00:00:00.000000 of the current date
-- init(year, month, day, hours, minutes, seconds, microseconds<,offset>)
--      initialize from a fully specified time specification.  The microseconds
--      are optional and default to zero.
::METHOD init
  numeric digits 18    -- need higher digits for time calculations

  argCount = arg()
  select
      when argCount == 0 then do
          -- no arguments, use current time and local timezone offset
          self~setTimeStamp(date('Full'), time('O')/60000000)
      end
      when argCount <= 2 then do    -- just create from a microseconds value
          use strict arg timestamp, offset=(time('O')/60000000)
          -- seems silly, but this validates the time
          self~setTimeStamp(date('f', timestamp, 'f'), offset)
      end
      when argCount <= 4 then do
          -- year month day to microseconds value
          use strict arg year, month, day, offset=(time('O')/60000000)

          -- format into a convertable date
          self~setTimeStamp(self~convertDate(year, month, day), offset)
      end
      -- only other format is everything, except for optional seconds and microseconds.
      otherwise
          -- starting with year, month, day, hours, minutes, seconds
          use strict arg year, month, day, hours, minutes, seconds = 0, usecs = 0, offset=(time('O')/60000000)

          timestamp = self~convertDate(year, month, day) + self~convertTime(hours, minutes, seconds, usecs)
          self~setTimeStamp(timestamp, offset)
  end

-- private method to adjust the date's timestamp and timezone information during construction
::METHOD setTimeStamp private
  expose utctimestamp timestamp offset
  use arg timestamp, offset

  numeric digits 18
  -- if offset is a timespan, then grab the number of microseconds in the
  -- span, retaining the sign
  if offset~isa(.TimeSpan) then
      offset = offset~totalMicroseconds / 60000000
  -- as of today, world time zone offsets range from -12:00 to +14:00
  -- for good measure we allow offsets between -15:00 and +15:00
  .Validate~wholeNumberRange("offset", offset, -900, 900)
  -- we need to convert from minutes to microseconds
  offset = offset * 60000000

  -- adjust the internal timestamp back to UTC
  utctimestamp = timestamp - offset

-- private utility method to get a full date value from year/month/day.
::METHOD convertDate private
  use arg year, month, day
  .Validate~wholeNumberRange("year", year, 1, 9999)
  .Validate~wholeNumberRange("month", month, 1, 12)
  .Validate~wholeNumberRange("day", day, 1, 31)

  date = year~right(4, '0')month~right(2, '0')day~right(2, '0')
  return date('F', date, 'S')

-- private utility method to get a full time value from an hour/minute/second/microseconds set.
::METHOD convertTime private
  use arg hours, minutes, seconds, usecs = 0

  .Validate~wholeNumberRange("hours", hours, 0, 23)
  .Validate~wholeNumberRange("minutes", minutes, 0, 59)
  .Validate~wholeNumberRange("seconds", seconds, 0, 59)
  .Validate~wholeNumberRange("microseconds", usecs, 0, 999999)

  time = hours~right(2, '0')':'minutes~right(2, '0')':'seconds~right(2, '0')'.'usecs~right(6, '0')
  return time('f', time, 'l')


-- perform a sort comparison of two datetimes
::METHOD compareTo
  expose utcTimeStamp

  use strict arg other

  if \other~isA(.DateTime) then
    forward class (super) -- let the default implementation handle this

  othertime = other~utcDate

  numeric digits 18
  -- just pick up the sign value of the subtraction
  return (utcTimeStamp - othertime)~sign

-- return the year value of the datetime.
::METHOD year
  expose timestamp
  use strict arg    -- enforces no arguments
  return date('Standard', timestamp, 'Full')~substr(1, 4)

-- return the month value of the datetime
::METHOD month
  expose timestamp
  use strict arg    -- enforces no arguments
  -- NB make sure the leading zeros are stripped
  return date('Standard', timestamp, 'Full')~substr(5, 2) + 0

-- return the day value of the datetime
::METHOD day
  expose timestamp
  use strict arg    -- enforces no arguments
  -- NB make sure the leading zeros are stripped
  return date('Standard', timestamp, 'Full')~substr(7, 2) + 0

-- return the hours value of the datetime
::METHOD hours
  expose timestamp
  use strict arg    -- enforces no arguments
  return time('Hours', timestamp, 'Full')

-- return the minutes value of the datetime
::METHOD minutes
  expose timestamp
  use strict arg    -- enforces no arguments
  return time('Minutes', timestamp, 'Full') // 60

-- return the seconds value of the datetime
::METHOD seconds
  expose timestamp
  use strict arg    -- enforces no arguments
  return time('Seconds', timestamp, 'Full') // 60

-- return the microseconds value of the datetime
::METHOD microseconds
  expose timestamp
  use strict arg    -- enforces no arguments

  parse value time('Long', timestamp, 'Full')  with '.' microseconds
  return microseconds + 0

-- return the number of minutes since 00:00:00.000000
::METHOD dayMinutes
  expose timestamp
  use strict arg    -- enforces no arguments
  return time('Minutes', timestamp, 'Full')

-- return the number of seconds since 00:00:00.000000
::METHOD daySeconds
  expose timestamp
  use strict arg    -- enforces no arguments
  return time('Seconds', timestamp, 'Full')

-- return the number of microseconds since 00:00:00.000000
::METHOD dayMicroseconds
  expose timestamp
  use strict arg    -- enforces no arguments
  numeric digits 18

  return self~daySeconds * 1000000 + self~microseconds

-- hashcode override for MapCollection interaction.
::METHOD hashCode
  expose timestamp
  use strict arg    -- enforces no arguments
  return timestamp~hashcode

-- perform subtraction between two datetime objects or a datetime
-- object and a timespan object.  The original object is left unchanged
-- and new instance is returned.
--
-- Prefix minus has no meaning, and will result in an error.
::METHOD "-"
  expose timeStamp utcTimeStamp

  numeric digits 18     -- need this to do math on the value

  -- could be a prefix "-", but we'll treat it as dyadic

  -- actual subtraction op
  use strict arg other

  -- "-" is not commutative with .DateTime.  We don't support
  -- subtracting a time from a TimeStamp.  The reverse operation,
  -- however, makes sense.
  if other~isa(.timespan) then do
      -- subtract the timespan from this class
      return self~class~new(timestamp - other~totalMicroseconds)
  end
  -- subtracting two dates
  else if other~isa(.datetime) then do
      -- perform the math using the big numbers...the result may be negative
      -- we also use the UTC time, since these might represent different timezones
      return .timespan~new(utcTimeStamp - other~utcDate)
  end

  raise syntax 88.914 array("subtractor", "DateTime or TimeSpan")


-- add a datetime instance to a timespan instance, returning a new datetime.
::METHOD "+"
  expose timestamp

  numeric digits 18     -- need this to do math on the value

  -- could be a prefix "+"
  if arg() == 0 then do
      -- this is pretty meaningless, but less so than
      -- prefix -.  We'll just make this a noop and return a copy of ourselves
      return self~class~new(timestamp, self~offset)
  end

  -- ok, actually addition.  We require a timespan.  Trying to add
  -- 2 dates is pretty meaningless
  use strict arg other

  -- When adding a timespan, the result is a datetime.
  if other~isa(.timespan) then do
      -- combine the two intervals, using the same timezone value
      return self~class~new(timestamp + other~totalMicroseconds, self~offset)
  end

  raise syntax 93.948 array(1, "TimeSpan")


-- Add a number of years to a datetime object, returning a new object
-- instance.  Leap years are accounted for, and if the resulting date
-- will be February 29th in a non-leap year, the day is rolled back to the
-- 28th.
::METHOD addYears
  expose timestamp
  use strict arg years

  .Validate~wholeNumber("years", years)

  -- This is easier to deal with if we split the date and time into
  -- two components first
  basedate = self~date
  dayoffset = self~timeofday

  year = basedate~year
  month = basedate~month
  day = basedate~day

  year += years

  -- if we're on Feb 29th, then we have a leap day problem to deal with
  -- we need to check to see if the resulting year will be a leap year
  -- or not.  If it is, we're fine, otherwise we have to step back to the
  -- 28th.
  if month = 2, day = 29 then do
      -- test for the leap year on the new target
      if year // 4 == 0, ((year // 100 \= 0) | (year // 400 == 0))  then nop
      else do
          day -= 1
      end
  end

  -- now adjust that component by the corresponding years
  newDate = self~class~new(year, month, day, self~offset)

  -- and finally recombine with the time to get the adjusted timestamp
  return newDate + dayoffset

-- Add a number of 7-day units to the datetime, returning a new instance
::METHOD addWeeks
  expose timestamp
  use strict arg weeks

  .Validate~number("weeks", weeks)

  numeric digits 18
  -- return a new instance of DateTime
  return self~class~new(trunc(timestamp + weeks * (7 * 24 * 3600 * 1000000)), self~offset)


-- Add a number of days to a datetime, returning a new datetime instance.
::METHOD addDays
  expose timestamp
  use strict arg days

  .Validate~number("days", days)

  numeric digits 18
  -- return a new instance of DateTime
  return self~class~new(trunc(timestamp + days * (24 * 3600 * 1000000)), self~offset)


-- Add a number of hours to a datetime, returning a new datetime instance.
::METHOD addHours
  expose timestamp
  use strict arg hours

  .Validate~number("hours", hours)

  numeric digits 18

  -- return a new instance of DateTime.
  -- NB, we trunk the value, as it's possible to add non-whole numbers of
  -- these units.
  return self~class~new(trunc(timestamp + (hours * (3600 * 1000000))), self~offset)


-- Add a number of minutes to a datetime, returning a new datetime instance.
::METHOD addMinutes
  expose timestamp
  use strict arg minutes

  .Validate~number("minutes", minutes)

  numeric digits 18

  -- return a new instance of DateTime
  -- NB, we trunk the value, as it's possible to add non-whole numbers of
  -- these units.
  return self~class~new(trunc(timestamp + (minutes * (60 * 1000000))), self~offset)


-- Add a number of seconds to a datetime, returning a new datetime instance.
::METHOD addSeconds
  expose timestamp
  use strict arg seconds

  .Validate~number("seconds", seconds)

  numeric digits 18

  -- return a new instance of DateTime
  -- NB, we trunk the value, as it's possible to add non-whole numbers of
  -- these units.
  return self~class~new(trunc(timestamp + (seconds * 1000000)), self~offset)


-- Add a number of microseconds to a datetime, returning a new datetime instance.
::METHOD addMicroseconds
  expose timestamp
  use strict arg usecs

  .Validate~number("microseconds", usecs)

  numeric digits 18

  -- return a new instance of DateTime
  -- NB, we trunk the value, as it's possible to add non-whole numbers of
  -- these units.
  return self~class~new(trunc(timestamp + usecs), self~offset)

-- Format the datetime into ISO format, yyyy-mm-ddT00:00:00.000000
::METHOD isoDate
  expose timestamp
  use strict arg
  return date("S",timestamp,"F","-")"T"time("L", timestamp, "F")

-- Format the datetime into full ISO format, yyyy-mm-ddT00:00:00.000000+hh:mm
::METHOD utcIsoDate
  expose timeStamp offset
  use strict arg
  base = date("S", timeStamp, "F", "-")"T"time("L", timeStamp, "F")
  if offset = 0 then
     return base||'Z'  -- this is Zulu time
  numeric digits 18
  -- we only append hours and minutes, so pull that out
  minutes = offset / (1000000 * 60)
  if minutes < 0 then do
     sign = '-'
     minutes = -minutes
  end
  else sign = '+'

  hours = minutes%60
  minutes = minutes//60
  --this returns the padded value
  return base||sign||right(hours, 2, '0')||":"||right(minutes, 2, '0')

-- Return the basedate for this datetime instance.
::METHOD baseDate
  expose timestamp
  use strict arg
  return date("B", timestamp, "F")

-- Return the day number within the year.
::METHOD yearDay
  expose timestamp
  use strict arg
  return date("D", timestamp, "F");

-- Format the datetime into European format, dd/mm/yy.  An optional
-- separator may be specified.
::METHOD europeanDate
  expose timestamp
  use strict arg sep = ("/")
  return date("E", timestamp, "F", sep);

-- Format the datetime into the Language format.
::METHOD languageDate
  expose timestamp
  use strict arg
  return date("L", timestamp, "F");

-- Return the name of the current month, in English
::METHOD monthName
  expose timestamp
  use strict arg
  return date("M", timestamp, "F");

-- Return the day of the week, in English
::METHOD dayName
  expose timestamp
  use strict arg
  return date("W", timestamp, "F");


-- Format the datetime into Normal format, 1 Sep 2007.  An optional
-- separator may be specified.
::METHOD normalDate
  expose timestamp
  use strict arg sep = (" ")
  return date("N", timestamp, "F", sep);


-- Format the datetime into Ordered format, yy/mm/dd.  An optional
-- separator may be specified.
::METHOD orderedDate
  expose timestamp
  use strict arg sep = ("/")
  return date("O", timestamp, "F", sep);


-- Format the datetime into Standard format, yyyymmdd.  An optional
-- separator may be specified.
::METHOD standardDate
  expose timestamp
  use strict arg sep = ("")
  return date("S", timestamp, "F", sep);

-- Format the datetime into USA format, mm/dd/yy.  An optional
-- separator may be specified.
::METHOD usaDate
  expose timestamp
  use strict arg sep = ("/")
  return date("U", timestamp, "F", sep);

-- Format the date into the ISO week number format, yyyy-Www-d
::METHOD weekNumberDate
  use strict arg

  return right(self~weekNumberYear, 4, '0')"-W"right(self~weekNumber, 2, '0')"-"self~weekDay

-- return the date as a year/ordinal pair in the formay YYYY-DDD
::METHOD ordinalDate
  use strict arg

  return right(self~year, 4, '0')"-"right(self~yearDay, 3, '0')


-- Return the day of the week as an integer.  1 = Monday,
-- 2 = Tuesday, etc.  These are the ISO definitions for the
-- day numbers.
::METHOD weekDay
  expose timestamp
  use strict arg
  return (date("B", timestamp, "F") // 7) + 1

-- Format the datetime into Civil format, hh:mmam/pm.
::METHOD civilTime
  expose timestamp
  use strict arg
  return time("C", timestamp, "F")


-- Format the datetime into Normal time format, hh:mm:ss
::METHOD normalTime
  expose timestamp
  use strict arg
  return time("N", timestamp, "F")


-- Format the datetime into Long time format, hh:mm:ss.uuuuuu
::METHOD longTime
  expose timestamp
  use strict arg
  return time("L", timestamp, "F")

-- Return the full date timestamp value for this date.
::METHOD fullDate
  expose timestamp
  use strict arg    -- enforces no arguments
  return timestamp

-- return the UTC timestamp in fulldate format
::METHOD utcDate
  expose utcTimeStamp
  use strict arg    -- enforces no arguments
  return utcTimeStamp

::METHOD toTimeZone
  expose utcTimeStamp
  -- default offset is for UTC
  use strict arg offset=0

  numeric digits 18
  -- if offset is a timespan, then grab the number of microseconds in the
  -- span, retaining the sign
  if offset~isa(.TimeSpan) then do
      adjustment = offset~totalMicroseconds
      offset = adjustment/60000000
  end
  else do
      -- we need to convert from minutes to microseconds
      adjustment = offset * 60000000
  end

  -- as of today, world time zone offsets range from -12:00 to +14:00
  -- for good measure we allow offsets between -15:00 and +15:00
  .Validate~wholeNumberRange("offset", offset, -900, 900)

  -- we create a new DateTime by converting the UTC time to
  -- the target timezone, then create a new object using that offset
  return self~class~new(utcTimeStamp + adjustment, offset)

-- return a .DateTime object converted to local time
::METHOD toLocalTime
  use strict arg
  return self~toTimeZone(time('O')/60000000)  -- convert to the local offset

-- return a .DateTime object converted to UTC time
::METHOD toUTCTime
  use strict arg
  return self~toTimeZone(0)  -- convert to the offset zero

-- return the time zone offset, as a TimeSpan object
::METHOD offset
  expose offset
  use strict arg    -- enforces no arguments
  return .TimeSpan~new(offset)

-- Return the Unix Ticks value for this timestamp.
::METHOD ticks
  expose timestamp
  use strict arg
  return time("T", timestamp, "F")

-- Returns a datetime object with a time of day value set to
-- 00:00:00.000000
::METHOD date
  use strict arg
  return self~class~new(date('F', self~standardDate, 'S'), self~offset)

-- Returns the time of day as a TimeSpan object with the interval
-- from 00:00:00.000000 of the datetime day.
::METHOD timeOfDay
  use strict arg
  return .timespan~new(time('F', self~LongTime, 'L'))

-- Returns the difference between the current time and the receiver object.
::METHOD elapsed
  expose timestamp
  use strict arg

  numeric digits 18
  return .timespan~new(time('F') - timestamp)

-- Returns true if the datetime object year is a leap year.
::METHOD isLeapYear
  use strict arg
  year = self~year

  if year // 4 == 0, year // 100 \== 0 | year // 400 == 0
      then return .true
      else return .false

-- Returns the number of days in the current month.  This accounts
-- for leap years.
::METHOD daysInMonth
  use strict arg
  month = self~month

  if month == 2 then
      return 28 + self~isLeapYear
  else
      return "31 . 31 30 31 30 31 31 30 31 30 31"~word(month)

-- Returns the number of days in the current year.  This accounts
-- for leap years.
::METHOD daysInYear
  use strict arg

  return 365 + self~isLeapYear


-- Returns the ISO week number for a given date
::METHOD weekNumber
  use strict arg

  -- we calculate the ISO week number according to
  -- https://en.wikipedia.org/wiki/ISO_week_date#Calculation
  -- week(date) = ( ordinal(date) - weekday(date) + 10 ) % 7
  -- week = ( lastWeek(year-1), week < 1
  --        ( 1,                week > lastWeek(year)
  weekNumber = (self~yearDay - self~weekDay + 10) % 7

  -- if not on the edges, then we are done
  if weekNumber >= 1, weekNumber <= 52 then
      return weekNumber
  -- if this is less than one, then the day belongs to the last week of the previous year
  else if weekNumber < 1 then
      return self~addYears(-1)~weeksInYear
  -- if greater than 52, see if it falls into first week of next year
  else return (weekNumber > self~weeksInYear)~?(1, weekNumber)

-- return the year associated with this date's week number. This may be
-- different than the year for dates at the beginning or end of the year
::METHOD weekNumberYear
  use strict arg

  year = self~year
  weekNumber = self~weekNumber
  month = self~month

  -- if the week number is 1 but we're in December, then this actually is part of next year
  if weekNumber == 1, month == 12 then do
      year += 1
  end
  -- if the week number is at the end of the year but the date is in January, then
  -- this belongs to the previous year
  else if weekNumber >= 52, month == 1 then do
      year -= 1
  end

  return year

-- return the number of weeks contained in a year according to the ISO
-- week number rules
::method weeksInYear
  use strict arg

  -- we calculate the number of ISO weeks according to
  -- https://en.wikipedia.org/wiki/ISO_week_date#Weeks_per_year
  -- weeks(year) = 52 + ( 1   if p(year) = 4 or p(year-1) = 3
  --                    ( 0   otherwise
  -- p(year) = (year + year % 4 - year % 100 + year % 400 ) mod 7

  year = self~year
  if p(year) \= 4, p(year - 1) \= 3 then
      return 52
  else
      return 53

  p: procedure
      parse arg year
      return (year + year % 4 - year % 100 + year % 400 ) // 7


-- Returns a string form for this date time.  The string value
-- is the ISO date.
::METHOD string      -- return a formatted string value
  use strict arg    -- enforces no arguments
  return self~isoDate

::method makeString
  forward message "STRING"


-- TimeSpan represents an interval of time.  Timespans are created by subtracting
-- two DateTime objects.  They also can be added to DateTime objects.
::CLASS 'TimeSpan' public inherit Comparable Orderable

-- Create a timespan object representing a number of days
::METHOD fromDays class
  use strict arg days
  .Validate~number("days", days)
  numeric digits 18
  return self~new(trunc(days * 24 * 3600 * 1000000))

-- Create a timespan object representing a number of hours
::METHOD fromHours class
  use strict arg hours
  .Validate~number("hours", hours)
  numeric digits 18
  return self~new(trunc(hours * 3600 * 1000000))

-- Create a timespan object representing a number of minutes
::METHOD fromMinutes class
  use strict arg minutes
  .Validate~number("minutes", minutes)
  numeric digits 18
  return self~new(trunc(minutes * 60 * 1000000))

-- Create a timespan object representing a number of seconds
::METHOD fromSeconds class
  use strict arg seconds
  .Validate~number("seconds", seconds)
  numeric digits 18
  return self~new(trunc(seconds * 1000000))

-- Create a timespan object representing a number of microseconds
::METHOD fromMicroseconds class
  use strict arg usec
  .Validate~number("microseconds", usec)
  numeric digits 18
  return self~new(trunc(usec))

-- Create a timespan object representing the interval from a Civil time
::METHOD fromCivilTime class
  use strict arg time
  signal on syntax
  return self~new(Time('F', time, 'C'))

  syntax:
  raise syntax 88.918 array("time", time)

-- Create a timespan object representing the interval from a Normal time
::METHOD fromNormalTime class
  use strict arg time
  signal on syntax
  return self~new(Time('F', time, 'N'))

  syntax:
  raise syntax 88.918 array("time", time)

-- Create a timespan object representing the interval from a Long time
::METHOD fromLongTime class
  use strict arg time
  signal on syntax
  return self~new(Time('F', time, 'L'))

  syntax:
  raise syntax 88.918 array("time", time)

-- create a TimeSpan object from the string format
::METHOD fromStringFormat class
  use strict arg time

  numeric digits 18
  signal on syntax   -- trap any errors and give the format error message
  parse var time days "." hours ":" minutes ":" seconds "." microseconds
  sign = 1

  if minutes \= "" then do  -- if minutes got something, then we have leading days
     if days < 0 then do
        days = -days
        sign = -1
     end
     timestamp = (((days * 24 * 3600) + (hours * 3600) + (minutes * 60) + seconds) * 1000000) + microseconds
     return .timespan~new(sign * timestamp)
  end
  else do
     -- form with no days in front
     parse var time hours ":" minutes ":" seconds "." microseconds
     if hours < 0 then do
        hours = -hours
        sign = -1
     end
     timestamp = (((hours * 3600) + (minutes * 60) + seconds) * 1000000) + microseconds
     return .timespan~new(sign * timestamp)
  end

  syntax:
  raise syntax 88.918 array("time", time)


-- Initialize a timespan object
-- initialize a TimeSpan instance.  There are multiple forms of this:
--
-- init(microseconds)
--      input is a full time number of microseconds from time('f')
-- init(hours, minutes, seconds)
--      initialize from an hours, minutes, seconds combo.
-- init(days, hours, minutes, seconds, microseconds)
--      initialize from a fully specified time specification.  The microseconds
--      are optional and default to zero.
::METHOD init
  expose timestamp
  numeric digits 18    -- need higher digits for time calculations

  select
      when arg() <= 1 then do    -- just create from a microseconds value
          use strict arg timestamp
          .Validate~wholeNumber("timestamp", timestamp, 18)
      end
      when arg() <= 3 then do
          -- convert hours, minutes, seconds to microseconds value
          use strict arg hours, minutes, seconds = 0
          .Validate~wholeNumberRange("hours", hours, 0, 23)
          .Validate~wholeNumberRange("minutes", minutes, 0, 59)
          .Validate~wholeNumberRange("seconds", seconds, 0, 59)
          timestamp = (hours * 3600 + minutes * 60 + seconds) * 1000000
      end
      otherwise
          -- starting with days, hours, minutes, seconds, and microseconds
          use strict arg days, hours, minutes, seconds, microseconds = 0
          .Validate~nonNegativeWholeNumber("days", days)
          .Validate~wholeNumberRange("hours", hours, 0, 23)
          .Validate~wholeNumberRange("minutes", minutes, 0, 59)
          .Validate~wholeNumberRange("seconds", seconds, 0, 59)
          .Validate~wholeNumberRange("microseconds", microseconds, 0, 999999)
          timestamp = ((days * 24 + hours) * 3600 + minutes * 60 + seconds) * 1000000 + microseconds
  end

  -- this will validate the timestamp value
  timestamp = date('f', abs(timestamp), 'f') * sign(timestamp)

-- perform a sort comparison of two timespans
::METHOD compareTo
  expose timestamp

  use strict arg other

  if \other~isA(.TimeSpan) then
    forward class (super) -- let the default implementation handle this

  numeric digits 18
  othertime = other~totalMicroseconds

  -- now produce a compare result based on the relative values.
  -- NOTE:  the timestamp values can be negative, so just subtraction won't work for
  -- a relative size test.
  if timestamp < othertime then do
      return -1
  end
  else if timestamp > othertime then do
      return 1
  end
  return 0

-- return a timespan instance as a positive value
::METHOD duration
  expose timestamp
  use strict arg    -- enforces no arguments
  return self~class~new(abs(timestamp))

-- return the number of whole days in the timespan
::METHOD days
  expose timestamp
  use strict arg    -- enforces no arguments
  numeric digits 18
  return abs(timestamp) % (24 * 3600 * 1000000)


-- return the hours component of the timespan
::METHOD hours
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  -- subtract out the higher components
  remainder = abs(timestamp) // (24 * 3600 * 1000000)
  -- and return the number full units remaining
  return remainder % (3600 * 1000000)


-- return the minutes component of the timespan
::METHOD minutes
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  -- subtract out the higher components
  remainder = abs(timestamp) // (3600 * 1000000)
  -- and return the number full units remaining
  return remainder % (60 * 1000000)


-- return the seconds component of the timespan
::METHOD seconds
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  -- subtract out the higher components
  remainder = abs(timestamp) // (60 * 1000000)
  -- and return the number full units remaining
  return remainder % (1000000)

-- return the microseconds component of the timespan
::METHOD microseconds
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  -- subtract out the higher components
  remainder = abs(timestamp) // 1000000
  -- and return the number full units remaining
  return remainder


-- return the timespan as a number of days (including fractional days)
::METHOD totalDays
  expose timestamp
  use strict arg    -- enforces no arguments
  numeric digits 18
  return timestamp / (24 * 3600 * 1000000)


-- return the timespan as a number of hours (including fractional hours)
::METHOD totalHours
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  return timestamp / (3600 * 1000000)


-- return the timespan as a number of minutes (including fractional minutes)
::METHOD totalMinutes
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  return timestamp / (60 * 1000000)


-- return the timespan as a number of seconds (including fractional seconds)
::METHOD totalSeconds
  expose timestamp
  use strict arg    -- enforces no arguments

  numeric digits 18
  return timestamp / (1000000)


-- return the timespan as a number of microseconds
::METHOD totalMicroseconds
  expose timestamp
  use strict arg    -- enforces no arguments
  return timestamp

-- hashcode override for MapCollection interaction.
::METHOD hashCode
  expose timestamp
  use strict arg    -- enforces no arguments
  return timestamp~hashcode

-- perform timespan subtraction.  If this is a prefix "-",
-- then the timespan is just negated.  Otherwise, the other
-- argument must be a timespan.  The return result is a new
-- timespan representing the difference between the two values.
::METHOD "-"
  expose timestamp

  numeric digits 18     -- need this to do math on the value

  -- could be a prefix "-"
  if arg() == 0 then do
      return self~class~new(-timestamp)
  end

  -- actual subtraction op
  use strict arg other

  -- "-" is not commutative with .DateTime.  We don't support
  -- subtracting a time from a TimeStamp.  The reverse operation,
  -- however, makes sense.
  if \other~isa(.timespan) then do
      raise syntax 93.948 array(1, "TimeSpan")
  end

  -- combine the two intervals
  return self~class~new(timestamp - other~totalMicroseconds)


-- perform timespan addition.  If this is the prefix "+" operator,
-- a new timespan instance with the same value is returned.  Otherwise,
-- if the argument is a TimeSpan object, the two timespans are added together,
-- returning a new TimeSpan.  If the argument object is a DateTime, the TimeSpan
-- is added to the DateTime and an new, adjusted DateTime object is returned.
::METHOD "+"
  expose timestamp

  numeric digits 18     -- need this to do math on the value

  -- could be a prefix "+"
  if arg() == 0 then do
      return self~class~new(timestamp)
  end

  -- ok, actually addition.  We require a timespan or a datetime.
  use strict arg other

  -- "+" can do the addition to either a timespan or a datetime.
  -- When addition occurs between two timespans, the result is a timespan.
  -- When adding a datetime, the result is a datetime.
  if other~isa(.timespan) then do
      -- combine the two intervals
      return self~class~new(timestamp + other~totalMicroseconds)
  end

  if other~isa(.datetime) then do
      -- combine the interval with the timestamp
      return other~class~new(timestamp + other~fullDate)
  end

  raise syntax 88.914 array(1, "TimeSpan or DateTime")


-- perform integer division on a timespan.  This divides the interval
-- and returns a new TimeSpan instance.
::METHOD "%"
  expose timestamp

  numeric digits 18     -- need this to do math on the value

  -- we just get a divisor and use it.  If it's bad, it's bad
  use strict arg divisor

  -- do the division and create a new interval
  return self~class~new(timestamp % divisor)

-- perform division on a timespan.  This divides the interval
-- and returns a new TimeSpan instance.  This is the same as integer division.
::METHOD "/"
  -- dividing a timespan is inherently an integer operation.  Handle as
  -- integer division.
  forward message("%")


-- perform remainder division on a timespan.  This divides the interval
-- and returns a new TimeSpan instance with the remainder.
::METHOD "//"
  expose timestamp

  numeric digits 18     -- need this to do math on the value

  -- we just get a divisor and use it.  If it's bad, it's bad
  use strict arg divisor


  -- do the remainder and create a new interval
  return self~class~new(timestamp // divisor)


-- perform multiplication on a timespan.  This multiplies the interval
-- and returns a new TimeSpan instance.
::METHOD "*"
  expose timestamp

  numeric digits 18     -- need this to do math on the value

  -- we just get a multiplier and use it.  If it's bad, it's bad
  use strict arg multiplier

  -- do the multiply and create a new interval
  return self~class~new(trunc(timestamp * multiplier))


-- Add a number of 7-day units to the datetime, returning a new instance
::METHOD addWeeks
  expose timestamp
  use strict arg weeks

  .Validate~number("weeks", weeks)

  numeric digits 18
  -- return a new instance of DateTime
  return self~class~new(trunc(timestamp + weeks * (7 * 24 * 3600 * 1000000)))


-- Add a number of days to a timespan, returning a new timespan instance.
::METHOD addDays
  expose timestamp
  use strict arg days

  .Validate~number("days", days)

  numeric digits 18
  -- return a new instance of TimeSpan
  return self~class~new(trunc(timestamp + (days * (24 * 3600 * 1000000))))


-- Add a number of hours to a timespan, returning a new timespan instance.
::METHOD addHours
  expose timestamp
  use strict arg hours

  .Validate~number("hours", hours)

  numeric digits 18

  -- return a new instance of TimeSpan
  return self~class~new(trunc(timestamp + (hours * (3600 * 1000000))))


-- Add a number of minutes to a timespan, returning a new timespan instance.
::METHOD addMinutes
  expose timestamp
  use strict arg minutes

  .Validate~number("minutes", minutes)

  numeric digits 18

  -- return a new instance of TimeSpan
  return self~class~new(trunc(timestamp + (minutes * (60 * 1000000))))


-- Add a number of seconds to a timespan, returning a new timespan instance.
::METHOD addSeconds
  expose timestamp
  use strict arg seconds

  .Validate~number("seconds", seconds)

  numeric digits 18

  -- return a new instance of TimeSpan
  return self~class~new(trunc(timestamp + (seconds * 1000000)))


-- Add a number of microseconds to a timespan, returning a new timespan instance.
::METHOD addMicroseconds
  expose timestamp
  use strict arg usecs

  .Validate~number("microseconds", usecs)
  numeric digits 18

  -- return a new instance of TimeSpan
  return self~class~new(trunc(timestamp + usecs))


-- Return the sign (-1, 0, 1) for this timestamp for easy negative checking
::METHOD sign
  expose timestamp
  use strict arg

  numeric digits 18
  return timestamp~sign


-- format the TimeSpan into string form.  The format is
-- (-)(ddddddd.)hh:mm:ss.uuuuuu  The portions in parentheses
-- are optional.
::METHOD string      -- return a formatted string value
  expose timestamp
  use strict arg

  days = self~days
  hours = self~hours
  minutes = self~minutes
  seconds = self~seconds
  microseconds = self~microseconds

  sign = ""

  if timestamp < 0 then do
      sign = "-"
  end

  -- only include the days portion if it's non-zero.
  if days > 0 then do
      return sign||days"."hours~right(2, '0')":"minutes~right(2, '0')":"seconds~right(2, '0')"."microseconds~right(6, '0')
  end
  else do
      return sign||hours~right(2, '0')":"minutes~right(2, '0')":"seconds~right(2, '0')"."microseconds~right(6, '0')
  end

::method makeString
  forward message "STRING"


-- NOTE: undocumented ArgUtil class has been superseded by documented Validate class
-- ArgUtil is deprecated, use of it is discouraged, as it may be removed in the future
::CLASS 'ArgUtil' public
::METHOD validateNumber class
  use strict arg name, number
  if \number~dataType('Number') then do
      raise syntax 88.902 array(name, number)
  end

-- Validates the argument is a number and is in range.  This gives the
-- 907 message for all error conditions to be most specific.
::METHOD validateNumberRange class
  use strict arg name, number, min, max, digits=(digits())
  numeric digits digits
  -- validate the numeric part first
  if \number~dataType('Number') then do
      raise syntax 88.907 array(name, min, max, number)
  end
  -- now validate it's within range
  if number < min | number > max then do
      raise syntax 88.907 array(name, min, max, number)
  end


-- Validates the argument is a whole number and is in range.  This gives the
-- 907 message for all error conditions to be most specific.
::METHOD validateWholeRange class
  use strict arg name, number, min, max, digits=(digits())
  numeric digits digits
  -- validate the numeric part first
  if \number~dataType('Whole') then do
      raise syntax 88.907 array(name, min, max, number)
  end
  -- now validate it's within range
  if number < min | number > max then do
      raise syntax 88.907 array(name, min, max, number)
  end

::METHOD validateWhole class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  if \number~dataType('Whole') then do
      raise syntax 88.903 array(name, number)
  end

-- Note, this uses the 904 message for both, which is most specific
::METHOD validateNonNegative class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- first validate whole number status
  if \number~dataType('Whole') then do
      raise syntax 88.904 array(name, number)
  end
  -- then check range status
  if number < 0 then do
      raise syntax 88.904 array(name, number)
  end

::METHOD validatePositive class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- first validate whole number status
  if \number~dataType('Whole') then do
      raise syntax 88.905 array(name, number)
  end
  -- then check range status
  if number <= 0 then do
      raise syntax 88.905 array(name, number)
  end

-- validate a length parameter.  This is essentially the same
-- as validateNonNegative, but a more specific message.
::METHOD validateLength class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- first validate whole number status
  if \number~dataType('Whole') then do
      raise syntax 88.911 array(name, number)
  end
  -- then check range status
  if number < 0 then do
      raise syntax 88.911 array(name, number)
  end

-- validate a position parameter.  This is essentially the same
-- as validatePosition, but a more specific message.
::METHOD validatePosition class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- first validate whole number status
  if \number~dataType('Whole') then do
      raise syntax 88.912 array(name, number)
  end
  -- then check range status
  if number <= 0 then do
      raise syntax 88.912 array(name, number)
  end

-- validate that an argument is an instance of a specific class.
::METHOD validateClass class
  use strict arg name, obj, class

  if \obj~isa(class) then do
      raise syntax 88.914 array(name, class~id)
  end


-- a class for performing easy argument validation
::CLASS 'Validate' public

-- validate that an argument is a valid Rexx number
::METHOD number class
  use strict arg name, number
  if \datatype(number, "Number") then do
      -- The NAME argument must be a number; found "NUMBER"
      raise syntax 88.902 array(name, number)
  end

-- validate that an argument is a number and is in range
::METHOD numberRange class
  use strict arg name, number, min, max, digits=(digits())
  numeric digits digits
  -- must be numeric and within the given range
  if datatype(number, "Number"), number >= min, number <= max then do
      return
  end
  -- The NAME argument must be in the range MIN to MAX; found "NUMBER"
  raise syntax 88.907 array(name, min, max, number)

-- validate that an argument is zero or a positive number
::METHOD nonNegativeNumber class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- must be numeric and zero or positive
  if datatype(number, "Number"), number >= 0 then do
      return
  end
  -- The NAME argument must be zero or a positive number; found "NUMBER"
  raise syntax 88.925 array(name, number)

-- validate that an argument is a positive number
::METHOD positiveNumber class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- must be numeric and positive
  if datatype(number, "Number"), number > 0 then do
      return
  end
  -- The NAME argument must be a positive number; found "NUMBER"
  raise syntax 88.926 array(name, number)

-- validate that an argument is a whole number within the given digits
::METHOD wholeNumber class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  if \datatype(number, "Whole") then do
      -- The NAME argument must be a whole number; found "NUMBER"
      raise syntax 88.903 array(name, number)
  end


-- validate that an argument is a whole number and is in range
::METHOD wholeNumberRange class
  use strict arg name, number, min, max, digits=(digits())
  numeric digits digits
  -- must be whole and within the given range
  if datatype(number, "Whole"), number >= min, number <= max then do
      return
  end
  -- The NAME argument must be in the range MIN to MAX; found "NUMBER"
  raise syntax 88.907 array(name, min, max, number)

-- validate that an argument is zero or a positive whole number
::METHOD nonNegativeWholeNumber class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- must be whole and zero or positive
  if datatype(number, "Whole"), number >= 0 then do
      return
  end
  -- The NAME argument must be zero or a positive whole number; found "NUMBER"
  raise syntax 88.904 array(name, number)

-- validate that an argument is a positive whole number
::METHOD positiveWholeNumber class
  use strict arg name, number, digits=(digits())
  numeric digits digits
  -- must be whole and positive
  if datatype(number, "Whole"), number > 0 then do
      return
  end
  -- The NAME argument must be a positive whole number; found "NUMBER"
  raise syntax 88.905 array(name, number)


-- validates a length argument
-- this is very similar to method nonNegativeWholeNumber, but with
-- a different default digits concept and a more specific message.
::METHOD length class
  use strict arg name, number, digits=(.RexxInfo~internalDigits)
  numeric digits digits
  -- must be whole and zero or positive
  if datatype(number, "Whole"), number >= 0 then do
      return
  end
  -- Argument NAME is an invalid length value; found "NUMBER"
  raise syntax 88.911 array(name, number)

-- validates a position argument
-- this is very similar to method positiveWholeNumber, but with
-- a different default digits concept and a more specific message.
::METHOD position class
  use strict arg name, number, digits=(.RexxInfo~internalDigits)
  numeric digits digits
  -- must be whole and positive
  if datatype(number, "Whole"), number > 0 then do
      return
  end
  -- Argument NAME is an invalid position value; found "NUMBER"
  raise syntax 88.912 array(name, number)

-- validate that an argument is an instance of a specific class
::METHOD classType class
  use strict arg name, object, class

  if \object~isA(class) then do
      -- Argument NAME must be an instance of the CLASS class
      raise syntax 88.914 array(name, class~id)
  end

-- validate that an argument can be expressed as an instance of a specific class
::METHOD requestClassType class
  use strict arg name, object, class

  newObject = object~request(class~id)

  if \newObject~isA(class) then do
      -- 93.978:  Method argument NAME could not be converted to type CLASS; found "OBJECT".
      raise syntax 93.978 array(name, class~id, object)
  end

  return newObject

-- validate that an argument is a valid boolean
::METHOD logical class
  use strict arg name, number

  if number \== .true, number \== .false then do
      -- The NAME argument must be exactly "0" or "1"; found NUMBER
      raise syntax 88.927 array(name, number)
  end


-- A mixin class for easily adding comparison methods to a
-- class
::CLASS 'Orderable' PUBLIC MIXINCLASS Object

-- perform an ordered comparison of two objects
::METHOD compareTo
  -- fallback implementation for classes inheriting from Orderable
  -- (see discussion in [bugs:1406])
  use strict arg other
  numeric digits 18
  return (self~identityHash - other~identityHash)~sign


-- we generally expect any comparison arguments to be 'orderable'
-- there's one exception, though: .nil
-- we want to be able to compare an object inheriting from ORDERABLE
-- equal or 'not equal' to .nil
-- but we can't let compareTo() handle this, as it can only return -1, 0, 1
-- and it doesn't know the operator it was called from
-- so we handle the special case of 'other' = .nil here

::METHOD "=="
  use strict arg other
  -- special case .nil comparison: this instance can never be equal to .nil
  if other~isNil then
    return 0
  return self~compareTo(other) = 0

::METHOD "\=="
  use strict arg other
  -- special case .nil comparison: this instance is always 'not equal' to .nil
  if other~isNil then
    return 1
  return self~compareTo(other) \= 0

::METHOD "="
  use strict arg other
  -- special case .nil comparison: this instance can never be equal to .nil
  if other~isNil then
    return 0
  return self~compareTo(other) = 0

::METHOD "\="
  use strict arg other
  -- special case .nil comparison: this instance is always 'not equal' to .nil
  if other~isNil then
    return 1
  return self~compareTo(other) \= 0

::METHOD "<>"
  -- this is equivalent of "\="
  forward message("\=")

::METHOD "><"
  -- this is equivalent of "\="
  forward message("\=")

::METHOD "<"
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array("<")     -- ORDERABLE comparison method "<" argument cannot be .nil
  return self~compareTo(other) < 0

::METHOD "<="
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array("<=")    -- ORDERABLE comparison method "<=" argument cannot be .nil
  return self~compareTo(other) <= 0

::METHOD "\>"
  -- this is equivalent of "<="
  forward message("<=")

::METHOD "<<"
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array("<<")    -- ORDERABLE comparison method "<<" argument cannot be .nil
  return self~compareTo(other) < 0

::METHOD "<<="
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array("<<=")   -- ORDERABLE comparison method "<<=" argument cannot be .nil
  return self~compareTo(other) <= 0

::METHOD "\>>"
  -- this is equivalent of "<<="
  forward message("<<=")

::METHOD ">"
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array(">")     -- ORDERABLE comparison method ">" argument cannot be .nil
  return self~compareTo(other) > 0

::METHOD ">="
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array(">=")    -- ORDERABLE comparison method ">=" argument cannot be .nil
  return self~compareTo(other) >= 0

::METHOD "\<"
  -- this is equivalent of ">="
  forward message(">=")

::METHOD ">>"
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array(">>")    -- ORDERABLE comparison method ">>" argument cannot be .nil
  return self~compareTo(other) > 0

::METHOD ">>="
  use strict arg other
  -- for this operator a .nil comparison is invalid
  if other~isNil then
    raise syntax 93.973 array(">>=")   -- ORDERABLE comparison method ">>=" argument cannot be .nil
  return self~compareTo(other) >= 0

::METHOD "\<<"
  -- this is equivalent of ">>="
  forward message(">>=")


/** This metaclass makes sure that only a single instance of a class can be created,
*   a "singleton". After a singleton got created each time a NEW message gets sent
*   to the class will cause that singleton to be returned. The Singleton metaclass
*   makes sure that the singleton object will return itself upon receiving the COPY
*   message.
*/
::class "Singleton" mixinclass class public

::method new            -- create a new instance
  expose s              -- attribute to hold singleton
  if var("S")=.false then  -- not yet created?
  do
     self~define("COPY", "return self")   -- make sure COPY returns singleton as well
     forward class (super) continue       -- let the superclass create the instance
     s=result           -- fetch & save the returned instance
  end
  return s              -- return singleton instance


/** This class maintains trace information meant to support debugging and analyzing
*   execution traces. The makeString method will return a string that will be formatted
*   according to the current setting of the OPTION class attribute. If the COLLECTOR
*   class attribute is not .nil then the traceObject will be appended to it.
*
*/
::class "TraceObject" subclass StringTable public

---------------------- class level ----------------------
::method    activate    class
  expose option collector counter makeStringMethod
  self~activate:super
  option   ='N'         -- normal (makeString returns the TRACELINE entry)
  collector=.nil        -- no appending to the collector will take place
  makeStringMethod = .nil
  counter  =0           -- value will be used to number the TraceObject instances

::method    new         class    -- a new instance gets requested
  expose option collector counter
  dt = .dateTime~new    -- take the current date and time
  forward class (super) continue -- let the superclass do the job
  newObj = result       -- fetch freshly created object
  newObj["TIMESTAMP"]=dt
  newObj["OPTION"]   =option
  counter += 1
  newObj["NUMBER"]   =counter
  if \collector~isNil then -- collector exists, append traceObject
     collector~append(newObj)
  return newObj         -- return the new object

::attribute collector   class       -- .nil or an object that does understand APPEND(object)

::attribute counter     get class   -- we only allow get access

::attribute option      set class
  expose option
  parse upper arg o +1  -- extract first letter
  pos=pos(o,"NTSFP")    -- option letter in hand? (Normal, Thread, Standard, Full, Profiling)
  if pos>0 then         -- valid option, use it
     option=o
  else                  -- unknown option, raise condition
     raise syntax 93.914 array (1, '"N" (normal), "T" (thread), "S" (standard), "F" (full) or "P" (profiling)', arg(1))

::attribute option      get class

::method setMakeString  class -- allow replacing the predefined makeStringImpl method
  expose makeStringMethod
  use strict arg newMethod
  if newMethod~isA(.method) then    -- a method object already
     makeStringMethod=newMethod
  else   -- create and save method object for performance
  do
     signal on syntax   -- create method object from newMethod and save it
     makeStringMethod=.method~new("newMakeStringMethod", newMethod)
  end
  return

syntax:
  raise propagate       -- propagate the error

::method unsetMakeString  class  -- allow replacing the predefined makeStringImpl method
  expose makeStringMethod
  use strict arg
  makeStringMethod = .nil        -- cancel this out


/** Create the traceline string, if option:
*     'N' ... just return the traceline (default)

*     'T' ... inserts the thread in the trace prefix after the second character ... thread

*     'S' ... return prefix [T1  I1  ]          ... thread, invocation
*                           [T1  I1  Gu A1  L1  *W] ... thread, invocation, guarded/unguarded, lockcount, hasObjectLock

*     'F' ... return prefix [R1   T1   I1   ]... interpreter, thread, invocation
                          for a method statement:
*                           [R1   T1   I1   Gu A1   L1   *W] ... interpreter, thread, invocation, guarded/unguarded, attribute pool, lockcount, hasObjectLock

*     'P' ... will cause ooRexx to not forward the traceObject (this option is meant for profiling);
              if set while makeString gets invoked via a Rexx program, then makeString will
              format the traceline with the option in effect of creating the TraceObject (if still
              'P', then use 'N' formating)
*/
::method makeStringImpl class    -- the formatting method
  expose option makeStringMethod
  use strict arg traceObj

  -- this is customizable, so check first for the override
  if makeStringMethod \= .nil then do
    return self~run(makeStringMethod, 'Individual', traceObj)  -- run it directly on ourselves
  end

  tmpOption=option         -- get current option

  if tmpOption='P' then    -- currently profiling/probing, use original option if not 'P'
  do
     oriOption=str(traceObj["OPTION"])     -- get original option, if also 'P', then use 'N' formatting
     if oriOption='?' then -- OPTION entry does not exist, resort to 'N' formatting
        tmpOption='N'      -- if no option available, format as normal
     else      -- if original option is P as well then format as normal, otherwise as original option
        tmpOption=(oriOption='P')~?('N',oriOption)
  end

  if tmpOption='N' then return str(traceObj["TRACELINE"])

  if tmpOption='T' then
  do
     parse value traceObj~traceline with line 7 prefix rest
     return line prefix~insert(traceObj["THREAD"],2) rest
  end

  mb = .MutableBuffer~new  -- for performance reasons
  mb~append("[")
  if tmpOption='S' then
  do
     mb~append("T", adjLeft(str(traceObj["THREAD"])    ,2), " ")  -- T_hread/activity
     mb~append("I", adjLeft(str(traceObj["INVOCATION"]),2)     )  -- I_nvocation/activation
  end
  else -- if tmpOption='F' then
  do
     mb~append("R", adjLeft(str(traceObj["INTERPRETER"]),3), " ") -- R_exx interpreter instance
     mb~append("T", adjLeft(str(traceObj["THREAD"])     ,3), " ") -- T_hread/activity
     mb~append("I", adjLeft(str(traceObj["INVOCATION"]) ,4)     ) -- I_nvocation/activation
  end

  ap=traceObj["ATTRIBUTEPOOL"]
  if \ap~isNil then        -- an object's variable dictionary in hand, we are in a method
  do
     mb~append(" ")
     isGuarded   =str(traceObj["ISGUARDED"])
     hasScopeLock=str(traceObj["HASSCOPELOCK"])

     if isGuarded='?' then
        mb~append(isGuarded)              -- ? (if not set), else G_uarded or U_unguarded
     else
        mb~append(isGuarded~?("G","U"))   -- method defined G_uarded or U_unguarded

     -- if current scope is not the method's defined one, indicate it
     if      isGuarded=.true,  hasScopeLock=.false then mb~append('u ')
     else if isGuarded=.false, hasScopeLock=.true  then mb~append('g ')
     else mb~append("  ")

     if tmpOption='S' then
     do
        mb~append("A", adjLeft(ap,2), " ")  -- Attribute pool (variable dictionary)
        mb~append("L", adjLeft(str(traceObj["SCOPELOCKCOUNT"]),2), " ") -- L ... lock reserve count
     end
     else -- if tmpOption='F' then
     do
        mb~append("A", adjLeft(ap,4), " ")  -- Attribute pool (variable dictionary)
        mb~append("L", adjLeft(str(traceObj["SCOPELOCKCOUNT"]),3), " ") -- L ... lock reserve count
     end

     if hasScopeLock='?' then
        mb~append(hasScopeLock)              -- indicates that value is not present
     else
     do
        mb~append(hasScopeLock~?("*"," "))   -- asterisk to indicate holding object lock (can execute)
        if traceObj~hasEntry("ISWAITING") then
           mb~append((traceObj["ISWAITING"]=.true)~?("W"," "))
        else
           mb~append(" ")
     end

     mb~append("] ")
  end
  else   -- no object related information in this traceObject
  do
     if tmpOption='S' then
        mb~append("]               ")     -- Standard: make sure we align traceline
     else -- if tmpOption='F' then
        mb~append("]                  ")  -- Full: make sure we align traceline
  end

  mb~append(str(traceObj["TRACELINE"]))
  return mb~string   -- return trace line with mtPrefix


adjLeft: procedure   -- left adjust, but make sure we show all chars
  use arg value, width
  if value~length>=width then -- no left adjustment
     return value
  return value~left(width)    -- left adjust with given width

str: procedure       -- make sure we supply a string if .nil, otherwise MutableBuffer causes an error
  use arg value
  if value~isNil then return '?' -- no entry, Rexx user omitted or deleted it
  return value


---------------------- instance level -------------------

::method compareTo   -- allow sorting, by default by NR which represents the creation sequence
  use arg other
  return sign(nz(self["NUMBER"],-1) - nz(other["NUMBER"],-1))  -- cf. rexxref.pdf, ComparableClass' compareTo definition

nz: procedure  -- in case a Rexx user removed the NR entry, make sure the subtraction can take place
  use arg val,ifNilValue=0
  if val~isNil then return ifNilValue
  return val

::method makeString  -- returns the traceline string
  return self~class~makeStringImpl(self)  -- let the class method makeStringImpl do the work

