nomsu/lib/things.nom

#!/usr/bin/env nomsu -V4.10.12.7
#
    A library for simple object oriented programming.
    
%globals.METAMETHOD_MAP = {..}
    "as text": "__tostring", "clean up": "__gc", "+": "__add", "-": "__sub"
    "*": "__mul", "/": "__div", negative: "__unm", "//": "__idiv", mod: "__mod"
    "^": "__pow", "&": "__band", "|": "__bor", "~": "__bxor", "~": "__bnot"
    "<<": "__bshl", ">>": "__bshr", "==": "__eq", "<": "__lt", "<=": "__le"
    "set 1 =": "__newindex", size: "__len", iterate: "__ipairs", "iterate all": "__pairs"

test:
    an (Empty) is a thing
    a (Dog) is a thing:
        that can (set up) by:
            %its.barks or= 0
        
        whose [bark, woof] all mean:
            %barks = [: for % in 1 to %its.barks: add "Bark!"]
            return (%barks::joined with " ")
        
        that can (get pissed off) by: %its.barks += 1
    (Dog).genus = "Canus"
    %d = (a Dog with {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 = (a Dog)
    assume (%d2.barks == 0) or barf "Default initializer failed"
    with {%d: a Dog with {barks: 1}}:
        assume ((%d::bark) == "Bark!")
    
    a (Corgi) is a thing:
        that can [set up, get pissed off] like a (Dog)
        whose (sploot) means "splooted"
        whose [bark, woof] all mean:
            %barks = [: for % in 1 to %its.barks: add "Yip!"]
            return (%barks::joined with " ")
    
    %corg = (a Corgi)
    assume (%corg.barks == 0)
    with {%d: a Corgi with {barks: 1}}:
        assume ((%d::sploot) == "splooted") or barf "subclass method failed"
        assume ((%d::bark) == "Yip!") or barf "inheritance failed"
        assume ((%d::woof) == "Yip!")
    
    with {%d: a Dog with {barks: 2}}:
        assume ((%d::bark) == "Bark! Bark!")

[..]
    that can %actions by %body, whose %actions means %body
    whose %actions all mean %body
..all compile to:
    unless (%actions.type == "List"):
        %actions = [%actions]
    
    lua> "\
        ..local fn_name = \%actions[1].stub:as_lua_id()
        local \%args = List{\(\%its), unpack(\%actions[1]:get_args())}
        local lua = LuaCode("class.", fn_name, " = ", \(what (%args -> %body) compiles to))
        for i=2,#\%actions do
            local alias = \%actions[i]
            local alias_name = alias.stub:as_lua_id()
            local \%alias_args = List{\(\%its), unpack(alias:get_args())}
            lua:append("\\nclass.", alias_name, " = ")
            if \%alias_args == \%args then
                lua:append("class.", fn_name)
            else
                lua:append("function(")
                lua:concat_append(table.map(\%alias_args, function(a) return compile(a) end), ", ")
                lua:append(")\\n    return class.", fn_name, "(")
                lua:concat_append(table.map(\%args, function(a) return compile(a) end), ", ")
                lua:append(")\\nend")
            end
        end
        return lua"

[..]
    that can %actions like a %class, that can %actions like an %class
    that has %actions like a %class, that has %actions like an %class
..all compile to:
    %lua = (Lua "")
    %class_expr = (%class as lua expr)
    %lines = []
    for %a in %actions:
        %lines::add "class.\(%a.stub::as lua id) = \%class_expr.\(%a.stub::as lua id)"
    %lua::add %lines joined with "\n"
    return %lua

[..]
    a %classname is a thing with %members %class_body
    an %classname is a thing with %members %class_body
..all compile 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, {
                    __tostring=function(cls) return cls.name end,
                    __call=function(cls, inst)
                        inst = setmetatable(inst or {}, cls)
                        if inst.set_up then inst:set_up() end
                        return inst
                    end,
                })
                class.__members = \(%members as lua expr)
                _ENV[("a "..class.name):as_lua_id()] = class
                _ENV[("an "..class.name):as_lua_id()] = class
                _ENV[("a "..class.name.." with"):as_lua_id()] = class
                _ENV[("an "..class.name.." with"):as_lua_id()] = class
                _ENV[class.name:as_lua_id()] = function() return class end
                class.__index = class
                class.class = class
                local dict_tostring = getmetatable(Dict{}).__tostring
                class.__tostring = function(inst)
                    return inst.name..dict_tostring(inst)
                end
                \((%class_body as lua) if %class_body else "")
                for stub,metamethod in pairs(globals.METAMETHOD_MAP) do
                    class[metamethod] = class[stub:as_lua_id()]
                end
                if class.__members then
                    assert(select(2, next(class.__members)) == true)
                    getmetatable(class).__newindex = function(its, key, value)
                        if class.__members[key] then
                            rawset(its, key, value)
                        else error("Not a valid member: "..tostring(key)) end
                    end
                end
            end"

[a %classname is a thing %class_body, an %classname is a thing] all parse as (..)
    a %classname is a thing with (nil) %class_body