diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/polytypic/lux/abstract/functor.lux | 41 |
1 files changed, 20 insertions, 21 deletions
diff --git a/stdlib/source/polytypic/lux/abstract/functor.lux b/stdlib/source/polytypic/lux/abstract/functor.lux index 1ff6c0398..3cc3074b0 100644 --- a/stdlib/source/polytypic/lux/abstract/functor.lux +++ b/stdlib/source/polytypic/lux/abstract/functor.lux @@ -4,9 +4,7 @@ [abstract [monad (.only Monad do)]] [control - ["p" parser (.only) - ["<[0]>" type] - ["s" code (.only Parser)]]] + ["<>" parser]] [data ["[0]" product] ["[0]" text (.only) @@ -19,13 +17,14 @@ [number ["n" nat]]] ["[0]" type (.only) + ["<[1]>" \\parser] ["[0]" poly (.only polytypic)]]]] [\\library ["[0]" /]]) (def .public functor (polytypic functor - (do [! p.monad] + (do [! <>.monad] [.let [g!_ (code.local "____________") type_funcC (code.local "____________type_funcC") funcC (code.local "____________funcC") @@ -44,16 +43,16 @@ ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (is (-> Code (<type>.Parser Code)) (function (Arg<?> valueC) - (all p.either + (all <>.either ... Type-var - (do p.monad + (do <>.monad [.let [varI (|> num_vars (n.* 2) --)] _ (<type>.this_parameter varI)] (in (` ((~ funcC) (~ valueC))))) ... Variants (do ! [_ (in []) - membersC (<type>.variant (p.many (Arg<?> valueC))) + membersC (<type>.variant (<>.many (Arg<?> valueC))) .let [last (-- (list.size membersC))]] (in (` (case (~ valueC) (~+ (list#conjoint (list#each (function (_ [tag memberC]) @@ -64,18 +63,18 @@ (` {(~ (code.nat tag)) #0 (~ memberC)})))) (list.enumeration membersC)))))))) ... Tuples - (do p.monad + (do <>.monad [pairsCC (is (<type>.Parser (List [Code Code])) (<type>.tuple (loop (again [idx 0 pairsCC (is (List [Code Code]) (list))]) - (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] - (do ! - [_ (in []) - memberC (Arg<?> slotC)] - (again (++ idx) - (list#composite pairsCC (list [slotC memberC]))))) - (in pairsCC)))))] + (<>.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] + (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))])))) @@ -84,7 +83,7 @@ [_ (in []) .let [g! (code.local "____________") outL (code.local "____________outL")] - [inT+ outC] (<type>.function (p.many <type>.any) + [inT+ outC] (<type>.function (<>.many <type>.any) (Arg<?> outL)) .let [inC+ (|> (list.size inT+) list.indices @@ -93,18 +92,18 @@ (let [(~ outL) ((~ valueC) (~+ inC+))] (~ outC)))))) ... Recursion - (do p.monad + (do <>.monad [_ <type>.recursive_call] (in (` ((~' each) (~ funcC) (~ valueC))))) ... Parameters - (do p.monad + (do <>.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)))))] + (<>.either (<type>.polymorphic + (Arg<?> inputC)) + (<>.failure (format "Cannot create Functor for: " (%.type inputT)))))] (in (` (is (~ (@Functor inputT)) (implementation (def ((~' each) (~ funcC) (~ inputC)) |