aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/base.clj1
-rw-r--r--src/lux/analyser/case.clj23
-rw-r--r--src/lux/base.clj59
-rw-r--r--src/lux/compiler.clj3
-rw-r--r--src/lux/compiler/host.clj418
-rw-r--r--src/lux/compiler/lux.clj1
-rw-r--r--src/lux/compiler/type.clj4
-rw-r--r--src/lux/lexer.clj5
-rw-r--r--src/lux/optimizer.clj15
-rw-r--r--src/lux/parser.clj3
-rw-r--r--src/lux/type.clj27
11 files changed, 334 insertions, 225 deletions
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 45d111249..302b5ba7c 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -14,6 +14,7 @@
("bool" 1)
("nat" 1)
("int" 1)
+ ("frac" 1)
("real" 1)
("char" 1)
("text" 1)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index bccbd4a07..2fd787f28 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -20,6 +20,7 @@
("BoolTotal" 2)
("NatTotal" 2)
("IntTotal" 2)
+ ("FracTotal" 2)
("RealTotal" 2)
("CharTotal" 2)
("TextTotal" 2)
@@ -32,6 +33,7 @@
("BoolTestAC" 1)
("NatTestAC" 1)
("IntTestAC" 1)
+ ("FracTestAC" 1)
("RealTestAC" 1)
("CharTestAC" 1)
("TextTestAC" 1)
@@ -277,6 +279,11 @@
=kont kont]
(return (&/T [($IntTestAC ?value) =kont])))
+ (&/$FracS ?value)
+ (|do [_ (&type/check value-type &type/Frac)
+ =kont kont]
+ (return (&/T [($FracTestAC ?value) =kont])))
+
(&/$RealS ?value)
(|do [_ (&type/check value-type &type/Real)
=kont kont]
@@ -407,6 +414,9 @@
[($IntTotal total? ?values) ($NoTestAC)]
(return ($IntTotal true ?values))
+ [($FracTotal total? ?values) ($NoTestAC)]
+ (return ($FracTotal true ?values))
+
[($RealTotal total? ?values) ($NoTestAC)]
(return ($RealTotal true ?values))
@@ -434,6 +444,9 @@
[($IntTotal total? ?values) ($StoreTestAC ?idx)]
(return ($IntTotal true ?values))
+ [($FracTotal total? ?values) ($StoreTestAC ?idx)]
+ (return ($FracTotal true ?values))
+
[($RealTotal total? ?values) ($StoreTestAC ?idx)]
(return ($RealTotal true ?values))
@@ -467,6 +480,12 @@
[($IntTotal total? ?values) ($IntTestAC ?value)]
(return ($IntTotal total? (&/$Cons ?value ?values)))
+ [($DefaultTotal total?) ($FracTestAC ?value)]
+ (return ($FracTotal total? (&/|list ?value)))
+
+ [($FracTotal total? ?values) ($FracTestAC ?value)]
+ (return ($FracTotal total? (&/$Cons ?value ?values)))
+
[($DefaultTotal total?) ($RealTestAC ?value)]
(return ($RealTotal total? (&/|list ?value)))
@@ -554,6 +573,10 @@
(|do [_ (&type/check value-type &type/Int)]
(return ?total))
+ ($FracTotal ?total _)
+ (|do [_ (&type/check value-type &type/Frac)]
+ (return ?total))
+
($RealTotal ?total _)
(|do [_ (&type/check value-type &type/Real)]
(return ?total))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index fbcf92413..b31fcf11f 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -3,7 +3,8 @@
;; 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.base
- (:require (clojure [template :refer [do-template]])
+ (:require (clojure [template :refer [do-template]]
+ [string :as string])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array))
@@ -217,6 +218,7 @@
("BoolM" 1)
("NatM" 1)
("IntM" 1)
+ ("FracM" 1)
("RealM" 1)
("CharM" 1)
("TextM" 1)
@@ -1042,6 +1044,58 @@
(fn [state]
(return* state (get$ $cursor state))))
+(let [remove-trailing-0s (fn [^String input]
+ (-> input
+ (.split "0*$")
+ (aget 0)))
+ make-text-start-0 (fn [input]
+ (loop [accum ""
+ range 10]
+ (if (< input range)
+ (recur (.concat accum "0")
+ (* 10 range))
+ accum)))
+ count-bin-start-0 (fn [input]
+ (loop [counter 0
+ idx 63]
+ (if (and (> idx -1)
+ (not (bit-test input idx)))
+ (recur (inc counter)
+ (dec idx))
+ counter)))
+ read-frac-text (fn [^String input]
+ (let [output* (.split input "0*$")]
+ (if (= 0 (alength output*))
+ (Long/parseUnsignedLong (aget output* 0))
+ (Long/parseUnsignedLong input))))
+ count-leading-0s (fn [^String input]
+ (let [parts (.split input "^0*")]
+ (if (= 2 (alength parts))
+ (.length (aget parts 0))
+ 0)))]
+ (defn encode-frac [input]
+ (if (= 0 input)
+ ".0"
+ (->> input
+ (Long/toUnsignedString)
+ remove-trailing-0s
+ (.concat (->> (count-bin-start-0 input)
+ (bit-shift-left 1)
+ (make-text-start-0))))))
+
+ (defn decode-frac [input]
+ (if-let [[_ frac-text] (re-find #"^\.(.+)$" input)]
+ (let [output* (-> frac-text
+ (string/replace #",_" "")
+ read-frac-text)
+ rows-to-move-forward (count-bin-start-0 output*)
+ scaling-factor (long (Math/pow 10.0 (double (count-leading-0s input))))]
+ (-> output*
+ (bit-shift-left rows-to-move-forward)
+ (/ scaling-factor)))
+ (assert false (str "Invalid Frac syntax: " input))))
+ )
+
(defn show-ast [ast]
(|case ast
[_ ($BoolS ?value)]
@@ -1053,6 +1107,9 @@
[_ ($IntS ?value)]
(pr-str ?value)
+ [_ ($FracS ?value)]
+ (encode-frac ?value)
+
[_ ($RealS ?value)]
(pr-str ?value)
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 294f2dc63..171a5c05e 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -58,6 +58,9 @@
(&o/$int ?value)
(&&lux/compile-int ?value)
+ (&o/$frac ?value)
+ (&&lux/compile-frac ?value)
+
(&o/$real ?value)
(&&lux/compile-real ?value)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 481145d3e..c59a616d8 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -750,6 +750,8 @@
(.visitInsn Opcodes/POP2) ;; L, L, I
(.visitInsn Opcodes/LSHL) ;; L, L
(.visitInsn Opcodes/LAND) ;; L
+ (.visitLdcInsn (long 0)) ;; L, L
+ (.visitInsn Opcodes/LCMP) ;; I
))
(defn ^:private compile-LuxRT-frac-methods [^ClassWriter =class]
@@ -841,217 +843,211 @@
(.visitInsn Opcodes/LRETURN)
(.visitMaxs 0 0)
(.visitEnd))
- ;; _ (let [$start (new Label)
- ;; $body (new Label)
- ;; $end (new Label)
- ;; $zero (new Label)]
- ;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "count_bin_start_0" "(J)I" nil nil)
- ;; (.visitCode)
- ;; ;; Initialize counter
- ;; (.visitLdcInsn (int 0)) ; I
- ;; (.visitVarInsn Opcodes/ISTORE 2) ;
- ;; ;; Initialize index var
- ;; (.visitLdcInsn (int 0)) ; I
- ;; ;; Begin loop
- ;; (.visitLabel $start) ; I
- ;; ;; Make sure we're still on the valid index range
- ;; (.visitInsn Opcodes/DUP) ; I, I
- ;; (.visitLdcInsn (int 64)) ; I, I, I
- ;; (.visitJumpInsn Opcodes/IF_ICMPLT $body) ; I
- ;; ;; If not, just return what we've got.
- ;; (.visitInsn Opcodes/POP) ;
- ;; (.visitVarInsn Opcodes/ILOAD 2) ; I
- ;; (.visitJumpInsn Opcodes/GOTO $end)
- ;; ;; If so, run the body
- ;; (.visitLabel $body) ;; I
- ;; (.visitInsn Opcodes/DUP) ;; I, I
- ;; (.visitVarInsn Opcodes/LLOAD 0) ;; I, I, L
- ;; (.visitInsn Opcodes/DUP2_X1) ;; I, L, I, L
- ;; (.visitInsn Opcodes/POP2) ;; I, L, I
- ;; bit-set-64? ;; I, L
- ;; (.visitLdcInsn (long 0)) ;; I, L, L
- ;; (.visitLdcInsn Opcodes/LCMP) ;; I, I
- ;; (.visitJumpInsn Opcodes/IFEQ $zero) ;; I
- ;; ;; No more zeroes from now on...
- ;; (.visitInsn Opcodes/POP) ;;
- ;; (.visitVarInsn Opcodes/ILOAD 2) ;; I
- ;; (.visitJumpInsn Opcodes/GOTO $end)
- ;; ;; Found another zero...
- ;; (.visitLabel $zero) ;; I
- ;; ;; Increase counter
- ;; (.visitVarInsn Opcodes/ILOAD 2) ;; I, I
- ;; (.visitLdcInsn (int 1)) ;; I, I, I
- ;; (.visitInsn Opcodes/IADD) ;; I, I
- ;; (.visitVarInsn Opcodes/ISTORE 2) ;; I
- ;; ;; Increase index, then iterate again...
- ;; (.visitLdcInsn (int 1)) ;; I, I
- ;; (.visitInsn Opcodes/IADD) ;; I
- ;; (.visitJumpInsn Opcodes/GOTO $start)
- ;; ;; Finally, return
- ;; (.visitLabel $end) ; I
- ;; (.visitInsn Opcodes/IRETURN)
- ;; (.visitMaxs 0 0)
- ;; (.visitEnd)))
- ;; _ (let [$start (new Label)
- ;; $can-append (new Label)
- ;; $end (new Label)]
- ;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "make_text_start_0" "(J)Ljava/lang/String;" nil nil)
- ;; (.visitCode)
- ;; ;; Initialize accum
- ;; (.visitLdcInsn "")
- ;; (.visitVarInsn Opcodes/ASTORE 2)
- ;; ;; Initialize comparator
- ;; (.visitLdcInsn (long 10))
- ;; ;; Testing/accum loop
- ;; (.visitLabel $start)
- ;; (.visitInsn Opcodes/DUP2)
- ;; (.visitVarInsn Opcodes/LLOAD 0)
- ;; (.visitInsn Opcodes/LCMP)
- ;; (.visitJumpInsn Opcodes/IFLT $can-append)
- ;; ;; No more testing.
- ;; ;; Throw away the comparator and return accum.
- ;; (.visitInsn Opcodes/POP)
- ;; (.visitVarInsn Opcodes/ALOAD 2)
- ;; (.visitJumpInsn Opcodes/GOTO $end)
- ;; ;; Can keep accumulating
- ;; (.visitLabel $can-append)
- ;; ;; Add one more 0 to accum
- ;; (.visitVarInsn Opcodes/ALOAD 2)
- ;; (.visitLdcInsn "0")
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
- ;; (.visitVarInsn Opcodes/ASTORE 2)
- ;; ;; Update comparator and re-iterate
- ;; (.visitLdcInsn (long 10))
- ;; (.visitInsn Opcodes/LMUL)
- ;; (.visitJumpInsn Opcodes/GOTO $start)
- ;; (.visitLabel $end)
- ;; (.visitInsn Opcodes/ARETURN)
- ;; (.visitMaxs 0 0)
- ;; (.visitEnd)))
- ;; _ (let [$is-zero (new Label)
- ;; $end (new Label)]
- ;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_frac" "(J)Ljava/lang/String;" nil nil)
- ;; (.visitCode)
- ;; (.visitVarInsn Opcodes/LLOAD 0)
- ;; (.visitLdcInsn (long 0))
- ;; (.visitInsn Opcodes/LCMP)
- ;; (.visitJumpInsn Opcodes/IFEQ $is-zero)
- ;; ;; IF =/= 0
- ;; ;; Generate leading 0s
- ;; (.visitLdcInsn (long 1))
- ;; (.visitVarInsn Opcodes/LLOAD 0)
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_bin_start_0" "(J)I")
- ;; (.visitInsn Opcodes/LSHL)
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_text_start_0" "(J)Ljava/lang/String;")
- ;; ;; Convert to number text
- ;; (.visitVarInsn Opcodes/LLOAD 0)
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC
- ;; (&host-generics/->bytecode-class-name "java.lang.Long")
- ;; "toUnsignedString" "(J)Ljava/lang/String;")
- ;; ;; Remove unnecessary trailing zeroes
- ;; (.visitLdcInsn "0*$")
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL
- ;; (&host-generics/->bytecode-class-name "java.lang.String")
- ;; "split" "(Ljava/lang/String;)[Ljava/lang/String;")
- ;; (.visitLdcInsn (int 0))
- ;; (.visitInsn Opcodes/AALOAD)
- ;; ;; Join leading 0s with number text
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
- ;; ;; FINISH
- ;; (.visitJumpInsn Opcodes/GOTO $end)
- ;; ;; IF == 0
- ;; (.visitLabel $is-zero)
- ;; (.visitLdcInsn ".0")
- ;; (.visitLabel $end)
- ;; (.visitInsn Opcodes/ARETURN)
- ;; (.visitMaxs 0 0)
- ;; (.visitEnd)))
- ;; _ (let [$end (new Label)
- ;; ;; $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_frac" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil)
- ;; (.visitCode)
- ;; ;; Check prefix
- ;; (.visitVarInsn Opcodes/ALOAD 0)
- ;; (.visitLdcInsn ".")
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "startsWith" "(Ljava/lang/String;)Z")
- ;; (.visitJumpInsn Opcodes/IFEQ $else)
- ;; ;; Remove prefix
- ;; (.visitVarInsn Opcodes/ALOAD 0)
- ;; (.visitLdcInsn (int 1))
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(I)Ljava/lang/String;")
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "clean_separators" "(Ljava/lang/String;)Ljava/lang/String;")
- ;; (.visitInsn Opcodes/DUP)
- ;; (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
- ;; (.visitLabel $from)
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "read_frac_text" "(Ljava/lang/String;)J")
- ;; (.visitLabel $to)
- ;; (.visitInsn Opcodes/DUP2)
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_bin_start_0" "(J)I")
- ;; (.visitInsn Opcodes/LSHL)
- ;; (.visitInsn Opcodes/DUP2_X1)
- ;; (.visitInsn Opcodes/POP2)
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_leading_zeroes" "(Ljava/lang/String;)J")
- ;; (.visitInsn Opcodes/L2D)
- ;; (.visitLdcInsn (double 10.0))
- ;; swap2
- ;; (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Math" "pow" "(DD)D")
- ;; (.visitInsn Opcodes/D2L)
- ;; (.visitInsn Opcodes/LDIV)
- ;; ;; (.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)
- ;; ;; Doesn't start with necessary prefix.
- ;; (.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)))
- ;; _ (let [string-bcn (&host-generics/->bytecode-class-name "java.lang.String")
- ;; $valid (new Label)
- ;; $end (new Label)]
- ;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "count_leading_zeroes" "(Ljava/lang/String;)J" nil nil)
- ;; (.visitCode)
- ;; (.visitVarInsn Opcodes/ALOAD 0) ;; S
- ;; (.visitLdcInsn "^0*") ;; S, S
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL string-bcn "split" "(Ljava/lang/String;)[Ljava/lang/String;") ;; [S
- ;; (.visitInsn Opcodes/DUP) ;; [S, [S
- ;; (.visitInsn Opcodes/ARRAYLENGTH) ;; [S, I
- ;; (.visitLdcInsn (int 2)) ;; [S, I, I
- ;; (.visitJumpInsn Opcodes/IF_ICMPEQ $valid) ;; [S
- ;; ;; Invalid...
- ;; (.visitInsn Opcodes/POP) ;;
- ;; (.visitLdcInsn (long 0)) ;; J
- ;; (.visitJumpInsn Opcodes/GOTO $end)
- ;; (.visitLabel $valid) ;; [S
- ;; ;; Valid...
- ;; (.visitLdcInsn (int 1)) ;; [S, I
- ;; (.visitInsn Opcodes/AALOAD) ;; S
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL string-bcn "length" "(Ljava/lang/String;)I") ;; I
- ;; (.visitVarInsn Opcodes/ALOAD 0) ;; I, S
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL string-bcn "length" "(Ljava/lang/String;)I") ;; I, I
- ;; (.visitInsn Opcodes/SWAP) ;; I, I
- ;; (.visitInsn Opcodes/ISUB) ;; I
- ;; (.visitInsn Opcodes/I2L) ;; J
- ;; (.visitLabel $end) ;; J
- ;; (.visitInsn Opcodes/LRETURN)
- ;; (.visitMaxs 0 0)
- ;; (.visitEnd)))
+ _ (let [$start (new Label)
+ $body (new Label)
+ $end (new Label)
+ $zero (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "count_bin_start_0" "(J)I" nil nil)
+ (.visitCode)
+ ;; Initialize counter
+ (.visitLdcInsn (int 0)) ; I
+ (.visitVarInsn Opcodes/ISTORE 2) ;
+ ;; Initialize index var
+ (.visitLdcInsn (int 63)) ; I
+ ;; Begin loop
+ (.visitLabel $start) ; I
+ ;; Make sure we're still on the valid index range
+ (.visitInsn Opcodes/DUP) ; I, I
+ (.visitLdcInsn (int -1)) ; I, I, I
+ (.visitJumpInsn Opcodes/IF_ICMPGT $body) ; I
+ ;; If not, just return what we've got.
+ (.visitInsn Opcodes/POP) ;
+ (.visitVarInsn Opcodes/ILOAD 2) ; I
+ (.visitJumpInsn Opcodes/GOTO $end)
+ ;; If so, run the body
+ (.visitLabel $body) ;; I
+ (.visitInsn Opcodes/DUP) ;; I, I
+ (.visitVarInsn Opcodes/LLOAD 0) ;; I, I, L
+ (.visitInsn Opcodes/DUP2_X1) ;; I, L, I, L
+ (.visitInsn Opcodes/POP2) ;; I, L, I
+ bit-set-64? ;; I, I
+ (.visitJumpInsn Opcodes/IFEQ $zero) ;; I
+ ;; No more zeroes from now on...
+ (.visitInsn Opcodes/POP) ;;
+ (.visitVarInsn Opcodes/ILOAD 2) ;; I
+ (.visitJumpInsn Opcodes/GOTO $end)
+ ;; Found another zero...
+ (.visitLabel $zero) ;; I
+ ;; Increase counter
+ (.visitVarInsn Opcodes/ILOAD 2) ;; I, I
+ (.visitLdcInsn (int 1)) ;; I, I, I
+ (.visitInsn Opcodes/IADD) ;; I, I
+ (.visitVarInsn Opcodes/ISTORE 2) ;; I
+ ;; Increase index, then iterate again...
+ (.visitLdcInsn (int 1)) ;; I, I
+ (.visitInsn Opcodes/ISUB) ;; I
+ (.visitJumpInsn Opcodes/GOTO $start)
+ ;; Finally, return
+ (.visitLabel $end) ; I
+ (.visitInsn Opcodes/IRETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ _ (let [$start (new Label)
+ $can-append (new Label)
+ $end (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "make_text_start_0" "(J)Ljava/lang/String;" nil nil)
+ (.visitCode)
+ ;; Initialize accum
+ (.visitLdcInsn "") ;; S
+ (.visitVarInsn Opcodes/ASTORE 2) ;;
+ ;; Initialize comparator
+ (.visitLdcInsn (long 10)) ;; L
+ ;; Testing/accum loop
+ (.visitLabel $start) ;; L
+ (.visitInsn Opcodes/DUP2) ;; L, L
+ (.visitVarInsn Opcodes/LLOAD 0) ;; L, L, L
+ (.visitInsn Opcodes/LCMP) ;; L, I
+ (.visitJumpInsn Opcodes/IFLT $can-append) ;; L
+ ;; No more testing.
+ ;; Throw away the comparator and return accum.
+ (.visitInsn Opcodes/POP2) ;;
+ (.visitVarInsn Opcodes/ALOAD 2) ;; S
+ (.visitJumpInsn Opcodes/GOTO $end)
+ ;; Can keep accumulating
+ (.visitLabel $can-append) ;; L
+ ;; Add one more 0 to accum
+ (.visitVarInsn Opcodes/ALOAD 2) ;; L, S
+ (.visitLdcInsn "0") ;; L, S, S
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;") ;; L, S
+ (.visitVarInsn Opcodes/ASTORE 2) ;; L
+ ;; Update comparator and re-iterate
+ (.visitLdcInsn (long 10)) ;; L, L
+ (.visitInsn Opcodes/LMUL) ;; L
+ (.visitJumpInsn Opcodes/GOTO $start)
+ (.visitLabel $end) ;; S
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ _ (let [$is-zero (new Label)
+ $end (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_frac" "(J)Ljava/lang/String;" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFEQ $is-zero)
+ ;; IF =/= 0
+ ;; Generate leading 0s
+ (.visitLdcInsn (long 1))
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_bin_start_0" "(J)I")
+ (.visitInsn Opcodes/LSHL)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_text_start_0" "(J)Ljava/lang/String;")
+ ;; Convert to number text
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toUnsignedString" "(J)Ljava/lang/String;")
+ ;; Remove unnecessary trailing zeroes
+ (.visitLdcInsn "0*$")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "split" "(Ljava/lang/String;)[Ljava/lang/String;")
+ (.visitLdcInsn (int 0))
+ (.visitInsn Opcodes/AALOAD)
+ ;; Join leading 0s with number text
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
+ ;; FINISH
+ (.visitJumpInsn Opcodes/GOTO $end)
+ ;; IF == 0
+ (.visitLabel $is-zero)
+ (.visitLdcInsn ".0")
+ (.visitLabel $end)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ _ (let [$end (new Label)
+ ;; $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_frac" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ ;; Check prefix
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn ".")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "startsWith" "(Ljava/lang/String;)Z")
+ (.visitJumpInsn Opcodes/IFEQ $else)
+ ;; Remove prefix
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 1))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(I)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "clean_separators" "(Ljava/lang/String;)Ljava/lang/String;")
+ (.visitInsn Opcodes/DUP)
+ (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
+ (.visitLabel $from)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "read_frac_text" "(Ljava/lang/String;)J")
+ (.visitLabel $to)
+ (.visitInsn Opcodes/DUP2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_bin_start_0" "(J)I")
+ (.visitInsn Opcodes/LSHL)
+ (.visitInsn Opcodes/DUP2_X1)
+ (.visitInsn Opcodes/POP2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_leading_zeroes" "(Ljava/lang/String;)J")
+ (.visitInsn Opcodes/L2D)
+ (.visitLdcInsn (double 10.0))
+ swap2
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Math" "pow" "(DD)D")
+ (.visitInsn Opcodes/D2L)
+ (.visitInsn Opcodes/LDIV)
+ ;; (.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)
+ ;; Doesn't start with necessary prefix.
+ (.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)))
+ _ (let [string-bcn (&host-generics/->bytecode-class-name "java.lang.String")
+ $valid (new Label)
+ $end (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "count_leading_zeroes" "(Ljava/lang/String;)J" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0) ;; S
+ (.visitLdcInsn "^0*") ;; S, S
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL string-bcn "split" "(Ljava/lang/String;)[Ljava/lang/String;") ;; [S
+ (.visitInsn Opcodes/DUP) ;; [S, [S
+ (.visitInsn Opcodes/ARRAYLENGTH) ;; [S, I
+ (.visitLdcInsn (int 2)) ;; [S, I, I
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $valid) ;; [S
+ ;; Invalid...
+ (.visitInsn Opcodes/POP) ;;
+ (.visitLdcInsn (long 0)) ;; J
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $valid) ;; [S
+ ;; Valid...
+ (.visitLdcInsn (int 1)) ;; [S, I
+ (.visitInsn Opcodes/AALOAD) ;; S
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL string-bcn "length" "()I") ;; I
+ (.visitVarInsn Opcodes/ALOAD 0) ;; I, S
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL string-bcn "length" "()I") ;; I, I
+ (.visitInsn Opcodes/SWAP) ;; I, I
+ (.visitInsn Opcodes/ISUB) ;; I
+ (.visitInsn Opcodes/I2L) ;; J
+ (.visitLabel $end) ;; J
+ (.visitInsn Opcodes/LRETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
_ (let [$only-zeroes (new Label)
$end (new Label)]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "read_frac_text" "(Ljava/lang/String;)J" nil nil)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index ba031eda7..360adb521 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -47,6 +47,7 @@
compile-nat "java/lang/Long" "(J)V" long
compile-int "java/lang/Long" "(J)V" long
+ compile-frac "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 f51165ea3..c7dbdb557 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -32,6 +32,7 @@
^:private bool$ &a/$bool "(-> Bool Analysis)"
^:private nat$ &a/$nat "(-> Nat Analysis)"
^:private int$ &a/$int "(-> Int Analysis)"
+ ^:private frac$ &a/$frac "(-> Nat Analysis)"
^:private real$ &a/$real "(-> Real Analysis)"
^:private char$ &a/$char "(-> Char Analysis)"
^:private text$ &a/$text "(-> Text Analysis)"
@@ -116,6 +117,9 @@
(&/$IntM value)
(variant$ #'&/$IntM (int$ value))
+ (&/$FracM value)
+ (variant$ #'&/$FracM (frac$ value))
+
(&/$RealM value)
(variant$ #'&/$RealM (real$ value))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index f52823bfc..f519aa563 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -17,6 +17,7 @@
("Bool" 1)
("Nat" 1)
("Int" 1)
+ ("Frac" 1)
("Real" 1)
("Char" 1)
("Text" 1)
@@ -167,6 +168,7 @@
lex-nat $Nat #"^\+(0|[1-9][0-9,_]*)"
lex-int $Int #"^-?(0|[1-9][0-9,_]*)"
+ lex-frac $Frac #"^(\.[0-9,_]+)"
lex-real $Real #"^-?(0\.[0-9,_]+|[1-9][0-9,_]*\.[0-9,_]+)(e-?[1-9][0-9,_]*)?"
)
@@ -241,8 +243,9 @@
(&/|list lex-white-space
lex-comment
lex-bool
- lex-real
lex-nat
+ lex-real
+ lex-frac
lex-int
lex-char
lex-text
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 56a73060c..83b44931d 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -13,6 +13,7 @@
("bool" 1)
("nat" 1)
("int" 1)
+ ("frac" 1)
("real" 1)
("char" 1)
("text" 1)
@@ -72,6 +73,8 @@
("NatPM" 1)
;; Compare the CDN with an integer value.
("IntPM" 1)
+ ;; Compare the CDN with a fractional value.
+ ("FracPM" 1)
;; Compare the CDN with a real value.
("RealPM" 1)
;; Compare the CDN with a character value.
@@ -123,6 +126,10 @@
(&/|list ($IntPM _value)
$PopPM)
+ (&a-case/$FracTestAC _value)
+ (&/|list ($FracPM _value)
+ $PopPM)
+
(&a-case/$RealTestAC _value)
(&/|list ($RealPM _value)
$PopPM)
@@ -227,6 +234,11 @@
($IntPM _pre-value)
($AltPM pre post))
+ [($FracPM _pre-value) ($FracPM _post-value)]
+ (if (= _pre-value _post-value)
+ ($FracPM _pre-value)
+ ($AltPM pre post))
+
[($RealPM _pre-value) ($RealPM _post-value)]
(if (= _pre-value _post-value)
($RealPM _pre-value)
@@ -533,6 +545,9 @@
(&a/$int value)
(&/T [meta ($int value)])
+
+ (&a/$frac value)
+ (&/T [meta ($frac value)])
(&a/$real value)
(&/T [meta ($real value)])
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index d5b4a54cd..ceafcd92e 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -82,6 +82,9 @@
(&lexer/$Int ?value)
(return (&/|list (&/T [meta (&/$IntS (Long/parseLong ?value))])))
+ (&lexer/$Frac ?value)
+ (return (&/|list (&/T [meta (&/$FracS (&/decode-frac ?value))])))
+
(&lexer/$Real ?value)
(return (&/|list (&/T [meta (&/$RealS (Double/parseDouble ?value))])))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index c56dfa75c..64b189949 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -128,22 +128,25 @@
;; IntM
Int
(&/$SumT
- ;; RealM
- Real
+ ;; FracM
+ Frac
(&/$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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 13:19:51 +0000