aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/poly
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/poly')
-rw-r--r--stdlib/source/poly/lux/abstract/equivalence.lux26
-rw-r--r--stdlib/source/poly/lux/abstract/functor.lux8
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux48
3 files changed, 41 insertions, 41 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux
index 69c2d24fb..8826b9ed9 100644
--- a/stdlib/source/poly/lux/abstract/equivalence.lux
+++ b/stdlib/source/poly/lux/abstract/equivalence.lux
@@ -42,7 +42,7 @@
["." /]})
(poly: #export equivalence
- (`` (do {@ p.monad}
+ (`` (do {! p.monad}
[#let [g!_ (code.local-identifier "_____________")]
*env* <type>.env
inputT <type>.peek
@@ -52,7 +52,7 @@
($_ p.either
## Basic types
(~~ (template [<matcher> <eq>]
- [(do @
+ [(do !
[_ <matcher>]
(wrap (` (: (~ (@Equivalence inputT))
<eq>))))]
@@ -66,7 +66,7 @@
[(<type>.sub Text) (~! text.equivalence)]))
## Composite types
(~~ (template [<name> <eq>]
- [(do @
+ [(do !
[[_ argC] (<type>.apply (p.and (<type>.exactly <name>)
equivalence))]
(wrap (` (: (~ (@Equivalence inputT))
@@ -80,7 +80,7 @@
[set.Set (~! set.equivalence)]
[tree.Tree (~! tree.equivalence)]
))
- (do @
+ (do !
[[_ _ valC] (<type>.apply ($_ p.and
(<type>.exactly dictionary.Dictionary)
<type>.any
@@ -89,7 +89,7 @@
((~! dictionary.equivalence) (~ valC))))))
## Models
(~~ (template [<type> <eq>]
- [(do @
+ [(do !
[_ (<type>.exactly <type>)]
(wrap (` (: (~ (@Equivalence inputT))
<eq>))))]
@@ -100,13 +100,13 @@
[day.Day day.equivalence]
[month.Month month.equivalence]
))
- (do @
+ (do !
[_ (<type>.apply (p.and (<type>.exactly unit.Qty)
<type>.any))]
(wrap (` (: (~ (@Equivalence inputT))
unit.equivalence))))
## Variants
- (do @
+ (do !
[members (<type>.variant (p.many equivalence))
#let [last (dec (list.size members))
g!_ (code.local-identifier "_____________")
@@ -127,7 +127,7 @@
(~ g!_)
#0))))))
## Tuples
- (do @
+ (do !
[g!eqs (<type>.tuple (p.many equivalence))
#let [g!_ (code.local-identifier "_____________")
indices (list.indices (list.size g!eqs))
@@ -139,7 +139,7 @@
(list@map (function (_ [g!eq g!left g!right])
(` ((~ g!eq) (~ g!left) (~ g!right)))))))))))))
## Type recursion
- (do @
+ (do !
[[g!self bodyC] (<type>.recursive equivalence)
#let [g!_ (code.local-identifier "_____________")]]
(wrap (` (: (~ (@Equivalence inputT))
@@ -147,13 +147,13 @@
(~ bodyC)))))))
<type>.recursive-self
## Type applications
- (do @
+ (do !
[[funcC argsC] (<type>.apply (p.and equivalence (p.many equivalence)))]
(wrap (` ((~ funcC) (~+ argsC)))))
## Parameters
<type>.parameter
## Polymorphism
- (do @
+ (do !
[[funcC varsC bodyC] (<type>.polymorphic equivalence)]
(wrap (` (: (All [(~+ varsC)]
(-> (~+ (list@map (|>> (~) ((~! /.Equivalence)) (`)) varsC))
@@ -163,6 +163,6 @@
<type>.recursive-call
## If all else fails...
(|> <type>.any
- (:: @ map (|>> %.type (format "Cannot create Equivalence for: ") p.fail))
- (:: @ join))
+ (:: ! map (|>> %.type (format "Cannot create Equivalence for: ") p.fail))
+ (:: ! join))
))))
diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux
index d1219bf87..da14b2b6c 100644
--- a/stdlib/source/poly/lux/abstract/functor.lux
+++ b/stdlib/source/poly/lux/abstract/functor.lux
@@ -24,7 +24,7 @@
["." /]})
(poly: #export functor
- (do {@ p.monad}
+ (do {! p.monad}
[#let [type-funcC (code.local-identifier "____________type-funcC")
funcC (code.local-identifier "____________funcC")
inputC (code.local-identifier "____________inputC")]
@@ -49,7 +49,7 @@
_ (<type>.parameter! varI)]
(wrap (` ((~ funcC) (~ valueC)))))
## Variants
- (do @
+ (do !
[_ (wrap [])
membersC (<type>.variant (p.many (Arg<?> valueC)))
#let [last (dec (list.size membersC))]]
@@ -68,7 +68,7 @@
pairsCC (: (List [Code Code])
(list))]
(p.either (let [slotC (|> idx %.nat (format "____________slot") code.local-identifier)]
- (do @
+ (do !
[_ (wrap [])
memberC (Arg<?> slotC)]
(recur (inc idx)
@@ -78,7 +78,7 @@
[(~+ (list;map product.left pairsCC))]
[(~+ (list;map product.right pairsCC))]))))
## Functions
- (do @
+ (do !
[_ (wrap [])
#let [g! (code.local-identifier "____________")
outL (code.local-identifier "____________outL")]
diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux
index 1921ecd3a..9cc39c994 100644
--- a/stdlib/source/poly/lux/data/format/json.lux
+++ b/stdlib/source/poly/lux/data/format/json.lux
@@ -99,7 +99,7 @@
(poly: #export codec//encode
(with-expansions
[<basic> (template [<matcher> <encoder>]
- [(do @
+ [(do !
[#let [g!_ (code.local-identifier "_______")]
_ <matcher>]
(wrap (` (: (~ (@JSON//encode inputT))
@@ -112,7 +112,7 @@
[(<type>.sub Frac) (|>> #/.Number)]
[(<type>.sub Text) (|>> #/.String)])
<time> (template [<type> <codec>]
- [(do @
+ [(do !
[_ (<type>.exactly <type>)]
(wrap (` (: (~ (@JSON//encode inputT))
(|>> (:: (~! <codec>) (~' encode)) #/.String)))))]
@@ -122,7 +122,7 @@
[date.Date date.codec]
[day.Day day.codec]
[month.Month month.codec])]
- (do {@ p.monad}
+ (do {! p.monad}
[*env* <type>.env
#let [@JSON//encode (: (-> Type Code)
(function (_ type)
@@ -131,12 +131,12 @@
($_ p.either
<basic>
<time>
- (do @
+ (do !
[unitT (<type>.apply (p.after (<type>.exactly unit.Qty)
<type>.any))]
(wrap (` (: (~ (@JSON//encode inputT))
(:: (~! qty-codec) (~' encode))))))
- (do @
+ (do !
[#let [g!_ (code.local-identifier "_______")
g!key (code.local-identifier "_______key")
g!val (code.local-identifier "_______val")]
@@ -150,19 +150,19 @@
[(~ g!key) ((~ =val=) (~ g!val))]))
((~! d.from-list) (~! text.hash))
#/.Object)))))
- (do @
+ (do !
[[_ =sub=] (<type>.apply ($_ p.and
(<type>.exactly .Maybe)
codec//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
((~! ..nullable) (~ =sub=))))))
- (do @
+ (do !
[[_ =sub=] (<type>.apply ($_ p.and
(<type>.exactly .List)
codec//encode))]
(wrap (` (: (~ (@JSON//encode inputT))
(|>> ((~! list@map) (~ =sub=)) ((~! row.from-list)) #/.Array)))))
- (do @
+ (do !
[#let [g!_ (code.local-identifier "_______")
g!input (code.local-identifier "_______input")]
members (<type>.variant (p.many codec//encode))
@@ -181,7 +181,7 @@
#0
((~ g!encode) (~ g!input))])))))
(list.enumeration members))))))))))
- (do @
+ (do !
[g!encoders (<type>.tuple (p.many codec//encode))
#let [g!_ (code.local-identifier "_______")
g!members (|> (list.size g!encoders)
@@ -193,7 +193,7 @@
(` ((~ g!encode) (~ g!member))))
(list.zip/2 g!members g!encoders)))]))))))
## Type recursion
- (do @
+ (do !
[[selfC non-recC] (<type>.recursive codec//encode)
#let [g! (code.local-identifier "____________")]]
(wrap (` (: (~ (@JSON//encode inputT))
@@ -201,11 +201,11 @@
(~ non-recC)))))))
<type>.recursive-self
## Type applications
- (do @
+ (do !
[partsC (<type>.apply (p.many codec//encode))]
(wrap (` ((~+ partsC)))))
## Polymorphism
- (do @
+ (do !
[[funcC varsC bodyC] (<type>.polymorphic codec//encode)]
(wrap (` (: (All [(~+ varsC)]
(-> (~+ (list@map (function (_ varC) (` (-> (~ varC) /.JSON)))
@@ -223,7 +223,7 @@
(poly: #export codec//decode
(with-expansions
[<basic> (template [<matcher> <decoder>]
- [(do @
+ [(do !
[_ <matcher>]
(wrap (` (: (~ (@JSON//decode inputT))
(~! <decoder>)))))]
@@ -235,7 +235,7 @@
[(<type>.sub Frac) </>.number]
[(<type>.sub Text) </>.string])
<time> (template [<type> <codec>]
- [(do @
+ [(do !
[_ (<type>.exactly <type>)]
(wrap (` (: (~ (@JSON//decode inputT))
((~! p.codec) (~! <codec>) (~! </>.string))))))]
@@ -245,7 +245,7 @@
[date.Date date.codec]
[day.Day day.codec]
[month.Month month.codec])]
- (do {@ p.monad}
+ (do {! p.monad}
[*env* <type>.env
#let [@JSON//decode (: (-> Type Code)
(function (_ type)
@@ -254,29 +254,29 @@
($_ p.either
<basic>
<time>
- (do @
+ (do !
[unitT (<type>.apply (p.after (<type>.exactly unit.Qty)
<type>.any))]
(wrap (` (: (~ (@JSON//decode inputT))
((~! p.codec) (~! qty-codec) (~! </>.any))))))
- (do @
+ (do !
[[_ _ valC] (<type>.apply ($_ p.and
(<type>.exactly d.Dictionary)
(<type>.exactly .Text)
codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
((~! </>.dictionary) (~ valC))))))
- (do @
+ (do !
[[_ subC] (<type>.apply (p.and (<type>.exactly .Maybe)
codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
((~! </>.nullable) (~ subC))))))
- (do @
+ (do !
[[_ subC] (<type>.apply (p.and (<type>.exactly .List)
codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
((~! </>.array) ((~! p.some) (~ subC)))))))
- (do @
+ (do !
[members (<type>.variant (p.many codec//decode))
#let [last (dec (list.size members))]]
(wrap (` (: (~ (@JSON//decode inputT))
@@ -292,12 +292,12 @@
((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
((~! </>.array))))))
(list.enumeration members))))))))
- (do @
+ (do !
[g!decoders (<type>.tuple (p.many codec//decode))]
(wrap (` (: (~ (@JSON//decode inputT))
((~! </>.array) ($_ ((~! p.and)) (~+ g!decoders)))))))
## Type recursion
- (do @
+ (do !
[[selfC bodyC] (<type>.recursive codec//decode)
#let [g! (code.local-identifier "____________")]]
(wrap (` (: (~ (@JSON//decode inputT))
@@ -305,11 +305,11 @@
(~ bodyC)))))))
<type>.recursive-self
## Type applications
- (do @
+ (do !
[[funcC argsC] (<type>.apply (p.and codec//decode (p.many codec//decode)))]
(wrap (` ((~ funcC) (~+ argsC)))))
## Polymorphism
- (do @
+ (do !
[[funcC varsC bodyC] (<type>.polymorphic codec//decode)]
(wrap (` (: (All [(~+ varsC)]
(-> (~+ (list@map (|>> (~) </>.Parser (`)) varsC))
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-04 08:26:28 +0000