aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/host.clj57
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler/case.clj10
-rw-r--r--src/lux/compiler/host.clj22
-rw-r--r--src/lux/type.clj2
-rw-r--r--src/lux/type/host.clj7
6 files changed, 76 insertions, 24 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 110bf253f..194205487 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -549,8 +549,8 @@
^:private analyse-jvm-dgt "dgt" "java.lang.Double" "java.lang.Boolean"
)
-(let [length-type &type/Int
- idx-type &type/Int]
+(let [length-type &type/Nat
+ idx-type &type/Nat]
(do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
(let [elem-type (&/$HostT <elem-class> &/$Nil)
array-type (&/$HostT <array-class> &/$Nil)]
@@ -599,8 +599,8 @@
;; else
false)))
-(let [length-type &type/Int
- idx-type &type/Int]
+(let [length-type &type/Nat
+ idx-type &type/Nat]
(defn ^:private analyse-jvm-anewarray [analyse exo-type ?values]
(|do [:let [(&/$Cons [_ (&/$TextS _gclass)] (&/$Cons length (&/$Nil))) ?values]
gclass (&reader/with-source "jvm-anewarray" _gclass
@@ -645,7 +645,7 @@
=array (&&/analyse-1+ analyse array)
[arr-class arr-params] (ensure-object (&&/expr-type* =array))
_ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
- _ (&type/check exo-type &type/Int)
+ _ (&type/check exo-type &type/Nat)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "arraylength"]) (&/|list =array) (&/|list))
@@ -885,8 +885,8 @@
(return (&/|list (&&/|meta output-type _cursor
(&&/$proc (&/T ["jvm" "load-class"]) (&/|list) (&/|list _class-name output-type)))))))
-(let [length-type &type/Int
- idx-type &type/Int]
+(let [length-type &type/Nat
+ idx-type &type/Nat]
(defn ^:private analyse-array-new [analyse exo-type ?values]
(|do [:let [(&/$Cons length (&/$Nil)) ?values]
:let [gclass (&/$GenericClass "java.lang.Object" (&/|list))
@@ -1008,9 +1008,9 @@
(do-template [<name> <op>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
- =mask (&&/analyse-1 analyse &type/Int mask)
- =input (&&/analyse-1 analyse &type/Int input)
- _ (&type/check exo-type &type/Int)
+ =mask (&&/analyse-1 analyse &type/Nat mask)
+ =input (&&/analyse-1 analyse &type/Nat input)
+ _ (&type/check exo-type &type/Nat)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list)))))))
@@ -1022,25 +1022,25 @@
(defn ^:private analyse-bit-count [analyse exo-type ?values]
(|do [:let [(&/$Cons input (&/$Nil)) ?values]
- =input (&&/analyse-1 analyse &type/Int input)
- _ (&type/check exo-type &type/Int)
+ =input (&&/analyse-1 analyse &type/Nat input)
+ _ (&type/check exo-type &type/Nat)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))
-(do-template [<name> <op>]
+(do-template [<name> <op> <type>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
- =shift (&&/analyse-1 analyse &type/Int shift)
- =input (&&/analyse-1 analyse &type/Int input)
- _ (&type/check exo-type &type/Int)
+ =shift (&&/analyse-1 analyse &type/Nat shift)
+ =input (&&/analyse-1 analyse <type> input)
+ _ (&type/check exo-type <type>)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list)))))))
- ^:private analyse-bit-shift-left "shift-left"
- ^:private analyse-bit-shift-right "shift-right"
- ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right"
+ ^:private analyse-bit-shift-left "shift-left" &type/Nat
+ ^:private analyse-bit-shift-right "shift-right" &type/Int
+ ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" &type/Nat
)
(defn ^:private analyse-lux-== [analyse exo-type ?values]
@@ -1101,6 +1101,19 @@
^:private analyse-nat-max-value &type/Nat ["nat" "max-value"]
)
+(do-template [<name> <from-type> <to-type> <op>]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons x (&/$Nil)) ?values]
+ =x (&&/analyse-1 analyse <from-type> x)
+ _ (&type/check exo-type <to-type>)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta <to-type> _cursor
+ (&&/$proc (&/T <op>) (&/|list =x) (&/|list)))))))
+
+ ^:private analyse-nat-to-int &type/Nat &type/Int ["nat" "to-int"]
+ ^:private analyse-int-to-nat &type/Int &type/Nat ["int" "to-nat"]
+ )
+
(defn analyse-host [analyse exo-type compilers category proc ?values]
(|let [[_ _ compile-class compile-interface] compilers]
(case category
@@ -1139,6 +1152,12 @@
"decode" (analyse-nat-decode analyse exo-type ?values)
"min-value" (analyse-nat-min-value analyse exo-type ?values)
"max-value" (analyse-nat-max-value analyse exo-type ?values)
+ "to-int" (analyse-nat-to-int analyse exo-type ?values)
+ )
+
+ "int"
+ (case proc
+ "to-nat" (analyse-int-to-nat analyse exo-type ?values)
)
"jvm"
diff --git a/src/lux/base.clj b/src/lux/base.clj
index ba42f702d..b5bd4e732 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -1047,7 +1047,7 @@
(pr-str ?value)
[_ ($NatS ?value)]
- (Long/toUnsignedString ?value)
+ (str "+" (Long/toUnsignedString ?value))
[_ ($IntS ?value)]
(pr-str ?value)
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 08624d171..4ca543b8e 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -72,6 +72,16 @@
(.visitLdcInsn _value)
(.visitJumpInsn Opcodes/IF_ICMPNE $else))
+ (&o/$NatPM _value)
+ (doto writer
+ (.visitInsn Opcodes/DUP)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_peek" "([Ljava/lang/Object;)Ljava/lang/Object;")
+ (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Long" "longValue" "()J")
+ (.visitLdcInsn (long _value))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFNE $else))
+
(&o/$IntPM _value)
(doto writer
(.visitInsn Opcodes/DUP)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index cdfc7dc7e..b6cd643d6 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -1570,7 +1570,10 @@
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
:let [_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "toUnsignedString" "(J)Ljava/lang/String;"))]]
+ (.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;"))]]
(return nil)))
(defn ^:private compile-nat-decode [compile ?values special-args]
@@ -1597,6 +1600,17 @@
^:private compile-nat-max-value (.visitLdcInsn -1) &&/wrap-long
)
+(do-template [<name>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)]
+ (return nil)))
+
+ ^:private compile-nat-to-int
+ ^:private compile-int-to-nat
+ )
+
(defn compile-host [compile proc-category proc-name ?values special-args]
(case proc-category
"lux"
@@ -1630,6 +1644,12 @@
"decode" (compile-nat-decode compile ?values special-args)
"max-value" (compile-nat-max-value compile ?values special-args)
"min-value" (compile-nat-min-value compile ?values special-args)
+ "to-int" (compile-nat-to-int compile ?values special-args)
+ )
+
+ "int"
+ (case proc-name
+ "to-nat" (compile-int-to-nat compile ?values special-args)
)
"jvm"
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 7ca4145a6..8099eb914 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -92,7 +92,7 @@
TypePair
(&/$SumT
;; BoundT
- Int
+ Nat
(&/$SumT
;; VarT
Int
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index a3252ddb7..fe910c76e 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -269,11 +269,14 @@
(not= array-data-tag a!name))
(check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
- (and (or (= nat-data-tag e!name)
- (= "java.lang.Long" e!name))
+ (and (= nat-data-tag e!name)
(= nat-data-tag a!name))
(return fixpoints)
+ (or (= nat-data-tag e!name)
+ (= nat-data-tag a!name))
+ (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
+
:else
(let [e!name (as-obj e!name)
a!name (as-obj a!name)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 11:49:44 +0000