126 lines
4.4 KiB
Plaintext
126 lines
4.4 KiB
Plaintext
#!/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,
|
|
})
|
|
\(nomsu environment name)[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
|