diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/poly/lux/abstract/equivalence.lux | 76 | ||||
-rw-r--r-- | stdlib/source/poly/lux/abstract/functor.lux | 50 | ||||
-rw-r--r-- | stdlib/source/poly/lux/data/format/json.lux | 185 |
3 files changed, 156 insertions, 155 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 1f414e197..b1d4f413f 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -54,8 +54,8 @@ (~~ (template [<matcher> <eq>] [(do ! [_ <matcher>] - (wrap (` (: (~ (@Equivalence inputT)) - <eq>))))] + (in (` (: (~ (@Equivalence inputT)) + <eq>))))] [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] [(<type>.sub Bit) (~! bit.equivalence)] @@ -69,8 +69,8 @@ [(do ! [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>) equivalence))] - (wrap (` (: (~ (@Equivalence inputT)) - (<eq> (~ argC))))))] + (in (` (: (~ (@Equivalence inputT)) + (<eq> (~ argC))))))] [.Maybe (~! maybe.equivalence)] [.List (~! list.equivalence)] @@ -85,14 +85,14 @@ (<type>.exactly dictionary.Dictionary) <type>.any equivalence))] - (wrap (` (: (~ (@Equivalence inputT)) - ((~! dictionary.equivalence) (~ valC)))))) + (in (` (: (~ (@Equivalence inputT)) + ((~! dictionary.equivalence) (~ valC)))))) ## Models (~~ (template [<type> <eq>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@Equivalence inputT)) - <eq>))))] + (in (` (: (~ (@Equivalence inputT)) + <eq>))))] [duration.Duration duration.equivalence] [instant.Instant instant.equivalence] @@ -103,8 +103,8 @@ (do ! [_ (<type>.applied (<>.and (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@Equivalence inputT)) - unit.equivalence)))) + (in (` (: (~ (@Equivalence inputT)) + unit.equivalence)))) ## Variants (do ! [members (<type>.variant (<>.many equivalence)) @@ -112,20 +112,20 @@ g!_ (code.local_identifier "_____________") g!left (code.local_identifier "_____________left") g!right (code.local_identifier "_____________right")]] - (wrap (` (: (~ (@Equivalence inputT)) - (function ((~ g!_) (~ g!left) (~ g!right)) - (case [(~ g!left) (~ g!right)] - (~+ (list\join (list\map (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) - ((~ (code.nat (dec 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)))))) + (in (` (: (~ (@Equivalence inputT)) + (function ((~ g!_) (~ g!left) (~ g!right)) + (case [(~ g!left) (~ g!right)] + (~+ (list\join (list\map (function (_ [tag g!eq]) + (if (nat.= last tag) + (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) + ((~ (code.nat (dec 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 (<type>.tuple (<>.many equivalence)) @@ -133,33 +133,33 @@ indices (list.indices (list.size g!eqs)) g!lefts (list\map (|>> nat\encode (text\compose "left") code.local_identifier) indices) g!rights (list\map (|>> nat\encode (text\compose "right") code.local_identifier) indices)]] - (wrap (` (: (~ (@Equivalence inputT)) - (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) - (and (~+ (|> (list.zipped/3 g!eqs g!lefts g!rights) - (list\map (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + (in (` (: (~ (@Equivalence inputT)) + (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) + (and (~+ (|> (list.zipped/3 g!eqs g!lefts g!rights) + (list\map (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do ! [[g!self bodyC] (<type>.recursive equivalence) #let [g!_ (code.local_identifier "_____________")]] - (wrap (` (: (~ (@Equivalence inputT)) - ((~! /.rec) (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) + (in (` (: (~ (@Equivalence inputT)) + ((~! /.rec) (.function ((~ g!_) (~ g!self)) + (~ bodyC))))))) <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))] - (wrap (` ((~ funcC) (~+ argsC))))) + (in (` ((~ funcC) (~+ argsC))))) ## Parameters <type>.parameter ## Polymorphism (do ! [[funcC varsC bodyC] (<type>.polymorphic equivalence)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.to_code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) + (in (` (: (All [(~+ varsC)] + (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + ((~! /.Equivalence) ((~ (poly.to_code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) <type>.recursive_call ## If all else fails... (|> <type>.any diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 363b43b8a..089d5119b 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -48,20 +48,20 @@ (do p.monad [#let [varI (|> num_vars (n.* 2) dec)] _ (<type>.parameter! varI)] - (wrap (` ((~ funcC) (~ valueC))))) + (in (` ((~ funcC) (~ valueC))))) ## Variants (do ! - [_ (wrap []) + [_ (in []) membersC (<type>.variant (p.many (Arg<?> valueC))) #let [last (dec (list.size membersC))]] - (wrap (` (case (~ valueC) - (~+ (list\join (list\map (function (_ [tag memberC]) - (if (n.= last tag) - (list (` ((~ (code.nat (dec tag))) #1 (~ valueC))) - (` ((~ (code.nat (dec tag))) #1 (~ memberC)))) - (list (` ((~ (code.nat tag)) #0 (~ valueC))) - (` ((~ (code.nat tag)) #0 (~ memberC)))))) - (list.enumeration membersC)))))))) + (in (` (case (~ valueC) + (~+ (list\join (list\map (function (_ [tag memberC]) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ valueC))) + (` ((~ (code.nat (dec tag))) #1 (~ memberC)))) + (list (` ((~ (code.nat tag)) #0 (~ valueC))) + (` ((~ (code.nat tag)) #0 (~ memberC)))))) + (list.enumeration membersC)))))))) ## Tuples (do p.monad [pairsCC (: (<type>.Parser (List [Code Code])) @@ -70,17 +70,17 @@ (list))] (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local_identifier)] (do ! - [_ (wrap []) + [_ (in []) memberC (Arg<?> slotC)] (recur (inc idx) (list\compose pairsCC (list [slotC memberC]))))) - (wrap pairsCC)))))] - (wrap (` (case (~ valueC) - [(~+ (list\map product.left pairsCC))] - [(~+ (list\map product.right pairsCC))])))) + (in pairsCC)))))] + (in (` (case (~ valueC) + [(~+ (list\map product.left pairsCC))] + [(~+ (list\map product.right pairsCC))])))) ## Functions (do ! - [_ (wrap []) + [_ (in []) #let [g! (code.local_identifier "____________") outL (code.local_identifier "____________outL")] [inT+ outC] (<type>.function (p.many <type>.any) @@ -88,23 +88,23 @@ #let [inC+ (|> (list.size inT+) list.indices (list\map (|>> %.nat (format "____________inC") code.local_identifier)))]] - (wrap (` (function ((~ g!) (~+ inC+)) - (let [(~ outL) ((~ valueC) (~+ inC+))] - (~ outC)))))) + (in (` (function ((~ g!) (~+ inC+)) + (let [(~ outL) ((~ valueC) (~+ inC+))] + (~ outC)))))) ## Recursion (do p.monad [_ <type>.recursive_call] - (wrap (` ((~' map) (~ funcC) (~ valueC))))) + (in (` ((~' map) (~ funcC) (~ valueC))))) ## Parameters (do p.monad [_ <type>.any] - (wrap valueC)) + (in valueC)) )))] [_ _ outputC] (: (<type>.Parser [Code (List Code) Code]) (p.either (<type>.polymorphic (Arg<?> inputC)) (p.failure (format "Cannot create Functor for: " (%.type inputT)))))] - (wrap (` (: (~ (@Functor inputT)) - (implementation - (def: ((~' map) (~ funcC) (~ inputC)) - (~ outputC)))))))) + (in (` (: (~ (@Functor inputT)) + (implementation + (def: ((~' map) (~ funcC) (~ inputC)) + (~ outputC)))))))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 1aa793323..9ce3b6a6e 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Codecs for values in the JSON format."} +(.module: + {#.doc "Codecs for values in the JSON format."} [library [lux #* ["." debug] @@ -70,8 +71,8 @@ (do <>.monad [high </>.number low </>.number] - (wrap (n.+ (|> high frac.int .nat (i64.left_shift 32)) - (|> low frac.int .nat)))))))) + (in (n.+ (|> high frac.int .nat (i64.left_shift 32)) + (|> low frac.int .nat)))))))) (implementation: int_codec (codec.Codec JSON Int) @@ -105,8 +106,8 @@ [(do ! [#let [g!_ (code.local_identifier "_______")] _ <matcher>] - (wrap (` (: (~ (@JSON\encode inputT)) - <encoder>))))] + (in (` (: (~ (@JSON\encode inputT)) + <encoder>))))] [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] [(<type>.sub Bit) (|>> #/.Boolean)] @@ -117,8 +118,8 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@JSON\encode inputT)) - (|>> (\ (~! <codec>) (~' encode)) #/.String)))))] + (in (` (: (~ (@JSON\encode inputT)) + (|>> (\ (~! <codec>) (~' encode)) #/.String)))))] ## [duration.Duration duration.codec] ## [instant.Instant instant.codec] @@ -137,8 +138,8 @@ (do ! [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@JSON\encode inputT)) - (\ (~! qty_codec) (~' encode)))))) + (in (` (: (~ (@JSON\encode inputT)) + (\ (~! qty_codec) (~' encode)))))) (do ! [#let [g!_ (code.local_identifier "_______") g!key (code.local_identifier "_______key") @@ -147,76 +148,76 @@ (<type>.exactly d.Dictionary) (<type>.exactly .Text) encode))] - (wrap (` (: (~ (@JSON\encode inputT)) - (|>> ((~! d.entries)) - ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) - ((~! d.of_list) (~! text.hash)) - #/.Object))))) + (in (` (: (~ (@JSON\encode inputT)) + (|>> ((~! d.entries)) + ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! d.of_list) (~! text.hash)) + #/.Object))))) (do ! [[_ =sub=] (<type>.applied ($_ <>.and (<type>.exactly .Maybe) encode))] - (wrap (` (: (~ (@JSON\encode inputT)) - ((~! ..nullable) (~ =sub=)))))) + (in (` (: (~ (@JSON\encode inputT)) + ((~! ..nullable) (~ =sub=)))))) (do ! [[_ =sub=] (<type>.applied ($_ <>.and (<type>.exactly .List) encode))] - (wrap (` (: (~ (@JSON\encode inputT)) - (|>> ((~! list\map) (~ =sub=)) ((~! row.of_list)) #/.Array))))) + (in (` (: (~ (@JSON\encode inputT)) + (|>> ((~! list\map) (~ =sub=)) ((~! row.of_list)) #/.Array))))) (do ! [#let [g!_ (code.local_identifier "_______") g!input (code.local_identifier "_______input")] members (<type>.variant (<>.many encode)) #let [last (dec (list.size members))]] - (wrap (` (: (~ (@JSON\encode inputT)) - (function ((~ g!_) (~ g!input)) - (case (~ g!input) - (~+ (list\join (list\map (function (_ [tag g!encode]) - (if (n.= last tag) - (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) - #1 - ((~ g!encode) (~ g!input))]))) - (list (` ((~ (code.nat tag)) #0 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - #0 - ((~ g!encode) (~ g!input))]))))) - (list.enumeration members)))))))))) + (in (` (: (~ (@JSON\encode inputT)) + (function ((~ g!_) (~ g!input)) + (case (~ g!input) + (~+ (list\join (list\map (function (_ [tag g!encode]) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) + #1 + ((~ g!encode) (~ g!input))]))) + (list (` ((~ (code.nat tag)) #0 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encode) (~ g!input))]))))) + (list.enumeration members)))))))))) (do ! [g!encoders (<type>.tuple (<>.many encode)) #let [g!_ (code.local_identifier "_______") g!members (|> (list.size g!encoders) list.indices (list\map (|>> n\encode code.local_identifier)))]] - (wrap (` (: (~ (@JSON\encode inputT)) - (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) - (` ((~ g!encode) (~ g!member)))) - (list.zipped/2 g!members g!encoders)))])))))) + (in (` (: (~ (@JSON\encode inputT)) + (function ((~ g!_) [(~+ g!members)]) + ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) + (` ((~ g!encode) (~ g!member)))) + (list.zipped/2 g!members g!encoders)))])))))) ## Type recursion (do ! [[selfC non_recC] (<type>.recursive encode) #let [g! (code.local_identifier "____________")]] - (wrap (` (: (~ (@JSON\encode inputT)) - ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) - (~ non_recC))))))) + (in (` (: (~ (@JSON\encode inputT)) + ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) <type>.recursive_self ## Type applications (do ! [partsC (<type>.applied (<>.many encode))] - (wrap (` ((~+ partsC))))) + (in (` ((~+ partsC))))) ## Polymorphism (do ! [[funcC varsC bodyC] (<type>.polymorphic encode)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) - (-> ((~ (poly.to_code *env* inputT)) (~+ varsC)) - /.JSON))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) + (in (` (: (All [(~+ varsC)] + (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) + (-> ((~ (poly.to_code *env* inputT)) (~+ varsC)) + /.JSON))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) <type>.parameter <type>.recursive_call ## If all else fails... @@ -228,8 +229,8 @@ [<basic> (template [<matcher> <decoder>] [(do ! [_ <matcher>] - (wrap (` (: (~ (@JSON\decode inputT)) - (~! <decoder>)))))] + (in (` (: (~ (@JSON\decode inputT)) + (~! <decoder>)))))] [(<type>.exactly Any) </>.null] [(<type>.sub Bit) </>.boolean] @@ -240,8 +241,8 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.codec) (~! <codec>) (~! </>.string))))))] + (in (` (: (~ (@JSON\decode inputT)) + ((~! <>.codec) (~! <codec>) (~! </>.string))))))] ## [duration.Duration duration.codec] ## [instant.Instant instant.codec] @@ -260,65 +261,65 @@ (do ! [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.applied ($_ <>.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.dictionary) (~ valC)))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.dictionary) (~ valC)))))) (do ! [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.nullable) (~ subC)))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.nullable) (~ subC)))))) (do ! [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.array) ((~! <>.some) (~ subC))))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.array) ((~! <>.some) (~ subC))))))) (do ! [members (<type>.variant (<>.many decode)) #let [last (dec (list.size members))]] - (wrap (` (: (~ (@JSON\decode inputT)) - ($_ ((~! <>.or)) - (~+ (list\map (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1)))) - ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) - ((~! </>.array)))) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0)))) - ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) - ((~! </>.array)))))) - (list.enumeration members)))))))) + (in (` (: (~ (@JSON\decode inputT)) + ($_ ((~! <>.or)) + (~+ (list\map (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1)))) + ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0)))) + ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) + ((~! </>.array)))))) + (list.enumeration members)))))))) (do ! [g!decoders (<type>.tuple (<>.many decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) ## Type recursion (do ! [[selfC bodyC] (<type>.recursive decode) #let [g! (code.local_identifier "____________")]] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.rec) (.function ((~ g!) (~ selfC)) - (~ bodyC))))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! <>.rec) (.function ((~ g!) (~ selfC)) + (~ bodyC))))))) <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.applied (<>.and decode (<>.many decode)))] - (wrap (` ((~ funcC) (~+ argsC))))) + (in (` ((~ funcC) (~+ argsC))))) ## Polymorphism (do ! [[funcC varsC bodyC] (<type>.polymorphic decode)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) - (</>.Parser ((~ (poly.to_code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) + (in (` (: (All [(~+ varsC)] + (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) + (</>.Parser ((~ (poly.to_code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) <type>.parameter <type>.recursive_call ## If all else fails... @@ -343,10 +344,10 @@ #dictionary (Dictionary Text Frac)}) (derived: (..codec Record)))} - (wrap (list (` (: (codec.Codec /.JSON (~ inputT)) - (implementation - (def: (~' encode) - ((~! ..encode) (~ inputT))) - (def: (~' decode) - ((~! </>.run) ((~! ..decode) (~ inputT)))) - )))))) + (in (list (` (: (codec.Codec /.JSON (~ inputT)) + (implementation + (def: (~' encode) + ((~! ..encode) (~ inputT))) + (def: (~' decode) + ((~! </>.run) ((~! ..decode) (~ inputT)))) + )))))) |