- Implemented Deg functionality in pure Lux.

6 files changed, 202 insertions, 137 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 6e6397eeb..6270d0b47 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2295,6 +2295,48 @@
            _
            (fail "Wrong syntax for do-template")}))
 
+(def:''' #export (d/= test subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) equality.")])
+         (-> Deg Deg Bool)
+         ("lux int ="
+          ("lux coerce" Int subject)
+          ("lux coerce" Int test)))
+
+(def:''' #export (d/< test subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) less-than.")])
+         (-> Deg Deg Bool)
+         (n/< ("lux coerce" Nat test)
+              ("lux coerce" Nat subject)))
+
+(def:''' #export (d/<= test subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) less-than-equal.")])
+         (-> Deg Deg Bool)
+         (if (n/< ("lux coerce" Nat test)
+                  ("lux coerce" Nat subject))
+           true
+           ("lux int ="
+            ("lux coerce" Int subject)
+            ("lux coerce" Int test))))
+
+(def:''' #export (d/> test subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) greater-than.")])
+         (-> Deg Deg Bool)
+         (d/< subject test))
+
+(def:''' #export (d/>= test subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) greater-than-equal.")])
+         (-> Deg Deg Bool)
+         (if (d/< subject test)
+           true
+           ("lux int ="
+            ("lux coerce" Int subject)
+            ("lux coerce" Int test))))
+
 (do-template [<type>
               <eq-proc> <lt-proc> <eq-name> <lt-name> <lte-name> <gt-name> <gte-name>
               <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>]
@@ -2335,9 +2377,6 @@
   [ Int "lux int =" "lux int <"   i/= i/< i/<= i/> i/>=
    "Int(eger) equality." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."]
   
-  [ Deg "lux deg =" "lux deg <"   d/= d/< d/<= d/> d/>=
-   "Deg(ree) equality." "Deg(ree) less-than." "Deg(ree) less-than-equal." "Deg(ree) greater-than." "Deg(ree) greater-than-equal."]
-
   [Frac "lux frac =" "lux frac <" f/= f/< f/<= f/> f/>=
    "Frac(tion) equality." "Frac(tion) less-than." "Frac(tion) less-than-equal." "Frac(tion) greater-than." "Frac(tion) greater-than-equal."]
   )
@@ -2389,6 +2428,88 @@
             (list [(tag$ ["lux" "doc"])
                    (text$ <doc>)])
             (-> <type> <type> <type>)
+            ("lux coerce" Deg
+             (<op> ("lux coerce" Int subject)
+                   ("lux coerce" Int param))))]
+
+  [ Deg d/+ "lux int +" "Deg(ree) addition."]
+  [ Deg d/- "lux int -" "Deg(ree) substraction."]
+  )
+
+(def:''' #export (d/* param subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) multiplication.")])
+         (-> Deg Deg Deg)
+         (let' [subjectH (high-bits ("lux coerce" Nat subject))
+                subjectL (low-bits ("lux coerce" Nat subject))
+                paramH (high-bits ("lux coerce" Nat param))
+                paramL (low-bits ("lux coerce" Nat param))
+                bottom ("lux coerce" Int
+                        ("lux bit logical-right-shift"
+                         ("lux coerce" Nat ("lux int *" subjectL paramL))
+                         +32))
+                middle ("lux int +"
+                        ("lux int *" subjectH paramL)
+                        ("lux int *" subjectL paramH))
+                top ("lux int *" subjectH paramH)]
+               ("lux coerce" Deg
+                ("lux int +"
+                 (high-bits
+                  ("lux coerce" Nat
+                   ("lux int +"
+                    bottom
+                    middle)))
+                 top))))
+
+(def:''' least-significant-bit-mask (list) Nat +1)
+
+(def:''' #export (d// param subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) division.")])
+         (-> Deg Deg Deg)
+         (if (|> param ("lux coerce" Int) ("lux int =" 0))
+           ("lux io error" "Cannot divide Deg by zero!")
+           (let' [[trailing-zeroes remaining] (("lux check" (-> Nat Nat (#Product Nat Nat))
+                                                (function' recur [count remaining]
+                                                           (if (|> remaining
+                                                                   ("lux bit and" least-significant-bit-mask)
+                                                                   ("lux coerce" Int)
+                                                                   ("lux int =" 0))
+                                                             (recur (|> count
+                                                                        ("lux coerce" Int)
+                                                                        ("lux int +" 1)
+                                                                        ("lux coerce" Nat))
+                                                                    ("lux bit logical-right-shift" remaining +1))
+                                                             [count remaining])))
+                                               +0 ("lux coerce" Nat param))
+                  [trailing-zeroes denominator] (if (|> trailing-zeroes ("lux coerce" Int) ("lux int =" 0))
+                                                  [+1 ("lux bit logical-right-shift" remaining +1)]
+                                                  [trailing-zeroes remaining])
+                  shift ("lux coerce" Nat
+                         ("lux int -"
+                          64
+                          ("lux coerce" Int trailing-zeroes)))
+                  numerator ("lux bit left-shift" +1 shift)]
+                 ("lux coerce" Deg
+                  ("lux int /"
+                   ("lux int *"
+                    ("lux coerce" Int subject)
+                    ("lux coerce" Int numerator))
+                   ("lux coerce" Int denominator))))))
+
+(def:''' #export (d/% param subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) remainder.")])
+         (-> Deg Deg Deg)
+         ("lux coerce" Deg
+          (n/% ("lux coerce" Nat subject)
+               ("lux coerce" Nat param))))
+
+(do-template [<type> <name> <op> <doc>]
+  [(def:''' #export (<name> param subject)
+            (list [(tag$ ["lux" "doc"])
+                   (text$ <doc>)])
+            (-> <type> <type> <type>)
             (<op> subject param))]
 
   [ Int i/+ "lux int +" "Int(eger) addition."]
