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

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

Developed for CSci 658, Software Language Engineering, Fall 2013
Revised for CSci 450, Org. of Programming Languages, Fall 2016

1234567890123456789012345678901234567890123456789012345678901234567890

2013-10-08: Developed this module from Movable Objects code
            Added default methods getTag, getSuper, toString, 
              and showValues to this version
2013-10-11: Edited readOnly for generality, added export
            Added optional open, sep, and close parameters to toString
2013-10-14: Improved internal documentation and formatting
2016-10-19: Improved setting of __index for inheritance

This module is used both in the Movable/Named Objects and the Lair DSL
case studies.

--]]


-- Default constructor and accessors for classes. These are designed
-- to be injected into new class prototypes as they are created.

local new      = function(self,o)
                    o = o or {}
                    setmetatable(o,self)
                    -- self.__index = self -- removed 2016-10-19
                    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,open,sep,close)
    open  = open  or "("
    sep   = sep   or ", "
    close = close or ")"
    open, sep, close = tostring(open), tostring(sep), tostring(close)
    return tostring(self:getTag()) .. 
           open  ..  table.concat(self:showValues(), sep)  ..  close 
  end


--[[ FUNCTION search

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

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 overridden 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 overridden 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.__index    = c
      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 })
      -- above replaced with below 10-19-16
      c.super   = parents
      c         = parentObj:new(c)
      c.__index = c
      return c

   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

Function "isInstanceOf" returns true if and only if 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

--[[ FUNCTION readOnly

Function "readOnly" creates and returns a proxy object (table) for
argument "obj" (a table). The proxy object can only be read, not
written.  (This was adapted from the Cell Lists Using Closures
module.)

--]]

local function readOnly(obj) 
   local proxy = {
      __index   = obj,   -- delegate read access to obj itself
      __newindex =
	 function(t,k,v) -- but disallow write accesses
            error("Attempted access to a read-only object.", 2)
         end
   }
   setmetatable(proxy,proxy)
   return proxy
end


-- MODULE EXPORT

return { makeClass    = makeClass,
         isInstanceOf = isInstanceOf,
         readOnly     = readOnly
       }