diff options
| -rw-r--r-- | lux-mode/lux-mode.el | 2 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 88 | ||||
| -rw-r--r-- | stdlib/source/lux/data/bit.lux | 2 | ||||
| -rw-r--r-- | stdlib/test/test/lux.lux | 16 |
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" |