aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj4
-rw-r--r--src/lux/analyser/base.clj1
-rw-r--r--src/lux/analyser/case.clj23
-rw-r--r--src/lux/analyser/host.clj62
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/compiler.clj3
-rw-r--r--src/lux/compiler/host.clj224
-rw-r--r--src/lux/compiler/lux.clj1
-rw-r--r--src/lux/compiler/type.clj4
-rw-r--r--src/lux/lexer.clj3
-rw-r--r--src/lux/optimizer.clj14
-rw-r--r--src/lux/parser.clj3
-rw-r--r--src/lux/type.clj32
-rw-r--r--src/lux/type/host.clj8
14 files changed, 363 insertions, 24 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index d6cc5cfda..2ad3745d8 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -71,6 +71,10 @@
(|do [_ (&type/check exo-type &type/Bool)]
(return (&/|list (&&/|meta exo-type cursor (&&/$bool ?value)))))
+ (&/$NatS ?value)
+ (|do [_ (&type/check exo-type &type/Nat)]
+ (return (&/|list (&&/|meta exo-type cursor (&&/$nat ?value)))))
+
(&/$IntS ?value)
(|do [_ (&type/check exo-type &type/Int)]
(return (&/|list (&&/|meta exo-type cursor (&&/$int ?value)))))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index fed65bb29..45d111249 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -12,6 +12,7 @@
;; [Tags]
(defvariant
("bool" 1)
+ ("nat" 1)
("int" 1)
("real" 1)
("char" 1)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 8b1ee3a89..bccbd4a07 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -18,6 +18,7 @@
(defvariant
("DefaultTotal" 1)
("BoolTotal" 2)
+ ("NatTotal" 2)
("IntTotal" 2)
("RealTotal" 2)
("CharTotal" 2)
@@ -29,6 +30,7 @@
("NoTestAC" 0)
("StoreTestAC" 1)
("BoolTestAC" 1)
+ ("NatTestAC" 1)
("IntTestAC" 1)
("RealTestAC" 1)
("CharTestAC" 1)
@@ -265,6 +267,11 @@
=kont kont]
(return (&/T [($BoolTestAC ?value) =kont])))
+ (&/$NatS ?value)
+ (|do [_ (&type/check value-type &type/Nat)
+ =kont kont]
+ (return (&/T [($NatTestAC ?value) =kont])))
+
(&/$IntS ?value)
(|do [_ (&type/check value-type &type/Int)
=kont kont]
@@ -394,6 +401,9 @@
[($BoolTotal total? ?values) ($NoTestAC)]
(return ($BoolTotal true ?values))
+ [($NatTotal total? ?values) ($NoTestAC)]
+ (return ($NatTotal true ?values))
+
[($IntTotal total? ?values) ($NoTestAC)]
(return ($IntTotal true ?values))
@@ -418,6 +428,9 @@
[($BoolTotal total? ?values) ($StoreTestAC ?idx)]
(return ($BoolTotal true ?values))
+ [($NatTotal total? ?values) ($StoreTestAC ?idx)]
+ (return ($NatTotal true ?values))
+
[($IntTotal total? ?values) ($StoreTestAC ?idx)]
(return ($IntTotal true ?values))
@@ -442,6 +455,12 @@
[($BoolTotal total? ?values) ($BoolTestAC ?value)]
(return ($BoolTotal total? (&/$Cons ?value ?values)))
+ [($DefaultTotal total?) ($NatTestAC ?value)]
+ (return ($NatTotal total? (&/|list ?value)))
+
+ [($NatTotal total? ?values) ($NatTestAC ?value)]
+ (return ($NatTotal total? (&/$Cons ?value ?values)))
+
[($DefaultTotal total?) ($IntTestAC ?value)]
(return ($IntTotal total? (&/|list ?value)))
@@ -527,6 +546,10 @@
(return (or ?total
(= #{true false} (set (&/->seq ?values))))))
+ ($NatTotal ?total _)
+ (|do [_ (&type/check value-type &type/Nat)]
+ (return ?total))
+
($IntTotal ?total _)
(|do [_ (&type/check value-type &type/Int)]
(return ?total))
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index be69dc54c..110bf253f 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -1054,6 +1054,53 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["lux" "=="]) (&/|list =left =right) (&/|list)))))))))
+(do-template [<name> <proc> <input-type> <output-type>]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
+ =x (&&/analyse-1 analyse <input-type> x)
+ =y (&&/analyse-1 analyse <input-type> y)
+ _ (&type/check exo-type <output-type>)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta <output-type> _cursor
+ (&&/$proc (&/T ["nat" <proc>]) (&/|list =x =y) (&/|list)))))))
+
+ ^:private analyse-nat-add "add" &type/Nat &type/Nat
+ ^:private analyse-nat-sub "sub" &type/Nat &type/Nat
+ ^:private analyse-nat-mul "mul" &type/Nat &type/Nat
+ ^:private analyse-nat-div "div" &type/Nat &type/Nat
+ ^:private analyse-nat-rem "rem" &type/Nat &type/Nat
+ ^:private analyse-nat-eq "eq" &type/Nat &type/Bool
+ ^:private analyse-nat-lt "lt" &type/Nat &type/Bool
+ )
+
+(defn ^:private analyse-nat-encode [analyse exo-type ?values]
+ (|do [:let [(&/$Cons x (&/$Nil)) ?values]
+ =x (&&/analyse-1 analyse &type/Nat x)
+ _ (&type/check exo-type &type/Text)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta &type/Text _cursor
+ (&&/$proc (&/T ["nat" "encode"]) (&/|list =x) (&/|list)))))))
+
+(defn ^:private analyse-nat-decode [analyse exo-type ?values]
+ (|do [:let [(&/$Cons x (&/$Nil)) ?values]
+ =x (&&/analyse-1 analyse &type/Text x)
+ _ (&type/check exo-type (&/$AppT &type/Maybe &type/Nat))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta (&/$AppT &type/Maybe &type/Nat) _cursor
+ (&&/$proc (&/T ["nat" "decode"]) (&/|list =x) (&/|list)))))))
+
+(do-template [<name> <type> <op>]
+ (defn <name> [analyse exo-type ?values]
+ (|do [:let [(&/$Nil) ?values]
+ _ (&type/check exo-type <type>)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta <type> _cursor
+ (&&/$proc (&/T <op>) (&/|list) (&/|list)))))))
+
+ ^:private analyse-nat-min-value &type/Nat ["nat" "min-value"]
+ ^:private analyse-nat-max-value &type/Nat ["nat" "max-value"]
+ )
+
(defn analyse-host [analyse exo-type compilers category proc ?values]
(|let [[_ _ compile-class compile-interface] compilers]
(case category
@@ -1078,6 +1125,21 @@
"put" (analyse-jvm-aastore analyse exo-type ?values)
"remove" (analyse-array-remove analyse exo-type ?values)
"size" (analyse-jvm-arraylength analyse exo-type ?values))
+
+ "nat"
+ (case proc
+ "+" (analyse-nat-add analyse exo-type ?values)
+ "-" (analyse-nat-sub analyse exo-type ?values)
+ "*" (analyse-nat-mul analyse exo-type ?values)
+ "/" (analyse-nat-div analyse exo-type ?values)
+ "%" (analyse-nat-rem analyse exo-type ?values)
+ "=" (analyse-nat-eq analyse exo-type ?values)
+ "<" (analyse-nat-lt analyse exo-type ?values)
+ "encode" (analyse-nat-encode analyse exo-type ?values)
+ "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)
+ )
"jvm"
(case proc
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 462bccd69..ba42f702d 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -70,6 +70,7 @@
;; AST
(defvariant
("BoolS" 1)
+ ("NatS" 1)
("IntS" 1)
("RealS" 1)
("CharS" 1)
@@ -213,6 +214,7 @@
;; Meta-data
(defvariant
("BoolM" 1)
+ ("NatM" 1)
("IntM" 1)
("RealM" 1)
("CharM" 1)
@@ -1044,6 +1046,9 @@
[_ ($BoolS ?value)]
(pr-str ?value)
+ [_ ($NatS ?value)]
+ (Long/toUnsignedString ?value)
+
[_ ($IntS ?value)]
(pr-str ?value)
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 4548e71ab..19832d4e6 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -52,6 +52,9 @@
(&o/$bool ?value)
(&&lux/compile-bool ?value)
+ (&o/$nat ?value)
+ (&&lux/compile-nat ?value)
+
(&o/$int ?value)
(&&lux/compile-int ?value)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index ae4b98f9f..cdfc7dc7e 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -779,26 +779,106 @@
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd))
+ _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "log" "(Ljava/lang/Object;)Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
+ (.visitLdcInsn "LOG: ")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "print" "(Ljava/lang/Object;)V")
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "println" "(Ljava/lang/Object;)V")
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "make_none" "()Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitLdcInsn (->> #'&/$None meta ::&/idx int)) ;; I
+ (.visitInsn Opcodes/ACONST_NULL) ;; I?
+ (.visitLdcInsn &/unit-tag) ;; I?U
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitLdcInsn (->> #'&/$Some meta ::&/idx int)) ;; I
+ (.visitInsn Opcodes/ACONST_NULL) ;; I?
+ (.visitVarInsn Opcodes/ALOAD 0) ;; I?O
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
_ (let [$end (new Label)
- $else (new Label)]
- (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "log" "(Ljava/lang/Object;)Ljava/lang/Object;" nil nil)
+ ;; $then (new Label)
+ $else (new Label)
+ $from (new Label)
+ $to (new Label)
+ $handler (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "decode_nat" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil)
(.visitCode)
- (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
- (.visitLdcInsn "LOG: ")
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "print" "(Ljava/lang/Object;)V")
- (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "println" "(Ljava/lang/Object;)V")
+ (.visitLdcInsn "+")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "startsWith" "(Ljava/lang/String;)Z")
+ (.visitJumpInsn Opcodes/IFEQ $else)
(.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 "java/lang/Long" "parseUnsignedLong" "(Ljava/lang/String;)J")
+ (.visitLabel $to)
+ ;; (.visitJumpInsn Opcodes/GOTO $then)
+ ;; (.visitLabel $then)
+ (&&/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)
+ (.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)
+ (.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"]))
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
_ (doto =class
- (compile-LuxRT-adt-methods)
- (compile-LuxRT-pm-methods))]]
+ (compile-LuxRT-pm-methods)
+ (compile-LuxRT-adt-methods))]]
(&&/save-class! (second (string/split &&/lux-utils-class #"/"))
(.toByteArray (doto =class .visitEnd)))))
+(defn ^:private compile-jvm-try [compile ?values special-args]
+ (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values
+ ;; (&/$Nil) special-args
+ ]
+ ^MethodVisitor *writer* &/get-writer
+ :let [$from (new Label)
+ $to (new Label)
+ $handler (new Label)
+ $end (new Label)]
+ :let [_ (doto *writer*
+ (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
+ (.visitLabel $from))]
+ _ (compile ?body)
+ :let [_ (doto *writer*
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $to)
+ (.visitLabel $handler))]
+ _ (compile ?catch)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (.visitInsn Opcodes/SWAP)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))]
+ :let [_ (.visitLabel *writer* $end)]]
+ (return nil)))
+
(do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>]
(defn <name> [compile _?value special-args]
(|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
@@ -1406,6 +1486,117 @@
(.visitLabel $end))]]
(return nil)))
+(do-template [<name> <opcode> <wrapper-class> <value-method> <value-method-sig> <wrap>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ _ (doto *writer*
+ (.visitInsn <opcode>)
+ (<wrap>))]]
+ (return nil)))
+
+ ^:private compile-nat-add Opcodes/LADD "java.lang.Long" "longValue" "()J" &&/wrap-long
+ ^:private compile-nat-sub Opcodes/LSUB "java.lang.Long" "longValue" "()J" &&/wrap-long
+ ^:private compile-nat-mul Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long
+ )
+
+(do-template [<name> <wrapper-class> <value-method> <value-method-sig> <wrap> <comp-method> <comp-sig>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ _ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ <comp-method> <comp-sig>)
+ (&&/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"
+ )
+
+(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig> <comp-method> <comp-sig>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ $then (new Label)
+ $end (new Label)
+ _ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "compareUnsigned" "(JJ)I")
+ (.visitLdcInsn (int <cmp-output>))
+ (.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)))
+
+ ^: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"
+ )
+
+(defn ^:private compile-nat-encode [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
+ :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+ "longValue" "()J"))]
+ :let [_ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "toUnsignedString" "(J)Ljava/lang/String;"))]]
+ (return nil)))
+
+(defn ^:private compile-nat-decode [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.String")]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+))]
+ :let [_ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "decode_nat" "(Ljava/lang/String;)Ljava/lang/Object;"))]]
+ (return nil)))
+
+(do-template [<name> <instr> <wrapper>]
+ (defn <name> [compile ?values special-args]
+ (|do [:let [(&/$Nil) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ :let [_ (doto *writer*
+ <instr>
+ <wrapper>)]]
+ (return nil)))
+
+ ^:private compile-nat-min-value (.visitLdcInsn 0) &&/wrap-long
+ ^:private compile-nat-max-value (.visitLdcInsn -1) &&/wrap-long
+ )
+
(defn compile-host [compile proc-category proc-name ?values special-args]
(case proc-category
"lux"
@@ -1425,6 +1616,21 @@
"array"
(case proc-name
"get" (compile-array-get compile ?values special-args))
+
+ "nat"
+ (case proc-name
+ "add" (compile-nat-add compile ?values special-args)
+ "sub" (compile-nat-sub compile ?values special-args)
+ "mul" (compile-nat-mul compile ?values special-args)
+ "div" (compile-nat-div compile ?values special-args)
+ "rem" (compile-nat-rem compile ?values special-args)
+ "eq" (compile-nat-eq compile ?values special-args)
+ "lt" (compile-nat-lt compile ?values special-args)
+ "encode" (compile-nat-encode compile ?values special-args)
+ "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)
+ )
"jvm"
(case proc-name
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 87113b538..83bb2ac44 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -45,6 +45,7 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>))]]
(return nil)))
+ compile-nat "java/lang/Long" "(J)V" long
compile-int "java/lang/Long" "(J)V" long
compile-real "java/lang/Double" "(D)V" double
compile-char "java/lang/Character" "(C)V" char
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index bf6ec5539..f51165ea3 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -30,6 +30,7 @@
(<tag> value)))
^:private bool$ &a/$bool "(-> Bool Analysis)"
+ ^:private nat$ &a/$nat "(-> Nat Analysis)"
^:private int$ &a/$int "(-> Int Analysis)"
^:private real$ &a/$real "(-> Real Analysis)"
^:private char$ &a/$char "(-> Char Analysis)"
@@ -109,6 +110,9 @@
(&/$BoolM value)
(variant$ #'&/$BoolM (bool$ value))
+ (&/$NatM value)
+ (variant$ #'&/$NatM (nat$ value))
+
(&/$IntM value)
(variant$ #'&/$IntM (int$ value))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 9754456b9..690a25106 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -15,6 +15,7 @@
("White_Space" 1)
("Comment" 1)
("Bool" 1)
+ ("Nat" 1)
("Int" 1)
("Real" 1)
("Char" 1)
@@ -157,6 +158,7 @@
(return (&/T [meta (<tag> token)]))))
lex-bool $Bool #"^(true|false)"
+ lex-nat $Nat #"^\+(0|[1-9][0-9]*)"
lex-int $Int #"^-?(0|[1-9][0-9]*)"
lex-real $Real #"^-?(0\.[0-9]+|[1-9][0-9]*\.[0-9]+)(e-?[1-9][0-9]*)?"
)
@@ -233,6 +235,7 @@
lex-comment
lex-bool
lex-real
+ lex-nat
lex-int
lex-char
lex-text
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index c03515370..fd859d90d 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -10,6 +10,7 @@
;; [Tags]
(defvariant
("bool" 1)
+ ("nat" 1)
("int" 1)
("real" 1)
("char" 1)
@@ -34,6 +35,7 @@
("PopPM" 0)
("BindPM" 1)
("BoolPM" 1)
+ ("NatPM" 1)
("IntPM" 1)
("RealPM" 1)
("CharPM" 1)
@@ -58,6 +60,10 @@
(&/|list ($BoolPM _value)
$PopPM)
+ (&a-case/$NatTestAC _value)
+ (&/|list ($NatPM _value)
+ $PopPM)
+
(&a-case/$IntTestAC _value)
(&/|list ($IntPM _value)
$PopPM)
@@ -129,6 +135,11 @@
($BoolPM _pre-value)
($AltPM pre post))
+ [($NatPM _pre-value) ($NatPM _post-value)]
+ (if (= _pre-value _post-value)
+ ($NatPM _pre-value)
+ ($AltPM pre post))
+
[($IntPM _pre-value) ($IntPM _post-value)]
(if (= _pre-value _post-value)
($IntPM _pre-value)
@@ -342,6 +353,9 @@
(&a/$bool value)
(&/T [meta ($bool value)])
+ (&a/$nat value)
+ (&/T [meta ($nat value)])
+
(&a/$int value)
(&/T [meta ($int value)])
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index 5b0bfce57..d5b4a54cd 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -76,6 +76,9 @@
(&lexer/$Bool ?value)
(return (&/|list (&/T [meta (&/$BoolS (Boolean/parseBoolean ?value))])))
+ (&lexer/$Nat ?value)
+ (return (&/|list (&/T [meta (&/$NatS (Long/parseUnsignedLong ?value))])))
+
(&lexer/$Int ?value)
(return (&/|list (&/T [meta (&/$IntS (Long/parseLong ?value))])))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e79cfe46d..7ca4145a6 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -28,6 +28,7 @@
(def empty-env &/$Nil)
(def Bool (&/$NamedT (&/T ["lux" "Bool"]) (&/$HostT "java.lang.Boolean" &/$Nil)))
+(def Nat (&/$NamedT (&/T ["lux" "Nat"]) (&/$HostT "#Nat" &/$Nil)))
(def Int (&/$NamedT (&/T ["lux" "Int"]) (&/$HostT "java.lang.Long" &/$Nil)))
(def Real (&/$NamedT (&/T ["lux" "Real"]) (&/$HostT "java.lang.Double" &/$Nil)))
(def Char (&/$NamedT (&/T ["lux" "Char"]) (&/$HostT "java.lang.Character" &/$Nil)))
@@ -120,25 +121,28 @@
;; BoolM
Bool
(&/$SumT
- ;; IntM
- Int
+ ;; NatM
+ Nat
(&/$SumT
- ;; RealM
- Real
+ ;; IntM
+ Int
(&/$SumT
- ;; CharM
- Char
+ ;; RealM
+ Real
(&/$SumT
- ;; TextM
- Text
+ ;; CharM
+ Char
(&/$SumT
- ;; IdentM
- Ident
+ ;; TextM
+ Text
(&/$SumT
- ;; ListM
- (&/$AppT List DefMetaValue)
- ;; DictM
- (&/$AppT List (&/$ProdT Text DefMetaValue)))))))))
+ ;; IdentM
+ Ident
+ (&/$SumT
+ ;; ListM
+ (&/$AppT List DefMetaValue)
+ ;; DictM
+ (&/$AppT List (&/$ProdT Text DefMetaValue))))))))))
)
&/$VoidT))))
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index b3858d2e5..a3252ddb7 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -16,6 +16,7 @@
;; [Exports]
(def array-data-tag "#Array")
(def null-data-tag "#Null")
+(def nat-data-tag "#Nat")
;; [Utils]
(defn ^:private trace-lineage* [^Class super-class ^Class sub-class]
@@ -267,7 +268,12 @@
(and (= array-data-tag e!name)
(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))
+ (= nat-data-tag a!name))
+ (return fixpoints)
+
: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-09 09:19:06 +0000