blob: a0292ccc3bc031abbee329a0371fcbe45debc8fc (
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
|
(.module:
[lux (#- Type)
[abstract
["." monad (#+ do)]]
[control
[state (#+ State)]]
[data
[number
["." i32]
["n" nat]]
[collection
["." list ("#@." monoid functor)]
["." row]]
[format
[".F" binary]]]
[target
[jvm
["." version]
["." modifier (#+ Modifier) ("#@." monoid)]
["." field (#+ Field)]
["." method (#+ Method)]
["_" instruction (#+ Label Instruction) ("#@." monad)]
["." class (#+ Class)]
["." type (#+ Type)
[category (#+ Return' Value')]
["." reflection]]
["." constant
[pool (#+ Pool)]]
[encoding
["." name (#+ External Internal)]
["." unsigned]]]]]
["." / #_
["#." abstract]
[field
[constant
["#." arity]]
[variable
["#." foreign]
["#." partial]]]
[method
["#." init]
["#." new]
["#." implementation]
["#." reset]
["#." apply]]
["/#" // #_
["#." runtime (#+ Operation Phase)]
[////
[reference (#+ Register)]
[analysis (#+ Environment)]
[synthesis (#+ Synthesis Abstraction Apply)]
["." arity (#+ Arity)]
["." phase
["." generation]]]]])
(def: #export (with @begin class environment arity body)
(-> Label External Environment Arity (Instruction Any)
(Operation [(List (State Pool Field))
(List (State Pool Method))
(Instruction Any)]))
(let [classT (type.class class (list))
fields (: (List (State Pool Field))
(list& /arity.constant
(list@compose (/foreign.variables environment)
(/partial.variables arity))))
methods (: (List (State Pool Method))
(list& (/init.method classT environment arity)
(/reset.method classT environment arity)
(if (arity.multiary? arity)
(|> (n.min arity /arity.maximum)
list.indices
(list@map (|>> inc (/apply.method classT environment arity @begin body)))
(list& (/implementation.method arity @begin body)))
(list (/implementation.method' /apply.name arity @begin body)))))]
(do phase.monad
[instance (/new.instance classT environment arity)]
(wrap [fields methods instance]))))
(def: modifier
(Modifier Class)
($_ modifier@compose
class.public
class.final))
(def: this-offset 1)
(def: internal
(All [category]
(-> (Type (<| Return' Value' category))
Internal))
(|>> type.reflection reflection.reflection name.internal))
(def: #export (abstraction generate [environment arity bodyS])
(-> Phase Abstraction (Operation (Instruction Any)))
(do phase.monad
[@begin //runtime.forge-label
[function-class bodyG] (generation.with-context
(generation.with-anchor [@begin ..this-offset]
(generate bodyS)))
[fields methods instance] (..with @begin function-class environment arity bodyG)
_ (generation.save! true ["" function-class]
[function-class
(<| (binaryF.run class.writer)
(class.class version.v6_0
..modifier
(name.internal function-class)
(..internal /abstract.class) (list)
fields
methods
(row.row)))])]
(wrap instance)))
(def: #export (apply generate [abstractionS inputsS])
(-> Phase Apply (Operation (Instruction Any)))
(do phase.monad
[abstractionG (generate abstractionS)
inputsG (monad.map @ generate inputsS)]
(wrap ($_ _.compose
abstractionG
(|> inputsG
(list.split-all /arity.maximum)
(monad.map _.monad
(function (_ batchG)
($_ _.compose
(_.checkcast /abstract.class)
(monad.seq _.monad batchG)
(_.invokevirtual /abstract.class /apply.name (/apply.type (list.size batchG)))
))))
))))
|
