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.lux162
-rw-r--r--stdlib/source/poly/lux/abstract/functor.lux196
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux264
3 files changed, 311 insertions, 311 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux
index fab913843..e531aa9dd 100644
--- a/stdlib/source/poly/lux/abstract/equivalence.lux
+++ b/stdlib/source/poly/lux/abstract/equivalence.lux
@@ -1,61 +1,61 @@
(.using
- [library
- [lux "*"
- [abstract
- [monad {"+" Monad do}]]
- [control
- ["[0]" maybe]
- ["<>" parser
- ["<[0]>" type]]]
- [data
- ["[0]" product]
- ["[0]" bit]
- ["[0]" text ("[1]#[0]" monoid)
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" monad)]
- ["[0]" sequence]
- ["[0]" array]
- ["[0]" queue]
- ["[0]" set]
- ["[0]" dictionary {"+" Dictionary}]
- ["[0]" tree]]]
- [macro
- [syntax {"+" syntax:}]
- ["[0]" code]]
- [math
- [number
- ["[0]" nat ("[1]#[0]" decimal)]
- ["[0]" int]
- ["[0]" rev]
- ["[0]" frac]]]
- [time
- ["[0]" duration]
- ["[0]" date]
- ["[0]" instant]
- ["[0]" day]
- ["[0]" month]]
- ["[0]" type
- ["[0]" poly {"+" poly:}]
- ["[0]" unit]]]]
- [\\library
- ["[0]" /]])
+ [library
+ [lux "*"
+ [abstract
+ [monad {"+" Monad do}]]
+ [control
+ ["[0]" maybe]
+ ["<>" parser
+ ["<[0]>" type]]]
+ [data
+ ["[0]" product]
+ ["[0]" bit]
+ ["[0]" text ("[1]#[0]" monoid)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" monad)]
+ ["[0]" sequence]
+ ["[0]" array]
+ ["[0]" queue]
+ ["[0]" set]
+ ["[0]" dictionary {"+" Dictionary}]
+ ["[0]" tree]]]
+ [macro
+ [syntax {"+" syntax:}]
+ ["[0]" code]]
+ [math
+ [number
+ ["[0]" nat ("[1]#[0]" decimal)]
+ ["[0]" int]
+ ["[0]" rev]
+ ["[0]" frac]]]
+ [time
+ ["[0]" duration]
+ ["[0]" date]
+ ["[0]" instant]
+ ["[0]" day]
+ ["[0]" month]]
+ ["[0]" type
+ ["[0]" poly {"+" poly:}]
+ ["[0]" unit]]]]
+ [\\library
+ ["[0]" /]])
(poly: .public equivalence
(`` (do [! <>.monad]
[.let [g!_ (code.local_symbol "_____________")]
*env* <type>.env
inputT <type>.next
- .let [@Equivalence (: (-> Type Code)
- (function (_ type)
- (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]]
+ .let [@Equivalence (is (-> Type Code)
+ (function (_ type)
+ (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]]
($_ <>.either
... Basic types
(~~ (template [<matcher> <eq>]
[(do !
[_ <matcher>]
- (in (` (: (~ (@Equivalence inputT))
- <eq>))))]
+ (in (` (is (~ (@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))]
- (in (` (: (~ (@Equivalence inputT))
- (<eq> (~ argC))))))]
+ (in (` (is (~ (@Equivalence inputT))
+ (<eq> (~ argC))))))]
[.Maybe (~! maybe.equivalence)]
[.List (~! list.equivalence)]
@@ -85,14 +85,14 @@
(<type>.exactly dictionary.Dictionary)
<type>.any
equivalence))]
- (in (` (: (~ (@Equivalence inputT))
- ((~! dictionary.equivalence) (~ valC))))))
+ (in (` (is (~ (@Equivalence inputT))
+ ((~! dictionary.equivalence) (~ valC))))))
... Models
(~~ (template [<type> <eq>]
[(do !
[_ (<type>.exactly <type>)]
- (in (` (: (~ (@Equivalence inputT))
- <eq>))))]
+ (in (` (is (~ (@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))]
- (in (` (: (~ (@Equivalence inputT))
- unit.equivalence))))
+ (in (` (is (~ (@Equivalence inputT))
+ unit.equivalence))))
... Variants
(do !
[members (<type>.variant (<>.many equivalence))
@@ -112,20 +112,20 @@
g!_ (code.local_symbol "_____________")
g!left (code.local_symbol "_____________left")
g!right (code.local_symbol "_____________right")]]
- (in (` (: (~ (@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))))))
+ (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 (<type>.tuple (<>.many equivalence))
@@ -133,18 +133,18 @@
indices (list.indices (list.size g!eqs))
g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local_symbol) indices)
g!rights (list#each (|>> nat#encoded (text#composite "right") code.local_symbol) indices)]]
- (in (` (: (~ (@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)))))))))))))
+ (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] (<type>.recursive equivalence)
.let [g!_ (code.local_symbol "_____________")]]
- (in (` (: (~ (@Equivalence inputT))
- ((~! /.rec) (.function ((~ g!_) (~ g!self))
- (~ bodyC)))))))
+ (in (` (is (~ (@Equivalence inputT))
+ ((~! /.rec) (.function ((~ g!_) (~ g!self))
+ (~ bodyC)))))))
<type>.recursive_self
... Type applications
(do !
@@ -155,11 +155,11 @@
... Polymorphism
(do !
[[funcC varsC bodyC] (<type>.polymorphic equivalence)]
- (in (` (: (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC))
- ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC)))))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
+ (in (` (is (All ((~ g!_) (~+ varsC))
+ (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC))
+ ((~! /.Equivalence) ((~ (poly.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 65fb23ec6..52f237a54 100644
--- a/stdlib/source/poly/lux/abstract/functor.lux
+++ b/stdlib/source/poly/lux/abstract/functor.lux
@@ -1,28 +1,28 @@
(.using
- [library
- [lux "*"
- [abstract
- [monad {"+" Monad do}]]
- [control
- ["p" parser
- ["<[0]>" type]
- ["s" code {"+" Parser}]]]
- [data
- ["[0]" product]
- ["[0]" text
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" monad monoid)]]]
- [macro
- [syntax {"+" syntax:}]
- ["[0]" code]]
- [math
- [number
- ["n" nat]]]
- ["[0]" type
- ["[0]" poly {"+" poly:}]]]]
- [\\library
- ["[0]" /]])
+ [library
+ [lux "*"
+ [abstract
+ [monad {"+" Monad do}]]
+ [control
+ ["p" parser
+ ["<[0]>" type]
+ ["s" code {"+" Parser}]]]
+ [data
+ ["[0]" product]
+ ["[0]" text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" monad monoid)]]]
+ [macro
+ [syntax {"+" syntax:}]
+ ["[0]" code]]
+ [math
+ [number
+ ["n" nat]]]
+ ["[0]" type
+ ["[0]" poly {"+" poly:}]]]]
+ [\\library
+ ["[0]" /]])
(poly: .public functor
(do [! p.monad]
@@ -35,77 +35,77 @@
[polyC varsC non_functorT] (<type>.local (list inputT)
(<type>.polymorphic <type>.any))
.let [num_vars (list.size varsC)]
- .let [@Functor (: (-> 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_symbol)))]
- (` (All ((~ g!_) (~+ paramsC))
- ((~! /.Functor) ((~ (poly.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) --)]
- _ (<type>.parameter! varI)]
- (in (` ((~ funcC) (~ valueC)))))
- ... Variants
- (do !
- [_ (in [])
- membersC (<type>.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 (: (<type>.Parser (List [Code Code]))
- (<type>.tuple (loop [idx 0
- pairsCC (: (List [Code Code])
- (list))]
- (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local_symbol)]
- (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_symbol "____________")
- outL (code.local_symbol "____________outL")]
- [inT+ outC] (<type>.function (p.many <type>.any)
- (Arg<?> outL))
- .let [inC+ (|> (list.size inT+)
- list.indices
- (list#each (|>> %.nat (format "____________inC") code.local_symbol)))]]
- (in (` (function ((~ g!) (~+ inC+))
- (let [(~ outL) ((~ valueC) (~+ inC+))]
- (~ outC))))))
- ... Recursion
- (do p.monad
- [_ <type>.recursive_call]
- (in (` ((~' each) (~ funcC) (~ valueC)))))
- ... Parameters
- (do p.monad
- [_ <type>.any]
- (in valueC))
- )))]
- [_ _ outputC] (: (<type>.Parser [Code (List Code) Code])
- (p.either (<type>.polymorphic
- (Arg<?> inputC))
- (p.failure (format "Cannot create Functor for: " (%.type inputT)))))]
- (in (` (: (~ (@Functor inputT))
- (implementation
- (def: ((~' each) (~ funcC) (~ inputC))
- (~ outputC))))))))
+ .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_symbol)))]
+ (` (All ((~ g!_) (~+ paramsC))
+ ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC)))))))))
+ Arg<?> (is (-> Code (<type>.Parser Code))
+ (function (Arg<?> valueC)
+ ($_ p.either
+ ... Type-var
+ (do p.monad
+ [.let [varI (|> num_vars (n.* 2) --)]
+ _ (<type>.parameter! varI)]
+ (in (` ((~ funcC) (~ valueC)))))
+ ... Variants
+ (do !
+ [_ (in [])
+ membersC (<type>.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 (<type>.Parser (List [Code Code]))
+ (<type>.tuple (loop [idx 0
+ pairsCC (is (List [Code Code])
+ (list))]
+ (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local_symbol)]
+ (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_symbol "____________")
+ outL (code.local_symbol "____________outL")]
+ [inT+ outC] (<type>.function (p.many <type>.any)
+ (Arg<?> outL))
+ .let [inC+ (|> (list.size inT+)
+ list.indices
+ (list#each (|>> %.nat (format "____________inC") code.local_symbol)))]]
+ (in (` (function ((~ g!) (~+ inC+))
+ (let [(~ outL) ((~ valueC) (~+ inC+))]
+ (~ outC))))))
+ ... Recursion
+ (do p.monad
+ [_ <type>.recursive_call]
+ (in (` ((~' each) (~ funcC) (~ valueC)))))
+ ... Parameters
+ (do p.monad
+ [_ <type>.any]
+ (in valueC))
+ )))]
+ [_ _ outputC] (is (<type>.Parser [Code (List Code) Code])
+ (p.either (<type>.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/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux
index 0985eb5ed..67f6fb464 100644
--- a/stdlib/source/poly/lux/data/format/json.lux
+++ b/stdlib/source/poly/lux/data/format/json.lux
@@ -1,43 +1,43 @@
(.using
- [library
- [lux "*"
- ["[0]" debug]
- [abstract
- [monad {"+" do}]
- ["[0]" codec]]
- [control
- ["[0]" try]
- ["<>" parser
- ["</>" json]
- ["<[0]>" type]
- ["<[0]>" code]]]
- [data
- ["[0]" text
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" monad)]
- ["[0]" sequence {"+" sequence}]
- ["[0]" dictionary]]]
- [macro
- [syntax {"+" syntax:}]
- ["[0]" code]]
- [math
- [number
- ["n" nat ("[1]#[0]" decimal)]
- ["[0]" i64]
- ["[0]" int]
- ["[0]" frac]]]
- [time
- ... ["[0]" instant]
- ... ["[0]" duration]
- ["[0]" date]
- ["[0]" day]
- ["[0]" month]]
- ["[0]" type
- ["[0]" unit]
- ["[0]" poly {"+" poly:}]]]]
- [\\library
- ["[0]" / {"+" JSON}]])
+ [library
+ [lux "*"
+ ["[0]" debug]
+ [abstract
+ [monad {"+" do}]
+ ["[0]" codec]]
+ [control
+ ["[0]" try]
+ ["<>" parser
+ ["</>" json]
+ ["<[0]>" type]
+ ["<[0]>" code]]]
+ [data
+ ["[0]" text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" monad)]
+ ["[0]" sequence {"+" sequence}]
+ ["[0]" dictionary]]]
+ [macro
+ [syntax {"+" syntax:}]
+ ["[0]" code]]
+ [math
+ [number
+ ["n" nat ("[1]#[0]" decimal)]
+ ["[0]" i64]
+ ["[0]" int]
+ ["[0]" frac]]]
+ [time
+ ... ["[0]" instant]
+ ... ["[0]" duration]
+ ["[0]" date]
+ ["[0]" day]
+ ["[0]" month]]
+ ["[0]" type
+ ["[0]" unit]
+ ["[0]" poly {"+" poly:}]]]]
+ [\\library
+ ["[0]" / {"+" JSON}]])
(def: tag
(-> Nat Frac)
@@ -102,8 +102,8 @@
[(do !
[.let [g!_ (code.local_symbol "_______")]
_ <matcher>]
- (in (` (: (~ (@JSON#encoded inputT))
- <encoder>))))]
+ (in (` (is (~ (@JSON#encoded inputT))
+ <encoder>))))]
[(<type>.exactly Any) (function ((~ g!_) (~ (code.symbol ["" "0"]))) {/.#Null})]
[(<type>.sub Bit) (|>> {/.#Boolean})]
@@ -114,8 +114,8 @@
<time> (template [<type> <codec>]
[(do !
[_ (<type>.exactly <type>)]
- (in (` (: (~ (@JSON#encoded inputT))
- (|>> (# (~! <codec>) (~' encoded)) {/.#String})))))]
+ (in (` (is (~ (@JSON#encoded inputT))
+ (|>> (# (~! <codec>) (~' encoded)) {/.#String})))))]
... [duration.Duration duration.codec]
... [instant.Instant instant.codec]
@@ -125,9 +125,9 @@
(do [! <>.monad]
[*env* <type>.env
.let [g!_ (code.local_symbol "_______")
- @JSON#encoded (: (-> Type Code)
- (function (_ type)
- (` (-> (~ (poly.code *env* type)) /.JSON))))]
+ @JSON#encoded (is (-> Type Code)
+ (function (_ type)
+ (` (-> (~ (poly.code *env* type)) /.JSON))))]
inputT <type>.next]
($_ <>.either
<basic>
@@ -135,8 +135,8 @@
(do !
[unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
<type>.any))]
- (in (` (: (~ (@JSON#encoded inputT))
- (# (~! qty_codec) (~' encoded))))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ (# (~! qty_codec) (~' encoded))))))
(do !
[.let [g!_ (code.local_symbol "_______")
g!key (code.local_symbol "_______key")
@@ -145,61 +145,61 @@
(<type>.exactly dictionary.Dictionary)
(<type>.exactly .Text)
encoded))]
- (in (` (: (~ (@JSON#encoded inputT))
- (|>> ((~! dictionary.entries))
- ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)])
- [(~ g!key) ((~ =val=) (~ g!val))]))
- ((~! dictionary.of_list) (~! text.hash))
- {/.#Object})))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ (|>> ((~! dictionary.entries))
+ ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)])
+ [(~ g!key) ((~ =val=) (~ g!val))]))
+ ((~! dictionary.of_list) (~! text.hash))
+ {/.#Object})))))
(do !
[[_ =sub=] (<type>.applied ($_ <>.and
(<type>.exactly .Maybe)
encoded))]
- (in (` (: (~ (@JSON#encoded inputT))
- ((~! ..nullable) (~ =sub=))))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ ((~! ..nullable) (~ =sub=))))))
(do !
[[_ =sub=] (<type>.applied ($_ <>.and
(<type>.exactly .List)
encoded))]
- (in (` (: (~ (@JSON#encoded inputT))
- (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array})))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array})))))
(do !
[.let [g!_ (code.local_symbol "_______")
g!input (code.local_symbol "_______input")]
members (<type>.variant (<>.many encoded))
.let [last (-- (list.size members))]]
- (in (` (: (~ (@JSON#encoded inputT))
- (function ((~ g!_) (~ g!input))
- (case (~ g!input)
- (~+ (list#conjoint (list#each (function (_ [tag g!encoded])
- (if (n.= last tag)
- (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)})
- (` ((~! /.json) [(~ (code.frac (..tag (-- tag))))
- #1
- ((~ g!encoded) (~ g!input))])))
- (.list (` {(~ (code.nat tag)) #0 (~ g!input)})
- (` ((~! /.json) [(~ (code.frac (..tag tag)))
- #0
- ((~ g!encoded) (~ g!input))])))))
- (list.enumeration members))))))))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ (function ((~ g!_) (~ g!input))
+ (case (~ g!input)
+ (~+ (list#conjoint (list#each (function (_ [tag g!encoded])
+ (if (n.= last tag)
+ (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)})
+ (` ((~! /.json) [(~ (code.frac (..tag (-- tag))))
+ #1
+ ((~ g!encoded) (~ g!input))])))
+ (.list (` {(~ (code.nat tag)) #0 (~ g!input)})
+ (` ((~! /.json) [(~ (code.frac (..tag tag)))
+ #0
+ ((~ g!encoded) (~ g!input))])))))
+ (list.enumeration members))))))))))
(do !
[g!encoders (<type>.tuple (<>.many encoded))
.let [g!_ (code.local_symbol "_______")
g!members (|> (list.size g!encoders)
list.indices
(list#each (|>> n#encoded code.local_symbol)))]]
- (in (` (: (~ (@JSON#encoded inputT))
- (function ((~ g!_) [(~+ g!members)])
- ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded])
- (` ((~ g!encoded) (~ g!member))))
- (list.zipped/2 g!members g!encoders)))]))))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ (function ((~ g!_) [(~+ g!members)])
+ ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded])
+ (` ((~ g!encoded) (~ g!member))))
+ (list.zipped/2 g!members g!encoders)))]))))))
... Type recursion
(do !
[[selfC non_recC] (<type>.recursive encoded)
.let [g! (code.local_symbol "____________")]]
- (in (` (: (~ (@JSON#encoded inputT))
- ((~! ..rec_encoded) (.function ((~ g!) (~ selfC))
- (~ non_recC)))))))
+ (in (` (is (~ (@JSON#encoded inputT))
+ ((~! ..rec_encoded) (.function ((~ g!) (~ selfC))
+ (~ non_recC)))))))
<type>.recursive_self
... Type applications
(do !
@@ -208,13 +208,13 @@
... Polymorphism
(do !
[[funcC varsC bodyC] (<type>.polymorphic encoded)]
- (in (` (: (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON)))
- varsC))
- (-> ((~ (poly.code *env* inputT)) (~+ varsC))
- /.JSON)))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
+ (in (` (is (All ((~ g!_) (~+ varsC))
+ (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON)))
+ varsC))
+ (-> ((~ (poly.code *env* inputT)) (~+ varsC))
+ /.JSON)))
+ (function ((~ funcC) (~+ varsC))
+ (~ bodyC))))))
<type>.parameter
<type>.recursive_call
... If all else fails...
@@ -226,8 +226,8 @@
[<basic> (template [<matcher> <decoder>]
[(do !
[_ <matcher>]
- (in (` (: (~ (@JSON#decoded inputT))
- (~! <decoder>)))))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ (~! <decoder>)))))]
[(<type>.exactly Any) </>.null]
[(<type>.sub Bit) </>.boolean]
@@ -238,8 +238,8 @@
<time> (template [<type> <codec>]
[(do !
[_ (<type>.exactly <type>)]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! <>.codec) (~! <codec>) (~! </>.string))))))]
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! <>.codec) (~! <codec>) (~! </>.string))))))]
... [duration.Duration duration.codec]
... [instant.Instant instant.codec]
@@ -249,9 +249,9 @@
(do [! <>.monad]
[*env* <type>.env
.let [g!_ (code.local_symbol "_______")
- @JSON#decoded (: (-> Type Code)
- (function (_ type)
- (` (</>.Parser (~ (poly.code *env* type))))))]
+ @JSON#decoded (is (-> Type Code)
+ (function (_ type)
+ (` (</>.Parser (~ (poly.code *env* type))))))]
inputT <type>.next]
($_ <>.either
<basic>
@@ -259,52 +259,52 @@
(do !
[unitT (<type>.applied (<>.after (<type>.exactly unit.Qty)
<type>.any))]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! <>.codec) (~! qty_codec) (~! </>.any))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! <>.codec) (~! qty_codec) (~! </>.any))))))
(do !
[[_ _ valC] (<type>.applied ($_ <>.and
(<type>.exactly dictionary.Dictionary)
(<type>.exactly .Text)
decoded))]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! </>.dictionary) (~ valC))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.dictionary) (~ valC))))))
(do !
[[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe)
decoded))]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! </>.nullable) (~ subC))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.nullable) (~ subC))))))
(do !
[[_ subC] (<type>.applied (<>.and (<type>.exactly .List)
decoded))]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! </>.array) ((~! <>.some) (~ subC)))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.array) ((~! <>.some) (~ subC)))))))
(do !
[members (<type>.variant (<>.many decoded))
.let [last (-- (list.size members))]]
- (in (` (: (~ (@JSON#decoded inputT))
- ($_ ((~! <>.or))
- (~+ (list#each (function (_ [tag memberC])
- (if (n.= last tag)
- (` (|> (~ memberC)
- ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1))))
- ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (-- tag))))))
- ((~! </>.array))))
- (` (|> (~ memberC)
- ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0))))
- ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
- ((~! </>.array))))))
- (list.enumeration members))))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ($_ ((~! <>.or))
+ (~+ (list#each (function (_ [tag memberC])
+ (if (n.= last tag)
+ (` (|> (~ memberC)
+ ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1))))
+ ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (-- tag))))))
+ ((~! </>.array))))
+ (` (|> (~ memberC)
+ ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0))))
+ ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag)))))
+ ((~! </>.array))))))
+ (list.enumeration members))))))))
(do !
[g!decoders (<type>.tuple (<>.many decoded))]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders)))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders)))))))
... Type recursion
(do !
[[selfC bodyC] (<type>.recursive decoded)
.let [g! (code.local_symbol "____________")]]
- (in (` (: (~ (@JSON#decoded inputT))
- ((~! <>.rec) (.function ((~ g!) (~ selfC))
- (~ bodyC)))))))
+ (in (` (is (~ (@JSON#decoded inputT))
+ ((~! <>.rec) (.function ((~ g!) (~ selfC))
+ (~ bodyC)))))))
<type>.recursive_self
... Type applications
(do !
@@ -313,11 +313,11 @@
... Polymorphism
(do !
[[funcC varsC bodyC] (<type>.polymorphic decoded)]
- (in (` (: (All ((~ g!_) (~+ varsC))
- (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC))
- (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC)))))
- (function ((~ funcC) (~+ varsC))
- (~ bodyC))))))
+ (in (` (is (All ((~ g!_) (~+ varsC))
+ (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC))
+ (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC)))))
+ (function ((~ funcC) (~+ varsC))
+ (~ bodyC))))))
<type>.parameter
<type>.recursive_call
... If all else fails...
@@ -325,10 +325,10 @@
))))
(syntax: .public (codec [inputT <code>.any])
- (in (.list (` (: (codec.Codec /.JSON (~ inputT))
- (implementation
- (def: (~' encoded)
- ((~! ..encoded) (~ inputT)))
- (def: (~' decoded)
- ((~! </>.result) ((~! ..decoded) (~ inputT))))
- ))))))
+ (in (.list (` (is (codec.Codec /.JSON (~ inputT))
+ (implementation
+ (def: (~' encoded)
+ ((~! ..encoded) (~ inputT)))
+ (def: (~' decoded)
+ ((~! </>.result) ((~! ..decoded) (~ inputT))))
+ ))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 14:44:19 +0000