@@ -2397,12 +2518,6 @@
   [ Int i// "lux int /" "Int(eger) division."]
   [ Int i/% "lux int %" "Int(eger) remainder."]
 
-  [ Deg d/+ "lux deg +" "Deg(ree) addition."]
-  [ Deg d/- "lux deg -" "Deg(ree) substraction."]
-  [ Deg d/* "lux deg *" "Deg(ree) multiplication."]
-  [ Deg d// "lux deg /" "Deg(ree) division."]
-  [ Deg d/% "lux deg %" "Deg(ree) remainder."]
-  
   [Frac f/+ "lux frac +" "Frac(tion) addition."]
   [Frac f/- "lux frac -" "Frac(tion) substraction."]
   [Frac f/* "lux frac *" "Frac(tion) multiplication."]
@@ -2410,16 +2525,14 @@
   [Frac f/% "lux frac %" "Frac(tion) remainder."]
   )
 
-(do-template [<type> <name> <op> <doc>]
-  [(def:''' #export (<name> param subject)
-            (list [(tag$ ["lux" "doc"])
-                   (text$ <doc>)])
-            (-> Nat <type> <type>)
-            (<op> subject param))]
-
-  [ Deg d/scale      "lux deg scale"      "Deg(ree) scale."]
-  [ Deg d/reciprocal "lux deg reciprocal" "Deg(ree) reciprocal."]
-  )
+(def:''' #export (d/scale param subject)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) scale.")])
+         (-> Nat Deg Deg)
+         ("lux coerce" Deg
+          ("lux int *"
+           ("lux coerce" Int subject)
+           ("lux coerce" Int param))))
 
 (do-template [<name> <type> <test> <doc>]
   [(def:''' #export (<name> left right)
@@ -5212,15 +5325,6 @@
   [nat-to-int Nat Int]
   )
 
-(do-template [<name> <op> <from> <to>]
-  [(def: #export (<name> input)
-     (-> <from> <to>)
-     (<op> input))]
-
-  [frac-to-deg "lux frac to-deg" Frac Deg]
-  [deg-to-frac "lux deg to-frac" Deg Frac]
-  )
-
 (def: #export frac-to-nat (|>> frac-to-int int-to-nat))
 (def: #export nat-to-frac (|>> nat-to-int int-to-frac))
 
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index bd1d34cad..eb712d046 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -80,10 +80,10 @@
   (def: * d/*)
   (def: / d//)
   (def: % d/%)
-  (def: (negate x) (d/- x ("lux deg max")))
+  (def: (negate x) (d/- x (:! Deg -1)))
   (def: abs id)
   (def: (signum x)
-    ("lux deg max")))
+    (:! Deg -1)))
 
 (do-template [<type> <order> <succ> <pred>]
   [(struct: #export _ (Enum <type>)
@@ -94,7 +94,7 @@
   [Nat Order<Nat> n/inc n/dec]
   [Int Order<Int> i/inc i/dec]
   [Frac Order<Frac> (f/+ ("lux frac smallest")) (f/- ("lux frac smallest"))]
-  [Deg Order<Deg> (d/+ ("lux deg min")) (d/- ("lux deg min"))]
+  [Deg Order<Deg> (d/+ (:! Deg +1)) (d/- (:! Deg +1))]
   )
 
 (do-template [<type> <enum> <top> <bottom>]
@@ -103,10 +103,10 @@
      (def: top <top>)
      (def: bottom <bottom>))]
 
-  [ Nat Enum<Nat>  ("lux coerce" Nat -1) +0]
+  [ Nat Enum<Nat>  (:! Nat -1) +0]
   [ Int Enum<Int>  ("lux int max") ("lux int min")]
   [Frac Enum<Frac> ("lux frac max") ("lux frac min")]
-  [ Deg Enum<Deg>  ("lux deg max") ("lux deg min")]
+  [ Deg Enum<Deg>  (:! Deg -1) (:! Deg +0)]
   )
 
 (do-template [<name> <type> <identity> <compose>]
diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux
index 7933027c9..7c5ee4150 100644
--- a/stdlib/source/lux/math/logic/fuzzy.lux
+++ b/stdlib/source/lux/math/logic/fuzzy.lux
@@ -48,81 +48,57 @@
   (All [a] (-> (Set a) (Fuzzy a)))
   (from-predicate (set.member? set)))
 
-(do-template [<ascending> <descending> <gradient> <type> <lt> <gt> <lte> <gte> <sub> <div> <post>]
-  [(def: (<ascending> from to)
-     (-> <type> <type> (Fuzzy <type>))
-     (function (_ elem)
-       (cond (<lte> from elem)
-             &.~false
-
-             (<gte> to elem)
-             &.~true
-
-             ## in the middle...
-             (<post> (<div> (<sub> from to)
-                            (<sub> from elem))))))
-
-   (def: (<descending> from to)
-     (-> <type> <type> (Fuzzy <type>))
-     (function (_ elem)
-       (cond (<lte> from elem)
-             &.~true
-
-             (<gte> to elem)
-             &.~false
-
-             ## in the middle...
-             (<post> (<div> (<sub> from to)
-                            (<sub> elem to))))))
-
-   (def: #export (<gradient> from to)
-     (-> <type> <type> (Fuzzy <type>))
-     (if (<lt> to from)
-       (<ascending> from to)
-       (<descending> from to)))]
-
-  [d/ascending d/descending d/gradient Deg  d/< d/> d/<= d/>= d/- d// id]
-  [f/ascending f/descending f/gradient Frac f/< f/> f/<= f/>= f/- f// frac-to-deg]
-  )
-
-(do-template [<triangle> <trapezoid> <type> <ascending> <descending> <lt>]
-  [(def: #export (<triangle> bottom middle top)
-     (-> <type> <type> <type> (Fuzzy <type>))
-     (case (list.sort <lt> (list bottom middle top))
-       (^ (list bottom middle top))
-       (intersection (<ascending> bottom middle)
-                     (<descending> middle top))
-
-       _
-       (undefined)))
-
-   (def: #export (<trapezoid> bottom middle-bottom middle-top top)
-     (-> <type> <type> <type> <type> (Fuzzy <type>))
-     (case (list.sort <lt> (list bottom middle-bottom middle-top top))
-       (^ (list bottom middle-bottom middle-top top))
-       (intersection (<ascending> bottom middle-bottom)
-                     (<descending> middle-top top))
-
-       _
-       (undefined)))]
-
-  [d/triangle d/trapezoid Deg  d/ascending d/descending d/<]
-  [f/triangle f/trapezoid Frac f/ascending f/descending f/<]
-  )
-
-(def: #export (gaussian deviation center)
-  (-> Frac Frac (Fuzzy Frac))
+(def: (ascending from to)
+  (-> Deg Deg (Fuzzy Deg))
   (function (_ elem)
-    (let [scale (|> deviation (math.pow 2.0) (f/* 2.0))
-          membership (|> elem
-                         (f/- center)
-                         (math.pow 2.0)
-                         (f/* -1.0)
-                         (f// scale)
-                         math.exp)]
-      (if (f/= 1.0 membership)
-        &.~true
-        (frac-to-deg membership)))))
+    (cond (d/<= from elem)
+          &.~false
+
+          (d/>= to elem)
+          &.~true
+
+          ## in the middle...
+          (d// (d/- from to)
+               (d/- from elem)))))
+
+(def: (descending from to)
+  (-> Deg Deg (Fuzzy Deg))
+  (function (_ elem)
+    (cond (d/<= from elem)
+          &.~true
+
+          (d/>= to elem)
+          &.~false
+
+          ## in the middle...
+          (d// (d/- from to)
+               (d/- elem to)))))
+
+(def: #export (gradient from to)
+  (-> Deg Deg (Fuzzy Deg))
+  (if (d/< to from)
+    (ascending from to)
+    (descending from to)))
+
+(def: #export (triangle bottom middle top)
+  (-> Deg Deg Deg (Fuzzy Deg))
+  (case (list.sort d/< (list bottom middle top))
+    (^ (list bottom middle top))
+    (intersection (ascending bottom middle)
+                  (descending middle top))
+
+    _
+    (undefined)))
+
+(def: #export (trapezoid bottom middle-bottom middle-top top)
+  (-> Deg Deg Deg Deg (Fuzzy Deg))
+  (case (list.sort d/< (list bottom middle-bottom middle-top top))
+    (^ (list bottom middle-bottom middle-top top))
+    (intersection (ascending bottom middle-bottom)
+                  (descending middle-top top))
+
+    _
+    (undefined)))
 
 (def: #export (cut treshold set)
   (All [a] (-> Deg (Fuzzy a) (Fuzzy a)))
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 39d7d880d..695323c98 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -74,11 +74,7 @@
 
 (def: #export int
   (Random Int)
-  (function (_ prng)
-    (let [[prng left] (prng [])
-          [prng right] (prng [])]
-      [prng (nat-to-int (n/+ (bit.left-shift +32 left)
-                             right))])))
+  (:: Monad<Random> map nat-to-int nat))
 
 (def: #export bool
   (Random Bool)
@@ -105,7 +101,7 @@
 
 (def: #export deg
   (Random Deg)
-  (:: Monad<Random> map frac-to-deg frac))
+  (:: Monad<Random> map (|>> (:! Deg)) nat))
 
 (def: #export (text' char-gen size)
   (-> (Random Nat) Nat (Random Text))
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux
index b8861eab6..a089f7cee 100644
--- a/stdlib/test/test/lux.lux
+++ b/stdlib/test/test/lux.lux
@@ -135,10 +135,10 @@
                          (|> x' (/ y) (* y) (= x'))))
                  ))))]
 
-  ["Nat"  r.nat  n/= n/+ n/- n/* n// n/% n/> +0  +1              +1000000         %n (n/% +1000) id]
-  ["Int"  r.int  i/= i/+ i/- i/* i// i/% i/>  0   1               1000000         %i (i/%  1000) id]
-  ["Frac" r.frac f/= f/+ f/- f/* f// f/% f/>  0.0 1.0             1000000.0       %r id          math.floor]
-  ["Deg"  r.deg  d/= d/+ d/- d/* d// d/% d/>   .0 ("lux deg max") ("lux deg max") %f id          id]
+  ["Nat"  r.nat  n/= n/+ n/- n/* n// n/% n/> +0  +1          +1000000     %n (n/% +1000) id]
+  ["Int"  r.int  i/= i/+ i/- i/* i// i/% i/>  0   1           1000000     %i (i/%  1000) id]
+  ["Frac" r.frac f/= f/+ f/- f/* f// f/% f/>  0.0 1.0         1000000.0   %r id          math.floor]
+  ["Deg"  r.deg  d/= d/+ d/- d/* d// d/% d/>   .0 (:! Deg -1) (:! Deg -1) %f id          id]
   )
 
 (do-template [category rand-gen -> <- = <cap> %a %z]
diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux
index 068e00523..6530fcb4a 100644
--- a/stdlib/test/test/lux/math/logic/fuzzy.lux
+++ b/stdlib/test/test/lux/math/logic/fuzzy.lux
@@ -50,8 +50,7 @@
                               (<gte> top sample))))
                ))))]
 
-  ["Frac" number.Hash<Frac> r.frac &.f/triangle f/< f/<= f/> f/>=]
-  ["Deg"  number.Hash<Deg>  r.deg  &.d/triangle d/< d/<= d/> d/>=]
+  ["Deg"  number.Hash<Deg>  r.deg  &.triangle d/< d/<= d/> d/>=]
   )
 
 (do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>]
@@ -98,33 +97,23 @@
                               (<gte> top sample))))
                ))))]
 
-  ["Frac" number.Hash<Frac> r.frac &.f/trapezoid f/< f/<= f/> f/>=]
-  ["Deg"  number.Hash<Deg>  r.deg  &.d/trapezoid d/< d/<= d/> d/>=]
+  ["Deg"  number.Hash<Deg>  r.deg  &.trapezoid d/< d/<= d/> d/>=]
   )
 
-(context: "Gaussian"
-  (<| (times +100)
-      (do @
-        [deviation (|> r.frac (r.filter (f/> 0.0)))
-         center r.frac
-         #let [gaussian (&.gaussian deviation center)]]
-        (test "The center value will always have maximum membership."
-              (d/= ~true (&.membership center gaussian))))))
-
 (def: gen-triangle
-  (r.Random (&.Fuzzy Frac))
+  (r.Random (&.Fuzzy Deg))
   (do r.Monad<Random>
-    [x r.frac
-     y r.frac
-     z r.frac]
-    (wrap (&.f/triangle x y z))))
+    [x r.deg
+     y r.deg
+     z r.deg]
+    (wrap (&.triangle x y z))))
 
 (context: "Combinators"
   (<| (times +100)
       (do @
         [left gen-triangle
          right gen-triangle
-         sample r.frac]
+         sample r.deg]
         ($_ seq
             (test "Union membership as as high as membership in any of its members."
                   (let [combined (&.union left right)
@@ -174,7 +163,7 @@
   (<| (times +100)
       (do @
         [fuzzy gen-triangle
-         sample r.frac
+         sample r.deg
          threshold r.deg
          #let [vip-fuzzy (&.cut threshold fuzzy)
                member? (&.to-predicate threshold fuzzy)]]