nomsu/lib/object.nom

#!/usr/bin/env nomsu -V1
#
    This file contains the implementation of an Object-Oriented programming system.

use "core"

compile [@, me] to: Lua value "self"

compile [method %actions %body] to
    %lua <- (compile as: action %actions %body)
    add free vars ((% as lua id) for % in %actions) to %lua
    declare locals in %lua
    for % in %actions
        to %lua write "\nclass.\(% as lua id) = \(% as lua id)"
    return
        Lua ".."
            do -- Method: \(%actions.1.stub)
                \%lua
            end

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
parse [as %instance %body] as
    result of
        %old_self <- (me)
        (me) <- %instance
        try
            %body
        ..and if it barfs %msg
            (me) <- %old_self
            barf %msg
        ..or if it succeeds
            (me) <- %old_self

compile [object %classname extends %parent %class_body] to
    Lua ".."
        do
            local class = {name=\(%classname as lua expr)}
            setmetatable(class, {
                __index=\(%parent as lua expr),
                __tostring=function(cls) return cls.name end,
                __call=function(cls, inst)
                    inst = setmetatable(inst or {}, cls)
                    if cls.A_initialize_1 then
                        cls.A_initialize_1(inst)
                    end
                    return inst
                end,
            })
            _ENV["A"..string.as_lua_id("new "..class.name)] = class
            _ENV["A"..string.as_lua_id("new "..class.name.." 1")] = class
            _ENV["A"..string.as_lua_id("class "..class.name)] = function() return class end
            class.__index = class
            class.class = class

            \(%class_body as lua statements)

            class.__tostring = class["A"..string.as_lua_id("as text")]
        end

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
parse [object %classname %class_body] as: object %classname extends (nil) %class_body