blob: 7308c073439ec15192d2ef2da013d19877b94280 (
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
|
(.module:
[lux (#- Type type)
[abstract
["." monad]]
[control
["." try]]
[data
[number
["n" nat]]
[collection
["." list ("#@." monoid functor)]]]
[target
[jvm
["_" bytecode (#+ Bytecode)]
["." method (#+ Method)]
[encoding
["." unsigned]]
[constant
[pool (#+ Resource)]]
["." type (#+ Type)
["." category (#+ Class Value)]]]]]
["." //
["#." implementation]
["/#" // #_
["#." abstract]
[field
[constant
["#." arity]]
[variable
["#." foreign]
["#." partial]]]
["/#" // #_
["#." type]
["#." reference]
[////
[reference (#+ Register)]
[analysis (#+ Environment)]
["." arity (#+ Arity)]]]]])
(def: #export name "<init>")
(def: (partials arity)
(-> Arity (List (Type Value)))
(list.repeat (dec arity) ////type.value))
(def: #export (type environment arity)
(-> Environment Arity (Type category.Method))
(type.method [(list@compose (///foreign.closure environment)
(if (arity.multiary? arity)
(list& ///arity.type (..partials arity))
(list)))
type.void
(list)]))
(def: no-partials (|> 0 unsigned.u1 try.assume _.bipush))
(def: #export (super environment-size arity)
(-> Nat Arity (Bytecode Any))
(let [arity-register (inc environment-size)]
($_ _.compose
(if (arity.unary? arity)
..no-partials
(_.iload arity-register))
(_.invokespecial ///abstract.class ..name ///abstract.init))))
(def: (store-all amount put offset)
(-> Nat
(-> Register (Bytecode Any) (Bytecode Any))
(-> Register Register)
(Bytecode Any))
(|> (list.indices amount)
(list@map (function (_ register)
(put register
(_.aload (offset register)))))
(monad.seq _.monad)))
(def: #export (method class environment arity)
(-> (Type Class) Environment Arity (Resource Method))
(let [environment-size (list.size environment)
offset-foreign (: (-> Register Register)
(n.+ 1))
offset-arity (: (-> Register Register)
(|>> offset-foreign (n.+ environment-size)))
offset-partial (: (-> Register Register)
(|>> offset-arity (n.+ 1)))]
(method.method //.modifier ..name
(..type environment arity)
(list)
(#.Some ($_ _.compose
////reference.this
(..super environment-size arity)
(store-all environment-size (///foreign.put class) offset-foreign)
(store-all (dec arity) (///partial.put class) offset-partial)
_.return)))))
|
