- Finished compiler's support for Frac numbers.

4 files changed, 122 insertions, 56 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]
diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux
index d5d60a9ce..832c8fbdd 100644
--- a/stdlib/test/test/lux/data/number.lux
+++ b/stdlib/test/test/lux/data/number.lux
@@ -104,10 +104,10 @@
   ["Real/Mul" R;real Number<Real> Mul@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
   ["Real/Min" R;real Number<Real> Min@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
   ["Real/Max" R;real Number<Real> Max@Monoid<Real> (r.% 1000.0) (r.> 0.0)]
-  ## ["Frac/Add" R;frac Number<Frac> Add@Monoid<Frac> (f.% .125)]
-  ## ["Frac/Mul" R;frac Number<Frac> Mul@Monoid<Frac> (f.% .125)]
-  ## ["Frac/Min" R;frac Number<Frac> Min@Monoid<Frac> (f.% .125)]
-  ## ["Frac/Max" R;frac Number<Frac> Max@Monoid<Frac> (f.% .125)]
+  ["Frac/Add" R;frac Number<Frac> Add@Monoid<Frac> (f.% .125)   (lambda [_] true)]
+  ## ["Frac/Mul" R;frac Number<Frac> Mul@Monoid<Frac> (f.% .125)   (lambda [_] true)]
+  ["Frac/Min" R;frac Number<Frac> Min@Monoid<Frac> (f.% .125)   (lambda [_] true)]
+  ["Frac/Max" R;frac Number<Frac> Max@Monoid<Frac> (f.% .125)   (lambda [_] true)]
   )
 
 (do-template [<category> <rand-gen> <Number> <Codec>]