aboutsummaryrefslogtreecommitdiff
path: root/lib/things.nom
blob: 711332527c1ac8314cd487dddf1306cc499afedd (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
158
#!/usr/bin/env nomsu -V6.15.13.8
#
    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 " ")
        
        ($its, get pissed off) means: $its.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, 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)
    unless ($d2.barks == 0):
        fail "Default initializer failed"
    
    with [$d = (a Dog with {.barks = 1})]:
        assume (($d, bark) == "Bark!")
    
    a (Corgi) is 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})

$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
external:
    [
        a $parent class named $classname with $members $(initialize $)
        an $parent class named $classname with $members $(initialize $)
    ] all mean:
        $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 {
            .__index = $parent
            .__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 $parent with $members $class_body
        an $classname is a $parent with $members $class_body
        a $classname is an $parent with $members $class_body
        an $classname is an $parent with $members $class_body
    ] all compile to:
        $class_id = ($classname.stub, as lua id)
        $lua =
            Lua ("
                \$class_id = a_1_class_named_2_with(\($parent as lua), \(quote $classname.stub), \($members as lua)\(
                    (
                        Lua ("
                            , function(\$class_id)
                                local it, its = \$class_id, \$class_id;
                                \($class_body as lua)
                            end
                        ")
                    ) if $class_body else ""
                ))
                a_\$class_id = function(initial_values) return \$class_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
            ")
        
        $lua, add free vars [$class_id, "a_\$class_id", "an_\$class_id"]
        return $lua

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

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

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