diff options
| -rw-r--r-- | stdlib/source/lux/type/unit.lux | 40 |
1 files changed, 26 insertions, 14 deletions
diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index e3736cf76..14c1edbce 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -2,7 +2,8 @@ lux (lux (control [monad #+ do Monad] ["p" parser "p/" Monad<Parser>]) - (data text/format) + (data text/format + (number ["r" ratio])) [macro] (macro [code] ["s" syntax #+ syntax:] @@ -17,7 +18,9 @@ (: (All [u] (-> (Qty u) (Qty (s u)))) scale) (: (All [u] (-> (Qty (s u)) (Qty u))) - de-scale)) + de-scale) + (: r;Ratio + ratio)) (type: #export Pure (Qty [])) @@ -44,7 +47,7 @@ (let [[magnitude carrier] quantity] magnitude)) -(def: #hidden (carrier quantity) +(def: (carrier quantity) (All [unit] (-> (Qty unit) unit)) (let [[magnitude carrier] quantity] carrier)) @@ -69,7 +72,7 @@ ))) (def: ratio^ - (s;Syntax [Int Int]) + (s;Syntax r;Ratio) (s;tuple (do p;Monad<Parser> [numerator s;int _ (p;assert (format "Numerator must be positive: " (%i numerator)) @@ -77,11 +80,11 @@ denominator s;int _ (p;assert (format "Denominator must be positive: " (%i denominator)) (i.> 0 denominator))] - (wrap [numerator denominator])))) + (wrap [(int-to-nat numerator) (int-to-nat denominator)])))) (syntax: #export (scale: [export csr;export] [name s;local-symbol] - [[numerator denominator] ratio^]) + [(^slots [#r;numerator #r;denominator]) ratio^]) (let [g!scale (code;local-symbol name)] (wrap (list (` (type: (~@ (csw;export export)) ((~ g!scale) (~' u)) (host (~ (code;local-symbol (scale-name name))) [(~' u)]))) @@ -89,14 +92,16 @@ (;;Scale (~ g!scale)) (def: (~' scale) (|>. ;;out - (i.* (~ (code;int numerator))) - (i./ (~ (code;int denominator))) + (i.* (~ (code;int (nat-to-int numerator)))) + (i./ (~ (code;int (nat-to-int denominator)))) (;;in (:! ((~ g!scale) ($ +0)) [])))) (def: (~' de-scale) (|>. ;;out - (i.* (~ (code;int denominator))) - (i./ (~ (code;int numerator))) - (;;in (:! ($ +0) [])))))) + (i.* (~ (code;int (nat-to-int denominator)))) + (i./ (~ (code;int (nat-to-int numerator)))) + (;;in (:! ($ +0) [])))) + (def: (~' ratio) + [(~ (code;nat numerator)) (~ (code;nat denominator))]))) )))) (do-template [<name> <op>] @@ -125,9 +130,11 @@ (def: #export (re-scale from to quantity) (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) - (|> quantity - (:: from de-scale) - (:: to scale))) + (let [[numerator denominator] (|> (:: to ratio) (r;q./ (:: from ratio)))] + (|> quantity out + (i.* (nat-to-int numerator)) + (i./ (nat-to-int denominator)) + (in (:! (($ +1) ($ +2)) []))))) (scale: #export Kilo [1 1_000]) (scale: #export Mega [1 1_000_000]) @@ -141,3 +148,8 @@ (All [s u] (-> (Scale s) u Int (Qty (s u)))) (let [[_ carrier] (|> 0 (in unit) (:: scale scale))] [magnitude carrier])) + +(unit: #export Gram) +(unit: #export Meter) +(unit: #export Litre) +(unit: #export Second) |