aboutsummaryrefslogtreecommitdiff
path: root/luxc/src
diff options
context:
space:
mode:
Diffstat (limited to 'luxc/src')
-rw-r--r--luxc/src/lux/analyser.clj4
-rw-r--r--luxc/src/lux/analyser/lux.clj2
-rw-r--r--luxc/src/lux/base.clj164
3 files changed, 118 insertions, 52 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 4133927e7..eefa5ee3d 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -79,6 +79,10 @@
(|do [_ (&type/check exo-type &type/Int)]
(return (&/|list (&&/|meta exo-type cursor (&&/$int ?value)))))
+ (&/$FracS ?value)
+ (|do [_ (&type/check exo-type &type/Frac)]
+ (return (&/|list (&&/|meta exo-type cursor (&&/$frac ?value)))))
+
(&/$RealS ?value)
(|do [_ (&type/check exo-type &type/Real)]
(return (&/|list (&&/|meta exo-type cursor (&&/$real ?value)))))
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index 1d46c2b60..fd1944b01 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -362,7 +362,7 @@
=arg (&/with-attempt
(&&/analyse-1 analyse ?input-t ?arg)
(fn [err]
- (&/fail-with-loc (str err "\n" "[Analyser Error] Function expected: " (&type/show-type ?input-t)))))]
+ (&/fail-with-loc (str err "\n" "[Analyser Error] Argument expected: " (&type/show-type ?input-t)))))]
(return (&/T [=output-t (&/$Cons =arg =args)])))
_
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index 5697415f8..1cb069021 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -924,7 +924,7 @@
(fn [state]
(let [body* (with-scope closure-name body)]
(run-state body* (update$ $scopes #($Cons (update$ $inner-closures inc (|head %))
- (|tail %))
+ (|tail %))
state))))))
(defn without-repl-closure [body]
@@ -1040,57 +1040,119 @@
(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 ^String (aget parts 0))
- 0)))]
+(def frac-bits 64)
+
+(let [clean-separators (fn [^String input]
+ (.replaceAll input "_" ""))
+ frac-text-to-digits (fn [^String input]
+ (loop [output (vec (repeat frac-bits 0))
+ index (dec (.length input))]
+ (if (>= index 0)
+ (let [digit (Byte/parseByte (.substring input index (inc index)))]
+ (recur (assoc output index digit)
+ (dec index)))
+ output)))
+ times5 (fn [index digits]
+ (loop [index index
+ carry 0
+ digits digits]
+ (if (>= index 0)
+ (let [raw (->> (get digits index) (* 5) (+ carry))]
+ (recur (dec index)
+ (int (/ raw 10))
+ (assoc digits index (rem raw 10))))
+ digits)))
+ frac-digit-power (fn [level]
+ (loop [output (-> (vec (repeat frac-bits 0))
+ (assoc level 1))
+ times level]
+ (if (>= times 0)
+ (recur (times5 level output)
+ (dec times))
+ output)))
+ frac-digits-lt (fn frac-digits-lt
+ ([subject param index]
+ (and (< index frac-bits)
+ (or (< (get subject index)
+ (get param index))
+ (and (= (get subject index)
+ (get param index))
+ (frac-digits-lt subject param (inc index))))))
+ ([subject param]
+ (frac-digits-lt subject param 0)))
+ frac-digits-sub-once (fn [subject param-digit index]
+ (if (>= (get subject index)
+ param-digit)
+ (update-in subject [index] #(- % param-digit))
+ (recur (update-in subject [index] #(- 10 (- param-digit %)))
+ 1
+ (dec index))))
+ frac-digits-sub (fn [subject param]
+ (loop [target subject
+ index (dec frac-bits)]
+ (if (>= index 0)
+ (recur (frac-digits-sub-once target (get param index) index)
+ (dec index))
+ target)))
+ frac-digits-to-text (fn [digits]
+ (loop [output ""
+ index (dec frac-bits)]
+ (if (>= index 0)
+ (recur (-> (get digits index)
+ (Character/forDigit 10)
+ (str output))
+ (dec index))
+ output)))
+ add-frac-digit-powers (fn [dl dr]
+ (loop [index (dec frac-bits)
+ output (vec (repeat frac-bits 0))
+ carry 0]
+ (if (>= index 0)
+ (let [raw (+ carry
+ (get dl index)
+ (get dr index))]
+ (recur (dec index)
+ (assoc output index (rem raw 10))
+ (int (/ raw 10))))
+ output)))
+ ]
+ ;; Based on the LuxRT.encode_frac method
(defn encode-frac [input]
- (if (= 0 input)
- ".0"
- (let [^String prefix (->> (count-bin-start-0 input)
- (bit-shift-left 1)
- (make-text-start-0))]
- (->> input
- (Long/toUnsignedString)
- remove-trailing-0s
- (.concat prefix)))))
-
- (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))))
+ (loop [index (dec frac-bits)
+ output (vec (repeat frac-bits 0))]
+ (if (>= index 0)
+ (recur (dec index)
+ (if (bit-test input index)
+ (->> (- (dec frac-bits) index)
+ frac-digit-power
+ (add-frac-digit-powers output))
+ output))
+ (-> output frac-digits-to-text
+ (->> (str "."))
+ (.split "0*$")
+ (aget 0)))))
+
+ ;; Based on the LuxRT.decode_frac method
+ (defn decode-frac [^String input]
+ (if (and (.startsWith input ".")
+ (< (.length input) (inc frac-bits)))
+ (loop [digits-left (-> input
+ (.substring 1)
+ clean-separators
+ frac-text-to-digits)
+ index 0
+ ouput 0]
+ (if (< index frac-bits)
+ (let [power-slice (frac-digit-power index)]
+ (if (not (frac-digits-lt digits-left power-slice))
+ (recur (frac-digits-sub digits-left power-slice)
+ (inc index)
+ (bit-set ouput (- (dec frac-bits) index)))
+ (recur digits-left
+ (inc index)
+ ouput)))
+ ouput))
+ (throw (str "Bad format for Frac number: " input))))
)
(defn show-ast [ast]