aboutsummaryrefslogtreecommitdiff
path: root/lib/things.nom
blob: 95f175d7a0378484afe0f4971ca23c771cf0ec46 (plain)
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
#!/usr/bin/env nomsu -V6.14
#
    A library for simple object oriented programming.
    
test:
    an (Empty) is a thing
    a (Dog) is a thing:
        ($its, set up) means:
            $its.barks or= 0
        
        [($its, bark), ($its, woof)] all mean:
            $barks = [: for $ in 1 to $its.barks: add "Bark!"]
            return ($barks, joined with " ")
        
        ($it, gets pissed off) means: $it.barks += 1
    (Dog).genus = "Canus"
    $d = (a Dog with {.barks = 2})
    assume "\$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, gets 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)
    unless ($d2.barks == 0):
        fail "Default initializer failed"
    
    with [$d = (a Dog with {.barks = 1})]:
        assume (($d, bark) == "Bark!")
    
    a (Corgi) is a thing:
        $it can [set up, gets pissed off] like a (Dog)
        ($it, as text) means "Dogloaf \{: for $k = $v in $it: add $k = $v}"
        ($its, sploot) means "sploooot"
        [($its, bark), ($its, woof)] all mean:
            $barks = [: for $ in 1 to $its.barks: add "Yip!"]
            return ($barks, joined with " ")
    
    $corg = (a Corgi)
    assume ($corg.barks == 0)
    assume "\$corg" == "Dogloaf {barks: 0}"
    with [$d = (a Corgi with {.barks = 1})]:
        unless (($d, sploot) == "sploooot"):
            fail "subclass method failed"
        
        unless (($d, bark) == "Yip!"):
            fail "inheritance failed"
        
        assume (($d, woof) == "Yip!")
    
    with [$d = (a Dog with {.barks = 2})]:
        assume (($d, bark) == "Bark! Bark!")
    
    a (Vec) is a thing with {.x, .y}:
        ($its, + $other) means (Vec {.x = ($its.x + $other.x), .y = ($its.y + $other.y)})
    
    assume ((Vec {.x = 1, .y = 2}) + (Vec {.x = 10, .y = 10})) ==
        Vec {.x = 11, .y = 12}
    
    assume
        ((Vec {.x = 1, .y = 2}) + (Vec {.x = 10, .y = 10})) != (Vec {.x = 0, .y = 0})

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

$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"
}

$($ as text like a dict) = ({}'s metatable).__tostring
externally (a class named $classname with $members $(initialize $)) means:
    $class = {.__type = $classname}
    $class.__index = $class
    $class.class = $class
    $class.__tostring = ($ -> "\($.__type) \($ as text like a dict)")
    $class.__eq = ({}'s metatable).__eq
    $class.__len = ({}'s metatable).__len
    if $members:
        $class.__members = $members
        $class.__newindex =
            for ($its $key = $value):
                if $members.$key:
                    rawset $its $key $value
                ..else:
                    fail "Cannot set \$key, it's not one of the allowed member fields."
    
    set $class's metatable to {
        .__tostring = ($class -> $class.__type)
        .__call =
            for ($class with $initial_values):
                if ($initial_values == (nil)): return $class
                set $initial_values's metatable to $class
                if $initial_values.set_up:
                    $initial_values, set up
                return $initial_values
    }
    
    if $(initialize $):
        initialize $class
        for $stub = $metamethod in $METAMETHOD_MAP:
            if $class.($stub, as lua id):
                $class.$metamethod = $class.($stub, as lua id)
    
    return $class

[
    a $classname is a thing with $members $class_body
    an $classname is a thing with $members $class_body
] all compile to:
    $class_id = ($classname.stub, as lua id)
    if $class_body:
        $body_lua = ($class_body as lua)
        $body_lua, remove free vars [$class_id]
        $body_lua, declare locals
    
    return
        Lua ("
            \$class_id = a_class_named_1_with(\(quote $classname.stub), \($members as lua)\(
                (
                    Lua ("
                        , function(\$class_id)
                            local it, its = \$class_id, \$class_id;
                            \$body_lua
                        end
                    ")
                ) if $class_body else ""
            ))
            a_\$class_id = function(initial_values) return \($classname.stub, as lua id)(initial_values \
            ..or {}) end
            an_\$class_id, a_\($class_id)_with, an_\($class_id)_with = a_\$class_id, a_\$class_id, a_\$class_id
        ")

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