FirstClass implementation of the Python class system in MoonScript/Lua

FirstClass.moon

-- Copyright (c)  2012, Owen Shepherd
-- Permission to use, copy, modify, and/or distribute this software for 
-- any purpose with or without fee is hereby granted, provided that the 
-- above copyright notice and this permission notice appear in all copies. 
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR
-- IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.


modName         = ...
getUserValue     = debug.getfenv
setUserValue 	= debug.setfenv
rawSetMetatable	= debug.setmetatable
rawGetMetatable	= debug.getmetatable
newproxy		= newproxy
string			= string
table 			= table
package 		= package
print			= print
_super 			= nil
-- Todo: Will these become LUDs again?
s_MRO 			= 'MRO'
s_Object		= 'Object'
s_Name			= 'Name'
s_Meta			= 'Meta'

-- Todo: C help
pointerString	= (v) -> '(pointerString missing)'

-- Debugging tool
_repr = (v, n=1) ->
	if n > 5 then return "(elided)"
	switch type v
		when "string" then return "\"" .. v .. "\""
		when "number" then return tostring(v)
		when "table"
			buf = "{ "
			for k, _v in pairs v
				buf ..= "[" .. _repr(k, n+1) .. "] = " .. _repr(_v, n+1) .. ", "
			return buf .. "}"
	return "::" .. type(v) .. "::"
export repr = _repr

prepr = (...) ->
	args = {...}
	print(unpack([repr(v) for v in ipairs args]))

