aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj38
-rw-r--r--src/lux/compiler.clj70
-rw-r--r--test2.lux88
3 files changed, 113 insertions, 83 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 07d3fb3b7..6f9573f4c 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -423,6 +423,36 @@
(return full-name)
(fail "Unknown class.")))])))
+(defn full-class [class]
+ ;; (prn 'full-class-name class)
+ (case class
+ "boolean" (return Boolean/TYPE)
+ "byte" (return Byte/TYPE)
+ "short" (return Short/TYPE)
+ "int" (return Integer/TYPE)
+ "long" (return Long/TYPE)
+ "float" (return Float/TYPE)
+ "double" (return Double/TYPE)
+ "char" (return Character/TYPE)
+ ;; else
+ (if (.contains class ".")
+ (return class)
+ (try-all-m [(exec [=class (resolve class)
+ ;; :let [_ (prn '=class =class)]
+ ]
+ (match (:form =class)
+ [::class ?full-name]
+ (return (Class/forName ?full-name))
+ _
+ (fail "Unknown class.")))
+ (let [full-name* (str "java.lang." class)]
+ (if-let [full-name (try (Class/forName full-name*)
+ full-name*
+ (catch Exception e
+ nil))]
+ (return (Class/forName full-name))
+ (fail "Unknown class.")))]))))
+
(defanalyser analyse-jvm-getstatic
[::&parser/form ([[::&parser/ident "jvm/getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)]
(exec [=class (full-class-name ?class)
@@ -433,14 +463,14 @@
[::&parser/form ([[::&parser/ident "jvm/invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)]
(exec [=class (full-class-name ?class)
=classes (map-m #(exec [class* (extract-ident %)]
- (full-class-name class*))
+ (full-class class*))
?classes)
- =return (lookup-virtual-method (Class/forName =class) ?method (map #(Class/forName %) =classes))
- ;; :let [_ (prn 'analyse-jvm-invokevirtual '=return =return)]
+ =return (lookup-virtual-method (Class/forName =class) ?method =classes)
+ :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)]
;; =return =return
=object (analyse-form* ?object)
=args (map-m analyse-form* ?args)]
- (return (annotated [::jvm-invokevirtual =class ?method =classes =object =args] =return))))
+ (return (annotated [::jvm-invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return))))
;; (defanalyser analyse-access
;; [::&parser/access ?object ?member]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index ae8c75aa0..76f3efb54 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -71,6 +71,14 @@
(defn ^:private ->type-signature [class]
(case class
"Void" "V"
+ "boolean" "Z"
+ "byte" "B"
+ "short" "S"
+ "int" "I"
+ "long" "J"
+ "float" "F"
+ "double" "D"
+ "char" "C"
;; else
(str "L" (->class class) ";")))
@@ -85,6 +93,12 @@
[::&type/primitive "boolean"]
"Z"
+ [::&type/primitive "int"]
+ "I"
+
+ [::&type/primitive "char"]
+ "C"
+
[::&type/object ?name []]
(->type-signature ?name)
@@ -164,7 +178,10 @@
(do ;; (prn 'CAPTURED [?scope ?captured-id])
(doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD (apply str (interpose "$" ?scope)) (str "__" ?captured-id) "Ljava/lang/Object;"))))
+ (.visitFieldInsn Opcodes/GETFIELD
+ (apply str (interpose "$" (map (comp normalize-ident str) ?scope)))
+ (str "__" ?captured-id)
+ "Ljava/lang/Object;"))))
(defcompiler ^:private compile-global
[::&analyser/global ?owner-class ?name]
@@ -259,7 +276,9 @@
(.visitInsn Opcodes/ACONST_NULL)))
))
-(let [boolean-class "java.lang.Boolean"]
+(let [boolean-class "java.lang.Boolean"
+ integer-class "java.lang.Integer"
+ char-class "java.lang.Character"]
(defcompiler ^:private compile-jvm-invokevirtual
[::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args]
(let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*)
@@ -268,12 +287,52 @@
(.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class))
(doseq [[class-name arg] (map vector ?classes ?args)]
(do (compile-form (assoc *state* :form arg))
- (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name))))
+ (condp = class-name
+ "boolean" (let [wrapper-class (->class "java.lang.Boolean")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "booleanValue" "()Z")))
+ "byte" (let [wrapper-class (->class "java.lang.Byte")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "byteValue" "()B")))
+ "short" (let [wrapper-class (->class "java.lang.Short")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "shortValue" "()S")))
+ "int" (let [wrapper-class (->class "java.lang.Integer")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "intValue" "()I")))
+ "long" (let [wrapper-class (->class "java.lang.Long")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "longValue" "()J")))
+ "float" (let [wrapper-class (->class "java.lang.Float")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "floatValue" "()F")))
+ "double" (let [wrapper-class (->class "java.lang.Double")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "doubleValue" "()D")))
+ "char" (let [wrapper-class (->class "java.lang.Character")]
+ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST wrapper-class)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "charValue" "()C")))
+ ;; else
+ (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name)))))
(.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (->class ?class) ?method method-sig)
(match *type*
::&type/nothing
(.visitInsn *writer* Opcodes/ACONST_NULL)
+ [::&type/primitive "char"]
+ (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class char-class) "valueOf" (str "(C)" (->type-signature char-class)))
+
+ [::&type/primitive "int"]
+ (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class integer-class) "valueOf" (str "(I)" (->type-signature integer-class)))
+
[::&type/primitive "boolean"]
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class boolean-class) "valueOf" (str "(Z)" (->type-signature boolean-class)))
@@ -790,12 +849,13 @@
[::&analyser/lambda ?scope ?frame ?args ?body]
(let [_ (prn '[?scope ?frame] ?scope ?frame ?args)
num-args (count ?args)
- outer-class (->class *class-name*)
+ ;; outer-class (->class *class-name*)
clo-field-sig (->type-signature "java.lang.Object")
counter-sig "I"
apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"
real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;")
- current-class (apply str (interpose "$" ?scope))
+ ;; current-class (apply str (interpose "$" ?scope))
+ current-class (apply str (interpose "$" (map (comp normalize-ident str) ?scope)))
num-captured (dec num-args)
init-signature (str "(" (apply str (repeat (->> (:mappings ?frame)
(map (comp :form second))
diff --git a/test2.lux b/test2.lux
index c3854ab19..8f076a839 100644
--- a/test2.lux
+++ b/test2.lux
@@ -339,17 +339,21 @@
#Nil
(#Cons from (range (inc from) to))))
+(def (text->list text)
+ (let length (jvm/invokevirtual String "length" []
+ text [])
+ (map (lambda [idx]
+ (jvm/invokevirtual String "charAt" [int]
+ text [idx]))
+ (range 0 length))))
+
+(def (normalize-ident ident)
+ (fold concat "" (map normalize-char (text->list ident))))
+
#(
- (def (text->list text)
- (let length (jvm/invokevirtual String "length" []
- text [])
- (map (lambda [idx]
- (jvm/invokevirtual String "charAt" [int]
- text [idx]))
- (range-to 0 length))))
+
- (def (normalize-ident ident)
- (fold concat "" (map normalize-char (text->list ident))))
+
(def (fresh-class-loader path)
(let file (jvm/new java.io.File [String] [path])
@@ -482,70 +486,6 @@
(do (print (show char)) (print " -> ")
(println (normalize-char char))))
(println (show-list (range 0 10)))
+ (println (normalize-ident "text->list"))
)
))
-
-#( (def (main args)
- (case (' ((~ "Oh yeah...")))
- (#Form (#Cons (#Text text) #Nil))
- (do (:: (:: System out) (println text))
- (:: (:: System out) (println (+ 10 20)))
- (:: (:: System out) (println (inc 10)))
- (:: (:: System out) (println (jvm/i- 10 20)))
- (:: (:: System out) (println (jvm/i* 10 20)))
- (:: (:: System out) (println (jvm/i/ 10 2))))
- ))
-
- (defmacro (::+ pieces)
- (case pieces
- (#Cons init #Nil)
- init
-
- (#Cons init (#Cons access others))
- (' (::+ (:: (~ init) (~ access)) (~@ others)))
- ))
-
- (def (main args)
- (if true
- (let f (lambda [x] (lambda [y] (x y)))
- (let g (lambda [x] x)
- (::+ System out (println (f g "WE'VE GOT CLOSURES!")))))
- (:: (:: System out) (println "FALSE"))))
-
- (def (main args)
- (if true
- (case (++ (#Cons "Pattern" #Nil) (#Cons "Matching" #Nil))
- (#Cons "Pattern" (#Cons second #Nil))
- (do (:: (:: System out) (println "Branch #1"))
- (:: (:: System out) (println second)))
-
- (#Cons first (#Cons second #Nil))
- (do (:: (:: System out) (println "Branch #2"))
- (:: (:: System out) (println first))
- (:: (:: System out) (println second))))
- (:: (:: System out) (println "FALSE"))))
-
- (def (main args)
- (case (template (#Cons (#Cons (#Symbol "~@") (#Cons (#Symbol "Pattern") #Nil)) #Nil)
- ## (#Cons (#Cons (#Symbol "~") (#Cons (#Symbol "Pattern") #Nil)) #Nil)
- )
- (#Cons word #Nil)
- (do (:: (:: System out) (println "Branch #1"))
- (:: (:: System out) (println word)))
-
- (#Cons (#Symbol op) spliced)
- (do (:: (:: System out) (println "Branch #2"))
- (:: (:: System out) (println op)))
- ))
-
- (def (main args)
- (case (' "YOLO")
- (#Text text)
- (:: (:: System out) (println text))))
-
- (def (main args)
- (case (' ((~ "TROLOLOL")))
- (#Form (#Cons (#Text text) #Nil))
- (:: (:: System out) (println text))
- ))
- )#
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 00:54:13 +0000