File: gen_fn_invokers.clj

package info (click to toggle)
clojure 1.12.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 4,704 kB
  • sloc: java: 43,177; xml: 599; sh: 68; makefile: 50
file content (173 lines) | stat: -rw-r--r-- 5,926 bytes parent folder | download
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
;; This code was used to generate the clojure.lang.FnInvokers class in
;; Clojure 1.12. This code is not intended to be reused but might be
;; useful in the future as a template for other code gen.

(ns gen-fn-invokers
  (:require
    [clojure.string :as str]))

(def header
  "/**
 *   Copyright (c) Rich Hickey. All rights reserved.
 *   The use and distribution terms for this software are covered by the
 *   Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0)
 *   which can be found in the file epl-v10.html at the root of this distribution.
 *   By using this software in any fashion, you are agreeing to be bound by
 * 	 the terms of this license.
 *   You must not remove this notice, or any other, from this software.
 **/

package clojure.lang;

public class FnInvokers {

    // Encode invoker param/return class to code for method name
    static char encodeInvokerType(Class c) {
        if(Long.TYPE.equals(c)) {
            return 'L';
        } else if(Double.TYPE.equals(c)) {
            return 'D';
        } else if(Integer.TYPE.equals(c)) {
            return 'I';
        } else if(Short.TYPE.equals(c)) {
            return 'S';
        } else if(Byte.TYPE.equals(c)) {
            return 'B';
        } else if(Float.TYPE.equals(c)) {
            return 'F';
        } else {
            return 'O';
        }
    }

")

(def footer
  "}")

(def invokeO-format
  "    public static Object invoke%sO(IFn f0%s) {
        return f0.invoke(%s);
    }")

(def invokeO-with-l-or-d-arg-format
  "    public static Object invoke%sO(IFn f0%s) {
        if(f0 instanceof IFn.%sO) {
            return ((IFn.%sO)f0).invokePrim(%s);
        } else {
            return f0.invoke(%s);
        }
    }")

(def invokeD-format
  "    public static double invoke%sD(IFn f0%s) {
        if(f0 instanceof IFn.%sD) {
            return ((IFn.%sD)f0).invokePrim(%s);
        } else {
            return RT.doubleCast(f0.invoke(%s));
        }
    }")

(def invokeF-format
  "    public static float invoke%sF(IFn f0%s) {
        if(f0 instanceof IFn.%sD) {
            return RT.floatCast(((IFn.%sD)f0).invokePrim(%s));
        } else {
            return RT.floatCast(f0.invoke(%s));
        }
    }")

(def invokeL-format
  "    public static long invoke%sL(IFn f0%s) {
        if(f0 instanceof IFn.%sL) {
            return ((IFn.%sL)f0).invokePrim(%s);
        } else {
            return RT.longCast(f0.invoke(%s));
        }
    }")

(def invokeI-format
  "    public static int invoke%sI(IFn f0%s) {
        if(f0 instanceof IFn.%sL) {
            return RT.intCast(((IFn.%sL)f0).invokePrim(%s));
        } else {
            return RT.intCast(f0.invoke(%s));
        }
    }")

(def invokeS-format
  "    public static short invoke%sS(IFn f0%s) {
        if(f0 instanceof IFn.%sL) {
            return RT.shortCast(((IFn.%sL)f0).invokePrim(%s));
        } else {
            return RT.shortCast(f0.invoke(%s));
        }
    }")

(def invokeB-format
  "    public static byte invoke%sB(IFn f0%s) {
        if(f0 instanceof IFn.%sL) {
            return RT.byteCast(((IFn.%sL)f0).invokePrim(%s));
        } else {
            return RT.byteCast(f0.invoke(%s));
        }
    }")

(def alphabet (map char (range 97 122)))

(def arg-types {:D ", double "
                :L ", long "
                :O ", Object "})

(defn gen-invoke [sig]
  (let [formatter (str (last sig))
        args (map str (butlast sig))
        arg-types (map #(get arg-types (keyword %)) args)
        fn-vars (str/join "" (map #(str %1 %2) arg-types (take (count args) alphabet)))
        fn-vars-sans-type (str/join ", " (take (count args) alphabet))
        arg-str (str/join args)]
    (case formatter
      "O" (if (some #{"D" "L"} args)
            (format invokeO-with-l-or-d-arg-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
            (format invokeO-format arg-str fn-vars fn-vars-sans-type))
      "L" (format invokeL-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
      "I" (format invokeI-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
      "S" (format invokeS-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
      "B" (format invokeB-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
      "D" (format invokeD-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type)
      "F" (format invokeF-format arg-str fn-vars arg-str arg-str fn-vars-sans-type fn-vars-sans-type))))

(defn sigs [args return-types]
  (let [fun-sig-reducer (fn [res ret]
                          (mapcat seq [res (map (fn [params]
                                                  (str params ret)) args)]))]
    (reduce fun-sig-reducer [] return-types)))

(defn gen-sigs []
  (let [small-rets ["L" "I" "S" "B" "D" "F" "O"]
        zero-arity (sigs [""] small-rets)
        single-arity (sigs ["L" "D" "O"] small-rets)
        two-arity (sigs ["LL" "LO" "OL" "DD" "LD" "DL" "OO" "OD" "DO"] small-rets)
        big-rets ["O"]
        three-arity (sigs ["OOO"] big-rets)
        four-arity  (sigs ["OOOO"] big-rets)
        five-arity  (sigs ["OOOOO"] big-rets)
        six-arity   (sigs ["OOOOOO"] big-rets)
        seven-arity (sigs ["OOOOOOO"] big-rets)
        eight-arity (sigs ["OOOOOOOO"] big-rets)
        nine-arity  (sigs ["OOOOOOOOO"] big-rets)
        ten-arity   (sigs ["OOOOOOOOOO"] big-rets)]
    (mapcat seq [zero-arity single-arity two-arity three-arity four-arity five-arity six-arity seven-arity eight-arity nine-arity ten-arity])))

(defn gen-invokers []
  (let [sb (StringBuilder. ^String header)
        invoker-signatures (gen-sigs)]
    (doseq [sig invoker-signatures]
      (.append sb (gen-invoke sig))
      (.append sb "\n\n"))
    (.append sb footer)
    (spit "src/jvm/clojure/lang/FnInvokers.java" (.toString sb))))

(comment
  (gen-invokers)
  )