aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/host.clj10
-rw-r--r--src/lux/analyser/module.clj7
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/compiler.clj82
-rw-r--r--src/lux/compiler/base.clj32
-rw-r--r--src/lux/compiler/cache.clj173
-rw-r--r--src/lux/compiler/cache/ann.clj159
-rw-r--r--src/lux/compiler/cache/type.clj164
-rw-r--r--src/lux/compiler/host.clj356
-rw-r--r--src/lux/compiler/lux.clj83
-rw-r--r--src/lux/compiler/type.clj157
-rw-r--r--src/lux/host.clj4
12 files changed, 805 insertions, 427 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 98baad662..180e3ef54 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -676,6 +676,15 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "null"]) (&/|list) (&/|list)))))))
+(defn analyse-jvm-synchronized [analyse exo-type ?values]
+ (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values]
+ =monitor (&&/analyse-1+ analyse ?monitor)
+ _ (ensure-object (&&/expr-type* =monitor))
+ =expr (&&/analyse-1 analyse exo-type ?expr)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["jvm" "synchronized"]) (&/|list =monitor =expr) (&/|list)))))))
+
(do-template [<name> <tag>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons ?monitor (&/$Nil)) ?values]
@@ -1228,6 +1237,7 @@
"jvm"
(case proc
+ "synchronized" (analyse-jvm-synchronized analyse exo-type ?values)
"load-class" (analyse-jvm-load-class analyse exo-type ?values)
"try" (analyse-jvm-try analyse exo-type ?values)
"throw" (analyse-jvm-throw analyse exo-type ?values)
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/base.clj b/src/lux/base.clj
index da5ef48f8..fd8cc2423 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -230,14 +230,9 @@
;; [Exports]
(def ^:const name-field "_name")
(def ^:const hash-field "_hash")
-(def ^:const type-field "_type")
-(def ^:const anns-field "_anns")
(def ^:const value-field "_value")
(def ^:const compiler-field "_compiler")
-(def ^:const imports-field "_imports")
-(def ^:const defs-field "_defs")
(def ^:const eval-field "_eval")
-(def ^:const tags-field "_tags")
(def ^:const module-class-name "_")
(def ^:const +name-separator+ ";")
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 030df1dd6..298445905 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
@@ -146,7 +148,7 @@
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/eval-field "Ljava/lang/Object;" nil nil)
(doto (.visitEnd)))
(.visitSource file-name nil))]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor *writer* &/get-writer
:let [_ (.visitCode *writer*)]
_ (compile-expression nil expr)
@@ -196,8 +198,6 @@
.visitEnd)
(-> (.visitField +field-flags+ &/compiler-field "Ljava/lang/String;" nil &/compiler-version)
.visitEnd)
- (-> (.visitField +field-flags+ &/anns-field +datum-sig+ nil nil)
- (doto (.visitEnd)))
(.visitSource file-name nil))]
_ (if (= "lux" name)
(|do [_ &&host/compile-Function-class
@@ -209,51 +209,43 @@
(&/exhaust% compiler-step))
(&/set$ &/$source (&reader/from name file-content) state))
(&/$Right ?state _)
- (&/run-state (|do [==anns (&a-module/get-anns name)
+ (&/run-state (|do [:let [_ (.visitEnd =class)]
+ module-anns (&a-module/get-anns name)
defs &a-module/defs
imports &a-module/imports
tag-groups &&module/tag-groups
- :let [_ (doto =class
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/defs-field "Ljava/lang/String;" nil
- (->> defs
- (&/|map (fn [_def]
- (|let [[?name ?alias] _def]
- (str ?name
- &&/exported-separator
- ?alias))))
- (&/|interpose &&/def-separator)
- (&/fold str "")))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/imports-field "Ljava/lang/String;" nil
- (->> imports
- (&/|map (fn [import]
- (|let [[_module _hash] import]
- (str _module &&/field-separator _hash))))
- (&/|interpose &&/entry-separator)
- (&/fold str "")))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/tags-field "Ljava/lang/String;" nil
- (->> tag-groups
- (&/|map (fn [group]
- (|let [[type tags] group]
- (->> tags (&/|interpose &&/tag-separator) (&/fold str "")
- (str type &&/type-separator)))))
- (&/|interpose &&/tag-group-separator)
- (&/fold str "")))
- .visitEnd))]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
- (|do [^MethodVisitor **writer** &/get-writer
- :let [_ (.visitCode **writer**)]
- _ (&&/compile-meta compile-expression ==anns)
- :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC module-class-name &/anns-field +datum-sig+)]
- :let [_ (doto **writer**
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
- :let [_ (.visitEnd =class)]
+ :let [def-entries (->> defs
+ (&/|map (fn [_def]
+ (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def]
+ (if (= "" ?alias)
+ (str ?name &&/datum-separator (&&&type/serialize-type ?def-type) &&/datum-separator (&&&ann/serialize-anns ?def-anns))
+ (str ?name &&/datum-separator ?alias)))))
+ (&/|interpose &&/entry-separator)
+ (&/fold str ""))
+ import-entries (->> imports
+ (&/|map (fn [import]
+ (|let [[_module _hash] import]
+ (str _module &&/datum-separator _hash))))
+ (&/|interpose &&/entry-separator)
+ (&/fold str ""))
+ tag-entries (->> tag-groups
+ (&/|map (fn [group]
+ (|let [[type tags] group]
+ (->> tags
+ (&/|interpose &&/datum-separator)
+ (&/fold str "")
+ (str type &&/datum-separator)))))
+ (&/|interpose &&/entry-separator)
+ (&/fold str ""))
+ module-descriptor (->> (&/|list import-entries
+ tag-entries
+ (&&&ann/serialize-anns module-anns)
+ def-entries)
+ (&/|interpose &&/section-separator)
+ (&/fold str ""))]
_ (&/flag-compiled-module name)
- _ (&&/save-class! &/module-class-name (.toByteArray =class))]
+ _ (&&/save-class! &/module-class-name (.toByteArray =class))
+ _ (&&/write-module-descriptor! name module-descriptor)]
(return file-hash))
?state)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index a369b7436..e57571fef 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -14,8 +14,7 @@
[host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module])
- [lux.host.generics :as &host-generics]
- (lux.compiler [type :as &&type]))
+ [lux.host.generics :as &host-generics])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -43,14 +42,9 @@
(def ^:const arity-field "_arity_")
(def ^:const partials-field "_partials_")
-(def ^:const exported-separator " ")
-(def ^:const def-separator "\t")
-(def ^:const tag-separator " ")
-(def ^:const type-separator "\t")
-(def ^:const tag-group-separator "\n")
-
-(def ^:const field-separator "\t")
-(def ^:const entry-separator "\n")
+(def ^:const section-separator (->> 29 char str))
+(def ^:const datum-separator (->> 31 char str))
+(def ^:const entry-separator (->> 30 char str))
;; [Utils]
(defn ^:private write-file [^String file-name ^bytes data]
@@ -88,6 +82,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
@@ -106,7 +114,3 @@
wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes/DUP_X2
wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes/DUP_X1
)
-
-(defn compile-meta [compile anns]
- (|let [analysis (&&type/defmeta->analysis anns)]
- (compile nil analysis)))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index c0b0bc344..788080b04 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)
@@ -99,93 +101,84 @@
(&/$Right compiler)
(return* compiler nil))))
-(let [->regex (fn [text] (re-pattern (java.util.regex.Pattern/quote text)))
- entry-separator-re (->regex &&/entry-separator)
- field-separator-re (->regex &&/field-separator)
- type-separator-re (->regex &&/type-separator)
- tag-separator-re (->regex &&/tag-separator)
- def-separator-re (->regex &&/def-separator)
- tag-group-separator-re (->regex &&/tag-group-separator)]
- (defn load [source-dirs module module-hash compile-module]
- "(-> (List Text) Text Int (-> Text (Lux (,))) (Lux Bool))"
- (|do [already-loaded? (&a-module/exists? module)]
- (if already-loaded?
- (return module-hash)
- (|let [redo-cache (|do [_ (delete module)
- async (compile-module module)]
- (assume-async-result @async))]
- (if (cached? module)
- (|do [loader &/loader
- !classes &/classes
- :let [module* (&host-generics/->class-name module)
- module-path (str @&&/!output-dir "/" module)
- class-name (str module* "._")
- old-classes @!classes
- ^Class module-class (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class"))))
- (&&/load-class! loader class-name))
- _ (install-all-classes-in-module !classes module* module-path)]]
- (if (and (= module-hash (get-field &/hash-field module-class))
- (= &/compiler-version (get-field &/compiler-field module-class)))
- (let [imports (string/split (get-field &/imports-field module-class) entry-separator-re)]
- (|do [loads (&/map% (fn [_import]
- (let [[_module _hash] (string/split _import field-separator-re)]
- (|do [file-content (&&io/read-file source-dirs (str _module ".lux"))
- :let [file-hash (hash file-content)
- __hash (Integer/parseInt _hash)]
- _ (load source-dirs _module file-hash compile-module)
- cached? (&/cached-module? _module)
- :let [consistent-cache? (= file-hash __hash)]]
- (return (and cached?
- consistent-cache?)))))
- (if (= [""] imports)
- &/$Nil
- (&/->list imports)))]
- (if (->> loads &/->seq (every? true?))
- (let [defs (string/split (get-field &/defs-field module-class) def-separator-re)
- tag-groups (let [all-tags (get-field &/tags-field module-class)]
- (if (= "" all-tags)
+(defn load [source-dirs module module-hash compile-module]
+ "(-> (List Text) Text Int (-> Text (Lux (,))) (Lux Bool))"
+ (|do [already-loaded? (&a-module/exists? module)]
+ (if already-loaded?
+ (return module-hash)
+ (|let [redo-cache (|do [_ (delete module)
+ async (compile-module module)]
+ (assume-async-result @async))]
+ (if (cached? module)
+ (|do [loader &/loader
+ !classes &/classes
+ :let [module* (&host-generics/->class-name module)
+ module-path (str @&&/!output-dir "/" module)
+ class-name (str module* "._")
+ old-classes @!classes
+ ^Class module-class (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class"))))
+ (&&/load-class! loader class-name))
+ _ (install-all-classes-in-module !classes module* module-path)]]
+ (if (and (= module-hash (get-field &/hash-field module-class))
+ (= &/compiler-version (get-field &/compiler-field module-class)))
+ (|do [^String descriptor (&&/read-module-descriptor! module)
+ :let [sections (.split descriptor &&/section-separator)
+ [^String imports-section ^String tags-section module-anns-section ^String defs-section] sections
+ imports (vec (.split imports-section &&/entry-separator))]
+ loads (&/map% (fn [^String _import]
+ (let [[_module _hash] (.split _import &&/datum-separator 2)]
+ (|do [file-content (&&io/read-file source-dirs (str _module ".lux"))
+ :let [file-hash (hash file-content)
+ __hash (Integer/parseInt _hash)]
+ _ (load source-dirs _module file-hash compile-module)
+ cached? (&/cached-module? _module)
+ :let [consistent-cache? (= file-hash __hash)]]
+ (return (and cached?
+ consistent-cache?)))))
+ (if (= [""] imports)
+ &/$Nil
+ (&/->list imports)))]
+ (if (->> loads &/->seq (every? true?))
+ (|do [:let [tag-groups (if (= "" tags-section)
&/$Nil
- (-> all-tags
- (string/split tag-group-separator-re)
- (->> (map (fn [_group]
- (let [[_type _tags] (string/split _group type-separator-re)]
- (&/T [_type (&/->list (string/split (or _tags "") tag-separator-re))])))))
- &/->list)))]
- (|do [_ (&a-module/create-module module module-hash)
- :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)
- &/$Nil
- (&/->list defs)))
- _ (&/map% (fn [group]
- (|let [[_type _tags] group]
- (|do [[was-exported? =type] (&a-module/type-def module _type)]
- (&a-module/declare-tags module _tags was-exported? =type))))
- tag-groups)]
- (return module-hash)))
- redo-cache)))
- (do (reset! !classes old-classes)
- redo-cache)))
- redo-cache))))))
+ (-> tags-section
+ (.split &&/entry-separator)
+ seq
+ (->> (map (fn [^String _group]
+ (let [[_type & _tags] (.split _group &&/datum-separator)]
+ (&/T [_type (->> _tags seq &/->list)])))))
+ &/->list))]
+ _ (&a-module/create-module module module-hash)
+ _ (&a-module/set-anns (&&&ann/deserialize-anns module-anns-section) module)
+ _ (&/flag-cached-module module)
+ _ (&a-module/set-imports imports)
+ :let [desc-defs (vec (.split defs-section &&/entry-separator))]
+ _ (&/map% (fn [^String _def-entry]
+ (let [parts (.split _def-entry &&/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 desc-defs)))
+ _ (&/map% (fn [group]
+ (|let [[_type _tags] group]
+ (|do [[was-exported? =type] (&a-module/type-def module _type)]
+ (&a-module/declare-tags module _tags was-exported? =type))))
+ tag-groups)]
+ (return module-hash))
+ redo-cache))
+ (do (reset! !classes old-classes)
+ redo-cache)))
+ redo-cache)))))
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/host.clj b/src/lux/compiler/host.clj
index 6c1646933..d987076c1 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -484,7 +484,7 @@
_
(return nil))
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
(|do [^MethodVisitor =method &/get-writer
:let [_ (doto =method
(.visitCode))]
@@ -1088,56 +1088,272 @@
(let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
(defn ^:private compile-LuxRT-nat-methods [^ClassWriter =class]
- (|let [_ (let [$end (new Label)
- ;; $then (new Label)
- $else (new Label)
- $from (new Label)
+ (|let [;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#677
+ _ (let [$from (new Label)
$to (new Label)
- $handler (new Label)]
+ $handler (new Label)
+
+ $good-start (new Label)
+ $short-enough (new Label)
+ $bad-digit (new Label)
+ $out-of-bounds (new Label)]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "decode_nat" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil)
(.visitCode)
+ (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
+ (.visitLabel $from)
+ ;; Remove the + at the beginning...
(.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 0))
+ (.visitLdcInsn (int 0))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
(.visitLdcInsn "+")
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "startsWith" "(Ljava/lang/String;)Z")
- (.visitJumpInsn Opcodes/IFEQ $else)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
+ (.visitJumpInsn Opcodes/IFNE $good-start)
+ ;; Doesn't start with +
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; Starts with +
+ (.visitLabel $good-start)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitLdcInsn (int 1))
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(I)Ljava/lang/String;")
- (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
- (.visitLabel $from)
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "clean_separators" "(Ljava/lang/String;)Ljava/lang/String;")
- (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseUnsignedLong" "(Ljava/lang/String;)J")
- (.visitLabel $to)
- ;; (.visitJumpInsn Opcodes/GOTO $then)
- ;; (.visitLabel $then)
- (&&/wrap-long)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
+ (.visitVarInsn Opcodes/ASTORE 0) ;; Removed the + prefix...
+ ;; Begin parsing processs
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitLdcInsn (int 18))
+ (.visitJumpInsn Opcodes/IF_ICMPLE $short-enough)
+ ;; Too long
+ ;; Get prefix...
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 0))
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/ISUB)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J")
+ (.visitInsn Opcodes/DUP2) ;; Clone prefix, for later...
+ ;; Get last digit...
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/ISUB)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C")
+ (.visitLdcInsn (int 10))
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Character" "digit" "(CI)I")
+ ;; Test last digit...
+ (.visitInsn Opcodes/DUP)
+ (.visitJumpInsn Opcodes/IFLT $bad-digit)
+ ;; Good digit...
+ ;; Stack: prefix::L, prefix::L, last-digit::I
+ (.visitInsn Opcodes/I2L)
+ ;; Build the result...
+ swap2
+ (.visitLdcInsn (long 10))
+ (.visitInsn Opcodes/LMUL)
+ (.visitInsn Opcodes/LADD) ;; Stack: prefix::L, result::L
+ (.visitInsn Opcodes/DUP2_X2) ;; Stack: result::L, prefix::L, result::L
+ swap2 ;; Stack: result::L, result::L, prefix::L
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitJumpInsn Opcodes/IFLT $out-of-bounds)
+ ;; Within bounds
+ ;; Stack: result::L
+ &&/wrap-long
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; Out of bounds
+ (.visitLabel $out-of-bounds)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; Bad digit...
+ (.visitLabel $bad-digit)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; 18 chars or less
+ (.visitLabel $short-enough)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J")
+ &&/wrap-long
(.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Object"]))
- (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $to)
(.visitLabel $handler)
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Exception"]))
- (.visitInsn Opcodes/POP)
(.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Object"]))
- (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#172
+ _ (let [$else (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_nat" "(J)Ljava/lang/String;" nil nil)
+ (.visitCode)
+ (.visitLdcInsn "+")
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFLT $else)
+ ;; then
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; else
(.visitLabel $else)
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 0 (to-array []))
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
- (.visitLabel $end)
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Object"]))
+ ;; Set up parts of the number string...
+ ;; First digits
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/LUSHR)
+ (.visitLdcInsn (long 5))
+ (.visitInsn Opcodes/LDIV) ;; quot
+ ;; Last digit
+ (.visitInsn Opcodes/DUP2)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ swap2
+ (.visitInsn Opcodes/LSUB)
+ (.visitLdcInsn (long 10))
+ (.visitInsn Opcodes/LMUL) ;; quot, rem
+ ;; Conversion to string...
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; quot, rem*
+ (.visitInsn Opcodes/DUP_X2);; rem*, quot, rem*
+ (.visitInsn Opcodes/POP) ;; rem*, quot
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; rem*, quot*
+ (.visitInsn Opcodes/SWAP) ;; quot*, rem*
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
- _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_nat" "(J)Ljava/lang/String;" nil nil)
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
+ _ (let [$else (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFLT $else)
+ ;; then
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; else
+ (.visitLabel $else)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (int 32))
+ (.visitInsn Opcodes/LUSHR)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
+ (.visitLdcInsn (int 32))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "shiftLeft" "(I)Ljava/math/BigInteger;")
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (int 32))
+ (.visitInsn Opcodes/LSHL)
+ (.visitLdcInsn (int 32))
+ (.visitInsn Opcodes/LUSHR)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "add" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java?av=f#1267
+ _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_compareUnsigned" "(JJ)I" nil nil)
(.visitCode)
(.visitVarInsn Opcodes/LLOAD 0)
- (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "toUnsignedString" "(J)Ljava/lang/String;")
- (.visitLdcInsn "+")
- (.visitInsn Opcodes/SWAP)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
- (.visitInsn Opcodes/ARETURN)
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J")
+ (.visitInsn Opcodes/LADD)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J")
+ (.visitInsn Opcodes/LADD)
+ (.visitInsn Opcodes/LCMP)
+ (.visitInsn Opcodes/IRETURN)
(.visitMaxs 0 0)
- (.visitEnd))]
+ (.visitEnd))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1290
+ _ (let [$case-1 (new Label)
+ $0 (new Label)
+ $case-2 (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "div_nat" "(JJ)J" nil nil)
+ (.visitCode)
+ ;; Test #1
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFLT $case-1)
+ ;; Test #2
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFGT $case-2)
+ ;; Case #3
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "divide" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J")
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #2
+ (.visitLabel $case-2)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitInsn Opcodes/LDIV)
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #1
+ (.visitLabel $case-1)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitJumpInsn Opcodes/IFLT $0)
+ ;; 1
+ (.visitLdcInsn (long 1))
+ (.visitInsn Opcodes/LRETURN)
+ ;; 0
+ (.visitLabel $0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LRETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1323
+ _ (let [$case-1 (new Label)
+ $case-2 (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "rem_nat" "(JJ)J" nil nil)
+ (.visitCode)
+ ;; Test #1
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitInsn Opcodes/IAND)
+ (.visitJumpInsn Opcodes/IFGT $case-1)
+ ;; Test #2
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitJumpInsn Opcodes/IFLT $case-2)
+ ;; Case #3
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "remainder" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J")
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #2
+ (.visitLabel $case-2)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #1
+ (.visitLabel $case-1)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitInsn Opcodes/LREM)
+ (.visitInsn Opcodes/LRETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))]
nil)))
(defn ^:private compile-LuxRT-pm-methods [^ClassWriter =class]
@@ -1608,6 +1824,21 @@
(.visitLabel $end))]]
(return nil)))
+(defn compile-jvm-synchronized [compile ?values special-args]
+ (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values
+ ;; (&/$Nil) special-args
+ ]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?monitor)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitInsn Opcodes/MONITORENTER))]
+ _ (compile ?expr)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/SWAP)
+ (.visitInsn Opcodes/MONITOREXIT))]]
+ (return nil)))
+
(do-template [<name> <op>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?monitor (&/$Nil)) ?values
@@ -1914,41 +2145,41 @@
^:private compile-frac-scale Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long
)
-(do-template [<name> <wrapper-class> <value-method> <value-method-sig> <wrap> <comp-method> <comp-sig>]
+(do-template [<name> <comp-method>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
- :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
^MethodVisitor *writer* &/get-writer
_ (compile ?x)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
_ (compile ?y)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))
_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ <comp-method> <comp-sig>)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <comp-method> "(JJ)J")
(&&/wrap-long))]]
(return nil)))
- ^:private compile-nat-div "java.lang.Long" "longValue" "()J" &&/wrap-long "divideUnsigned" "(JJ)J"
- ^:private compile-nat-rem "java.lang.Long" "longValue" "()J" &&/wrap-long "remainderUnsigned" "(JJ)J"
+ ^:private compile-nat-div "div_nat"
+ ^:private compile-nat-rem "rem_nat"
)
-(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig> <comp-method> <comp-sig>]
+(do-template [<name> <cmp-output>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
- :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
^MethodVisitor *writer* &/get-writer
_ (compile ?x)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
_ (compile ?y)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))
$then (new Label)
$end (new Label)
_ (doto *writer*
@@ -1962,13 +2193,37 @@
(.visitLabel $end))]]
(return nil)))
- ^:private compile-nat-eq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
- ^:private compile-nat-lt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
-
- ^:private compile-frac-eq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
- ^:private compile-frac-lt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
+ ^:private compile-nat-eq 0
+
+ ^:private compile-frac-eq 0
+ ^:private compile-frac-lt -1
)
+(let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
+ (defn ^:private compile-nat-lt [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))
+ $then (new Label)
+ $end (new Label)
+ _ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitLdcInsn (int -1))
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitLabel $end))]]
+ (return nil))))
+
(do-template [<name> <instr> <wrapper>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Nil) ?values]
@@ -2131,6 +2386,7 @@
"jvm"
(case proc-name
+ "synchronized" (compile-jvm-synchronized compile ?values special-args)
"load-class" (compile-jvm-load-class compile ?values special-args)
"instanceof" (compile-jvm-instanceof compile ?values special-args)
"try" (compile-jvm-try compile ?values special-args)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index f44375e97..9d5837fe2 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -21,8 +21,7 @@
[module :as &a-module]
[meta :as &a-meta])
(lux.compiler [base :as &&]
- [lambda :as &&lambda]
- [type :as &&type]))
+ [lambda :as &&lambda]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -236,18 +235,6 @@
_ (.visitLabel *writer* $end)]]
(return nil)))
-(defn ^:private compile-def-type [compile ?body]
- (|do [:let [?def-type (|case ?body
- [[?def-type ?def-cursor] (&o/$ann ?def-value ?type-expr)]
- (&o/optimize ?type-expr)
-
- [[?def-type ?def-cursor] ?def-value]
- (if (&type/type= &type/Type ?def-type)
- (&/T [(&/T [?def-type ?def-cursor])
- (&o/$tuple (&/|list))])
- (&&type/type->analysis ?def-type)))]]
- (compile nil ?def-type)))
-
(defn ^:private de-ann [optim]
(|case optim
[_ (&o/$ann value-expr _)]
@@ -266,7 +253,7 @@
(if (= 1 (&/|length ?meta))
(|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 (-> def-class (.getField &/type-field) (.get nil))
+ def-type (&a-module/def-type r-module r-name)
def-meta ?meta
def-value (-> def-class (.getField &/value-field) (.get nil))]
_ (&/without-repl-closure
@@ -284,7 +271,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)
@@ -294,43 +280,31 @@
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))]
instancer (&&lambda/compile-function compile (&/$Some =class) _arity _scope _captured ?body+)
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil 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)]
_ instancer
- :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
+ :let [_ (.visitTypeInsn **writer** Opcodes/CHECKCAST "java/lang/Object")
+ _ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
:let [_ (doto **writer**
(.visitInsn Opcodes/RETURN)
(.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 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])))
+ def-type (&a/expr-type* ?body)
+ 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
@@ -367,7 +341,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)
@@ -377,42 +350,30 @@
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_PUBLIC "<clinit>" "()V" nil 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 [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
+ :let [_ (.visitTypeInsn **writer** Opcodes/CHECKCAST "java/lang/Object")
+ _ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)]
:let [_ (doto **writer**
(.visitInsn Opcodes/RETURN)
(.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 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])))
+ def-type (&a/expr-type* ?body)
+ 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
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
deleted file mode 100644
index b2b0f9cb9..000000000
--- a/src/lux/compiler/type.clj
+++ /dev/null
@@ -1,157 +0,0 @@
-;; 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.type
- (:require [clojure.template :refer [do-template]]
- clojure.core.match
- clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let |case]]
- [type :as &type]
- [optimizer :as &o])
- [lux.analyser.base :as &a]))
-
-;; [Utils]
-(defn ^:private variant$ [tag body]
- "(-> clojure.lang.Var Analysis Analysis)"
- (let [tag-meta (meta tag)]
- (&a/|meta &/$VoidT &/empty-cursor
- (&o/$variant (::&/idx tag-meta) (::&/is-last? tag-meta) body))))
-
-(defn ^:private tuple$ [members]
- "(-> (List Analysis) Analysis)"
- (&a/|meta &/$VoidT &/empty-cursor
- (&o/$tuple members)))
-
-(do-template [<name> <tag> <doc>]
- (defn <name> [value]
- <doc>
- (&a/|meta &/$VoidT &/empty-cursor
- (<tag> value)))
-
- ^:private bool$ &o/$bool "(-> Bool Analysis)"
- ^:private nat$ &o/$nat "(-> Nat Analysis)"
- ^:private int$ &o/$int "(-> Int Analysis)"
- ^:private frac$ &o/$frac "(-> Nat Analysis)"
- ^:private real$ &o/$real "(-> Real Analysis)"
- ^:private char$ &o/$char "(-> Char Analysis)"
- ^:private text$ &o/$text "(-> Text Analysis)"
- )
-
-(defn ^:private ident$ [value]
- "(-> Ident Analysis)"
- (|let [[p n] value]
- (tuple$ (&/|list (text$ p) (text$ n)))))
-
-(def ^:private $Nil
- "Analysis"
- (variant$ #'&/$Nil (tuple$ &/$Nil)))
-
-(defn ^:private Cons$ [head tail]
- "(-> Analysis Analysis Analysis)"
- (variant$ #'&/$Cons (tuple$ (&/|list head tail))))
-
-(defn ^:private List$ [elems]
- "(-> (List Analysis) Analysis)"
- (&/fold (fn [tail head]
- (Cons$ head tail))
- $Nil
- (&/|reverse elems)))
-
-;; [Exports]
-(defn type->analysis [type]
- "(-> Type Analysis)"
- (|case type
- (&/$HostT class params)
- (variant$ #'&/$HostT (tuple$ (&/|list (text$ class)
- (List$ (&/|map type->analysis params)))))
-
- (&/$VoidT)
- (variant$ #'&/$VoidT (tuple$ (&/|list)))
-
- (&/$UnitT)
- (variant$ #'&/$UnitT (tuple$ (&/|list)))
-
- (&/$ProdT left right)
- (variant$ #'&/$ProdT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
-
- (&/$SumT left right)
- (variant$ #'&/$SumT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
-
- (&/$LambdaT input output)
- (variant$ #'&/$LambdaT (tuple$ (&/|list (type->analysis input) (type->analysis output))))
-
- (&/$UnivQ env body)
- (variant$ #'&/$UnivQ
- (tuple$ (&/|list (List$ (&/|map type->analysis env))
- (type->analysis body))))
-
- (&/$ExQ env body)
- (variant$ #'&/$ExQ
- (tuple$ (&/|list (List$ (&/|map type->analysis env))
- (type->analysis body))))
-
- (&/$BoundT idx)
- (variant$ #'&/$BoundT (int$ idx))
-
- (&/$AppT fun arg)
- (variant$ #'&/$AppT (tuple$ (&/|list (type->analysis fun) (type->analysis arg))))
-
- (&/$NamedT [module name] type*)
- (variant$ #'&/$NamedT (tuple$ (&/|list (tuple$ (&/|list (text$ module) (text$ name)))
- (type->analysis type*))))
-
- _
- (assert false (prn 'type->analysis (&type/show-type type)))
- ))
-
-(defn ^:private defmetavalue->analysis [dmv]
- "(-> Ann-Value Analysis)"
- (|case dmv
- (&/$BoolM value)
- (variant$ #'&/$BoolM (bool$ value))
-
- (&/$NatM value)
- (variant$ #'&/$NatM (nat$ value))
-
- (&/$IntM value)
- (variant$ #'&/$IntM (int$ value))
-
- (&/$FracM value)
- (variant$ #'&/$FracM (frac$ value))
-
- (&/$RealM value)
- (variant$ #'&/$RealM (real$ value))
-
- (&/$CharM value)
- (variant$ #'&/$CharM (char$ value))
-
- (&/$TextM value)
- (variant$ #'&/$TextM (text$ value))
-
- (&/$IdentM value)
- (variant$ #'&/$IdentM (ident$ value))
-
- (&/$ListM xs)
- (variant$ #'&/$ListM (List$ (&/|map defmetavalue->analysis xs)))
-
- (&/$DictM kvs)
- (variant$ #'&/$DictM
- (List$ (&/|map (fn [kv]
- (|let [[k v] kv]
- (tuple$ (&/|list (text$ k)
- (defmetavalue->analysis v)))))
- kvs)))
-
- _
- (assert false (prn 'defmetavalue->analysis (&/adt->text dmv)))
- ))
-
-(defn defmeta->analysis [xs]
- "(-> Anns Analysis)"
- (List$ (&/|map (fn [kv]
- (|let [[k v] kv]
- (tuple$ (&/|list (ident$ k)
- (defmetavalue->analysis v)))))
- xs)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 26176b840..3c8cef536 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -104,7 +104,7 @@
(do-template [<name> <static?> <method-type>]
(defn <name> [class-loader target method-name args]
(|let [target-class (Class/forName target true class-loader)]
- (if-let [[^Method method ^Class declarer] (first (for [^Method =method (.getMethods target-class)
+ (if-let [[^Method method ^Class declarer] (first (for [^Method =method (.getDeclaredMethods target-class)
:when (and (.equals ^Object method-name (.getName =method))
(.equals ^Object <static?> (Modifier/isStatic (.getModifiers =method)))
(let [param-types (&/->list (seq (.getParameterTypes =method)))]
@@ -394,7 +394,7 @@
(defn use-dummy-class [class-decl super-class interfaces ctor-args fields methods]
(|do [module &/get-module-name
:let [[?name ?params] class-decl
- dummy-name (str ?name "__DUMMY__")
+ dummy-name ?name;; (str ?name "__DUMMY__")
dummy-full-name (str module "/" dummy-name)
real-name (str (&host-generics/->class-name module) "." ?name)
store-name (str (&host-generics/->class-name module) "." dummy-name)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-14 22:32:44 +0000