--[[ Class Support Module
     For Improved Version of Movalbe Objects and Names Module
     H. Conrad Cunningham, Professor
     Computer and Information Science
     University of Mississippi

This package explorts functions for creating and testing single and
multiple inheritance class structures.

Developed for CSci 658, Software Language Engineering, Fall 2013

1234567890123456789012345678901234567890123456789012345678901234567890

2013-10-08: Developed this module from Movable Objects code
            Added default methods getTag, getSuper, toString, 
              and showValues to this version

Note: Function readOnly was copied here for possible future use.

--]]


-- Default constructor and accessors for classes

local new      = function(self,o)
                   o = o or {}
                   setmetatable(o,self)
                   self.__index = self
                   return o
                 end

local getTag   = function(self) return self.tag   end
local getSuper = function(self) return self.super end

local showValues = 
  function(self)
    return { " ERROR: abstract method showValues called " }
  end

local toString = function(self)
    return tostring(self:getTag()) .. 
         "("  ..  table.concat(self:showValues(), ", ")  ..  ")" 
  end


-- Function "search" searches the tables in "plist" in order for a key
-- "k".  If it finds "k", it returns the corresponding entry.  If not
-- found, it returns nil. Based on code in Listing 16.1 of the 3rd
-- edition of the PiL book.

local function search(k,plist)
  for i = 1,#plist do
    local v = plist[i][k]
    if v then return v end
  end
  return nil
end


-- Function "makeClass" returns the prototype object (table) for a
-- class with the given type tag "classTag" and the zero or more
-- superclass objects given as the remaining arguments.  This function
-- is, in part, adapted from the "createClass" method in Listing 16.1
-- of the 3rd edition of the PiL book.

-- (1) If no superclasses are given, then the returned class is a base
--     class with no parents. A standard default constructor "new" and
--     standard default accessors "getTag", "getSuper", "toString",
--     and "showValues" are created for the new class.

-- (2) If one superclass is given, then the returned class is a
--     subclass of that class.  That parent's constructor should be
--     used to create instances of the new class.  The accessors are
--     inherited from the base, except that "showValues" (at least)
--     must be overriden for concrete classes. 

-- (3) If more than one superclass is given, then the returned class
--     has multiple parents.  A default constructor "new" with
--     multiple inheritance is created for the new class. The
--     accessors are inherited from the first listed superclass,
--     except that "showValues" likely should be overriden for
--     concrete classes.

local function makeClass(classTag,...)
  assert(type(classTag) == "string",
         "Function makeClass called with invalid class tag.")
  local parents = {...}
  local c       = { tag = classTag }

  if #parents == 0 then -- base class
     c.new        = new
     c.getTag     = getTag
     c.getSuper   = getSuper
     c.toString   = toString
     c.showValues = showValues
     return c

  elseif #parents == 1 then  -- single inheritance
    local parentObj = parents[1]
    assert(type(parentObj) == "table" and parentObj:getTag(),
           "Function makeClass called with invalid parent object.")
    return parentObj:new { tag = classTag, super = parents }

  else  -- multiple inheritance
    local parentObj 
    for i = 1, #parents do -- all parents must be valid
      parentObj = parents[i]
      assert(type(parentObj) == "table" and parentObj:getTag(),
             "Function makeClass called with invalid parent object.")
    end
    c.super = parents

    -- search method list for each parent in turn
    local mt = { __index = function(t,k)
                             return search(k,c.super)
                           end }

    -- make c metatable for its instances
    setmetatable(c,mt)
    c.__index = c
    c.new = new
    return c
  end
end


-- Function "isInstanceOf" returns true iff argument "obj" is an
-- instance of the class whose tag is given in argument "class" or an
-- instance of one of its subclasses.

local function isInstanceOf(obj,class)
  if type(obj) ~= "table" or type(class) ~= "string" then
    return false
  elseif obj:getTag() == class then 
    return true
  elseif obj:getSuper() then
    local super = obj:getSuper()
    for i = 1, #super do
      if isInstanceOf(super[i],class) then return true end
    end
    return false
  else
    return false
  end
end


-- NOT CURRENTLY USED 
-- Function "readonly" creates and returns a proxy table for "cell"
-- that can only be read, not written.  (This was borrowed from the
-- Cell Lists Using Closures module.

local function readonly(cell) 
  local proxy = {
    __index   = cell,   -- delegate read access to cell itself
    __newindex = function(t,k,v) -- but disallow write accesses
        error("List cells are read-only.", 2)
      end
  }
  setmetatable(proxy,proxy)
  return proxy
end


-- MODULE EXPORT

return { makeClass    = makeClass,
         isInstanceOf = isInstanceOf
       }
       -- export readonly when complete?