1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!/usr/bin/env nomsu -V6.15.13.8
#
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
|
