Klass Module

lua-users home
wiki

Another implementation of classes. Works with Lua 5.1 and Lua 5.2. Not the fastest one, but takes only about 2k (without comments), introduces "inherited(self, ...)" calls, has isA() method, and constructors. Destructors are also implemented, via unofficial/unsupported newproxy() trick or with "__gc" metamethod.

-- $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");

RecentChanges · preferences
edit · history
Last edited August 30, 2011 3:03 pm GMT (diff)