aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-12-04 19:10:12 -0400
committerEduardo Julian2017-12-04 19:10:12 -0400
commit0b946aa762f777682c53c6171b4797f8869204bb (patch)
tree5a4438c3e5c7c9ee70f20dfa96fe597074e8e8c1
parent880b1a68c0b92a9271ebe028202dd9d71e8e69c6 (diff)
- Implemented unit types on top of abstract types.
-rw-r--r--stdlib/source/lux/macro/poly/json.lux10
-rw-r--r--stdlib/source/lux/type/unit.lux61
-rw-r--r--stdlib/test/test/lux/data/format/json.lux9
3 files changed, 36 insertions, 44 deletions
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 3cb1fac1a..155042437 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -69,12 +69,12 @@
#.None #//.Null
(#.Some value) (writer value))))
-(struct: (Codec<JSON,Qty> carrier)
- (All [unit] (-> unit (Codec JSON (unit.Qty unit))))
+(struct: Codec<JSON,Qty>
+ (All [unit] (Codec JSON (unit.Qty unit)))
(def: encode
(|>> unit.out (:: Codec<JSON,Int> encode)))
(def: decode
- (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier)))))
+ (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map unit.in))))
(poly: Codec<JSON,?>//encode
(with-expansions
@@ -114,7 +114,7 @@
[unitT (poly.apply (p.after (poly.this unit.Qty)
poly.any))]
(wrap (` (: (~ (@JSON//encode inputT))
- (:: ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode))))))
+ (:: (~! Codec<JSON,Qty>) (~' encode))))))
(do @
[#let [g!key (code.local-symbol "\u0000key")
g!val (code.local-symbol "\u0000val")]
@@ -226,7 +226,7 @@
[unitT (poly.apply (p.after (poly.this unit.Qty)
poly.any))]
(wrap (` (: (~ (@JSON//decode inputT))
- (p.codec ((~! Codec<JSON,Qty>) (:! (~ (poly.to-ast *env* unitT)) [])) //.any)))))
+ (p.codec (~! Codec<JSON,Qty>) //.any)))))
(do @
[[_ _ valC] (poly.apply ($_ p.seq
(poly.this d.Dict)
diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux
index cf59e25d4..c483ad71b 100644
--- a/stdlib/source/lux/type/unit.lux
+++ b/stdlib/source/lux/type/unit.lux
@@ -12,10 +12,20 @@
["s" syntax #+ syntax:]
(syntax ["cs" common]
(common ["csr" reader]
- ["csw" writer])))))
+ ["csw" writer])))
+ (type abstract)))
-(type: #export (Qty unit)
- [Int unit])
+(abstract: #export (Qty unit)
+ {}
+ Int
+
+ (def: #export in
+ (All [unit] (-> Int (Qty unit)))
+ (|>> @abstract))
+
+ (def: #export out
+ (All [unit] (-> (Qty unit) Int))
+ (|>> @repr)))
(sig: #export (Scale s)
(: (All [u] (-> (Qty u) (Qty (s u))))
@@ -37,23 +47,9 @@
(type: #export (Product p s)
(|> s (Per (Inverse p))))
-(def: #export (in carrier magnitude)
- (All [unit] (-> unit Int (Qty unit)))
- [magnitude carrier])
-
-(def: #export (pure magnitude)
+(def: #export pure
(-> Int Pure)
- (in [] magnitude))
-
-(def: #export (out quantity)
- (All [unit] (-> (Qty unit) Int))
- (let [[magnitude carrier] quantity]
- magnitude))
-
-(def: (carrier quantity)
- (All [unit] (-> (Qty unit) unit))
- (let [[magnitude carrier] quantity]
- carrier))
+ in)
(do-template [<name> <tag>]
[(def: <name>
@@ -101,12 +97,12 @@
(|>> ..out
(i/* (~ (code.int (nat-to-int numerator))))
(i// (~ (code.int (nat-to-int denominator))))
- (..in (:! ((~ g!scale) ($ +0)) []))))
+ ..in))
(def: (~' de-scale)
(|>> ..out
(i/* (~ (code.int (nat-to-int denominator))))
(i// (~ (code.int (nat-to-int numerator))))
- (..in (:! ($ +0) []))))
+ ..in))
(def: (~' ratio)
[(~ (code.nat numerator)) (~ (code.nat denominator))])))
))))
@@ -114,7 +110,7 @@
(do-template [<name> <op>]
[(def: #export (<name> param subject)
(All [unit] (-> (Qty unit) (Qty unit) (Qty unit)))
- (|> (out subject) (<op> (out param)) (in (carrier subject))))]
+ (|> subject out (<op> (out param)) in))]
[u/+ i/+]
[u/- i/-]
@@ -126,22 +122,24 @@
(|> (out subject)
(i/* (out input))
(i// (out param))
- (in (carrier subject)))))
+ in)))
(def: #export (u/* param subject)
(All [p s] (-> (Qty p) (Qty s) (Product (Qty p) (Qty s))))
(function [input]
- (|> (out subject)
+ (|> subject
+ out
(i/* (out (input param)))
- (in (carrier subject)))))
+ in)))
(def: #export (re-scale from to quantity)
(All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u))))
(let [[numerator denominator] (|> (:: to ratio) (r.r// (:: from ratio)))]
- (|> quantity out
+ (|> quantity
+ out
(i/* (nat-to-int numerator))
(i// (nat-to-int denominator))
- (in (:! (($ +1) ($ +2)) [])))))
+ in)))
(scale: #export Kilo [1 1_000])
(scale: #export Mega [1 1_000_000])
@@ -151,11 +149,6 @@
(scale: #export Micro [ 1_000_000 1])
(scale: #export Nano [1_000_000_000 1])
-(def: #export (as scale unit magnitude)
- (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)
@@ -179,5 +172,5 @@
(struct: #export Enum<Unit> (All [unit] (Enum (Qty unit)))
(def: order Order<Unit>)
- (def: (succ qty) (|> (out qty) i/inc (in (carrier qty))))
- (def: (pred qty) (|> (out qty) i/dec (in (carrier qty)))))
+ (def: succ (|>> ..out i/inc ..in))
+ (def: pred (|>> ..out i/dec ..in)))
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
index 5cbef91b0..e08478993 100644
--- a/stdlib/test/test/lux/data/format/json.lux
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -100,10 +100,9 @@
(derived: (poly/eq.Eq<?> Recursive))
-(def: (qty carrier)
- (All [unit] (-> unit (r.Random (unit.Qty unit))))
- (|> r.int
- (:: r.Monad<Random> map (unit.in carrier))))
+(def: qty
+ (All [unit] (r.Random (unit.Qty unit)))
+ (|> r.int (:: r.Monad<Random> map unit.in)))
(def: gen-record
(r.Random Record)
@@ -123,7 +122,7 @@
_instant.instant
_duration.duration
_date.date
- (qty unit.@Gram)
+ qty
)))
(derived: (poly/json.Codec<JSON,?> Record))