From 9a835bde8908e4ebd1c8972211acadc5895d720a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 14 Jun 2022 10:17:32 -0400 Subject: De-sigil-ification: suffix : [Part 8] --- .../source/polytypic/lux/abstract/equivalence.lux | 247 ++++++------ stdlib/source/polytypic/lux/abstract/functor.lux | 173 ++++---- stdlib/source/polytypic/lux/data/format/json.lux | 446 +++++++++++---------- 3 files changed, 435 insertions(+), 431 deletions(-) (limited to 'stdlib/source/polytypic') diff --git a/stdlib/source/polytypic/lux/abstract/equivalence.lux b/stdlib/source/polytypic/lux/abstract/equivalence.lux index 119142267..03d3dd3de 100644 --- a/stdlib/source/polytypic/lux/abstract/equivalence.lux +++ b/stdlib/source/polytypic/lux/abstract/equivalence.lux @@ -35,133 +35,134 @@ ["[0]" day] ["[0]" month]] ["[0]" type (.only) - ["[0]" poly (.only poly:)] + ["[0]" poly (.only polytypic)] ["[0]" unit]]]] [\\library ["[0]" /]]) -(poly: .public equivalence - (`` (do [! <>.monad] - [.let [g!_ (code.local "_____________")] - *env* .env - inputT .next - .let [@Equivalence (is (-> Type Code) - (function (_ type) - (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]] - (all <>.either - ... Basic types - (~~ (with_template [ ] - [(do ! - [_ ] - (in (` (is (~ (@Equivalence inputT)) - ))))] +(def: .public equivalence + (polytypic equivalence + (`` (do [! <>.monad] + [.let [g!_ (code.local "_____________")] + *env* .env + inputT .next + .let [@Equivalence (is (-> Type Code) + (function (_ type) + (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]] + (all <>.either + ... Basic types + (~~ (with_template [ ] + [(do ! + [_ ] + (in (` (is (~ (@Equivalence inputT)) + ))))] - [(.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] - [(.sub Bit) (~! bit.equivalence)] - [(.sub Nat) (~! nat.equivalence)] - [(.sub Int) (~! int.equivalence)] - [(.sub Rev) (~! rev.equivalence)] - [(.sub Frac) (~! frac.equivalence)] - [(.sub Text) (~! text.equivalence)])) - ... Composite types - (~~ (with_template [ ] - [(do ! - [[_ argC] (.applied (<>.and (.exactly ) - equivalence))] - (in (` (is (~ (@Equivalence inputT)) - ( (~ argC))))))] + [(.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] + [(.sub Bit) (~! bit.equivalence)] + [(.sub Nat) (~! nat.equivalence)] + [(.sub Int) (~! int.equivalence)] + [(.sub Rev) (~! rev.equivalence)] + [(.sub Frac) (~! frac.equivalence)] + [(.sub Text) (~! text.equivalence)])) + ... Composite types + (~~ (with_template [ ] + [(do ! + [[_ argC] (.applied (<>.and (.exactly ) + equivalence))] + (in (` (is (~ (@Equivalence inputT)) + ( (~ argC))))))] - [.Maybe (~! maybe.equivalence)] - [.List (~! list.equivalence)] - [sequence.Sequence (~! sequence.equivalence)] - [array.Array (~! array.equivalence)] - [queue.Queue (~! queue.equivalence)] - [set.Set (~! set.equivalence)] - [tree.Tree (~! tree.equivalence)] - )) - (do ! - [[_ _ valC] (.applied (all <>.and - (.exactly dictionary.Dictionary) - .any - equivalence))] - (in (` (is (~ (@Equivalence inputT)) - ((~! dictionary.equivalence) (~ valC)))))) - ... Models - (~~ (with_template [ ] - [(do ! - [_ (.exactly )] - (in (` (is (~ (@Equivalence inputT)) - ))))] + [.Maybe (~! maybe.equivalence)] + [.List (~! list.equivalence)] + [sequence.Sequence (~! sequence.equivalence)] + [array.Array (~! array.equivalence)] + [queue.Queue (~! queue.equivalence)] + [set.Set (~! set.equivalence)] + [tree.Tree (~! tree.equivalence)] + )) + (do ! + [[_ _ valC] (.applied (all <>.and + (.exactly dictionary.Dictionary) + .any + equivalence))] + (in (` (is (~ (@Equivalence inputT)) + ((~! dictionary.equivalence) (~ valC)))))) + ... Models + (~~ (with_template [ ] + [(do ! + [_ (.exactly )] + (in (` (is (~ (@Equivalence inputT)) + ))))] - [duration.Duration duration.equivalence] - [instant.Instant instant.equivalence] - [date.Date date.equivalence] - [day.Day day.equivalence] - [month.Month month.equivalence] - )) - (do ! - [_ (.applied (<>.and (.exactly unit.Qty) - .any))] - (in (` (is (~ (@Equivalence inputT)) - unit.equivalence)))) - ... Variants - (do ! - [members (.variant (<>.many equivalence)) - .let [last (-- (list.size members)) - g!_ (code.local "_____________") - g!left (code.local "_____________left") - g!right (code.local "_____________right")]] - (in (` (is (~ (@Equivalence inputT)) - (function ((~ g!_) (~ g!left) (~ g!right)) - (case [(~ g!left) (~ g!right)] - (~+ (list#conjoint (list#each (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)} - {(~ (code.nat (-- tag))) #1 (~ g!right)}]) - (` ((~ g!eq) (~ g!left) (~ g!right)))) - (list (` [{(~ (code.nat tag)) #0 (~ g!left)} - {(~ (code.nat tag)) #0 (~ g!right)}]) - (` ((~ g!eq) (~ g!left) (~ g!right)))))) - (list.enumeration members)))) - (~ g!_) - #0)))))) - ... Tuples - (do ! - [g!eqs (.tuple (<>.many equivalence)) - .let [g!_ (code.local "_____________") - indices (list.indices (list.size g!eqs)) - g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices) - g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]] - (in (` (is (~ (@Equivalence inputT)) - (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) - (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights) - (list#each (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) - ... Type recursion - (do ! - [[g!self bodyC] (.recursive equivalence) - .let [g!_ (code.local "_____________")]] - (in (` (is (~ (@Equivalence inputT)) - ((~! /.rec) (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) - .recursive_self - ... Type applications - (do ! - [[funcC argsC] (.applied (<>.and equivalence (<>.many equivalence)))] - (in (` ((~ funcC) (~+ argsC))))) - ... Parameters - .parameter - ... Polymorphism - (do ! - [[funcC varsC bodyC] (.polymorphic equivalence)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - .recursive_call - ... If all else fails... - (|> .any - (at ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure)) - (at ! conjoint)) - )))) + [duration.Duration duration.equivalence] + [instant.Instant instant.equivalence] + [date.Date date.equivalence] + [day.Day day.equivalence] + [month.Month month.equivalence] + )) + (do ! + [_ (.applied (<>.and (.exactly unit.Qty) + .any))] + (in (` (is (~ (@Equivalence inputT)) + unit.equivalence)))) + ... Variants + (do ! + [members (.variant (<>.many equivalence)) + .let [last (-- (list.size members)) + g!_ (code.local "_____________") + g!left (code.local "_____________left") + g!right (code.local "_____________right")]] + (in (` (is (~ (@Equivalence inputT)) + (function ((~ g!_) (~ g!left) (~ g!right)) + (case [(~ g!left) (~ g!right)] + (~+ (list#conjoint (list#each (function (_ [tag g!eq]) + (if (nat.= last tag) + (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)} + {(~ (code.nat (-- tag))) #1 (~ g!right)}]) + (` ((~ g!eq) (~ g!left) (~ g!right)))) + (list (` [{(~ (code.nat tag)) #0 (~ g!left)} + {(~ (code.nat tag)) #0 (~ g!right)}]) + (` ((~ g!eq) (~ g!left) (~ g!right)))))) + (list.enumeration members)))) + (~ g!_) + #0)))))) + ... Tuples + (do ! + [g!eqs (.tuple (<>.many equivalence)) + .let [g!_ (code.local "_____________") + indices (list.indices (list.size g!eqs)) + g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices) + g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]] + (in (` (is (~ (@Equivalence inputT)) + (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) + (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights) + (list#each (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + ... Type recursion + (do ! + [[g!self bodyC] (.recursive equivalence) + .let [g!_ (code.local "_____________")]] + (in (` (is (~ (@Equivalence inputT)) + ((~! /.rec) (.function ((~ g!_) (~ g!self)) + (~ bodyC))))))) + .recursive_self + ... Type applications + (do ! + [[funcC argsC] (.applied (<>.and equivalence (<>.many equivalence)))] + (in (` ((~ funcC) (~+ argsC))))) + ... Parameters + .parameter + ... Polymorphism + (do ! + [[funcC varsC bodyC] (.polymorphic equivalence)] + (in (` (is (All ((~ g!_) (~+ varsC)) + (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + .recursive_call + ... If all else fails... + (|> .any + (at ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure)) + (at ! conjoint)) + ))))) diff --git a/stdlib/source/polytypic/lux/abstract/functor.lux b/stdlib/source/polytypic/lux/abstract/functor.lux index 3ad598a91..fc7cae722 100644 --- a/stdlib/source/polytypic/lux/abstract/functor.lux +++ b/stdlib/source/polytypic/lux/abstract/functor.lux @@ -19,92 +19,93 @@ [number ["n" nat]]] ["[0]" type (.only) - ["[0]" poly (.only poly:)]]]] + ["[0]" poly (.only polytypic)]]]] [\\library ["[0]" /]]) -(poly: .public functor - (do [! p.monad] - [.let [g!_ (code.local "____________") - type_funcC (code.local "____________type_funcC") - funcC (code.local "____________funcC") - inputC (code.local "____________inputC")] - *env* .env - inputT .next - [polyC varsC non_functorT] (.local (list inputT) - (.polymorphic .any)) - .let [num_vars (list.size varsC)] - .let [@Functor (is (-> Type Code) - (function (_ unwrappedT) - (if (n.= 1 num_vars) - (` ((~! /.Functor) (~ (poly.code *env* unwrappedT)))) - (let [paramsC (|> num_vars -- list.indices (list#each (|>> %.nat code.local)))] - (` (All ((~ g!_) (~+ paramsC)) - ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC))))))))) - Arg (is (-> Code (.Parser Code)) - (function (Arg valueC) - (all p.either - ... Type-var - (do p.monad - [.let [varI (|> num_vars (n.* 2) --)] - _ (.this_parameter varI)] - (in (` ((~ funcC) (~ valueC))))) - ... Variants - (do ! - [_ (in []) - membersC (.variant (p.many (Arg valueC))) - .let [last (-- (list.size membersC))]] - (in (` (case (~ valueC) - (~+ (list#conjoint (list#each (function (_ [tag memberC]) - (if (n.= last tag) - (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)}) - (` {(~ (code.nat (-- tag))) #1 (~ memberC)})) - (list (` {(~ (code.nat tag)) #0 (~ valueC)}) - (` {(~ (code.nat tag)) #0 (~ memberC)})))) - (list.enumeration membersC)))))))) - ... Tuples - (do p.monad - [pairsCC (is (.Parser (List [Code Code])) - (.tuple (loop (again [idx 0 - pairsCC (is (List [Code Code]) - (list))]) - (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] - (do ! - [_ (in []) - memberC (Arg slotC)] - (again (++ idx) - (list#composite pairsCC (list [slotC memberC]))))) - (in pairsCC)))))] - (in (` (case (~ valueC) - [(~+ (list#each product.left pairsCC))] - [(~+ (list#each product.right pairsCC))])))) - ... Functions - (do ! - [_ (in []) - .let [g! (code.local "____________") - outL (code.local "____________outL")] - [inT+ outC] (.function (p.many .any) - (Arg outL)) - .let [inC+ (|> (list.size inT+) - list.indices - (list#each (|>> %.nat (format "____________inC") code.local)))]] - (in (` (function ((~ g!) (~+ inC+)) - (let [(~ outL) ((~ valueC) (~+ inC+))] - (~ outC)))))) - ... Recursion - (do p.monad - [_ .recursive_call] - (in (` ((~' each) (~ funcC) (~ valueC))))) - ... Parameters - (do p.monad - [_ .any] - (in valueC)) - )))] - [_ _ outputC] (is (.Parser [Code (List Code) Code]) - (p.either (.polymorphic - (Arg inputC)) - (p.failure (format "Cannot create Functor for: " (%.type inputT)))))] - (in (` (is (~ (@Functor inputT)) - (implementation - (def: ((~' each) (~ funcC) (~ inputC)) - (~ outputC)))))))) +(def: .public functor + (polytypic functor + (do [! p.monad] + [.let [g!_ (code.local "____________") + type_funcC (code.local "____________type_funcC") + funcC (code.local "____________funcC") + inputC (code.local "____________inputC")] + *env* .env + inputT .next + [polyC varsC non_functorT] (.local (list inputT) + (.polymorphic .any)) + .let [num_vars (list.size varsC)] + .let [@Functor (is (-> Type Code) + (function (_ unwrappedT) + (if (n.= 1 num_vars) + (` ((~! /.Functor) (~ (poly.code *env* unwrappedT)))) + (let [paramsC (|> num_vars -- list.indices (list#each (|>> %.nat code.local)))] + (` (All ((~ g!_) (~+ paramsC)) + ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC))))))))) + Arg (is (-> Code (.Parser Code)) + (function (Arg valueC) + (all p.either + ... Type-var + (do p.monad + [.let [varI (|> num_vars (n.* 2) --)] + _ (.this_parameter varI)] + (in (` ((~ funcC) (~ valueC))))) + ... Variants + (do ! + [_ (in []) + membersC (.variant (p.many (Arg valueC))) + .let [last (-- (list.size membersC))]] + (in (` (case (~ valueC) + (~+ (list#conjoint (list#each (function (_ [tag memberC]) + (if (n.= last tag) + (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)}) + (` {(~ (code.nat (-- tag))) #1 (~ memberC)})) + (list (` {(~ (code.nat tag)) #0 (~ valueC)}) + (` {(~ (code.nat tag)) #0 (~ memberC)})))) + (list.enumeration membersC)))))))) + ... Tuples + (do p.monad + [pairsCC (is (.Parser (List [Code Code])) + (.tuple (loop (again [idx 0 + pairsCC (is (List [Code Code]) + (list))]) + (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] + (do ! + [_ (in []) + memberC (Arg slotC)] + (again (++ idx) + (list#composite pairsCC (list [slotC memberC]))))) + (in pairsCC)))))] + (in (` (case (~ valueC) + [(~+ (list#each product.left pairsCC))] + [(~+ (list#each product.right pairsCC))])))) + ... Functions + (do ! + [_ (in []) + .let [g! (code.local "____________") + outL (code.local "____________outL")] + [inT+ outC] (.function (p.many .any) + (Arg outL)) + .let [inC+ (|> (list.size inT+) + list.indices + (list#each (|>> %.nat (format "____________inC") code.local)))]] + (in (` (function ((~ g!) (~+ inC+)) + (let [(~ outL) ((~ valueC) (~+ inC+))] + (~ outC)))))) + ... Recursion + (do p.monad + [_ .recursive_call] + (in (` ((~' each) (~ funcC) (~ valueC))))) + ... Parameters + (do p.monad + [_ .any] + (in valueC)) + )))] + [_ _ outputC] (is (.Parser [Code (List Code) Code]) + (p.either (.polymorphic + (Arg inputC)) + (p.failure (format "Cannot create Functor for: " (%.type inputT)))))] + (in (` (is (~ (@Functor inputT)) + (implementation + (def: ((~' each) (~ funcC) (~ inputC)) + (~ outputC))))))))) diff --git a/stdlib/source/polytypic/lux/data/format/json.lux b/stdlib/source/polytypic/lux/data/format/json.lux index 801a16e19..b86f256a2 100644 --- a/stdlib/source/polytypic/lux/data/format/json.lux +++ b/stdlib/source/polytypic/lux/data/format/json.lux @@ -35,7 +35,7 @@ ["[0]" month]] ["[0]" type (.only) ["[0]" unit] - ["[0]" poly (.only poly:)]]]] + ["[0]" poly (.only polytypic)]]]] [\\library ["[0]" / (.only JSON)]]) @@ -96,233 +96,235 @@ (|>> (at ..int_codec decoded) (at try.functor each (debug.private unit.in')))))) -(poly: encoded - (with_expansions - [ (with_template [ ] - [(do ! - [.let [g!_ (code.local "_______")] - _ ] - (in (` (is (~ (@JSON#encoded inputT)) - ))))] +(def: encoded + (polytypic encoded + (with_expansions + [ (with_template [ ] + [(do ! + [.let [g!_ (code.local "_______")] + _ ] + (in (` (is (~ (@JSON#encoded inputT)) + ))))] - [(.exactly Any) (function ((~ g!_) (~ (code.symbol ["" "0"]))) {/.#Null})] - [(.sub Bit) (|>> {/.#Boolean})] - [(.sub Nat) (at (~! ..nat_codec) (~' encoded))] - [(.sub Int) (at (~! ..int_codec) (~' encoded))] - [(.sub Frac) (|>> {/.#Number})] - [(.sub Text) (|>> {/.#String})]) -