From febfa99c2823219c2e76d2c73b1fd8db8f6c9918 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 May 2018 01:37:38 -0400 Subject: - Implemented Deg functionality in pure Lux. --- stdlib/source/lux.lux | 160 +++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 132 insertions(+), 28 deletions(-) (limited to 'stdlib/source/lux.lux') 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 [ <<-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."] ) @@ -2384,6 +2423,88 @@ ("lux coerce" Int subject) flat)))) +(do-template [ ] + [(def:''' #export ( param subject) + (list [(tag$ ["lux" "doc"]) + (text$ )]) + (-> ) + ("lux coerce" Deg + ( ("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 [ ] [(def:''' #export ( param subject) (list [(tag$ ["lux" "doc"]) @@ -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 [ ] - [(def:''' #export ( param subject) - (list [(tag$ ["lux" "doc"]) - (text$ )]) - (-> Nat ) - ( 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 [ ] [(def:''' #export ( left right) @@ -5212,15 +5325,6 @@ [nat-to-int Nat Int] ) -(do-template [ ] - [(def: #export ( input) - (-> ) - ( 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)) -- cgit v1.2.3