From 224797231a8144f6ead1baab3b4b01a74cab629c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 21 Nov 2022 16:40:51 -0400 Subject: Added index section to documentation + re-named Primitive -> Nominal --- stdlib/source/test/lux.lux | 6 +- stdlib/source/test/lux/data/collection/array.lux | 8 +- stdlib/source/test/lux/data/color.lux | 22 +++--- stdlib/source/test/lux/data/color/hsl.lux | 89 +++++++++++++++++++++ stdlib/source/test/lux/ffi.old.lux | 4 +- .../compiler/language/lux/analysis/inference.lux | 6 +- .../meta/compiler/language/lux/analysis/module.lux | 6 +- .../meta/compiler/language/lux/analysis/type.lux | 8 +- .../language/lux/phase/analysis/complex.lux | 4 +- .../language/lux/phase/extension/analysis/lux.lux | 2 +- stdlib/source/test/lux/meta/target/jvm.lux | 2 +- stdlib/source/test/lux/meta/type.lux | 52 ++++++------- stdlib/source/test/lux/meta/type/check.lux | 84 ++++++++++---------- stdlib/source/test/lux/meta/type/nominal.lux | 90 ++++++++++++++++++++++ stdlib/source/test/lux/meta/type/primitive.lux | 90 ---------------------- stdlib/source/test/lux/world/net.lux | 3 +- 16 files changed, 283 insertions(+), 193 deletions(-) create mode 100644 stdlib/source/test/lux/data/color/hsl.lux create mode 100644 stdlib/source/test/lux/meta/type/nominal.lux delete mode 100644 stdlib/source/test/lux/meta/type/primitive.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 29e2725cf..f009922e8 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -587,9 +587,9 @@ (same? expected))) (_.coverage [/.type_of] (same? /.Nat (/.type_of expected))) - (_.coverage [/.Primitive] - (when (/.Primitive "foo" [expected/0 expected/1]) - {.#Primitive "foo" (list actual/0 actual/1)} + (_.coverage [/.Nominal] + (when (/.Nominal "foo" [expected/0 expected/1]) + {.#Nominal "foo" (list actual/0 actual/1)} (and (same? expected/0 actual/0) (same? expected/1 actual/1)) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index bbffbd0a3..a923891aa 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -155,11 +155,11 @@ (_.coverage [!.empty !.size] (n.= size (!.size (is (Array Nat) (!.empty size))))) - (_.coverage [!.primitive] + (_.coverage [!.nominal] (when !.Array (<| {.#Named (symbol !.Array)} {.#UnivQ (list)} - {.#Primitive !.primitive (list _)}) + {.#Nominal !.nominal (list _)}) true _ @@ -323,12 +323,12 @@ (_.coverage [/.empty /.size] (n.= size (/.size (is (Array Nat) (/.empty size))))) - (_.coverage [/.primitive] + (_.coverage [/.nominal] (when /.Array (<| {.#Named (symbol /.Array)} {.#Named (symbol !.Array)} {.#UnivQ (list)} - {.#Primitive /.primitive (list _)}) + {.#Nominal /.nominal (list _)}) true _ diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 7434e8c15..8198800e6 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -21,10 +21,12 @@ ["_" property (.only Test)]]]] [\\library ["[0]" / (.only) - ["[0]" rgb]]] + ["[0]" rgb] + ["[0]" hsl]]] ["[0]" / ["[1][0]" rgb] ["[1][0]" cmyk] + ["[1][0]" hsl] ["[1][0]" named] ["[1][0]" terminal]]) @@ -63,14 +65,15 @@ (def rgb_error_margin +1.8) -(with_template [] - [(def ( color) +(with_template [ ] + [(def (-> /.Color Frac) - (let [[hue saturation luminance] (/.hsl color)] - ))] + (|>> /.rgb + hsl.of_rgb + ))] - [saturation] - [luminance] + [saturation hsl.saturation] + [luminance hsl.luminance] ) (def (encoding expected) @@ -79,10 +82,6 @@ (_.coverage [/.rgb /.of_rgb] (|> expected /.rgb /.of_rgb (at /.equivalence = expected))) - (_.coverage [/.HSL /.hsl /.of_hsl] - (|> expected /.hsl /.of_hsl - (distance/3 expected) - (f.<= ..rgb_error_margin))) (_.coverage [/.HSB /.hsb /.of_hsb] (|> expected /.hsb /.of_hsb (distance/3 expected) @@ -215,6 +214,7 @@ /rgb.test /cmyk.test + /hsl.test /named.test /terminal.test )))) diff --git a/stdlib/source/test/lux/data/color/hsl.lux b/stdlib/source/test/lux/data/color/hsl.lux new file mode 100644 index 000000000..b3221e03b --- /dev/null +++ b/stdlib/source/test/lux/data/color/hsl.lux @@ -0,0 +1,89 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["[0]S" equivalence]]] + [control + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" exception]] + [math + ["[0]" random (.only Random)] + [number + ["f" frac]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" rgb]]]] + [// + ["[0]T" rgb]]) + +(def .public value + (Random /.Value) + (random.one (|>> /.value try.maybe) + random.safe_frac)) + +(def .public random + (Random /.HSL) + (do random.monad + [hue ..value + saturation ..value + luminance ..value] + (random.one (|>> try.maybe) + (in (/.hsl hue saturation luminance))))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected_value ..value + expected_rgb rgbT.random + expected_hsl ..random]) + (all _.and + (_.for [/.Value] + (all _.and + (_.coverage [/.value] + (|> expected_value + /.value + (try#each (f.= expected_value)) + (try.else false))) + (_.coverage [/.least] + (when (/.value (f.+ +0.001 /.least)) + {try.#Failure _} false + {try.#Success _} true)) + (_.coverage [/.most] + (when (/.value (f.- +0.001 /.most)) + {try.#Failure _} false + {try.#Success _} true)) + (_.coverage [/.invalid] + (and (when (/.value (f.- +0.001 /.least)) + {try.#Failure it} (exception.match? /.invalid it) + {try.#Success _} false) + (when (/.value (f.+ +0.001 /.most)) + {try.#Failure it} (exception.match? /.invalid it) + {try.#Success _} false))) + )) + (_.for [/.HSL] + (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /.equivalence ..random)) + + (_.coverage [/.hsl + /.hue /.saturation /.luminance] + (|> (/.hsl (/.hue expected_hsl) (/.saturation expected_hsl) (/.luminance expected_hsl)) + (try#each (at /.equivalence = expected_hsl)) + (try.else false))) + (_.coverage [/.of_rgb /.rgb] + (and (|> expected_rgb + /.of_rgb + /.rgb + (at rgb.equivalence = expected_rgb)) + (|> expected_hsl + /.rgb + /.of_rgb + (at /.equivalence = expected_hsl)))) + )) + ))) diff --git a/stdlib/source/test/lux/ffi.old.lux b/stdlib/source/test/lux/ffi.old.lux index 5feb469ec..e3ea06d48 100644 --- a/stdlib/source/test/lux/ffi.old.lux +++ b/stdlib/source/test/lux/ffi.old.lux @@ -235,9 +235,9 @@ test/lux/ffi/TestInterface::current (i.= (i.+ increase counter)))) (_.coverage [/.type] - (and (type#= (Primitive "java.lang.Char") + (and (type#= (Nominal "java.lang.Char") (/.type java/lang/Char)) - (type#= (Primitive "java.util.List" [(Primitive "java.lang.Byte")]) + (type#= (Nominal "java.util.List" [(Nominal "java.lang.Byte")]) (/.type (java/util/List java/lang/Byte))))) ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux index 21fb6b1df..0cfac766e 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/inference.lux @@ -63,11 +63,11 @@ configuration ($configuration.random 5)] (in (//.state (//.info version host configuration))))) -(def primitive +(def nominal (Random Type) (do random.monad [name (random.lower_cased 1)] - (in {.#Primitive name (list)}))) + (in {.#Nominal name (list)}))) (def analysis //.Phase @@ -103,7 +103,7 @@ [lux ..random_state .let [state [/extension.#bundle (/extension/analysis.bundle ..eval) /extension.#state lux]] - expected ..primitive + expected ..nominal name ($symbol.random 1 1) [type/0 term/0] ..simple_parameter arity (at ! each (n.% 10) random.nat) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux index da666f219..26dd79c7b 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux @@ -36,11 +36,11 @@ configuration ($configuration.random 5)] (in (//.state (//.info version host configuration))))) -(def primitive +(def nominal (Random Type) (do random.monad [name (random.lower_cased 1)] - (in {.#Primitive name (list)}))) + (in {.#Nominal name (list)}))) (def (new? hash it) (-> Nat .Module Bit) @@ -199,7 +199,7 @@ alias_name (random.lower_cased 3) public? random.bit - def_type ..primitive + def_type ..nominal arity (at ! each (|>> (n.% 10) ++) random.nat) labels|head (random.lower_cased 1) labels|tail (|> (random.lower_cased 1) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/type.lux index c6b2fcb7c..9699f635d 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/type.lux @@ -35,11 +35,11 @@ configuration ($configuration.random 5)] (in (//.state (//.info version host configuration))))) -(def primitive +(def nominal (Random Type) (do random.monad [name (random.lower_cased 1)] - (in {.#Primitive name (list)}))) + (in {.#Nominal name (list)}))) (def .public test Test @@ -48,9 +48,9 @@ [lux ..random_state .let [state [/extension.#bundle /extension.empty /extension.#state lux]] - expected ..primitive + expected ..nominal dummy (random.only (|>> (type#= expected) not) - ..primitive) + ..nominal) module (random.lower_cased 1)] (all _.and (_.coverage [/.expecting /.inference] diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux index 0fb6d9f54..829452717 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -69,11 +69,11 @@ configuration ($configuration.random 5)] (in (//analysis.state (//analysis.info version host configuration))))) -(def primitive +(def nominal (Random Type) (do random.monad [name (random.lower_cased 1)] - (in {.#Primitive name (list)}))) + (in {.#Nominal name (list)}))) (def analysis //analysis.Phase diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index 8d9aebda6..258333074 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except i64 int primitive) + [lux (.except i64 int) [abstract ["[0]" monad (.only do)]] [data diff --git a/stdlib/source/test/lux/meta/target/jvm.lux b/stdlib/source/test/lux/meta/target/jvm.lux index b5039dcaf..514eecf1f 100644 --- a/stdlib/source/test/lux/meta/target/jvm.lux +++ b/stdlib/source/test/lux/meta/target/jvm.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Type Primitive Label int) + [lux (.except Type Label int) ["[0]" ffi (.only import)] [abstract ["[0]" monad (.only do)]] diff --git a/stdlib/source/test/lux/meta/type.lux b/stdlib/source/test/lux/meta/type.lux index 50cccc419..8c7e6cd9c 100644 --- a/stdlib/source/test/lux/meta/type.lux +++ b/stdlib/source/test/lux/meta/type.lux @@ -33,7 +33,7 @@ [\\library ["[0]" / (.use "[1]#[0]" equivalence)]] ["[0]" / - ["[1][0]" primitive] + ["[1][0]" nominal] ["[1][0]" check] ["[1][0]" dynamic] ["[1][0]" implicit] @@ -54,19 +54,19 @@ _ false)])) -(def primitive +(def nominal (Random Type) (|> (random.alpha_numeric 1) (at random.monad each (function (_ name) - {.#Primitive name (list)})))) + {.#Nominal name (list)})))) (def test|matches Test (<| (_.for [\\parser.types_do_not_match]) (do [! random.monad] - [expected ..primitive + [expected ..nominal dummy (random.only (|>> (/#= expected) not) - ..primitive)]) + ..nominal)]) (all _.and (_.coverage [\\parser.exactly] (and (|> (\\parser.result (\\parser.exactly expected) expected) @@ -99,9 +99,9 @@ (def test|aggregate Test (do [! random.monad] - [expected_left ..primitive - expected_middle ..primitive - expected_right ..primitive] + [expected_left ..nominal + expected_middle ..nominal + expected_right ..nominal] (`` (all _.and (,, (with_template [ ] [(_.coverage [ ] @@ -147,9 +147,9 @@ (def test|parameter Test (do random.monad - [quantification ..primitive - argument ..primitive - not_parameter ..primitive + [quantification ..nominal + argument ..nominal + not_parameter ..nominal parameter random.nat] (all _.and (_.coverage [\\parser.not_parameter] @@ -208,7 +208,7 @@ (def test|polymorphic Test (do [! random.monad] - [not_polymorphic ..primitive + [not_polymorphic ..nominal expected_inputs (at ! each (|>> (n.% 10) ++) random.nat)] (all _.and (_.coverage [\\parser.not_polymorphic] @@ -231,7 +231,7 @@ (def test|recursive Test (do random.monad - [expected ..primitive] + [expected ..nominal] (all _.and (_.coverage [\\parser.recursive] (|> (.type_literal (Rec @ expected)) @@ -264,13 +264,13 @@ (_.for [\\parser.Parser]) (all _.and (do [! random.monad] - [expected ..primitive] + [expected ..nominal] (_.coverage [\\parser.result \\parser.any] (|> (\\parser.result \\parser.any expected) (!expect (^.multi {try.#Success actual} (/#= expected actual)))))) (do [! random.monad] - [expected ..primitive] + [expected ..nominal] (_.coverage [\\parser.next \\parser.unconsumed_input] (and (|> (\\parser.result (do <>.monad [actual \\parser.next @@ -283,7 +283,7 @@ (!expect (^.multi {try.#Failure error} (exception.match? \\parser.unconsumed_input error))))))) (do [! random.monad] - [expected ..primitive] + [expected ..nominal] (_.coverage [\\parser.empty_input] (`` (and (,, (with_template [] [(|> (\\parser.result (do <>.monad @@ -297,7 +297,7 @@ [\\parser.next] )))))) (do [! random.monad] - [expected ..primitive] + [expected ..nominal] (_.coverage [\\parser.Env \\parser.env \\parser.fresh] (|> (\\parser.result (do <>.monad [env \\parser.env @@ -307,9 +307,9 @@ (!expect (^.multi {try.#Success environment} (same? \\parser.fresh environment)))))) (do [! random.monad] - [expected ..primitive + [expected ..nominal dummy (random.only (|>> (/#= expected) not) - ..primitive)] + ..nominal)] (_.coverage [\\parser.local] (|> (\\parser.result (do <>.monad [_ \\parser.any] @@ -328,7 +328,7 @@ (do [! random.monad] [expected_name (random.and (random.alpha_numeric 1) (random.alpha_numeric 1)) - expected_type ..primitive] + expected_type ..nominal] (_.coverage [\\parser.named \\parser.not_named] (|> (\\parser.result \\parser.named {.#Named expected_name expected_type}) @@ -359,9 +359,9 @@ (let [pairG (random.and again again) un_parameterized (is (Random Type) (all random.either - (random#each (|>> {.#Primitive}) (random.and ..short (random.list 0 again))) - (random#each (|>> {.#Primitive}) (random.and ..short (random.list 1 again))) - (random#each (|>> {.#Primitive}) (random.and ..short (random.list 2 again))) + (random#each (|>> {.#Nominal}) (random.and ..short (random.list 0 again))) + (random#each (|>> {.#Nominal}) (random.and ..short (random.list 1 again))) + (random#each (|>> {.#Nominal}) (random.and ..short (random.list 2 again))) (random#each (|>> {.#Sum}) pairG) (random#each (|>> {.#Product}) pairG) (random#each (|>> {.#Function}) pairG) @@ -491,8 +491,8 @@ element_type (|> (..random 0) (random.only (function (_ type) (when type - {.#Primitive name (list element_type)} - (not (text#= array.primitive name)) + {.#Nominal name (list element_type)} + (not (text#= array.nominal name)) _ true)))) @@ -563,7 +563,7 @@ ..\\parser - /primitive.test + /nominal.test /check.test /dynamic.test /implicit.test diff --git a/stdlib/source/test/lux/meta/type/check.lux b/stdlib/source/test/lux/meta/type/check.lux index 05b6dcba4..5fd953e73 100644 --- a/stdlib/source/test/lux/meta/type/check.lux +++ b/stdlib/source/test/lux/meta/type/check.lux @@ -61,7 +61,7 @@ random_quantified (random.either (random#each (|>> {.#UnivQ}) quantifiedG) (random#each (|>> {.#ExQ}) quantifiedG))] (all random.either - (random#each (|>> {.#Primitive}) (random.and ..short (random#in (list)))) + (random#each (|>> {.#Nominal}) (random.and ..short (random#in (list)))) random_pair random_id random_quantified @@ -75,7 +75,7 @@ (def (valid_type? type) (-> Type Bit) (when type - {.#Primitive name params} + {.#Nominal name params} (list.every? valid_type? params) {.#Ex id} @@ -118,16 +118,16 @@ ($monad.spec ..injection ..comparison /.monad)) )) -(def (primitive_type parameters) +(def (nominal_type parameters) (-> Nat (Random Type)) (do random.monad - [primitive (random.upper_cased 3) - parameters (random.list parameters (primitive_type (-- parameters)))] - (in {.#Primitive primitive parameters}))) + [nominal (random.upper_cased 3) + parameters (random.list parameters (nominal_type (-- parameters)))] + (in {.#Nominal nominal parameters}))) (def clean_type (Random Type) - (primitive_type 2)) + (nominal_type 2)) (exception.def yolo) @@ -214,7 +214,7 @@ (when (/.result /.fresh_context (do /.monad [[var_id var_type] /.var - _ (/.bind {.#Primitive nominal (list)} + _ (/.bind {.#Nominal nominal (list)} var_id)] (in true))) {try.#Success _} true @@ -225,7 +225,7 @@ (and (|> (do /.monad [[var_id var_type] /.var pre (/.bound? var_id) - _ (/.bind {.#Primitive nominal (list)} + _ (/.bind {.#Nominal nominal (list)} var_id) post (/.bound? var_id)] (in (and (not pre) @@ -248,9 +248,9 @@ (when (/.result /.fresh_context (do /.monad [[var_id var_type] /.var - _ (/.bind {.#Primitive nominal (list)} + _ (/.bind {.#Nominal nominal (list)} var_id)] - (/.bind {.#Primitive nominal (list)} + (/.bind {.#Nominal nominal (list)} var_id))) {try.#Success _} false @@ -262,7 +262,7 @@ var_id random.nat] (_.coverage [/.unknown_type_var] (when (/.result /.fresh_context - (/.bind {.#Primitive nominal (list)} + (/.bind {.#Nominal nominal (list)} var_id)) {try.#Success _} false @@ -271,7 +271,7 @@ (exception.match? /.unknown_type_var error)))) (do random.monad [nominal (random.upper_cased 10) - .let [expected {.#Primitive nominal (list)}]] + .let [expected {.#Nominal nominal (list)}]] (_.coverage [/.peek] (and (|> (do /.monad [[var_id var_type] /.var] @@ -299,7 +299,7 @@ false))))) (do random.monad [nominal (random.upper_cased 10) - .let [expected {.#Primitive nominal (list)}]] + .let [expected {.#Nominal nominal (list)}]] (_.coverage [/.read] (when (/.result /.fresh_context (do /.monad @@ -313,7 +313,7 @@ false))) (do random.monad [nominal (random.upper_cased 10) - .let [expected {.#Primitive nominal (list)}]] + .let [expected {.#Nominal nominal (list)}]] (_.coverage [/.unbound_type_var] (when (/.result /.fresh_context (do /.monad @@ -383,7 +383,7 @@ (Random Type) (do random.monad [name (random.upper_cased 10)] - (in {.#Primitive name (list)}))) + (in {.#Nominal name (list)}))) (def (non_twins = random) (All (_ a) (-> (-> a a Bit) (Random a) (Random [a a]))) @@ -401,22 +401,22 @@ (def (handles_nominal_types! name/0 name/1 parameter/0 parameter/1) (-> Text Text Type Type Bit) (let [names_matter! - (and (..succeeds? (/.check {.#Primitive name/0 (list)} - {.#Primitive name/0 (list)})) - (..fails? (/.check {.#Primitive name/0 (list)} - {.#Primitive name/1 (list)}))) + (and (..succeeds? (/.check {.#Nominal name/0 (list)} + {.#Nominal name/0 (list)})) + (..fails? (/.check {.#Nominal name/0 (list)} + {.#Nominal name/1 (list)}))) parameters_matter! - (and (..succeeds? (/.check {.#Primitive name/0 (list parameter/0)} - {.#Primitive name/0 (list parameter/0)})) - (..fails? (/.check {.#Primitive name/0 (list parameter/0)} - {.#Primitive name/0 (list parameter/1)}))) + (and (..succeeds? (/.check {.#Nominal name/0 (list parameter/0)} + {.#Nominal name/0 (list parameter/0)})) + (..fails? (/.check {.#Nominal name/0 (list parameter/0)} + {.#Nominal name/0 (list parameter/1)}))) covariant_parameters! - (and (..succeeds? (/.check {.#Primitive name/0 (list Super)} - {.#Primitive name/0 (list Sub)})) - (..fails? (/.check {.#Primitive name/0 (list Sub)} - {.#Primitive name/0 (list Super)})))] + (and (..succeeds? (/.check {.#Nominal name/0 (list Super)} + {.#Nominal name/0 (list Sub)})) + (..fails? (/.check {.#Nominal name/0 (list Sub)} + {.#Nominal name/0 (list Super)})))] (and names_matter! parameters_matter! covariant_parameters!))) @@ -424,8 +424,8 @@ (with_template [ ] [(def ( name/0 name/1) (-> Text Text Bit) - (let [pair/0 { {.#Primitive name/0 (list)} {.#Primitive name/0 (list)}} - pair/1 { {.#Primitive name/1 (list)} {.#Primitive name/1 (list)}} + (let [pair/0 { {.#Nominal name/0 (list)} {.#Nominal name/0 (list)}} + pair/1 { {.#Nominal name/1 (list)} {.#Nominal name/1 (list)}} invariant! (and (..succeeds? (/.check pair/0 pair/0)) @@ -713,7 +713,7 @@ [name (random.upper_cased 10) parameterT dirty_type] (in (function (_ holeT) - {.#Primitive name (list (parameterT holeT))}))) + {.#Nominal name (list (parameterT holeT))}))) (,, (with_template [] [(do [! random.monad] [funcT dirty_type @@ -765,18 +765,18 @@ (def for_subsumption|nominal (Random Bit) (do random.monad - [primitive (random.upper_cased 10) + [nominal (random.upper_cased 10) example ..clean_type] - (in (and (/.subsumes? {.#Primitive primitive (list)} - {.#Primitive primitive (list)}) - (/.subsumes? {.#Primitive primitive (list .Any)} - {.#Primitive primitive (list example)}) - (not (/.subsumes? {.#Primitive primitive (list example)} - {.#Primitive primitive (list .Any)})) - (/.subsumes? {.#Primitive primitive (list example)} - {.#Primitive primitive (list .Nothing)}) - (not (/.subsumes? {.#Primitive primitive (list .Nothing)} - {.#Primitive primitive (list example)})) + (in (and (/.subsumes? {.#Nominal nominal (list)} + {.#Nominal nominal (list)}) + (/.subsumes? {.#Nominal nominal (list .Any)} + {.#Nominal nominal (list example)}) + (not (/.subsumes? {.#Nominal nominal (list example)} + {.#Nominal nominal (list .Any)})) + (/.subsumes? {.#Nominal nominal (list example)} + {.#Nominal nominal (list .Nothing)}) + (not (/.subsumes? {.#Nominal nominal (list .Nothing)} + {.#Nominal nominal (list example)})) )))) (def for_subsumption|sum diff --git a/stdlib/source/test/lux/meta/type/nominal.lux b/stdlib/source/test/lux/meta/type/nominal.lux new file mode 100644 index 000000000..c0bf30297 --- /dev/null +++ b/stdlib/source/test/lux/meta/type/nominal.lux @@ -0,0 +1,90 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random] + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" code (.only) + ["<[1]>" \\parser]] + ["[0]" macro (.only) + [syntax (.only syntax)] + ["[0]" template]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(template.with_locals [g!Foo g!Bar] + (these (with_template [ ] + [(def + (syntax (_ []) + (do meta.monad + [frame ] + (in (list (code.text (the /.#name frame)))))))] + + [current /.current] + [specific (/.specific (template.text [g!Foo]))] + ) + + (/.def (g!Foo a) + Text + + (/.def (g!Bar a) + Nat + + (def .public test + Test + (<| (_.covering /._) + (_.for [/.def]) + (do random.monad + [expected_foo (random.lower_cased 5) + expected_bar random.nat] + (all _.and + (_.coverage [/.abstraction] + (and (exec (is (g!Foo Text) + (/.abstraction g!Foo expected_foo)) + true) + (exec (is (g!Bar Text) + (/.abstraction expected_bar)) + true))) + (_.coverage [/.representation] + (and (|> expected_foo + (/.abstraction g!Foo) + (is (g!Foo Bit)) + (/.representation g!Foo) + (text#= expected_foo)) + (|> (/.abstraction expected_bar) + (is (g!Bar Bit)) + /.representation + (n.= expected_bar)))) + (_.coverage [/.transmutation] + (and (exec (|> expected_foo + (/.abstraction g!Foo) + (is (g!Foo .Macro)) + (/.transmutation g!Foo) + (is (g!Foo .Lux))) + true) + (exec (|> (/.abstraction expected_bar) + (is (g!Bar .Macro)) + /.transmutation + (is (g!Bar .Lux))) + true))) + (_.for [/.Frame] + (all _.and + (_.coverage [/.current] + (text#= (template.text [g!Bar]) + (..current))) + (_.coverage [/.specific] + (text#= (template.text [g!Foo]) + (..specific))) + )) + )))))))) diff --git a/stdlib/source/test/lux/meta/type/primitive.lux b/stdlib/source/test/lux/meta/type/primitive.lux deleted file mode 100644 index c0bf30297..000000000 --- a/stdlib/source/test/lux/meta/type/primitive.lux +++ /dev/null @@ -1,90 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)]] - [control - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" text (.use "[1]#[0]" equivalence)]] - [math - ["[0]" random] - [number - ["n" nat]]] - ["[0]" meta (.only) - ["[0]" code (.only) - ["<[1]>" \\parser]] - ["[0]" macro (.only) - [syntax (.only syntax)] - ["[0]" template]]] - [test - ["_" property (.only Test)]]]] - [\\library - ["[0]" /]]) - -(template.with_locals [g!Foo g!Bar] - (these (with_template [ ] - [(def - (syntax (_ []) - (do meta.monad - [frame ] - (in (list (code.text (the /.#name frame)))))))] - - [current /.current] - [specific (/.specific (template.text [g!Foo]))] - ) - - (/.def (g!Foo a) - Text - - (/.def (g!Bar a) - Nat - - (def .public test - Test - (<| (_.covering /._) - (_.for [/.def]) - (do random.monad - [expected_foo (random.lower_cased 5) - expected_bar random.nat] - (all _.and - (_.coverage [/.abstraction] - (and (exec (is (g!Foo Text) - (/.abstraction g!Foo expected_foo)) - true) - (exec (is (g!Bar Text) - (/.abstraction expected_bar)) - true))) - (_.coverage [/.representation] - (and (|> expected_foo - (/.abstraction g!Foo) - (is (g!Foo Bit)) - (/.representation g!Foo) - (text#= expected_foo)) - (|> (/.abstraction expected_bar) - (is (g!Bar Bit)) - /.representation - (n.= expected_bar)))) - (_.coverage [/.transmutation] - (and (exec (|> expected_foo - (/.abstraction g!Foo) - (is (g!Foo .Macro)) - (/.transmutation g!Foo) - (is (g!Foo .Lux))) - true) - (exec (|> (/.abstraction expected_bar) - (is (g!Bar .Macro)) - /.transmutation - (is (g!Bar .Lux))) - true))) - (_.for [/.Frame] - (all _.and - (_.coverage [/.current] - (text#= (template.text [g!Bar]) - (..current))) - (_.coverage [/.specific] - (text#= (template.text [g!Foo]) - (..specific))) - )) - )))))))) diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux index ddcd8dcfd..13fb27295 100644 --- a/stdlib/source/test/lux/world/net.lux +++ b/stdlib/source/test/lux/world/net.lux @@ -24,7 +24,8 @@ true) (_.coverage [/.URL] true) - (_.coverage [/.Address] + (_.coverage [/.Address + /.#host /.#port] true) /mime.test -- cgit v1.2.3