From 2e5852abb1ac0ae5abdd8709238aca447f62520e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Nov 2020 00:29:40 -0400 Subject: Pure-Lux implementation for biggest and smallest Frac values. --- stdlib/source/poly/lux/abstract/equivalence.lux | 34 ++++++------ stdlib/source/poly/lux/data/format/json.lux | 74 ++++++++++++------------- 2 files changed, 54 insertions(+), 54 deletions(-) (limited to 'stdlib/source/poly') diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 8826b9ed9..a4d139aa4 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -11,14 +11,14 @@ ["." bit] ["." maybe] [number - ["." nat ("#@." decimal)] + ["." nat ("#//." decimal)] ["." int] ["." rev] ["." frac]] - ["." text ("#@." monoid) + ["." text ("#//." monoid) ["%" format (#+ format)]] [collection - ["." list ("#@." monad)] + ["." list ("#//." monad)] ["." row] ["." array] ["." queue] @@ -115,15 +115,15 @@ (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)))) + (~+ (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 @@ -131,13 +131,13 @@ [g!eqs (.tuple (p.many equivalence)) #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) - (list@map (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + (list//map (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do ! [[g!self bodyC] (.recursive equivalence) @@ -156,7 +156,7 @@ (do ! [[funcC varsC bodyC] (.polymorphic equivalence)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list@map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + (-> (~+ (list//map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) ((~! /.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 9cc39c994..afe34c404 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -18,14 +18,14 @@ ["." product] [number ["." i64] - ["n" nat ("#@." decimal)] + ["n" nat ("#//." decimal)] ["." int] - ["." frac ("#@." decimal)]] - ["." text ("#@." equivalence) + ["." frac ("#//." decimal)]] + ["." text ("#//." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." fold monad)] - ["." row (#+ Row row) ("#@." monad)] + ["." list ("#//." fold monad)] + ["." row (#+ Row row) ("#//." monad)] ["d" dictionary]]] [time ## ["." instant] @@ -146,8 +146,8 @@ codec//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (|>> ((~! d.entries)) - ((~! list@map) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! list//map) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) ((~! d.from-list) (~! text.hash)) #/.Object))))) (do ! @@ -161,7 +161,7 @@ (.exactly .List) codec//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")] @@ -170,28 +170,28 @@ (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)))))))))) + (~+ (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 (.tuple (p.many codec//encode)) #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]) - (` ((~ g!encode) (~ g!member)))) - (list.zip/2 g!members g!encoders)))])))))) + ((~! /.json) [(~+ (list//map (function (_ [g!member g!encode]) + (` ((~ g!encode) (~ g!member)))) + (list.zip/2 g!members g!encoders)))])))))) ## Type recursion (do ! [[selfC non-recC] (.recursive codec//encode) @@ -208,8 +208,8 @@ (do ! [[funcC varsC bodyC] (.polymorphic codec//encode)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list@map (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) + (-> (~+ (list//map (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) (-> ((~ (poly.to-code *env* inputT)) (~+ varsC)) /.JSON))) (function ((~ funcC) (~+ varsC)) @@ -281,17 +281,17 @@ #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON//decode inputT)) ($_ ((~! p.or)) - (~+ (list@map (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! p.after) ((~! .boolean!) (~ (code.bit #1)))) - ((~! p.after) ((~! .number!) (~ (code.frac (..tag (dec tag)))))) - ((~! .array)))) - (` (|> (~ memberC) - ((~! p.after) ((~! .boolean!) (~ (code.bit #0)))) - ((~! p.after) ((~! .number!) (~ (code.frac (..tag tag))))) - ((~! .array)))))) - (list.enumeration members)))))))) + (~+ (list//map (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! p.after) ((~! .boolean!) (~ (code.bit #1)))) + ((~! p.after) ((~! .number!) (~ (code.frac (..tag (dec tag)))))) + ((~! .array)))) + (` (|> (~ memberC) + ((~! p.after) ((~! .boolean!) (~ (code.bit #0)))) + ((~! p.after) ((~! .number!) (~ (code.frac (..tag tag))))) + ((~! .array)))))) + (list.enumeration members)))))))) (do ! [g!decoders (.tuple (p.many codec//decode))] (wrap (` (: (~ (@JSON//decode inputT)) @@ -312,7 +312,7 @@ (do ! [[funcC varsC bodyC] (.polymorphic codec//decode)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list@map (|>> (~) .Parser (`)) varsC)) + (-> (~+ (list//map (|>> (~) .Parser (`)) varsC)) (.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) -- cgit v1.2.3