blob: 65c7e58aaec695085c72d7fcfc139cae6c59ee15 (
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
|
(ns lux.compiler.lambda
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|do return* return fail fail*]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
[analyser :as &analyser]
[host :as &host])
[lux.analyser.base :as &a]
(lux.compiler [base :as &&]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
MethodVisitor)))
;; [Utils]
(def ^:private clo-field-sig (&host/->type-signature "java.lang.Object"))
(def ^:private lambda-return-sig (&host/->type-signature "java.lang.Object"))
(def ^:private <init>-return "V")
(def ^:private lambda-impl-signature
(str "(" clo-field-sig ")" lambda-return-sig))
(defn ^:private lambda-<init>-signature [env]
(str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")"
<init>-return))
(defn ^:private add-lambda-<init> [class class-name env]
(doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "<init>" (lambda-<init>-signature env) nil nil)
(.visitCode)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
(-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(matchv ::M/objects [?name+?captured]
[[?name [["captured" [_ ?captured-id ?source]] _]]])
(doseq [?name+?captured (&/->seq env)])))
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd)))
(defn ^:private add-lambda-apply [class class-name env]
(doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "apply" &&/apply-signature nil nil)
(.visitCode)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ALOAD 1)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" lambda-impl-signature)
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
(defn ^:private add-lambda-impl [class compile impl-signature impl-body]
(&/with-writer (doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "impl" impl-signature nil nil)
(.visitCode))
(|do [^MethodVisitor *writer* &/get-writer
:let [num-locals (&&/total-locals impl-body)
$start (new Label)
$end (new Label)
_ (doto *writer*
(-> (.visitLocalVariable (str &&/local-prefix idx) (&host/->java-sig (&/V "lux;DataT" "java.lang.Object")) nil $start $end (+ 2 idx))
(->> (dotimes [idx num-locals])))
(.visitLabel $start))]
ret (compile impl-body)
:let [_ (doto *writer*
(.visitLabel $end)
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd))]]
(return ret))))
(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW lambda-class)
(.visitInsn Opcodes/DUP))]
_ (&/map% (fn [?name+?captured]
(matchv ::M/objects [?name+?captured]
[[?name [["captured" [_ _ ?source]] _]]]
(compile ?source)))
closed-over)
:let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
(return nil)))
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?body]
(|do [:let [lambda-class (&host/location ?scope)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
lambda-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
(-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(matchv ::M/objects [?name+?captured]
[[?name [["captured" [_ ?captured-id ?source]] _]]])
(doseq [?name+?captured (&/->seq ?env)])))
(add-lambda-apply lambda-class ?env)
(add-lambda-<init> lambda-class ?env)
)]
_ (add-lambda-impl =class compile lambda-impl-signature ?body)
:let [_ (.visitEnd =class)]
_ (&&/save-class! lambda-class (.toByteArray =class))]
(instance-closure compile lambda-class ?env (lambda-<init>-signature ?env))))
|
