diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 160 |
1 files changed, 132 insertions, 28 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)) |