Klass Module

wiki

-- $FILE klass.lua

-- $VERSION 0.0.5

-- $AUTHOR Ketmar

-- $DESCRIPTION

--   another simple prototype-based class engine with finalizers and support for 'inherited' calls

--

-- $LICENSE

--   WTFPL

--

-- $DEPENDS

--   kmodule

--

-- $USAGE

--   local newclass = class(nil, "baseclass")

--   function newclass:Method (...) print(self); end;

--

--   local class2 = class(newclass)

--   function class2:Method (...) print(self); inherited(self, ...); end;

--

--   local inst = class2("argument to Constructor!");

--

--   iherited() will do nothing if there's no inherited method. %-)

--   class can have 2 special methods:

--     :Constructor (...)

--     :Destructor ()

--   `Destructor' will be called when class is going to be destroyed by GC

--

--   DO NOT FORGET TO PASS `self' TO inherited()!

--

--   earch method can know it's name from variable (not field!) method

--

--   one can add/alter methods in class or instance in runtime.

--

-- $HISTORY

--   [+] works with Lua 5.2 beta

--   [+] added :isA(obj)

--



-- cache global functions

local assert, type, rawget, rawset = assert, type, rawget, rawset;

local getmetatable, setmetatable = getmetatable, setmetatable;

--local newproxy = newproxy;

local setfenv, getfenv = setfenv, getfenv;

local getinfo, getupvalue, setupvalue, upvaluejoin;

local newlua = false;

local _klassG;



--local print, tostring = print, tostring;





if not setfenv then

  require "debug";

  getinfo, getupvalue, setupvalue, upvaluejoin = debug.getinfo, debug.getupvalue, debug.setupvalue, debug.upvaluejoin;

  newlua = true;



  setfenv = function (f, t)

    f = (type(f) == 'function' and f or getinfo(f+1, 'f').func);

    local up, name = 0;

    repeat

      up = up+1;

      name = getupvalue(f, up)

    until name == '_ENV' or name == nil;

    if name then

      upvaluejoin(f, up, function() return name; end, 1); -- use unique upvalue

      setupvalue(f, up, t);

    end;

  end;



  getfenv = function (f)

    f = (type(f) == 'function' and f or getinfo(f+1, 'f').func);

    local up, name, val = 0;

    repeat

      up = up+1;

      name, val = getupvalue(f, up);

    until name == '_ENV' or name == nil;

    return val;

  end;



  _klassG = _ENV;

end;





module(..., package.seeall);





local specialFields = {

  _className=true,

  _parent=true,

};





-- $DESCR

--   find field in class or in it's parents

-- $IN

--   class

--     class definition or instance

--   fld

--     field name (of any type)

-- $OUT

--  $OR good

--   value

--  $OR bad

--   nil

local function findField (class, fld)

  if specialFields[fld] then return rawget(class, fld); end;

  local res;

  repeat

    --print("findField", fld, class._className);

    res = rawget(rawget(class, "_fields"), fld); if res ~= nil then return res; end;

    -- not found, go up

    class = rawget(class, "_parent");

  until not class;

  -- default result: nil

end;





-- metatable for 'see everything'

--local seeallmt = { __index = _G };



-- $DESCR

--   add field or method, install environment for method

-- $IN

--   class

--     class definition or instance

--   fld

--     field name (of any type)

--   value

--     field value or metod

-- $OUT

local function newField (class, fld, value)

  local fields = rawget(class, "_fields");

  if type(value) == "function" then

    -- new method, change envtable to make inherited() visible

    assert(not specialFields[fld]);

    local inh = function (self, ...)

      --print("inherited", fld, class._className);

      local m = rawget(class, "_parent");

      if m then

        m = findField(m, fld); -- search upwards

        if m then return m(self, ...); end;

      end;

    end;

    --local env = { method = fld };

    --setmetatable(env, seeallmt); setfenv(inh, env);

    --print(tostring(_ENV), tostring(package.seeall));

    local seeallmt;

    if newlua then

      seeallmt = { __index = _ENV };

    else

      seeallmt = { __index = _G };

    end;

    local env = { method = fld, inherited = inh };

    setmetatable(env, seeallmt); setfenv(value, env);

  end;

  rawset(specialFields[fld] and class or fields, fld, value);

