aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/documentation/lux/type/unit.lux13
-rw-r--r--stdlib/source/library/lux.lux61
-rw-r--r--stdlib/source/library/lux/target/jvm/class.lux27
-rw-r--r--stdlib/source/library/lux/target/jvm/field.lux25
-rw-r--r--stdlib/source/library/lux/target/jvm/method.lux31
-rw-r--r--stdlib/source/library/lux/target/jvm/modifier.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/modifier/inner.lux27
-rw-r--r--stdlib/source/library/lux/type/unit.lux137
-rw-r--r--stdlib/source/library/lux/type/unit/scale.lux79
-rw-r--r--stdlib/source/polytypic/lux/data/format/json.lux5
-rw-r--r--stdlib/source/test/lux/data/format/json.lux3
-rw-r--r--stdlib/source/test/lux/type/unit.lux105
-rw-r--r--stdlib/source/test/lux/type/unit/scale.lux97
13 files changed, 323 insertions, 289 deletions
diff --git a/stdlib/source/documentation/lux/type/unit.lux b/stdlib/source/documentation/lux/type/unit.lux
index 5218d140c..fd518779f 100644
--- a/stdlib/source/documentation/lux/type/unit.lux
+++ b/stdlib/source/documentation/lux/type/unit.lux
@@ -28,15 +28,14 @@
(documentation: /.Pure
"A pure, unit-less quantity.")
-(documentation: /.unit:
+(documentation: /.unit
(format "Define a unit of measurement."
\n "Both the name of the type, and the name of the Unit implementation must be specified.")
- [(unit: .public Feet feet)])
+ [(def: feet (unit []))])
-(documentation: /.scale:
+(documentation: /.scale
"Define a scale of magnitude."
- [(scale: .public Bajillion bajillion
- [1 1,234,567,890])])
+ [(def: bajillion (scale [1 1,234,567,890]))])
(documentation: /.re_scaled
""
@@ -75,8 +74,8 @@
..Unit
..Scale
..Pure
- ..unit:
- ..scale:
+ ..unit
+ ..scale
..re_scaled
..kilo
..mega
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index ee78bcc4b..483362c7d 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -5048,19 +5048,56 @@
=refers)
=refers)}))))
-(with_expansions [<Immediate_UnQuote> "#Macro/Immediate_UnQuote"]
- (these (type: .public Immediate_UnQuote
- (Primitive <Immediate_UnQuote>))
+(def: (symbol#= [moduleL shortL] [moduleR shortR])
+ (-> Symbol Symbol Bit)
+ (and (text#= moduleL moduleR)
+ (text#= shortL shortR)))
+
+(def: (type#= left right)
+ (-> Type Type Bit)
+ (case [left right]
+ [{#Primitive nameL parametersL} {#Primitive nameR parametersR}]
+ (and (text#= nameL nameR)
+ ("lux i64 =" (list#size parametersL) (list#size parametersR))
+ (every? (function (_ [itL itR])
+ (type#= itL itR))
+ (zipped_2 parametersL parametersR)))
- (def: .private (immediate_unquote_type? it)
- (-> Type Bit)
- (case it
- (pattern {#Named [(static ..prelude) "Immediate_UnQuote"]
- {#Primitive <Immediate_UnQuote> {#End}}})
- #1
+ (with_template#pattern [<tag>]
+ [[{<tag> leftL rightL} {<tag> leftR rightR}]
+ (and (type#= leftL leftR)
+ (type#= rightL rightR))])
+ ([#Sum]
+ [#Product]
+ [#Function]
+ [#Apply])
- _
- #0))))
+ (with_template#pattern [<tag>]
+ [[{<tag> idL} {<tag> idR}]
+ ("lux i64 =" idL idR)])
+ ([#Parameter]
+ [#Var]
+ [#Ex])
+
+ (with_template#pattern [<tag>]
+ [[{<tag> envL bodyL} {<tag> envR bodyR}]
+ (and ("lux i64 =" (list#size envL) (list#size envR))
+ (every? (function (_ [itL itR])
+ (type#= itL itR))
+ (zipped_2 envL envR))
+ (type#= bodyL bodyR))])
+ ([#UnivQ]
+ [#ExQ])
+
+ [{#Named nameL anonL} {#Named nameR anonR}]
+ (and (symbol#= nameL nameR)
+ (type#= anonL anonR))
+
+ _
+ #0))
+
+(type: .public Immediate_UnQuote
+ (Primitive "#Macro/Immediate_UnQuote"))
(def: .public immediate_unquote
(-> Macro Immediate_UnQuote)
@@ -5120,7 +5157,7 @@
<failure>
{#Right [type value]}
- (if (immediate_unquote_type? type)
+ (if (type#= ..Immediate_UnQuote type)
(do meta#monad
[bound ((immediate_unquote_macro (as Immediate_UnQuote value)) parameters)
g!expansion (..generated_symbol "g!expansion")]
diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux
index 2f5e274e7..f93320b4c 100644
--- a/stdlib/source/library/lux/target/jvm/class.lux
+++ b/stdlib/source/library/lux/target/jvm/class.lux
@@ -14,7 +14,7 @@
[collection
["[0]" sequence (.only Sequence)]]]]]
["[0]" //
- ["[1][0]" modifier (.only Modifier modifiers:)]
+ ["[1][0]" modifier (.only Modifier modifiers)]
["[1][0]" version (.only Version Minor Major)]
["[1][0]" magic (.only Magic)]
["[1][0]" index (.only Index)]
@@ -45,16 +45,17 @@
#methods (Sequence Method)
#attributes (Sequence Attribute)])))
-(modifiers: Class
- ["0001" public]
- ["0010" final]
- ["0020" super]
- ["0200" interface]
- ["0400" abstract]
- ["1000" synthetic]
- ["2000" annotation]
- ["4000" enum]
- )
+(modifiers
+ Class
+ ["0001" public]
+ ["0010" final]
+ ["0020" super]
+ ["0200" interface]
+ ["0400" abstract]
+ ["1000" synthetic]
+ ["2000" annotation]
+ ["4000" enum]
+ )
(def: .public equivalence
(Equivalence Class)
@@ -87,8 +88,8 @@
(in [@this @super @interfaces])))
(def: .public (class version modifier
- this signature super interfaces
- fields methods attributes)
+ this signature super interfaces
+ fields methods attributes)
(-> Major (Modifier Class)
Internal (Maybe (Signature Inheritance)) Internal (List Internal)
(List (Resource Field))
diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux
index 28b414914..b41782db2 100644
--- a/stdlib/source/library/lux/target/jvm/field.lux
+++ b/stdlib/source/library/lux/target/jvm/field.lux
@@ -11,7 +11,7 @@
[collection
["[0]" sequence (.only Sequence)]]]]]
["[0]" //
- ["[0]" modifier (.only Modifier modifiers:)]
+ ["[0]" modifier (.only Modifier modifiers)]
["[1][0]" constant (.only UTF8)
["[1]/[0]" pool (.only Pool Resource)]]
["[1][0]" index (.only Index)]
@@ -28,17 +28,18 @@
#descriptor (Index (Descriptor Value))
#attributes (Sequence Attribute)])))
-(modifiers: Field
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0040" volatile]
- ["0080" transient]
- ["1000" synthetic]
- ["4000" enum]
- )
+(modifiers
+ Field
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0040" volatile]
+ ["0080" transient]
+ ["1000" synthetic]
+ ["4000" enum]
+ )
(def: .public equivalence
(Equivalence Field)
diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux
index 6e7dfa4bf..bdbe58f87 100644
--- a/stdlib/source/library/lux/target/jvm/method.lux
+++ b/stdlib/source/library/lux/target/jvm/method.lux
@@ -14,7 +14,7 @@
["[0]" sequence (.only Sequence)]
["[0]" list]]]]]
["[0]" //
- ["[1][0]" modifier (.only Modifier modifiers:)]
+ ["[1][0]" modifier (.only Modifier modifiers)]
["[1][0]" index (.only Index)]
["[1][0]" attribute (.only Attribute)
["[2][0]" code]]
@@ -36,20 +36,21 @@
#descriptor (Index (Descriptor //category.Method))
#attributes (Sequence Attribute)])))
-(modifiers: Method
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0020" synchronized]
- ["0040" bridge]
- ["0080" var_args]
- ["0100" native]
- ["0400" abstract]
- ["0800" strict]
- ["1000" synthetic]
- )
+(modifiers
+ Method
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0020" synchronized]
+ ["0040" bridge]
+ ["0080" var_args]
+ ["0100" native]
+ ["0400" abstract]
+ ["0800" strict]
+ ["1000" synthetic]
+ )
(def: .public (method modifier name with_signature? type attributes code)
(-> (Modifier Method) UTF8 Bit (Type //category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any))
diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux
index 4213dd66d..b76886f54 100644
--- a/stdlib/source/library/lux/target/jvm/modifier.lux
+++ b/stdlib/source/library/lux/target/jvm/modifier.lux
@@ -80,7 +80,7 @@
(|>> !wrap))
)
-(def: .public modifiers:
+(def: .public modifiers
(syntax (_ [ofT <code>.any
options (<>.many <code>.any)])
(with_symbols [g!modifier g!code]
diff --git a/stdlib/source/library/lux/target/jvm/modifier/inner.lux b/stdlib/source/library/lux/target/jvm/modifier/inner.lux
index 9ca1ce443..ee47de449 100644
--- a/stdlib/source/library/lux/target/jvm/modifier/inner.lux
+++ b/stdlib/source/library/lux/target/jvm/modifier/inner.lux
@@ -3,19 +3,20 @@
[lux (.except static)
[type
abstract]]]
- [// (.only modifiers:)])
+ [// (.only modifiers)])
(abstract: .public Inner Any)
-(modifiers: Inner
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0200" interface]
- ["0400" abstract]
- ["1000" synthetic]
- ["2000" annotation]
- ["4000" enum]
- )
+(modifiers
+ Inner
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0200" interface]
+ ["0400" abstract]
+ ["1000" synthetic]
+ ["2000" annotation]
+ ["4000" enum]
+ )
diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux
index 6c6fec8a3..1d2cc20ca 100644
--- a/stdlib/source/library/lux/type/unit.lux
+++ b/stdlib/source/library/lux/type/unit.lux
@@ -1,53 +1,40 @@
(.using
[library
[lux (.except type)
- ["[0]" meta]
[abstract
- [monad (.only Monad do)]
[equivalence (.only Equivalence)]
[order (.only Order)]
[enum (.only Enum)]]
[control
- ["<>" parser (.open: "[1]#[0]" monad)
- ["<[0]>" code (.only Parser)]]]
- [data
- ["[0]" text (.only)
- ["%" \\format (.only format)]]]
+ [parser
+ ["<[0]>" code]]]
["[0]" macro (.only)
- ["[0]" code]
- ["[0]" template]
- [syntax (.only syntax)
- ["|[0]|" export]]]
+ [syntax (.only syntax)]]
[math
[number
- ["n" nat]
- ["i" int]
- ["[0]" ratio (.only Ratio)]]]]]
+ ["i" int]]]]]
["[0]" // (.only)
[primitive (.except)]])
-(primitive: .public (Qty unit)
+(primitive: .public (Qty scale unit)
Int
- (type: .public Pure
- (Qty Any))
-
- (def: .public pure
- (-> Int Pure)
+ (def: .public quantity
+ (All (_ scale unit) (-> Int (Qty scale unit)))
(|>> abstraction))
(def: .public number
- (-> Pure Int)
+ (All (_ scale unit) (-> (Qty scale unit) Int))
(|>> representation))
(def: .public equivalence
- (All (_ unit) (Equivalence (Qty unit)))
+ (All (_ scale unit) (Equivalence (Qty scale unit)))
(implementation
(def: (= reference sample)
(i.= (representation reference) (representation sample)))))
(def: .public order
- (All (_ unit) (Order (Qty unit)))
+ (All (_ scale unit) (Order (Qty scale unit)))
(implementation
(def: equivalence ..equivalence)
@@ -55,7 +42,7 @@
(i.< (representation reference) (representation sample)))))
(def: .public enum
- (All (_ unit) (Enum (Qty unit)))
+ (All (_ scale unit) (Enum (Qty scale unit)))
(implementation
(def: order ..order)
(def: succ (|>> representation ++ abstraction))
@@ -63,7 +50,7 @@
(with_template [<name> <op>]
[(def: .public (<name> param subject)
- (All (_ unit) (-> (Qty unit) (Qty unit) (Qty unit)))
+ (All (_ scale unit) (-> (Qty scale unit) (Qty scale unit) (Qty scale unit)))
(abstraction (<op> (representation param)
(representation subject))))]
@@ -73,7 +60,7 @@
(with_template [<name> <op> <p> <s> <p*s>]
[(def: .public (<name> param subject)
- (All (_ p s) (-> (Qty <p>) (Qty <s>) (Qty <p*s>)))
+ (All (_ scale p s) (-> (Qty scale <p>) (Qty scale <s>) (Qty scale <p*s>)))
(abstraction (<op> (representation param)
(representation subject))))]
@@ -83,31 +70,23 @@
(type: .public (Unit a)
(Interface
- (is (-> Int (Qty a))
+ (is (-> Int (Qty Any a))
in)
- (is (-> (Qty a) Int)
+ (is (-> (Qty Any a) Int)
out)))
(def: .public (unit _)
(Ex (_ a) (-> Any (Unit a)))
(implementation
- (def: in (|>> abstraction))
- (def: out (|>> representation))))
-
- (def: in'
- (All (_ unit) (-> Int (Qty unit)))
- (|>> abstraction))
-
- (def: out'
- (All (_ unit) (-> (Qty unit) Int))
- (|>> representation))
+ (def: in ..quantity)
+ (def: out ..number)))
)
(def: .public type
(syntax (_ [it <code>.any])
(macro.with_symbols [g!a]
(in (list (` ((~! //.by_example) [(~ g!a)]
- (Unit (~ g!a))
+ (..Unit (~ g!a))
(~ it)
(~ g!a))))))))
@@ -124,83 +103,3 @@
[litre Litre]
[second Second]
)
-
-(type: .public (Scale s)
- (Interface
- (is (All (_ u) (-> (Qty u) (Qty (s u))))
- scale)
- (is (All (_ u) (-> (Qty (s u)) (Qty u)))
- de_scale)
- (is Ratio
- ratio)))
-
-(def: scaleP
- (Parser Ratio)
- (<code>.tuple (do <>.monad
- [numerator <code>.nat
- _ (<>.assertion (format "Numerator must be positive: " (%.nat numerator))
- (n.> 0 numerator))
- denominator <code>.nat
- _ (<>.assertion (format "Denominator must be positive: " (%.nat denominator))
- (n.> 0 denominator))]
- (in [numerator denominator]))))
-
-(def: .public scale:
- (syntax (_ [[export_policy type_name scale_name ratio]
- (|export|.parser
- (all <>.and
- <code>.local
- <code>.local
- ..scaleP))])
- (do meta.monad
- [.let [(open "_[0]") ratio]
- @ meta.current_module_name
- .let [g!scale (code.local type_name)]]
- (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u))
- (Primitive (~ (code.text (%.symbol [@ type_name]))) [(~' u)])))
-
- (` (def: (~ export_policy) (~ (code.local scale_name))
- (..Scale (~ g!scale))
- (implementation
- (def: (~' scale)
- (|>> ((~! ..out'))
- (i.* (~ (code.int (.int _#numerator))))
- (i./ (~ (code.int (.int _#denominator))))
- ((~! ..in'))))
- (def: (~' de_scale)
- (|>> ((~! ..out'))
- (i.* (~ (code.int (.int _#denominator))))
- (i./ (~ (code.int (.int _#numerator))))
- ((~! ..in'))))
- (def: (~' ratio)
- [(~ (code.nat _#numerator))
- (~ (code.nat _#denominator))]))))
- )))))
-
-(def: .public (re_scaled from to quantity)
- (All (_ si so u) (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u))))
- (let [[numerator denominator] (ratio./ (at from ratio)
- (at to ratio))]
- (|> quantity
- out'
- (i.* (.int numerator))
- (i./ (.int denominator))
- in')))
-
-(def: implementation_name
- (syntax (_ [type_name <code>.local])
- (in (list (code.local (text.lower_cased type_name))))))
-
-(with_template [<type> <from> <to>]
- [(`` (scale: .public <type>
- (~~ (implementation_name <type>))
- [<from> <to>]))]
-
- [Kilo 1 1,000]
- [Mega 1 1,000,000]
- [Giga 1 1,000,000,000]
-
- [Milli 1,000 1]
- [Micro 1,000,000 1]
- [Nano 1,000,000,000 1]
- )
diff --git a/stdlib/source/library/lux/type/unit/scale.lux b/stdlib/source/library/lux/type/unit/scale.lux
new file mode 100644
index 000000000..3a956baf0
--- /dev/null
+++ b/stdlib/source/library/lux/type/unit/scale.lux
@@ -0,0 +1,79 @@
+(.using
+ [library
+ [lux (.except type)
+ [control
+ [parser
+ ["<[0]>" code]]]
+ ["[0]" macro (.only)
+ [syntax (.only syntax)]]
+ [math
+ [number
+ ["i" int]
+ ["[0]" ratio (.only Ratio)]]]]]
+ ["[0]" // (.only)
+ ["/[1]" //]])
+
+(type: .public (Scale s)
+ (Interface
+ (is (All (_ u) (-> (//.Qty Any u) (//.Qty s u)))
+ up)
+ (is (All (_ u) (-> (//.Qty s u) (//.Qty Any u)))
+ down)
+ (is Ratio
+ ratio)))
+
+(def: .public (scale ratio)
+ (Ex (_ s) (-> Ratio (Scale s)))
+ (let [(open "/[0]") ratio]
+ (implementation
+ (def: up
+ (|>> //.number
+ (i.* (.int /#numerator))
+ (i./ (.int /#denominator))
+ //.quantity))
+ (def: down
+ (|>> //.number
+ (i.* (.int /#denominator))
+ (i./ (.int /#numerator))
+ //.quantity))
+ (def: ratio
+ ratio))))
+
+(def: .public (re_scaled from to quantity)
+ (All (_ si so u) (-> (Scale si) (Scale so) (//.Qty si u) (//.Qty so u)))
+ (let [(open "/[0]") (ratio./ (at from ratio)
+ (at to ratio))]
+ (|> quantity
+ //.number
+ (i.* (.int /#numerator))
+ (i./ (.int /#denominator))
+ //.quantity)))
+
+(def: .public type
+ (syntax (_ [it <code>.any])
+ (macro.with_symbols [g!a]
+ (in (list (` ((~! ///.by_example) [(~ g!a)]
+ (..Scale (~ g!a))
+ (~ it)
+
+ (~ g!a))))))))
+
+(with_template [<order_of_magnitude> <up> <up_type> <down> <down_type>]
+ [(def: .public <up>
+ (scale [ratio.#numerator <order_of_magnitude>
+ ratio.#denominator 1]))
+
+ (type: .public <up_type>
+ (~ (..type <up>)))
+
+ (def: .public <down>
+ (scale [ratio.#numerator 1
+ ratio.#denominator <order_of_magnitude>]))
+
+ (type: .public <down_type>
+ (~ (..type <down>)))]
+
+ [ 1,000 kilo Kilo milli Milli]
+ [ 1,000,000 mega Mega micro Micro]
+ [1,000,000,000 giga Giga nano Nano ]
+ )
diff --git a/stdlib/source/polytypic/lux/data/format/json.lux b/stdlib/source/polytypic/lux/data/format/json.lux
index b86f256a2..63017d5ba 100644
--- a/stdlib/source/polytypic/lux/data/format/json.lux
+++ b/stdlib/source/polytypic/lux/data/format/json.lux
@@ -1,7 +1,6 @@
(.using
[library
[lux (.except)
- ["[0]" debug]
[abstract
[monad (.only do)]
["[0]" codec]]
@@ -90,11 +89,11 @@
(codec.Codec JSON (unit.Qty unit)))
(implementation
(def: encoded
- (|>> ((debug.private unit.out'))
+ (|>> unit.number
(at ..int_codec encoded)))
(def: decoded
(|>> (at ..int_codec decoded)
- (at try.functor each (debug.private unit.in'))))))
+ (at try.functor each unit.quantity)))))
(def: encoded
(polytypic encoded
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index 2133f51f1..613767144 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -3,7 +3,6 @@
[lux (.except Variant Record)
["_" test (.only Test)]
["@" target]
- ["[0]" debug]
["[0]" meta]
[abstract
[codec (.except)]
@@ -87,7 +86,7 @@
(def: qty
(All (_ unit) (Random (unit.Qty unit)))
- (at random.monad each (debug.private unit.in') random.int))
+ (at random.monad each unit.quantity random.int))
(def: gen_record
(Random Record)
diff --git a/stdlib/source/test/lux/type/unit.lux b/stdlib/source/test/lux/type/unit.lux
index b4662133e..a4198429c 100644
--- a/stdlib/source/test/lux/type/unit.lux
+++ b/stdlib/source/test/lux/type/unit.lux
@@ -2,8 +2,6 @@
[library
[lux (.except)
["_" test (.only Test)]
- ["[0]" debug]
- ["[0]" meta]
[abstract
[monad (.only do)]
[equivalence (.only Equivalence)]
@@ -11,20 +9,18 @@
["$[0]" equivalence]
["$[0]" order]
["$[0]" enum]]]
- [macro
- [syntax (.only syntax)]
- ["[0]" code]]
[math
["[0]" random (.only Random)]
[number
- ["i" int]
- ["[0]" ratio (.open: "[1]#[0]" equivalence)]]]]]
+ ["i" int]]]]]
[\\library
- ["[0]" /]])
+ ["[0]" /]]
+ ["[0]" /
+ ["[1][0]" scale]])
(with_template [<name> <type> <unit>]
[(def: (<name> range)
- (-> Nat (Random (/.Qty <type>)))
+ (-> Nat (Random (/.Qty Any <type>)))
(|> random.int
(at random.monad each (i.% (.int range)))
(random.only (|>> (i.= +0) not))
@@ -66,100 +62,24 @@
[/.Litre /.litre]
[/.Second /.second]
))
- (_.coverage [/.Pure /.pure /.number]
+ (_.coverage [/.quantity /.number]
(|> expected
- /.pure
+ /.quantity
/.number
(i.= expected)))
(_.coverage [/.unit /.type]
(|> expected
(at ..what in)
- (is (/.Qty What))
+ (is (/.Qty Any What))
(at ..what out)
(i.= expected)))
)))))
-(def: natural
- (syntax (_ [])
- (at meta.monad each
- (|>> code.nat list)
- meta.seed)))
-
-(with_expansions [<from> (..natural)
- <to> (..natural)]
- (/.scale: How how
- [<from> <to>])
-
- (def: how::from <from>)
- (def: how::to <to>)
- )
-
-(def: scale
- Test
- (do [! random.monad]
- [small (|> random.int
- (at ! each (i.% +1,000))
- (at ! each (at /.meter in)))
- large (|> random.int
- (at ! each (i.% +1,000))
- (at ! each (i.* +1,000,000,000))
- (at ! each (at /.meter in)))
- .let [(open "meter#[0]") (is (Equivalence (/.Qty /.Meter))
- /.equivalence)]
- unscaled (|> random.int
- (at ! each (i.% +1,000))
- (at ! each (i.* (.int how::to)))
- (at ! each (at /.meter in)))]
- (_.for [/.Scale]
- (`` (all _.and
- (~~ (with_template [<type> <scale>]
- [(_.coverage [<type> <scale>]
- (|> large
- (at <scale> scale)
- (is (/.Qty (<type> /.Meter)))
- (at <scale> de_scale)
- (is (/.Qty /.Meter))
- (meter#= large)))]
-
- [/.Kilo /.kilo]
- [/.Mega /.mega]
- [/.Giga /.giga]
- ))
- (~~ (with_template [<type> <scale>]
- [(_.coverage [<type> <scale>]
- (|> small
- (at <scale> scale)
- (is (/.Qty (<type> /.Meter)))
- (at <scale> de_scale)
- (is (/.Qty /.Meter))
- (meter#= small)))]
-
- [/.Milli /.milli]
- [/.Micro /.micro]
- [/.Nano /.nano]
- ))
- (_.coverage [/.re_scaled]
- (|> large (is (/.Qty /.Meter))
- (at /.kilo scale) (is (/.Qty (/.Kilo /.Meter)))
- (/.re_scaled /.kilo /.milli) (is (/.Qty (/.Milli /.Meter)))
- (/.re_scaled /.milli /.kilo) (is (/.Qty (/.Kilo /.Meter)))
- (at /.kilo de_scale) (is (/.Qty /.Meter))
- (meter#= large)))
- (_.coverage [/.scale:]
- (and (|> unscaled
- (at ..how scale)
- (at ..how de_scale)
- (meter#= unscaled))
- (ratio#= [..how::from
- ..how::to]
- (at ..how ratio))))
- )))))
-
(def: arithmetic
Test
(do random.monad
[.let [zero (at /.meter in +0)
- (open "meter#[0]") (is (Equivalence (/.Qty /.Meter))
+ (open "meter#[0]") (is (Equivalence (/.Qty Any /.Meter))
/.equivalence)]
left (random.only (|>> (meter#= zero) not) (..meter 1,000))
right (..meter 1,000)
@@ -175,8 +95,8 @@
))
(_.coverage [/.*]
(let [expected (i.* (at /.meter out left) (at /.meter out right))
- actual ((debug.private /.out') (is (/.Qty [/.Meter /.Meter])
- (/.* left right)))]
+ actual (/.number (is (/.Qty Any [/.Meter /.Meter])
+ (/.* left right)))]
(i.= expected actual)))
(_.coverage [/./]
(|> right
@@ -192,6 +112,7 @@
(all _.and
..polymorphism
..unit
- ..scale
..arithmetic
+
+ /scale.test
)))
diff --git a/stdlib/source/test/lux/type/unit/scale.lux b/stdlib/source/test/lux/type/unit/scale.lux
new file mode 100644
index 000000000..569cdc0ba
--- /dev/null
+++ b/stdlib/source/test/lux/type/unit/scale.lux
@@ -0,0 +1,97 @@
+(.using
+ [library
+ [lux (.except)
+ ["_" test (.only Test)]
+ ["[0]" meta]
+ [abstract
+ [monad (.only do)]
+ [equivalence (.only Equivalence)]]
+ [macro
+ [syntax (.only syntax)]
+ ["[0]" code]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["i" int]
+ ["[0]" ratio (.open: "[1]#[0]" equivalence)]]]]]
+ [\\library
+ ["[0]" / (.only)
+ ["/[1]" //]]])
+
+(def: natural
+ (syntax (_ [])
+ (at meta.monad each
+ (|>> code.nat list)
+ meta.seed)))
+
+(with_expansions [<from> (..natural)
+ <to> (..natural)]
+ (def: how (/.scale [ratio.#denominator <from> ratio.#numerator <to>]))
+ (def: How (/.type how))
+
+ (def: how::from <from>)
+ (def: how::to <to>)
+ )
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Scale])
+ (do [! random.monad]
+ [small (|> random.int
+ (at ! each (i.% +1,000))
+ (at ! each (at //.meter in)))
+ large (|> random.int
+ (at ! each (i.% +1,000))
+ (at ! each (i.* +1,000,000,000))
+ (at ! each (at //.meter in)))
+ .let [(open "meter#[0]") (is (Equivalence (//.Qty Any //.Meter))
+ //.equivalence)]
+ unscaled (|> random.int
+ (at ! each (i.% +1,000))
+ (at ! each (i.* (.int how::to)))
+ (at ! each (at //.meter in)))]
+ (`` (all _.and
+ (~~ (with_template [<type> <scale>]
+ [(_.coverage [<type> <scale>]
+ (|> small
+ (at <scale> up)
+ (is (//.Qty <type> //.Meter))
+ (at <scale> down)
+ (is (//.Qty Any //.Meter))
+ (meter#= small)))]
+
+ [/.Kilo /.kilo]
+ [/.Mega /.mega]
+ [/.Giga /.giga]
+ ))
+ (~~ (with_template [<type> <scale>]
+ [(_.coverage [<type> <scale>]
+ (|> large
+ (at <scale> up)
+ (is (//.Qty <type> //.Meter))
+ (at <scale> down)
+ (is (//.Qty Any //.Meter))
+ (meter#= large)))]
+
+ [/.Milli /.milli]
+ [/.Micro /.micro]
+ [/.Nano /.nano]
+ ))
+ (_.coverage [/.re_scaled]
+ (|> large (is (//.Qty Any //.Meter))
+ (at /.kilo up) (is (//.Qty /.Kilo //.Meter))
+ (/.re_scaled /.kilo /.milli) (is (//.Qty /.Milli //.Meter))
+ (/.re_scaled /.milli /.kilo) (is (//.Qty /.Kilo //.Meter))
+ (at /.kilo down) (is (//.Qty Any //.Meter))
+ (meter#= large)))
+ (_.coverage [/.scale /.type]
+ (and (|> unscaled
+ (at ..how up)
+ (is (//.Qty How //.Meter))
+ (at ..how down)
+ (meter#= unscaled))
+ (ratio#= [ratio.#denominator ..how::from
+ ratio.#numerator ..how::to]
+ (at ..how ratio))))
+ )))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 05:37:22 +0000