strsplit = (str, sep=':') ->
	fields = {}
	pattern = string.format("([^%s]+)", sep)
	string.gsub(str, pattern, (c) -> fields[#fields + 1] = c)
	return fields

-- Clean module function
-- Like Lua 5.1 module, without global namespace pollution
-- Returns the module table. Make this your environment

_module = (modpath, ...) ->
	_M = {}
	package.loaded[modpath] = _M

	-- Parse the name
	modcomponents 	= strsplit(modpath, ".")
	topmod 			= modcomponents[1]
	modname			= table.remove(modcomponents)
	packagename   	= table.concat(modcomponents, ".")

	-- Define for compatibility with module()
	_M._M       = _M
	_M._NAME    = modpath
	_M._PACKAGE = packagename

	-- If this is a nested package, then import parent and place ourself in
	-- their table
	if packagename ~= ""
		package = require packagename
		package[modname] = _M
	
	-- Apply decorators to the module
	privM = nil
	if ... then for _, f in ipairs {...}
		privM = f(_M, privM)
	
	return privM or _M

_seeAll = (_M, privM={}) ->
	privMT =
		__index: 	(privM, k) -> _M[k] or _G[k]
		__newindex:	_M
	return setmetatable(privM, privMT)

print "module"

_ENV = _module(modName, _seeAll)

if _VERSION == "Lua 5.1"
	setfenv(1, _ENV) 

export module = _module
export seeAll = _seeAll

copyTable = (t) -> {k, v for k, v in pairs t}

-- Underscore indicates only safe to use on something that is explicitly an FC 
-- object
_mroOf 			= (c) -> rawget(getUserValue(c), s_MRO)
_nameOf 		= (c) -> rawget(getUserValue(c), s_Name)
_instTabOf 		= (c) -> rawget(getUserValue(c), s_Object)
_metaOf			= (c) -> rawget(getUserValue(c), s_Meta)

mroIter = (t, prev=1) -> () -> 
	prev = t[prev]
	return prev

print "Make MRO"
---- Generates a C3 order class list in MRO format
-- FirstClass stores MROs in a format which makes it easy to begin iterating 
-- from any class. For example, the MRO
--		[A, B, C, D]
-- is stored as
-- 		{1: A, A: B, B: C, C: D}
--
-- This function takes a class to generate an MRO for and a list of base 
-- classes, transforms their MROs to be linear, then uses the C3 rules in order
-- to generate an MRO for the class.
makeMRO = (cls, bases) ->
	classList = (cls) -> [c for c in mroIter _mroOf cls]
	lists = [classList(c) for _, c in ipairs bases]
	print("makeMRO", repr(bases), repr(lists))

	hasGoodHead = (L) ->
		h = L[1]
		for _, l in ipairs lists
			if l ~= L and l[#l] == h then return nil
		return h

	nextHead = () ->
		for _, l in ipairs lists
			print("Does[", repr(l), "] have good head?")
			h = hasGoodHead l
			if h then return h
		error("Impossible to calculate linearization for class \"" .. _nameOf(cls) .. "\"", 2) 
	
	purge = (l, p) ->
		for i, v in ipairs l
			if v == p 
				table.remove(l, i)

	purgeAll = (p) -> 
		for _, l in ipairs lists do purge(l, p)

	remainingClasses = () ->
		for _, l in ipairs lists
			if #l > 0 then return true
		return false

	lastClass = cls
	mro = { cls }

	while remainingClasses!
		-- Find a good head
		head = nextHead!
		purgeAll head

		mro[lastClass] = head
		lastClass = head
	return mro

-- Returns the type of an object, or a descriptive error on failure

--_typeOf = (obj) ->
--	ok, cls = pcall(_classOf, obj)
--	if ok 
--		return cls
--	else
--		error "typeOf invoked on non-FirstClass object(" .. cls .. ")"
_typeOf = (obj) -> rawGetMetatable(obj).__metatable
export typeOf = _typeOf

-- Returns a metatable handler for a non-binary operator
opImp = (op) -> 
	__op = "__" .. op
	(...) => 
		print(__op)
		return (_typeOf self)[__op](self, ...)

-- .. for a binary operator
binOpImp = (op) ->
	__op  = "__" .. op
	__rop = "__r" .. op
	(lhs, rhs) ->
		ok, tl = pcall(_typeOf, lhs)
		if ok
			return tl[op](lhs, rhs)
		ok, tr = pcall(_typeOf, rhs)
		if ok
			return tr[rop](lhs, rhs)
		error("No suitable implementation found for operator " .. op)

print "Build metatable"

-- Build the metatable template
objMetaTemplate =
	-- Standard
	call: 		opImp
	unm:  		opImp
	len:  		opImp
	newindex:	opImp

	tostring:	opImp

	-- Binary
	add:		binOpImp
	sub:		binOpImp
	mul:		binOpImp
	div:		binOpImp
	mod:		binOpImp
	pow:		binOpImp
	concat:		binOpImp
	eq:			binOpImp
	le:			binOpImp
objMetaTemplate = { "__" .. k, fn(k) for k, fn in pairs objMetaTemplate}

-- Index must be implemented specially else we would end up in an infinite loop
-- (Note all other operator implementations depend upon a working __index!)
--
-- We redirect invocations of the __index metamethod to the __index__ method 
-- on the class. __index__ is responsible for performing the actual lookup.
--
-- Why __index__ and not __index? Because the semantics are different. The
-- intention is that classes behave in a table-like manner. __index__ delegates
-- to __index whenever it cannot find a method using the usual lookup rules -
-- making the __index method a better semantic match
--
-- TODO: Implement caching for performance
objMetaTemplate.__index = (key) =>
	cls = _typeOf self
	instTab = _instTabOf cls
	
	ixMethod = rawget(instTab, '__index__')
	if ixMethod then return ixMethod(self, key)
	return cls.__index__(self, key)

constructObject = (cls, self) ->
	assert(type cls == "userdata")
	assert(type self  == "userdata")

	env = {}
	setUserValue(self, env)

	return self

newObject = () => constructObject(self, newproxy true)

-- Perform an MRO-wise search of an object
mroSearch = (key, toSearch=1) =>
	assert(type(self) == "userdata")
	assert(key ~= nil)
	print "mroSearch of " .. _nameOf(self) .. " for " .. tostring(key)

	mro = _mroOf self
	while true
		toSearch = mro[toSearch]
		--print("MRO search of " .. className(class) .. "; at " .. className(toSearch) .. "; for " .. key)
		if toSearch == nil then return nil

		val = rawget(_instTabOf(toSearch), key)
		if val then return val

-- Processes a descriptor that has been looked up
processDescriptor = (descriptor, val) =>
	print("processDescriptor", repr(descriptor), repr(val))
	get, set = nil, nil
	if descriptor
		get = (type(descriptor) == "userdata") and descriptor.__get
		set = (type(descriptor) == "userdata") and descriptor.__set

	if get and set
		print "Get+Set"
		return get(descriptor, self)
	elseif val
		print "Val"
		return val
	elseif get
		print "Get"
		return get(descriptor, self)
	else
		print "Desc"
		return descriptor

print "Make Type"

-- Initialize Type
_Type = newproxy true
export Type = _Type
constructObject(_Type, _Type)
_TypeMeta = copyTable objMetaTemplate
_TypeMeta.__metatable = _Type
rawSetMetatable(_Type, _TypeMeta)
_TypeUV = getUserValue _Type
_TypeUV[s_MRO]  = { _Type }
_TypeUV[s_Name] = "Class"
_TypeUV[s_Meta] = _TypeMeta
_TypeUV[s_Object] =
	__index__: (key) =>
		--print("Class.__index(instanceof " .. className(typeof(self)) .. ", " .. key ..")")
		print("Type.__index__", key)
		val = rawget(_instTabOf(self), key) 
		descriptor = mroSearch(self, key)

		return processDescriptor(self, descriptor, val) or _super(_Type, self).__index(self, key)
	

	__new: (cls, name, bases, methods) ->
		self = newObject(cls)
		print("Class.__new(", name, repr(bases))
		--print("Class.__new", class, name, bases, methods)
		
		rawSetMetatable(self, _metaOf cls)
		uv = getUserValue self
		meta = copyTable objMetaTemplate
		meta.__metatable = self
		rawset(uv, s_Name,  name)
		rawset(uv, s_Object, copyTable methods)
		rawset(uv, s_MRO, makeMRO(self, bases))
		rawset(uv, s_Meta, meta)

		print "Class.__new)"
		return self

	__init: (...) => nil

	__call: (...) =>
		print("__call", repr({...}))
		inst = mroSearch(self, "__new")(self, ...)
		print("__call(init)", repr(inst))
		mroSearch(self, "__init")(inst, ...)
		return inst

	__tostring: () =>
    	return "<Class " .. self.name .. ">" 

print "Make Object"

_Object = _Type("Object", {}, {})
export Object = _Object
_ObjectIT = _instTabOf _Object
_ObjectIT.__new = (type) ->
	self = newObject(type)
	rawSetMetatable(self, _metaOf type)
	rawset(getUserValue(self), s_Object, {})
	return self

_ObjectIT.__init = () =>
	-- Nothing

_ObjectIT.__index__ = (key) =>
	print("Object.__index__", key)
	val = rawget(_instTabOf(self), key)
	descriptor = mroSearch(_typeOf(self), key)

	return processDescriptor(self, descriptor, val) or _typeOf(self).__index(self, key)
    
_ObjectIT.__index = (key) => nil
	
_ObjectIT.__newindex = (key, value) =>
	descriptor = mroSearch(_typeOf(self), key)
	if descriptor
		set = (type(descriptor) == "userdata") and descriptor.__set
		if set
			return set(descriptor, self, value)
		
	return rawset(_instTabOf(self), key, value)

_ObjectIT.__tostring = () => 
	print("__tostring!", repr(rawGetMetatable(self)))
	return string.format("[%s %s]", _typeOf(self).name, pointerString(self))
_ObjectIT.__eq = rawequal

-- Patch the Type MRO
_mroOf(_Type)[_Type] = _Object

print "Super & etc"

_super = (type, self) ->
	proxy = newproxy(true)
	proxyMT =
		__index: (_, key) -> mroSearch(_typeOf(self), key, type)
	rawSetMetatable(proxy, proxyMT)
	return proxy
_ENV['super'] = _super

_Property = _Type("Property", {Object}, {
    __init: (get, set) =>
    	print("Property.__init", repr(self))
        _super(Property, self).__init(self)
        if get then self.__get = (obj)      => return get(obj)
        if set then self.__set = (obj, val) => return set(obj, val)
})
export Property = _Property
print(repr rawGetMetatable _Property)

roProperty = (get) -> return _Property(get, () -> error("Setting readonly property"))

_Type.name = roProperty(() => (_nameOf self) or ("<no s_Name on " ..(tostring _typeOf self) .. " instance>"))
_Type.mro  = roProperty(() => [v for v in mroIter])

n = Type.name
print("!!", repr(n))
print("Type.name:", n)