end;





local classNew;

-- $DESCR

--   create new class (with possible inheritance)

-- $IN

--   class parent

--     parent or nil

--   nil/str className

--     class name

-- $OUT

--   class

function class (parent, className)

  if className == nil and type(parent) == "string" then className, parent = parent, nil; end;

  local res = {

    New = classNew,

    _className = className or "<unnamed>",

    _parent = parent,

    _fields = {},

    __call = classNew,

    __index = findField,

    __newindex = newField,

  };

  setmetatable(res, res);

  if not res.isA then

    -- no 'isA' method, add it

    res.isA = function (self, class)

      while self do

        if self == class then return true; end;

        self = rawget(self, "_parent");

      end;

      return false;

    end;

  end;

  return res;

end;





-- $DESCR

--   create new class instance

-- $IN

--   class

--     class definition

--   ...

--     constructor args

-- $OUT

--   class_instance

classNew = function (classDef, ...)

  local res = class(classDef, rawget(classDef, "_className"));

  if not newlua then

    -- this trick registers "object finalizer" in Lua 5.1

    local proxy = newproxy(true); -- create proxy (userdata) with empty metatable

    local mt = getmetatable(proxy);

    mt.__gc = function ()

      local dd = res.Destructor;

      if dd then dd(res); end;

    end;

    rawset(res, "__gc", proxy);

  else

    -- this trick registers "object finalizer" in Lua 5.2

    local mt = getmetatable(res);

    rawset(mt, "__gc", function ()

      local dd = res.Destructor;

      if dd then dd(res); end;

    end);

    setmetatable(res, mt);

  end;

  -- end of "object finalizer" trick

  local cc = res.Constructor; if cc then cc(res, ...); end;

  return res;

end;





if newlua then

  _klassG.class = class;

else

  _G.class = class;

end;

and a testcase:

require "klass";



print("\n\n===============================");





local BaseClass = class("base");

function BaseClass:Constructor (...)

  print("BaseClass."..method);

end;



function BaseClass:Me (...)

  print("BaseClass."..method);

  print(self);

end;



function BaseClass:ClassName (...)

  print("BaseClass."..method);

  return "BaseClass";

end;



function BaseClass:Test ()

  print("BaseClass."..method);

  inherited(self);

end;



function BaseClass:Destructor ()

  print("BaseClass."..method);

  print(self);

end;





local NewClass = class(BaseClass, "new");

function NewClass:Constructor (...)

  print("NewClass."..method);

  inherited(self);

end;



function NewClass:ClassName (...)

  print("NewClass."..method);

  return "NewClass";

end;



function NewClass:Destructor ()

  print("NewClass."..method);

  print(self);

  inherited(self);

  print("NewClass instance is dead");

end;





print("\27[37;1mcreating BaseClass instance...\27[0m");

local bc = BaseClass();

print("\27[37;1mcreating NewClass instance...\27[0m");

local nc = NewClass();



function nc:Test ()

  print("!!!");

  inherited(self);

end;



print("\27[37;1mbc:ClassName()\27[0m");

print(bc:ClassName());

print("\27[37;1mnc:ClassName()\27[0m");

print(nc:ClassName());



print("\27[37;1mbc:Me()\27[0m");

bc:Me();

print("\27[37;1mnc:Me()\27[0m");

nc:Me();

print("\27[37;1mnc:Test()\27[0m");

nc:Test();



--[[

print(BaseClass);

print(NewClass);

print(nc.parent);

print(nc.parent.parent);

]]

print("nc:isA(bc): "..tostring(nc:isA(bc)));

print("nc:isA(BaseClass): "..tostring(nc:isA(BaseClass)));



print("\27[37;1mdone\27[0m");



bc = nil; nc = nil;

collectgarbage("collect");

collectgarbage("collect");