aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-mode/lux-mode.el2
-rw-r--r--stdlib/source/lux.lux88
-rw-r--r--stdlib/source/lux/data/bit.lux2
-rw-r--r--stdlib/test/test/lux.lux16
4 files changed, 84 insertions, 24 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 15c24490d..a254c1ad2 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -215,7 +215,7 @@ Called by `imenu--generic-function'."
"("
(regexp-opt
'(".module:"
- "def:" "type:" "macro:" "syntax:" "program:"
+ "def:" "type:" "macro:" "alias:" "syntax:" "program:"
"sig:" "struct:" "context:" "template:"
"class:" "interface:"
"poly:" "derived:"
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"