diff options
author | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-29 04:51:04 -0400 |
commit | 8c5cca122817bc63f4f84cc8351ced3cb67e5eea (patch) | |
tree | 8803dd3ed59ddcc6b964354fd312ab9e62e12cd8 /stdlib/source/lux/macro/poly | |
parent | 1ef969c8ce0f1a83ffa8d26d779806190ac3eced (diff) |
- Changed the identifier separator, from the semi-colon (;) to the period/dot (.).
Diffstat (limited to 'stdlib/source/lux/macro/poly')
-rw-r--r-- | stdlib/source/lux/macro/poly/eq.lux | 112 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly/functor.lux | 76 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly/json.lux | 250 |
3 files changed, 219 insertions, 219 deletions
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 55927e614..46feab967 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [eq] @@ -31,13 +31,13 @@ ## [Derivers] (poly: #export Eq<?> (`` (do @ - [#let [g!_ (code;local-symbol "\u0000_")] - *env* poly;env - inputT poly;peek + [#let [g!_ (code.local-symbol "\u0000_")] + *env* poly.env + inputT poly.peek #let [@Eq (: (-> Type Code) (function [type] - (` (eq;Eq (~ (poly;to-ast *env* type))))))]] - ($_ p;either + (` (eq.Eq (~ (poly.to-ast *env* type))))))]] + ($_ p.either ## Basic types (~~ (do-template [<matcher> <eq>] [(do @ @@ -45,103 +45,103 @@ (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [poly;unit (function [(~ g!_) (~ g!_)] true)] - [poly;bool bool;Eq<Bool>] - [poly;nat number;Eq<Nat>] - [poly;int number;Eq<Int>] - [poly;deg number;Eq<Deg>] - [poly;frac number;Eq<Frac>] - [poly;text text;Eq<Text>])) + [poly.unit (function [(~ g!_) (~ g!_)] true)] + [poly.bool bool.Eq<Bool>] + [poly.nat number.Eq<Nat>] + [poly.int number.Eq<Int>] + [poly.deg number.Eq<Deg>] + [poly.frac number.Eq<Frac>] + [poly.text text.Eq<Text>])) ## Composite types (~~ (do-template [<name> <eq>] [(do @ - [[_ argC] (poly;apply (p;seq (poly;this <name>) + [[_ argC] (poly.apply (p.seq (poly.this <name>) Eq<?>))] (wrap (` (: (~ (@Eq inputT)) (<eq> (~ argC))))))] - [;Maybe maybe;Eq<Maybe>] - [;List list;Eq<List>] - [sequence;Sequence sequence;Eq<Sequence>] - [;Array array;Eq<Array>] - [queue;Queue queue;Eq<Queue>] - [set;Set set;Eq<Set>] - [rose;Tree rose;Eq<Tree>] + [.Maybe maybe.Eq<Maybe>] + [.List list.Eq<List>] + [sequence.Sequence sequence.Eq<Sequence>] + [.Array array.Eq<Array>] + [queue.Queue queue.Eq<Queue>] + [set.Set set.Eq<Set>] + [rose.Tree rose.Eq<Tree>] )) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this dict;Dict) - poly;any + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this dict.Dict) + poly.any Eq<?>))] (wrap (` (: (~ (@Eq inputT)) - (dict;Eq<Dict> (~ valC)))))) + (dict.Eq<Dict> (~ valC)))))) ## Models (~~ (do-template [<type> <eq>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@Eq inputT)) <eq>))))] - [du;Duration du;Eq<Duration>] - [i;Instant i;Eq<Instant>] - [da;Date da;Eq<Date>] - [da;Day da;Eq<Day>] - [da;Month da;Eq<Month>])) + [du.Duration du.Eq<Duration>] + [i.Instant i.Eq<Instant>] + [da.Date da.Eq<Date>] + [da.Day da.Eq<Day>] + [da.Month da.Eq<Month>])) (do @ - [_ (poly;apply (p;seq (poly;this unit;Qty) - poly;any))] + [_ (poly.apply (p.seq (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@Eq inputT)) - unit;Eq<Qty>)))) + unit.Eq<Qty>)))) ## Variants (do @ - [members (poly;variant (p;many Eq<?>)) - #let [g!left (code;local-symbol "\u0000left") - g!right (code;local-symbol "\u0000right")]] + [members (poly.variant (p.many Eq<?>)) + #let [g!left (code.local-symbol "\u0000left") + g!right (code.local-symbol "\u0000right")]] (wrap (` (: (~ (@Eq inputT)) (function [(~ g!left) (~ g!right)] (case [(~ g!left) (~ g!right)] (~@ (list/join (list/map (function [[tag g!eq]] - (list (` [((~ (code;nat tag)) (~ g!left)) - ((~ (code;nat tag)) (~ g!right))]) + (list (` [((~ (code.nat tag)) (~ g!left)) + ((~ (code.nat tag)) (~ g!right))]) (` ((~ g!eq) (~ g!left) (~ g!right))))) - (list;enumerate members)))) + (list.enumerate members)))) (~ g!_) false)))))) ## Tuples (do @ - [g!eqs (poly;tuple (p;many Eq<?>)) - #let [indices (|> (list;size g!eqs) n/dec (list;n/range +0)) - g!lefts (list/map (|>> nat/encode (text/compose "left") code;local-symbol) indices) - g!rights (list/map (|>> nat/encode (text/compose "right") code;local-symbol) indices)]] + [g!eqs (poly.tuple (p.many Eq<?>)) + #let [indices (|> (list.size g!eqs) n/dec (list.n/range +0)) + g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) + g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) (function [[(~@ g!lefts)] [(~@ g!rights)]] - (and (~@ (|> (list;zip3 g!eqs g!lefts g!rights) + (and (~@ (|> (list.zip3 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] (poly;recursive Eq<?>)] + [[g!self bodyC] (poly.recursive Eq<?>)] (wrap (` (: (~ (@Eq inputT)) - (eq;rec (;function [(~ g!self)] + (eq.rec (.function [(~ g!self)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Eq<?> (p;many Eq<?>)))] + [[funcC argsC] (poly.apply (p.seq Eq<?> (p.many Eq<?>)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Bound type-vars - poly;bound + poly.bound ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Eq<?>)] + [[funcC varsC bodyC] (poly.polymorphic Eq<?>)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) eq;Eq (`)) varsC)) - (eq;Eq ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) eq.Eq (`)) varsC)) + (eq.Eq ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;recursive-call + poly.recursive-call ## If all else fails... - (|> poly;any - (:: @ map (|>> %type (format "Cannot create Eq for: ") p;fail)) + (|> poly.any + (:: @ map (|>> %type (format "Cannot create Eq for: ") p.fail)) (:: @ join)) )))) diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index edd3efcc2..fbd8dcd03 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do Monad] [functor] @@ -17,45 +17,45 @@ (poly: #export Functor<?> (do @ - [#let [type-funcC (code;local-symbol "\u0000type-funcC") - funcC (code;local-symbol "\u0000funcC") - inputC (code;local-symbol "\u0000inputC")] - *env* poly;env - inputT poly;peek - [polyC varsC non-functorT] (poly;local (list inputT) - (poly;polymorphic poly;any)) - #let [num-vars (list;size varsC)] + [#let [type-funcC (code.local-symbol "\u0000type-funcC") + funcC (code.local-symbol "\u0000funcC") + inputC (code.local-symbol "\u0000inputC")] + *env* poly.env + inputT poly.peek + [polyC varsC non-functorT] (poly.local (list inputT) + (poly.polymorphic poly.any)) + #let [num-vars (list.size varsC)] #let [@Functor (: (-> Type Code) (function [unwrappedT] (if (n/= +1 num-vars) - (` (functor;Functor (~ (poly;to-ast *env* unwrappedT)))) - (let [paramsC (|> num-vars n/dec list;indices (L/map (|>> %n code;local-symbol)))] + (` (functor.Functor (~ (poly.to-ast *env* unwrappedT)))) + (let [paramsC (|> num-vars n/dec list.indices (L/map (|>> %n code.local-symbol)))] (` (All [(~@ paramsC)] - (functor;Functor ((~ (poly;to-ast *env* unwrappedT)) (~@ paramsC))))))))) - Arg<?> (: (-> Code (poly;Poly Code)) + (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~@ paramsC))))))))) + Arg<?> (: (-> Code (poly.Poly Code)) (function Arg<?> [valueC] - ($_ p;either + ($_ p.either ## Type-var - (do p;Monad<Parser> + (do p.Monad<Parser> [#let [varI (|> num-vars (n/* +2) n/dec)] - _ (poly;var varI)] + _ (poly.var varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants (do @ [_ (wrap []) - membersC (poly;variant (p;many (Arg<?> valueC)))] + membersC (poly.variant (p.many (Arg<?> valueC)))] (wrap (` (case (~ valueC) (~@ (L/join (L/map (function [[tag memberC]] - (list (` ((~ (code;nat tag)) (~ valueC))) - (` ((~ (code;nat tag)) (~ memberC))))) - (list;enumerate membersC)))))))) + (list (` ((~ (code.nat tag)) (~ valueC))) + (` ((~ (code.nat tag)) (~ memberC))))) + (list.enumerate membersC)))))))) ## Tuples - (do p;Monad<Parser> - [pairsCC (: (poly;Poly (List [Code Code])) - (poly;tuple (loop [idx +0 + (do p.Monad<Parser> + [pairsCC (: (poly.Poly (List [Code Code])) + (poly.tuple (loop [idx +0 pairsCC (: (List [Code Code]) (list))] - (p;either (let [slotC (|> idx %n (format "\u0000slot") code;local-symbol)] + (p.either (let [slotC (|> idx %n (format "\u0000slot") code.local-symbol)] (do @ [_ (wrap []) memberC (Arg<?> slotC)] @@ -63,33 +63,33 @@ (L/compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) - [(~@ (L/map product;left pairsCC))] - [(~@ (L/map product;right pairsCC))])))) + [(~@ (L/map product.left pairsCC))] + [(~@ (L/map product.right pairsCC))])))) ## Functions (do @ [_ (wrap []) - #let [outL (code;local-symbol "\u0000outL")] - [inT+ outC] (poly;function (p;many poly;any) + #let [outL (code.local-symbol "\u0000outL")] + [inT+ outC] (poly.function (p.many poly.any) (Arg<?> outL)) - #let [inC+ (|> (list;size inT+) n/dec - (list;n/range +0) - (L/map (|>> %n (format "\u0000inC") code;local-symbol)))]] + #let [inC+ (|> (list.size inT+) n/dec + (list.n/range +0) + (L/map (|>> %n (format "\u0000inC") code.local-symbol)))]] (wrap (` (function [(~@ inC+)] (let [(~ outL) ((~ valueC) (~@ inC+))] (~ outC)))))) ## Recursion - (do p;Monad<Parser> - [_ poly;recursive-call] + (do p.Monad<Parser> + [_ poly.recursive-call] (wrap (` ((~' map) (~ funcC) (~ valueC))))) ## Bound type-variables - (do p;Monad<Parser> - [_ poly;any] + (do p.Monad<Parser> + [_ poly.any] (wrap valueC)) )))] - [_ _ outputC] (: (poly;Poly [Code (List Code) Code]) - (p;either (poly;polymorphic + [_ _ outputC] (: (poly.Poly [Code (List Code) Code]) + (p.either (poly.polymorphic (Arg<?> inputC)) - (p;fail (format "Cannot create Functor for: " (%type inputT)))))] + (p.fail (format "Cannot create Functor for: " (%type inputT)))))] (wrap (` (: (~ (@Functor inputT)) (struct (def: ((~' map) (~ funcC) (~ inputC)) (~ outputC)))))))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index d001d4839..3a5148377 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Codecs for values in the JSON format."} +(.module: {#.doc "Codecs for values in the JSON format."} lux (lux (control [monad #+ do Monad] [eq #+ Eq] @@ -43,42 +43,42 @@ (function [input] (non-rec (rec-encode non-rec) input))) -(def: low-mask Nat (|> +1 (bit;shift-left +32) n/dec)) -(def: high-mask Nat (|> low-mask (bit;shift-left +32))) +(def: low-mask Nat (|> +1 (bit.shift-left +32) n/dec)) +(def: high-mask Nat (|> low-mask (bit.shift-left +32))) (struct: #hidden _ (Codec JSON Nat) (def: (encode input) - (let [high (|> input (bit;and high-mask) (bit;shift-right +32)) - low (bit;and low-mask input)] - (#//;Array (sequence (|> high nat-to-int int-to-frac #//;Number) - (|> low nat-to-int int-to-frac #//;Number))))) + (let [high (|> input (bit.and high-mask) (bit.shift-right +32)) + low (bit.and low-mask input)] + (#//.Array (sequence (|> high nat-to-int int-to-frac #//.Number) + (|> low nat-to-int int-to-frac #//.Number))))) (def: (decode input) - (<| (//;run input) - (do p;Monad<Parser> - [high //;number - low //;number]) - (wrap (n/+ (|> high frac-to-int int-to-nat (bit;shift-left +32)) + (<| (//.run input) + (do p.Monad<Parser> + [high //.number + low //.number]) + (wrap (n/+ (|> high frac-to-int int-to-nat (bit.shift-left +32)) (|> low frac-to-int int-to-nat)))))) (struct: #hidden _ (Codec JSON Int) (def: encode (|>> int-to-nat (:: Codec<JSON,Nat> encode))) (def: decode - (|>> (:: Codec<JSON,Nat> decode) (:: e;Functor<Error> map nat-to-int)))) + (|>> (:: Codec<JSON,Nat> decode) (:: e.Functor<Error> map nat-to-int)))) (def: #hidden (nullable writer) - {#;doc "Builds a JSON generator for potentially inexistent values."} + {#.doc "Builds a JSON generator for potentially inexistent values."} (All [a] (-> (-> a JSON) (-> (Maybe a) JSON))) (function [elem] (case elem - #;None #//;Null - (#;Some value) (writer value)))) + #.None #//.Null + (#.Some value) (writer value)))) (struct: #hidden (Codec<JSON,Qty> carrier) - (All [unit] (-> unit (Codec JSON (unit;Qty unit)))) + (All [unit] (-> unit (Codec JSON (unit.Qty unit)))) (def: encode - (|>> unit;out (:: Codec<JSON,Int> encode))) + (|>> unit.out (:: Codec<JSON,Int> encode))) (def: decode - (|>> (:: Codec<JSON,Int> decode) (:: e;Functor<Error> map (unit;in carrier))))) + (|>> (:: Codec<JSON,Int> decode) (:: e.Functor<Error> map (unit.in carrier))))) (poly: #hidden Codec<JSON,?>//encode (with-expansions @@ -88,108 +88,108 @@ (wrap (` (: (~ (@JSON//encode inputT)) <encoder>))))] - [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #//;Null)] - [Bool poly;bool (|>> #//;Boolean)] - [Nat poly;nat (:: ;;Codec<JSON,Nat> (~' encode))] - [Int poly;int (:: ;;Codec<JSON,Int> (~' encode))] - [Frac poly;frac (|>> #//;Number)] - [Text poly;text (|>> #//;String)]) + [Unit poly.unit (function [(~ (code.symbol ["" "0"]))] #//.Null)] + [Bool poly.bool (|>> #//.Boolean)] + [Nat poly.nat (:: ..Codec<JSON,Nat> (~' encode))] + [Int poly.int (:: ..Codec<JSON,Int> (~' encode))] + [Frac poly.frac (|>> #//.Number)] + [Text poly.text (|>> #//.String)]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (:: <codec> (~' encode)) #//;String)))))] + (|>> (:: <codec> (~' encode)) #//.String)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//encode (: (-> Type Code) (function [type] - (` (-> (~ (poly;to-ast *env* type)) //;JSON))))] - inputT poly;peek] - ($_ p;either + (` (-> (~ (poly.to-ast *env* type)) //.JSON))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//encode inputT)) - (:: (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) (~' encode)))))) + (:: (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) (~' encode)))))) (do @ - [#let [g!key (code;local-symbol "\u0000key") - g!val (code;local-symbol "\u0000val")] - [_ _ .val.] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [#let [g!key (code.local-symbol "\u0000key") + g!val (code.local-symbol "\u0000val")] + [_ _ =val=] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> d;entries - (;;_map_ (function [[(~ g!key) (~ g!val)]] - [(~ g!key) ((~ .val.) (~ g!val))])) - (d;from-list text;Hash<Text>) - #//;Object))))) + (|>> d.entries + (.._map_ (function [[(~ g!key) (~ g!val)]] + [(~ g!key) ((~ =val=) (~ g!val))])) + (d.from-list text.Hash<Text>) + #//.Object))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;Maybe) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .Maybe) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (;;nullable (~ .sub.)))))) + (..nullable (~ =sub=)))))) (do @ - [[_ .sub.] (poly;apply ($_ p;seq - (poly;this ;List) + [[_ =sub=] (poly.apply ($_ p.seq + (poly.this .List) Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) - (|>> (;;_map_ (~ .sub.)) sequence;from-list #//;Array))))) + (|>> (.._map_ (~ =sub=)) sequence.from-list #//.Array))))) (do @ - [#let [g!input (code;local-symbol "\u0000input")] - members (poly;variant (p;many Codec<JSON,?>//encode))] + [#let [g!input (code.local-symbol "\u0000input")] + members (poly.variant (p.many Codec<JSON,?>//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (function [(~ g!input)] (case (~ g!input) (~@ (list/join (list/map (function [[tag g!encode]] - (list (` ((~ (code;nat tag)) (~ g!input))) - (` (//;json [(~ (code;frac (;;tag tag))) + (list (` ((~ (code.nat tag)) (~ g!input))) + (` (//.json [(~ (code.frac (..tag tag))) ((~ g!encode) (~ g!input))])))) - (list;enumerate members)))))))))) + (list.enumerate members)))))))))) (do @ - [g!encoders (poly;tuple (p;many Codec<JSON,?>//encode)) - #let [g!members (|> (list;size g!encoders) n/dec - (list;n/range +0) - (list/map (|>> nat/encode code;local-symbol)))]] + [g!encoders (poly.tuple (p.many Codec<JSON,?>//encode)) + #let [g!members (|> (list.size g!encoders) n/dec + (list.n/range +0) + (list/map (|>> nat/encode code.local-symbol)))]] (wrap (` (: (~ (@JSON//encode inputT)) (function [[(~@ g!members)]] - (//;json [(~@ (list/map (function [[g!member g!encode]] + (//.json [(~@ (list/map (function [[g!member g!encode]] (` ((~ g!encode) (~ g!member)))) - (list;zip2 g!members g!encoders)))])))))) + (list.zip2 g!members g!encoders)))])))))) ## Type recursion (do @ - [[selfC non-recC] (poly;recursive Codec<JSON,?>//encode)] + [[selfC non-recC] (poly.recursive Codec<JSON,?>//encode)] (wrap (` (: (~ (@JSON//encode inputT)) - (;;rec-encode (;function [(~ selfC)] + (..rec-encode (.function [(~ selfC)] (~ non-recC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [partsC (poly;apply (p;many Codec<JSON,?>//encode))] + [partsC (poly.apply (p.many Codec<JSON,?>//encode))] (wrap (` ((~@ partsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//encode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (function [varC] (` (-> (~ varC) //;JSON))) + (-> (~@ (list/map (function [varC] (` (-> (~ varC) //.JSON))) varsC)) - (-> ((~ (poly;to-ast *env* inputT)) (~@ varsC)) - //;JSON))) + (-> ((~ (poly.to-ast *env* inputT)) (~@ varsC)) + //.JSON))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON encoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON encoder for: " (type.to-text inputT))) )))) (poly: #hidden Codec<JSON,?>//decode @@ -200,94 +200,94 @@ (wrap (` (: (~ (@JSON//decode inputT)) <decoder>))))] - [Unit poly;unit //;null] - [Bool poly;bool //;boolean] - [Nat poly;nat (p;codec ;;Codec<JSON,Nat> //;any)] - [Int poly;int (p;codec ;;Codec<JSON,Int> //;any)] - [Frac poly;frac //;number] - [Text poly;text //;string]) + [Unit poly.unit //.null] + [Bool poly.bool //.boolean] + [Nat poly.nat (p.codec ..Codec<JSON,Nat> //.any)] + [Int poly.int (p.codec ..Codec<JSON,Int> //.any)] + [Frac poly.frac //.number] + [Text poly.text //.string]) <time> (do-template [<type> <codec>] [(do @ - [_ (poly;this <type>)] + [_ (poly.this <type>)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec <codec> //;string)))))] + (p.codec <codec> //.string)))))] - [du;Duration du;Codec<Text,Duration>] - [i;Instant i;Codec<Text,Instant>] - [da;Date da;Codec<Text,Date>] - [da;Day da;Codec<Text,Day>] - [da;Month da;Codec<Text,Month>])] + [du.Duration du.Codec<Text,Duration>] + [i.Instant i.Codec<Text,Instant>] + [da.Date da.Codec<Text,Date>] + [da.Day da.Codec<Text,Day>] + [da.Month da.Codec<Text,Month>])] (do @ - [*env* poly;env + [*env* poly.env #let [@JSON//decode (: (-> Type Code) (function [type] - (` (//;Reader (~ (poly;to-ast *env* type))))))] - inputT poly;peek] - ($_ p;either + (` (//.Reader (~ (poly.to-ast *env* type))))))] + inputT poly.peek] + ($_ p.either <basic> <time> (do @ - [unitT (poly;apply (p;after (poly;this unit;Qty) - poly;any))] + [unitT (poly.apply (p.after (poly.this unit.Qty) + poly.any))] (wrap (` (: (~ (@JSON//decode inputT)) - (p;codec (Codec<JSON,Qty> (:! (~ (poly;to-ast *env* unitT)) [])) //;any))))) + (p.codec (Codec<JSON,Qty> (:! (~ (poly.to-ast *env* unitT)) [])) //.any))))) (do @ - [[_ _ valC] (poly;apply ($_ p;seq - (poly;this d;Dict) - poly;text + [[_ _ valC] (poly.apply ($_ p.seq + (poly.this d.Dict) + poly.text Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;object (~ valC)))))) + (//.object (~ valC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;Maybe) + [[_ subC] (poly.apply (p.seq (poly.this .Maybe) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;nullable (~ subC)))))) + (//.nullable (~ subC)))))) (do @ - [[_ subC] (poly;apply (p;seq (poly;this ;List) + [[_ subC] (poly.apply (p.seq (poly.this .List) Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array (p;some (~ subC))))))) + (//.array (p.some (~ subC))))))) (do @ - [members (poly;variant (p;many Codec<JSON,?>//decode))] + [members (poly.variant (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - ($_ p;alt + ($_ p.alt (~@ (list/map (function [[tag memberC]] (` (|> (~ memberC) - (p;after (//;number! (~ (code;frac (;;tag tag))))) - //;array))) - (list;enumerate members)))))))) + (p.after (//.number! (~ (code.frac (..tag tag))))) + //.array))) + (list.enumerate members)))))))) (do @ - [g!decoders (poly;tuple (p;many Codec<JSON,?>//decode))] + [g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//;array ($_ p;seq (~@ g!decoders))))))) + (//.array ($_ p.seq (~@ g!decoders))))))) ## Type recursion (do @ - [[selfC bodyC] (poly;recursive Codec<JSON,?>//decode)] + [[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)] (wrap (` (: (~ (@JSON//decode inputT)) - (p;rec (;function [(~ selfC)] + (p.rec (.function [(~ selfC)] (~ bodyC))))))) - poly;recursive-self + poly.recursive-self ## Type applications (do @ - [[funcC argsC] (poly;apply (p;seq Codec<JSON,?>//decode (p;many Codec<JSON,?>//decode)))] + [[funcC argsC] (poly.apply (p.seq Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))] (wrap (` ((~ funcC) (~@ argsC))))) ## Polymorphism (do @ - [[funcC varsC bodyC] (poly;polymorphic Codec<JSON,?>//decode)] + [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) //;Reader (`)) varsC)) - (//;Reader ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) + (-> (~@ (list/map (|>> (~) //.Reader (`)) varsC)) + (//.Reader ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) - poly;bound - poly;recursive-call + poly.bound + poly.recursive-call ## If all else fails... - (p;fail (text/compose "Cannot create JSON decoder for: " (type;to-text inputT))) + (p.fail (text/compose "Cannot create JSON decoder for: " (type.to-text inputT))) )))) (syntax: #export (Codec<JSON,?> inputT) - {#;doc (doc "A macro for automatically producing JSON codecs." + {#.doc (doc "A macro for automatically producing JSON codecs." (type: Variant (#Case0 Bool) (#Case1 Text) @@ -306,7 +306,7 @@ (derived: (Codec<JSON,?> Record)))} (with-gensyms [g!inputs] - (wrap (list (` (: (Codec //;JSON (~ inputT)) + (wrap (list (` (: (Codec //.JSON (~ inputT)) (struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT))) - (def: ((~' decode) (~ g!inputs)) (//;run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) + (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) ))))))) |