diff options
Diffstat (limited to 'stdlib/source/poly')
| -rw-r--r-- | stdlib/source/poly/lux/abstract/equivalence.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/poly/lux/abstract/functor.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/poly/lux/data/format/json.lux | 90 |
3 files changed, 72 insertions, 72 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index f8d8d1fa8..b6cfa2c2c 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -43,12 +43,12 @@ (poly: #export equivalence (`` (do {! p.monad} - [#let [g!_ (code.local-identifier "_____________")] + [#let [g!_ (code.local_identifier "_____________")] *env* <type>.env inputT <type>.peek #let [@Equivalence (: (-> Type Code) (function (_ type) - (` ((~! /.Equivalence) (~ (poly.to-code *env* type))))))]] + (` ((~! /.Equivalence) (~ (poly.to_code *env* type))))))]] ($_ p.either ## Basic types (~~ (template [<matcher> <eq>] @@ -109,9 +109,9 @@ (do ! [members (<type>.variant (p.many equivalence)) #let [last (dec (list.size members)) - g!_ (code.local-identifier "_____________") - g!left (code.local-identifier "_____________left") - g!right (code.local-identifier "_____________right")]] + 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)] @@ -129,10 +129,10 @@ ## Tuples (do ! [g!eqs (<type>.tuple (p.many equivalence)) - #let [g!_ (code.local-identifier "_____________") + #let [g!_ (code.local_identifier "_____________") 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)]] + 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.zip/3 g!eqs g!lefts g!rights) @@ -141,11 +141,11 @@ ## Type recursion (do ! [[g!self bodyC] (<type>.recursive equivalence) - #let [g!_ (code.local-identifier "_____________")]] + #let [g!_ (code.local_identifier "_____________")]] (wrap (` (: (~ (@Equivalence inputT)) ((~! /.rec) (.function ((~ g!_) (~ g!self)) (~ bodyC))))))) - <type>.recursive-self + <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.apply (p.and equivalence (p.many equivalence)))] @@ -157,10 +157,10 @@ [[funcC varsC bodyC] (<type>.polymorphic equivalence)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC))))) + ((~! /.Equivalence) ((~ (poly.to_code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) - <type>.recursive-call + <type>.recursive_call ## If all else fails... (|> <type>.any (\ ! map (|>> %.type (format "Cannot create Equivalence for: ") p.fail)) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index d640d4205..70f4f9b64 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -25,27 +25,27 @@ (poly: #export functor (do {! p.monad} - [#let [type-funcC (code.local-identifier "____________type-funcC") - funcC (code.local-identifier "____________funcC") - inputC (code.local-identifier "____________inputC")] + [#let [type_funcC (code.local_identifier "____________type_funcC") + funcC (code.local_identifier "____________funcC") + inputC (code.local_identifier "____________inputC")] *env* <type>.env inputT <type>.peek - [polyC varsC non-functorT] (<type>.local (list inputT) + [polyC varsC non_functorT] (<type>.local (list inputT) (<type>.polymorphic <type>.any)) - #let [num-vars (list.size varsC)] + #let [num_vars (list.size varsC)] #let [@Functor (: (-> Type Code) (function (_ unwrappedT) - (if (n.= 1 num-vars) - (` ((~! /.Functor) (~ (poly.to-code *env* unwrappedT)))) - (let [paramsC (|> num-vars dec list.indices (list\map (|>> %.nat code.local-identifier)))] + (if (n.= 1 num_vars) + (` ((~! /.Functor) (~ (poly.to_code *env* unwrappedT)))) + (let [paramsC (|> num_vars dec list.indices (list\map (|>> %.nat code.local_identifier)))] (` (All [(~+ paramsC)] - ((~! /.Functor) ((~ (poly.to-code *env* unwrappedT)) (~+ paramsC))))))))) + ((~! /.Functor) ((~ (poly.to_code *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (: (-> Code (<type>.Parser Code)) (function (Arg<?> valueC) ($_ p.either ## Type-var (do p.monad - [#let [varI (|> num-vars (n.* 2) dec)] + [#let [varI (|> num_vars (n.* 2) dec)] _ (<type>.parameter! varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants @@ -67,7 +67,7 @@ (<type>.tuple (loop [idx 0 pairsCC (: (List [Code Code]) (list))] - (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local-identifier)] + (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local_identifier)] (do ! [_ (wrap []) memberC (Arg<?> slotC)] @@ -80,19 +80,19 @@ ## Functions (do ! [_ (wrap []) - #let [g! (code.local-identifier "____________") - outL (code.local-identifier "____________outL")] + #let [g! (code.local_identifier "____________") + outL (code.local_identifier "____________outL")] [inT+ outC] (<type>.function (p.many <type>.any) (Arg<?> outL)) #let [inC+ (|> (list.size inT+) list.indices - (list\map (|>> %.nat (format "____________inC") code.local-identifier)))]] + (list\map (|>> %.nat (format "____________inC") code.local_identifier)))]] (wrap (` (function ((~ g!) (~+ inC+)) (let [(~ outL) ((~ valueC) (~+ inC+))] (~ outC)))))) ## Recursion (do p.monad - [_ <type>.recursive-call] + [_ <type>.recursive_call] (wrap (` ((~' map) (~ funcC) (~ valueC))))) ## Parameters (do p.monad diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 3cba2eb3b..58784dccd 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -44,22 +44,22 @@ (-> Nat Frac) (|>> .int int.frac)) -(def: (rec-encode non-rec) +(def: (rec_encode non_rec) (All [a] (-> (-> (-> a JSON) (-> a JSON)) (-> a JSON))) (function (_ input) - (non-rec (rec-encode non-rec) input))) + (non_rec (rec_encode non_rec) input))) -(def: low-mask Nat (|> 1 (i64.left-shift 32) dec)) -(def: high-mask Nat (|> low-mask (i64.left-shift 32))) +(def: low_mask Nat (|> 1 (i64.left_shift 32) dec)) +(def: high_mask Nat (|> low_mask (i64.left_shift 32))) -(structure: nat-codec +(structure: nat_codec (codec.Codec JSON Nat) (def: (encode input) - (let [high (|> input (i64.and high-mask) (i64.logic-right-shift 32)) - low (i64.and low-mask input)] + (let [high (|> input (i64.and high_mask) (i64.logic_right_shift 32)) + low (i64.and low_mask input)] (#/.Array (row (|> high .int int.frac #/.Number) (|> low .int int.frac #/.Number))))) (def: decode @@ -67,15 +67,15 @@ (do <>.monad [high </>.number low </>.number] - (wrap (n.+ (|> high frac.int .nat (i64.left-shift 32)) + (wrap (n.+ (|> high frac.int .nat (i64.left_shift 32)) (|> low frac.int .nat)))))))) -(structure: int-codec +(structure: int_codec (codec.Codec JSON Int) - (def: encode (|>> .nat (\ nat-codec encode))) + (def: encode (|>> .nat (\ nat_codec encode))) (def: decode - (|>> (\ nat-codec decode) (\ try.functor map .int)))) + (|>> (\ nat_codec decode) (\ try.functor map .int)))) (def: (nullable writer) {#.doc "Builds a JSON generator for potentially inexistent values."} @@ -85,28 +85,28 @@ #.None #/.Null (#.Some value) (writer value)))) -(structure: qty-codec +(structure: qty_codec (All [unit] (codec.Codec JSON (unit.Qty unit))) (def: encode - (|>> unit.out (\ ..int-codec encode))) + (|>> unit.out (\ ..int_codec encode))) (def: decode - (|>> (\ ..int-codec decode) (\ try.functor map unit.in)))) + (|>> (\ ..int_codec decode) (\ try.functor map unit.in)))) (poly: encode - (with-expansions + (with_expansions [<basic> (template [<matcher> <encoder>] [(do ! - [#let [g!_ (code.local-identifier "_______")] + [#let [g!_ (code.local_identifier "_______")] _ <matcher>] (wrap (` (: (~ (@JSON\encode inputT)) <encoder>))))] [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] [(<type>.sub Bit) (|>> #/.Boolean)] - [(<type>.sub Nat) (\ (~! ..nat-codec) (~' encode))] - [(<type>.sub Int) (\ (~! ..int-codec) (~' encode))] + [(<type>.sub Nat) (\ (~! ..nat_codec) (~' encode))] + [(<type>.sub Int) (\ (~! ..int_codec) (~' encode))] [(<type>.sub Frac) (|>> #/.Number)] [(<type>.sub Text) (|>> #/.String)]) <time> (template [<type> <codec>] @@ -124,7 +124,7 @@ [*env* <type>.env #let [@JSON\encode (: (-> Type Code) (function (_ type) - (` (-> (~ (poly.to-code *env* type)) /.JSON))))] + (` (-> (~ (poly.to_code *env* type)) /.JSON))))] inputT <type>.peek] ($_ <>.either <basic> @@ -133,11 +133,11 @@ [unitT (<type>.apply (<>.after (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@JSON\encode inputT)) - (\ (~! qty-codec) (~' encode)))))) + (\ (~! qty_codec) (~' encode)))))) (do ! - [#let [g!_ (code.local-identifier "_______") - g!key (code.local-identifier "_______key") - g!val (code.local-identifier "_______val")] + [#let [g!_ (code.local_identifier "_______") + g!key (code.local_identifier "_______key") + g!val (code.local_identifier "_______val")] [_ _ =val=] (<type>.apply ($_ <>.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) @@ -146,7 +146,7 @@ (|>> ((~! d.entries)) ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) [(~ g!key) ((~ =val=) (~ g!val))])) - ((~! d.from-list) (~! text.hash)) + ((~! d.from_list) (~! text.hash)) #/.Object))))) (do ! [[_ =sub=] (<type>.apply ($_ <>.and @@ -159,10 +159,10 @@ (<type>.exactly .List) encode))] (wrap (` (: (~ (@JSON\encode inputT)) - (|>> ((~! list\map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) + (|>> ((~! list\map) (~ =sub=)) ((~! row.from_list)) #/.Array))))) (do ! - [#let [g!_ (code.local-identifier "_______") - g!input (code.local-identifier "_______input")] + [#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)) @@ -181,10 +181,10 @@ (list.enumeration members)))))))))) (do ! [g!encoders (<type>.tuple (<>.many encode)) - #let [g!_ (code.local-identifier "_______") + #let [g!_ (code.local_identifier "_______") g!members (|> (list.size g!encoders) list.indices - (list\map (|>> n\encode code.local-identifier)))]] + (list\map (|>> n\encode code.local_identifier)))]] (wrap (` (: (~ (@JSON\encode inputT)) (function ((~ g!_) [(~+ g!members)]) ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) @@ -192,12 +192,12 @@ (list.zip/2 g!members g!encoders)))])))))) ## Type recursion (do ! - [[selfC non-recC] (<type>.recursive encode) - #let [g! (code.local-identifier "____________")]] + [[selfC non_recC] (<type>.recursive encode) + #let [g! (code.local_identifier "____________")]] (wrap (` (: (~ (@JSON\encode inputT)) - ((~! ..rec-encode) (.function ((~ g!) (~ selfC)) - (~ non-recC))))))) - <type>.recursive-self + ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) + <type>.recursive_self ## Type applications (do ! [partsC (<type>.apply (<>.many encode))] @@ -208,18 +208,18 @@ (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) varsC)) - (-> ((~ (poly.to-code *env* inputT)) (~+ varsC)) + (-> ((~ (poly.to_code *env* inputT)) (~+ varsC)) /.JSON))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) <type>.parameter - <type>.recursive-call + <type>.recursive_call ## If all else fails... (<>.fail (format "Cannot create JSON encoder for: " (type.format inputT))) )))) (poly: decode - (with-expansions + (with_expansions [<basic> (template [<matcher> <decoder>] [(do ! [_ <matcher>] @@ -228,8 +228,8 @@ [(<type>.exactly Any) </>.null] [(<type>.sub Bit) </>.boolean] - [(<type>.sub Nat) (<>.codec ..nat-codec </>.any)] - [(<type>.sub Int) (<>.codec ..int-codec </>.any)] + [(<type>.sub Nat) (<>.codec ..nat_codec </>.any)] + [(<type>.sub Int) (<>.codec ..int_codec </>.any)] [(<type>.sub Frac) </>.number] [(<type>.sub Text) </>.string]) <time> (template [<type> <codec>] @@ -247,7 +247,7 @@ [*env* <type>.env #let [@JSON\decode (: (-> Type Code) (function (_ type) - (` (</>.Parser (~ (poly.to-code *env* type))))))] + (` (</>.Parser (~ (poly.to_code *env* type))))))] inputT <type>.peek] ($_ <>.either <basic> @@ -256,7 +256,7 @@ [unitT (<type>.apply (<>.after (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.codec) (~! qty-codec) (~! </>.any)))))) + ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.apply ($_ <>.and (<type>.exactly d.Dictionary) @@ -297,11 +297,11 @@ ## Type recursion (do ! [[selfC bodyC] (<type>.recursive decode) - #let [g! (code.local-identifier "____________")]] + #let [g! (code.local_identifier "____________")]] (wrap (` (: (~ (@JSON\decode inputT)) ((~! <>.rec) (.function ((~ g!) (~ selfC)) (~ bodyC))))))) - <type>.recursive-self + <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.apply (<>.and decode (<>.many decode)))] @@ -311,11 +311,11 @@ [[funcC varsC bodyC] (<type>.polymorphic decode)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) - (</>.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC))))) + (</>.Parser ((~ (poly.to_code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) <type>.parameter - <type>.recursive-call + <type>.recursive_call ## If all else fails... (<>.fail (format "Cannot create JSON decoder for: " (type.format inputT))) )))) |