From abc5c5293603229b447b8b5dfa7f3275571ad982 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 15 Dec 2020 22:05:05 -0400 Subject: Compiling "lux syntax char case!" with TABLESWITCH instead of LOOKUPSWITCH. --- stdlib/source/lux/control/concurrency/frp.lux | 2 +- stdlib/source/lux/data/collection/tree/finger.lux | 23 ++ stdlib/source/lux/data/maybe.lux | 15 +- stdlib/source/lux/data/text/unicode.lux | 454 +++++++-------------- stdlib/source/lux/data/text/unicode/segment.lux | 204 +++++++++ .../source/program/aedifex/artifact/extension.lux | 8 +- .../source/program/aedifex/metadata/snapshot.lux | 286 +++++++++++++ stdlib/source/test/aedifex/artifact/type.lux | 14 +- stdlib/source/test/aedifex/metadata.lux | 2 + stdlib/source/test/aedifex/metadata/snapshot.lux | 84 ++++ stdlib/source/test/lux/control/concurrency/frp.lux | 24 +- stdlib/source/test/lux/control/parser/text.lux | 31 +- .../test/lux/data/collection/tree/finger.lux | 18 +- stdlib/source/test/lux/data/format/tar.lux | 11 +- stdlib/source/test/lux/data/text.lux | 4 +- stdlib/source/test/lux/data/text/regex.lux | 72 ++-- stdlib/source/test/lux/data/text/unicode.lux | 91 +++++ .../source/test/lux/data/text/unicode/segment.lux | 211 ++++++++++ 18 files changed, 1156 insertions(+), 398 deletions(-) create mode 100644 stdlib/source/lux/data/text/unicode/segment.lux create mode 100644 stdlib/source/program/aedifex/metadata/snapshot.lux create mode 100644 stdlib/source/test/aedifex/metadata/snapshot.lux create mode 100644 stdlib/source/test/lux/data/text/unicode.lux create mode 100644 stdlib/source/test/lux/data/text/unicode/segment.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index 4709a0cad..aea0b082a 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -161,7 +161,7 @@ (recur tail) #.None - (recur tail)) + (wrap [])) #.None (wrap []))))) diff --git a/stdlib/source/lux/data/collection/tree/finger.lux b/stdlib/source/lux/data/collection/tree/finger.lux index c3e20ce08..c18ff7251 100644 --- a/stdlib/source/lux/data/collection/tree/finger.lux +++ b/stdlib/source/lux/data/collection/tree/finger.lux @@ -3,6 +3,9 @@ [abstract [predicate (#+ Predicate)] ["." monoid (#+ Monoid)]] + [data + [collection + ["." list ("#\." monoid)]]] [type (#+ :by-example) [abstract (#+ abstract: :abstraction :representation)]]]) @@ -55,6 +58,26 @@ (0 #1 [left right]) (value left))) + (def: #export (tags tree) + (All [@ t v] (-> (Tree @ t v) (List t))) + (case (get@ #root (:representation tree)) + (0 #0 value) + (list (get@ #tag (:representation tree))) + + (0 #1 [left right]) + (list\compose (tags left) + (tags right)))) + + (def: #export (values tree) + (All [@ t v] (-> (Tree @ t v) (List v))) + (case (get@ #root (:representation tree)) + (0 #0 value) + (list value) + + (0 #1 [left right]) + (list\compose (values left) + (values right)))) + (def: #export (search predicate tree) (All [@ t v] (-> (Predicate t) (Tree @ t v) (Maybe v))) (let [[monoid tag root] (:representation tree)] diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 7b6f3ace4..6584eaf6a 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -125,14 +125,13 @@ +20)} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [location.dummy (#.Identifier ["" ""])]) - code (` (case (~ maybe) - (#.Some (~ g!temp)) - (~ g!temp) - - #.None - (~ else)))] - (#.Right [state (list code)])) + (let [g!temp (: Code [location.dummy (#.Identifier ["" ""])])] + (#.Right [state (list (` (case (~ maybe) + (#.Some (~ g!temp)) + (~ g!temp) + + #.None + (~ else))))])) _ (#.Left "Wrong syntax for default"))) diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux index 00c67f2c1..2aad089b9 100644 --- a/stdlib/source/lux/data/text/unicode.lux +++ b/stdlib/source/lux/data/text/unicode.lux @@ -1,196 +1,21 @@ (.module: [lux #* [abstract - [monoid (#+ Monoid)] - ["." interval (#+ Interval)]] + [equivalence (#+ Equivalence)]] [data - [number (#+ hex) - ["n" nat ("#\." interval)]] [collection ["." list ("#\." fold functor)] + ["." set ("#\." equivalence)] ["." tree #_ ["#" finger (#+ Tree)]]]] [type (#+ :by-example) abstract]] - [// (#+ Char)]) - -(abstract: #export Segment - (Interval Char) - - (structure: monoid - (Monoid Segment) - - (def: identity - (:abstraction (interval.between n.enum n\top n\bottom))) - (def: (compose left right) - (let [left (:representation left) - right (:representation right)] - (:abstraction - (interval.between n.enum - (n.min (\ left bottom) - (\ right bottom)) - (n.max (\ left top) - (\ right top))))))) - - (def: #export (segment start end) - (-> Char Char Segment) - (:abstraction (interval.between n.enum (n.min start end) (n.max start end)))) - - (template [ ] - [(def: #export - (-> Segment Char) - (|>> :representation (get@ )))] - - [start #interval.bottom] - [end #interval.top] - ) - - (def: #export (size segment) - (-> Segment Nat) - (let [start (get@ #interval.bottom (:representation segment)) - end (get@ #interval.top (:representation segment))] - (|> end (n.- start) inc))) - - (def: #export (within? segment char) - (All [a] (-> Segment Char Bit)) - (interval.within? (:representation segment) char)) - ) - -(template [ ] - [(def: #export Segment (..segment (hex ) (hex )))] - - ## Normal segments - [basic-latin "0000" "007F"] - [latin-1-supplement "00A0" "00FF"] - [latin-extended-a "0100" "017F"] - [latin-extended-b "0180" "024F"] - [ipa-extensions "0250" "02AF"] - [spacing-modifier-letters "02B0" "02FF"] - [combining-diacritical-marks "0300" "036F"] - [greek-and-coptic "0370" "03FF"] - [cyrillic "0400" "04FF"] - [cyrillic-supplementary "0500" "052F"] - [armenian "0530" "058F"] - [hebrew "0590" "05FF"] - [arabic "0600" "06FF"] - [syriac "0700" "074F"] - [thaana "0780" "07BF"] - [devanagari "0900" "097F"] - [bengali "0980" "09FF"] - [gurmukhi "0A00" "0A7F"] - [gujarati "0A80" "0AFF"] - [oriya "0B00" "0B7F"] - [tamil "0B80" "0BFF"] - [telugu "0C00" "0C7F"] - [kannada "0C80" "0CFF"] - [malayalam "0D00" "0D7F"] - [sinhala "0D80" "0DFF"] - [thai "0E00" "0E7F"] - [lao "0E80" "0EFF"] - [tibetan "0F00" "0FFF"] - [myanmar "1000" "109F"] - [georgian "10A0" "10FF"] - [hangul-jamo "1100" "11FF"] - [ethiopic "1200" "137F"] - [cherokee "13A0" "13FF"] - [unified-canadian-aboriginal-syllabics "1400" "167F"] - [ogham "1680" "169F"] - [runic "16A0" "16FF"] - [tagalog "1700" "171F"] - [hanunoo "1720" "173F"] - [buhid "1740" "175F"] - [tagbanwa "1760" "177F"] - [khmer "1780" "17FF"] - [mongolian "1800" "18AF"] - [limbu "1900" "194F"] - [tai-le "1950" "197F"] - [khmer-symbols "19E0" "19FF"] - [phonetic-extensions "1D00" "1D7F"] - [latin-extended-additional "1E00" "1EFF"] - [greek-extended "1F00" "1FFF"] - [general-punctuation "2000" "206F"] - [superscripts-and-subscripts "2070" "209F"] - [currency-symbols "20A0" "20CF"] - [combining-diacritical-marks-for-symbols "20D0" "20FF"] - [letterlike-symbols "2100" "214F"] - [number-forms "2150" "218F"] - [arrows "2190" "21FF"] - [mathematical-operators "2200" "22FF"] - [miscellaneous-technical "2300" "23FF"] - [control-pictures "2400" "243F"] - [optical-character-recognition "2440" "245F"] - [enclosed-alphanumerics "2460" "24FF"] - [box-drawing "2500" "257F"] - [block-elements "2580" "259F"] - [geometric-shapes "25A0" "25FF"] - [miscellaneous-symbols "2600" "26FF"] - [dingbats "2700" "27BF"] - [miscellaneous-mathematical-symbols-a "27C0" "27EF"] - [supplemental-arrows-a "27F0" "27FF"] - [braille-patterns "2800" "28FF"] - [supplemental-arrows-b "2900" "297F"] - [miscellaneous-mathematical-symbols-b "2980" "29FF"] - [supplemental-mathematical-operators "2A00" "2AFF"] - [miscellaneous-symbols-and-arrows "2B00" "2BFF"] - [cjk-radicals-supplement "2E80" "2EFF"] - [kangxi-radicals "2F00" "2FDF"] - [ideographic-description-characters "2FF0" "2FFF"] - [cjk-symbols-and-punctuation "3000" "303F"] - [hiragana "3040" "309F"] - [katakana "30A0" "30FF"] - [bopomofo "3100" "312F"] - [hangul-compatibility-jamo "3130" "318F"] - [kanbun "3190" "319F"] - [bopomofo-extended "31A0" "31BF"] - [katakana-phonetic-extensions "31F0" "31FF"] - [enclosed-cjk-letters-and-months "3200" "32FF"] - [cjk-compatibility "3300" "33FF"] - [cjk-unified-ideographs-extension-a "3400" "4DBF"] - [yijing-hexagram-symbols "4DC0" "4DFF"] - [cjk-unified-ideographs "4E00" "9FFF"] - [yi-syllables "A000" "A48F"] - [yi-radicals "A490" "A4CF"] - [hangul-syllables "AC00" "D7AF"] - [high-surrogates "D800" "DB7F"] - [high-private-use-surrogates "DB80" "DBFF"] - [low-surrogates "DC00" "DFFF"] - [private-use-area "E000" "F8FF"] - [cjk-compatibility-ideographs "F900" "FAFF"] - [alphabetic-presentation-forms "FB00" "FB4F"] - [arabic-presentation-forms-a "FB50" "FDFF"] - [variation-selectors "FE00" "FE0F"] - [combining-half-marks "FE20" "FE2F"] - [cjk-compatibility-forms "FE30" "FE4F"] - [small-form-variants "FE50" "FE6F"] - [arabic-presentation-forms-b "FE70" "FEFF"] - [halfwidth-and-fullwidth-forms "FF00" "FFEF"] - [specials "FFF0" "FFFF"] - ## [linear-b-syllabary "10000" "1007F"] - ## [linear-b-ideograms "10080" "100FF"] - ## [aegean-numbers "10100" "1013F"] - ## [old-italic "10300" "1032F"] - ## [gothic "10330" "1034F"] - ## [ugaritic "10380" "1039F"] - ## [deseret "10400" "1044F"] - ## [shavian "10450" "1047F"] - ## [osmanya "10480" "104AF"] - ## [cypriot-syllabary "10800" "1083F"] - ## [byzantine-musical-symbols "1D000" "1D0FF"] - ## [musical-symbols "1D100" "1D1FF"] - ## [tai-xuan-jing-symbols "1D300" "1D35F"] - ## [mathematical-alphanumeric-symbols "1D400" "1D7FF"] - ## [cjk-unified-ideographs-extension-b "20000" "2A6DF"] - ## [cjk-compatibility-ideographs-supplement "2F800" "2FA1F"] - ## [tags "E0000" "E007F"] - - ## Specialized segments - [basic-latin/decimal "0030" "0039"] - [basic-latin/upper-alpha "0041" "005A"] - [basic-latin/lower-alpha "0061" "007A"] - ) + ["." / #_ + ["#." segment (#+ Segment)] + [// (#+ Char)]]) (def: builder - (tree.builder ..monoid)) + (tree.builder /segment.monoid)) (def: :@: (:by-example [@] @@ -218,131 +43,131 @@ (list\fold ..compose (..singleton head) (list\map ..singleton tail))) (def: half/0 - (..set [basic-latin - (list latin-1-supplement - latin-extended-a - latin-extended-b - ipa-extensions - spacing-modifier-letters - combining-diacritical-marks - greek-and-coptic - cyrillic - cyrillic-supplementary - armenian - hebrew - arabic - syriac - thaana - devanagari - bengali - gurmukhi - gujarati - oriya - tamil - telugu - kannada - malayalam - sinhala - thai - lao - tibetan - myanmar - georgian - hangul-jamo - ethiopic - cherokee - unified-canadian-aboriginal-syllabics - ogham - runic - tagalog - hanunoo - buhid - tagbanwa - khmer - mongolian - limbu - tai-le - khmer-symbols - phonetic-extensions - latin-extended-additional - greek-extended - general-punctuation - superscripts-and-subscripts - currency-symbols - combining-diacritical-marks-for-symbols - letterlike-symbols - number-forms - arrows - mathematical-operators - miscellaneous-technical - control-pictures - optical-character-recognition - enclosed-alphanumerics - box-drawing + (..set [/segment.basic-latin + (list /segment.latin-1-supplement + /segment.latin-extended-a + /segment.latin-extended-b + /segment.ipa-extensions + /segment.spacing-modifier-letters + /segment.combining-diacritical-marks + /segment.greek-and-coptic + /segment.cyrillic + /segment.cyrillic-supplementary + /segment.armenian + /segment.hebrew + /segment.arabic + /segment.syriac + /segment.thaana + /segment.devanagari + /segment.bengali + /segment.gurmukhi + /segment.gujarati + /segment.oriya + /segment.tamil + /segment.telugu + /segment.kannada + /segment.malayalam + /segment.sinhala + /segment.thai + /segment.lao + /segment.tibetan + /segment.myanmar + /segment.georgian + /segment.hangul-jamo + /segment.ethiopic + /segment.cherokee + /segment.unified-canadian-aboriginal-syllabics + /segment.ogham + /segment.runic + /segment.tagalog + /segment.hanunoo + /segment.buhid + /segment.tagbanwa + /segment.khmer + /segment.mongolian + /segment.limbu + /segment.tai-le + /segment.khmer-symbols + /segment.phonetic-extensions + /segment.latin-extended-additional + /segment.greek-extended + /segment.general-punctuation + /segment.superscripts-and-subscripts + /segment.currency-symbols + /segment.combining-diacritical-marks-for-symbols + /segment.letterlike-symbols + /segment.number-forms + /segment.arrows + /segment.mathematical-operators + /segment.miscellaneous-technical + /segment.control-pictures + /segment.optical-character-recognition + /segment.enclosed-alphanumerics + /segment.box-drawing )])) (def: half/1 - (..set [block-elements - (list geometric-shapes - miscellaneous-symbols - dingbats - miscellaneous-mathematical-symbols-a - supplemental-arrows-a - braille-patterns - supplemental-arrows-b - miscellaneous-mathematical-symbols-b - supplemental-mathematical-operators - miscellaneous-symbols-and-arrows - cjk-radicals-supplement - kangxi-radicals - ideographic-description-characters - cjk-symbols-and-punctuation - hiragana - katakana - bopomofo - hangul-compatibility-jamo - kanbun - bopomofo-extended - katakana-phonetic-extensions - enclosed-cjk-letters-and-months - cjk-compatibility - cjk-unified-ideographs-extension-a - yijing-hexagram-symbols - cjk-unified-ideographs - yi-syllables - yi-radicals - hangul-syllables - ## high-surrogates - ## high-private-use-surrogates - ## low-surrogates - ## private-use-area - cjk-compatibility-ideographs - alphabetic-presentation-forms - arabic-presentation-forms-a - variation-selectors - combining-half-marks - cjk-compatibility-forms - small-form-variants - arabic-presentation-forms-b - halfwidth-and-fullwidth-forms - specials - ## linear-b-syllabary - ## linear-b-ideograms - ## aegean-numbers - ## old-italic - ## gothic - ## ugaritic - ## deseret - ## shavian - ## osmanya - ## cypriot-syllabary - ## byzantine-musical-symbols - ## musical-symbols - ## tai-xuan-jing-symbols - ## mathematical-alphanumeric-symbols - ## cjk-unified-ideographs-extension-b - ## cjk-compatibility-ideographs-supplement - ## tags + (..set [/segment.block-elements + (list /segment.geometric-shapes + /segment.miscellaneous-symbols + /segment.dingbats + /segment.miscellaneous-mathematical-symbols-a + /segment.supplemental-arrows-a + /segment.braille-patterns + /segment.supplemental-arrows-b + /segment.miscellaneous-mathematical-symbols-b + /segment.supplemental-mathematical-operators + /segment.miscellaneous-symbols-and-arrows + /segment.cjk-radicals-supplement + /segment.kangxi-radicals + /segment.ideographic-description-characters + /segment.cjk-symbols-and-punctuation + /segment.hiragana + /segment.katakana + /segment.bopomofo + /segment.hangul-compatibility-jamo + /segment.kanbun + /segment.bopomofo-extended + /segment.katakana-phonetic-extensions + /segment.enclosed-cjk-letters-and-months + /segment.cjk-compatibility + /segment.cjk-unified-ideographs-extension-a + /segment.yijing-hexagram-symbols + /segment.cjk-unified-ideographs + /segment.yi-syllables + /segment.yi-radicals + /segment.hangul-syllables + ## /segment.high-surrogates + ## /segment.high-private-use-surrogates + ## /segment.low-surrogates + ## /segment.private-use-area + /segment.cjk-compatibility-ideographs + /segment.alphabetic-presentation-forms + /segment.arabic-presentation-forms-a + /segment.variation-selectors + /segment.combining-half-marks + /segment.cjk-compatibility-forms + /segment.small-form-variants + /segment.arabic-presentation-forms-b + /segment.halfwidth-and-fullwidth-forms + /segment.specials + ## /segment.linear-b-syllabary + ## /segment.linear-b-ideograms + ## /segment.aegean-numbers + ## /segment.old-italic + ## /segment.gothic + ## /segment.ugaritic + ## /segment.deseret + ## /segment.shavian + ## /segment.osmanya + ## /segment.cypriot-syllabary + ## /segment.byzantine-musical-symbols + ## /segment.musical-symbols + ## /segment.tai-xuan-jing-symbols + ## /segment.mathematical-alphanumeric-symbols + ## /segment.cjk-unified-ideographs-extension-b + ## /segment.cjk-compatibility-ideographs-supplement + ## /segment.tags )])) (def: #export full @@ -351,13 +176,13 @@ (def: #export (range set) (-> Set [Char Char]) (let [tag (tree.tag (:representation set))] - [(..start tag) - (..end tag)])) + [(/segment.start tag) + (/segment.end tag)])) (def: #export (member? set character) (-> Set Char Bit) (loop [tree (:representation set)] - (if (..within? (tree.tag tree) character) + (if (/segment.within? (tree.tag tree) character) (case (tree.root tree) (0 #0 _) true @@ -366,15 +191,22 @@ (or (recur left) (recur right))) false))) + + (structure: #export equivalence + (Equivalence Set) + + (def: (= reference subject) + (set\= (set.from-list /segment.hash (tree.tags (:representation reference))) + (set.from-list /segment.hash (tree.tags (:representation subject)))))) ) (template [ ] [(def: #export (..set ))] - [ascii [basic-latin (list)]] - [ascii/alpha [basic-latin/upper-alpha (list basic-latin/lower-alpha)]] - [ascii/alpha-num [basic-latin/upper-alpha (list basic-latin/lower-alpha basic-latin/decimal)]] - [ascii/upper-alpha [basic-latin/upper-alpha (list)]] - [ascii/lower-alpha [basic-latin/lower-alpha (list)]] + [ascii [/segment.basic-latin (list)]] + [ascii/alpha [/segment.basic-latin/upper-alpha (list /segment.basic-latin/lower-alpha)]] + [ascii/alpha-num [/segment.basic-latin/upper-alpha (list /segment.basic-latin/lower-alpha /segment.basic-latin/decimal)]] + [ascii/upper-alpha [/segment.basic-latin/upper-alpha (list)]] + [ascii/lower-alpha [/segment.basic-latin/lower-alpha (list)]] ) diff --git a/stdlib/source/lux/data/text/unicode/segment.lux b/stdlib/source/lux/data/text/unicode/segment.lux new file mode 100644 index 000000000..a2507cc1e --- /dev/null +++ b/stdlib/source/lux/data/text/unicode/segment.lux @@ -0,0 +1,204 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [hash (#+ Hash)] + [monoid (#+ Monoid)] + ["." interval (#+ Interval)]] + [data + [number (#+ hex) + ["n" nat ("#\." interval)] + ["." i64]]] + [type + abstract]] + [/// (#+ Char)]) + +(abstract: #export Segment + (Interval Char) + + (structure: #export monoid + (Monoid Segment) + + (def: identity + (:abstraction (interval.between n.enum n\top n\bottom))) + (def: (compose left right) + (let [left (:representation left) + right (:representation right)] + (:abstraction + (interval.between n.enum + (n.min (\ left bottom) + (\ right bottom)) + (n.max (\ left top) + (\ right top))))))) + + (def: #export (segment start end) + (-> Char Char Segment) + (:abstraction (interval.between n.enum (n.min start end) (n.max start end)))) + + (template [ ] + [(def: #export + (-> Segment Char) + (|>> :representation (get@ )))] + + [start #interval.bottom] + [end #interval.top] + ) + + (def: #export (size segment) + (-> Segment Nat) + (let [start (get@ #interval.bottom (:representation segment)) + end (get@ #interval.top (:representation segment))] + (|> end (n.- start) inc))) + + (def: #export (within? segment char) + (All [a] (-> Segment Char Bit)) + (interval.within? (:representation segment) char)) + ) + +(structure: #export equivalence + (Equivalence Segment) + + (def: (= reference subject) + (and (n.= (..start reference) (..start subject)) + (n.= (..end reference) (..end subject))))) + +(structure: #export hash + (Hash Segment) + + (def: &equivalence ..equivalence) + (def: (hash value) + (i64.or (i64.left-shift 32 (..start value)) + (..end value)))) + +(template [ ] + [(def: #export Segment (..segment (hex ) (hex )))] + + ## Normal segments + [basic-latin "0000" "007F"] + [latin-1-supplement "00A0" "00FF"] + [latin-extended-a "0100" "017F"] + [latin-extended-b "0180" "024F"] + [ipa-extensions "0250" "02AF"] + [spacing-modifier-letters "02B0" "02FF"] + [combining-diacritical-marks "0300" "036F"] + [greek-and-coptic "0370" "03FF"] + [cyrillic "0400" "04FF"] + [cyrillic-supplementary "0500" "052F"] + [armenian "0530" "058F"] + [hebrew "0590" "05FF"] + [arabic "0600" "06FF"] + [syriac "0700" "074F"] + [thaana "0780" "07BF"] + [devanagari "0900" "097F"] + [bengali "0980" "09FF"] + [gurmukhi "0A00" "0A7F"] + [gujarati "0A80" "0AFF"] + [oriya "0B00" "0B7F"] + [tamil "0B80" "0BFF"] + [telugu "0C00" "0C7F"] + [kannada "0C80" "0CFF"] + [malayalam "0D00" "0D7F"] + [sinhala "0D80" "0DFF"] + [thai "0E00" "0E7F"] + [lao "0E80" "0EFF"] + [tibetan "0F00" "0FFF"] + [myanmar "1000" "109F"] + [georgian "10A0" "10FF"] + [hangul-jamo "1100" "11FF"] + [ethiopic "1200" "137F"] + [cherokee "13A0" "13FF"] + [unified-canadian-aboriginal-syllabics "1400" "167F"] + [ogham "1680" "169F"] + [runic "16A0" "16FF"] + [tagalog "1700" "171F"] + [hanunoo "1720" "173F"] + [buhid "1740" "175F"] + [tagbanwa "1760" "177F"] + [khmer "1780" "17FF"] + [mongolian "1800" "18AF"] + [limbu "1900" "194F"] + [tai-le "1950" "197F"] + [khmer-symbols "19E0" "19FF"] + [phonetic-extensions "1D00" "1D7F"] + [latin-extended-additional "1E00" "1EFF"] + [greek-extended "1F00" "1FFF"] + [general-punctuation "2000" "206F"] + [superscripts-and-subscripts "2070" "209F"] + [currency-symbols "20A0" "20CF"] + [combining-diacritical-marks-for-symbols "20D0" "20FF"] + [letterlike-symbols "2100" "214F"] + [number-forms "2150" "218F"] + [arrows "2190" "21FF"] + [mathematical-operators "2200" "22FF"] + [miscellaneous-technical "2300" "23FF"] + [control-pictures "2400" "243F"] + [optical-character-recognition "2440" "245F"] + [enclosed-alphanumerics "2460" "24FF"] + [box-drawing "2500" "257F"] + [block-elements "2580" "259F"] + [geometric-shapes "25A0" "25FF"] + [miscellaneous-symbols "2600" "26FF"] + [dingbats "2700" "27BF"] + [miscellaneous-mathematical-symbols-a "27C0" "27EF"] + [supplemental-arrows-a "27F0" "27FF"] + [braille-patterns "2800" "28FF"] + [supplemental-arrows-b "2900" "297F"] + [miscellaneous-mathematical-symbols-b "2980" "29FF"] + [supplemental-mathematical-operators "2A00" "2AFF"] + [miscellaneous-symbols-and-arrows "2B00" "2BFF"] + [cjk-radicals-supplement "2E80" "2EFF"] + [kangxi-radicals "2F00" "2FDF"] + [ideographic-description-characters "2FF0" "2FFF"] + [cjk-symbols-and-punctuation "3000" "303F"] + [hiragana "3040" "309F"] + [katakana "30A0" "30FF"] + [bopomofo "3100" "312F"] + [hangul-compatibility-jamo "3130" "318F"] + [kanbun "3190" "319F"] + [bopomofo-extended "31A0" "31BF"] + [katakana-phonetic-extensions "31F0" "31FF"] + [enclosed-cjk-letters-and-months "3200" "32FF"] + [cjk-compatibility "3300" "33FF"] + [cjk-unified-ideographs-extension-a "3400" "4DBF"] + [yijing-hexagram-symbols "4DC0" "4DFF"] + [cjk-unified-ideographs "4E00" "9FFF"] + [yi-syllables "A000" "A48F"] + [yi-radicals "A490" "A4CF"] + [hangul-syllables "AC00" "D7AF"] + [high-surrogates "D800" "DB7F"] + [high-private-use-surrogates "DB80" "DBFF"] + [low-surrogates "DC00" "DFFF"] + [private-use-area "E000" "F8FF"] + [cjk-compatibility-ideographs "F900" "FAFF"] + [alphabetic-presentation-forms "FB00" "FB4F"] + [arabic-presentation-forms-a "FB50" "FDFF"] + [variation-selectors "FE00" "FE0F"] + [combining-half-marks "FE20" "FE2F"] + [cjk-compatibility-forms "FE30" "FE4F"] + [small-form-variants "FE50" "FE6F"] + [arabic-presentation-forms-b "FE70" "FEFF"] + [halfwidth-and-fullwidth-forms "FF00" "FFEF"] + [specials "FFF0" "FFFF"] + ## [linear-b-syllabary "10000" "1007F"] + ## [linear-b-ideograms "10080" "100FF"] + ## [aegean-numbers "10100" "1013F"] + ## [old-italic "10300" "1032F"] + ## [gothic "10330" "1034F"] + ## [ugaritic "10380" "1039F"] + ## [deseret "10400" "1044F"] + ## [shavian "10450" "1047F"] + ## [osmanya "10480" "104AF"] + ## [cypriot-syllabary "10800" "1083F"] + ## [byzantine-musical-symbols "1D000" "1D0FF"] + ## [musical-symbols "1D100" "1D1FF"] + ## [tai-xuan-jing-symbols "1D300" "1D35F"] + ## [mathematical-alphanumeric-symbols "1D400" "1D7FF"] + ## [cjk-unified-ideographs-extension-b "20000" "2A6DF"] + ## [cjk-compatibility-ideographs-supplement "2F800" "2FA1F"] + ## [tags "E0000" "E007F"] + + ## Specialized segments + [basic-latin/decimal "0030" "0039"] + [basic-latin/upper-alpha "0041" "005A"] + [basic-latin/lower-alpha "0061" "007A"] + ) diff --git a/stdlib/source/program/aedifex/artifact/extension.lux b/stdlib/source/program/aedifex/artifact/extension.lux index 78939260a..e108a3727 100644 --- a/stdlib/source/program/aedifex/artifact/extension.lux +++ b/stdlib/source/program/aedifex/artifact/extension.lux @@ -1,7 +1,7 @@ (.module: - [lux #* + [lux (#- type) [data - [text + ["." text ["%" format (#+ format)]]] [macro ["." template]]] @@ -18,6 +18,10 @@ (-> //.Type Extension) (|>> (format ..separator))) +(def: #export type + (-> Extension //.Type) + (text.replace-all ..separator "")) + (template [] [(def: #export Extension diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux new file mode 100644 index 000000000..a94ac33c4 --- /dev/null +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -0,0 +1,286 @@ +(.module: + [lux (#- Name Type) + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)]] + [control + ["." exception (#+ exception:)] + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [format + ["." xml (#+ XML)]] + [collection + ["." list ("#\." functor)]]] + ["." time (#+ Time) + ["." instant (#+ Instant)] + ["." date (#+ Date)] + ["." year] + ["." month]]] + ["." /// #_ + ["#." artifact (#+ Group Name Version Artifact) + ["#/." type (#+ Type)]]]) + +(def: snapshot + "SNAPSHOT") + +(type: #export Time-Stamp + Instant) + +(type: #export Build + Nat) + +(type: #export Versioning + {#time-stamp Time-Stamp + #build Build + #snapshot (List Type)}) + +(type: #export Value + [Version Time-Stamp Build]) + +(type: #export Metadata + {#group Group + #name Name + #version Version + #versioning Versioning}) + +(def: (pad value) + (-> Nat Text) + (if (n.< 10 value) + (format "0" (%.nat value)) + (%.nat value))) + +(def: (date-format value) + (%.Format Date) + (format (|> value date.year year.value .nat %.nat) + (|> value date.month month.number ..pad) + (|> value date.day-of-month ..pad))) + +(def: (time-format value) + (%.Format Time) + (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] + (format (..pad hour) + (..pad minute) + (..pad second)))) + +(def: (instant-format value) + (%.Format Instant) + (format (..date-format (instant.date value)) + (..time-format (instant.time value)))) + +(template [ ] + [(def: + )] + + ["." time-stamp-separator] + ["-" value-separator] + ) + +(def: (time-stamp-format value) + (%.Format Time-Stamp) + (format (..date-format (instant.date value)) + ..time-stamp-separator + (..time-format (instant.time value)))) + +(def: (value-format [version time-stamp build]) + (%.Format Value) + (format (text.replace-all ..snapshot + (..time-stamp-format time-stamp) + version) + ..value-separator + (%.nat build))) + +(template [ ] + [(def: xml.Tag ["" ])] + + [ "groupId"] + [ "artifactId"] + [ "version"] + [ "lastUpdated"] + [ "metadata"] + [ "versioning"] + [ "snapshot"] + [ "timestamp"] + [ "buildNumber"] + [ "snapshotVersions"] + [ "snapshotVersion"] + [ "extension"] + [ "value"] + [ "updated"] + ) + +(template [ 
]
+  [(def: 
+     (->  XML)
+     (|>> 
 #xml.Text list (#xml.Node  xml.attributes)))]
+
+  [write-group Group .. (|>)]
+  [write-name Name .. (|>)]
+  [write-version Version .. (|>)]
+  [write-last-updated Instant .. ..instant-format]
+  [write-time-stamp Instant .. ..time-stamp-format]
+  [write-build-number Nat .. %.nat]
+  [write-extension Type .. (|>)]
+  [write-value Value .. ..value-format]
+  [write-updated Instant .. ..instant-format]
+  )
+
+(def: (write-snapshot value type)
+  (-> Value Type XML)
+  (<| (#xml.Node .. xml.attributes)
+      (list (..write-extension type)
+            (..write-value value)
+            (let [[version time-stamp build] value]
+              (..write-updated time-stamp)))))
+
+(def: (write-versioning version (^slots [#time-stamp #build #snapshot]))
+  (-> Version Versioning XML)
+  (<| (#xml.Node .. xml.attributes)
+      (list (<| (#xml.Node .. xml.attributes)
+                (list (..write-time-stamp time-stamp)
+                      (..write-build-number build)))
+            (..write-last-updated time-stamp)
+            (<| (#xml.Node .. xml.attributes)
+                (list\map (..write-snapshot [version time-stamp build])
+                          snapshot)))))
+
+(def: #export (write (^slots [#group #name #version #versioning]))
+  (-> Metadata XML)
+  (#xml.Node ..
+             xml.attributes
+             (list (..write-group group)
+                   (..write-name name)
+                   (..write-version version)
+                   (..write-versioning version versioning))))
+
+(def: (sub tag parser)
+  (All [a] (-> xml.Tag (Parser a) (Parser a)))
+  (do <>.monad
+    [_ (.node tag)]
+    (.children parser)))
+
+(def: (text tag)
+  (-> xml.Tag (Parser Text))
+  (..sub tag .text))
+
+(def: date-parser
+  (.Parser Date)
+  (do <>.monad
+    [year (<>.codec n.decimal (.exactly 4 .decimal))
+     year (<>.lift (year.year (.int year)))
+     month (<>.codec n.decimal (.exactly 2 .decimal))
+     month (<>.lift (month.by-number month))
+     day-of-month (<>.codec n.decimal (.exactly 2 .decimal))]
+    (<>.lift (date.date year month day-of-month))))
+
+(def: time-parser
+  (.Parser Time)
+  (do <>.monad
+    [hour (<>.codec n.decimal (.exactly 2 .decimal))
+     minute (<>.codec n.decimal (.exactly 2 .decimal))
+     second (<>.codec n.decimal (.exactly 2 .decimal))]
+    (<>.lift (time.time
+              {#time.hour hour
+               #time.minute minute
+               #time.second second
+               #time.milli-second 0}))))
+
+(def: last-updated-parser
+  (Parser Instant)
+  (.embed (do <>.monad
+                  [date ..date-parser
+                   time ..time-parser]
+                  (wrap (instant.from-date-time date time)))
+                (..text ..)))
+
+(def: time-stamp-parser
+  (Parser Time-Stamp)
+  (.embed (do <>.monad
+                  [date ..date-parser
+                   _ (.this ..time-stamp-separator)
+                   time ..time-parser]
+                  (wrap (instant.from-date-time date time)))
+                (..text ..)))
+
+(def: build-parser
+  (Parser Build)
+  (.embed (<>.codec n.decimal
+                          (.many .decimal))
+                (..text ..)))
+
+(exception: #export (time-stamp-mismatch {expected Time-Stamp} {actual Text})
+  (exception.report
+   ["Expected time-stamp" (instant-format expected)]
+   ["Actual time-stamp" actual]))
+
+(exception: #export (value-mismatch {expected Value} {actual Text})
+  (exception.report
+   ["Expected" (..value-format expected)]
+   ["Actual" actual]))
+
+(def: (snapshot-parser expected)
+  (-> Value (Parser Type))
+  (<| (..sub ..)
+      (do <>.monad
+        [#let [[version time-stamp build] expected]
+         updated (.somewhere (..text ..))
+         _ (<>.assert (exception.construct ..time-stamp-mismatch [time-stamp updated])
+                      (\ text.equivalence = (instant-format time-stamp) updated))
+         actual (.somewhere (..text ..))
+         _ (<>.assert (exception.construct ..value-mismatch [expected actual])
+                      (\ text.equivalence = (..value-format expected) actual))]
+        (.somewhere (..text ..)))))
+
+(def: (versioning-parser version)
+  (-> Version (Parser Versioning))
+  (<| (..sub ..)
+      (do <>.monad
+        [[time-stamp build] (<| .somewhere
+                                (..sub ..)
+                                (<>.and ..time-stamp-parser
+                                        ..build-parser))
+         last-updated (.somewhere ..last-updated-parser)
+         _ (<>.assert (exception.construct ..time-stamp-mismatch [time-stamp (instant-format last-updated)])
+                      (\ instant.equivalence = time-stamp last-updated))
+         snapshot (<| .somewhere
+                      (..sub ..)
+                      (<>.some (..snapshot-parser [version time-stamp build])))]
+        (wrap {#time-stamp time-stamp
+               #build build
+               #snapshot snapshot}))))
+
+(def: #export parser
+  (Parser Metadata)
+  (<| (..sub ..)
+      (do <>.monad
+        [group (.somewhere (..text ..))
+         name (.somewhere (..text ..))
+         version (.somewhere (..text ..))
+         versioning (.somewhere (..versioning-parser version))]
+        (wrap {#group group
+               #name name
+               #version version
+               #versioning versioning}))))
+
+(def: versioning
+  (Equivalence Versioning)
+  ($_ product.equivalence
+      instant.equivalence
+      n.equivalence
+      (list.equivalence text.equivalence)
+      ))
+
+(def: #export equivalence
+  (Equivalence Metadata)
+  ($_ product.equivalence
+      text.equivalence
+      text.equivalence
+      text.equivalence
+      ..versioning
+      ))
diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux
index 84807a8c6..5dc1b9caa 100644
--- a/stdlib/source/test/aedifex/artifact/type.lux
+++ b/stdlib/source/test/aedifex/artifact/type.lux
@@ -11,10 +11,22 @@
      ["." set]
      ["." list]]]
    [math
-    ["." random (#+ Random)]]]
+    ["." random (#+ Random) ("#\." monad)]]]
   {#program
    ["." /]})
 
+(def: #export random
+  (Random /.Type)
+  ($_ random.either
+      ($_ random.either
+          (random\wrap /.lux-library)
+          (random\wrap /.jvm-library))
+      ($_ random.either
+          (random\wrap /.pom)
+          (random\wrap /.md5)
+          (random\wrap /.sha-1))
+      ))
+
 (def: #export test
   Test
   (<| (_.covering /._)
diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux
index 5b8b47b00..6a1ac503a 100644
--- a/stdlib/source/test/aedifex/metadata.lux
+++ b/stdlib/source/test/aedifex/metadata.lux
@@ -9,6 +9,7 @@
     ["." random]]]
   ["." / #_
    ["#." artifact]
+   ["#." snapshot]
    [//
     ["@." artifact]]]
   {#program
@@ -29,4 +30,5 @@
                     )))
 
           /artifact.test
+          /snapshot.test
           )))
diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux
new file mode 100644
index 000000000..e17765038
--- /dev/null
+++ b/stdlib/source/test/aedifex/metadata/snapshot.lux
@@ -0,0 +1,84 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [control
+    ["." try ("#\." functor)]
+    [parser
+     ["<.>" xml]]]
+   [data
+    [number
+     ["n" nat]]]
+   ["." time
+    ["." date]
+    ["." year]
+    ["." month]
+    ["." instant (#+ Instant)]
+    ["." duration]]
+   [math
+    ["." random (#+ Random)]]
+   [macro
+    ["." code]]]
+  ["$." /// #_
+   [artifact
+    ["#." type]]]
+  {#program
+   ["." /]})
+
+(def: random-instant
+  (Random Instant)
+  (do {! random.monad}
+    [year (\ ! map (|>> (n.% 10,000) .int) random.nat)
+     month (\ ! map (n.% 13) random.nat)
+     day-of-month (\ ! map (n.% 29) random.nat)
+     hour (\ ! map (n.% 24) random.nat)
+     minute (\ ! map (n.% 60) random.nat)
+     second (\ ! map (n.% 60) random.nat)]
+    (wrap (try.assume
+           (do try.monad
+             [year (year.year year)
+              month (month.by-number month)
+              date (date.date year month day-of-month)
+              time (time.time
+                    {#time.hour hour
+                     #time.minute minute
+                     #time.second second
+                     #time.milli-second 0})]
+             (wrap (instant.from-date-time date time)))))))
+
+(def: random-versioning
+  (Random /.Versioning)
+  ($_ random.and
+      ..random-instant
+      random.nat
+      (random.list 5 $///type.random)
+      ))
+
+(def: #export random
+  (Random /.Metadata)
+  ($_ random.and
+      (random.ascii/alpha 5)
+      (random.ascii/alpha 5)
+      (random.ascii/alpha 5)
+      ..random-versioning))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Metadata])
+      ($_ _.and
+          (_.for [/.equivalence]
+                 ($equivalence.spec /.equivalence ..random))
+          (do random.monad
+            [expected ..random]
+            (_.cover [/.write /.parser]
+                     (|> expected
+                         /.write
+                         (.run /.parser)
+                         (try\map (\ /.equivalence = expected))
+                         (try.default false))))
+          )))
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 709c756a2..3e0aee4f0 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -127,24 +127,20 @@
                              channel (/.sequential 0 (list\compose inputs inputs))]
                        _ (promise.future (/.subscribe (function (_ value)
                                                         (do {! io.monad}
-                                                          [current (atom.read sink)]
-                                                          (if (n.< (list.size inputs)
-                                                                   (row.size current))
-                                                            (do !
-                                                              [_ (atom.update (row.add value) sink)]
-                                                              (wrap (#.Some [])))
-                                                            (wrap (#.Some [])))))
+                                                          [current (atom.read sink)
+                                                           _ (atom.update (row.add value) sink)]
+                                                          (wrap (if (n.< (list.size inputs)
+                                                                         (inc (row.size current)))
+                                                                  (#.Some [])
+                                                                  #.None))))
                                                       channel))
-                       output (/.consume channel)
+                       _ (/.consume channel)
                        listened (|> sink
                                     atom.read
                                     promise.future
                                     (\ ! map row.to-list))]
                       (_.cover' [/.Subscriber /.subscribe]
-                                (and (list\= inputs
-                                             output)
-                                     (list\= output
-                                             listened)))))
+                                (list\= inputs listened))))
               (wrap (do promise.monad
                       [actual (/.fold (function (_ input total)
                                         (promise.resolved (n.+ input total)))
@@ -173,9 +169,9 @@
                       (_.cover' [/.distinct]
                                 (list\= (list distint/0 distint/1 distint/2)
                                         actual))))
-              (let [polling-delay 10
-                    wiggle-room (n.* 5 polling-delay)
+              (let [polling-delay 1
                     amount-of-polls 5
+                    wiggle-room ($_ n.* amount-of-polls 2 polling-delay)
                     total-delay (|> polling-delay
                                     (n.* amount-of-polls)
                                     (n.+ wiggle-room))]
diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux
index 5a2245401..7c1f5d932 100644
--- a/stdlib/source/test/lux/control/parser/text.lux
+++ b/stdlib/source/test/lux/control/parser/text.lux
@@ -10,8 +10,9 @@
    [data
     ["." maybe]
     ["." text ("#\." equivalence)
-     ["." unicode]
-     ["%" format (#+ format)]]
+     ["%" format (#+ format)]
+     ["." unicode
+      ["#/." segment]]]
     [number
      ["n" nat]]
     [collection
@@ -81,41 +82,41 @@
                       (..should-fail out-of-range (/.range offset limit)))))
       (do {! random.monad}
         [expected (random.char unicode.ascii/upper-alpha)
-         invalid (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) not)
+         invalid (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/upper-alpha) not)
                                 (random.char unicode.full))]
         (_.cover [/.upper]
                  (and (..should-pass (text.from-code expected) /.upper)
                       (..should-fail (text.from-code invalid) /.upper))))
       (do {! random.monad}
         [expected (random.char unicode.ascii/lower-alpha)
-         invalid (random.filter (|>> (unicode.within? unicode.basic-latin/lower-alpha) not)
+         invalid (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/lower-alpha) not)
                                 (random.char unicode.full))]
         (_.cover [/.lower]
                  (and (..should-pass (text.from-code expected) /.lower)
                       (..should-fail (text.from-code invalid) /.lower))))
       (do {! random.monad}
         [expected (\ ! map (n.% 10) random.nat)
-         invalid (random.char (unicode.set [unicode.number-forms (list)]))]
+         invalid (random.char (unicode.set [unicode/segment.number-forms (list)]))]
         (_.cover [/.decimal]
                  (and (..should-pass (\ n.decimal encode expected) /.decimal)
                       (..should-fail (text.from-code invalid) /.decimal))))
       (do {! random.monad}
         [expected (\ ! map (n.% 8) random.nat)
-         invalid (random.char (unicode.set [unicode.number-forms (list)]))]
+         invalid (random.char (unicode.set [unicode/segment.number-forms (list)]))]
         (_.cover [/.octal]
                  (and (..should-pass (\ n.octal encode expected) /.octal)
                       (..should-fail (text.from-code invalid) /.octal))))
       (do {! random.monad}
         [expected (\ ! map (n.% 16) random.nat)
-         invalid (random.char (unicode.set [unicode.number-forms (list)]))]
+         invalid (random.char (unicode.set [unicode/segment.number-forms (list)]))]
         (_.cover [/.hexadecimal]
                  (and (..should-pass (\ n.hex encode expected) /.hexadecimal)
                       (..should-fail (text.from-code invalid) /.hexadecimal))))
       (do {! random.monad}
         [expected (random.char unicode.ascii/alpha)
          invalid (random.filter (function (_ char)
-                                  (not (or (unicode.within? unicode.basic-latin/upper-alpha char)
-                                           (unicode.within? unicode.basic-latin/lower-alpha char))))
+                                  (not (or (unicode/segment.within? unicode/segment.basic-latin/upper-alpha char)
+                                           (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char))))
                                 (random.char unicode.full))]
         (_.cover [/.alpha]
                  (and (..should-pass (text.from-code expected) /.alpha)
@@ -123,9 +124,9 @@
       (do {! random.monad}
         [expected (random.char unicode.ascii/alpha-num)
          invalid (random.filter (function (_ char)
-                                  (not (or (unicode.within? unicode.basic-latin/upper-alpha char)
-                                           (unicode.within? unicode.basic-latin/lower-alpha char)
-                                           (unicode.within? unicode.basic-latin/decimal char))))
+                                  (not (or (unicode/segment.within? unicode/segment.basic-latin/upper-alpha char)
+                                           (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char)
+                                           (unicode/segment.within? unicode/segment.basic-latin/decimal char))))
                                 (random.char unicode.full))]
         (_.cover [/.alpha-num]
                  (and (..should-pass (text.from-code expected) /.alpha-num)
@@ -394,7 +395,7 @@
                                           (text\= expected actual))))))
           (do {! random.monad}
             [invalid (random.ascii/upper-alpha 1)
-             expected (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha)
+             expected (random.filter (|>> (unicode/segment.within? unicode/segment.basic-latin/upper-alpha)
                                           not)
                                      (random.char unicode.full))
              #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]]
@@ -414,8 +415,8 @@
             [upper (random.ascii/upper-alpha 1)
              lower (random.ascii/lower-alpha 1)
              invalid (random.filter (function (_ char)
-                                      (not (or (unicode.within? unicode.basic-latin/upper-alpha char)
-                                               (unicode.within? unicode.basic-latin/lower-alpha char))))
+                                      (not (or (unicode/segment.within? unicode/segment.basic-latin/upper-alpha char)
+                                               (unicode/segment.within? unicode/segment.basic-latin/lower-alpha char))))
                                     (random.char unicode.full))
              #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
                    lower! (/.one-of! "abcdefghijklmnopqrstuvwxyz")]]
diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux
index 3760298f9..3c1325d4e 100644
--- a/stdlib/source/test/lux/data/collection/tree/finger.lux
+++ b/stdlib/source/test/lux/data/collection/tree/finger.lux
@@ -7,7 +7,9 @@
     ["." maybe ("#\." functor)]
     ["." text ("#\." equivalence monoid)]
     [number
-     ["n" nat]]]
+     ["n" nat]]
+    [collection
+     ["." list ("#\." fold)]]]
    [math
     ["." random]]
    [type (#+ :by-example)]]
@@ -73,6 +75,20 @@
                                (/.value (\ ..builder branch
                                            (\ ..builder leaf tag-left expected-left)
                                            (\ ..builder leaf tag-right expected-right))))))
+            (do random.monad
+              [#let [tags-equivalence (list.equivalence text.equivalence)
+                     values-equivalence (list.equivalence n.equivalence)]
+               tags/H (random.ascii/alpha-num 1)
+               tags/T (random.list 5 (random.ascii/alpha-num 1))
+               values/H random.nat
+               values/T (random.list 5 random.nat)]
+              (_.cover [/.tags /.values]
+                       (let [tree (list\fold (function (_ [tag value] tree)
+                                               (\ builder branch tree (\ builder leaf tag value)))
+                                             (\ builder leaf tags/H values/H)
+                                             (list.zip/2 tags/T values/T))]
+                         (and (\ tags-equivalence = (list& tags/H tags/T) (/.tags tree))
+                              (\ values-equivalence = (list& values/H values/T) (/.values tree))))))
             (_.cover [/.search]
                      (let [can-find-correct-one!
                            (|> (\ ..builder leaf tag-left expected-left)
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
index f837c0d18..73ccec27f 100644
--- a/stdlib/source/test/lux/data/format/tar.lux
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -13,9 +13,10 @@
     ["." maybe]
     ["." binary ("#\." equivalence)]
     ["." text ("#\." equivalence)
+     ["%" format (#+ format)]
      ["." encoding]
-     ["." unicode]
-     ["%" format (#+ format)]]
+     ["." unicode
+      ["#/." segment]]]
     [number
      ["n" nat]
      ["i" int]]
@@ -38,7 +39,7 @@
          (do {! random.monad}
            [expected (random.ascii/lower-alpha /.path-size)
             invalid (random.ascii/lower-alpha (inc /.path-size))
-            not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)]))
+            not-ascii (random.text (random.char (unicode.set [unicode/segment.katakana (list)]))
                                    /.path-size)]
            (`` ($_ _.and
                    (_.cover [/.path /.from-path]
@@ -71,7 +72,7 @@
          (do {! random.monad}
            [expected (random.ascii/lower-alpha /.name-size)
             invalid (random.ascii/lower-alpha (inc /.name-size))
-            not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)]))
+            not-ascii (random.text (random.char (unicode.set [unicode/segment.katakana (list)]))
                                    /.name-size)]
            (`` ($_ _.and
                    (_.cover [/.name /.from-name]
@@ -312,7 +313,7 @@
     [path (random.ascii/lower-alpha /.path-size)
      expected (random.ascii/lower-alpha /.name-size)
      invalid (random.ascii/lower-alpha (inc /.name-size))
-     not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)]))
+     not-ascii (random.text (random.char (unicode.set [unicode/segment.katakana (list)]))
                             /.name-size)]
     (_.for [/.Ownership /.Owner /.ID]
            ($_ _.and
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index 2cf0e2cfd..b9dfdb1a9 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -23,7 +23,8 @@
    ["#." buffer]
    ["#." encoding]
    ["#." format]
-   ["#." regex]]
+   ["#." regex]
+   ["#." unicode]]
   {1
    ["." /]})
 
@@ -302,4 +303,5 @@
           /encoding.test
           /format.test
           /regex.test
+          /unicode.test
           )))
diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux
index 83d2cfcc4..f72c19030 100644
--- a/stdlib/source/test/lux/data/text/regex.lux
+++ b/stdlib/source/test/lux/data/text/regex.lux
@@ -1,8 +1,8 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
-   [abstract/monad (#+ do)]
+   [abstract
+    [monad (#+ do)]]
    [control
     pipe
     ["." try]
@@ -11,9 +11,10 @@
      ["s" code]]]
    [data
     [number (#+ hex)]
-    ["." text ("#\." equivalence)]]
+    ["." text ("#\." equivalence)
+     ["%" format (#+ format)]]]
    [math
-    ["r" random]]
+    ["." random]]
    ["." meta]
    [macro
     [syntax (#+ syntax:)]]]
@@ -57,13 +58,8 @@
                        (case> (^ (#try.Success (~ pattern)))
                               true
 
-                              (#try.Failure (~ g!message))
-                              (exec (log! (format "{{{Failure}}} " (~ g!message)))
-                                false)
-
                               (~ g!_)
-                              (exec (log! (format "{{{Success}}} " "OH NO"))
-                                false))))))))
+                              false)))))))
 
 (def: basics
   Test
@@ -273,36 +269,34 @@
                                  "123-456-7890")))
       ))
 
-(def: pattern-matching
-  Test
-  (do r.monad
-    [sample1 (r.unicode 3)
-     sample2 (r.unicode 3)
-     sample3 (r.unicode 4)]
-    (case (format sample1 "-" sample2 "-" sample3)
-      (/.^regex "(.{3})-(.{3})-(.{4})"
-                [_ match1 match2 match3])
-      (_.test "Can pattern-match using regular-expressions."
-              (and (text\= sample1 match1)
-                   (text\= sample2 match2)
-                   (text\= sample3 match3)))
-
-      _
-      (_.test "Cannot pattern-match using regular-expressions."
-              #0))))
-
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.regex)))
+  (<| (_.covering /._)
       ($_ _.and
-          ..basics
-          ..system-character-classes
-          ..special-system-character-classes
-          ..custom-character-classes
-          ..references
-          ..fuzzy-quantifiers
-          ..crisp-quantifiers
-          ..groups
-          ..alternation
-          ..pattern-matching
+          (_.for [/.regex]
+                 ($_ _.and
+                     ..basics
+                     ..system-character-classes
+                     ..special-system-character-classes
+                     ..custom-character-classes
+                     ..references
+                     ..fuzzy-quantifiers
+                     ..crisp-quantifiers
+                     ..groups
+                     ..alternation
+                     ))
+          (do random.monad
+            [sample1 (random.unicode 3)
+             sample2 (random.unicode 3)
+             sample3 (random.unicode 4)]
+            (_.cover [/.^regex]
+                     (case (format sample1 "-" sample2 "-" sample3)
+                       (/.^regex "(.{3})-(.{3})-(.{4})"
+                                 [_ match1 match2 match3])
+                       (and (text\= sample1 match1)
+                            (text\= sample2 match2)
+                            (text\= sample3 match3))
+
+                       _
+                       false)))
           )))
diff --git a/stdlib/source/test/lux/data/text/unicode.lux b/stdlib/source/test/lux/data/text/unicode.lux
new file mode 100644
index 000000000..1b47c8cdb
--- /dev/null
+++ b/stdlib/source/test/lux/data/text/unicode.lux
@@ -0,0 +1,91 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [data
+    ["." product]
+    ["." bit ("#\." equivalence)]
+    [number
+     ["n" nat]]
+    [collection
+     ["." set ("#\." equivalence)]]]
+   [math
+    ["." random (#+ Random)]]]
+  ["." / #_
+   ["#." segment]]
+  {1
+   ["." /
+    ["." segment]]})
+
+(def: #export random
+  (Random /.Set)
+  (do {! random.monad}
+    [left /segment.random
+     right /segment.random]
+    (wrap (/.set [left (list right)]))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Set])
+      (do {! random.monad}
+        [segment /segment.random
+         inside (\ ! map
+                   (|>> (n.% (segment.size segment))
+                        (n.+ (segment.start segment)))
+                   random.nat)
+         left /segment.random
+         right /segment.random
+         #let [equivalence (product.equivalence n.equivalence
+                                                n.equivalence)]]
+        (`` ($_ _.and
+                (_.for [/.equivalence]
+                       ($equivalence.spec /.equivalence ..random))
+                
+                (_.cover [/.range]
+                         (let [[start end] (/.range (/.set [left (list right)]))]
+                           (and (n.= (n.min (segment.start left)
+                                            (segment.start right))
+                                     start)
+                                (n.= (n.max (segment.end left)
+                                            (segment.end right))
+                                     end))))
+                (_.cover [/.member?]
+                         (bit\= (segment.within? segment inside)
+                                (/.member? (/.set [segment (list)]) inside)))
+                (_.cover [/.compose]
+                         (\ equivalence =
+                            [(n.min (segment.start left)
+                                    (segment.start right))
+                             (n.max (segment.end left)
+                                    (segment.end right))]
+                            (/.range (/.compose (/.set [left (list)])
+                                                (/.set [right (list)])))))
+                (_.cover [/.set]
+                         (\ equivalence =
+                            (/.range (/.compose (/.set [left (list)])
+                                                (/.set [right (list)])))
+                            (/.range (/.set [left (list right)]))))
+                (~~ (template []
+                      [(do random.monad
+                         [char (random.char )
+                          #let [[start end] (/.range )]]
+                         (_.cover []
+                                  (and (/.member?  char)
+                                       (not (/.member?  (dec start)))
+                                       (not (/.member?  (inc end))))))]
+
+                      [/.ascii]
+                      [/.ascii/alpha]
+                      [/.ascii/alpha-num]
+                      [/.ascii/lower-alpha]
+                      [/.ascii/upper-alpha]
+                      [/.full]
+                      ))
+
+                /segment.test
+                )))))
diff --git a/stdlib/source/test/lux/data/text/unicode/segment.lux b/stdlib/source/test/lux/data/text/unicode/segment.lux
new file mode 100644
index 000000000..62a399cd1
--- /dev/null
+++ b/stdlib/source/test/lux/data/text/unicode/segment.lux
@@ -0,0 +1,211 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]
+      ["$." hash]
+      ["$." monoid]]}]
+   [data
+    ["." text]
+    [number (#+ hex)
+     ["n" nat]]
+    [collection
+     ["." set]
+     ["." list]]]
+   [macro
+    ["." template]]
+   [math
+    ["." random (#+ Random)]]]
+  {1
+   ["." /]})
+
+(def: #export random
+  (Random /.Segment)
+  (do random.monad
+    [start random.nat
+     end random.nat]
+    (wrap (/.segment start end))))
+
+(with-expansions [ (as-is [segments/0
+                                     [/.basic-latin
+                                      /.latin-1-supplement
+                                      /.latin-extended-a
+                                      /.latin-extended-b
+                                      /.ipa-extensions
+                                      /.spacing-modifier-letters
+                                      /.combining-diacritical-marks
+                                      /.greek-and-coptic
+                                      /.cyrillic
+                                      /.cyrillic-supplementary
+                                      /.armenian
+                                      /.hebrew
+                                      /.arabic
+                                      /.syriac
+                                      /.thaana
+                                      /.devanagari
+                                      /.bengali
+                                      /.gurmukhi
+                                      /.gujarati
+                                      /.oriya
+                                      /.tamil
+                                      /.telugu
+                                      /.kannada
+                                      /.malayalam
+                                      /.sinhala
+                                      /.thai
+                                      /.lao
+                                      /.tibetan
+                                      /.myanmar
+                                      /.georgian
+                                      /.hangul-jamo
+                                      /.ethiopic
+                                      /.cherokee
+                                      /.unified-canadian-aboriginal-syllabics
+                                      /.ogham
+                                      /.runic
+                                      /.tagalog
+                                      /.hanunoo
+                                      /.buhid
+                                      /.tagbanwa
+                                      /.khmer
+                                      /.mongolian]]
+                                    [segments/1
+                                     [/.limbu
+                                      /.tai-le
+                                      /.khmer-symbols
+                                      /.phonetic-extensions
+                                      /.latin-extended-additional
+                                      /.greek-extended
+                                      /.general-punctuation
+                                      /.superscripts-and-subscripts
+                                      /.currency-symbols
+                                      /.combining-diacritical-marks-for-symbols
+                                      /.letterlike-symbols
+                                      /.number-forms
+                                      /.arrows
+                                      /.mathematical-operators
+                                      /.miscellaneous-technical
+                                      /.control-pictures
+                                      /.optical-character-recognition
+                                      /.enclosed-alphanumerics
+                                      /.box-drawing
+                                      /.block-elements
+                                      /.geometric-shapes
+                                      /.miscellaneous-symbols
+                                      /.dingbats
+                                      /.miscellaneous-mathematical-symbols-a
+                                      /.supplemental-arrows-a
+                                      /.braille-patterns
+                                      /.supplemental-arrows-b
+                                      /.miscellaneous-mathematical-symbols-b
+                                      /.supplemental-mathematical-operators
+                                      /.miscellaneous-symbols-and-arrows
+                                      /.cjk-radicals-supplement
+                                      /.kangxi-radicals
+                                      /.ideographic-description-characters
+                                      /.cjk-symbols-and-punctuation
+                                      /.hiragana
+                                      /.katakana
+                                      /.bopomofo
+                                      /.hangul-compatibility-jamo
+                                      /.kanbun
+                                      /.bopomofo-extended
+                                      /.katakana-phonetic-extensions
+                                      /.enclosed-cjk-letters-and-months
+                                      /.cjk-compatibility
+                                      /.cjk-unified-ideographs-extension-a
+                                      /.yijing-hexagram-symbols
+                                      /.cjk-unified-ideographs
+                                      /.yi-syllables
+                                      /.yi-radicals
+                                      /.hangul-syllables
+                                      /.high-surrogates
+                                      /.high-private-use-surrogates
+                                      /.low-surrogates
+                                      /.private-use-area
+                                      /.cjk-compatibility-ideographs
+                                      /.alphabetic-presentation-forms]]
+                                    [segments/2
+                                     [/.arabic-presentation-forms-a
+                                      /.variation-selectors
+                                      /.combining-half-marks
+                                      /.cjk-compatibility-forms
+                                      /.small-form-variants
+                                      /.arabic-presentation-forms-b
+                                      /.halfwidth-and-fullwidth-forms
+                                      /.specials
+                                      
+                                      ## Specialized segments
+                                      /.basic-latin/decimal
+                                      /.basic-latin/upper-alpha
+                                      /.basic-latin/lower-alpha]]
+                                    )
+                   (template [ ]
+                            [((: (-> Any (List /.Segment))
+                                 (function (_ _)
+                                   (`` (list (~~ (template.splice ))))))
+                              [])]
+                            
+                            )]
+  (template [ ]
+    [(def: 
+       Test
+       (`` (_.cover [(~~ (template.splice ))]
+                    (let [all (list.concat (list ))
+                          unique (set.from-list /.hash all)]
+                      (n.= (list.size all)
+                           (set.size unique))))))]
+    
+    
+    )
+
+  (def: #export test
+    Test
+    (<| (_.covering /._)
+        (_.for [/.Segment])
+        (do {! random.monad}
+          [#let [top-start (hex "AC00")
+                 top-end (hex "D7AF")]
+           start (\ ! map (|>> (n.% top-start) inc) random.nat)
+           end (\ ! map (|>> (n.% top-end) inc) random.nat)
+           #let [sample (/.segment start end)
+                 size (/.size sample)]
+           inside (\ ! map
+                     (|>> (n.% size)
+                          (n.+ (/.start sample)))
+                     random.nat)]
+          (`` ($_ _.and
+                  (_.for [/.equivalence]
+                         ($equivalence.spec /.equivalence ..random))
+                  (_.for [/.hash]
+                         ($hash.spec /.hash ..random))
+                  (_.for [/.monoid]
+                         ($monoid.spec /.equivalence /.monoid ..random))
+                  
+                  (_.cover [/.segment]
+                           (\ /.equivalence =
+                              (/.segment start end)
+                              (/.segment end start)))
+                  (_.cover [/.start]
+                           (n.= (n.min start end)
+                                (/.start (/.segment start end))))
+                  (_.cover [/.end]
+                           (n.= (n.max start end)
+                                (/.end (/.segment start end))))
+                  (_.cover [/.size]
+                           (n.= (inc (n.- (n.min start end)
+                                          (n.max start end)))
+                                (/.size (/.segment start end))))
+                  (_.cover [/.within?]
+                           (and (/.within? sample inside)
+                                (not (/.within? sample (dec (/.start sample))))
+                                (not (/.within? sample (inc (/.end sample))))))
+                  (~~ (template [ ]
+                        []
+                        
+                        ))
+                  )))))
+  )
-- 
cgit v1.2.3