diff options
| author | Eduardo Julian | 2020-11-17 20:23:53 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2020-11-17 20:23:53 -0400 | 
| commit | d89d837de3475b75587a4293e094d755d2cd4626 (patch) | |
| tree | 0975a487d987cfe855c4f6e87f05478346913a16 /stdlib/source/poly | |
| parent | 2e5852abb1ac0ae5abdd8709238aca447f62520e (diff) | |
Made the syntax of ^template more consistent.
Diffstat (limited to 'stdlib/source/poly')
| -rw-r--r-- | stdlib/source/poly/lux/abstract/equivalence.lux | 34 | ||||
| -rw-r--r-- | stdlib/source/poly/lux/data/format/json.lux | 162 | 
2 files changed, 98 insertions, 98 deletions
diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index a4d139aa4..0f5db0309 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 (<type>.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] (<type>.recursive equivalence) @@ -156,7 +156,7 @@              (do !                [[funcC varsC bodyC] (<type>.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 afe34c404..15c8c5906 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] @@ -96,13 +96,13 @@    (def: decode      (|>> (:: ..int-codec decode) (:: e.functor map unit.in)))) -(poly: #export codec//encode +(poly: #export codec\encode    (with-expansions      [<basic> (template [<matcher> <encoder>]                 [(do !                    [#let [g!_ (code.local-identifier "_______")]                     _ <matcher>] -                  (wrap (` (: (~ (@JSON//encode inputT)) +                  (wrap (` (: (~ (@JSON\encode inputT))                                <encoder>))))]                 [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] @@ -114,7 +114,7 @@       <time> (template [<type> <codec>]                [(do !                   [_ (<type>.exactly <type>)] -                 (wrap (` (: (~ (@JSON//encode inputT)) +                 (wrap (` (: (~ (@JSON\encode inputT))                               (|>> (:: (~! <codec>) (~' encode)) #/.String)))))]                ## [duration.Duration duration.codec] @@ -124,9 +124,9 @@                [month.Month month.codec])]      (do {! p.monad}        [*env* <type>.env -       #let [@JSON//encode (: (-> Type Code) -                              (function (_ type) -                                (` (-> (~ (poly.to-code *env* type)) /.JSON))))] +       #let [@JSON\encode (: (-> Type Code) +                             (function (_ type) +                               (` (-> (~ (poly.to-code *env* type)) /.JSON))))]         inputT <type>.peek]        ($_ p.either            <basic> @@ -134,7 +134,7 @@            (do !              [unitT (<type>.apply (p.after (<type>.exactly unit.Qty)                                            <type>.any))] -            (wrap (` (: (~ (@JSON//encode inputT)) +            (wrap (` (: (~ (@JSON\encode inputT))                          (:: (~! qty-codec) (~' encode))))))            (do !              [#let [g!_ (code.local-identifier "_______") @@ -143,73 +143,73 @@               [_ _ =val=] (<type>.apply ($_ p.and                                             (<type>.exactly d.Dictionary)                                             (<type>.exactly .Text) -                                           codec//encode))] -            (wrap (` (: (~ (@JSON//encode inputT)) +                                           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 !              [[_ =sub=] (<type>.apply ($_ p.and                                           (<type>.exactly .Maybe) -                                         codec//encode))] -            (wrap (` (: (~ (@JSON//encode inputT)) +                                         codec\encode))] +            (wrap (` (: (~ (@JSON\encode inputT))                          ((~! ..nullable) (~ =sub=))))))            (do !              [[_ =sub=] (<type>.apply ($_ p.and                                           (<type>.exactly .List) -                                         codec//encode))] -            (wrap (` (: (~ (@JSON//encode inputT)) -                        (|>> ((~! list//map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) +                                         codec\encode))] +            (wrap (` (: (~ (@JSON\encode inputT)) +                        (|>> ((~! list\map) (~ =sub=)) ((~! row.from-list)) #/.Array)))))            (do !              [#let [g!_ (code.local-identifier "_______")                     g!input (code.local-identifier "_______input")] -             members (<type>.variant (p.many codec//encode)) +             members (<type>.variant (p.many codec\encode))               #let [last (dec (list.size members))]] -            (wrap (` (: (~ (@JSON//encode inputT)) +            (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 (<type>.tuple (p.many codec//encode)) +            [g!encoders (<type>.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)))]] -            (wrap (` (: (~ (@JSON//encode inputT)) +                                 (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] (<type>.recursive codec//encode) +            [[selfC non-recC] (<type>.recursive codec\encode)               #let [g! (code.local-identifier "____________")]] -            (wrap (` (: (~ (@JSON//encode inputT)) +            (wrap (` (: (~ (@JSON\encode inputT))                          ((~! ..rec-encode) (.function ((~ g!) (~ selfC))                                               (~ non-recC)))))))            <type>.recursive-self            ## Type applications            (do ! -            [partsC (<type>.apply (p.many codec//encode))] +            [partsC (<type>.apply (p.many codec\encode))]              (wrap (` ((~+ partsC)))))            ## Polymorphism            (do ! -            [[funcC varsC bodyC] (<type>.polymorphic codec//encode)] +            [[funcC varsC bodyC] (<type>.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)) @@ -220,12 +220,12 @@            (p.fail (format "Cannot create JSON encoder for: " (type.format inputT)))            )))) -(poly: #export codec//decode +(poly: #export codec\decode    (with-expansions      [<basic> (template [<matcher> <decoder>]                 [(do !                    [_ <matcher>] -                  (wrap (` (: (~ (@JSON//decode inputT)) +                  (wrap (` (: (~ (@JSON\decode inputT))                                (~! <decoder>)))))]                 [(<type>.exactly Any)  </>.null] @@ -237,7 +237,7 @@       <time> (template [<type> <codec>]                [(do !                   [_ (<type>.exactly <type>)] -                 (wrap (` (: (~ (@JSON//decode inputT)) +                 (wrap (` (: (~ (@JSON\decode inputT))                               ((~! p.codec) (~! <codec>) (~! </>.string))))))]                ## [duration.Duration duration.codec] @@ -247,9 +247,9 @@                [month.Month month.codec])]      (do {! p.monad}        [*env* <type>.env -       #let [@JSON//decode (: (-> Type Code) -                              (function (_ type) -                                (` (</>.Parser (~ (poly.to-code *env* type))))))] +       #let [@JSON\decode (: (-> Type Code) +                             (function (_ type) +                               (` (</>.Parser (~ (poly.to-code *env* type))))))]         inputT <type>.peek]        ($_ p.either            <basic> @@ -257,62 +257,62 @@            (do !              [unitT (<type>.apply (p.after (<type>.exactly unit.Qty)                                            <type>.any))] -            (wrap (` (: (~ (@JSON//decode inputT)) +            (wrap (` (: (~ (@JSON\decode inputT))                          ((~! p.codec) (~! qty-codec) (~! </>.any))))))            (do !              [[_ _ valC] (<type>.apply ($_ p.and                                            (<type>.exactly d.Dictionary)                                            (<type>.exactly .Text) -                                          codec//decode))] -            (wrap (` (: (~ (@JSON//decode inputT)) +                                          codec\decode))] +            (wrap (` (: (~ (@JSON\decode inputT))                          ((~! </>.dictionary) (~ valC))))))            (do !              [[_ subC] (<type>.apply (p.and (<type>.exactly .Maybe) -                                           codec//decode))] -            (wrap (` (: (~ (@JSON//decode inputT)) +                                           codec\decode))] +            (wrap (` (: (~ (@JSON\decode inputT))                          ((~! </>.nullable) (~ subC))))))            (do !              [[_ subC] (<type>.apply (p.and (<type>.exactly .List) -                                           codec//decode))] -            (wrap (` (: (~ (@JSON//decode inputT)) +                                           codec\decode))] +            (wrap (` (: (~ (@JSON\decode inputT))                          ((~! </>.array) ((~! p.some) (~ subC)))))))            (do ! -            [members (<type>.variant (p.many codec//decode)) +            [members (<type>.variant (p.many codec\decode))               #let [last (dec (list.size members))]] -            (wrap (` (: (~ (@JSON//decode inputT)) +            (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 (<type>.tuple (p.many codec//decode))] -            (wrap (` (: (~ (@JSON//decode inputT)) +            [g!decoders (<type>.tuple (p.many codec\decode))] +            (wrap (` (: (~ (@JSON\decode inputT))                          ((~! </>.array) ($_ ((~! p.and)) (~+ g!decoders)))))))            ## Type recursion            (do ! -            [[selfC bodyC] (<type>.recursive codec//decode) +            [[selfC bodyC] (<type>.recursive codec\decode)               #let [g! (code.local-identifier "____________")]] -            (wrap (` (: (~ (@JSON//decode inputT)) +            (wrap (` (: (~ (@JSON\decode inputT))                          ((~! p.rec) (.function ((~ g!) (~ selfC))                                        (~ bodyC)))))))            <type>.recursive-self            ## Type applications            (do ! -            [[funcC argsC] (<type>.apply (p.and codec//decode (p.many codec//decode)))] +            [[funcC argsC] (<type>.apply (p.and codec\decode (p.many codec\decode)))]              (wrap (` ((~ funcC) (~+ argsC)))))            ## Polymorphism            (do ! -            [[funcC varsC bodyC] (<type>.polymorphic codec//decode)] +            [[funcC varsC bodyC] (<type>.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)))))) @@ -342,7 +342,7 @@                (derived: (..codec Record)))}    (wrap (list (` (: (codec.Codec /.JSON (~ inputT))                      (structure (def: (~' encode) -                                 (..codec//encode (~ inputT))) +                                 (..codec\encode (~ inputT)))                                 (def: (~' decode) -                                 ((~! </>.run) (..codec//decode (~ inputT)))) +                                 ((~! </>.run) (..codec\decode (~ inputT))))                                 ))))))  | 
