aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/module.clj7
-rw-r--r--src/lux/compiler.clj21
-rw-r--r--src/lux/compiler/base.clj17
-rw-r--r--src/lux/compiler/cache.clj46
-rw-r--r--src/lux/compiler/cache/ann.clj159
-rw-r--r--src/lux/compiler/cache/type.clj164
-rw-r--r--src/lux/compiler/lux.clj55
7 files changed, 394 insertions, 75 deletions
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 21aa324e8..61b11b596 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -361,13 +361,14 @@
(return* state
(->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs)
(&/|map (fn [kv]
- (|let [[k [?def-type ?def-meta ?def-value]] kv]
+ (|let [[k _def-data] kv
+ [_ ?def-meta _] _def-data]
(|case (&meta/meta-get &meta/alias-tag ?def-meta)
(&/$Some (&/$IdentM [?r-module ?r-name]))
- (&/T [k (str ?r-module ";" ?r-name)])
+ (&/T [k (str ?r-module ";" ?r-name) _def-data])
_
- (&/T [k ""])
+ (&/T [k "" _def-data])
)))))))))
(do-template [<name> <type> <tag> <desc>]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 39e475aaa..869ee84d7 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -30,7 +30,9 @@
[lambda :as &&lambda]
[module :as &&module]
[io :as &&io]
- [parallel :as &&parallel]))
+ [parallel :as &&parallel])
+ (lux.compiler.cache [type :as &&&type]
+ [ann :as &&&ann]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -213,12 +215,20 @@
defs &a-module/defs
imports &a-module/imports
tag-groups &&module/tag-groups
- :let [^String defs-value (->> defs
+ :let [^String def-entries (->> defs
+ (&/|map (fn [_def]
+ (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def]
+ (if (= "" ?alias)
+ (str ?name &&/def-datum-separator (&&&type/serialize-type ?def-type) &&/def-datum-separator (&&&ann/serialize-anns ?def-anns))
+ (str ?name &&/def-datum-separator ?alias)))))
+ (&/|interpose &&/def-entry-separator)
+ (&/fold str ""))
+ ^String defs-value (->> defs
(&/|filter (fn [_def]
- (|let [[?name ?alias] _def]
+ (|let [[?name ?alias [?def-type ?def-meta ?def-value]] _def]
(= "" ?alias))))
(&/|map (fn [_def]
- (|let [[?name ?alias] _def]
+ (|let [[?name ?alias [?def-type ?def-meta ?def-value]] _def]
(str ?name
&&/exported-separator
?alias))))
@@ -258,7 +268,8 @@
(return nil)))
:let [_ (.visitEnd =class)]
_ (&/flag-compiled-module name)
- _ (&&/save-class! &/module-class-name (.toByteArray =class))]
+ _ (&&/save-class! &/module-class-name (.toByteArray =class))
+ _ (&&/write-module-descriptor! name def-entries)]
(return file-hash))
?state)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index a369b7436..fcb153662 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -52,6 +52,9 @@
(def ^:const field-separator "\t")
(def ^:const entry-separator "\n")
+(def ^:const def-datum-separator (->> 31 char str))
+(def ^:const def-entry-separator (->> 30 char str))
+
;; [Utils]
(defn ^:private write-file [^String file-name ^bytes data]
(do (assert (not (.exists (File. file-name))) (str "Can't overwrite file: " file-name))
@@ -88,6 +91,20 @@
_ (load-class! loader real-name)]]
(return nil)))
+(def ^String lux-module-descriptor-name "lux_module_descriptor")
+
+(defn write-module-descriptor! [^String name ^String descriptor]
+ (|do [_ (return nil)
+ :let [lmd-dir (str @!output-dir "/" name)
+ _ (.mkdirs (File. lmd-dir))
+ _ (write-file (str lmd-dir "/" lux-module-descriptor-name) (.getBytes descriptor java.nio.charset.StandardCharsets/UTF_8))]]
+ (return nil)))
+
+(defn read-module-descriptor! [^String name]
+ (|do [_ (return nil)]
+ (return (slurp (str @!output-dir "/" name "/" lux-module-descriptor-name)
+ :encoding "UTF-8"))))
+
(do-template [<wrap-name> <unwrap-name> <class> <unwrap-method> <prim> <dup>]
(do (defn <wrap-name> [^MethodVisitor writer]
(doto writer
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index c0b0bc344..ba221b73d 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -17,7 +17,9 @@
[module :as &a-module]
[meta :as &a-meta])
(lux.compiler [base :as &&]
- [io :as &&io]))
+ [io :as &&io])
+ (lux.compiler.cache [type :as &&&type]
+ [ann :as &&&ann]))
(:import (java.io File
BufferedOutputStream
FileOutputStream)
@@ -152,33 +154,31 @@
(&/T [_type (&/->list (string/split (or _tags "") tag-separator-re))])))))
&/->list)))]
(|do [_ (&a-module/create-module module module-hash)
+ ^String descriptor (&&/read-module-descriptor! module)
:let [module-anns (get-field &/anns-field module-class)]
_ (&a-module/set-anns module-anns module)
_ (&/flag-cached-module module)
_ (&a-module/set-imports imports)
- _ (&/map% (fn [_def]
- (let [[_name _alias] (string/split _def #" ")]
- (if (= nil _alias)
- (let [def-class (&&/load-class! loader (str module* "." (&host/def-name _name)))
- def-meta (get-field &/anns-field def-class)
- def-type (|case (&a-meta/meta-get &a-meta/type?-tag def-meta)
- (&/$Some (&/$BoolM true))
- &type/Type
-
- _
- (get-field &/type-field def-class))
- def-value (get-field &/value-field def-class)]
- (&a-module/define module _name def-type def-meta def-value))
- (let [[_ __module __name] (re-find #"^(.*);(.*)$" _alias)
- def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name)))
- def-type (get-field &/type-field def-class)
- def-meta (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))]))
- def-value (get-field &/value-field def-class)]
- (&a-module/define module _name def-type def-meta def-value)))
- ))
- (if (= [""] defs)
+ :let [desc-defs (vec (.split descriptor &&/def-entry-separator))]
+ _ (&/map% (fn [^String _def-entry]
+ (let [parts (.split _def-entry &&/def-datum-separator)]
+ (case (alength parts)
+ 2 (let [[_name _alias] parts
+ [_ __module __name] (re-find #"^(.*);(.*)$" _alias)
+ def-class (&&/load-class! loader (str (&host-generics/->class-name __module) "." (&host/def-name __name)))
+ def-type (&a-module/def-type __module __name)
+ def-anns (&/|list (&/T [&a-meta/alias-tag (&/$IdentM (&/T [__module __name]))]))
+ def-value (get-field &/value-field def-class)]
+ (&a-module/define module _name def-type def-anns def-value))
+ 3 (let [[_name _type _anns] parts
+ def-class (&&/load-class! loader (str module* "." (&host/def-name _name)))
+ [def-anns _] (&&&ann/deserialize-anns _anns)
+ [def-type _] (&&&type/deserialize-type _type)
+ def-value (get-field &/value-field def-class)]
+ (&a-module/define module _name def-type def-anns def-value)))))
+ (if (= [""] desc-defs)
&/$Nil
- (&/->list defs)))
+ (&/->list desc-defs)))
_ (&/map% (fn [group]
(|let [[_type _tags] group]
(|do [[was-exported? =type] (&a-module/type-def module _type)]
diff --git a/src/lux/compiler/cache/ann.clj b/src/lux/compiler/cache/ann.clj
new file mode 100644
index 000000000..d50c02465
--- /dev/null
+++ b/src/lux/compiler/cache/ann.clj
@@ -0,0 +1,159 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+;; If a copy of the MPL was not distributed with this file,
+;; You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(ns lux.compiler.cache.ann
+ (:require (clojure [template :refer [do-template]]
+ [string :as string])
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [|let |do return* return fail fail* |case]])))
+
+(def ^:private stop (->> 7 char str))
+(def ^:private cons-signal (->> 5 char str))
+(def ^:private nil-signal (->> 6 char str))
+(def ^:private ident-separator ";")
+
+(defn ^:private serialize-seq [serialize-ann params]
+ (str (&/fold (fn [so-far param]
+ (str so-far cons-signal (serialize-ann param)))
+ ""
+ params)
+ nil-signal))
+
+(defn ^:private serialize-text [value]
+ (str "T" value stop))
+
+(defn ^:private serialize-ident [ident]
+ (|let [[module name] ident]
+ (str "@" module ident-separator name stop)))
+
+(defn serialize-ann
+ "(-> Ann-Value Text)"
+ [ann]
+ (|case ann
+ (&/$BoolM value)
+ (str "B" value stop)
+
+ (&/$NatM value)
+ (str "N" value stop)
+
+ (&/$IntM value)
+ (str "I" value stop)
+
+ (&/$FracM value)
+ (str "F" value stop)
+
+ (&/$RealM value)
+ (str "R" value stop)
+
+ (&/$CharM value)
+ (str "C" value stop)
+
+ (&/$TextM value)
+ (serialize-text value)
+
+ (&/$IdentM ident)
+ (serialize-ident ident)
+
+ (&/$ListM elems)
+ (str "L" (serialize-seq serialize-ann elems))
+
+ (&/$DictM kvs)
+ (str "D" (serialize-seq (fn [kv]
+ (|let [[k v] kv]
+ (str (serialize-text k)
+ (serialize-ann v))))
+ kvs))
+
+ _
+ (assert false)
+ ))
+
+(defn serialize-anns
+ "(-> Anns Text)"
+ [anns]
+ (serialize-seq (fn [kv]
+ (|let [[k v] kv]
+ (str (serialize-ident k)
+ (serialize-ann v))))
+ anns))
+
+(declare deserialize-ann)
+
+(do-template [<name> <signal> <ctor> <parser>]
+ (defn <name> [^String input]
+ (when (.startsWith input <signal>)
+ (let [[value* ^String input*] (.split (.substring input 1) stop 2)]
+ [(<ctor> (<parser> value*)) input*])))
+
+ ^:private deserialize-bool "B" &/$BoolM Boolean/parseBoolean
+ ^:private deserialize-nat "N" &/$NatM Long/parseLong
+ ^:private deserialize-int "I" &/$IntM Long/parseLong
+ ^:private deserialize-frac "F" &/$FracM Long/parseLong
+ ^:private deserialize-real "R" &/$RealM Double/parseDouble
+ ^:private deserialize-char "C" &/$CharM (fn [^String input] (.charAt input 0))
+ ^:private deserialize-text "T" &/$TextM identity
+ )
+
+(defn ^:private deserialize-ident* [^String input]
+ (when (.startsWith input "@")
+ (let [[ident* ^String input*] (.split (.substring input 1) stop 2)
+ [_module _name] (.split ident* ident-separator 2)]
+ [(&/T [_module _name]) input*])))
+
+(defn ^:private deserialize-ident [^String input]
+ (when (.startsWith input "@")
+ (let [[ident* ^String input*] (.split (.substring input 1) stop 2)
+ [_module _name] (.split ident* ident-separator 2)]
+ [(&/$IdentM (&/T [_module _name])) input*])))
+
+(defn ^:private deserialize-seq [deserializer input]
+ (cond (.startsWith input nil-signal)
+ [&/$Nil (.substring input 1)]
+
+ (.startsWith input cons-signal)
+ (when-let [[head ^String input*] (deserializer (.substring input 1))]
+ (when-let [[tail ^String input*] (deserialize-seq deserializer input*)]
+ [(&/$Cons head tail) input*]))
+ ))
+
+(do-template [<name> <deserialize-key>]
+ (defn <name> [input]
+ (when-let [[key input*] (<deserialize-key> input)]
+ (when-let [[ann input*] (deserialize-ann input*)]
+ [(&/T [key ann]) input*])))
+
+ ^:private deserialize-kv deserialize-text
+ ^:private deserialize-ann-entry deserialize-ident*
+ )
+
+(do-template [<name> <signal> <type> <deserializer>]
+ (defn <name> [^String input]
+ (when (.startsWith input <signal>)
+ (when-let [[elems ^String input*] (deserialize-seq <deserializer>
+ (.substring input 1))]
+ [(<type> elems) input*])))
+
+ ^:private deserialize-list "L" &/$ListM deserialize-ann
+ ^:private deserialize-dict "D" &/$DictM deserialize-kv
+ )
+
+(defn ^:private deserialize-ann
+ "(-> Text Anns)"
+ [input]
+ (or (deserialize-bool input)
+ (deserialize-nat input)
+ (deserialize-int input)
+ (deserialize-frac input)
+ (deserialize-real input)
+ (deserialize-char input)
+ (deserialize-text input)
+ (deserialize-ident input)
+ (deserialize-list input)
+ (deserialize-dict input)
+ (assert false "[Cache error] Can't deserialize annocation.")))
+
+(defn deserialize-anns [^String input]
+ (deserialize-seq deserialize-ann-entry input))
diff --git a/src/lux/compiler/cache/type.clj b/src/lux/compiler/cache/type.clj
new file mode 100644
index 000000000..80d3a93d6
--- /dev/null
+++ b/src/lux/compiler/cache/type.clj
@@ -0,0 +1,164 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+;; If a copy of the MPL was not distributed with this file,
+;; You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(ns lux.compiler.cache.type
+ (:require (clojure [template :refer [do-template]]
+ [string :as string])
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [|let |do return* return fail fail* |case]]
+ [type :as &type])))
+
+(def ^:private stop (->> 7 char str))
+(def ^:private cons-signal (->> 5 char str))
+(def ^:private nil-signal (->> 6 char str))
+(def ^:private ident-separator ";")
+
+(defn ^:private serialize-list [serialize-type params]
+ (str (&/fold (fn [so-far param]
+ (str so-far cons-signal (serialize-type param)))
+ ""
+ params)
+ nil-signal))
+
+(defn serialize-type
+ "(-> Type Text)"
+ [type]
+ (if (clojure.lang.Util/identical &type/Type type)
+ "T"
+ (|case type
+ (&/$HostT name params)
+ (str "^" name stop (serialize-list serialize-type params))
+
+ (&/$VoidT)
+ "0"
+
+ (&/$UnitT)
+ "1"
+
+ (&/$ProdT left right)
+ (str "*" (serialize-type left) (serialize-type right))
+
+ (&/$SumT left right)
+ (str "+" (serialize-type left) (serialize-type right))
+
+ (&/$LambdaT left right)
+ (str ">" (serialize-type left) (serialize-type right))
+
+ (&/$UnivQ env body)
+ (str "U" (serialize-list serialize-type env) (serialize-type body))
+
+ (&/$ExQ env body)
+ (str "E" (serialize-list serialize-type env) (serialize-type body))
+
+ (&/$BoundT idx)
+ (str "$" idx stop)
+
+ (&/$ExT idx)
+ (str "!" idx stop)
+
+ (&/$VarT idx)
+ (str "?" idx stop)
+
+ (&/$AppT left right)
+ (str "%" (serialize-type left) (serialize-type right))
+
+ (&/$NamedT [module name] type*)
+ (str "@" module ident-separator name stop (serialize-type type*))
+
+ _
+ (assert false (prn 'serialize-type (&type/show-type type)))
+ )))
+
+(declare deserialize-type)
+
+(defn ^:private deserialize-list [input]
+ (cond (.startsWith input nil-signal)
+ [&/$Nil (.substring input 1)]
+
+ (.startsWith input cons-signal)
+ (when-let [[head ^String input*] (deserialize-type (.substring input 1))]
+ (when-let [[tail ^String input*] (deserialize-list input*)]
+ [(&/$Cons head tail) input*]))
+ ))
+
+(do-template [<name> <signal> <type>]
+ (defn <name> [^String input]
+ (when (.startsWith input <signal>)
+ [<type> (.substring input 1)]
+ ))
+
+ ^:private deserialize-void "0" &/$VoidT
+ ^:private deserialize-unit "1" &/$UnitT
+ ^:private deserialize-type* "T" &type/Type
+ )
+
+(do-template [<name> <signal> <type>]
+ (defn <name> [^String input]
+ (when (.startsWith input <signal>)
+ (when-let [[left ^String input*] (deserialize-type (.substring input 1))]
+ (when-let [[right ^String input*] (deserialize-type input*)]
+ [(<type> left right) input*]))
+ ))
+
+ ^:private deserialize-sum "+" &/$SumT
+ ^:private deserialize-prod "*" &/$ProdT
+ ^:private deserialize-lambda ">" &/$LambdaT
+ ^:private deserialize-app "%" &/$AppT
+ )
+
+(do-template [<name> <signal> <type>]
+ (defn <name> [^String input]
+ (when (.startsWith input <signal>)
+ (let [[idx ^String input*] (.split (.substring input 1) stop 2)]
+ [(<type> (Long/parseLong idx)) input*])))
+
+ ^:private deserialize-bound "$" &/$BoundT
+ ^:private deserialize-ex "!" &/$ExT
+ ^:private deserialize-var "?" &/$VarT
+ )
+
+(defn ^:private deserialize-named [^String input]
+ (when (.startsWith input "@")
+ (let [[^String module+name ^String input*] (.split (.substring input 1) stop 2)
+ [module name] (.split module+name ident-separator 2)]
+ (when-let [[type* ^String input*] (deserialize-type input*)]
+ [(&/$NamedT (&/T [module name]) type*) input*]))))
+
+(do-template [<name> <signal> <type>]
+ (defn <name> [^String input]
+ (when (.startsWith input <signal>)
+ (when-let [[env ^String input*] (deserialize-list (.substring input 1))]
+ (when-let [[body ^String input*] (deserialize-type input*)]
+ [(<type> env body) input*]))))
+
+ ^:private deserialize-univq "U" &/$UnivQ
+ ^:private deserialize-exq "E" &/$ExQ
+ )
+
+(defn ^:private deserialize-host [^String input]
+ (when (.startsWith input "^")
+ (let [[name ^String input*] (.split (.substring input 1) stop 2)]
+ (when-let [[params ^String input*] (deserialize-list input*)]
+ [(&/$HostT name params) input*]))))
+
+(defn deserialize-type
+ "(-> Text Type)"
+ [input]
+ (or (deserialize-type* input)
+ (deserialize-void input)
+ (deserialize-unit input)
+ (deserialize-sum input)
+ (deserialize-prod input)
+ (deserialize-lambda input)
+ (deserialize-app input)
+ (deserialize-bound input)
+ (deserialize-ex input)
+ (deserialize-var input)
+ (deserialize-named input)
+ (deserialize-univq input)
+ (deserialize-exq input)
+ (deserialize-host input)
+ (assert false (str "[Cache error] Can't deserialize type. --- " input))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index a6b636107..1ea078e76 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -267,7 +267,6 @@
(|do [:let [current-class (&host-generics/->class-name (str (&host/->module-class r-module) "/" (&host/def-name r-name)))
def-class (&&/load-class! class-loader current-class)
def-type (&a-module/def-type r-module r-name)
- ;; def-type (-> def-class (.getField &/type-field) (.get nil))
def-meta ?meta
def-value (-> def-class (.getField &/value-field) (.get nil))]
_ (&/without-repl-closure
@@ -285,7 +284,6 @@
false
(de-ann ?body))]
(|do [:let [=value-type (&a/expr-type* ?body)]
- ;; ^ClassWriter *writer* &/get-writer
[file-name _ _] &/cursor
:let [datum-sig "Ljava/lang/Object;"
def-name (&host/def-name ?name)
@@ -295,10 +293,6 @@
current-class nil &&/function-class (into-array String []))
(-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
(doto (.visitEnd)))
- ;; (-> (.visitField field-flags &/type-field datum-sig nil nil)
- ;; (doto (.visitEnd)))
- ;; (-> (.visitField field-flags &/anns-field datum-sig nil nil)
- ;; (doto (.visitEnd)))
(-> (.visitField field-flags &/value-field datum-sig nil nil)
(doto (.visitEnd)))
(.visitSource file-name nil))]
@@ -306,10 +300,6 @@
_ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor **writer** &/get-writer
:let [_ (.visitCode **writer**)]
- ;; _ (compile-def-type compile ?body)
- ;; :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/type-field datum-sig)]
- ;; _ (&&/compile-meta compile ?meta)
- ;; :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/anns-field datum-sig)]
_ instancer
:let [_ (.visitTypeInsn **writer** Opcodes/CHECKCAST "java/lang/Object")
_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
@@ -318,23 +308,16 @@
(.visitMaxs 0 0)
(.visitEnd))]]
(return nil)))
- ;; :let [_ (.visitEnd *writer*)]
:let [_ (.visitEnd =class)]
_ (&&/save-class! def-name (.toByteArray =class))
:let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
def-type (&a/expr-type* ?body)
- [;; def-type
- is-type?] (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
- (&/$Some (&/$BoolM true))
- (&/T [;; &type/Type
- true])
-
- _
- (if (&type/type= &type/Type =value-type)
- (&/T [;; &type/Type
- false])
- (&/T [;; (-> def-class (.getField &/type-field) (.get nil))
- false])))
+ is-type? (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
+ (&/$Some (&/$BoolM true))
+ true
+
+ _
+ false)
def-meta ?meta
def-value (-> def-class (.getField &/value-field) (.get nil))]
_ (&/without-repl-closure
@@ -371,7 +354,6 @@
_
(|do [:let [=value-type (&a/expr-type* ?body)]
- ;; ^ClassWriter *writer* &/get-writer
[file-name _ _] &/cursor
:let [datum-sig "Ljava/lang/Object;"
def-name (&host/def-name ?name)
@@ -381,20 +363,12 @@
current-class nil "java/lang/Object" (into-array String []))
(-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
(doto (.visitEnd)))
- ;; (-> (.visitField field-flags &/type-field datum-sig nil nil)
- ;; (doto (.visitEnd)))
- ;; (-> (.visitField field-flags &/anns-field datum-sig nil nil)
- ;; (doto (.visitEnd)))
(-> (.visitField field-flags &/value-field datum-sig nil nil)
(doto (.visitEnd)))
(.visitSource file-name nil))]
_ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor **writer** &/get-writer
:let [_ (.visitCode **writer**)]
- ;; _ (compile-def-type compile ?body)
- ;; :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/type-field datum-sig)]
- ;; _ (&&/compile-meta compile ?meta)
- ;; :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/anns-field datum-sig)]
_ (compile nil ?body)
:let [_ (.visitTypeInsn **writer** Opcodes/CHECKCAST "java/lang/Object")
_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
@@ -403,23 +377,16 @@
(.visitMaxs 0 0)
(.visitEnd))]]
(return nil)))
- ;; :let [_ (.visitEnd *writer*)]
:let [_ (.visitEnd =class)]
_ (&&/save-class! def-name (.toByteArray =class))
:let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
def-type (&a/expr-type* ?body)
- [;; def-type
- is-type?] (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
- (&/$Some (&/$BoolM true))
- (&/T [;; &type/Type
- true])
+ is-type? (|case (&a-meta/meta-get &a-meta/type?-tag ?meta)
+ (&/$Some (&/$BoolM true))
+ true
- _
- (if (&type/type= &type/Type =value-type)
- (&/T [;; &type/Type
- false])
- (&/T [;; (-> def-class (.getField &/type-field) (.get nil))
- false])))
+ _
+ false)
def-meta ?meta
def-value (-> def-class (.getField &/value-field) (.get nil))]
_ (&/without-repl-closure
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 10:21:21 +0000