aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2018-05-12 18:48:52 -0400
committerEduardo Julian2018-05-12 18:48:52 -0400
commit6717fc5e4aaf5986cd4f0d4ea1a12793188cbe9a (patch)
tree471ee5a4a585183b2fcb570c75277969b5953406 /stdlib/source
parenta268b8e66fbb5ad51e053bbb9a334a6460602aed (diff)
- Implemented Deg(ree) reciprocal & conversions Deg<->Frac.
- Added an easy way to define aliases.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux88
-rw-r--r--stdlib/source/lux/data/bit.lux2
2 files changed, 72 insertions, 18 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)))