nomsu/lib/object.nom

#!/usr/bin/env nomsu -V6.14
#
    This file contains the implementation of an Object-Oriented programming system.
    
$globals.METAMETHOD_MAP = {
    ."as text" = "__tostring", ."clean up" = "__gc", ."+ 1" = "__add"
    ."- 1" = "__sub", ."* 1" = "__mul", ."/ 1" = "__div", ."-" = "__unm"
    ."// 1" = "__idiv", ."mod 1" = "__mod", ."^ 1" = "__pow", ."& 1" = "__band"
    ."| 1" = "__bor", ."~ 1" = "__bxor", ."~" = "__bnot", ."<< 1" = "__bshl"
    .">> 1" = "__bshr", ."== 1" = "__eq", ."< 1" = "__lt", ."<= 1" = "__le"
    ."set 1 = 2" = "__newindex", .size = "__len", .iterate = "__ipairs"
    ."iterate all" = "__pairs"
}

test:
    object (Dog):
        (Dog).genus = "Canus"
        my action [set up]:
            $me.barks or= 0
        
        my action [bark, woof]:
            $barks = [: for $ in 1 to $me.barks: add "Bark!"]
            return ($barks, joined with " ")
        
        my action [get pissed off]: $me.barks += 1
    $d = (Dog {.barks = 2})
    assume (type of $d) == "Dog"
    assume ($d is a "Dog")
    assume $d.barks == 2
    assume (($d, bark) == "Bark! Bark!")
    assume (($d, woof) == "Bark! Bark!")
    $d, get pissed off
    assume ($d.barks == 3)
    assume (($d, bark) == "Bark! Bark! Bark!")
    assume ($d.genus == "Canus")
    assume ("\($d.class)" == "Dog")
    assume ($d.genus == "Canus")
    assume ($d.barks == 3)
    $d2 = (Dog {})
    unless ($d2.barks == 0):
        fail "Default initializer failed"
    
    with [$d = (Dog {.barks = 1})]:
        assume (($d, bark) == "Bark!")
    
    object (Corgi) extends (Dog):
        my action [sploot] "splooted"
        my action [bark, woof]:
            $barks = [: for $ in 1 to $me.barks: add "Yip!"]
            return ($barks, joined with " ")
    
    $corg = (Corgi {})
    assume ($corg.barks == 0)
    with [$d = (Corgi {.barks = 1})]:
        unless (($d, sploot) == "splooted"):
            fail "subclass method failed"
        
        unless (($d, bark) == "Yip!"):
            fail "inheritance failed"
        
        assume (($d, woof) == "Yip!")
    
    with [$d = (Dog {.barks = 2})]:
        assume (($d, bark) == "Bark! Bark!")

(my action $actions $body) compiles to:
    lua> ("
        local fn_name = \$actions[1].stub:as_lua_id()
        local \$args = List(\$actions[1]:get_args())
        table.insert(\$args, 1, \(\$me))
        local lua = LuaCode("class.", fn_name, " = ", \(\($args -> $body) as lua))
        for i=2,#\$actions do
            local alias = \$actions[i]
            local alias_name = alias.stub:as_lua_id()
            local \$alias_args = List(alias:get_args())
            table.insert(\$alias_args, 1, \(\$me))
            lua:add("\\nclass.", alias_name, " = ")
            if \$args == \$alias_args then
                lua:add("class.", fn_name)
            else
                lua:add(\(\($alias_args -> $actions.1) as lua))
            end
        end
        return lua
    ")

(object $classname extends $parent $class_body) compiles to:
    unless ($classname.type == "Action"):
        compile error at $classname
            "Expected this to be an action, not a \$classname.type"
    
    for $ in $classname:
        unless ($ is text):
            compile error at $ "Class names should not have arguments."
    
    return
        Lua ("
            do
                local class = {name=\(quote $classname.stub)}
                class.__type = class.name
                setmetatable(class, {
                    __index=\($parent as lua expr),
                    __tostring=function(cls) return cls.name end,
                    __call=function(cls, inst)
                        if inst == nil then return cls end
                        inst = setmetatable(inst, cls)
                        if inst.set_up then inst:set_up() end
                        return inst
                    end,
                })
                _ENV[class.name:as_lua_id()] = class
                class.__index = class
                class.class = class
                class.__tostring = function(inst)
                    return inst.name..getmetatable(Dict{}).__tostring(inst)
                end
                \($class_body as lua)
                for stub,metamethod in pairs(globals.METAMETHOD_MAP) do
                    class[metamethod] = class[stub:as_lua_id()]
                end
            end
        ")

(object $classname $class_body) parses as
    object $classname extends (nil) $class_body