From 565fe5a2e60ff3c6b612031d1c3bb89f330751da Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 30 Jun 2022 18:15:20 -0400 Subject: Moved ".../dictionary/plist" to ".../list/property". --- stdlib/source/documentation/lux/data.lux | 4 +- stdlib/source/documentation/lux/data/binary.lux | 75 ++++++- .../lux/data/collection/dictionary.lux | 6 +- .../lux/data/collection/dictionary/plist.lux | 48 ----- .../documentation/lux/data/collection/list.lux | 6 +- .../lux/data/collection/list/property.lux | 48 +++++ stdlib/source/documentation/lux/data/format.lux | 4 +- .../documentation/lux/data/format/binary.lux | 93 --------- .../source/documentation/lux/data/format/json.lux | 115 +++++------ .../source/documentation/lux/data/format/tar.lux | 2 +- .../source/documentation/lux/data/format/xml.lux | 31 ++- stdlib/source/documentation/lux/data/text.lux | 74 ++++++- .../documentation/lux/data/text/encoding.lux | 4 +- .../source/documentation/lux/data/text/format.lux | 68 ------- .../documentation/lux/data/text/unicode/block.lux | 4 +- stdlib/source/documentation/lux/target.lux | 4 +- stdlib/source/documentation/lux/target/jvm.lux | 49 ----- stdlib/source/documentation/lux/type/primitive.lux | 218 ++++++++++----------- stdlib/source/documentation/lux/type/resource.lux | 172 ++++++++-------- stdlib/source/library/lux.lux | 130 +++++++++--- .../source/library/lux/control/function/mutual.lux | 4 +- .../lux/data/collection/dictionary/plist.lux | 122 ------------ .../library/lux/data/collection/list/property.lux | 122 ++++++++++++ stdlib/source/library/lux/macro/context.lux | 11 +- stdlib/source/library/lux/macro/local.lux | 21 +- stdlib/source/library/lux/meta.lux | 25 ++- stdlib/source/library/lux/meta/configuration.lux | 7 +- .../tool/compiler/language/lux/analysis/module.lux | 41 ++-- .../tool/compiler/language/lux/analysis/scope.lux | 15 +- stdlib/source/library/lux/type/check.lux | 22 +-- stdlib/source/program/aedifex/parser.lux | 7 +- stdlib/source/program/aedifex/profile.lux | 14 +- stdlib/source/test/lux.lux | 7 +- stdlib/source/test/lux/data/collection.lux | 18 +- .../test/lux/data/collection/dictionary/plist.lux | 97 --------- .../test/lux/data/collection/list/property.lux | 97 +++++++++ stdlib/source/test/lux/macro/local.lux | 9 +- 37 files changed, 879 insertions(+), 915 deletions(-) delete mode 100644 stdlib/source/documentation/lux/data/collection/dictionary/plist.lux create mode 100644 stdlib/source/documentation/lux/data/collection/list/property.lux delete mode 100644 stdlib/source/documentation/lux/data/format/binary.lux delete mode 100644 stdlib/source/documentation/lux/data/text/format.lux delete mode 100644 stdlib/source/documentation/lux/target/jvm.lux delete mode 100644 stdlib/source/library/lux/data/collection/dictionary/plist.lux create mode 100644 stdlib/source/library/lux/data/collection/list/property.lux delete mode 100644 stdlib/source/test/lux/data/collection/dictionary/plist.lux create mode 100644 stdlib/source/test/lux/data/collection/list/property.lux (limited to 'stdlib') diff --git a/stdlib/source/documentation/lux/data.lux b/stdlib/source/documentation/lux/data.lux index 025efb839..088366a27 100644 --- a/stdlib/source/documentation/lux/data.lux +++ b/stdlib/source/documentation/lux/data.lux @@ -1,10 +1,8 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data - [text (.only \n) - ["%" \\format (.only format)]] [collection ["[0]" list]]]]] ["[0]" / diff --git a/stdlib/source/documentation/lux/data/binary.lux b/stdlib/source/documentation/lux/data/binary.lux index 80e05d511..61395234c 100644 --- a/stdlib/source/documentation/lux/data/binary.lux +++ b/stdlib/source/documentation/lux/data/binary.lux @@ -7,9 +7,82 @@ ["%" \\format (.only format)]]] [macro ["[0]" template]]]] + ["[0]" \\format] [\\library ["[0]" /]]) +(.def \\format + (.List $.Module) + ($.module \\format._ + "" + [($.default \\format.monoid) + ($.default \\format.bits_8) + ($.default \\format.bits_16) + ($.default \\format.bits_32) + ($.default \\format.bits_64) + ($.default \\format.any) + ($.default \\format.bit) + ($.default \\format.nat) + ($.default \\format.int) + ($.default \\format.rev) + ($.default \\format.frac) + ($.default \\format.binary_8) + ($.default \\format.binary_16) + ($.default \\format.binary_32) + ($.default \\format.binary_64) + ($.default \\format.utf8_8) + ($.default \\format.utf8_16) + ($.default \\format.utf8_32) + ($.default \\format.utf8_64) + ($.default \\format.text) + ($.default \\format.sequence_8) + ($.default \\format.sequence_16) + ($.default \\format.sequence_32) + ($.default \\format.sequence_64) + ($.default \\format.maybe) + ($.default \\format.list) + ($.default \\format.set) + ($.default \\format.symbol) + ($.default \\format.type) + ($.default \\format.location) + ($.default \\format.code) + + ($.documentation \\format.Mutation + "A mutation of binary data, tracking where in the data to transform.") + + ($.documentation \\format.Specification + "A description of how to transform binary data.") + + ($.documentation \\format.no_op + "A specification for empty binary data.") + + ($.documentation \\format.instance + "Given a specification of how to construct binary data, yields a binary blob that matches it.") + + ($.documentation (\\format.Format it) + "An operation that knows how to write information into a binary blob.") + + ($.documentation \\format.result + "Yields a binary blob with all the information written to it." + [(result format value)]) + + ($.documentation \\format.or + "" + [(or left right)]) + + ($.documentation \\format.and + "" + [(and pre post)]) + + ($.documentation \\format.rec + "A combinator for recursive formats." + [(rec body)]) + + ($.documentation \\format.segment + "Writes at most 'size' bytes of an input binary blob." + [(segment size)])] + [])) + (.def .public documentation (.List $.Module) ($.module /._ @@ -74,4 +147,4 @@ ($.documentation /.after "Yields a binary BLOB with at most the specified number of bytes removed." [(after bytes binary)])] - [])) + [..\\format])) diff --git a/stdlib/source/documentation/lux/data/collection/dictionary.lux b/stdlib/source/documentation/lux/data/collection/dictionary.lux index 114050284..342d79f15 100644 --- a/stdlib/source/documentation/lux/data/collection/dictionary.lux +++ b/stdlib/source/documentation/lux/data/collection/dictionary.lux @@ -11,8 +11,7 @@ [\\library ["[0]" /]] ["[0]" / - ["[1][0]" ordered] - ["[1][0]" plist]]) + ["[1][0]" ordered]]) (.def .public documentation (.List $.Module) @@ -85,5 +84,4 @@ ($.documentation /.sub "A sub-dictionary, with only the specified keys." [(sub keys dict)])] - [/ordered.documentation - /plist.documentation])) + [/ordered.documentation])) diff --git a/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux b/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux deleted file mode 100644 index 2e478812e..000000000 --- a/stdlib/source/documentation/lux/data/collection/dictionary/plist.lux +++ /dev/null @@ -1,48 +0,0 @@ -(.require - [library - [lux (.except has revised) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]] - [macro - ["[0]" code] - ["[0]" template]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.empty) - ($.default /.size) - ($.default /.empty?) - ($.default /.keys) - ($.default /.values) - ($.default /.equivalence) - - ($.documentation (/.PList it) - (format "A property list." - \n "It's a simple dictionary-like structure with Text keys.")) - - ($.documentation /.value - "" - [(value key properties)]) - - ($.documentation /.contains? - "" - [(contains? key properties)]) - - ($.documentation /.has - "" - [(has key val properties)]) - - ($.documentation /.revised - "" - [(revised key f properties)]) - - ($.documentation /.lacks - "" - [(lacks key properties)])] - [])) diff --git a/stdlib/source/documentation/lux/data/collection/list.lux b/stdlib/source/documentation/lux/data/collection/list.lux index e0699154e..d3fb2c080 100644 --- a/stdlib/source/documentation/lux/data/collection/list.lux +++ b/stdlib/source/documentation/lux/data/collection/list.lux @@ -9,7 +9,9 @@ ["[0]" code] ["[0]" template]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + ["[0]" / + ["[1][0]" property]]) (`` (.def .public documentation (.List $.Module) @@ -165,4 +167,4 @@ [value (do_something 1 2 3) .when (passes_test? value)] (do_something_else 4 5 6))])] - []))) + [/property.documentation]))) diff --git a/stdlib/source/documentation/lux/data/collection/list/property.lux b/stdlib/source/documentation/lux/data/collection/list/property.lux new file mode 100644 index 000000000..99e2faf06 --- /dev/null +++ b/stdlib/source/documentation/lux/data/collection/list/property.lux @@ -0,0 +1,48 @@ +(.require + [library + [lux (.except has revised) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]] + [macro + ["[0]" code] + ["[0]" template]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.empty) + ($.default /.size) + ($.default /.empty?) + ($.default /.keys) + ($.default /.values) + ($.default /.equivalence) + + ($.documentation (/.List it) + (format "A property list." + \n "It's a simple dictionary-like structure with Text keys.")) + + ($.documentation /.value + "" + [(value key properties)]) + + ($.documentation /.contains? + "" + [(contains? key properties)]) + + ($.documentation /.has + "" + [(has key val properties)]) + + ($.documentation /.revised + "" + [(revised key f properties)]) + + ($.documentation /.lacks + "" + [(lacks key properties)])] + [])) diff --git a/stdlib/source/documentation/lux/data/format.lux b/stdlib/source/documentation/lux/data/format.lux index 794ebe065..7dbf22055 100644 --- a/stdlib/source/documentation/lux/data/format.lux +++ b/stdlib/source/documentation/lux/data/format.lux @@ -8,7 +8,6 @@ [collection ["[0]" list]]]]] ["[0]" / - ["[1][0]" binary] ["[1][0]" json] ["[1][0]" tar] ["[1][0]" xml]]) @@ -16,8 +15,7 @@ (.def .public documentation (.List $.Module) (list.together - (list /binary.documentation - /json.documentation + (list /json.documentation /tar.documentation /xml.documentation ))) diff --git a/stdlib/source/documentation/lux/data/format/binary.lux b/stdlib/source/documentation/lux/data/format/binary.lux deleted file mode 100644 index b2ea53f63..000000000 --- a/stdlib/source/documentation/lux/data/format/binary.lux +++ /dev/null @@ -1,93 +0,0 @@ -(.require - [library - [lux (.except nat int rev list or and symbol) - ["$" documentation (.only documentation:)] - [data - [text (.only \n) - ["%" \\format (.only format)]]] - [macro - ["[0]" template]]]] - [\\library - ["[0]" /]]) - -(documentation: /.Mutation - "A mutation of binary data, tracking where in the data to transform.") - -(documentation: /.Specification - "A description of how to transform binary data.") - -(documentation: /.no_op - "A specification for empty binary data.") - -(documentation: /.instance - "Given a specification of how to construct binary data, yields a binary blob that matches it.") - -(documentation: (/.Format it) - "An operation that knows how to write information into a binary blob.") - -(documentation: /.result - "Yields a binary blob with all the information written to it." - [(result format value)]) - -(documentation: /.or - "" - [(or left right)]) - -(documentation: /.and - "" - [(and pre post)]) - -(documentation: /.rec - "A combinator for recursive formats." - [(rec body)]) - -(documentation: /.segment - "Writes at most 'size' bytes of an input binary blob." - [(segment size)]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..Mutation - ..Specification - ..no_op - ..instance - ..Format - ..result - ..or - ..and - ..rec - ..segment - ($.default /.monoid) - ($.default /.bits_8) - ($.default /.bits_16) - ($.default /.bits_32) - ($.default /.bits_64) - ($.default /.any) - ($.default /.bit) - ($.default /.nat) - ($.default /.int) - ($.default /.rev) - ($.default /.frac) - ($.default /.binary_8) - ($.default /.binary_16) - ($.default /.binary_32) - ($.default /.binary_64) - ($.default /.utf8_8) - ($.default /.utf8_16) - ($.default /.utf8_32) - ($.default /.utf8_64) - ($.default /.text) - ($.default /.sequence_8) - ($.default /.sequence_16) - ($.default /.sequence_32) - ($.default /.sequence_64) - ($.default /.maybe) - ($.default /.list) - ($.default /.set) - ($.default /.symbol) - ($.default /.type) - ($.default /.location) - ($.default /.code)] - [])) diff --git a/stdlib/source/documentation/lux/data/format/json.lux b/stdlib/source/documentation/lux/data/format/json.lux index bda2246e2..2051ee55c 100644 --- a/stdlib/source/documentation/lux/data/format/json.lux +++ b/stdlib/source/documentation/lux/data/format/json.lux @@ -1,7 +1,7 @@ (.require [library - [lux (.except nat int rev list or and has) - ["$" documentation (.only documentation:)] + [lux (.except) + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]]] @@ -10,70 +10,59 @@ [\\library ["[0]" /]]) -(documentation: /.json - "A simple way to produce JSON literals." - ["null" - (json #null)] - ["true" - (json #1)] - ["123.456" - (json +123.456)] - ["'this is a string'" - (json "this is a string")] - ["['this' 'is' 'an' 'array']" - (json ["this" "is" "an" "array"])] - ["{'this' 'is', 'an' 'object'}" - (json {"this" "is" "an" "object"})]) +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + (format "Functionality for reading and writing values in the JSON format." + \n "For more information, please see: http://www.json.org/") + [($.default /.Null) + ($.default /.Boolean) + ($.default /.Number) + ($.default /.String) + ($.default /.JSON) + ($.default /.Array) + ($.default /.Object) + ($.default /.null?) + ($.default /.object) + ($.default /.equivalence) + ($.default /.format) + ($.default /.codec) -(documentation: /.fields - "Get all the fields in a JSON object." - [(fields json)]) + ($.documentation /.json + "A simple way to produce JSON literals." + ["null" + (json #null)] + ["true" + (json #1)] + ["123.456" + (json +123.456)] + ["'this is a string'" + (json "this is a string")] + ["['this' 'is' 'an' 'array']" + (json ["this" "is" "an" "array"])] + ["{'this' 'is', 'an' 'object'}" + (json {"this" "is" "an" "object"})]) -(documentation: /.field - "A JSON object field getter." - [(field key json)]) + ($.documentation /.fields + "Get all the fields in a JSON object." + [(fields json)]) -(documentation: /.has - "A JSON object field setter." - [(has key value json)]) + ($.documentation /.field + "A JSON object field getter." + [(field key json)]) -(with_template [ ] - [(documentation: - (format "A JSON object field getter for " "."))] + ($.documentation /.has + "A JSON object field setter." + [(has key value json)]) - [/.boolean_field "booleans"] - [/.number_field "numbers"] - [/.string_field "strings"] - [/.array_field "arrays"] - [/.object_field "objects"] - ) + (~~ (with_template [ ] + [($.documentation + (format "A JSON object field getter for " "."))] -(.def .public documentation - (.List $.Module) - ($.module /._ - (format "Functionality for reading and writing values in the JSON format." - \n "For more information, please see: http://www.json.org/") - [..json - ..fields - ..field - ..has - - ..boolean_field - ..number_field - ..string_field - ..array_field - ..object_field - - ($.default /.Null) - ($.default /.Boolean) - ($.default /.Number) - ($.default /.String) - ($.default /.JSON) - ($.default /.Array) - ($.default /.Object) - ($.default /.null?) - ($.default /.object) - ($.default /.equivalence) - ($.default /.format) - ($.default /.codec)] - [])) + [/.boolean_field "booleans"] + [/.number_field "numbers"] + [/.string_field "strings"] + [/.array_field "arrays"] + [/.object_field "objects"] + ))] + []))) diff --git a/stdlib/source/documentation/lux/data/format/tar.lux b/stdlib/source/documentation/lux/data/format/tar.lux index 8da6c890f..353d83876 100644 --- a/stdlib/source/documentation/lux/data/format/tar.lux +++ b/stdlib/source/documentation/lux/data/format/tar.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - ["$" documentation (.only documentation:)] + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]]] diff --git a/stdlib/source/documentation/lux/data/format/xml.lux b/stdlib/source/documentation/lux/data/format/xml.lux index afb0bc9ee..002f24eff 100644 --- a/stdlib/source/documentation/lux/data/format/xml.lux +++ b/stdlib/source/documentation/lux/data/format/xml.lux @@ -1,7 +1,7 @@ (.require [library - [lux (.except nat int rev list or and) - ["$" documentation (.only documentation:)] + [lux (.except) + ["$" documentation] [data [text (.only \n) ["%" \\format (.only format)]]] @@ -10,27 +10,24 @@ [\\library ["[0]" /]]) -(documentation: /.attributes - "An empty set of XML attributes.") - -(documentation: /.tag - "The text format of a XML tag." - [(tag name)]) - -(documentation: /.attribute - "The text format of a XML attribute.") - (.def .public documentation (.List $.Module) ($.module /._ "" - [..attributes - ..tag - ..attribute - ($.default /.Tag) + [($.default /.Tag) ($.default /.Attribute) ($.default /.Attrs) ($.default /.XML) ($.default /.codec) - ($.default /.equivalence)] + ($.default /.equivalence) + + ($.documentation /.attributes + "An empty set of XML attributes.") + + ($.documentation /.tag + "The text format of a XML tag." + [(tag name)]) + + ($.documentation /.attribute + "The text format of a XML attribute.")] [])) diff --git a/stdlib/source/documentation/lux/data/text.lux b/stdlib/source/documentation/lux/data/text.lux index d0ca26967..3be4f68f6 100644 --- a/stdlib/source/documentation/lux/data/text.lux +++ b/stdlib/source/documentation/lux/data/text.lux @@ -1,22 +1,75 @@ (.require [library - [lux (.except char) - ["$" documentation] - [data - [text - ["%" \\format (.only format)]] - [collection - ["[0]" list]]]]] + [lux (.except) + ["$" documentation]]] ["[0]" / ["[1][0]" buffer] ["[1][0]" encoding] ["[1][0]" escape] - ["[1][0]" format] ["[1][0]" regex] ["[1][0]" unicode]] + ["[0]" \\format] [\\library ["[0]" /]]) +(.def \\format + (.List $.Module) + ($.module \\format._ + "" + [($.default \\format.functor) + + ($.default \\format.bit) + ($.default \\format.nat) + ($.default \\format.int) + ($.default \\format.rev) + ($.default \\format.frac) + ($.default \\format.text) + + ($.default \\format.ratio) + ($.default \\format.symbol) + ($.default \\format.location) + ($.default \\format.code) + ($.default \\format.type) + + ($.default \\format.instant) + ($.default \\format.duration) + ($.default \\format.date) + ($.default \\format.time) + ($.default \\format.day) + ($.default \\format.month) + + ($.default \\format.xml) + ($.default \\format.json) + + ($.default \\format.nat_2) + ($.default \\format.nat_8) + ($.default \\format.nat_10) + ($.default \\format.nat_16) + ($.default \\format.int_2) + ($.default \\format.int_8) + ($.default \\format.int_10) + ($.default \\format.int_16) + ($.default \\format.rev_2) + ($.default \\format.rev_8) + ($.default \\format.rev_10) + ($.default \\format.rev_16) + ($.default \\format.frac_2) + ($.default \\format.frac_8) + ($.default \\format.frac_10) + ($.default \\format.frac_16) + + ($.default \\format.mod) + ($.default \\format.list) + ($.default \\format.maybe) + + ($.documentation (\\format.Format it) + "A way to produce readable text from values.") + + ($.documentation \\format.format + "Text interpolation." + [(format "Static part " (text static) " does not match URI: " uri)])] + [])) + (.def .public documentation (.List $.Module) ($.module /._ @@ -143,9 +196,10 @@ ($.documentation /.space? "Checks whether the character is white-space." [(space? char)])] - [/buffer.documentation + [..\\format + + /buffer.documentation /encoding.documentation /escape.documentation - /format.documentation /regex.documentation /unicode.documentation])) diff --git a/stdlib/source/documentation/lux/data/text/encoding.lux b/stdlib/source/documentation/lux/data/text/encoding.lux index fbc82281a..6a8652b67 100644 --- a/stdlib/source/documentation/lux/data/text/encoding.lux +++ b/stdlib/source/documentation/lux/data/text/encoding.lux @@ -18,11 +18,11 @@ "" [($.default /.name) - (documentation: /.Encoding + ($.documentation /.Encoding "Encoding formats for text.") (~~ (with_template [] - [(documentation: + [($.documentation (format "'" (/.name ) "' text encoding. "))] [/.ascii] diff --git a/stdlib/source/documentation/lux/data/text/format.lux b/stdlib/source/documentation/lux/data/text/format.lux deleted file mode 100644 index c7dbb68b5..000000000 --- a/stdlib/source/documentation/lux/data/text/format.lux +++ /dev/null @@ -1,68 +0,0 @@ -(.require - [library - [lux (.except nat int rev list symbol) - ["$" documentation (.only documentation:)] - [macro - ["[0]" template]]]] - [\\library - ["[0]" /]]) - -(documentation: (/.Format it) - "A way to produce readable text from values.") - -(documentation: /.format - "Text interpolation." - [(format "Static part " (text static) " does not match URI: " uri)]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [..Format - ..format - ($.default /.functor) - - ($.default /.bit) - ($.default /.nat) - ($.default /.int) - ($.default /.rev) - ($.default /.frac) - ($.default /.text) - - ($.default /.ratio) - ($.default /.symbol) - ($.default /.location) - ($.default /.code) - ($.default /.type) - - ($.default /.instant) - ($.default /.duration) - ($.default /.date) - ($.default /.time) - ($.default /.day) - ($.default /.month) - - ($.default /.xml) - ($.default /.json) - - ($.default /.nat_2) - ($.default /.nat_8) - ($.default /.nat_10) - ($.default /.nat_16) - ($.default /.int_2) - ($.default /.int_8) - ($.default /.int_10) - ($.default /.int_16) - ($.default /.rev_2) - ($.default /.rev_8) - ($.default /.rev_10) - ($.default /.rev_16) - ($.default /.frac_2) - ($.default /.frac_8) - ($.default /.frac_10) - ($.default /.frac_16) - - ($.default /.mod) - ($.default /.list) - ($.default /.maybe)] - [])) diff --git a/stdlib/source/documentation/lux/data/text/unicode/block.lux b/stdlib/source/documentation/lux/data/text/unicode/block.lux index 95868365e..0ee609dd9 100644 --- a/stdlib/source/documentation/lux/data/text/unicode/block.lux +++ b/stdlib/source/documentation/lux/data/text/unicode/block.lux @@ -3,13 +3,13 @@ [lux (.except) ["$" documentation] [data - ["[0]" text + ["[0]" text (.only) ["%" \\format (.only format)]]] [macro ["[0]" template]] [math [number - ["[0]" nat ("hex#[0]" hex)]]]]] + ["[0]" nat (.use "hex#[0]" hex)]]]]] [\\library ["[0]" /]]) diff --git a/stdlib/source/documentation/lux/target.lux b/stdlib/source/documentation/lux/target.lux index 70ba24c62..a10a6e3f5 100644 --- a/stdlib/source/documentation/lux/target.lux +++ b/stdlib/source/documentation/lux/target.lux @@ -11,7 +11,7 @@ ["[0]" /]] ["[0]" / ["[1][0]" js] - ["[1][0]" jvm] + ["[1][0]" jvm/type] ["[1][0]" lua] ["[1][0]" python] ["[1][0]" ruby]]) @@ -35,7 +35,7 @@ (format "The name/ID of a platform targetted by a Lux compiler." \n "This information can be used to generate code targetting specific platforms, and to make programs cross-platform."))] [/js.documentation - /jvm.documentation + /jvm/type.documentation /lua.documentation /python.documentation /ruby.documentation])) diff --git a/stdlib/source/documentation/lux/target/jvm.lux b/stdlib/source/documentation/lux/target/jvm.lux deleted file mode 100644 index 440ef5775..000000000 --- a/stdlib/source/documentation/lux/target/jvm.lux +++ /dev/null @@ -1,49 +0,0 @@ -(.require - [library - [lux (.except char) - ["$" documentation] - [data - [text (.only \n) - ["%" \\format (.only format)]] - [collection - ["[0]" list]]]]] - [\\library - ["[0]" /]] - ["[0]" / - ["[1][0]" type]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.Literal) - ($.default /.Constant) - ($.default /.Int_Arithmetic) - ($.default /.Long_Arithmetic) - ($.default /.Float_Arithmetic) - ($.default /.Double_Arithmetic) - ($.default /.Arithmetic) - ($.default /.Int_Bitwise) - ($.default /.Long_Bitwise) - ($.default /.Bitwise) - ($.default /.Conversion) - ($.default /.Array) - ($.default /.Object) - ($.default /.Register) - ($.default /.Local_Int) - ($.default /.Local_Long) - ($.default /.Local_Float) - ($.default /.Local_Double) - ($.default /.Local_Object) - ($.default /.Local) - ($.default /.Stack) - ($.default /.Comparison) - ($.default /.Label) - ($.default /.Branching) - ($.default /.Exception) - ($.default /.Concurrency) - ($.default /.Return) - ($.default /.Control) - ($.default /.Instruction) - ($.default /.Bytecode)] - [/type.documentation])) diff --git a/stdlib/source/documentation/lux/type/primitive.lux b/stdlib/source/documentation/lux/type/primitive.lux index f91104900..a015098b7 100644 --- a/stdlib/source/documentation/lux/type/primitive.lux +++ b/stdlib/source/documentation/lux/type/primitive.lux @@ -10,113 +10,111 @@ [\\library ["[0]" /]]) -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.no_active_frames) - - ($.documentation /.Frame - "Meta-data about an abstract/nominal type in a stack of them.") - - ($.documentation /.current - "The currently-being-defined abstract/nominal type.") - - ($.documentation /.specific - "A specific abstract/nominal type still being defined somewhere in the scope." - [(specific name)]) - - (~~ (with_template [ <$> ] - [($.documentation - "Type-casting macro for abstract/nominal types." - [(|> value - (is ) - <$> - (is ))])] - - [/.abstraction Representation abstraction Abstraction] - [/.representation Abstraction representation Representation] - )) - - ($.documentation /.primitive - (format "Define abstract/nominal types which hide their representation details." - \n "You can convert between the abstraction and its representation selectively to access the value, while hiding it from others.") - [(primitive String - Text - - (def (string value) - (-> Text String) - (abstraction value)) - - (def (text value) - (-> String Text) - (representation value)))] - ["Type-parameters are optional." - (primitive (Duplicate a) - [a a] - - (def (duplicate value) - (All (_ a) (-> a (Duplicate a))) - (abstraction [value value])))] - ["Definitions can be nested." - (primitive (Single a) - a - - (def (single value) - (All (_ a) (-> a (Single a))) - (abstraction value)) - - (primitive (Double a) - [a a] - - (def (double value) - (All (_ a) (-> a (Double a))) - (abstraction [value value])) - - (def (single' value) - (All (_ a) (-> a (Single a))) - (abstraction Single [value value])) - - (let [value 0123] - (same? value - (|> value - single' - (representation Single) - double - representation)))))] - ["Type-parameters do not necessarily have to be used in the representation type." - "If they are not used, they become phantom types and can be used to customize types without changing the representation." - (primitive (JavaScript a) - Text - - (primitive Expression Any) - (primitive Statement Any) - - (def (+ x y) - (-> (JavaScript Expression) (JavaScript Expression) (JavaScript Expression)) - (abstraction - (format "(" (representation x) "+" (representation y) ")"))) - - (def (while test body) - (-> (JavaScript Expression) (JavaScript Statement) (JavaScript Statement)) - (abstraction - (format "while(" (representation test) ") {" - (representation body) - "}"))))]) - - ($.documentation /.transmutation - "Transmutes an abstract/nominal type's phantom types." - [(primitive (JavaScript a) - Text - - (primitive Expression Any) - (primitive Statement Any) - - (def (statement expression) - (-> (JavaScript Expression) (JavaScript Statement)) - (transmutation expression)) - - (def (statement' expression) - (-> (JavaScript Expression) (JavaScript Statement)) - (transmutation JavaScript expression)))])] - [])) +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.documentation /.Frame + "Meta-data about an abstract/nominal type in a stack of them.") + + ($.documentation /.current + "The currently-being-defined abstract/nominal type.") + + ($.documentation /.specific + "A specific abstract/nominal type still being defined somewhere in the scope." + [(specific name)]) + + (~~ (with_template [ <$> ] + [($.documentation + "Type-casting macro for abstract/nominal types." + [(|> value + (is ) + <$> + (is ))])] + + [/.abstraction Representation abstraction Abstraction] + [/.representation Abstraction representation Representation] + )) + + ($.documentation /.primitive + (format "Define abstract/nominal types which hide their representation details." + \n "You can convert between the abstraction and its representation selectively to access the value, while hiding it from others.") + [(primitive String + Text + + (def (string value) + (-> Text String) + (abstraction value)) + + (def (text value) + (-> String Text) + (representation value)))] + ["Type-parameters are optional." + (primitive (Duplicate a) + [a a] + + (def (duplicate value) + (All (_ a) (-> a (Duplicate a))) + (abstraction [value value])))] + ["Definitions can be nested." + (primitive (Single a) + a + + (def (single value) + (All (_ a) (-> a (Single a))) + (abstraction value)) + + (primitive (Double a) + [a a] + + (def (double value) + (All (_ a) (-> a (Double a))) + (abstraction [value value])) + + (def (single' value) + (All (_ a) (-> a (Single a))) + (abstraction Single [value value])) + + (let [value 0123] + (same? value + (|> value + single' + (representation Single) + double + representation)))))] + ["Type-parameters do not necessarily have to be used in the representation type." + "If they are not used, they become phantom types and can be used to customize types without changing the representation." + (primitive (JavaScript a) + Text + + (primitive Expression Any) + (primitive Statement Any) + + (def (+ x y) + (-> (JavaScript Expression) (JavaScript Expression) (JavaScript Expression)) + (abstraction + (format "(" (representation x) "+" (representation y) ")"))) + + (def (while test body) + (-> (JavaScript Expression) (JavaScript Statement) (JavaScript Statement)) + (abstraction + (format "while(" (representation test) ") {" + (representation body) + "}"))))]) + + ($.documentation /.transmutation + "Transmutes an abstract/nominal type's phantom types." + [(primitive (JavaScript a) + Text + + (primitive Expression Any) + (primitive Statement Any) + + (def (statement expression) + (-> (JavaScript Expression) (JavaScript Statement)) + (transmutation expression)) + + (def (statement' expression) + (-> (JavaScript Expression) (JavaScript Statement)) + (transmutation JavaScript expression)))])] + []))) diff --git a/stdlib/source/documentation/lux/type/resource.lux b/stdlib/source/documentation/lux/type/resource.lux index d5615d0dc..fa673174a 100644 --- a/stdlib/source/documentation/lux/type/resource.lux +++ b/stdlib/source/documentation/lux/type/resource.lux @@ -10,89 +10,89 @@ [\\library ["[0]" /]]) -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.monad) - ($.default /.index_cannot_be_repeated) - ($.default /.amount_cannot_be_zero) - - ($.documentation (/.Procedure monad input output value) - (format "A computation that takes a sequence of resource access rights as inputs and yields a different sequence as outputs." - \n "A procedure yields a result value." - \n "A procedure can make use of monadic effects.")) - - ($.documentation (/.Linear monad value) - (format "A procedure that is constant with regards to resource access rights." - \n "This means no additional resources will be available after the computation is over." - \n "This also means no previously available resources will have been consumed.")) - - ($.documentation (/.Affine monad permissions value) - "A procedure which expands the number of available resources.") - - ($.documentation (/.Relevant monad permissions value) - "A procedure which reduces the number of available resources.") - - ($.documentation /.run! - "" - [(run! monad procedure)]) - - ($.documentation /.lifted - "" - [(lifted monad procedure)]) - - ($.documentation /.Ordered - "The mode of keys which CANNOT be swapped, and for whom order of release/consumption matters.") - - ($.documentation /.Commutative - "The mode of keys which CAN be swapped, and for whom order of release/consumption DOES NOT matters.") - - ($.documentation (/.Key mode key) - (format "The access right for a resource." - \n "Without the key for a resource existing somewhere among the available ambient rights, one cannot use a resource.")) - - ($.documentation (/.Res key value) - (format "A resource locked by a key." - \n "The 'key' represents the right to access/consume a resource.")) - - (~~ (with_template [] - [($.documentation - "Makes a value into a resource and adds the key/access-right to it to the ambient keyring for future use.")] - - [/.ordered] - [/.commutative] - )) - - ($.documentation /.read - "Access the value of a resource, so long as its key is available." - [(read monad resource)]) - - ($.documentation /.exchange - (format "A function that can exchange the keys for resource, so long as they are commutative." - \n "This keys will be placed at the front of the keyring in the order they are specified." - \n "The specific keys must be specified based of their index into the current keyring.") - [(do (monad !) - [res|left (commutative ! pre) - res|right (commutative ! post) - _ ((exchange [1 0]) !) - left (read ! res|left) - right (read ! res|right)] - (in (format left right)))]) - - (~~ (with_template [] - [($.documentation - "Group/un-group keys in the keyring into/out-of tuples." - [(do (monad !) - [res|left (commutative ! pre) - res|right (commutative ! post) - _ ((group 2) !) - _ ((un_group 2) !) - right (read ! res|right) - left (read ! res|left)] - (in (format left right)))])] - - [/.group] - [/.un_group] - ))] - [])) +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.monad) + ($.default /.index_cannot_be_repeated) + ($.default /.amount_cannot_be_zero) + + ($.documentation (/.Procedure monad input output value) + (format "A computation that takes a sequence of resource access rights as inputs and yields a different sequence as outputs." + \n "A procedure yields a result value." + \n "A procedure can make use of monadic effects.")) + + ($.documentation (/.Linear monad value) + (format "A procedure that is constant with regards to resource access rights." + \n "This means no additional resources will be available after the computation is over." + \n "This also means no previously available resources will have been consumed.")) + + ($.documentation (/.Affine monad permissions value) + "A procedure which expands the number of available resources.") + + ($.documentation (/.Relevant monad permissions value) + "A procedure which reduces the number of available resources.") + + ($.documentation /.run! + "" + [(run! monad procedure)]) + + ($.documentation /.lifted + "" + [(lifted monad procedure)]) + + ($.documentation /.Ordered + "The mode of keys which CANNOT be swapped, and for whom order of release/consumption matters.") + + ($.documentation /.Commutative + "The mode of keys which CAN be swapped, and for whom order of release/consumption DOES NOT matters.") + + ($.documentation (/.Key mode key) + (format "The access right for a resource." + \n "Without the key for a resource existing somewhere among the available ambient rights, one cannot use a resource.")) + + ($.documentation (/.Res key value) + (format "A resource locked by a key." + \n "The 'key' represents the right to access/consume a resource.")) + + (~~ (with_template [] + [($.documentation + "Makes a value into a resource and adds the key/access-right to it to the ambient keyring for future use.")] + + [/.ordered] + [/.commutative] + )) + + ($.documentation /.read + "Access the value of a resource, so long as its key is available." + [(read monad resource)]) + + ($.documentation /.exchange + (format "A function that can exchange the keys for resource, so long as they are commutative." + \n "This keys will be placed at the front of the keyring in the order they are specified." + \n "The specific keys must be specified based of their index into the current keyring.") + [(do (monad !) + [res|left (commutative ! pre) + res|right (commutative ! post) + _ ((exchange [1 0]) !) + left (read ! res|left) + right (read ! res|right)] + (in (format left right)))]) + + (~~ (with_template [] + [($.documentation + "Group/un-group keys in the keyring into/out-of tuples." + [(do (monad !) + [res|left (commutative ! pre) + res|right (commutative ! post) + _ ((group 2) !) + _ ((un_group 2) !) + right (read ! res|right) + left (read ! res|left)] + (in (format left right)))])] + + [/.group] + [/.un_group] + ))] + []))) diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 9b479ce35..439fb69e3 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1526,33 +1526,33 @@ (failure "Wrong syntax for if")} tokens))) -(def' .private PList +(def' .private Property_List Type (All (_ a) ($' List (Tuple Text a)))) -(def' .private (plist#value k plist) +(def' .private (property#value k property_list) (All (_ a) - (-> Text ($' PList a) ($' Maybe a))) - ({{#Item [[k' v] plist']} + (-> Text ($' Property_List a) ($' Maybe a))) + ({{#Item [[k' v] property_list']} (if (text#= k k') {#Some v} - (plist#value k plist')) + (property#value k property_list')) {#End} {#None}} - plist)) + property_list)) -(def' .private (plist#with k v plist) +(def' .private (property#with k v property_list) (All (_ a) - (-> Text a ($' PList a) ($' PList a))) - ({{#Item [k' v'] plist'} + (-> Text a ($' Property_List a) ($' Property_List a))) + ({{#Item [k' v'] property_list'} (if (text#= k k') - (partial_list [k v] plist') - (partial_list [k' v'] (plist#with k v plist'))) + (partial_list [k v] property_list') + (partial_list [k' v'] (property#with k v property_list'))) {#End} (list [k v])} - plist)) + property_list)) (def' .private (global_symbol full_name state) (-> Symbol ($' Meta Symbol)) @@ -1574,11 +1574,11 @@ {#None} {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} - (plist#value name definitions)) + (property#value name definitions)) {#None} {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} - (plist#value module modules)))) + (property#value module modules)))) (def' .private (|List| expression) (-> Code Code) @@ -1711,8 +1711,8 @@ {#Slot _} {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} definition)} - (plist#value expected_short definitions))} - (plist#value expected_module modules)))) + (property#value expected_short definitions))} + (property#value expected_module modules)))) (def' .private (global_value global lux) (-> Symbol ($' Meta ($' Maybe (Tuple Type Any)))) @@ -2354,9 +2354,9 @@ Text Text Text ($' Maybe Macro)) (do maybe#monad - [$module (plist#value module modules) + [$module (property#value module modules) gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] - (plist#value name bindings))] + (property#value name bindings))] ({{#Alias [r_module r_name]} (named_macro' modules current_module r_module r_name) @@ -2652,9 +2652,75 @@ (meta#in type)} type)) +(def' .private (with_quantification' body lux) + (-> ($' Meta Code) ($' Meta Code)) + (let' [[..#info info/pre + ..#source source/pre + ..#current_module current_module/pre + ..#modules modules/pre + ..#scopes scopes/pre + ..#type_context type_context/pre + ..#host host/pre + ..#seed seed/pre + ..#expected expected/pre + ..#location location/pre + ..#extensions extensions/pre + ..#scope_type_vars scope_type_vars/pre + ..#eval eval/pre] lux] + ({{..#Right [lux/post output]} + (let' [[..#info info/post + ..#source source/post + ..#current_module current_module/post + ..#modules modules/post + ..#scopes scopes/post + ..#type_context type_context/post + ..#host host/post + ..#seed seed/post + ..#expected expected/post + ..#location location/post + ..#extensions extensions/post + ..#scope_type_vars scope_type_vars/post + ..#eval eval/post] lux/post] + {..#Right [[..#info info/post + ..#source source/post + ..#current_module current_module/post + ..#modules modules/post + ..#scopes scopes/pre + ..#type_context type_context/post + ..#host host/post + ..#seed seed/post + ..#expected expected/post + ..#location location/post + ..#extensions extensions/post + ..#scope_type_vars scope_type_vars/post + ..#eval eval/post] + output]}) + + failure + failure} + (body [..#info info/pre + ..#source source/pre + ..#current_module current_module/pre + ..#modules modules/pre + ..#scopes (partial_list [#name (list) + #inner 0 + #locals [#counter 0 + #mappings (list [..quantification_level [.Nat ("lux type as" Nat -1)]])] + #captured [#counter 0 + #mappings (list)]] + scopes/pre) + ..#type_context type_context/pre + ..#host host/pre + ..#seed seed/pre + ..#expected expected/pre + ..#location location/pre + ..#extensions extensions/pre + ..#scope_type_vars scope_type_vars/pre + ..#eval eval/pre])))) + (def' .public type_literal Macro - (macro (_ tokens) + (macro (type_literal tokens) ({{#Item type {#End}} (do meta#monad [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] @@ -2669,10 +2735,14 @@ _ (failure "The expansion of the type-syntax had to yield a single element.")} type+)) - (in (list (..quantified (` (..type_literal (~ type)))))))) + (do meta#monad + [it (with_quantification' + (one_expansion + (type_literal tokens)))] + (in (list (..quantified it)))))) _ - (failure (wrong_syntax_error [..prelude "type"]))} + (failure (wrong_syntax_error [..prelude "type_literal"]))} tokens))) (def' .public is @@ -3394,7 +3464,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (plist#value name modules) + (case (property#value name modules) {#Some module} {#Right state module} @@ -3410,7 +3480,7 @@ ..#definitions definitions ..#imports _ ..#module_state _] =module]] - (case (plist#value name definitions) + (case (property#value name definitions) {#Some {#Slot [exported type group index]}} (meta#in [index (list#each (function (_ slot) @@ -3442,7 +3512,7 @@ ..#definitions definitions ..#imports _ ..#module_state _] =module]] - (case (plist#value name definitions) + (case (property#value name definitions) {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}} (case (interface_methods _type) {#Some members} @@ -3544,7 +3614,7 @@ (function (_ token) (case token (pattern [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}]) - (case (plist#value slot_name tag_mappings) + (case (property#value slot_name tag_mappings) {#Some tag} (in (list tag value)) @@ -3955,7 +4025,7 @@ ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] [current_module modules])] - (case (plist#value module modules) + (case (property#value module modules) {#Some =module} (let [to_alias (list#each (is (-> [Text Global] (List Text)) @@ -4091,7 +4161,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (plist#value expected_module modules) + (case (property#value expected_module modules) {#None} {#None} @@ -4100,7 +4170,7 @@ ..#module_aliases _ ..#imports _ ..#module_state _]} - (case (plist#value expected_short definitions) + (case (property#value expected_short definitions) {#None} {#None} @@ -4801,7 +4871,7 @@ (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) {#Some [bindings bodies]} (loop (again [bindings bindings - map (is (PList (List Code)) + map (is (Property_List (List Code)) (list))]) (let [normal (is (-> Code (List Code)) (function (_ it) @@ -4821,7 +4891,7 @@ "Incorrect expansion in with_expansions" " | Binding: " (text#encoded var_name) " | Expression: " (code#encoded expr))))] - (again &rest (plist#with var_name expansion map))) + (again &rest (property#with var_name expansion map))) {#End} (at meta#monad #in (list#conjoint (list#each normal bodies)))))) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index c6107b1a9..fb74ef01e 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -12,9 +12,7 @@ [text ["%" \\format (.only format)]] [collection - ["[0]" list (.use "[1]#[0]" functor)] - [dictionary - ["[0]" plist (.only PList)]]]] + ["[0]" list (.use "[1]#[0]" functor)]]] ["[0]" macro (.only) ["[0]" local] ["[0]" code (.only) diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux deleted file mode 100644 index 2e6abd831..000000000 --- a/stdlib/source/library/lux/data/collection/dictionary/plist.lux +++ /dev/null @@ -1,122 +0,0 @@ -(.require - [library - [lux (.except has revised) - [abstract - [equivalence (.only Equivalence)] - [monoid (.only Monoid)]] - [control - ["[0]" maybe (.use "[1]#[0]" functor)]] - [data - ["[0]" product] - ["[0]" text (.use "[1]#[0]" equivalence)] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)]]] - [math - [number - ["n" nat]]]]]) - -... https://en.wikipedia.org/wiki/Property_list -(type .public (PList a) - (List [Text a])) - -(def .public empty - PList - {.#End}) - -(def .public size - (All (_ a) (-> (PList a) Nat)) - list.size) - -(def .public empty? - (All (_ a) (-> (PList a) Bit)) - (|>> ..size (n.= 0))) - -(def .public (value key properties) - (All (_ a) (-> Text (PList a) (Maybe a))) - (case properties - {.#End} - {.#None} - - {.#Item [k' v'] properties'} - (if (text#= key k') - {.#Some v'} - (value key properties')))) - -(with_template [ ] - [(def .public - (All (_ a) (-> (PList a) (List ))) - (list#each ))] - - [keys Text product.left] - [values a product.right] - ) - -(def .public (contains? key properties) - (All (_ a) (-> Text (PList a) Bit)) - (case (..value key properties) - {.#Some _} - true - - {.#None} - false)) - -(def .public (has key val properties) - (All (_ a) (-> Text a (PList a) (PList a))) - (case properties - {.#End} - (list [key val]) - - {.#Item [k' v'] properties'} - (if (text#= key k') - {.#Item [key val] - properties'} - {.#Item [k' v'] - (has key val properties')}))) - -(def .public (revised key f properties) - (All (_ a) (-> Text (-> a a) (PList a) (PList a))) - (case properties - {.#End} - {.#End} - - {.#Item [k' v'] properties'} - (if (text#= key k') - {.#Item [k' (f v')] properties'} - {.#Item [k' v'] (revised key f properties')}))) - -(def .public (lacks key properties) - (All (_ a) (-> Text (PList a) (PList a))) - (case properties - {.#End} - properties - - {.#Item [k' v'] properties'} - (if (text#= key k') - properties' - {.#Item [k' v'] - (lacks key properties')}))) - -(def .public (equivalence (open "/#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (PList a)))) - (implementation - (def (= reference subject) - (and (n.= (list.size reference) - (list.size subject)) - (list.every? (function (_ [key val]) - (|> reference - (..value key) - (maybe#each (/#= val)) - (maybe.else false))) - subject))))) - -(def .public monoid - (All (_ a) (Monoid (PList a))) - (implementation - (def identity - ..empty) - - (def (composite left right) - (list#mix (function (_ [key val] it) - (..has key val it)) - right - left)))) diff --git a/stdlib/source/library/lux/data/collection/list/property.lux b/stdlib/source/library/lux/data/collection/list/property.lux new file mode 100644 index 000000000..a4480dabb --- /dev/null +++ b/stdlib/source/library/lux/data/collection/list/property.lux @@ -0,0 +1,122 @@ +(.require + [library + [lux (.except List has revised) + [abstract + [equivalence (.only Equivalence)] + [monoid (.only Monoid)]] + [control + ["[0]" maybe (.use "[1]#[0]" functor)]] + [data + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + [number + ["n" nat]]]]]) + +... https://en.wikipedia.org/wiki/Property_list +(type .public (List a) + (.List [Text a])) + +(def .public empty + List + {.#End}) + +(def .public size + (All (_ a) (-> (List a) Nat)) + list.size) + +(def .public empty? + (All (_ a) (-> (List a) Bit)) + (|>> ..size (n.= 0))) + +(def .public (value key properties) + (All (_ a) (-> Text (List a) (Maybe a))) + (case properties + {.#End} + {.#None} + + {.#Item [k' v'] properties'} + (if (text#= key k') + {.#Some v'} + (value key properties')))) + +(with_template [ ] + [(def .public + (All (_ a) (-> (List a) (.List ))) + (list#each ))] + + [keys Text product.left] + [values a product.right] + ) + +(def .public (contains? key properties) + (All (_ a) (-> Text (List a) Bit)) + (case (..value key properties) + {.#Some _} + true + + {.#None} + false)) + +(def .public (has key val properties) + (All (_ a) (-> Text a (List a) (List a))) + (case properties + {.#End} + (list [key val]) + + {.#Item [k' v'] properties'} + (if (text#= key k') + {.#Item [key val] + properties'} + {.#Item [k' v'] + (has key val properties')}))) + +(def .public (revised key f properties) + (All (_ a) (-> Text (-> a a) (List a) (List a))) + (case properties + {.#End} + {.#End} + + {.#Item [k' v'] properties'} + (if (text#= key k') + {.#Item [k' (f v')] properties'} + {.#Item [k' v'] (revised key f properties')}))) + +(def .public (lacks key properties) + (All (_ a) (-> Text (List a) (List a))) + (case properties + {.#End} + properties + + {.#Item [k' v'] properties'} + (if (text#= key k') + properties' + {.#Item [k' v'] + (lacks key properties')}))) + +(def .public (equivalence (open "/#[0]")) + (All (_ a) (-> (Equivalence a) (Equivalence (List a)))) + (implementation + (def (= reference subject) + (and (n.= (list.size reference) + (list.size subject)) + (list.every? (function (_ [key val]) + (|> reference + (..value key) + (maybe#each (/#= val)) + (maybe.else false))) + subject))))) + +(def .public monoid + (All (_ a) (Monoid (List a))) + (implementation + (def identity + ..empty) + + (def (composite left right) + (list#mix (function (_ [key val] it) + (..has key val it)) + right + left)))) diff --git a/stdlib/source/library/lux/macro/context.lux b/stdlib/source/library/lux/macro/context.lux index 4b243e53a..b85f94af8 100644 --- a/stdlib/source/library/lux/macro/context.lux +++ b/stdlib/source/library/lux/macro/context.lux @@ -12,9 +12,8 @@ [data ["[0]" text (.use "[1]#[0]" equivalence monoid)] [collection - ["[0]" list] - [dictionary - ["[0]" plist (.only PList)]]]] + ["[0]" list (.only) + ["[0]" property]]]] [macro ["[0]" code ["?[1]" \\parser]]] @@ -98,11 +97,11 @@ _ it))) - on_globals (is (-> (PList Global) (PList Global)) - (plist.revised context on_global)) + on_globals (is (-> (property.List Global) (property.List Global)) + (property.revised context on_global)) on_module (is (-> Module Module) (revised .#definitions on_globals))] - {.#Right [(revised .#modules (plist.revised @ on_module) lux) + {.#Right [(revised .#modules (property.revised @ on_module) lux) []]}))) (.def (push' _ top) diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index ef15fbe10..29fa9820c 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -12,9 +12,8 @@ ["[0]" product] ["[0]" text] [collection - ["[0]" list (.use "[1]#[0]" functor)] - [dictionary - ["[0]" plist (.only PList)]]]]]] + ["[0]" list (.use "[1]#[0]" functor) + ["[0]" property]]]]]] ["[0]" // (.only) [syntax (.only syntax)] ["[0]" code (.only) @@ -38,11 +37,11 @@ (def (with_module name body) (All (_ a) (-> Text (-> Module (Try [Module a])) (Meta a))) (function (_ compiler) - (case (|> compiler (the .#modules) (plist.value name)) + (case (|> compiler (the .#modules) (property.value name)) {.#Some module} (case (body module) {try.#Success [module' output]} - {try.#Success [(revised .#modules (plist.has name module') compiler) + {try.#Success [(revised .#modules (property.has name module') compiler) output]} {try.#Failure error} @@ -56,11 +55,11 @@ (do meta.monad [[module_name definition_name] (meta.normal name) .let [definition (is Global {.#Definition [false .Macro macro]}) - add_macro! (is (-> (PList Global) (PList Global)) - (plist.has definition_name definition))]] + add_macro! (is (-> (property.List Global) (property.List Global)) + (property.has definition_name definition))]] (..with_module module_name (function (_ module) - (case (|> module (the .#definitions) (plist.value definition_name)) + (case (|> module (the .#definitions) (property.value definition_name)) {.#None} {try.#Success [(revised .#definitions add_macro! module) []]} @@ -72,11 +71,11 @@ (-> Symbol (Meta Any)) (do meta.monad [[module_name definition_name] (meta.normal name) - .let [lacks_macro! (is (-> (PList Global) (PList Global)) - (plist.lacks definition_name))]] + .let [lacks_macro! (is (-> (property.List Global) (property.List Global)) + (property.lacks definition_name))]] (..with_module module_name (function (_ module) - (case (|> module (the .#definitions) (plist.value definition_name)) + (case (|> module (the .#definitions) (property.value definition_name)) {.#Some _} {try.#Success [(revised .#definitions lacks_macro! module) []]} diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 7d778190c..64d84a933 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -12,9 +12,8 @@ ["[0]" product] ["[0]" text (.use "[1]#[0]" monoid order)] [collection - ["[0]" list (.use "[1]#[0]" monoid monad)] - [dictionary - ["[0]" plist]]]] + ["[0]" list (.use "[1]#[0]" monoid monad) + ["[0]" property]]]] [macro ["^" pattern] ["[0]" code]] @@ -118,7 +117,7 @@ (def .public (module name) (-> Text (Meta Module)) (function (_ lux) - (case (plist.value name (the .#modules lux)) + (case (property.value name (the .#modules lux)) {.#Some module} {try.#Success [lux module]} @@ -175,12 +174,12 @@ (loop (again [module module name name]) (do maybe.monad - [$module (plist.value module modules) + [$module (property.value module modules) definition (is (Maybe Global) (|> $module (is Module) (the .#definitions) - (plist.value name)))] + (property.value name)))] (case definition {.#Alias [r_module r_name]} (again r_module r_name) @@ -211,7 +210,7 @@ (def .public (module_exists? module) (-> Text (Meta Bit)) (function (_ lux) - {try.#Success [lux (case (plist.value module (the .#modules lux)) + {try.#Success [lux (case (property.value module (the .#modules lux)) {.#Some _} #1 @@ -303,8 +302,8 @@ (do maybe.monad [(open "[0]") (|> lux (the .#modules) - (plist.value normal_module))] - (plist.value normal_short #definitions))) + (property.value normal_module))] + (property.value normal_short #definitions))) {.#Some definition} {try.#Success [lux definition]} @@ -317,7 +316,7 @@ {try.#Failure (all text#composite "Unknown definition: " (symbol#encoded name) text.new_line " Current module: " current_module text.new_line - (case (plist.value current_module (the .#modules lux)) + (case (property.value current_module (the .#modules lux)) {.#Some this_module} (let [candidates (|> lux (the .#modules) @@ -455,7 +454,7 @@ (def .public (globals module) (-> Text (Meta (List [Text Global]))) (function (_ lux) - (case (plist.value module (the .#modules lux)) + (case (property.value module (the .#modules lux)) {.#Some module} {try.#Success [lux (the .#definitions module)]} @@ -506,7 +505,7 @@ (do ..monad [.let [[module_name name] type_name] module (..module module_name)] - (case (plist.value name (the .#definitions module)) + (case (property.value name (the .#definitions module)) {.#Some {.#Type [exported? type labels]}} (case labels (^.or {.#Left labels} @@ -557,7 +556,7 @@ [.let [[module name] label_name] =module (..module module) this_module_name ..current_module_name] - (case (plist.value name (the .#definitions =module)) + (case (property.value name (the .#definitions =module)) {.#Some { [exported? type group idx]}} (if (or (text#= this_module_name module) exported?) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index d0dea1e76..d1858ca56 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -15,9 +15,8 @@ ["%" \\format] ["<[1]>" \\parser (.only Parser)]] [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - [dictionary - ["/" plist]]]] + ["[0]" list (.use "[1]#[0]" functor mix) + ["/" property]]]] [macro [syntax (.only syntax)] ["[0]" code (.only) @@ -26,7 +25,7 @@ [number (.only hex)]]]]) (type .public Configuration - (/.PList Text)) + (/.List Text)) (def .public equivalence (Equivalence Configuration) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux index c86bdc9b5..d9ab4f4a1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux @@ -11,9 +11,8 @@ ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] [collection - ["[0]" list (.use "[1]#[0]" mix functor)] - [dictionary - ["[0]" plist]]]] + ["[0]" list (.use "[1]#[0]" mix functor) + ["[0]" property]]]] ["[0]" meta]]] ["/" // (.only Operation) ["//[1]" // @@ -84,11 +83,11 @@ [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules - (plist.revised self_name (revised .#imports (function (_ current) - (if (list.any? (text#= module) - current) - current - {.#Item module current})))) + (property.revised self_name (revised .#imports (function (_ current) + (if (list.any? (text#= module) + current) + current + {.#Item module current})))) state) []]})))) @@ -99,8 +98,8 @@ [self_name meta.current_module_name] (function (_ state) {try.#Success [(revised .#modules - (plist.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) - (|>> {.#Item [alias module]})))) + (property.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) + (|>> {.#Item [alias module]})))) state) []]})))) @@ -110,7 +109,7 @@ (function (_ state) (|> state (the .#modules) - (plist.value module) + (property.value module) (pipe.case {.#Some _} #1 {.#None} #0) [state] {try.#Success})))) @@ -122,14 +121,14 @@ [self_name meta.current_module_name self meta.current_module] (function (_ state) - (case (plist.value name (the .#definitions self)) + (case (property.value name (the .#definitions self)) {.#None} {try.#Success [(revised .#modules - (plist.has self_name - (revised .#definitions - (is (-> (List [Text Global]) (List [Text Global])) - (|>> {.#Item [name definition]})) - self)) + (property.has self_name + (revised .#definitions + (is (-> (List [Text Global]) (List [Text Global])) + (|>> {.#Item [name definition]})) + self)) state) []]} @@ -142,7 +141,7 @@ (///extension.lifted (function (_ state) {try.#Success [(revised .#modules - (plist.has name (..empty hash)) + (property.has name (..empty hash)) state) []]}))) @@ -160,14 +159,14 @@ (-> Text (Operation Any)) (///extension.lifted (function (_ state) - (case (|> state (the .#modules) (plist.value module_name)) + (case (|> state (the .#modules) (property.value module_name)) {.#Some module} (let [active? (case (the .#module_state module) {.#Active} #1 _ #0)] (if active? {try.#Success [(revised .#modules - (plist.has module_name (has .#module_state {} module)) + (property.has module_name (has .#module_state {} module)) state) []]} ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {}])) @@ -181,7 +180,7 @@ (-> Text (Operation Bit)) (///extension.lifted (function (_ state) - (case (|> state (the .#modules) (plist.value module_name)) + (case (|> state (the .#modules) (property.value module_name)) {.#Some module} {try.#Success [state (case (the .#module_state module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux index 8832c4b7e..538874881 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux @@ -11,9 +11,8 @@ ["[0]" text (.use "[1]#[0]" equivalence)] ["[0]" product] [collection - ["[0]" list (.use "[1]#[0]" functor mix monoid)] - [dictionary - ["[0]" plist]]]]]] + ["[0]" list (.use "[1]#[0]" functor mix monoid) + ["[0]" property]]]]]] ["/" // (.only Environment Operation Phase) [// [phase @@ -33,13 +32,13 @@ (-> Text Scope Bit) (|> scope (the [.#locals .#mappings]) - (plist.contains? name))) + (property.contains? name))) (def (local name scope) (-> Text Scope (Maybe [Type Variable])) (|> scope (the [.#locals .#mappings]) - (plist.value name) + (property.value name) (maybe#each (function (_ [type value]) [type {variable.#Local value}])))) @@ -47,7 +46,7 @@ (-> Text Scope Bit) (|> scope (the [.#captured .#mappings]) - (plist.contains? name))) + (property.contains? name))) (def (captured name scope) (-> Text Scope (Maybe [Type Variable])) @@ -96,7 +95,7 @@ {.#Item (revised .#captured (is (-> Foreign Foreign) (|>> (revised .#counter ++) - (revised .#mappings (plist.has name [ref_type (product.left ref+inner)])))) + (revised .#mappings (property.has name [ref_type (product.left ref+inner)])))) scope) (product.right ref+inner)}])) [init_ref {.#End}] @@ -119,7 +118,7 @@ new_head (revised .#locals (is (-> Local Local) (|>> (revised .#counter ++) - (revised .#mappings (plist.has name [type new_var_id])))) + (revised .#mappings (property.has name [type new_var_id])))) head)] (case (phase.result' [bundle (has .#scopes {.#Item new_head tail} state)] action) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 527292c47..cb49cc6e4 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -134,35 +134,35 @@ (use "check#[0]" ..monad) -(def (var::new id plist) +(def (var::new id property_list) (-> Var Type_Vars Type_Vars) - {.#Item [id {.#None}] plist}) + {.#Item [id {.#None}] property_list}) -(def (var::get id plist) +(def (var::get id property_list) (-> Var Type_Vars (Maybe (Maybe Type))) - (case plist + (case property_list {.#Item [var_id var_type] - plist'} + property_list'} (if (!n#= id var_id) {.#Some var_type} - (var::get id plist')) + (var::get id property_list')) {.#End} {.#None})) -(def (var::put id value plist) +(def (var::put id value property_list) (-> Var (Maybe Type) Type_Vars Type_Vars) - (case plist + (case property_list {.#End} (list [id value]) {.#Item [var_id var_type] - plist'} + property_list'} (if (!n#= id var_id) {.#Item [var_id value] - plist'} + property_list'} {.#Item [var_id var_type] - (var::put id value plist')}))) + (var::put id value property_list')}))) (def .public (result context proc) (All (_ a) (-> Type_Context (Check a) (Try a))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 30660e707..5255067fd 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -10,8 +10,9 @@ ["[0]" text] [collection ["[0]" set (.only Set)] - ["[0]" dictionary (.only Dictionary) - ["[0]" plist (.only PList)]]]] + ["[0]" dictionary (.only Dictionary)] + [list + ["[0]" property]]]] [macro ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]]] @@ -244,7 +245,7 @@ (<| (at ! each (dictionary.of_list text.hash)) (<>.else (list)) (..plural input "deploy_repositories" ..deploy_repository))) - ^configuration (is (Parser (PList Text)) + ^configuration (is (Parser (property.List Text)) (<| (<>.else (list)) (..plural input "configuration" ..configuration/1))) ^java (|> ..runtime diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index ff8710893..5f9435dd5 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -11,10 +11,10 @@ ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence)] [collection - ["[0]" list (.use "[1]#[0]" monoid)] ["[0]" set (.only Set)] - ["[0]" dictionary (.only Dictionary) - ["[0]" plist (.only PList) (.use "[1]#[0]" monoid)]]]] + ["[0]" dictionary (.only Dictionary)] + ["[0]" list (.use "[1]#[0]" monoid) + ["[0]" property (.use "[1]#[0]" monoid)]]]] [macro ["^" pattern] ["[0]" template]] @@ -179,7 +179,7 @@ #program (Maybe Module) #test (Maybe Module) #deploy_repositories (Dictionary Text Address) - #configuration (PList Text) + #configuration (property.List Text) #java Runtime #js Runtime #python Runtime @@ -214,7 +214,7 @@ ... #deploy_repositories (dictionary.equivalence text.equivalence) ... #configuration - (plist.equivalence text.equivalence) + (property.equivalence text.equivalence) ... #java runtime.equivalence ... #js @@ -242,7 +242,7 @@ #program {.#None} #test {.#None} #deploy_repositories (dictionary.empty text.hash) - #configuration plist.empty + #configuration property.empty #java runtime.default_java #js runtime.default_js #python runtime.default_python @@ -270,7 +270,7 @@ #program (maybe#composite (the #program override) (the #program baseline)) #test (maybe#composite (the #test override) (the #test baseline)) #deploy_repositories (dictionary.composite (the #deploy_repositories override) (the #deploy_repositories baseline)) - #configuration (plist#composite (the #configuration override) (the #configuration baseline)) + #configuration (property#composite (the #configuration override) (the #configuration baseline)) #java (!runtime #java runtime.default_java) #js (!runtime #js runtime.default_js) #python (!runtime #python runtime.default_python) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 7f9d94809..af6864ce3 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -18,10 +18,9 @@ ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] [collection - ["[0]" list (.use "[1]#[0]" functor)] ["[0]" set (.only Set) (.use "[1]#[0]" equivalence)] - [dictionary - ["[0]" plist]]]] + ["[0]" list (.use "[1]#[0]" functor) + ["[0]" property]]]] ["[0]" macro (.only) [syntax (.only syntax)] ["^" pattern] @@ -1135,7 +1134,7 @@ (function (_ is? name) (|> captured/2 (the .#mappings) - (plist.value name) + (property.value name) (maybe#each (|>> product.right is?)) (maybe.else false)))) diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 83351d7c1..f1fa1792e 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -1,17 +1,17 @@ (.require [library - [lux (.except) + [lux (.except list) ["_" test (.only Test)]]] ["[0]" / ["[1][0]" array] ["[1][0]" bits] - ["[1][0]" list] ["[1][0]" sequence] ["[1][0]" stream] ["[1][0]" stack] + ["[1][0]" list (.only) + ["[1]/[0]" property]] ["[1][0]" dictionary (.only) - ["[1]/[0]" ordered] - ["[1]/[0]" plist]] + ["[1]/[0]" ordered]] ["[1][0]" queue (.only) ["[1]/[0]" priority]] ["[1][0]" set (.only) @@ -21,12 +21,18 @@ ["[1]/[0]" finger] ["[1]/[0]" zipper]]]) +(def list + Test + (all _.and + /list.test + /list/property.test + )) + (def dictionary Test (all _.and /dictionary.test /dictionary/ordered.test - /dictionary/plist.test )) (def queue @@ -57,10 +63,10 @@ (all _.and /array.test /bits.test - /list.test /sequence.test /stream.test /stack.test + ..list ..dictionary ..queue ..set diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux deleted file mode 100644 index 4b83ece89..000000000 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ /dev/null @@ -1,97 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" monoid]]] - [control - ["[0]" maybe (.use "[1]#[0]" monad)]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)] - ["[0]" text] - [collection - ["[0]" set] - ["[0]" list]]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) - -(def .public (random size gen_key gen_value) - (All (_ v) - (-> Nat (Random Text) (Random v) (Random (/.PList v)))) - (do random.monad - [keys (random.set text.hash size gen_key) - values (random.list size gen_value)] - (in (list.zipped_2 (set.list keys) values)))) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.PList]) - (do [! random.monad] - [.let [gen_key (random.alphabetic 10)] - size (at ! each (n.% 100) random.nat) - sample (..random size gen_key random.nat) - - .let [keys (|> sample /.keys (set.of_list text.hash))] - extra_key (random.only (|>> (set.member? keys) not) - gen_key) - extra_value random.nat - shift random.nat] - (all _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) - (..random size gen_key random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) - /.monoid - (..random 10 (random.lower_case 1) random.nat))) - - (_.coverage [/.size] - (n.= size (/.size sample))) - (_.coverage [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.coverage [/.empty] - (/.empty? /.empty)) - (_.coverage [/.keys /.values] - (at (/.equivalence n.equivalence) = - sample - (list.zipped_2 (/.keys sample) - (/.values sample)))) - (_.coverage [/.contains?] - (and (list.every? (function (_ key) - (/.contains? key sample)) - (/.keys sample)) - (not (/.contains? extra_key sample)))) - (_.coverage [/.has] - (let [sample+ (/.has extra_key extra_value sample)] - (and (not (/.contains? extra_key sample)) - (/.contains? extra_key sample+) - (n.= (++ (/.size sample)) - (/.size sample+))))) - (_.coverage [/.value] - (|> sample - (/.has extra_key extra_value) - (/.value extra_key) - (maybe#each (n.= extra_value)) - (maybe.else false))) - (_.coverage [/.revised] - (|> sample - (/.has extra_key extra_value) - (/.revised extra_key (n.+ shift)) - (/.value extra_key) - (maybe#each (n.= (n.+ shift extra_value))) - (maybe.else false))) - (_.coverage [/.lacks] - (|> sample - (/.has extra_key extra_value) - (/.lacks extra_key) - (at (/.equivalence n.equivalence) = sample))) - )))) diff --git a/stdlib/source/test/lux/data/collection/list/property.lux b/stdlib/source/test/lux/data/collection/list/property.lux new file mode 100644 index 000000000..d8ae753ef --- /dev/null +++ b/stdlib/source/test/lux/data/collection/list/property.lux @@ -0,0 +1,97 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" monoid]]] + [control + ["[0]" maybe (.use "[1]#[0]" monad)]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text] + [collection + ["[0]" set] + ["[0]" list]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def .public (random size gen_key gen_value) + (All (_ v) + (-> Nat (Random Text) (Random v) (Random (/.List v)))) + (do random.monad + [keys (random.set text.hash size gen_key) + values (random.list size gen_value)] + (in (list.zipped_2 (set.list keys) values)))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.List]) + (do [! random.monad] + [.let [gen_key (random.alphabetic 10)] + size (at ! each (n.% 100) random.nat) + sample (..random size gen_key random.nat) + + .let [keys (|> sample /.keys (set.of_list text.hash))] + extra_key (random.only (|>> (set.member? keys) not) + gen_key) + extra_value random.nat + shift random.nat] + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (..random size gen_key random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) + /.monoid + (..random 10 (random.lower_case 1) random.nat))) + + (_.coverage [/.size] + (n.= size (/.size sample))) + (_.coverage [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.coverage [/.empty] + (/.empty? /.empty)) + (_.coverage [/.keys /.values] + (at (/.equivalence n.equivalence) = + sample + (list.zipped_2 (/.keys sample) + (/.values sample)))) + (_.coverage [/.contains?] + (and (list.every? (function (_ key) + (/.contains? key sample)) + (/.keys sample)) + (not (/.contains? extra_key sample)))) + (_.coverage [/.has] + (let [sample+ (/.has extra_key extra_value sample)] + (and (not (/.contains? extra_key sample)) + (/.contains? extra_key sample+) + (n.= (++ (/.size sample)) + (/.size sample+))))) + (_.coverage [/.value] + (|> sample + (/.has extra_key extra_value) + (/.value extra_key) + (maybe#each (n.= extra_value)) + (maybe.else false))) + (_.coverage [/.revised] + (|> sample + (/.has extra_key extra_value) + (/.revised extra_key (n.+ shift)) + (/.value extra_key) + (maybe#each (n.= (n.+ shift extra_value))) + (maybe.else false))) + (_.coverage [/.lacks] + (|> sample + (/.has extra_key extra_value) + (/.lacks extra_key) + (at (/.equivalence n.equivalence) = sample))) + )))) diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux index b86a299b8..74d66e29c 100644 --- a/stdlib/source/test/lux/macro/local.lux +++ b/stdlib/source/test/lux/macro/local.lux @@ -13,9 +13,8 @@ [text ["%" \\format]] [collection - ["[0]" list] - [dictionary - ["[0]" plist]]]] + ["[0]" list + ["[0]" property]]]] ["[0]" macro (.only) [syntax (.only syntax)] ["[0]" code (.only) @@ -60,9 +59,9 @@ [module short] (meta.normal name) _ (if pre_remove (let [remove_macro! (is (-> .Module .Module) - (revised .#definitions (plist.lacks short)))] + (revised .#definitions (property.lacks short)))] (function (_ lux) - {try.#Success [(revised .#modules (plist.revised module remove_macro!) lux) + {try.#Success [(revised .#modules (property.revised module remove_macro!) lux) []]})) (in []))] (let [pre_expansion (` (let [(~ g!output) (~ body)] -- cgit v1.2.3