- Implemented Deg(ree) reciprocal & conversions Deg<->Frac.

- Added an easy way to define aliases.

3 files changed, 83 insertions, 23 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 9537f6a9b..4c52bf00f 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2463,25 +2463,28 @@
 
 (def:''' least-significant-bit-mask (list) Nat +1)
 
+(def:''' (without-trailing-zeroes count remaining)
+         (list)
+         (-> Nat Nat (#Product Nat Nat))
+         (if (|> remaining
+                 ("lux bit and" least-significant-bit-mask)
+                 ("lux coerce" Int)
+                 ("lux int =" 0))
+           (without-trailing-zeroes
+            (|> count
+                ("lux coerce" Int)
+                ("lux int +" 1)
+                ("lux coerce" Nat))
+            ("lux bit logical-right-shift" remaining +1))
+           [count remaining]))
+
 (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))
+           (let' [[trailing-zeroes remaining] (without-trailing-zeroes +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])
@@ -2491,11 +2494,11 @@
                           ("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))))))
+                  ("lux int *"
+                   ("lux coerce" Int subject)
+                   ("lux int /"
+                    ("lux coerce" Int numerator)
+                    ("lux coerce" Int denominator)))))))
 
 (def:''' #export (d/% param subject)
          (list [(tag$ ["lux" "doc"])
@@ -2534,6 +2537,17 @@
            ("lux coerce" Int subject)
            ("lux coerce" Int param))))
 
+(def:''' #export (d/reciprocal numerator)
+         (list [(tag$ ["lux" "doc"])
+                (text$ "Deg(ree) reciprocal of a Nat(ural).")])
+         (-> Nat Deg)
+         ("lux coerce" Deg
+          (let' [[trailing-zeroes remaining] (without-trailing-zeroes +0 numerator)]
+                (n// remaining
+                     ("lux case" trailing-zeroes
+                      {+0 ("lux coerce" Nat -1)
+                       _ ("lux bit left-shift" +1 (n/- trailing-zeroes +64))})))))
+
 (do-template [<name> <type> <test> <doc>]
   [(def:''' #export (<name> left right)
             (list [(tag$ ["lux" "doc"])
@@ -6315,3 +6329,41 @@
   [Nat n//% n// n/%]
   [Int i//% i// i/%]
   )
+
+(def: (to-significand value)
+  (-> Nat Frac)
+  (|> ("lux bit logical-right-shift" value +11)
+      (:! Int)
+      int-to-frac))
+
+(def: deg-denominator Frac (to-significand (:! Nat -1)))
+
+(def: #export (frac-to-deg input)
+  (-> Frac Deg)
+  (let [abs (if (f/< 0.0 input)
+              (f/* -1.0 input)
+              input)]
+    (:! Deg
+        ("lux bit left-shift"
+         (|> abs
+             (f/% 1.0)
+             (f/* deg-denominator)
+             frac-to-int
+             (:! Nat))
+         +11))))
+
+(def: #export deg-to-frac
+  (-> Deg Frac)
+  (|>> (:! Nat) to-significand (f// deg-denominator)))
+
+(macro: #export (alias: tokens)
+  (case tokens
+    (^ (list [_meta (#Symbol ["" alias])] [_meta (#Symbol aliased)]))
+    (let [alias (symbol$ ["" alias])
+          aliased (symbol$ aliased)]
+      (return (list (` (def: #export (~ alias)
+                         {#.doc (doc "Alias for:" (~ aliased))}
+                         (~ aliased))))))
+
+    _
+    (fail "Wrong syntax for alias:")))
diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux
index c6d680563..ae5b6e55d 100644
--- a/stdlib/source/lux/data/bit.lux
+++ b/stdlib/source/lux/data/bit.lux
@@ -17,6 +17,8 @@
   [arithmetic-right-shift Int "lux bit arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."]
   )
 
+(alias: right-shift logical-right-shift)
+
 (def: (add-shift shift value)
   (-> Nat Nat Nat)
   (|> value (logical-right-shift shift) (n/+ value)))
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux
index a089f7cee..788085db4 100644
--- a/stdlib/test/test/lux.lux
+++ b/stdlib/test/test/lux.lux
@@ -5,6 +5,7 @@
        [math]
        ["r" math/random]
        (data [maybe]
+             [bit]
              [text "text/" Eq<Text>]
              text/format)
        [macro]
@@ -141,6 +142,11 @@
   ["Deg"  r.deg  d/= d/+ d/- d/* d// d/% d/>   .0 (:! Deg -1) (:! Deg -1) %f id          id]
   )
 
+(def: frac-deg
+  (r.Random Deg)
+  (|> r.deg
+      (:: r.Functor<Random> map (|>> (:! Nat) (bit.left-shift +11) (bit.right-shift +11) (:! Deg)))))
+
 (do-template [category rand-gen -> <- = <cap> %a %z]
   [(context: (format "[" category "] " "Numeric conversions")
      (<| (times +100)
@@ -150,11 +156,11 @@
            (test ""
                  (|> value -> <- (= value))))))]
 
-  ["Int->Nat"  r.int  int-to-nat  nat-to-int  i/= (i/%  1000000) %i %n]
-  ["Nat->Int"  r.nat  nat-to-int  int-to-nat  n/= (n/% +1000000) %n %i]
-  ["Int->Frac" r.int  int-to-frac frac-to-int i/= (i/%  1000000) %i %r]
-  ["Frac->Int" r.frac frac-to-int int-to-frac f/= math.floor     %r %i]
-  ## [r.frac frac-to-deg deg-to-frac f/= (f/% 1.0) %r %f]
+  ["Int->Nat"  r.int    int-to-nat  nat-to-int  i/= (i/%  1000000) %i %n]
+  ["Nat->Int"  r.nat    nat-to-int  int-to-nat  n/= (n/% +1000000) %n %i]
+  ["Int->Frac" r.int    int-to-frac frac-to-int i/= (i/%  1000000) %i %r]
+  ["Frac->Int" r.frac   frac-to-int int-to-frac f/= math.floor     %r %i]
+  ["Deg->Frac" frac-deg deg-to-frac frac-to-deg d/= id             %d %r]
   )
 
 (context: "Simple macros and constructs"