diff options
| author | Eduardo Julian | 2022-06-12 13:33:48 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-06-12 13:33:48 -0400 |
| commit | 8c3a1afab9efeb86e2f53d743551fc689fbad257 (patch) | |
| tree | 396b2fd29bac407544d2136a0d9e6e3b8b2c30af /stdlib/source/library | |
| parent | 9c21fd1f33eb52fb971d493ad21a67036d68b841 (diff) | |
De-sigil-ification: suffix : [Part 4]
Diffstat (limited to 'stdlib/source/library')
139 files changed, 4116 insertions, 4148 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 1a35551fa..812a52cb8 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3322,43 +3322,6 @@ head tail))) -(def: (remainderP tokens) - (-> (List Code) (Maybe (List Code))) - (case tokens - {#End} - {#None} - - _ - {#Item tokens})) - -(def: (implementationP tokens) - (-> (List Code) (Maybe [Code Text (List Code) Code (List Code)])) - (do maybe_monad - [% (enhanced_declarationP tokens) - .let' [[tokens [export_policy name parameters]] %] - % (anyP tokens) - .let' [[tokens type] %] - tokens (remainderP tokens)] - (in [export_policy name parameters type tokens]))) - -(def: .public implementation: - (macro (_ tokens) - (case (implementationP tokens) - {#Some [export_policy name args type definitions]} - (let [usage (case args - {#End} - (local$ name) - - _ - (` ((~ (local$ name)) (~+ args))))] - (meta#in (list (` (..def: (~ export_policy) (~ usage) - (~ type) - (..implementation - (~+ definitions))))))) - - {#None} - (failure "Wrong syntax for implementation:")))) - (def: (function#identity value) (All (_ a) (-> a a)) diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux index 1bf1c84ce..0685484d5 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -14,30 +14,29 @@ (-> (f a) (f (-> a b)) (f b))) on))) -(implementation: .public (composite f_monad f_apply g_apply) +(def: .public (composite f_monad f_apply g_apply) (All (_ F G) (-> (Monad F) (Apply F) (Apply G) ... TODO: Replace (All (_ a) (F (G a))) with (functor.Then F G) (Apply (All (_ a) (F (G a)))))) - - (def: functor - (functor.composite (the functor f_apply) - (the functor g_apply))) - - (def: (on fgx fgf) - ... TODO: Switch from this version to the one below (in comments) ASAP. - (for @.old (let [fgf' (at f_apply on - fgf - (at f_monad in (function (_ gf gx) (at g_apply on gx gf))))] - (as_expected (at f_apply on (as_expected fgx) (as_expected fgf')))) - (let [fgf' (at f_apply on - fgf - (at f_monad in (function (_ gf gx) (at g_apply on gx gf))))] - (at f_apply on fgx fgf'))) - ... (let [applyF (at f_apply on) - ... applyG (at g_apply on)] - ... (all applyF - ... fgf - ... (at f_monad in applyG) - ... fgx)) - )) + (implementation + (def: functor + (functor.composite (the functor f_apply) + (the functor g_apply))) + (def: (on fgx fgf) + ... TODO: Switch from this version to the one below (in comments) ASAP. + (for @.old (let [fgf' (at f_apply on + fgf + (at f_monad in (function (_ gf gx) (at g_apply on gx gf))))] + (as_expected (at f_apply on (as_expected fgx) (as_expected fgf')))) + (let [fgf' (at f_apply on + fgf + (at f_monad in (function (_ gf gx) (at g_apply on gx gf))))] + (at f_apply on fgx fgf'))) + ... (let [applyF (at f_apply on) + ... applyG (at g_apply on)] + ... (all applyF + ... fgf + ... (at f_monad in applyG) + ... fgx)) + ))) diff --git a/stdlib/source/library/lux/abstract/codec.lux b/stdlib/source/library/lux/abstract/codec.lux index d24ac4c93..ce6bab822 100644 --- a/stdlib/source/library/lux/abstract/codec.lux +++ b/stdlib/source/library/lux/abstract/codec.lux @@ -14,15 +14,16 @@ (is (-> m (Try a)) decoded))) -(implementation: .public (composite cb_codec ba_codec) +(def: .public (composite cb_codec ba_codec) (All (_ a b c) (-> (Codec c b) (Codec b a) (Codec c a))) - (def: encoded - (|>> (at ba_codec encoded) - (at cb_codec encoded))) + (implementation + (def: encoded + (|>> (at ba_codec encoded) + (at cb_codec encoded))) - (def: (decoded cy) - (do try.monad - [by (at cb_codec decoded cy)] - (at ba_codec decoded by)))) + (def: (decoded cy) + (do try.monad + [by (at cb_codec decoded cy)] + (at ba_codec decoded by))))) diff --git a/stdlib/source/library/lux/abstract/comonad/free.lux b/stdlib/source/library/lux/abstract/comonad/free.lux index cba43d06d..60cbb883b 100644 --- a/stdlib/source/library/lux/abstract/comonad/free.lux +++ b/stdlib/source/library/lux/abstract/comonad/free.lux @@ -8,20 +8,20 @@ (type: .public (Free F a) [a (F (Free F a))]) -(implementation: .public (functor dsl) +(def: .public (functor dsl) (All (_ F) (-> (Functor F) (Functor (Free F)))) - - (def: (each f [head tail]) - [(f head) (at dsl each (each f) tail)])) + (implementation + (def: (each f [head tail]) + [(f head) (at dsl each (each f) tail)]))) -(implementation: .public (comonad dsl) +(def: .public (comonad dsl) (All (_ F) (-> (Functor F) (CoMonad (Free F)))) + (implementation + (def: functor (..functor dsl)) - (def: functor (..functor dsl)) + (def: (out [head tail]) + head) - (def: (out [head tail]) - head) - - (def: (disjoint [head tail]) - [[head tail] - (at dsl each disjoint tail)])) + (def: (disjoint [head tail]) + [[head tail] + (at dsl each disjoint tail)]))) diff --git a/stdlib/source/library/lux/abstract/equivalence.lux b/stdlib/source/library/lux/abstract/equivalence.lux index ca5b8cc96..064492b0f 100644 --- a/stdlib/source/library/lux/abstract/equivalence.lux +++ b/stdlib/source/library/lux/abstract/equivalence.lux @@ -17,10 +17,10 @@ (def: (= left right) (sub = left right)))) -(implementation: .public functor +(def: .public functor (contravariant.Functor Equivalence) - - (def: (each f equivalence) - (implementation - (def: (= reference sample) - (at equivalence = (f reference) (f sample)))))) + (implementation + (def: (each f equivalence) + (implementation + (def: (= reference sample) + (at equivalence = (f reference) (f sample))))))) diff --git a/stdlib/source/library/lux/abstract/hash.lux b/stdlib/source/library/lux/abstract/hash.lux index 8a47a8b59..31a8d24b7 100644 --- a/stdlib/source/library/lux/abstract/hash.lux +++ b/stdlib/source/library/lux/abstract/hash.lux @@ -13,14 +13,14 @@ (is (-> a Nat) hash))) -(implementation: .public functor +(def: .public functor (contravariant.Functor Hash) - - (def: (each f super) - (implementation - (def: equivalence - (at equivalence.functor each f - (at super equivalence))) - - (def: hash - (|>> f (at super hash)))))) + (implementation + (def: (each f super) + (implementation + (def: equivalence + (at equivalence.functor each f + (at super equivalence))) + + (def: hash + (|>> f (at super hash))))))) diff --git a/stdlib/source/library/lux/abstract/interval.lux b/stdlib/source/library/lux/abstract/interval.lux index 2ec0a1fa5..9f4a4a6ec 100644 --- a/stdlib/source/library/lux/abstract/interval.lux +++ b/stdlib/source/library/lux/abstract/interval.lux @@ -73,26 +73,26 @@ (or (starts_with? elem interval) (ends_with? elem interval))) -(implementation: .public (union left right) +(def: .public (union left right) (All (_ a) (-> (Interval a) (Interval a) (Interval a))) + (implementation + (def: enum (the enum right)) + (def: bottom (order.min (at right order) (at left bottom) (at right bottom))) + (def: top (order.max (at right order) (at left top) (at right top))))) - (def: enum (the enum right)) - (def: bottom (order.min (at right order) (at left bottom) (at right bottom))) - (def: top (order.max (at right order) (at left top) (at right top)))) - -(implementation: .public (intersection left right) +(def: .public (intersection left right) (All (_ a) (-> (Interval a) (Interval a) (Interval a))) + (implementation + (def: enum (the enum right)) + (def: bottom (order.max (at right order) (at left bottom) (at right bottom))) + (def: top (order.min (at right order) (at left top) (at right top))))) - (def: enum (the enum right)) - (def: bottom (order.max (at right order) (at left bottom) (at right bottom))) - (def: top (order.min (at right order) (at left top) (at right top)))) - -(implementation: .public (complement interval) +(def: .public (complement interval) (All (_ a) (-> (Interval a) (Interval a))) - - (def: enum (the enum interval)) - (def: bottom (at interval succ (at interval top))) - (def: top (at interval pred (at interval bottom)))) + (implementation + (def: enum (the enum interval)) + (def: bottom (at interval succ (at interval top))) + (def: top (at interval pred (at interval bottom))))) (def: .public (precedes? reference sample) (All (_ a) (-> (Interval a) (Interval a) Bit)) @@ -142,13 +142,13 @@ [finishes? ,#top order.>= ,#bottom] ) -(implementation: .public equivalence +(def: .public equivalence (All (_ a) (Equivalence (Interval a))) - - (def: (= reference sample) - (let [(open ",#[0]") reference] - (and (,#= ,#bottom (at sample bottom)) - (,#= ,#top (at sample top)))))) + (implementation + (def: (= reference sample) + (let [(open ",#[0]") reference] + (and (,#= ,#bottom (at sample bottom)) + (,#= ,#top (at sample top))))))) (def: .public (nested? reference sample) (All (_ a) (-> (Interval a) (Interval a) Bit)) diff --git a/stdlib/source/library/lux/abstract/monad/free.lux b/stdlib/source/library/lux/abstract/monad/free.lux index f7ca07159..af3436ab4 100644 --- a/stdlib/source/library/lux/abstract/monad/free.lux +++ b/stdlib/source/library/lux/abstract/monad/free.lux @@ -11,57 +11,57 @@ {#Pure a} {#Effect (F (Free F a))})) -(implementation: .public (functor dsl) +(def: .public (functor dsl) (All (_ F) (-> (Functor F) (Functor (Free F)))) - - (def: (each f ea) - (case ea - {#Pure a} - {#Pure (f a)} - - {#Effect value} - {#Effect (at dsl each (each f) value)}))) + (implementation + (def: (each f ea) + (case ea + {#Pure a} + {#Pure (f a)} + + {#Effect value} + {#Effect (at dsl each (each f) value)})))) -(implementation: .public (apply dsl) +(def: .public (apply dsl) (All (_ F) (-> (Functor F) (Apply (Free F)))) - - (def: functor - (..functor dsl)) + (implementation + (def: functor + (..functor dsl)) - (def: (on ea ef) - (case [ef ea] - [{#Pure f} {#Pure a}] - {#Pure (f a)} + (def: (on ea ef) + (case [ef ea] + [{#Pure f} {#Pure a}] + {#Pure (f a)} - [{#Pure f} {#Effect fa}] - {#Effect (at dsl each - (at (..functor dsl) each f) - fa)} + [{#Pure f} {#Effect fa}] + {#Effect (at dsl each + (at (..functor dsl) each f) + fa)} - [{#Effect ff} _] - {#Effect (at dsl each (on ea) ff)} - ))) + [{#Effect ff} _] + {#Effect (at dsl each (on ea) ff)} + )))) -(implementation: .public (monad dsl) +(def: .public (monad dsl) (All (_ F) (-> (Functor F) (Monad (Free F)))) + (implementation + (def: functor (..functor dsl)) - (def: functor (..functor dsl)) + (def: (in a) + {#Pure a}) - (def: (in a) - {#Pure a}) + (def: (conjoint efefa) + (case efefa + {#Pure efa} + (case efa + {#Pure a} + {#Pure a} - (def: (conjoint efefa) - (case efefa - {#Pure efa} - (case efa - {#Pure a} - {#Pure a} - - {#Effect fa} - {#Effect fa}) - - {#Effect fefa} - {#Effect (at dsl each - (at (monad dsl) conjoint) - fefa)} - ))) + {#Effect fa} + {#Effect fa}) + + {#Effect fefa} + {#Effect (at dsl each + (at (monad dsl) conjoint) + fefa)} + )))) diff --git a/stdlib/source/library/lux/abstract/order.lux b/stdlib/source/library/lux/abstract/order.lux index e5931d694..e8dfbc834 100644 --- a/stdlib/source/library/lux/abstract/order.lux +++ b/stdlib/source/library/lux/abstract/order.lux @@ -44,13 +44,13 @@ Choice (if (at order < y x) y x)) -(implementation: .public functor +(def: .public functor (contravariant.Functor Order) - - (def: (each f order) - (implementation - (def: equivalence - (at equivalence.functor each f (at order equivalence))) - - (def: (< reference sample) - (at order < (f reference) (f sample)))))) + (implementation + (def: (each f order) + (implementation + (def: equivalence + (at equivalence.functor each f (at order equivalence))) + + (def: (< reference sample) + (at order < (f reference) (f sample))))))) diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux index 10efde28e..61a2bb41c 100644 --- a/stdlib/source/library/lux/abstract/predicate.lux +++ b/stdlib/source/library/lux/abstract/predicate.lux @@ -27,11 +27,11 @@ ) (with_template [<name> <identity> <composition>] - [(implementation: .public <name> + [(def: .public <name> (All (_ a) (Monoid (Predicate a))) - - (def: identity <identity>) - (def: composite <composition>))] + (implementation + (def: identity <identity>) + (def: composite <composition>)))] [union ..none ..or] [intersection ..all ..and] @@ -54,8 +54,8 @@ (function (again input) (predicate again input))) -(implementation: .public functor +(def: .public functor (contravariant.Functor Predicate) - - (def: (each f fb) - (|>> f fb))) + (implementation + (def: (each f fb) + (|>> f fb)))) diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 8882fc928..0770db384 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -98,55 +98,55 @@ {.#Some _} #1))))) -(implementation: .public functor +(def: .public functor (Functor Async) - - (def: (each f fa) - (let [[fb resolve] (sharing [a b] - (-> a b) - f - - [(Async b) (Resolver b)] - (..async []))] - (exec - (io.run! (..upon! (|>> f resolve) fa)) - fb)))) - -(implementation: .public apply + (implementation + (def: (each f fa) + (let [[fb resolve] (sharing [a b] + (-> a b) + f + + [(Async b) (Resolver b)] + (..async []))] + (exec + (io.run! (..upon! (|>> f resolve) fa)) + fb))))) + +(def: .public apply (Apply Async) - - (def: functor ..functor) - - (def: (on fa ff) - (let [[fb resolve] (sharing [a b] - (Async (-> a b)) - ff - - [(Async b) (Resolver b)] - (..async []))] - (exec - (io.run! (..upon! (function (_ f) - (..upon! (|>> f resolve) fa)) - ff)) - fb)))) - -(implementation: .public monad + (implementation + (def: functor ..functor) + + (def: (on fa ff) + (let [[fb resolve] (sharing [a b] + (Async (-> a b)) + ff + + [(Async b) (Resolver b)] + (..async []))] + (exec + (io.run! (..upon! (function (_ f) + (..upon! (|>> f resolve) fa)) + ff)) + fb))))) + +(def: .public monad (Monad Async) - - (def: functor ..functor) - - (def: in ..resolved) - - (def: (conjoint mma) - (let [[ma resolve] (sharing [a] - (Async (Async a)) - mma - - [(Async a) (Resolver a)] - (..async []))] - (exec - (io.run! (..upon! (..upon! resolve) mma)) - ma)))) + (implementation + (def: functor ..functor) + + (def: in ..resolved) + + (def: (conjoint mma) + (let [[ma resolve] (sharing [a] + (Async (Async a)) + mma + + [(Async a) (Resolver a)] + (..async []))] + (exec + (io.run! (..upon! (..upon! resolve) mma)) + ma))))) (def: .public (and left right) (All (_ lr lw rr rw) (-> (Async' lr lw) (Async' rr rw) (Async [lr rr]))) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index 15f599f8f..e49a80418 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -89,76 +89,76 @@ (let [[async resolve] (async.async [])] [async (..sink resolve)])) -(implementation: .public functor +(def: .public functor (Functor Channel) - - (def: (each f) - (async#each - (maybe#each - (function (_ [head tail]) - [(variance.write (f (variance.read head))) - (each f tail)]))))) + (implementation + (def: (each f) + (async#each + (maybe#each + (function (_ [head tail]) + [(variance.write (f (variance.read head))) + (each f tail)])))))) -(implementation: .public apply +(def: .public apply (Apply Channel) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (do async.monad - [item_f ff - item_a fa] - (case [item_f item_a] - [{.#Some [head_f tail_f]} {.#Some [head_a tail_a]}] - (in {.#Some [(variance.write ((variance.read head_f) (variance.read head_a))) - (on tail_a tail_f)]}) + (def: (on fa ff) + (do async.monad + [item_f ff + item_a fa] + (case [item_f item_a] + [{.#Some [head_f tail_f]} {.#Some [head_a tail_a]}] + (in {.#Some [(variance.write ((variance.read head_f) (variance.read head_a))) + (on tail_a tail_f)]}) - _ - (in {.#None}))))) + _ + (in {.#None})))))) (def: empty Channel (async.resolved {.#None})) -(implementation: .public monad +(def: .public monad (Monad Channel) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in a) - (async.resolved {.#Some [(variance.write a) ..empty]})) + (def: (in a) + (async.resolved {.#Some [(variance.write a) ..empty]})) - (def: (conjoint mma) - (let [[output sink] (sharing [a] - (Channel (Channel a)) - mma - - [(Channel a) (Sink a)] - (channel []))] - (exec - (is (Async Any) - (loop (again [mma mma]) - (do [! async.monad] - [?mma mma] - (case ?mma - {.#Some [ma mma']} - (do ! - [_ (loop (again [ma ma]) - (do ! - [?ma (variance.read ma)] - (case ?ma - {.#Some [a ma']} - (exec - (io.run! (at sink feed (variance.read a))) - (again (variance.write ma'))) - - {.#None} - (in []))))] - (again mma')) - - {.#None} - (in (is Any (io.run! (at sink close)))))))) - output)))) + (def: (conjoint mma) + (let [[output sink] (sharing [a] + (Channel (Channel a)) + mma + + [(Channel a) (Sink a)] + (channel []))] + (exec + (is (Async Any) + (loop (again [mma mma]) + (do [! async.monad] + [?mma mma] + (case ?mma + {.#Some [ma mma']} + (do ! + [_ (loop (again [ma ma]) + (do ! + [?ma (variance.read ma)] + (case ?ma + {.#Some [a ma']} + (exec + (io.run! (at sink feed (variance.read a))) + (again (variance.write ma'))) + + {.#None} + (in []))))] + (again mma')) + + {.#None} + (in (is Any (io.run! (at sink close)))))))) + output))))) (type: .public (Subscriber a) (-> a (IO (Maybe Any)))) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index a17527e5f..3d16d8338 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -158,38 +158,38 @@ tx} []]))) -(implementation: .public functor +(def: .public functor (Functor STM) - - (def: (each f fa) - (function (_ tx) - (let [[tx' a] (fa tx)] - [tx' (f a)])))) + (implementation + (def: (each f fa) + (function (_ tx) + (let [[tx' a] (fa tx)] + [tx' (f a)]))))) -(implementation: .public apply +(def: .public apply (Apply STM) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (function (_ tx) - (let [[tx' f] (ff tx) - [tx'' a] (fa tx')] - [tx'' (f a)])))) + (def: (on fa ff) + (function (_ tx) + (let [[tx' f] (ff tx) + [tx'' a] (fa tx')] + [tx'' (f a)]))))) -(implementation: .public monad +(def: .public monad (Monad STM) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in a) - (function (_ tx) - [tx a])) + (def: (in a) + (function (_ tx) + [tx a])) - (def: (conjoint mma) - (function (_ tx) - (let [[tx' ma] (mma tx)] - (ma tx'))))) + (def: (conjoint mma) + (function (_ tx) + (let [[tx' ma] (mma tx)] + (ma tx')))))) (def: .public (update f var) (All (_ r w) (-> (-> r w) (Var' r w) (STM [r w]))) diff --git a/stdlib/source/library/lux/control/continuation.lux b/stdlib/source/library/lux/control/continuation.lux index 69de59e57..3cbd80b92 100644 --- a/stdlib/source/library/lux/control/continuation.lux +++ b/stdlib/source/library/lux/control/continuation.lux @@ -52,35 +52,35 @@ (f (function (_ a) (function (_ ic) (ic (oc a)))) function.identity))) -(implementation: .public functor +(def: .public functor (All (_ o) (Functor (All (_ i) (Cont i o)))) - - (def: (each f fv) - (function (_ k) - (fv (function.composite k f))))) + (implementation + (def: (each f fv) + (function (_ k) + (fv (function.composite k f)))))) -(implementation: .public apply +(def: .public apply (All (_ o) (Apply (All (_ i) (Cont i o)))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fv ff) - (function (_ k) - (|> (k (f v)) - (function (_ v)) fv - (function (_ f)) ff)))) + (def: (on fv ff) + (function (_ k) + (|> (k (f v)) + (function (_ v)) fv + (function (_ f)) ff))))) -(implementation: .public monad +(def: .public monad (All (_ o) (Monad (All (_ i) (Cont i o)))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in value) - (function (_ k) (k value))) + (def: (in value) + (function (_ k) (k value))) - (def: (conjoint ffa) - (function (_ k) - (ffa (continued k))))) + (def: (conjoint ffa) + (function (_ k) + (ffa (continued k)))))) (def: .public (portal init) (All (_ i o z) diff --git a/stdlib/source/library/lux/control/function.lux b/stdlib/source/library/lux/control/function.lux index bdbe4407f..15cd56f93 100644 --- a/stdlib/source/library/lux/control/function.lux +++ b/stdlib/source/library/lux/control/function.lux @@ -27,8 +27,8 @@ (-> i (-> i o) o)) (function input)) -(implementation: .public monoid +(def: .public monoid (All (_ a) (Monoid (-> a a))) - - (def: identity ..identity) - (def: composite ..composite)) + (implementation + (def: identity ..identity) + (def: composite ..composite))) diff --git a/stdlib/source/library/lux/control/function/mixin.lux b/stdlib/source/library/lux/control/function/mixin.lux index 0a087b121..d23e86e04 100644 --- a/stdlib/source/library/lux/control/function/mixin.lux +++ b/stdlib/source/library/lux/control/function/mixin.lux @@ -27,11 +27,11 @@ (function (_ delegate recur) (parent (child delegate recur) recur))) -(implementation: .public monoid +(def: .public monoid (All (_ i o) (Monoid (Mixin i o))) - - (def: identity ..nothing) - (def: composite ..mixed)) + (implementation + (def: identity ..nothing) + (def: composite ..mixed))) (def: .public (advice when then) (All (_ i o) (-> (Predicate i) (Mixin i o) (Mixin i o))) diff --git a/stdlib/source/library/lux/control/io.lux b/stdlib/source/library/lux/control/io.lux index 50ed5ca0c..a942a7c80 100644 --- a/stdlib/source/library/lux/control/io.lux +++ b/stdlib/source/library/lux/control/io.lux @@ -43,28 +43,28 @@ (All (_ a) (-> (IO a) a)) (|>> ..run!')) - (implementation: .public functor + (def: .public functor (Functor IO) - - (def: (each f) - (|>> ..run!' f !io))) + (implementation + (def: (each f) + (|>> ..run!' f !io)))) - (implementation: .public apply + (def: .public apply (Apply IO) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (!io ((..run!' ff) (..run!' fa))))) + (def: (on fa ff) + (!io ((..run!' ff) (..run!' fa)))))) - (implementation: .public monad + (def: .public monad (Monad IO) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: in - (|>> !io)) - - (def: conjoint - (|>> ..run!' ..run!' !io))) + (def: in + (|>> !io)) + + (def: conjoint + (|>> ..run!' ..run!' !io)))) ) diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux index afa816e00..62baa0ec1 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -48,29 +48,29 @@ (with_symbols [g!_] (in (list (` ((~! ..lazy') (function ((~ g!_) (~ g!_)) (~ expression))))))))) -(implementation: .public (equivalence (open "_#[0]")) +(def: .public (equivalence (open "_#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Lazy a)))) - - (def: (= left right) - (_#= (..value left) - (..value right)))) + (implementation + (def: (= left right) + (_#= (..value left) + (..value right))))) -(implementation: .public functor +(def: .public functor (Functor Lazy) - - (def: (each f fa) - (lazy (f (value fa))))) + (implementation + (def: (each f fa) + (lazy (f (value fa)))))) -(implementation: .public apply +(def: .public apply (Apply Lazy) - - (def: functor ..functor) - (def: (on fa ff) - (lazy ((value ff) (value fa))))) + (implementation + (def: functor ..functor) + (def: (on fa ff) + (lazy ((value ff) (value fa)))))) -(implementation: .public monad +(def: .public monad (Monad Lazy) - - (def: functor ..functor) - (def: in (|>> lazy)) - (def: conjoint ..value)) + (implementation + (def: functor ..functor) + (def: in (|>> lazy)) + (def: conjoint ..value))) diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index 2e255a7ec..00cef670e 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -15,111 +15,111 @@ ... {.#None} ... {.#Some a}) -(implementation: .public monoid +(def: .public monoid (All (_ a) (Monoid (Maybe a))) - - (def: identity - {.#None}) - - (def: (composite mx my) - (case mx - {.#None} - my - - _ - mx))) - -(implementation: .public functor + (implementation + (def: identity + {.#None}) + + (def: (composite mx my) + (case mx + {.#None} + my + + _ + mx)))) + +(def: .public functor (Functor Maybe) - - (def: (each f ma) - (case ma - {.#Some a} - {.#Some (f a)} - - ... {.#None} - it - (as_expected it)))) - -(implementation: .public apply + (implementation + (def: (each f ma) + (case ma + {.#Some a} + {.#Some (f a)} + + ... {.#None} + it + (as_expected it))))) + +(def: .public apply (Apply Maybe) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (case [ff fa] - [{.#Some f} {.#Some a}] - {.#Some (f a)} + (def: (on fa ff) + (case [ff fa] + [{.#Some f} {.#Some a}] + {.#Some (f a)} - _ - {.#None}))) + _ + {.#None})))) -(implementation: .public monad +(def: .public monad (Monad Maybe) - - (def: functor ..functor) - - (def: (in x) - {.#Some x}) - - (def: (conjoint mma) - (case mma - {.#Some mx} - mx - - ... {.#None} - it - (as_expected it)))) - -(implementation: .public (equivalence super) + (implementation + (def: functor ..functor) + + (def: (in x) + {.#Some x}) + + (def: (conjoint mma) + (case mma + {.#Some mx} + mx + + ... {.#None} + it + (as_expected it))))) + +(def: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Maybe a)))) - - (def: (= mx my) - (case [mx my] - [{.#None} {.#None}] - #1 - - [{.#Some x} {.#Some y}] - (at super = x y) - - _ - #0))) - -(implementation: .public (hash super) + (implementation + (def: (= mx my) + (case [mx my] + [{.#None} {.#None}] + #1 + + [{.#Some x} {.#Some y}] + (at super = x y) + + _ + #0)))) + +(def: .public (hash super) (All (_ a) (-> (Hash a) (Hash (Maybe a)))) - - (def: equivalence - (..equivalence (at super equivalence))) - - (def: (hash value) - (case value - {.#None} - 1 - - {.#Some value} - (at super hash value)))) - -(implementation: .public (with monad) + (implementation + (def: equivalence + (..equivalence (at super equivalence))) + + (def: (hash value) + (case value + {.#None} + 1 + + {.#Some value} + (at super hash value))))) + +(def: .public (with monad) (All (_ M) (-> (Monad M) (Monad (All (_ a) (M (Maybe a)))))) - - (def: functor - (functor.composite (the monad.functor monad) - ..functor)) - - (def: in - (|>> (at ..monad in) - (at monad in))) - - (def: (conjoint MmMma) - (do monad - [mMma MmMma] - (case mMma - {.#Some Mma} - Mma - - ... {.#None} - it - (in (as_expected it)))))) + (implementation + (def: functor + (functor.composite (the monad.functor monad) + ..functor)) + + (def: in + (|>> (at ..monad in) + (at monad in))) + + (def: (conjoint MmMma) + (do monad + [mMma MmMma] + (case mMma + {.#Some Mma} + Mma + + ... {.#None} + it + (in (as_expected it))))))) (def: .public (lifted monad) (All (_ M a) (-> (Monad M) (-> (M a) (M (Maybe a))))) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index 31fe9ad6a..99d4cd24e 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -19,54 +19,54 @@ (type: .public (Parser s a) (-> s (Try [s a]))) -(implementation: .public functor +(def: .public functor (All (_ s) (Functor (Parser s))) - - (def: (each f ma) - (function (_ input) - (case (ma input) - {try.#Failure msg} - {try.#Failure msg} + (implementation + (def: (each f ma) + (function (_ input) + (case (ma input) + {try.#Failure msg} + {try.#Failure msg} - {try.#Success [input' a]} - {try.#Success [input' (f a)]})))) + {try.#Success [input' a]} + {try.#Success [input' (f a)]}))))) -(implementation: .public apply +(def: .public apply (All (_ s) (Apply (Parser s))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (function (_ input) - (case (ff input) - {try.#Success [input' f]} - (case (fa input') - {try.#Success [input'' a]} - {try.#Success [input'' (f a)]} + (def: (on fa ff) + (function (_ input) + (case (ff input) + {try.#Success [input' f]} + (case (fa input') + {try.#Success [input'' a]} + {try.#Success [input'' (f a)]} - {try.#Failure msg} - {try.#Failure msg}) + {try.#Failure msg} + {try.#Failure msg}) - {try.#Failure msg} - {try.#Failure msg})))) + {try.#Failure msg} + {try.#Failure msg}))))) -(implementation: .public monad +(def: .public monad (All (_ s) (Monad (Parser s))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in x) - (function (_ input) - {try.#Success [input x]})) + (def: (in x) + (function (_ input) + {try.#Success [input x]})) - (def: (conjoint mma) - (function (_ input) - (case (mma input) - {try.#Failure msg} - {try.#Failure msg} + (def: (conjoint mma) + (function (_ input) + (case (mma input) + {try.#Failure msg} + {try.#Failure msg} - {try.#Success [input' ma]} - (ma input'))))) + {try.#Success [input' ma]} + (ma input')))))) (def: .public (assertion message test) (All (_ s) (-> Text Bit (Parser s Any))) diff --git a/stdlib/source/library/lux/control/reader.lux b/stdlib/source/library/lux/control/reader.lux index cd2d5b053..dc9c65f57 100644 --- a/stdlib/source/library/lux/control/reader.lux +++ b/stdlib/source/library/lux/control/reader.lux @@ -22,49 +22,49 @@ (All (_ r a) (-> r (Reader r a) a)) (proc env)) -(implementation: .public functor +(def: .public functor (All (_ r) (Functor (Reader r))) - - (def: (each f fa) - (function (_ env) - (f (fa env))))) + (implementation + (def: (each f fa) + (function (_ env) + (f (fa env)))))) -(implementation: .public apply +(def: .public apply (All (_ r) (Apply (Reader r))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (function (_ env) - ((ff env) (fa env))))) + (def: (on fa ff) + (function (_ env) + ((ff env) (fa env)))))) -(implementation: .public monad +(def: .public monad (All (_ r) (Monad (Reader r))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in x) - (function (_ env) x)) + (def: (in x) + (function (_ env) x)) - (def: (conjoint mma) - (function (_ env) - (mma env env)))) + (def: (conjoint mma) + (function (_ env) + (mma env env))))) -(implementation: .public (with monad) +(def: .public (with monad) (All (_ !) (-> (Monad !) (All (_ e) (Monad (All (_ a) (Reader e (! a))))))) + (implementation + (def: functor + (functor.composite ..functor (the monad.functor monad))) - (def: functor - (functor.composite ..functor (the monad.functor monad))) - - (def: in - (|>> (at monad in) - (at ..monad in))) - - (def: (conjoint eMeMa) - (function (_ env) - (do monad - [eMa (result env eMeMa)] - (result env eMa))))) + (def: in + (|>> (at monad in) + (at ..monad in))) + + (def: (conjoint eMeMa) + (function (_ env) + (do monad + [eMa (result env eMeMa)] + (result env eMa)))))) (def: .public lifted (All (_ ! e a) (-> (! a) (Reader e (! a)))) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index 6d7038b2e..066b8b890 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -69,71 +69,71 @@ cleaners} {try.#Success value}]))) -(implementation: .public (functor super) +(def: .public (functor super) (All (_ !) (-> (Functor !) (All (_ r) (Functor (Region r !))))) - - (def: (each f) - (function (_ fa) - (function (_ region+cleaners) - (at super each - (function (_ [cleaners' temp]) - [cleaners' (case temp - {try.#Success value} - {try.#Success (f value)} - - {try.#Failure error} - {try.#Failure error})]) - (fa region+cleaners)))))) - -(implementation: .public (apply super) + (implementation + (def: (each f) + (function (_ fa) + (function (_ region+cleaners) + (at super each + (function (_ [cleaners' temp]) + [cleaners' (case temp + {try.#Success value} + {try.#Success (f value)} + + {try.#Failure error} + {try.#Failure error})]) + (fa region+cleaners))))))) + +(def: .public (apply super) (All (_ !) (-> (Monad !) (All (_ r) (Apply (Region r !))))) - - (def: functor - (..functor (the monad.functor super))) - - (def: (on fa ff) - (function (_ [region cleaners]) - (do super - [[cleaners ef] (ff [region cleaners]) - [cleaners ea] (fa [region cleaners])] - (case ef - {try.#Success f} - (case ea - {try.#Success a} - (in [cleaners {try.#Success (f a)}]) - - {try.#Failure error} - (in [cleaners {try.#Failure error}])) - - {try.#Failure error} - (in [cleaners {try.#Failure error}])))))) - -(implementation: .public (monad super) + (implementation + (def: functor + (..functor (the monad.functor super))) + + (def: (on fa ff) + (function (_ [region cleaners]) + (do super + [[cleaners ef] (ff [region cleaners]) + [cleaners ea] (fa [region cleaners])] + (case ef + {try.#Success f} + (case ea + {try.#Success a} + (in [cleaners {try.#Success (f a)}]) + + {try.#Failure error} + (in [cleaners {try.#Failure error}])) + + {try.#Failure error} + (in [cleaners {try.#Failure error}]))))))) + +(def: .public (monad super) (All (_ !) (-> (Monad !) (All (_ r) (Monad (Region r !))))) - - (def: functor - (..functor (the monad.functor super))) - - (def: (in value) - (function (_ [region cleaners]) - (at super in [cleaners {try.#Success value}]))) - - (def: (conjoint ffa) - (function (_ [region cleaners]) - (do super - [[cleaners efa] (ffa [region cleaners])] - (case efa - {try.#Success fa} - (fa [region cleaners]) - - {try.#Failure error} - (in [cleaners {try.#Failure error}])))))) + (implementation + (def: functor + (..functor (the monad.functor super))) + + (def: (in value) + (function (_ [region cleaners]) + (at super in [cleaners {try.#Success value}]))) + + (def: (conjoint ffa) + (function (_ [region cleaners]) + (do super + [[cleaners efa] (ffa [region cleaners])] + (case efa + {try.#Success fa} + (fa [region cleaners]) + + {try.#Failure error} + (in [cleaners {try.#Failure error}]))))))) (def: .public (failure monad error) (All (_ ! a) diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux index a41783bc9..2328915f6 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -54,26 +54,26 @@ (type (All (_ brand label) (constructor (All (_ value) (Policy brand value label)))))) - (implementation: .public functor + (def: .public functor (~ (..of_policy Functor)) - - (def: (each f fa) - (|> fa representation f abstraction))) + (implementation + (def: (each f fa) + (|> fa representation f abstraction)))) - (implementation: .public apply + (def: .public apply (~ (..of_policy Apply)) - - (def: functor ..functor) - - (def: (on fa ff) - (abstraction ((representation ff) (representation fa))))) + (implementation + (def: functor ..functor) + + (def: (on fa ff) + (abstraction ((representation ff) (representation fa)))))) - (implementation: .public monad + (def: .public monad (~ (..of_policy Monad)) - - (def: functor ..functor) - (def: in (|>> abstraction)) - (def: conjoint (|>> representation))) + (implementation + (def: functor ..functor) + (def: in (|>> abstraction)) + (def: conjoint (|>> representation)))) ) (with_template [<brand> <value> <upgrade> <downgrade>] diff --git a/stdlib/source/library/lux/control/state.lux b/stdlib/source/library/lux/control/state.lux index 798e42b16..dc007f65a 100644 --- a/stdlib/source/library/lux/control/state.lux +++ b/stdlib/source/library/lux/control/state.lux @@ -39,38 +39,38 @@ (All (_ s a) (-> s (State s a) [s a])) (action state)) -(implementation: .public functor +(def: .public functor (All (_ s) (Functor (State s))) - - (def: (each f ma) - (function (_ state) - (let [[state' a] (ma state)] - [state' (f a)])))) + (implementation + (def: (each f ma) + (function (_ state) + (let [[state' a] (ma state)] + [state' (f a)]))))) -(implementation: .public apply +(def: .public apply (All (_ s) (Apply (State s))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (function (_ state) - (let [[state' f] (ff state) - [state'' a] (fa state')] - [state'' (f a)])))) + (def: (on fa ff) + (function (_ state) + (let [[state' f] (ff state) + [state'' a] (fa state')] + [state'' (f a)]))))) -(implementation: .public monad +(def: .public monad (All (_ s) (Monad (State s))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in a) - (function (_ state) - [state a])) + (def: (in a) + (function (_ state) + [state a])) - (def: (conjoint mma) - (function (_ state) - (let [[state' ma] (mma state)] - (ma state'))))) + (def: (conjoint mma) + (function (_ state) + (let [[state' ma] (mma state)] + (ma state')))))) (def: .public (while condition body) (All (_ s) (-> (State s Bit) (State s Any) (State s Any))) @@ -88,25 +88,25 @@ [_ body] (while condition body))) -(implementation: (with//functor functor) +(def: (with//functor functor) (All (_ M s) (-> (Functor M) (Functor (All (_ a) (-> s (M [s a])))))) - - (def: (each f sfa) - (function (_ state) - (at functor each (function (_ [s a]) [s (f a)]) - (sfa state))))) + (implementation + (def: (each f sfa) + (function (_ state) + (at functor each (function (_ [s a]) [s (f a)]) + (sfa state)))))) -(implementation: (with//apply monad) +(def: (with//apply monad) (All (_ M s) (-> (Monad M) (Apply (All (_ a) (-> s (M [s a])))))) - - (def: functor (with//functor (at monad functor))) + (implementation + (def: functor (with//functor (at monad functor))) - (def: (on sFa sFf) - (function (_ state) - (do monad - [[state f] (sFf state) - [state a] (sFa state)] - (in [state (f a)]))))) + (def: (on sFa sFf) + (function (_ state) + (do monad + [[state f] (sFf state) + [state a] (sFa state)] + (in [state (f a)])))))) (type: .public (+State M s a) (-> s (M [s a]))) @@ -115,20 +115,20 @@ (All (_ M s a) (-> s (+State M s a) (M [s a]))) (action state)) -(implementation: .public (with monad) +(def: .public (with monad) (All (_ M s) (-> (Monad M) (Monad (+State M s)))) - - (def: functor (with//functor (at monad functor))) - - (def: (in a) - (function (_ state) - (at monad in [state a]))) - - (def: (conjoint sMsMa) - (function (_ state) - (do monad - [[state' sMa] (sMsMa state)] - (sMa state'))))) + (implementation + (def: functor (with//functor (at monad functor))) + + (def: (in a) + (function (_ state) + (at monad in [state a]))) + + (def: (conjoint sMsMa) + (function (_ state) + (do monad + [[state' sMa] (sMsMa state)] + (sMa state')))))) (def: .public (lifted monad ma) (All (_ M s a) (-> (Monad M) (M a) (+State M s a))) diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index 13ac32bf5..2725e4a84 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -64,35 +64,35 @@ (IO a))) (|>> ..result io.io)) -(implementation: .public functor +(def: .public functor (All (_ !) (Functor (Thread !))) + (implementation + (def: (each f) + (function (_ fa) + (function (_ !) + (f (fa !))))))) - (def: (each f) - (function (_ fa) - (function (_ !) - (f (fa !)))))) - -(implementation: .public apply +(def: .public apply (All (_ !) (Apply (Thread !))) + (implementation + (def: functor ..functor) - (def: functor ..functor) - - (def: (on fa ff) - (function (_ !) - ((ff !) (fa !))))) + (def: (on fa ff) + (function (_ !) + ((ff !) (fa !)))))) -(implementation: .public monad +(def: .public monad (All (_ !) (Monad (Thread !))) + (implementation + (def: functor ..functor) - (def: functor ..functor) + (def: (in value) + (function (_ !) + value)) - (def: (in value) - (function (_ !) - value)) - - (def: (conjoint ffa) - (function (_ !) - ((ffa !) !)))) + (def: (conjoint ffa) + (function (_ !) + ((ffa !) !))))) (def: .public (update! f box) (All (_ ! r w) (-> (-> r w) (Box' ! r w) (Thread ! [r w]))) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index 563d7c114..3b5da2546 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -15,96 +15,96 @@ {#Failure Text} {#Success a})) -(implementation: .public functor +(def: .public functor (Functor Try) - - (def: (each f ma) - (case ma - {#Success datum} - {#Success (f datum)} + (implementation + (def: (each f ma) + (case ma + {#Success datum} + {#Success (f datum)} - ... {#Failure msg} - it - (as_expected it)))) + ... {#Failure msg} + it + (as_expected it))))) -(implementation: .public apply +(def: .public apply (Apply Try) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (case ff - {#Success f} - (case fa - {#Success a} - {#Success (f a)} + (def: (on fa ff) + (case ff + {#Success f} + (case fa + {#Success a} + {#Success (f a)} - ... {#Failure msg} - it - (as_expected it)) + ... {#Failure msg} + it + (as_expected it)) - ... {#Failure msg} - it - (as_expected it)))) + ... {#Failure msg} + it + (as_expected it))))) -(implementation: .public monad +(def: .public monad (Monad Try) - - (def: functor ..functor) - - (def: (in a) - {#Success a}) - - (def: (conjoint mma) - (case mma - {#Success ma} - ma - - ... {#Failure msg} - it - (as_expected it)))) - -(implementation: .public (with monad) + (implementation + (def: functor ..functor) + + (def: (in a) + {#Success a}) + + (def: (conjoint mma) + (case mma + {#Success ma} + ma + + ... {#Failure msg} + it + (as_expected it))))) + +(def: .public (with monad) ... TODO: Replace (All (_ a) (! (Try a))) with (functor.Then ! Try) (All (_ !) (-> (Monad !) (Monad (All (_ a) (! (Try a)))))) - - (def: functor - (functor.composite (the monad.functor monad) - ..functor)) - - (def: in - (|>> (at ..monad in) - (at monad in))) - - (def: (conjoint MeMea) - (do monad - [eMea MeMea] - (case eMea - {#Success Mea} - Mea - - ... {#Failure error} - it - (in (as_expected it)))))) + (implementation + (def: functor + (functor.composite (the monad.functor monad) + ..functor)) + + (def: in + (|>> (at ..monad in) + (at monad in))) + + (def: (conjoint MeMea) + (do monad + [eMea MeMea] + (case eMea + {#Success Mea} + Mea + + ... {#Failure error} + it + (in (as_expected it))))))) (def: .public (lifted monad) (All (_ ! a) (-> (Monad !) (-> (! a) (! (Try a))))) (at monad each (at ..monad in))) -(implementation: .public (equivalence (open "_#[0]")) +(def: .public (equivalence (open "_#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Try a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Success reference} {#Success sample}] - (_#= reference sample) - - [{#Failure reference} {#Failure sample}] - ("lux text =" reference sample) - - _ - false - ))) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Success reference} {#Success sample}] + (_#= reference sample) + + [{#Failure reference} {#Failure sample}] + ("lux text =" reference sample) + + _ + false + )))) (def: .public (trusted try) (All (_ a) diff --git a/stdlib/source/library/lux/control/writer.lux b/stdlib/source/library/lux/control/writer.lux index e08e494d1..88b536e30 100644 --- a/stdlib/source/library/lux/control/writer.lux +++ b/stdlib/source/library/lux/control/writer.lux @@ -17,62 +17,62 @@ (All (_ log) (-> log (Writer log Any))) [message []]) -(implementation: .public functor +(def: .public functor (All (_ l) (Functor (Writer l))) - - (def: (each f fa) - (let [[log datum] fa] - [log (f datum)]))) + (implementation + (def: (each f fa) + (let [[log datum] fa] + [log (f datum)])))) -(implementation: .public (apply monoid) +(def: .public (apply monoid) (All (_ l) (-> (Monoid l) (Apply (Writer l)))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (let [[log1 f] ff - [log2 a] fa] - [(at monoid composite log1 log2) (f a)]))) + (def: (on fa ff) + (let [[log1 f] ff + [log2 a] fa] + [(at monoid composite log1 log2) (f a)])))) -(implementation: .public (monad monoid) +(def: .public (monad monoid) (All (_ l) (-> (Monoid l) (Monad (Writer l)))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: in - (|>> [(at monoid identity)])) + (def: in + (|>> [(at monoid identity)])) - (def: (conjoint mma) - (let [[log1 [log2 a]] mma] - [(at monoid composite log1 log2) a]))) + (def: (conjoint mma) + (let [[log1 [log2 a]] mma] + [(at monoid composite log1 log2) a])))) -(implementation: .public (with monoid monad) +(def: .public (with monoid monad) (All (_ l M) (-> (Monoid l) (Monad M) (Monad (All (_ a) (M (Writer l a)))))) + (implementation + (def: functor + (functor.composite (the monad.functor monad) + ..functor)) - (def: functor - (functor.composite (the monad.functor monad) - ..functor)) - - (def: in - (let [writer (..monad monoid)] - (|>> (at writer in) (at monad in)))) - - (def: (conjoint MlMla) - (do monad - [[l1 Mla] (for @.old - (is {.#Apply (Writer (parameter 0) - {.#Apply (Writer (parameter 0) - (parameter 2)) - (parameter 1)}) - (parameter 1)} - MlMla) - ... On new compiler - MlMla) - [l2 a] Mla] - (in [(at monoid composite l1 l2) a])))) + (def: in + (let [writer (..monad monoid)] + (|>> (at writer in) (at monad in)))) + + (def: (conjoint MlMla) + (do monad + [[l1 Mla] (for @.old + (is {.#Apply (Writer (parameter 0) + {.#Apply (Writer (parameter 0) + (parameter 2)) + (parameter 1)}) + (parameter 1)} + MlMla) + ... On new compiler + MlMla) + [l2 a] Mla] + (in [(at monoid composite l1 l2) a]))))) (def: .public (lifted monoid monad) (All (_ l M a) diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index d39c1eff1..5290075eb 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -72,11 +72,11 @@ [has_64! /.has_64! (n.+ 7)] ) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Binary) - - (def: (= reference sample) - (/.= reference sample))) + (implementation + (def: (= reference sample) + (/.= reference sample)))) (exception: .public (cannot_copy [bytes Nat source_input Nat @@ -122,17 +122,17 @@ ... else (/.empty 0))) -(implementation: .public monoid +(def: .public monoid (Monoid Binary) - - (def: identity - (/.empty 0)) - - (def: (composite left right) - (let [sizeL (/.size left) - sizeR (/.size right) - output (/.empty (n.+ sizeL sizeR))] - (exec - (/.copy! sizeL 0 left 0 output) - (/.copy! sizeR 0 right sizeL output) - output)))) + (implementation + (def: identity + (/.empty 0)) + + (def: (composite left right) + (let [sizeL (/.size left) + sizeR (/.size right) + output (/.empty (n.+ sizeL sizeR))] + (exec + (/.copy! sizeL 0 left 0 output) + (/.copy! sizeR 0 right sizeL output) + output))))) diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index da276ed5a..6d9988573 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -17,48 +17,48 @@ [off on] ) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Bit) - - (def: (= x y) - (if x - y - (not y)))) + (implementation + (def: (= x y) + (if x + y + (not y))))) -(implementation: .public hash +(def: .public hash (Hash Bit) - - (def: equivalence ..equivalence) - - (def: (hash value) - (case value - #0 2 - #1 3))) + (implementation + (def: equivalence ..equivalence) + + (def: (hash value) + (case value + #0 2 + #1 3)))) (with_template [<name> <identity> <op>] - [(implementation: .public <name> + [(def: .public <name> (Monoid Bit) - - (def: identity <identity>) - (def: (composite x y) (<op> x y)))] + (implementation + (def: identity <identity>) + (def: (composite x y) (<op> x y))))] [disjunction #0 or] [conjunction #1 and] ) -(implementation: .public codec +(def: .public codec (Codec Text Bit) - - (def: (encoded x) - (if x - "#1" - "#0")) + (implementation + (def: (encoded x) + (if x + "#1" + "#0")) - (def: (decoded input) - (case input - "#1" {.#Right #1} - "#0" {.#Right #0} - _ {.#Left "Wrong syntax for Bit."}))) + (def: (decoded input) + (case input + "#1" {.#Right #1} + "#0" {.#Right #0} + _ {.#Left "Wrong syntax for Bit."})))) (def: .public complement (All (_ a) (-> (-> a Bit) (-> a Bit))) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index 7d239d16a..f4e987ca9 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -110,34 +110,34 @@ (All (_ r w) (-> (Maybe r) (Array' r w) (List r))) (!.list default array)) -(implementation: .public (equivalence //) +(def: .public (equivalence //) (All (_ r) (-> (Equivalence r) (Equivalence (Ex (_ w) (Array' r w))))) - - (def: (= left/* right/*) - (!.= // left/* right/*))) + (implementation + (def: (= left/* right/*) + (!.= // left/* right/*)))) -(implementation: .public monoid +(def: .public monoid (All (_ a) (Monoid (Array a))) - - (def: identity (!.empty 0)) + (implementation + (def: identity (!.empty 0)) - (def: (composite left/* right/*) - (!.composite left/* right/*))) + (def: (composite left/* right/*) + (!.composite left/* right/*)))) -(implementation: .public mix +(def: .public mix (Mix (All (_ r) (Array' r Nothing))) - - (def: (mix $ init it) - (!.mix (function (_ index partial total) - ($ partial total)) - init - it))) - -(implementation: .public functor + (implementation + (def: (mix $ init it) + (!.mix (function (_ index partial total) + ($ partial total)) + init + it)))) + +(def: .public functor (Functor Array) - - (def: (each $ input) - (!.each $ input))) + (implementation + (def: (each $ input) + (!.each $ input)))) (with_template [<safe> <unsafe>] [(def: .public (<safe> ? it) diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index 1df1551e6..c33ecd77f 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -162,16 +162,16 @@ [xor i64.xor] ) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Bits) - - (def: (= reference sample) - (let [size (n.max (array.size reference) - (array.size sample))] - (loop (again [idx 0]) - (if (n.< size idx) - (.and ("lux i64 =" - (..chunk idx reference) - (..chunk idx sample)) - (again (++ idx))) - #1))))) + (implementation + (def: (= reference sample) + (let [size (n.max (array.size reference) + (array.size sample))] + (loop (again [idx 0]) + (if (n.< size idx) + (.and ("lux i64 =" + (..chunk idx reference) + (..chunk idx sample)) + (again (++ idx))) + #1)))))) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index ef8f4f75d..124adeceb 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -690,52 +690,52 @@ (empty key_hash) keys))) -(implementation: .public (equivalence (open ",#[0]")) +(def: .public (equivalence (open ",#[0]")) (All (_ k v) (-> (Equivalence v) (Equivalence (Dictionary k v)))) - - (def: (= reference subject) - (and (n.= (..size reference) - (..size subject)) - (list.every? (function (_ [k rv]) - (case (..value k subject) - {.#Some sv} - (,#= rv sv) - - _ - #0)) - (..entries reference))))) - -(implementation: node_functor + (implementation + (def: (= reference subject) + (and (n.= (..size reference) + (..size subject)) + (list.every? (function (_ [k rv]) + (case (..value k subject) + {.#Some sv} + (,#= rv sv) + + _ + #0)) + (..entries reference)))))) + +(def: node_functor (All (_ k) (Functor (Node k))) - - (def: (each f fa) - (case fa - {#Hierarchy size hierarchy} - {#Hierarchy size (array.each (each f) hierarchy)} - - {#Base bitmap base} - {#Base bitmap (array.each (function (_ either) - (case either - {.#Left fa'} - {.#Left (each f fa')} - - {.#Right [k v]} - {.#Right [k (f v)]})) - base)} - - {#Collisions hash collisions} - {#Collisions hash (array.each (function (_ [k v]) - [k (f v)]) - collisions)}))) - -(implementation: .public functor + (implementation + (def: (each f fa) + (case fa + {#Hierarchy size hierarchy} + {#Hierarchy size (array.each (each f) hierarchy)} + + {#Base bitmap base} + {#Base bitmap (array.each (function (_ either) + (case either + {.#Left fa'} + {.#Left (each f fa')} + + {.#Right [k v]} + {.#Right [k (f v)]})) + base)} + + {#Collisions hash collisions} + {#Collisions hash (array.each (function (_ [k v]) + [k (f v)]) + collisions)})))) + +(def: .public functor (All (_ k) (Functor (Dictionary k))) - - (def: (each f fa) - (.revised #root (at ..node_functor each f) fa))) + (implementation + (def: (each f fa) + (.revised #root (at ..node_functor each f) fa)))) -(implementation: .public (monoid hash) +(def: .public (monoid hash) (All (_ k v) (-> (Hash k) (Monoid (Dictionary k v)))) - - (def: identity (..empty hash)) - (def: composite ..composite)) + (implementation + (def: identity (..empty hash)) + (def: composite ..composite))) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index 00c1cc840..38521368c 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -562,21 +562,21 @@ [values v (the #value node')] ) -(implementation: .public (equivalence (open ",#[0]")) +(def: .public (equivalence (open ",#[0]")) (All (_ k v) (-> (Equivalence v) (Equivalence (Dictionary k v)))) - - (def: (= reference sample) - (let [(open "/#[0]") (the #order reference)] - (loop (again [entriesR (entries reference) - entriesS (entries sample)]) - (case [entriesR entriesS] - [{.#End} {.#End}] - #1 - - [{.#Item [keyR valueR] entriesR'} {.#Item [keyS valueS] entriesS'}] - (and (/#= keyR keyS) - (,#= valueR valueS) - (again entriesR' entriesS')) - - _ - #0))))) + (implementation + (def: (= reference sample) + (let [(open "/#[0]") (the #order reference)] + (loop (again [entriesR (entries reference) + entriesS (entries sample)]) + (case [entriesR entriesS] + [{.#End} {.#End}] + #1 + + [{.#Item [keyR valueR] entriesR'} {.#Item [keyS valueS] entriesS'}] + (and (/#= keyR keyS) + (,#= valueR valueS) + (again entriesR' entriesS')) + + _ + #0)))))) diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux index 4f91cfc6d..d594f7b5e 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/plist.lux @@ -96,27 +96,27 @@ {.#Item [k' v'] (lacks key properties')}))) -(implementation: .public (equivalence (open "/#[0]")) +(def: .public (equivalence (open "/#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (PList a)))) - - (def: (= reference subject) - (and (n.= (list.size reference) - (list.size subject)) - (list.every? (function (_ [key val]) - (|> reference - (..value key) - (maybe#each (/#= val)) - (maybe.else false))) - subject)))) - -(implementation: .public monoid + (implementation + (def: (= reference subject) + (and (n.= (list.size reference) + (list.size subject)) + (list.every? (function (_ [key val]) + (|> reference + (..value key) + (maybe#each (/#= val)) + (maybe.else false))) + subject))))) + +(def: .public monoid (All (_ a) (Monoid (PList a))) - - (def: identity - ..empty) - - (def: (composite left right) - (list#mix (function (_ [key val] it) - (..has key val it)) - right - left))) + (implementation + (def: identity + ..empty) + + (def: (composite left right) + (list#mix (function (_ [key val] it) + (..has key val it)) + right + left)))) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 64dbcb141..0e47ff3dd 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -23,16 +23,16 @@ ... #End ... {#Item a (List a)}) -(implementation: .public mix +(def: .public mix (Mix List) - - (def: (mix f init xs) - (case xs - {.#End} - init + (implementation + (def: (mix f init xs) + (case xs + {.#End} + init - {.#Item x xs'} - (mix f (f x init) xs')))) + {.#Item x xs'} + (mix f (f x init) xs'))))) (def: .public (mixes f init inputs) (All (_ a b) (-> (-> a b b) b (List a) (List b))) @@ -289,87 +289,87 @@ 0 {.#Some x} _ (item (-- i) xs')))) -(implementation: .public (equivalence Equivalence<a>) +(def: .public (equivalence Equivalence<a>) (All (_ a) (-> (Equivalence a) (Equivalence (List a)))) - - (def: (= xs ys) - (case [xs ys] - [{.#End} {.#End}] - #1 + (implementation + (def: (= xs ys) + (case [xs ys] + [{.#End} {.#End}] + #1 - [{.#Item x xs'} {.#Item y ys'}] - (and (at Equivalence<a> = x y) - (= xs' ys')) + [{.#Item x xs'} {.#Item y ys'}] + (and (at Equivalence<a> = x y) + (= xs' ys')) - [_ _] - #0 - ))) + [_ _] + #0 + )))) -(implementation: .public (hash super) +(def: .public (hash super) (All (_ a) (-> (Hash a) (Hash (List a)))) - - (def: equivalence - (..equivalence (at super equivalence))) - - (def: hash - (at ..mix mix - (function (_ member hash) - (n.+ (at super hash member) hash)) - 0))) - -(implementation: .public monoid + (implementation + (def: equivalence + (..equivalence (at super equivalence))) + + (def: hash + (at ..mix mix + (function (_ member hash) + (n.+ (at super hash member) hash)) + 0)))) + +(def: .public monoid (All (_ a) (Monoid (List a))) - - (def: identity - {.#End}) - (def: (composite xs ys) - (case xs - {.#End} - ys - - {.#Item x xs'} - {.#Item x (composite xs' ys)}))) + (implementation + (def: identity + {.#End}) + (def: (composite xs ys) + (case xs + {.#End} + ys + + {.#Item x xs'} + {.#Item x (composite xs' ys)})))) (open: "[0]" ..monoid) -(implementation: .public functor +(def: .public functor (Functor List) - - (def: (each f ma) - (case ma - {.#End} - {.#End} - - {.#Item a ma'} - {.#Item (f a) (each f ma')}))) + (implementation + (def: (each f ma) + (case ma + {.#End} + {.#End} + + {.#Item a ma'} + {.#Item (f a) (each f ma')})))) (open: "[0]" ..functor) -(implementation: .public apply +(def: .public apply (Apply List) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (case ff - {.#End} - {.#End} - - {.#Item f ff'} - (|> ff' - (on fa) - (composite (each f fa)))))) + (def: (on fa ff) + (case ff + {.#End} + {.#End} + + {.#Item f ff'} + (|> ff' + (on fa) + (composite (each f fa))))))) -(implementation: .public monad +(def: .public monad (Monad List) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in a) - {.#Item a {.#End}}) + (def: (in a) + {.#Item a {.#End}}) - (def: conjoint - (|>> reversed (mix composite identity)))) + (def: conjoint + (|>> reversed (mix composite identity))))) (def: .public (sorted < xs) (All (_ a) (-> (-> a a Bit) (List a) (List a))) @@ -573,25 +573,25 @@ (All (_ a) (-> (List (List a)) (List a))) (at ..monad conjoint)) -(implementation: .public (with monad) +(def: .public (with monad) (All (_ M) (-> (Monad M) (Monad (All (_ a) (M (List a)))))) - - (def: functor - (functor.composite (the monad.functor monad) - ..functor)) - - (def: in - (|>> (at ..monad in) (at monad in))) - - (def: (conjoint MlMla) - (do [! monad] - [lMla MlMla - ... TODO: Remove this version ASAP and use one below. - lla (for @.old (is {.#Apply (type (List (List (parameter 1)))) - (parameter 0)} - (monad.all ! lMla)) - (monad.all ! lMla))] - (in (..together lla))))) + (implementation + (def: functor + (functor.composite (the monad.functor monad) + ..functor)) + + (def: in + (|>> (at ..monad in) (at monad in))) + + (def: (conjoint MlMla) + (do [! monad] + [lMla MlMla + ... TODO: Remove this version ASAP and use one below. + lla (for @.old (is {.#Apply (type (List (List (parameter 1)))) + (parameter 0)} + (monad.all ! lMla)) + (monad.all ! lMla))] + (in (..together lla)))))) (def: .public (lifted monad) (All (_ M a) (-> (Monad M) (-> (M a) (M (List a))))) diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index 0d11963cd..3919ea449 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -78,17 +78,17 @@ _ (revised #rear (|>> {.#Item val}) queue))) -(implementation: .public (equivalence super) +(def: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Queue a)))) - - (def: (= reference subject) - (at (list.equivalence super) = - (..list reference) - (..list subject)))) + (implementation + (def: (= reference subject) + (at (list.equivalence super) = + (..list reference) + (..list subject))))) -(implementation: .public functor +(def: .public functor (Functor Queue) - - (def: (each f fa) - [#front (|> fa (the #front) (list#each f)) - #rear (|> fa (the #rear) (list#each f))])) + (implementation + (def: (each f fa) + [#front (|> fa (the #front) (list#each f)) + #rear (|> fa (the #rear) (list#each f))]))) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index b6bdf698a..bae056369 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -369,112 +369,112 @@ (syntax (_ [elems (<>.some <code>.any)]) (in (.list (` (..of_list (.list (~+ elems)))))))) -(implementation: (node_equivalence //#=) +(def: (node_equivalence //#=) (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) - - (def: (= v1 v2) - (case [v1 v2] - [{#Base b1} {#Base b2}] - (array.= //#= b1 b2) - - [{#Hierarchy h1} {#Hierarchy h2}] - (array.= (node_equivalence //#=) h1 h2) - - _ - #0))) - -(implementation: .public (equivalence //#=) + (implementation + (def: (= v1 v2) + (case [v1 v2] + [{#Base b1} {#Base b2}] + (array.= //#= b1 b2) + + [{#Hierarchy h1} {#Hierarchy h2}] + (array.= (node_equivalence //#=) h1 h2) + + _ + #0)))) + +(def: .public (equivalence //#=) (All (_ a) (-> (Equivalence a) (Equivalence (Sequence a)))) - - (def: (= v1 v2) - (and (n.= (the #size v1) (the #size v2)) - (let [(open "node#[0]") (node_equivalence //#=)] - (and (node#= {#Base (the #tail v1)} - {#Base (the #tail v2)}) - (node#= {#Hierarchy (the #root v1)} - {#Hierarchy (the #root v2)})))))) - -(implementation: node_mix + (implementation + (def: (= v1 v2) + (and (n.= (the #size v1) (the #size v2)) + (let [(open "node#[0]") (node_equivalence //#=)] + (and (node#= {#Base (the #tail v1)} + {#Base (the #tail v2)}) + (node#= {#Hierarchy (the #root v1)} + {#Hierarchy (the #root v2)}))))))) + +(def: node_mix (Mix Node) - - (def: (mix $ init xs) - (case xs - {#Base base} - (array.mix (function (_ _ item output) ($ item output)) - init - base) - - {#Hierarchy hierarchy} - (array.mix (function (_ _ node init') (mix $ init' node)) + (implementation + (def: (mix $ init xs) + (case xs + {#Base base} + (array.mix (function (_ _ item output) ($ item output)) + init + base) + + {#Hierarchy hierarchy} + (array.mix (function (_ _ node init') (mix $ init' node)) + init + hierarchy))))) + +(def: .public mix + (Mix Sequence) + (implementation + (def: (mix $ init xs) + (let [(open "[0]") node_mix] + (mix $ + (mix $ init - hierarchy)))) + {#Hierarchy (the #root xs)}) + {#Base (the #tail xs)}))))) -(implementation: .public mix - (Mix Sequence) - - (def: (mix $ init xs) - (let [(open "[0]") node_mix] - (mix $ - (mix $ - init - {#Hierarchy (the #root xs)}) - {#Base (the #tail xs)})))) - -(implementation: .public monoid +(def: .public monoid (All (_ a) (Monoid (Sequence a))) - - (def: identity ..empty) - - (def: (composite xs ys) - (list#mix suffix xs (..list ys)))) + (implementation + (def: identity ..empty) + + (def: (composite xs ys) + (list#mix suffix xs (..list ys))))) -(implementation: node_functor +(def: node_functor (Functor Node) - - (def: (each $ xs) - (case xs - {#Base base} - {#Base (array.each $ base)} - - {#Hierarchy hierarchy} - {#Hierarchy (array.each (each $) hierarchy)}))) - -(implementation: .public functor + (implementation + (def: (each $ xs) + (case xs + {#Base base} + {#Base (array.each $ base)} + + {#Hierarchy hierarchy} + {#Hierarchy (array.each (each $) hierarchy)})))) + +(def: .public functor (Functor Sequence) - - (def: (each $ xs) - [#level (the #level xs) - #size (the #size xs) - #root (let [... TODO: This binding was established to get around a compilation error. Fix and inline! - $ (at node_functor each $)] - (|> xs (the #root) (array.each $))) - #tail (|> xs (the #tail) (array.each $))])) - -(implementation: .public apply + (implementation + (def: (each $ xs) + [#level (the #level xs) + #size (the #size xs) + #root (let [ ... TODO: This binding was established to get around a compilation error. Fix and inline! + $ (at node_functor each $)] + (|> xs (the #root) (array.each $))) + #tail (|> xs (the #tail) (array.each $))]))) + +(def: .public apply (Apply Sequence) - - (def: functor ..functor) - - (def: (on fa ff) - (let [(open "[0]") ..functor - (open "[0]") ..mix - (open "[0]") ..monoid - results (each (function (_ f) (each f fa)) - ff)] - (mix composite identity results)))) - -(implementation: .public monad + (implementation + (def: functor ..functor) + + (def: (on fa ff) + (let [(open "[0]") ..functor + (open "[0]") ..mix + (open "[0]") ..monoid + results (each (function (_ f) (each f fa)) + ff)] + (mix composite identity results))))) + +(def: .public monad (Monad Sequence) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: in - (|>> sequence)) + (def: in + (|>> sequence)) - (def: conjoint - (let [(open "[0]") ..mix - (open "[0]") ..monoid] - (mix (function (_ post pre) (composite pre post)) identity)))) + (def: conjoint + (let [(open "[0]") ..mix + (open "[0]") ..monoid] + (mix (function (_ post pre) (composite pre post)) identity))))) (def: .public reversed (All (_ a) (-> (Sequence a) (Sequence a))) diff --git a/stdlib/source/library/lux/data/collection/set.lux b/stdlib/source/library/lux/data/collection/set.lux index 1d32060b9..138d5c351 100644 --- a/stdlib/source/library/lux/data/collection/set.lux +++ b/stdlib/source/library/lux/data/collection/set.lux @@ -61,30 +61,30 @@ (//.sub (//.keys filter) base)) -(implementation: .public equivalence +(def: .public equivalence (All (_ a) (Equivalence (Set a))) - - (def: (= (^.let reference [hash _]) sample) - (and (n.= (..size reference) - (..size sample)) - (list.every? (..member? reference) - (..list sample))))) - -(implementation: .public hash + (implementation + (def: (= (^.let reference [hash _]) sample) + (and (n.= (..size reference) + (..size sample)) + (list.every? (..member? reference) + (..list sample)))))) + +(def: .public hash (All (_ a) (Hash (Set a))) - - (def: equivalence ..equivalence) - - (def: (hash set) - (|> set - ..list - (at (list.hash (..member_hash set)) hash)))) - -(implementation: .public (monoid hash) + (implementation + (def: equivalence ..equivalence) + + (def: (hash set) + (|> set + ..list + (at (list.hash (..member_hash set)) hash))))) + +(def: .public (monoid hash) (All (_ a) (-> (Hash a) (Monoid (Set a)))) - - (def: identity (..empty hash)) - (def: composite ..union)) + (implementation + (def: identity (..empty hash)) + (def: composite ..union))) (def: .public empty? (All (_ a) (-> (Set a) Bit)) diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux index 9141df9b2..f43c6fa10 100644 --- a/stdlib/source/library/lux/data/collection/set/multi.lux +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -112,32 +112,32 @@ dictionary.keys (//.of_list hash)))) - (implementation: .public equivalence + (def: .public equivalence (All (_ a) (Equivalence (Set a))) - - (def: (= reference sample) - (let [reference (representation reference)] - (and (n.= (dictionary.size reference) - (dictionary.size (representation sample))) - (|> reference - dictionary.entries - (list.every? (function (_ [elem multiplicity]) - (|> elem - (..multiplicity sample) - (n.= multiplicity))))))))) - - (implementation: .public hash + (implementation + (def: (= reference sample) + (let [reference (representation reference)] + (and (n.= (dictionary.size reference) + (dictionary.size (representation sample))) + (|> reference + dictionary.entries + (list.every? (function (_ [elem multiplicity]) + (|> elem + (..multiplicity sample) + (n.= multiplicity)))))))))) + + (def: .public hash (All (_ a) (Hash (Set a))) - - (def: equivalence ..equivalence) - - (def: (hash set) - (let [set (representation set) - [hash _] set] - (list#mix (function (_ [elem multiplicity] acc) - (|> elem (at hash hash) (n.* multiplicity) (n.+ acc))) - 0 - (dictionary.entries set))))) + (implementation + (def: equivalence ..equivalence) + + (def: (hash set) + (let [set (representation set) + [hash _] set] + (list#mix (function (_ [elem multiplicity] acc) + (|> elem (at hash hash) (n.* multiplicity) (n.+ acc))) + 0 + (dictionary.entries set)))))) ) (def: .public (member? set elem) diff --git a/stdlib/source/library/lux/data/collection/set/ordered.lux b/stdlib/source/library/lux/data/collection/set/ordered.lux index 296e0aadc..30fab5b6a 100644 --- a/stdlib/source/library/lux/data/collection/set/ordered.lux +++ b/stdlib/source/library/lux/data/collection/set/ordered.lux @@ -66,12 +66,12 @@ (list.only (|>> (..member? param) not)) (..of_list (the /.#order (representation subject))))) - (implementation: .public equivalence + (def: .public equivalence (All (_ a) (Equivalence (Set a))) - - (def: (= reference sample) - (at (list.equivalence (at (representation reference) equivalence)) - = (..list reference) (..list sample)))) + (implementation + (def: (= reference sample) + (at (list.equivalence (at (representation reference) equivalence)) + = (..list reference) (..list sample))))) ) (def: .public (sub? super sub) diff --git a/stdlib/source/library/lux/data/collection/stack.lux b/stdlib/source/library/lux/data/collection/stack.lux index 1b52dfdaa..baf2bf038 100644 --- a/stdlib/source/library/lux/data/collection/stack.lux +++ b/stdlib/source/library/lux/data/collection/stack.lux @@ -47,20 +47,20 @@ (All (_ a) (-> a (Stack a) (Stack a))) (abstraction {.#Item value (representation stack)})) - (implementation: .public (equivalence super) + (def: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Stack a)))) + (implementation + (def: (= reference subject) + (at (//.equivalence super) = (representation reference) (representation subject))))) - (def: (= reference subject) - (at (//.equivalence super) = (representation reference) (representation subject)))) - - (implementation: .public functor + (def: .public functor (Functor Stack) - - (def: (each f value) - (|> value - representation - (at //.functor each f) - abstraction))) + (implementation + (def: (each f value) + (|> value + representation + (at //.functor each f) + abstraction)))) ) diff --git a/stdlib/source/library/lux/data/collection/stream.lux b/stdlib/source/library/lux/data/collection/stream.lux index a005782b4..4f77166fa 100644 --- a/stdlib/source/library/lux/data/collection/stream.lux +++ b/stdlib/source/library/lux/data/collection/stream.lux @@ -109,23 +109,23 @@ [(..only left? xs) (..only (bit.complement left?) xs)]) -(implementation: .public functor +(def: .public functor (Functor Stream) - - (def: (each f fa) - (let [[head tail] (//.result fa)] - (//.pending [(f head) (each f tail)])))) + (implementation + (def: (each f fa) + (let [[head tail] (//.result fa)] + (//.pending [(f head) (each f tail)]))))) -(implementation: .public comonad +(def: .public comonad (CoMonad Stream) - - (def: functor ..functor) - - (def: out head) - - (def: (disjoint wa) - (let [[head tail] (//.result wa)] - (//.pending [wa (disjoint tail)])))) + (implementation + (def: functor ..functor) + + (def: out head) + + (def: (disjoint wa) + (let [[head tail] (//.result wa)] + (//.pending [wa (disjoint tail)]))))) (def: .public pattern (syntax (_ [patterns (<code>.form (<>.many <code>.any)) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index 52f7f4ec4..64b0d13f7 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -60,26 +60,26 @@ (` [#value (~ value) #children (list (~+ (list#each again children)))])))))) -(implementation: .public (equivalence super) +(def: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Tree a)))) - - (def: (= tx ty) - (and (at super = (the #value tx) (the #value ty)) - (at (list.equivalence (equivalence super)) = (the #children tx) (the #children ty))))) + (implementation + (def: (= tx ty) + (and (at super = (the #value tx) (the #value ty)) + (at (list.equivalence (equivalence super)) = (the #children tx) (the #children ty)))))) -(implementation: .public functor +(def: .public functor (Functor Tree) - - (def: (each f fa) - [#value (f (the #value fa)) - #children (list#each (each f) - (the #children fa))])) + (implementation + (def: (each f fa) + [#value (f (the #value fa)) + #children (list#each (each f) + (the #children fa))]))) -(implementation: .public mix +(def: .public mix (Mix Tree) - - (def: (mix f init tree) - (list#mix (function (_ tree' init') (mix f init' tree')) - (f (the #value tree) - init) - (the #children tree)))) + (implementation + (def: (mix f init tree) + (list#mix (function (_ tree' init') (mix f init' tree')) + (f (the #value tree) + init) + (the #children tree))))) diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux index 74b2c633b..b316d4dc5 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -38,20 +38,20 @@ [root #root (Either v [(Tree @ t v) (Tree @ t v)])] ) - (implementation: .public (builder monoid) + (def: .public (builder monoid) (All (_ t) (Ex (_ @) (-> (Monoid t) (Builder @ t)))) - - (def: (leaf tag value) - (abstraction - [#monoid monoid - #tag tag - #root {.#Left value}])) - - (def: (branch left right) - (abstraction - [#monoid monoid - #tag (at monoid composite (..tag left) (..tag right)) - #root {.#Right [left right]}]))) + (implementation + (def: (leaf tag value) + (abstraction + [#monoid monoid + #tag tag + #root {.#Left value}])) + + (def: (branch left right) + (abstraction + [#monoid monoid + #tag (at monoid composite (..tag left) (..tag right)) + #root {.#Right [left right]}])))) (def: .public (value tree) (All (_ @ t v) (-> (Tree @ t v) v)) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 861713b8c..d69f75ef4 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -29,20 +29,20 @@ [#family (Maybe (Family Zipper a)) #node (Tree a)])) -(implementation: .public (equivalence super) +(def: .public (equivalence super) (All (_ a) (-> (Equivalence a) (Equivalence (Zipper a)))) - - (def: (= reference sample) - (let [== (all product.equivalence - (maybe.equivalence - (all product.equivalence - = - (list.equivalence (//.equivalence super)) - (list.equivalence (//.equivalence super)))) - (//.equivalence super))] - (== reference sample)))) + (implementation + (def: (= reference sample) + (let [== (all product.equivalence + (maybe.equivalence + (all product.equivalence + = + (list.equivalence (//.equivalence super)) + (list.equivalence (//.equivalence super)))) + (//.equivalence super))] + (== reference sample))))) (def: .public (zipper tree) (All (_ a) (-> (Tree a) (Zipper a))) @@ -289,36 +289,36 @@ [insert_right #rights] ) -(implementation: .public functor +(def: .public functor (Functor Zipper) - - (def: (each f (open "_[0]")) - [#family (maybe#each (function (_ (open "_[0]")) - [#parent (each f _#parent) - #lefts (list#each (//#each f) _#lefts) - #rights (list#each (//#each f) _#rights)]) - _#family) - #node (//#each f _#node)])) - -(implementation: .public comonad + (implementation + (def: (each f (open "_[0]")) + [#family (maybe#each (function (_ (open "_[0]")) + [#parent (each f _#parent) + #lefts (list#each (//#each f) _#lefts) + #rights (list#each (//#each f) _#rights)]) + _#family) + #node (//#each f _#node)]))) + +(def: .public comonad (CoMonad Zipper) - - (def: functor - ..functor) - - (def: out - (the [#node //.#value])) - - (def: (disjoint (open "_[0]")) - (let [tree_splitter (is (All (_ a) (-> (Tree a) (Tree (Zipper a)))) - (function (tree_splitter tree) - [//.#value (..zipper tree) - //.#children (|> tree - (the //.#children) - (list#each tree_splitter))]))] - [#family (maybe#each (function (_ (open "_[0]")) - [..#parent (disjoint _#parent) - ..#lefts (list#each tree_splitter _#lefts) - ..#rights (list#each tree_splitter _#rights)]) - _#family) - #node (tree_splitter _#node)]))) + (implementation + (def: functor + ..functor) + + (def: out + (the [#node //.#value])) + + (def: (disjoint (open "_[0]")) + (let [tree_splitter (is (All (_ a) (-> (Tree a) (Tree (Zipper a)))) + (function (tree_splitter tree) + [//.#value (..zipper tree) + //.#children (|> tree + (the //.#children) + (list#each tree_splitter))]))] + [#family (maybe#each (function (_ (open "_[0]")) + [..#parent (disjoint _#parent) + ..#lefts (list#each tree_splitter _#lefts) + ..#rights (list#each tree_splitter _#rights)]) + _#family) + #node (tree_splitter _#node)])))) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index 40424f426..c6d5126f0 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -64,27 +64,27 @@ (-> Color RGB) (|>> representation)) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Color) - - (def: (= reference sample) - (let [[rR gR bR] (representation reference) - [rS gS bS] (representation sample)] - (and (n.= rR rS) - (n.= gR gS) - (n.= bR bS))))) - - (implementation: .public hash + (implementation + (def: (= reference sample) + (let [[rR gR bR] (representation reference) + [rS gS bS] (representation sample)] + (and (n.= rR rS) + (n.= gR gS) + (n.= bR bS)))))) + + (def: .public hash (Hash Color) + (implementation + (def: equivalence ..equivalence) - (def: equivalence ..equivalence) - - (def: (hash value) - (let [[r g b] (representation value)] - (all i64.or - (i64.left_shifted 16 r) - (i64.left_shifted 8 g) - b)))) + (def: (hash value) + (let [[r g b] (representation value)] + (all i64.or + (i64.left_shifted 16 r) + (i64.left_shifted 8 g) + b))))) (def: .public black Color @@ -98,17 +98,17 @@ #green ..top #blue ..top])) - (implementation: .public addition + (def: .public addition (Monoid Color) + (implementation + (def: identity ..black) - (def: identity ..black) - - (def: (composite left right) - (let [[lR lG lB] (representation left) - [rR rG rB] (representation right)] - (abstraction [#red (n.max lR rR) - #green (n.max lG rG) - #blue (n.max lB rB)])))) + (def: (composite left right) + (let [[lR lG lB] (representation left) + [rR rG rB] (representation right)] + (abstraction [#red (n.max lR rR) + #green (n.max lG rG) + #blue (n.max lB rB)]))))) (def: (opposite_intensity value) (-> Nat Nat) @@ -121,17 +121,17 @@ #green (opposite_intensity green) #blue (opposite_intensity blue)]))) - (implementation: .public subtraction + (def: .public subtraction (Monoid Color) - - (def: identity ..white) - - (def: (composite left right) - (let [[lR lG lB] (representation (..complement left)) - [rR rG rB] (representation right)] - (abstraction [#red (n.min lR rR) - #green (n.min lG rG) - #blue (n.min lB rB)])))) + (implementation + (def: identity ..white) + + (def: (composite left right) + (let [[lR lG lB] (representation (..complement left)) + [rR rG rB] (representation right)] + (abstraction [#red (n.min lR rR) + #green (n.min lG rG) + #blue (n.min lB rB)]))))) ) (def: .public (hsl color) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index 290996b4e..b64b061f3 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -61,15 +61,15 @@ (-> Specification Binary) (|> size /.empty [0] mutation product.right)) -(implementation: .public monoid +(def: .public monoid (Monoid Specification) - - (def: identity - ..no_op) - - (def: (composite [sizeL mutL] [sizeR mutR]) - [(n#+ sizeL sizeR) - (|>> mutL mutR)])) + (implementation + (def: identity + ..no_op) + + (def: (composite [sizeL mutL] [sizeR mutR]) + [(n#+ sizeL sizeR) + (|>> mutL mutR)]))) (type: .public (Writer a) (-> a Specification)) diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 3a0e69a6c..19c3a9bba 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -178,45 +178,45 @@ [object_field #Object Object] ) -(implementation: .public equivalence +(def: .public equivalence (Equivalence JSON) - - (def: (= x y) - (case [x y] - [{#Null} {#Null}] - #1 - - (^.with_template [<tag> <struct>] - [[{<tag> x'} {<tag> y'}] - (at <struct> = x' y')]) - ([#Boolean bit.equivalence] - [#Number f.equivalence] - [#String text.equivalence]) - - [{#Array xs} {#Array ys}] - (and (n.= (sequence.size xs) (sequence.size ys)) - (list#mix (function (_ idx prev) - (and prev - (maybe.else #0 - (do maybe.monad - [x' (sequence.item idx xs) - y' (sequence.item idx ys)] - (in (= x' y')))))) - #1 - (list.indices (sequence.size xs)))) - - [{#Object xs} {#Object ys}] - (and (n.= (dictionary.size xs) (dictionary.size ys)) - (list#mix (function (_ [xk xv] prev) - (and prev - (case (dictionary.value xk ys) - {.#None} #0 - {.#Some yv} (= xv yv)))) - #1 - (dictionary.entries xs))) - - _ - #0))) + (implementation + (def: (= x y) + (case [x y] + [{#Null} {#Null}] + #1 + + (^.with_template [<tag> <struct>] + [[{<tag> x'} {<tag> y'}] + (at <struct> = x' y')]) + ([#Boolean bit.equivalence] + [#Number f.equivalence] + [#String text.equivalence]) + + [{#Array xs} {#Array ys}] + (and (n.= (sequence.size xs) (sequence.size ys)) + (list#mix (function (_ idx prev) + (and prev + (maybe.else #0 + (do maybe.monad + [x' (sequence.item idx xs) + y' (sequence.item idx ys)] + (in (= x' y')))))) + #1 + (list.indices (sequence.size xs)))) + + [{#Object xs} {#Object ys}] + (and (n.= (dictionary.size xs) (dictionary.size ys)) + (list#mix (function (_ [xk xv] prev) + (and prev + (case (dictionary.value xk ys) + {.#None} #0 + {.#Some yv} (= xv yv)))) + #1 + (dictionary.entries xs))) + + _ + #0)))) ............................................................ ............................................................ @@ -432,8 +432,8 @@ (array_parser json_parser) (object_parser json_parser))))) -(implementation: .public codec +(def: .public codec (Codec Text JSON) - - (def: encoded ..format) - (def: decoded (<text>.result json_parser))) + (implementation + (def: encoded ..format) + (def: decoded (<text>.result json_parser)))) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index dfab48227..ff08ad834 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -232,68 +232,68 @@ " encoding=" (quote "UTF-8") "?>"))) -(implementation: .public codec +(def: .public codec (Codec Text XML) - - (def: encoded - (let [attributes (is (-> Attrs Text) - (function (_ attrs) - (|> attrs - dictionary.entries - (list#each (function (_ [key value]) - (all text#composite (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) - (text.interposed " "))))] - (function (_ input) - (all text#composite - ..xml_header text.new_line - (loop (again [prefix "" - input input]) - (case input - {#Text value} - (sanitize_value value) - - (pattern {#Node xml_tag xml_attrs (list {#Text value})}) - (let [tag (..tag xml_tag) - attrs (if (dictionary.empty? xml_attrs) - "" - (all text#composite " " (attributes xml_attrs)))] - (all text#composite - prefix "<" tag attrs ">" - (sanitize_value value) - "</" tag ">")) - - {#Node xml_tag xml_attrs xml_children} - (let [tag (..tag xml_tag) - attrs (if (dictionary.empty? xml_attrs) - "" - (all text#composite " " (attributes xml_attrs)))] - (if (list.empty? xml_children) - (all text#composite prefix "<" tag attrs "/>") - (all text#composite prefix "<" tag attrs ">" - (|> xml_children - (list#each (|>> (again (text#composite prefix text.tab)) (text#composite text.new_line))) - text.together) - text.new_line prefix "</" tag ">"))))) - )))) - (def: decoded - (<text>.result ..xml^))) - -(implementation: .public equivalence + (implementation + (def: encoded + (let [attributes (is (-> Attrs Text) + (function (_ attrs) + (|> attrs + dictionary.entries + (list#each (function (_ [key value]) + (all text#composite (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) + (text.interposed " "))))] + (function (_ input) + (all text#composite + ..xml_header text.new_line + (loop (again [prefix "" + input input]) + (case input + {#Text value} + (sanitize_value value) + + (pattern {#Node xml_tag xml_attrs (list {#Text value})}) + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) + "" + (all text#composite " " (attributes xml_attrs)))] + (all text#composite + prefix "<" tag attrs ">" + (sanitize_value value) + "</" tag ">")) + + {#Node xml_tag xml_attrs xml_children} + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) + "" + (all text#composite " " (attributes xml_attrs)))] + (if (list.empty? xml_children) + (all text#composite prefix "<" tag attrs "/>") + (all text#composite prefix "<" tag attrs ">" + (|> xml_children + (list#each (|>> (again (text#composite prefix text.tab)) (text#composite text.new_line))) + text.together) + text.new_line prefix "</" tag ">"))))) + )))) + (def: decoded + (<text>.result ..xml^)))) + +(def: .public equivalence (Equivalence XML) - - (def: (= reference sample) - (case [reference sample] - [{#Text reference/value} {#Text sample/value}] - (text#= reference/value sample/value) - - [{#Node reference/tag reference/attrs reference/children} - {#Node sample/tag sample/attrs sample/children}] - (and (symbol#= reference/tag sample/tag) - (at (dictionary.equivalence text.equivalence) = reference/attrs sample/attrs) - (n.= (list.size reference/children) - (list.size sample/children)) - (|> (list.zipped_2 reference/children sample/children) - (list.every? (product.uncurried =)))) - - _ - false))) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Text reference/value} {#Text sample/value}] + (text#= reference/value sample/value) + + [{#Node reference/tag reference/attrs reference/children} + {#Node sample/tag sample/attrs sample/children}] + (and (symbol#= reference/tag sample/tag) + (at (dictionary.equivalence text.equivalence) = reference/attrs sample/attrs) + (n.= (list.size reference/children) + (list.size sample/children)) + (|> (list.zipped_2 reference/children sample/children) + (list.every? (product.uncurried =)))) + + _ + false)))) diff --git a/stdlib/source/library/lux/data/identity.lux b/stdlib/source/library/lux/data/identity.lux index 03e907c20..55e942681 100644 --- a/stdlib/source/library/lux/data/identity.lux +++ b/stdlib/source/library/lux/data/identity.lux @@ -12,28 +12,28 @@ (type: .public (Identity a) a) -(implementation: .public functor +(def: .public functor (Functor Identity) + (implementation + (def: each function.identity))) - (def: each function.identity)) - -(implementation: .public apply +(def: .public apply (Apply Identity) + (implementation + (def: functor ..functor) + (def: (on fa ff) + (ff fa)))) - (def: functor ..functor) - (def: (on fa ff) - (ff fa))) - -(implementation: .public monad +(def: .public monad (Monad Identity) - - (def: functor ..functor) - (def: in function.identity) - (def: conjoint function.identity)) + (implementation + (def: functor ..functor) + (def: in function.identity) + (def: conjoint function.identity))) -(implementation: .public comonad +(def: .public comonad (CoMonad Identity) - - (def: functor ..functor) - (def: out function.identity) - (def: disjoint function.identity)) + (implementation + (def: functor ..functor) + (def: out function.identity) + (def: disjoint function.identity))) diff --git a/stdlib/source/library/lux/data/product.lux b/stdlib/source/library/lux/data/product.lux index c57ec6cfc..02caab668 100644 --- a/stdlib/source/library/lux/data/product.lux +++ b/stdlib/source/library/lux/data/product.lux @@ -49,12 +49,12 @@ (function (_ x) [(f x) (g x)])) -(implementation: .public (equivalence left right) +(def: .public (equivalence left right) (All (_ l r) (-> (Equivalence l) (Equivalence r) (Equivalence [l r]))) - - (def: (= [rl rr] [sl sr]) - (and (at left = rl sl) - (at right = rr sr)))) + (implementation + (def: (= [rl rr] [sl sr]) + (and (at left = rl sl) + (at right = rr sr))))) (def: .public (hash left right) (All (_ l r) (-> (Hash l) (Hash r) (Hash [l r]))) diff --git a/stdlib/source/library/lux/data/store.lux b/stdlib/source/library/lux/data/store.lux index 035128d02..c5b82a4c5 100644 --- a/stdlib/source/library/lux/data/store.lux +++ b/stdlib/source/library/lux/data/store.lux @@ -17,25 +17,25 @@ [#cursor (the #cursor wa) #peek (function (_ s) (f (has #cursor s wa)))]) -(implementation: .public functor +(def: .public functor (All (_ s) (Functor (Store s))) - - (def: (each f fa) - (extend (function (_ store) - (f (at store peek (at store cursor)))) - fa))) + (implementation + (def: (each f fa) + (extend (function (_ store) + (f (at store peek (at store cursor)))) + fa)))) -(implementation: .public comonad +(def: .public comonad (All (_ s) (CoMonad (Store s))) - - (def: functor - ..functor) + (implementation + (def: functor + ..functor) - (def: (out wa) - (a/an peek (a/an cursor))) + (def: (out wa) + (a/an peek (a/an cursor))) - (def: disjoint - (extend id))) + (def: disjoint + (extend id)))) (def: .public (peeks trans store) (All (_ s a) (-> (-> s s) (Store s a) a)) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 91c9cedf6..918fde82a 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -258,60 +258,60 @@ ... Inefficient default <default>))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Text) - - (def: (= reference sample) - ("lux text =" reference sample))) + (implementation + (def: (= reference sample) + ("lux text =" reference sample)))) -(implementation: .public order +(def: .public order (Order Text) - - (def: equivalence ..equivalence) + (implementation + (def: equivalence ..equivalence) - (def: (< reference sample) - ("lux text <" reference sample))) + (def: (< reference sample) + ("lux text <" reference sample)))) -(implementation: .public monoid +(def: .public monoid (Monoid Text) - - (def: identity "") - - (def: (composite left right) - ("lux text concat" left right))) + (implementation + (def: identity "") + + (def: (composite left right) + ("lux text concat" left right)))) -(implementation: .public hash +(def: .public hash (Hash Text) - - (def: equivalence ..equivalence) - - (def: (hash input) - (for @.old - (|> input - (is (Primitive "java.lang.Object")) - "jvm invokevirtual:java.lang.Object:hashCode:" - "jvm convert int-to-long" - (as Nat)) - - @.jvm - (|> input - (as (Primitive "java.lang.Object")) - ("jvm member invoke virtual" [] "java.lang.Object" "hashCode" []) - "jvm conversion int-to-long" - "jvm object cast" - (is (Primitive "java.lang.Long")) - (as Nat)) - ... Platform-independent default. - (let [length ("lux text size" input)] - (loop (again [index 0 - hash 0]) - (if (n.< length index) - (again (++ index) - (|> hash - (i64.left_shifted 5) - (n.- hash) - (n.+ ("lux text char" index input)))) - hash)))))) + (implementation + (def: equivalence ..equivalence) + + (def: (hash input) + (for @.old + (|> input + (is (Primitive "java.lang.Object")) + "jvm invokevirtual:java.lang.Object:hashCode:" + "jvm convert int-to-long" + (as Nat)) + + @.jvm + (|> input + (as (Primitive "java.lang.Object")) + ("jvm member invoke virtual" [] "java.lang.Object" "hashCode" []) + "jvm conversion int-to-long" + "jvm object cast" + (is (Primitive "java.lang.Long")) + (as Nat)) + ... Platform-independent default. + (let [length ("lux text size" input)] + (loop (again [index 0 + hash 0]) + (if (n.< length index) + (again (++ index) + (|> hash + (i64.left_shifted 5) + (n.- hash) + (n.+ ("lux text char" index input)))) + hash))))))) (def: .public together (-> (List Text) Text) diff --git a/stdlib/source/library/lux/data/text/encoding/utf8.lux b/stdlib/source/library/lux/data/text/encoding/utf8.lux index 91b2cdb36..a95d4f163 100644 --- a/stdlib/source/library/lux/data/text/encoding/utf8.lux +++ b/stdlib/source/library/lux/data/text/encoding/utf8.lux @@ -155,8 +155,8 @@ ..utf8->string {try.#Success})))) -(implementation: .public codec +(def: .public codec (Codec Binary Text) - - (def: encoded ..encoded) - (def: decoded ..decoded)) + (implementation + (def: encoded ..encoded) + (def: decoded ..decoded))) diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index ce3642c9e..606cace14 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -42,11 +42,11 @@ (type: .public (Format a) (-> a Text)) -(implementation: .public functor +(def: .public functor (contravariant.Functor Format) - - (def: (each f fb) - (|>> f fb))) + (implementation + (def: (each f fb) + (|>> f fb)))) (def: .public format (syntax (_ [fragments (<>.many <code>.any)]) diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux index 92398a955..a95c2ad0a 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -17,22 +17,22 @@ (primitive: .public Block (Interval Char) - (implementation: .public monoid + (def: .public monoid (Monoid Block) - - (def: identity - (abstraction - (interval.between n.enum n#top n#bottom))) - - (def: (composite left right) - (let [left (representation left) - right (representation right)] - (abstraction - (interval.between n.enum - (n.min (at left bottom) - (at right bottom)) - (n.max (at left top) - (at right top))))))) + (implementation + (def: identity + (abstraction + (interval.between n.enum n#top n#bottom))) + + (def: (composite left right) + (let [left (representation left) + right (representation right)] + (abstraction + (interval.between n.enum + (n.min (at left bottom) + (at right bottom)) + (n.max (at left top) + (at right top)))))))) (def: .public (block start additional) (-> Char Nat Block) @@ -58,20 +58,20 @@ (interval.within? (representation block) char)) ) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Block) + (implementation + (def: (= reference subject) + (and (n.= (..start reference) (..start subject)) + (n.= (..end reference) (..end subject)))))) - (def: (= reference subject) - (and (n.= (..start reference) (..start subject)) - (n.= (..end reference) (..end subject))))) - -(implementation: .public hash +(def: .public hash (Hash Block) - - (def: equivalence ..equivalence) - (def: (hash value) - (i64.or (i64.left_shifted 32 (..start value)) - (..end value)))) + (implementation + (def: equivalence ..equivalence) + (def: (hash value) + (i64.or (i64.left_shifted 32 (..start value)) + (..end value))))) (with_template [<start> <end> <name>] [(def: .public <name> diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index f7211bc8a..92a575201 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -225,12 +225,12 @@ (again right))) false))) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Set) - - (def: (= reference subject) - (set#= (set.of_list //block.hash (tree.tags (representation reference))) - (set.of_list //block.hash (tree.tags (representation subject)))))) + (implementation + (def: (= reference subject) + (set#= (set.of_list //block.hash (tree.tags (representation reference))) + (set.of_list //block.hash (tree.tags (representation subject))))))) ) (with_template [<name> <blocks>] diff --git a/stdlib/source/library/lux/data/trace.lux b/stdlib/source/library/lux/data/trace.lux index ada33d1da..cc92f72ac 100644 --- a/stdlib/source/library/lux/data/trace.lux +++ b/stdlib/source/library/lux/data/trace.lux @@ -12,29 +12,29 @@ [#monoid (Monoid t) #trace (-> t a)])) -(implementation: .public functor +(def: .public functor (All (_ t) (Functor (Trace t))) + (implementation + (def: (each f fa) + (revised #trace (composite f) fa)))) - (def: (each f fa) - (revised #trace (composite f) fa))) - -(implementation: .public comonad +(def: .public comonad (All (_ t) (CoMonad (Trace t))) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (out wa) - ((the #trace wa) - (the [#monoid monoid.#identity] wa))) + (def: (out wa) + ((the #trace wa) + (the [#monoid monoid.#identity] wa))) - (def: (disjoint wa) - (let [monoid (the #monoid wa)] - [#monoid monoid - #trace (function (_ t1) - [#monoid monoid - #trace (function (_ t2) - ((the #trace wa) - (at monoid composite t1 t2)))])]))) + (def: (disjoint wa) + (let [monoid (the #monoid wa)] + [#monoid monoid + #trace (function (_ t1) + [#monoid monoid + #trace (function (_ t2) + ((the #trace wa) + (at monoid composite t1 t2)))])])))) (def: .public (result context tracer) (All (_ t a) (-> t (Trace t a) a)) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 90033a988..51ca6a3d3 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -62,8 +62,8 @@ ((~! phase.failure) (~ g!error))) )))))))))] - [<c>.any <c>.end <c>.and <c>.result "lux def analysis" analysis:] - [<a>.any <a>.end <a>.and <a>.result "lux def synthesis" synthesis:] - [<s>.any <s>.end <s>.and <s>.result "lux def generation" generation:] - [<c>.any <c>.end <c>.and <c>.result "lux def directive" directive:] + [<c>.any <c>.end <c>.and <c>.result "lux def analysis" analysis] + [<a>.any <a>.end <a>.and <a>.result "lux def synthesis" synthesis] + [<s>.any <s>.end <s>.and <s>.result "lux def generation" generation] + [<c>.any <c>.end <c>.and <c>.result "lux def directive" directive] ) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index 07f3e8268..1106d6b87 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except) - [extension (.only directive:)] + [extension (.only directive)] ["[0]" meta] ["[0]" static] [abstract @@ -49,8 +49,8 @@ (with_expansions [<extension> (static.random (|>> %.nat (%.format "lua export ") code.text) random.nat)] - (directive: (<extension> self phase archive [name <code>.text - term <code>.any]) + (directive (<extension> self phase archive [name <code>.text + term <code>.any]) (do [! phase.monad] [next directive.analysis [_ term] (<| directive.lifted_analysis diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 8bc85319c..b81ca60be 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except) - [extension (.only directive:)] + [extension (.only directive)] ["[0]" meta] ["[0]" static] [abstract @@ -53,8 +53,8 @@ (with_expansions [<extension> (static.random (|>> %.nat (%.format "lua export ") code.text) random.nat)] - (directive: (<extension> self phase archive [name <code>.text - term <code>.any]) + (directive (<extension> self phase archive [name <code>.text + term <code>.any]) (do [! phase.monad] [next directive.analysis [_ term] (<| directive.lifted_analysis diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 87475b5df..d96ea55d0 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except) - [extension (.only directive:)] + [extension (.only directive)] ["[0]" meta] ["[0]" static] [abstract @@ -49,8 +49,8 @@ (with_expansions [<extension> (static.random (|>> %.nat (%.format "python export ") code.text) random.nat)] - (directive: (<extension> self phase archive [name <code>.text - term <code>.any]) + (directive (<extension> self phase archive [name <code>.text + term <code>.any]) (do [! phase.monad] [next directive.analysis [_ term] (<| directive.lifted_analysis diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 00702d7cf..a35c801c6 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except global) - [extension (.only directive:)] + [extension (.only directive)] ["[0]" meta] ["[0]" static] ["[0]" type] @@ -87,9 +87,9 @@ (with_expansions [<extension> (static.random (|>> %.nat (%.format "ruby export ") code.text) random.nat)] - (directive: (<extension> self phase archive [global? <code>.bit - name <code>.text - term <code>.any]) + (directive (<extension> self phase archive [global? <code>.bit + name <code>.text + term <code>.any]) (do [! phase.monad] [next directive.analysis [type term] (<| directive.lifted_analysis diff --git a/stdlib/source/library/lux/locale/language.lux b/stdlib/source/library/lux/locale/language.lux index 82b4ca4c2..e17fe5ff3 100644 --- a/stdlib/source/library/lux/locale/language.lux +++ b/stdlib/source/library/lux/locale/language.lux @@ -556,19 +556,19 @@ ["zun" "Zuni" zuni []] ["zza" "Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]]]) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Language) - - (def: (= reference sample) - (same? reference sample))) + (implementation + (def: (= reference sample) + (same? reference sample)))) - (implementation: .public hash + (def: .public hash (Hash Language) - - (def: equivalence - ..equivalence) - - (def: hash - (|>> ..code - (at text.hash hash)))) + (implementation + (def: equivalence + ..equivalence) + + (def: hash + (|>> ..code + (at text.hash hash))))) ) diff --git a/stdlib/source/library/lux/locale/territory.lux b/stdlib/source/library/lux/locale/territory.lux index 0d0bca38b..26d65e515 100644 --- a/stdlib/source/library/lux/locale/territory.lux +++ b/stdlib/source/library/lux/locale/territory.lux @@ -295,19 +295,19 @@ ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] ) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Territory) - - (def: (= reference sample) - (same? reference sample))) + (implementation + (def: (= reference sample) + (same? reference sample)))) - (implementation: .public hash + (def: .public hash (Hash Territory) - - (def: equivalence ..equivalence) - - (def: hash - (|>> representation - (the #long) - (at text.hash hash)))) + (implementation + (def: equivalence ..equivalence) + + (def: hash + (|>> representation + (the #long) + (at text.hash hash))))) ) diff --git a/stdlib/source/library/lux/macro/code.lux b/stdlib/source/library/lux/macro/code.lux index 0131567c7..72b09aff4 100644 --- a/stdlib/source/library/lux/macro/code.lux +++ b/stdlib/source/library/lux/macro/code.lux @@ -60,31 +60,31 @@ [local .#Symbol]) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Code) - - (def: (= x y) - (case [x y] - (^.with_template [<tag> <eq>] - [[[_ {<tag> x'}] [_ {<tag> y'}]] - (at <eq> = x' y')]) - ([.#Bit bit.equivalence] - [.#Nat nat.equivalence] - [.#Int int.equivalence] - [.#Rev rev.equivalence] - [.#Frac frac.equivalence] - [.#Text text.equivalence] - [.#Symbol symbol.equivalence]) + (implementation + (def: (= x y) + (case [x y] + (^.with_template [<tag> <eq>] + [[[_ {<tag> x'}] [_ {<tag> y'}]] + (at <eq> = x' y')]) + ([.#Bit bit.equivalence] + [.#Nat nat.equivalence] + [.#Int int.equivalence] + [.#Rev rev.equivalence] + [.#Frac frac.equivalence] + [.#Text text.equivalence] + [.#Symbol symbol.equivalence]) - (^.with_template [<tag>] - [[[_ {<tag> xs'}] [_ {<tag> ys'}]] - (at (list.equivalence =) = xs' ys')]) - ([.#Form] - [.#Variant] - [.#Tuple]) - - _ - false))) + (^.with_template [<tag>] + [[[_ {<tag> xs'}] [_ {<tag> ys'}]] + (at (list.equivalence =) = xs' ys')]) + ([.#Form] + [.#Variant] + [.#Tuple]) + + _ + false)))) (def: .public (format ast) (-> Code Text) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 01274b28c..97a979ec0 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except) - [extension (.only analysis:)] + [extension (.only analysis)] ["@" target] ["[0]" static] [abstract @@ -72,7 +72,7 @@ [(with_expansions [<extension> (static.seed) <extension> (template.text [<@> " " <extension>]) <scenarios> (template.spliced <scenarios>')] - (these (analysis: (<extension> self phase archive [operands (<>.some <code>.any)]) + (these (analysis (<extension> self phase archive [operands (<>.some <code>.any)]) (<| type.with_var (function (_ [$it :it:])) (do [! phase.monad] @@ -142,8 +142,8 @@ [(with_expansions [<extension> (static.seed) <extension> (template.text [<@> " " <extension>]) <scenarios> (template.spliced <scenarios>')] - (these (analysis: (<extension> self phase archive [left <code>.any - right <code>.any]) + (these (analysis (<extension> self phase archive [left <code>.any + right <code>.any]) (<| type.with_var (function (_ [$it :it:])) (do [! phase.monad] @@ -198,8 +198,8 @@ [(with_expansions [<extension> (static.seed) <extension> (template.text [<@> " " <extension>]) <scenarios> (template.spliced <scenarios>')] - (these (analysis: (<extension> self phase archive [left <code>.any - right <code>.any]) + (these (analysis (<extension> self phase archive [left <code>.any + right <code>.any]) (<| type.with_var (function (_ [$it :it:])) (do [! phase.monad] diff --git a/stdlib/source/library/lux/math/logic/continuous.lux b/stdlib/source/library/lux/math/logic/continuous.lux index c72e296d1..195601894 100644 --- a/stdlib/source/library/lux/math/logic/continuous.lux +++ b/stdlib/source/library/lux/math/logic/continuous.lux @@ -16,11 +16,11 @@ (-> Rev Rev Rev) <chooser>) - (implementation: .public <monoid> + (def: .public <monoid> (Monoid Rev) - - (def: identity <identity>) - (def: composite <name>))] + (implementation + (def: identity <identity>) + (def: composite <name>)))] [or /.max disjunction ..false] [and /.min conjunction ..true] diff --git a/stdlib/source/library/lux/math/logic/fuzzy.lux b/stdlib/source/library/lux/math/logic/fuzzy.lux index 79555e858..d21962ea6 100644 --- a/stdlib/source/library/lux/math/logic/fuzzy.lux +++ b/stdlib/source/library/lux/math/logic/fuzzy.lux @@ -19,11 +19,11 @@ (type: .public (Fuzzy a) (-> a Rev)) -(implementation: .public functor +(def: .public functor (contravariant.Functor Fuzzy) - - (def: (each f fb) - (|>> f fb))) + (implementation + (def: (each f fb) + (|>> f fb)))) (with_template [<name> <verdict>] [(def: .public <name> diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index a46f67418..d1e4860cd 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -59,23 +59,23 @@ (<>.codec i.decimal (<text>.and (<text>.one_of "-+") (<text>.many <text>.decimal)))) - (implementation: .public (codec expected) + (def: .public (codec expected) (All (_ %) (-> (Modulus %) (Codec Text (Mod %)))) - - (def: (encoded modular) - (let [[_ value] (representation modular)] - (all text#composite - (i#encoded value) - ..separator - (i#encoded (//.divisor expected))))) - - (def: decoded - (<text>.result - (do <>.monad - [[value _ actual] (all <>.and intL (<text>.this ..separator) intL) - _ (<>.assertion (exception.error ..incorrect_modulus [expected actual]) - (i.= (//.divisor expected) actual))] - (in (..modular expected value)))))) + (implementation + (def: (encoded modular) + (let [[_ value] (representation modular)] + (all text#composite + (i#encoded value) + ..separator + (i#encoded (//.divisor expected))))) + + (def: decoded + (<text>.result + (do <>.monad + [[value _ actual] (all <>.and intL (<text>.this ..separator) intL) + _ (<>.assertion (exception.error ..incorrect_modulus [expected actual]) + (i.= (//.divisor expected) actual))] + (in (..modular expected value))))))) (with_template [<name> <op>] [(def: .public (<name> reference subject) @@ -91,16 +91,16 @@ [>= i.>=] ) - (implementation: .public equivalence + (def: .public equivalence (All (_ %) (Equivalence (Mod %))) + (implementation + (def: = ..=))) - (def: = ..=)) - - (implementation: .public order + (def: .public order (All (_ %) (Order (Mod %))) - - (def: equivalence ..equivalence) - (def: < ..<)) + (implementation + (def: equivalence ..equivalence) + (def: < ..<))) (with_template [<name> <op>] [(def: .public (<name> param subject) @@ -118,13 +118,13 @@ ) (with_template [<composition> <identity> <monoid>] - [(implementation: .public (<monoid> modulus) + [(def: .public (<monoid> modulus) (All (_ %) (-> (Modulus %) (Monoid (Mod %)))) - - (def: identity - (..modular modulus <identity>)) - (def: composite - <composition>))] + (implementation + (def: identity + (..modular modulus <identity>)) + (def: composite + <composition>)))] [..+ +0 addition] [..* +1 multiplication] diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 56e2cefc7..8708b9c7f 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -68,10 +68,10 @@ [- f.-] ) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Complex) - - (def: = ..=)) + (implementation + (def: = ..=))) (with_template [<name> <transform>] [(def: .public <name> diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 149ca8e50..ea62f7c92 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -559,19 +559,19 @@ (..= ..positive_infinity it) (..= ..negative_infinity it)))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Frac) - - (def: (= left right) - (or (..= left right) - (and (..not_a_number? left) - (..not_a_number? right))))) + (implementation + (def: (= left right) + (or (..= left right) + (and (..not_a_number? left) + (..not_a_number? right)))))) -(implementation: .public order +(def: .public order (Order Frac) - - (def: equivalence ..equivalence) - (def: < ..<)) + (implementation + (def: equivalence ..equivalence) + (def: < ..<))) (def: .public smallest Frac @@ -587,11 +587,11 @@ (..* f2^+1023)))) (with_template [<name> <composite> <identity>] - [(implementation: .public <name> + [(def: .public <name> (Monoid Frac) - - (def: identity <identity>) - (def: composite <composite>))] + (implementation + (def: identity <identity>) + (def: composite <composite>)))] [addition ..+ +0.0] [multiplication ..* +1.0] @@ -599,26 +599,26 @@ [maximum ..max (..* -1.0 ..biggest)] ) -(implementation: .public decimal +(def: .public decimal (Codec Text Frac) - - (def: (encoded x) - (case x - -0.0 (let [output ("lux f64 encode" x)] - (if (text.starts_with? "-" output) - output - ("lux text concat" "+" output))) - _ (if (..< +0.0 x) - ("lux f64 encode" x) - ("lux text concat" "+" ("lux f64 encode" x))))) - - (def: (decoded input) - (case ("lux f64 decode" input) - {.#Some value} - {try.#Success value} - - {.#None} - {try.#Failure "Could not decode Frac"}))) + (implementation + (def: (encoded x) + (case x + -0.0 (let [output ("lux f64 encode" x)] + (if (text.starts_with? "-" output) + output + ("lux text concat" "+" output))) + _ (if (..< +0.0 x) + ("lux f64 encode" x) + ("lux text concat" "+" ("lux f64 encode" x))))) + + (def: (decoded input) + (case ("lux f64 decode" input) + {.#Some value} + {try.#Success value} + + {.#None} + {try.#Failure "Could not decode Frac"})))) (def: log/2 (-> Frac Frac) @@ -777,64 +777,64 @@ {try.#Success [representation +0]})) (with_template [<struct> <nat> <int> <error>] - [(implementation: .public <struct> + [(def: .public <struct> (Codec Text Frac) - - (def: (encoded value) - (let [bits (..bits value) - mantissa (..mantissa bits) - exponent (//int.- (.int ..double_bias) (..exponent bits)) - sign (..sign bits)] - (all "lux text concat" - (case (.nat sign) - 1 "-" - 0 "+" - _ (undefined)) - (at <nat> encoded (.nat mantissa)) - ".0E" - (at <int> encoded exponent)))) - - (def: (decoded representation) - (let [negative? (text.starts_with? "-" representation) - positive? (text.starts_with? "+" representation)] - (if (or negative? positive?) - (do [! try.monad] - [[mantissa exponent] (..representation_exponent <nat> representation) - [whole decimal] (case ("lux text index" 0 "." mantissa) - {.#Some split_index} - (do ! - [.let [after_offset (++ split_index) - after_length (//nat.- after_offset ("lux text size" mantissa))] - decimal (|> mantissa - ("lux text clip" after_offset after_length) - (at <nat> decoded))] - (in [("lux text clip" 0 split_index mantissa) - decimal])) - - {.#None} - {try.#Failure ("lux text concat" <error> representation)}) - .let [whole ("lux text clip" 1 (-- ("lux text size" whole)) whole)] - mantissa (at <nat> decoded (case decimal - 0 whole - _ ("lux text concat" whole (at <nat> encoded decimal)))) - .let [sign (if negative? 1 0)]] - (in (..of_bits - (all //i64.or - (//i64.left_shifted ..sign_offset (.i64 sign)) - (//i64.left_shifted ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) - (//i64.zero ..mantissa_size (.i64 mantissa)))))) - {try.#Failure ("lux text concat" <error> representation)}))))] + (implementation + (def: (encoded value) + (let [bits (..bits value) + mantissa (..mantissa bits) + exponent (//int.- (.int ..double_bias) (..exponent bits)) + sign (..sign bits)] + (all "lux text concat" + (case (.nat sign) + 1 "-" + 0 "+" + _ (undefined)) + (at <nat> encoded (.nat mantissa)) + ".0E" + (at <int> encoded exponent)))) + + (def: (decoded representation) + (let [negative? (text.starts_with? "-" representation) + positive? (text.starts_with? "+" representation)] + (if (or negative? positive?) + (do [! try.monad] + [[mantissa exponent] (..representation_exponent <nat> representation) + [whole decimal] (case ("lux text index" 0 "." mantissa) + {.#Some split_index} + (do ! + [.let [after_offset (++ split_index) + after_length (//nat.- after_offset ("lux text size" mantissa))] + decimal (|> mantissa + ("lux text clip" after_offset after_length) + (at <nat> decoded))] + (in [("lux text clip" 0 split_index mantissa) + decimal])) + + {.#None} + {try.#Failure ("lux text concat" <error> representation)}) + .let [whole ("lux text clip" 1 (-- ("lux text size" whole)) whole)] + mantissa (at <nat> decoded (case decimal + 0 whole + _ ("lux text concat" whole (at <nat> encoded decimal)))) + .let [sign (if negative? 1 0)]] + (in (..of_bits + (all //i64.or + (//i64.left_shifted ..sign_offset (.i64 sign)) + (//i64.left_shifted ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) + (//i64.zero ..mantissa_size (.i64 mantissa)))))) + {try.#Failure ("lux text concat" <error> representation)})))))] [binary //nat.binary //int.binary "Invalid binary syntax: "] [octal //nat.octal //int.octal "Invalid octaladecimal syntax: "] [hex //nat.hex //int.hex "Invalid hexadecimal syntax: "] ) -(implementation: .public hash +(def: .public hash (Hash Frac) - - (def: equivalence ..equivalence) - (def: hash ..bits)) + (implementation + (def: equivalence ..equivalence) + (def: hash ..bits))) (def: .public (approximately? margin_of_error standard value) (-> Frac Frac Frac Bit) diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux index 81cea98f4..78a5c798f 100644 --- a/stdlib/source/library/lux/math/number/i64.lux +++ b/stdlib/source/library/lux/math/number/i64.lux @@ -117,25 +117,25 @@ (-> Nat Nat Mask) (..left_rotated offset (..mask size))) -(implementation: .public equivalence +(def: .public equivalence (All (_ a) (Equivalence (I64 a))) + (implementation + (def: (= reference sample) + ("lux i64 =" reference sample)))) - (def: (= reference sample) - ("lux i64 =" reference sample))) - -(implementation: .public hash +(def: .public hash (All (_ a) (Hash (I64 a))) + (implementation + (def: equivalence ..equivalence) - (def: equivalence ..equivalence) - - (def: hash (|>> .nat))) + (def: hash (|>> .nat)))) (with_template [<monoid> <identity> <composite>] - [(implementation: .public <monoid> + [(def: .public <monoid> (All (_ a) (Monoid (I64 a))) - - (def: identity <identity>) - (def: composite <composite>))] + (implementation + (def: identity <identity>) + (def: composite <composite>)))] [disjunction ..false ..or] [conjunction ..true ..and] diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index a59608af6..19d2459f9 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -158,44 +158,44 @@ (-> Int Frac) (|>> "lux i64 f64")) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Int) - - (def: = ..=)) + (implementation + (def: = ..=))) -(implementation: .public order +(def: .public order (Order Int) - - (def: equivalence ..equivalence) - (def: < ..<)) + (implementation + (def: equivalence ..equivalence) + (def: < ..<))) -(implementation: .public enum +(def: .public enum (Enum Int) - - (def: order ..order) - (def: succ ++) - (def: pred --)) + (implementation + (def: order ..order) + (def: succ ++) + (def: pred --))) ... TODO: Find out why the numeric literals fail during JS compilation. -(implementation: .public interval +(def: .public interval (Interval Int) - - (def: enum ..enum) - (def: top - ... +9,223,372,036,854,775,807 - (let [half (//i64.left_shifted 62 +1)] - (+ half - (-- half)))) - (def: bottom - ... -9,223,372,036,854,775,808 - (//i64.left_shifted 63 +1))) + (implementation + (def: enum ..enum) + (def: top + ... +9,223,372,036,854,775,807 + (let [half (//i64.left_shifted 62 +1)] + (+ half + (-- half)))) + (def: bottom + ... -9,223,372,036,854,775,808 + (//i64.left_shifted 63 +1)))) (with_template [<name> <composite> <identity>] - [(implementation: .public <name> + [(def: .public <name> (Monoid Int) - - (def: identity <identity>) - (def: composite <composite>))] + (implementation + (def: identity <identity>) + (def: composite <composite>)))] [addition ..+ +0] [multiplication ..* +1] @@ -207,33 +207,33 @@ (def: +sign "+") (with_template [<struct> <codec> <error>] - [(implementation: .public <struct> + [(def: .public <struct> (Codec Text Int) - - (def: (encoded value) - (if (..< +0 value) - (|> value ++ ..opposite .nat ++ (at <codec> encoded) ("lux text concat" ..-sign)) - (|> value .nat (at <codec> encoded) ("lux text concat" ..+sign)))) - - (def: (decoded repr) - (let [input_size ("lux text size" repr)] - (if (//nat.> 1 input_size) - (case ("lux text clip" 0 1 repr) - (pattern (static ..+sign)) - (|> repr - ("lux text clip" 1 (-- input_size)) - (at <codec> decoded) - (at try.functor each (|>> .int))) - - (pattern (static ..-sign)) - (|> repr - ("lux text clip" 1 (-- input_size)) - (at <codec> decoded) - (at try.functor each (|>> -- .int ..opposite --))) - - _ - {try.#Failure <error>}) - {try.#Failure <error>}))))] + (implementation + (def: (encoded value) + (if (..< +0 value) + (|> value ++ ..opposite .nat ++ (at <codec> encoded) ("lux text concat" ..-sign)) + (|> value .nat (at <codec> encoded) ("lux text concat" ..+sign)))) + + (def: (decoded repr) + (let [input_size ("lux text size" repr)] + (if (//nat.> 1 input_size) + (case ("lux text clip" 0 1 repr) + (pattern (static ..+sign)) + (|> repr + ("lux text clip" 1 (-- input_size)) + (at <codec> decoded) + (at try.functor each (|>> .int))) + + (pattern (static ..-sign)) + (|> repr + ("lux text clip" 1 (-- input_size)) + (at <codec> decoded) + (at try.functor each (|>> -- .int ..opposite --))) + + _ + {try.#Failure <error>}) + {try.#Failure <error>})))))] [binary //nat.binary "Invalid binary syntax for Int: "] [octal //nat.octal "Invalid octal syntax for Int: "] @@ -241,11 +241,11 @@ [hex //nat.hex "Invalid hexadecimal syntax for Int: "] ) -(implementation: .public hash +(def: .public hash (Hash Int) - - (def: equivalence ..equivalence) - (def: hash (|>> .nat))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> .nat)))) (def: .public (right_shifted parameter subject) (-> Nat Int Int) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index 988efc62b..206a6fe46 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -142,37 +142,37 @@ (-> Nat Frac) (|>> .int "lux i64 f64")) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Nat) - - (def: = ..=)) + (implementation + (def: = ..=))) -(implementation: .public order +(def: .public order (Order Nat) - - (def: equivalence ..equivalence) - (def: < ..<)) + (implementation + (def: equivalence ..equivalence) + (def: < ..<))) -(implementation: .public enum +(def: .public enum (Enum Nat) - - (def: order ..order) - (def: succ ++) - (def: pred --)) + (implementation + (def: order ..order) + (def: succ ++) + (def: pred --))) -(implementation: .public interval +(def: .public interval (Interval Nat) - - (def: enum ..enum) - (def: top (-- 0)) - (def: bottom 0)) + (implementation + (def: enum ..enum) + (def: top (-- 0)) + (def: bottom 0))) (with_template [<name> <composite> <identity>] - [(implementation: .public <name> + [(def: .public <name> (Monoid Nat) - - (def: identity <identity>) - (def: composite <composite>))] + (implementation + (def: identity <identity>) + (def: composite <composite>)))] [addition ..+ 0] [multiplication ..* 1] @@ -286,81 +286,81 @@ _ {.#None})) (with_template [<shift> <struct> <to_character> <to_value> <error>] - [(implementation: .public <struct> + [(def: .public <struct> (Codec Text Nat) - - (def: encoded - (let [mask (|> 1 ("lux i64 left-shift" <shift>) --)] - (function (_ value) - (loop (again [input value - output ""]) - (let [output' ("lux text concat" - (<to_character> ("lux i64 and" mask input)) - output)] - (case (is Nat ("lux i64 right-shift" <shift> input)) - 0 - output' - - input' - (again input' output'))))))) - - (def: (decoded repr) - (let [input_size ("lux text size" repr)] + (implementation + (def: encoded + (let [mask (|> 1 ("lux i64 left-shift" <shift>) --)] + (function (_ value) + (loop (again [input value + output ""]) + (let [output' ("lux text concat" + (<to_character> ("lux i64 and" mask input)) + output)] + (case (is Nat ("lux i64 right-shift" <shift> input)) + 0 + output' + + input' + (again input' output'))))))) + + (def: (decoded repr) + (let [input_size ("lux text size" repr)] + (if (..> 0 input_size) + (loop (again [idx 0 + output 0]) + (if (..< input_size idx) + (case (<to_value> ("lux text char" idx repr)) + {.#Some digit_value} + (again (++ idx) + (|> output + ("lux i64 left-shift" <shift>) + ("lux i64 or" digit_value))) + + _ + {try.#Failure ("lux text concat" <error> repr)}) + {try.#Success output})) + {try.#Failure ("lux text concat" <error> repr)})))))] + + [1 binary binary_character binary_value "Invalid binary syntax for Nat: "] + [3 octal octal_character octal_value "Invalid octal syntax for Nat: "] + [4 hex hexadecimal_character hexadecimal_value "Invalid hexadecimal syntax for Nat: "] + ) + +(def: .public decimal + (Codec Text Nat) + (implementation + (def: (encoded value) + (loop (again [input value + output ""]) + (let [digit (decimal_character (..% 10 input)) + output' ("lux text concat" digit output)] + (case (../ 10 input) + 0 + output' + + input' + (again input' output'))))) + + (def: (decoded repr) + (let [input_size ("lux text size" repr)] + (with_expansions [<failure> {try.#Failure ("lux text concat" "Invalid decimal syntax for Nat: " repr)}] (if (..> 0 input_size) (loop (again [idx 0 output 0]) (if (..< input_size idx) - (case (<to_value> ("lux text char" idx repr)) + (case (decimal_value ("lux text char" idx repr)) + {.#None} + <failure> + {.#Some digit_value} (again (++ idx) - (|> output - ("lux i64 left-shift" <shift>) - ("lux i64 or" digit_value))) - - _ - {try.#Failure ("lux text concat" <error> repr)}) + (|> output (..* 10) (..+ digit_value)))) {try.#Success output})) - {try.#Failure ("lux text concat" <error> repr)}))))] - - [1 binary binary_character binary_value "Invalid binary syntax for Nat: "] - [3 octal octal_character octal_value "Invalid octal syntax for Nat: "] - [4 hex hexadecimal_character hexadecimal_value "Invalid hexadecimal syntax for Nat: "] - ) + <failure>)))))) -(implementation: .public decimal - (Codec Text Nat) - - (def: (encoded value) - (loop (again [input value - output ""]) - (let [digit (decimal_character (..% 10 input)) - output' ("lux text concat" digit output)] - (case (../ 10 input) - 0 - output' - - input' - (again input' output'))))) - - (def: (decoded repr) - (let [input_size ("lux text size" repr)] - (with_expansions [<failure> {try.#Failure ("lux text concat" "Invalid decimal syntax for Nat: " repr)}] - (if (..> 0 input_size) - (loop (again [idx 0 - output 0]) - (if (..< input_size idx) - (case (decimal_value ("lux text char" idx repr)) - {.#None} - <failure> - - {.#Some digit_value} - (again (++ idx) - (|> output (..* 10) (..+ digit_value)))) - {try.#Success output})) - <failure>))))) - -(implementation: .public hash +(def: .public hash (Hash Nat) - - (def: equivalence ..equivalence) - (def: hash function.identity)) + (implementation + (def: equivalence ..equivalence) + (def: hash function.identity))) diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index df07ca898..225b8da06 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -52,10 +52,10 @@ (n.= (the #denominator parameter) (the #denominator subject)))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Ratio) - - (def: = ..=)) + (implementation + (def: = ..=))) (def: (equalized parameter subject) (-> Ratio Ratio [Nat Nat]) @@ -83,11 +83,11 @@ (or (> parameter subject) (= parameter subject))) -(implementation: .public order +(def: .public order (Order Ratio) - - (def: equivalence ..equivalence) - (def: < ..<)) + (implementation + (def: equivalence ..equivalence) + (def: < ..<))) (def: .public (+ parameter subject) (-> Ratio Ratio Ratio) @@ -129,32 +129,32 @@ (def: separator ":") -(implementation: .public codec +(def: .public codec (Codec Text Ratio) - - (def: (encoded (open "_[0]")) - (all text#composite - (n#encoded _#numerator) - ..separator (n#encoded _#denominator))) - - (def: (decoded input) - (case (text.split_by ..separator input) - {.#Some [num denom]} - (do try.monad - [numerator (n#decoded num) - denominator (n#decoded denom)] - (in (normal [#numerator numerator - #denominator denominator]))) - - {.#None} - {.#Left (text#composite "Invalid syntax for ratio: " input)}))) + (implementation + (def: (encoded (open "_[0]")) + (all text#composite + (n#encoded _#numerator) + ..separator (n#encoded _#denominator))) + + (def: (decoded input) + (case (text.split_by ..separator input) + {.#Some [num denom]} + (do try.monad + [numerator (n#decoded num) + denominator (n#decoded denom)] + (in (normal [#numerator numerator + #denominator denominator]))) + + {.#None} + {.#Left (text#composite "Invalid syntax for ratio: " input)})))) (with_template [<identity> <composite> <name>] - [(implementation: .public <name> + [(def: .public <name> (Monoid Ratio) - - (def: identity (..ratio <identity>)) - (def: composite <composite>))] + (implementation + (def: identity (..ratio <identity>)) + (def: composite <composite>)))] [0 ..+ addition] [1 ..* multiplication] diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 7afe11894..f7200c908 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -175,43 +175,43 @@ (-> Rev Frac) (|>> ..mantissa ("lux f64 /" ..frac_denominator))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Rev) - - (def: = ..=)) + (implementation + (def: = ..=))) -(implementation: .public hash +(def: .public hash (Hash Rev) - - (def: equivalence ..equivalence) - (def: hash (|>> .nat))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> .nat)))) -(implementation: .public order +(def: .public order (Order Rev) - - (def: equivalence ..equivalence) - (def: < ..<)) + (implementation + (def: equivalence ..equivalence) + (def: < ..<))) -(implementation: .public enum +(def: .public enum (Enum Rev) - - (def: order ..order) - (def: succ ++) - (def: pred --)) + (implementation + (def: order ..order) + (def: succ ++) + (def: pred --))) -(implementation: .public interval +(def: .public interval (Interval Rev) - - (def: enum ..enum) - (def: top (.rev -1)) - (def: bottom (.rev 0))) + (implementation + (def: enum ..enum) + (def: top (.rev -1)) + (def: bottom (.rev 0)))) (with_template [<name> <composite> <identity>] - [(implementation: .public <name> + [(def: .public <name> (Monoid Rev) - - (def: identity (at interval <identity>)) - (def: composite <composite>))] + (implementation + (def: identity (at interval <identity>)) + (def: composite <composite>)))] [addition ..+ bottom] [maximum ..max bottom] @@ -224,42 +224,42 @@ (with_template [<struct> <codec> <char_bit_size> <error>] [(with_expansions [<failure> (these {try.#Failure ("lux text concat" <error> repr)})] - (implementation: .public <struct> + (def: .public <struct> (Codec Text Rev) - - (def: (encoded value) - (let [raw_output (at <codec> encoded (.nat value)) - max_num_chars (//nat.+ (//nat./ <char_bit_size> //i64.width) - (case (//nat.% <char_bit_size> //i64.width) - 0 0 - _ 1)) - raw_size ("lux text size" raw_output) - zero_padding (is Text - (loop (again [zeroes_left (is Nat (//nat.- raw_size max_num_chars)) - output (is Text "")]) - (if (//nat.= 0 zeroes_left) - output - (again (-- zeroes_left) - ("lux text concat" "0" output)))))] - (|> raw_output - ("lux text concat" zero_padding) - ("lux text concat" ".")))) - - (def: (decoded repr) - (let [repr_size ("lux text size" repr)] - (if (//nat.> 1 repr_size) - (case ("lux text char" 0 repr) - (pattern (char ".")) - (case (at <codec> decoded (..decimals repr)) - {try.#Success output} - {try.#Success (.rev output)} - - failure - <failure>) - - else - <failure>) - <failure>)))))] + (implementation + (def: (encoded value) + (let [raw_output (at <codec> encoded (.nat value)) + max_num_chars (//nat.+ (//nat./ <char_bit_size> //i64.width) + (case (//nat.% <char_bit_size> //i64.width) + 0 0 + _ 1)) + raw_size ("lux text size" raw_output) + zero_padding (is Text + (loop (again [zeroes_left (is Nat (//nat.- raw_size max_num_chars)) + output (is Text "")]) + (if (//nat.= 0 zeroes_left) + output + (again (-- zeroes_left) + ("lux text concat" "0" output)))))] + (|> raw_output + ("lux text concat" zero_padding) + ("lux text concat" ".")))) + + (def: (decoded repr) + (let [repr_size ("lux text size" repr)] + (if (//nat.> 1 repr_size) + (case ("lux text char" 0 repr) + (pattern (char ".")) + (case (at <codec> decoded (..decimals repr)) + {try.#Success output} + {try.#Success (.rev output)} + + failure + <failure>) + + else + <failure>) + <failure>))))))] [binary //nat.binary 1 "Invalid binary syntax: "] [octal //nat.octal 3 "Invalid octal syntax: "] @@ -399,55 +399,55 @@ (again (-- idx) (digits#-!' idx (..digit idx param) output))))) -(implementation: .public decimal +(def: .public decimal (Codec Text Rev) - - (def: (encoded input) - (case (.nat input) - 0 - ".0" - - input - (let [last_idx (-- //i64.width)] - (loop (again [idx last_idx - digits (..digits [])]) - (if (//int.< +0 (.int idx)) - ("lux text concat" "." (..format digits)) - (if (//i64.one? idx input) - (let [digits' (digits#+! (power_digits (//nat.- idx last_idx)) - digits)] - (again (-- idx) - digits')) - (again (-- idx) - digits))))))) - - (def: (decoded input) - (let [dotted? (case ("lux text index" 0 "." input) - {.#Some 0} - true - - _ - false) - within_limits? (|> input - "lux text size" - (//nat.<= (++ //i64.width)))] - (if (and dotted? within_limits?) - (case (|> input ..decimals ..text_digits) - {.#Some digits} - (loop (again [digits digits - idx 0 - output 0]) - (if (//nat.< //i64.width idx) - (let [power (power_digits idx)] - (if (digits#< power digits) - ... Skip power - (again digits (++ idx) output) - (again (digits#-! power digits) - (++ idx) - (//i64.one (//nat.- idx (-- //i64.width)) output)))) - {try.#Success (.rev output)})) - - {.#None} - {try.#Failure ("lux text concat" "Wrong syntax for Rev: " input)}) - {try.#Failure ("lux text concat" "Wrong syntax for Rev: " input)})) - )) + (implementation + (def: (encoded input) + (case (.nat input) + 0 + ".0" + + input + (let [last_idx (-- //i64.width)] + (loop (again [idx last_idx + digits (..digits [])]) + (if (//int.< +0 (.int idx)) + ("lux text concat" "." (..format digits)) + (if (//i64.one? idx input) + (let [digits' (digits#+! (power_digits (//nat.- idx last_idx)) + digits)] + (again (-- idx) + digits')) + (again (-- idx) + digits))))))) + + (def: (decoded input) + (let [dotted? (case ("lux text index" 0 "." input) + {.#Some 0} + true + + _ + false) + within_limits? (|> input + "lux text size" + (//nat.<= (++ //i64.width)))] + (if (and dotted? within_limits?) + (case (|> input ..decimals ..text_digits) + {.#Some digits} + (loop (again [digits digits + idx 0 + output 0]) + (if (//nat.< //i64.width idx) + (let [power (power_digits idx)] + (if (digits#< power digits) + ... Skip power + (again digits (++ idx) output) + (again (digits#-! power digits) + (++ idx) + (//i64.one (//nat.- idx (-- //i64.width)) output)))) + {try.#Success (.rev output)})) + + {.#None} + {try.#Failure ("lux text concat" "Wrong syntax for Rev: " input)}) + {try.#Failure ("lux text concat" "Wrong syntax for Rev: " input)})) + ))) diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 2a05eac36..a1a94b0a1 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -44,38 +44,38 @@ (type: .public (Random a) (-> PRNG [PRNG a])) -(implementation: .public functor +(def: .public functor (Functor Random) - - (def: (each f fa) - (function (_ state) - (let [[state' a] (fa state)] - [state' (f a)])))) + (implementation + (def: (each f fa) + (function (_ state) + (let [[state' a] (fa state)] + [state' (f a)]))))) -(implementation: .public apply +(def: .public apply (Apply Random) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (function (_ state) - (let [[state' f] (ff state) - [state'' a] (fa state')] - [state'' (f a)])))) + (def: (on fa ff) + (function (_ state) + (let [[state' f] (ff state) + [state'' a] (fa state')] + [state'' (f a)]))))) -(implementation: .public monad +(def: .public monad (Monad Random) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in a) - (function (_ state) - [state a])) + (def: (in a) + (function (_ state) + [state a])) - (def: (conjoint ffa) - (function (_ state) - (let [[state' fa] (ffa state)] - (fa state'))))) + (def: (conjoint ffa) + (function (_ state) + (let [[state' fa] (ffa state)] + (fa state')))))) (def: .public (only pred gen) (All (_ a) (-> (-> a Bit) (Random a) (Random a))) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index f056570b4..5b38ef955 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -30,54 +30,54 @@ ... (type: (Meta a) ... (-> Lux (Try [Lux a]))) -(implementation: .public functor +(def: .public functor (Functor Meta) - - (def: (each f fa) - (function (_ lux) - (case (fa lux) - {try.#Failure msg} - {try.#Failure msg} + (implementation + (def: (each f fa) + (function (_ lux) + (case (fa lux) + {try.#Failure msg} + {try.#Failure msg} - {try.#Success [lux' a]} - {try.#Success [lux' (f a)]})))) + {try.#Success [lux' a]} + {try.#Success [lux' (f a)]}))))) -(implementation: .public apply +(def: .public apply (Apply Meta) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (on fa ff) - (function (_ lux) - (case (ff lux) - {try.#Success [lux' f]} - (case (fa lux') - {try.#Success [lux'' a]} - {try.#Success [lux'' (f a)]} + (def: (on fa ff) + (function (_ lux) + (case (ff lux) + {try.#Success [lux' f]} + (case (fa lux') + {try.#Success [lux'' a]} + {try.#Success [lux'' (f a)]} - {try.#Failure msg} - {try.#Failure msg}) + {try.#Failure msg} + {try.#Failure msg}) - {try.#Failure msg} - {try.#Failure msg})))) + {try.#Failure msg} + {try.#Failure msg}))))) -(implementation: .public monad +(def: .public monad (Monad Meta) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (in x) - (function (_ lux) - {try.#Success [lux x]})) - - (def: (conjoint mma) - (function (_ lux) - (case (mma lux) - {try.#Failure msg} - {try.#Failure msg} + (def: (in x) + (function (_ lux) + {try.#Success [lux x]})) + + (def: (conjoint mma) + (function (_ lux) + (case (mma lux) + {try.#Failure msg} + {try.#Failure msg} - {try.#Success [lux' ma]} - (ma lux'))))) + {try.#Success [lux' ma]} + (ma lux')))))) (def: .public (result' lux action) (All (_ a) (-> Lux (Meta a) (Try [Lux a]))) diff --git a/stdlib/source/library/lux/meta/location.lux b/stdlib/source/library/lux/meta/location.lux index 99d6ce252..cdad2fa11 100644 --- a/stdlib/source/library/lux/meta/location.lux +++ b/stdlib/source/library/lux/meta/location.lux @@ -4,13 +4,13 @@ [abstract [equivalence (.only Equivalence)]]]]) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Location) - - (def: (= reference subject) - (and ("lux text =" (the .#module reference) (the .#module subject)) - ("lux i64 =" (the .#line reference) (the .#line subject)) - ("lux i64 =" (the .#column reference) (the .#column subject))))) + (implementation + (def: (= reference subject) + (and ("lux text =" (the .#module reference) (the .#module subject)) + ("lux i64 =" (the .#line reference) (the .#line subject)) + ("lux i64 =" (the .#column reference) (the .#column subject)))))) (def: .public dummy Location diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index a539acea7..7966482ce 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -30,33 +30,33 @@ (Equivalence Symbol) (at ..hash equivalence)) -(implementation: .public order +(def: .public order (Order Symbol) - - (def: equivalence ..equivalence) - (def: (< [moduleP shortP] [moduleS shortS]) - (if (text#= moduleP moduleS) - (at text.order < shortP shortS) - (at text.order < moduleP moduleS)))) + (implementation + (def: equivalence ..equivalence) + (def: (< [moduleP shortP] [moduleS shortS]) + (if (text#= moduleP moduleS) + (at text.order < shortP shortS) + (at text.order < moduleP moduleS))))) (def: .public separator ".") -(implementation: .public codec +(def: .public codec (Codec Text Symbol) - - (def: (encoded [module short]) - (case module - "" short - _ (all text#composite module ..separator short))) - - (def: (decoded input) - (case (text.all_split_by ..separator input) - (pattern (list short)) - {.#Right ["" short]} - - (pattern (list module short)) - {.#Right [module short]} - - _ - {.#Left (text#composite "Invalid format for Symbol: " input)}))) + (implementation + (def: (encoded [module short]) + (case module + "" short + _ (all text#composite module ..separator short))) + + (def: (decoded input) + (case (text.all_split_by ..separator input) + (pattern (list short)) + {.#Right ["" short]} + + (pattern (list module short)) + {.#Right [module short]} + + _ + {.#Left (text#composite "Invalid format for Symbol: " input)})))) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 8fabbe9c7..11ddcdd16 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -33,6 +33,7 @@ @.jvm body @.js body @.python body + ... else (` ((~! do) (~! io.monad) [(~ g!output) (~ body) (~ g!_) (~! thread.run!)] diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 7925c5c24..e838ed77d 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -110,11 +110,11 @@ (try|in [(at sequence.monoid composite left_exceptions right_exceptions) (_#composite left_instruction right_instruction)]))))) -(implementation: relative_monoid +(def: relative_monoid (Monoid Relative) - - (def: identity ..relative#identity) - (def: composite ..relative#composite)) + (implementation + (def: identity ..relative#identity) + (def: composite ..relative#composite))) (type: .public (Bytecode a) (+State Try [Pool Environment Tracker] (Writer Relative a))) @@ -205,42 +205,43 @@ environment)) <success>)))))) -(implementation: .public functor +(def: .public functor (Functor Bytecode) - (def: (each $ it) - (function (_ state) - (case (it state) - {try.#Success [state' [relative it]]} - {try.#Success [state' [relative ($ it)]]} - - ... {try.#Failure error} - failure - (as_expected failure))))) - -(implementation: .public monad + (implementation + (def: (each $ it) + (function (_ state) + (case (it state) + {try.#Success [state' [relative it]]} + {try.#Success [state' [relative ($ it)]]} + + ... {try.#Failure error} + failure + (as_expected failure)))))) + +(def: .public monad (Monad Bytecode) - - (def: functor ..functor) - - (def: (in it) - (function (_ state) - {try.#Success [state [relative#identity it]]})) - - (def: (conjoint ^^it) - (function (_ state) - (case (^^it state) - {try.#Success [state' [left ^it]]} - (case (^it state') - {try.#Success [state'' [right it]]} - {try.#Success [state'' [(relative#composite left right) it]]} - - ... {try.#Failure error} - failure - (as_expected failure)) - - ... {try.#Failure error} - failure - (as_expected failure))))) + (implementation + (def: functor ..functor) + + (def: (in it) + (function (_ state) + {try.#Success [state [relative#identity it]]})) + + (def: (conjoint ^^it) + (function (_ state) + (case (^^it state) + {try.#Success [state' [left ^it]]} + (case (^it state') + {try.#Success [state'' [right it]]} + {try.#Success [state'' [(relative#composite left right) it]]} + + ... {try.#Failure error} + failure + (as_expected failure)) + + ... {try.#Failure error} + failure + (as_expected failure)))))) (def: .public (when_continuous it) (-> (Bytecode Any) (Bytecode Any)) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/address.lux b/stdlib/source/library/lux/target/jvm/bytecode/address.lux index eac99cd2c..b7099f324 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/address.lux @@ -56,13 +56,13 @@ (n.> (|> reference representation ///unsigned.value) (|> subject representation ///unsigned.value))) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Address) - - (def: (= reference subject) - (at ///unsigned.equivalence = - (representation reference) - (representation subject)))) + (implementation + (def: (= reference subject) + (at ///unsigned.equivalence = + (representation reference) + (representation subject))))) (def: .public writer (Writer Address) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment.lux index bcef16e3e..cc3ff123c 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment.lux @@ -37,17 +37,17 @@ (type: .public Condition (-> Environment (Try Environment))) -(implementation: .public monoid +(def: .public monoid (Monoid Condition) - - (def: identity - (|>> {try.#Success})) - - (def: (composite left right) - (function (_ environment) - (do try.monad - [environment (left environment)] - (right environment))))) + (implementation + (def: identity + (|>> {try.#Success})) + + (def: (composite left right) + (function (_ environment) + (do try.monad + [environment (left environment)] + (right environment)))))) (exception: .public discontinuity) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index 145fe13e0..01b7e3102 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -695,10 +695,10 @@ size) (|>> mutation lookupswitch_mutation)]))))])) -(implementation: .public monoid +(def: .public monoid (Monoid Instruction) + (implementation + (def: identity ..empty) - (def: identity ..empty) - - (def: (composite left right) - (|>> left right))) + (def: (composite left right) + (|>> left right)))) diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index f8ca85cc0..fa4c61142 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -66,17 +66,17 @@ "[1]::[0]" ("static" floatToRawIntBits "manual" [float] int)) -(implementation: .public float_equivalence +(def: .public float_equivalence (Equivalence java/lang/Float) - - (def: (= parameter subject) - (for @.old - ("jvm feq" parameter subject) - - @.jvm - ("jvm float =" - ("jvm object cast" parameter) - ("jvm object cast" subject))))) + (implementation + (def: (= parameter subject) + (for @.old + ("jvm feq" parameter subject) + + @.jvm + ("jvm float =" + ("jvm object cast" parameter) + ("jvm object cast" subject)))))) (import java/lang/Double "[1]::[0]" diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index b69d7ef21..c73271b59 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -44,37 +44,37 @@ (type: .public (Resource a) (+State Try Pool a)) -(implementation: .public functor +(def: .public functor (Functor Resource) - - (def: (each $ it) - (|>> it - (pipe.case - {try.#Success [state output]} - {try.#Success [state ($ output)]} - - ... {try.#Failure error} - failure - (as_expected failure))))) - -(implementation: .public monad + (implementation + (def: (each $ it) + (|>> it + (pipe.case + {try.#Success [state output]} + {try.#Success [state ($ output)]} + + ... {try.#Failure error} + failure + (as_expected failure)))))) + +(def: .public monad (Monad Resource) - - (def: functor ..functor) - - (def: (in it) - (function (_ state) - {try.#Success [state it]})) - - (def: (conjoint it) - (function (_ state) - (case (it state) - {try.#Success [state' it']} - (it' state') - - ... {try.#Failure error} - failure - (as_expected failure))))) + (implementation + (def: functor ..functor) + + (def: (in it) + (function (_ state) + {try.#Success [state it]})) + + (def: (conjoint it) + (function (_ state) + (case (it state) + {try.#Success [state' it']} + (it' state') + + ... {try.#Failure error} + failure + (as_expected failure)))))) (def: try|each (template (_ <binding> <value> <body>) diff --git a/stdlib/source/library/lux/target/jvm/constant/tag.lux b/stdlib/source/library/lux/target/jvm/constant/tag.lux index cf629c062..aedf6fed2 100644 --- a/stdlib/source/library/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux @@ -17,11 +17,12 @@ (primitive: .public Tag U1 - (implementation: .public equivalence + (def: .public equivalence (Equivalence Tag) - (def: (= reference sample) - (u1//= (representation reference) - (representation sample)))) + (implementation + (def: (= reference sample) + (u1//= (representation reference) + (representation sample))))) (with_template [<code> <name>] [(def: .public <name> diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index 9f94e12c1..7896fd92e 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -29,17 +29,18 @@ (-> (Signed Any) Int) (|>> representation)) - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Signed brand))) - (def: (= reference sample) - (i.= (representation reference) (representation sample)))) + (implementation + (def: (= reference sample) + (i.= (representation reference) (representation sample))))) - (implementation: .public order + (def: .public order (All (_ brand) (Order (Signed brand))) - - (def: equivalence ..equivalence) - (def: (< reference sample) - (i.< (representation reference) (representation sample)))) + (implementation + (def: equivalence ..equivalence) + (def: (< reference sample) + (i.< (representation reference) (representation sample))))) (exception: .public (value_exceeds_the_scope [value Int scope Nat]) diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux index 6126469a4..cbebef0f5 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -28,19 +28,20 @@ (-> (Unsigned Any) Nat) (|>> representation)) - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Unsigned brand))) - (def: (= reference sample) - (n.= (representation reference) - (representation sample)))) + (implementation + (def: (= reference sample) + (n.= (representation reference) + (representation sample))))) - (implementation: .public order + (def: .public order (All (_ brand) (Order (Unsigned brand))) - - (def: equivalence ..equivalence) - (def: (< reference sample) - (n.< (representation reference) - (representation sample)))) + (implementation + (def: equivalence ..equivalence) + (def: (< reference sample) + (n.< (representation reference) + (representation sample))))) (exception: .public (value_exceeds_the_maximum [type Symbol value Nat diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux index 3900196fe..0db6fec0c 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -30,13 +30,13 @@ (-> (Modifier Any) //unsigned.U2) (|>> representation)) - (implementation: .public equivalence + (def: .public equivalence (All (_ of) (Equivalence (Modifier of))) - - (def: (= reference sample) - (at //unsigned.equivalence = - (representation reference) - (representation sample)))) + (implementation + (def: (= reference sample) + (at //unsigned.equivalence = + (representation reference) + (representation sample))))) (def: !wrap (template (_ value) @@ -58,14 +58,14 @@ (i64.and sub) (at i64.equivalence = sub)))) - (implementation: .public monoid + (def: .public monoid (All (_ of) (Monoid (Modifier of))) - - (def: identity - (!wrap (hex "0000"))) - - (def: (composite left right) - (!wrap (i64.or (!unwrap left) (!unwrap right))))) + (implementation + (def: identity + (!wrap (hex "0000"))) + + (def: (composite left right) + (!wrap (i64.or (!unwrap left) (!unwrap right)))))) (def: .public empty Modifier diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux index 268743ce0..88023ba23 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -149,19 +149,19 @@ (..descriptor output)]) (as_expected ..void)])) - (implementation: .public equivalence + (def: .public equivalence (All (_ category) (Equivalence (Type category))) + (implementation + (def: (= parameter subject) + (at /signature.equivalence = + (..signature parameter) + (..signature subject))))) - (def: (= parameter subject) - (at /signature.equivalence = - (..signature parameter) - (..signature subject)))) - - (implementation: .public hash + (def: .public hash (All (_ category) (Hash (Type category))) - - (def: equivalence ..equivalence) - (def: hash (|>> ..signature (at /signature.hash hash)))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> ..signature (at /signature.hash hash))))) (def: .public (primitive? type) (-> (Type Value) (Either (Type Object) diff --git a/stdlib/source/library/lux/target/jvm/type/descriptor.lux b/stdlib/source/library/lux/target/jvm/type/descriptor.lux index d063eecb7..353d2a08d 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -100,11 +100,11 @@ (text.enclosed ["(" ")"])) (representation output)))) - (implementation: .public equivalence + (def: .public equivalence (All (_ category) (Equivalence (Descriptor category))) - - (def: (= parameter subject) - (text#= (representation parameter) (representation subject)))) + (implementation + (def: (= parameter subject) + (text#= (representation parameter) (representation subject))))) (def: .public class_name (-> (Descriptor Object) Internal) diff --git a/stdlib/source/library/lux/target/jvm/type/reflection.lux b/stdlib/source/library/lux/target/jvm/type/reflection.lux index 37f1a7eab..07bfe8b89 100644 --- a/stdlib/source/library/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/type/reflection.lux @@ -22,11 +22,11 @@ (-> (Reflection Any) Text) (|>> representation)) - (implementation: .public equivalence + (def: .public equivalence (All (_ category) (Equivalence (Reflection category))) - - (def: (= parameter subject) - (text#= (representation parameter) (representation subject)))) + (implementation + (def: (= parameter subject) + (text#= (representation parameter) (representation subject))))) (with_template [<category> <name> <reflection>] [(def: .public <name> diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index 1c35b96f7..8e4cea594 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -167,16 +167,16 @@ (list#each (|>> representation (format ..exception_prefix))) text.together)))) - (implementation: .public equivalence + (def: .public equivalence (All (_ category) (Equivalence (Signature category))) - - (def: (= parameter subject) - (text#= (representation parameter) - (representation subject)))) + (implementation + (def: (= parameter subject) + (text#= (representation parameter) + (representation subject))))) - (implementation: .public hash + (def: .public hash (All (_ category) (Hash (Signature category))) - - (def: equivalence ..equivalence) - (def: hash (|>> representation text#hash))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> representation text#hash)))) ) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 2c92e2c18..d8e1a9561 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -43,17 +43,17 @@ (primitive: .public (Code brand) Text - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Code brand))) + (implementation + (def: (= reference subject) + (at text.equivalence = (representation reference) (representation subject))))) - (def: (= reference subject) - (at text.equivalence = (representation reference) (representation subject)))) - - (implementation: .public hash + (def: .public hash (All (_ brand) (Hash (Code brand))) - - (def: equivalence ..equivalence) - (def: hash (|>> representation (at text.hash hash)))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> representation (at text.hash hash))))) (def: .public manual (-> Text Code) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index a100adb9f..dfc2d4fa4 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -51,17 +51,17 @@ (primitive: .public (Code brand) Text - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Code brand))) + (implementation + (def: (= reference subject) + (at text.equivalence = (representation reference) (representation subject))))) - (def: (= reference subject) - (at text.equivalence = (representation reference) (representation subject)))) - - (implementation: .public hash + (def: .public hash (All (_ brand) (Hash (Code brand))) - - (def: equivalence ..equivalence) - (def: hash (|>> representation (at text.hash hash)))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> representation (at text.hash hash))))) (def: .public manual (-> Text Code) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 1d9f93737..e8f6e5259 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -60,17 +60,17 @@ (primitive: .public (Code brand) Text - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Code brand))) + (implementation + (def: (= reference subject) + (at text.equivalence = (representation reference) (representation subject))))) - (def: (= reference subject) - (at text.equivalence = (representation reference) (representation subject)))) - - (implementation: .public hash + (def: .public hash (All (_ brand) (Hash (Code brand))) - - (def: equivalence ..equivalence) - (def: hash (|>> representation (at text.hash hash)))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> representation (at text.hash hash))))) (def: .public manual (-> Text Code) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 238bc052f..5b7ef0447 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -43,11 +43,11 @@ (primitive: .public (Code brand) Text - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (at text.equivalence = (representation reference) (representation subject)))) + (implementation + (def: (= reference subject) + (at text.equivalence = (representation reference) (representation subject))))) (def: .public manual (-> Text Code) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index 52e8862fc..ca4a7f13b 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -34,17 +34,17 @@ (primitive: .public (Code k) Text - (implementation: .public equivalence + (def: .public equivalence (All (_ brand) (Equivalence (Code brand))) + (implementation + (def: (= reference subject) + (at text.equivalence = (representation reference) (representation subject))))) - (def: (= reference subject) - (at text.equivalence = (representation reference) (representation subject)))) - - (implementation: .public hash + (def: .public hash (All (_ brand) (Hash (Code brand))) - - (def: equivalence ..equivalence) - (def: hash (|>> representation (at text.hash hash)))) + (implementation + (def: equivalence ..equivalence) + (def: hash (|>> representation (at text.hash hash))))) (with_template [<type> <brand> <super>+] [(primitive: .public (<brand> brand) Any) diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 07f3dcb94..2416d3867 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -93,35 +93,35 @@ (-> Time Nat) (|>> representation)) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Time) + (implementation + (def: (= param subject) + (n.= (representation param) (representation subject))))) - (def: (= param subject) - (n.= (representation param) (representation subject)))) - - (implementation: .public order + (def: .public order (Order Time) + (implementation + (def: equivalence ..equivalence) - (def: equivalence ..equivalence) - - (def: (< param subject) - (n.< (representation param) (representation subject)))) + (def: (< param subject) + (n.< (representation param) (representation subject))))) - (`` (implementation: .public enum + (`` (def: .public enum (Enum Time) + (implementation + (def: order ..order) - (def: order ..order) + (def: succ + (|>> representation ++ (n.% ..limit) abstraction)) - (def: succ - (|>> representation ++ (n.% ..limit) abstraction)) - - (def: pred - (|>> representation - (pipe.case - 0 ..limit - millis millis) - -- - abstraction)))) + (def: pred + (|>> representation + (pipe.case + 0 ..limit + millis millis) + -- + abstraction))))) (def: .public parser (Parser Time) @@ -207,8 +207,8 @@ ..separator (..padded _#second) (..millis_format _#milli_second)))) -(implementation: .public codec +(def: .public codec (Codec Text Time) - - (def: encoded ..format) - (def: decoded (<text>.result ..parser))) + (implementation + (def: encoded ..format) + (def: decoded (<text>.result ..parser)))) diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index 3419b07ea..96f855fee 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -102,43 +102,43 @@ [day_of_month Nat #day] ) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Date) - - (def: (= reference sample) - (let [reference (representation reference) - sample (representation sample)] - (and (at //year.equivalence = + (implementation + (def: (= reference sample) + (let [reference (representation reference) + sample (representation sample)] + (and (at //year.equivalence = + (the #year reference) + (the #year sample)) + (at //month.equivalence = + (the #month reference) + (the #month sample)) + (n.= (the #day reference) + (the #day sample))))))) + + (def: .public order + (Order Date) + (implementation + (def: equivalence ..equivalence) + + (def: (< reference sample) + (let [reference (representation reference) + sample (representation sample)] + (or (at //year.order < (the #year reference) (the #year sample)) - (at //month.equivalence = - (the #month reference) - (the #month sample)) - (n.= (the #day reference) - (the #day sample)))))) - - (implementation: .public order - (Order Date) - - (def: equivalence ..equivalence) - - (def: (< reference sample) - (let [reference (representation reference) - sample (representation sample)] - (or (at //year.order < - (the #year reference) - (the #year sample)) - (and (at //year.equivalence = - (the #year reference) - (the #year sample)) - (or (at //month.order < - (the #month reference) - (the #month sample)) - (and (at //month.order = - (the #month reference) - (the #month sample)) - (n.< (the #day reference) - (the #day sample))))))))) + (and (at //year.equivalence = + (the #year reference) + (the #year sample)) + (or (at //month.order < + (the #month reference) + (the #month sample)) + (and (at //month.order = + (the #month reference) + (the #month sample)) + (n.< (the #day reference) + (the #day sample)))))))))) ) (def: section_parser @@ -189,11 +189,11 @@ ..separator (..padded (|> value ..month //month.number)) ..separator (..padded (..day_of_month value)))) -(implementation: .public codec +(def: .public codec (Codec Text Date) - - (def: encoded ..format) - (def: decoded (<text>.result ..parser))) + (implementation + (def: encoded ..format) + (def: decoded (<text>.result ..parser)))) (def: days_per_leap (|> //year.days @@ -340,13 +340,13 @@ (maybe.trusted (dictionary.value month ..month_by_number)) day)))) -(implementation: .public enum +(def: .public enum (Enum Date) + (implementation + (def: order ..order) - (def: order ..order) - - (def: succ - (|>> ..days ++ ..of_days)) + (def: succ + (|>> ..days ++ ..of_days)) - (def: pred - (|>> ..days -- ..of_days))) + (def: pred + (|>> ..days -- ..of_days)))) diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux index 0d8b6a369..20b526090 100644 --- a/stdlib/source/library/lux/time/day.lux +++ b/stdlib/source/library/lux/time/day.lux @@ -29,24 +29,24 @@ {#Friday} {#Saturday})) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Day) - - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag>] - [[{<tag>} {<tag>}] - #1]) - ([#Sunday] - [#Monday] - [#Tuesday] - [#Wednesday] - [#Thursday] - [#Friday] - [#Saturday]) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag>] + [[{<tag>} {<tag>}] + #1]) + ([#Sunday] + [#Monday] + [#Tuesday] + [#Wednesday] + [#Thursday] + [#Friday] + [#Saturday]) - _ - #0))) + _ + #0)))) (def: (nat day) (-> Day Nat) @@ -59,71 +59,71 @@ {#Friday} 5 {#Saturday} 6)) -(implementation: .public order +(def: .public order (Order Day) - - (def: equivalence ..equivalence) - - (def: (< reference sample) - (n.< (..nat reference) (..nat sample)))) + (implementation + (def: equivalence ..equivalence) + + (def: (< reference sample) + (n.< (..nat reference) (..nat sample))))) -(implementation: .public enum +(def: .public enum (Enum Day) - - (def: order ..order) - - (def: (succ day) - (case day - {#Sunday} {#Monday} - {#Monday} {#Tuesday} - {#Tuesday} {#Wednesday} - {#Wednesday} {#Thursday} - {#Thursday} {#Friday} - {#Friday} {#Saturday} - {#Saturday} {#Sunday})) - - (def: (pred day) - (case day - {#Monday} {#Sunday} - {#Tuesday} {#Monday} - {#Wednesday} {#Tuesday} - {#Thursday} {#Wednesday} - {#Friday} {#Thursday} - {#Saturday} {#Friday} - {#Sunday} {#Saturday}))) + (implementation + (def: order ..order) + + (def: (succ day) + (case day + {#Sunday} {#Monday} + {#Monday} {#Tuesday} + {#Tuesday} {#Wednesday} + {#Wednesday} {#Thursday} + {#Thursday} {#Friday} + {#Friday} {#Saturday} + {#Saturday} {#Sunday})) + + (def: (pred day) + (case day + {#Monday} {#Sunday} + {#Tuesday} {#Monday} + {#Wednesday} {#Tuesday} + {#Thursday} {#Wednesday} + {#Friday} {#Thursday} + {#Saturday} {#Friday} + {#Sunday} {#Saturday})))) (exception: .public (not_a_day_of_the_week [value Text]) (exception.report "Value" (text.format value))) -(implementation: .public codec +(def: .public codec (Codec Text Day) - - (def: (encoded value) - (case value - (^.with_template [<tag>] - [{<tag>} - (text.replaced "#" "" (template.text [<tag>]))]) - ([..#Monday] - [..#Tuesday] - [..#Wednesday] - [..#Thursday] - [..#Friday] - [..#Saturday] - [..#Sunday]))) - (def: (decoded value) - (case (text#composite "#" value) - (^.with_template [<tag>] - [(pattern (template.text [<tag>])) - {try.#Success {<tag>}}]) - ([..#Monday] - [..#Tuesday] - [..#Wednesday] - [..#Thursday] - [..#Friday] - [..#Saturday] - [..#Sunday]) - _ (exception.except ..not_a_day_of_the_week [value])))) + (implementation + (def: (encoded value) + (case value + (^.with_template [<tag>] + [{<tag>} + (text.replaced "#" "" (template.text [<tag>]))]) + ([..#Monday] + [..#Tuesday] + [..#Wednesday] + [..#Thursday] + [..#Friday] + [..#Saturday] + [..#Sunday]))) + (def: (decoded value) + (case (text#composite "#" value) + (^.with_template [<tag>] + [(pattern (template.text [<tag>])) + {try.#Success {<tag>}}]) + ([..#Monday] + [..#Tuesday] + [..#Wednesday] + [..#Thursday] + [..#Friday] + [..#Saturday] + [..#Sunday]) + _ (exception.except ..not_a_day_of_the_week [value]))))) (def: .public week (List Day) @@ -170,19 +170,19 @@ (exception.except ..invalid_day [number]))) ) -(implementation: .public hash +(def: .public hash (Hash Day) - - (def: equivalence ..equivalence) - (def: (hash day) - (case day - (^.with_template [<prime> <day>] - [{<day>} - <prime>]) - ([02 #Sunday] - [03 #Monday] - [05 #Tuesday] - [07 #Wednesday] - [11 #Thursday] - [13 #Friday] - [17 #Saturday])))) + (implementation + (def: equivalence ..equivalence) + (def: (hash day) + (case day + (^.with_template [<prime> <day>] + [{<day>} + <prime>]) + ([02 #Sunday] + [03 #Monday] + [05 #Tuesday] + [07 #Wednesday] + [11 #Thursday] + [13 #Friday] + [17 #Saturday]))))) diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index e59e4c9f2..e608a8075 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -60,18 +60,18 @@ (-> Duration Duration Int) (i./ (representation param) (representation subject))) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Duration) - - (def: (= param subject) - (i.= (representation param) (representation subject)))) + (implementation + (def: (= param subject) + (i.= (representation param) (representation subject))))) - (implementation: .public order + (def: .public order (Order Duration) - - (def: equivalence ..equivalence) - (def: (< param subject) - (i.< (representation param) (representation subject)))) + (implementation + (def: equivalence ..equivalence) + (def: (< param subject) + (i.< (representation param) (representation subject))))) (with_template [<op> <name>] [(def: .public <name> @@ -106,11 +106,11 @@ (def: .public leap_year (..composite ..day ..normal_year)) -(implementation: .public monoid +(def: .public monoid (Monoid Duration) - - (def: identity ..empty) - (def: composite ..composite)) + (implementation + (def: identity ..empty) + (def: composite ..composite))) (with_template [<value> <definition>] [(def: <definition> <value>)] @@ -181,21 +181,21 @@ {.#Left _} (..inverse span) {.#Right _} span))))) -(implementation: .public codec +(def: .public codec (Codec Text Duration) - - (def: encoded ..encoded) - (def: decoded (<text>.result ..parser))) + (implementation + (def: encoded ..encoded) + (def: decoded (<text>.result ..parser)))) (def: .public (difference from to) (-> Duration Duration Duration) (|> from ..inverse (..composite to))) -(implementation: .public enum +(def: .public enum (Enum Duration) - - (def: order ..order) - (def: succ - (..composite ..milli_second)) - (def: pred - (..composite (..inverse ..milli_second)))) + (implementation + (def: order ..order) + (def: succ + (..composite ..milli_second)) + (def: pred + (..composite (..inverse ..milli_second))))) diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index 2f8bbd980..5298fdb17 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -57,29 +57,29 @@ (-> Duration Instant) (|> offset duration.millis abstraction)) - (implementation: .public equivalence + (def: .public equivalence (Equivalence Instant) - - (def: (= param subject) - (at i.equivalence = (representation param) (representation subject)))) + (implementation + (def: (= param subject) + (at i.equivalence = (representation param) (representation subject))))) - (implementation: .public order + (def: .public order (Order Instant) - - (def: equivalence ..equivalence) - (def: (< param subject) - (at i.order < (representation param) (representation subject)))) + (implementation + (def: equivalence ..equivalence) + (def: (< param subject) + (at i.order < (representation param) (representation subject))))) - (`` (implementation: .public enum + (`` (def: .public enum (Enum Instant) - - (def: order ..order) - (~~ (with_template [<name>] - [(def: <name> - (|>> representation (at i.enum <name>) abstraction))] - - [succ] [pred] - )))) + (implementation + (def: order ..order) + (~~ (with_template [<name>] + [(def: <name> + (|>> representation (at i.enum <name>) abstraction))] + + [succ] [pred] + ))))) ) (def: .public epoch @@ -142,11 +142,11 @@ (duration.composite (duration.up time duration.milli_second)) ..absolute)))) -(implementation: .public codec +(def: .public codec (Codec Text Instant) - - (def: encoded ..format) - (def: decoded (<text>.result ..parser))) + (implementation + (def: encoded ..format) + (def: decoded (<text>.result ..parser)))) (def: .public now (IO Instant) diff --git a/stdlib/source/library/lux/time/month.lux b/stdlib/source/library/lux/time/month.lux index 7e7ddc447..8dd48ba4d 100644 --- a/stdlib/source/library/lux/time/month.lux +++ b/stdlib/source/library/lux/time/month.lux @@ -34,29 +34,29 @@ {#November} {#December})) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Month) - - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag>] - [[{<tag>} {<tag>}] - true]) - ([#January] - [#February] - [#March] - [#April] - [#May] - [#June] - [#July] - [#August] - [#September] - [#October] - [#November] - [#December]) - - _ - false))) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag>] + [[{<tag>} {<tag>}] + true]) + ([#January] + [#February] + [#March] + [#April] + [#May] + [#June] + [#July] + [#August] + [#September] + [#October] + [#November] + [#December]) + + _ + false)))) (with_expansions [<pairs> (these [01 #January] [02 #February] @@ -98,71 +98,71 @@ (exception.except ..invalid_month [number]))) ) -(implementation: .public hash +(def: .public hash (Hash Month) - - (def: equivalence ..equivalence) - (def: (hash month) - (case month - (^.with_template [<prime> <month>] - [{<month>} - <prime>]) - ([02 #January] - [03 #February] - [05 #March] - [07 #April] - [11 #May] - [13 #June] - [17 #July] - [19 #August] - [23 #September] - [29 #October] - [31 #November] - [37 #December])))) - -(implementation: .public order + (implementation + (def: equivalence ..equivalence) + (def: (hash month) + (case month + (^.with_template [<prime> <month>] + [{<month>} + <prime>]) + ([02 #January] + [03 #February] + [05 #March] + [07 #April] + [11 #May] + [13 #June] + [17 #July] + [19 #August] + [23 #September] + [29 #October] + [31 #November] + [37 #December]))))) + +(def: .public order (Order Month) - - (def: equivalence ..equivalence) - - (def: (< reference sample) - (n.< (..number reference) - (..number sample)))) - -(implementation: .public enum + (implementation + (def: equivalence ..equivalence) + + (def: (< reference sample) + (n.< (..number reference) + (..number sample))))) + +(def: .public enum (Enum Month) - - (def: order ..order) - - (def: (succ month) - (case month - {#January} {#February} - {#February} {#March} - {#March} {#April} - {#April} {#May} - {#May} {#June} - {#June} {#July} - {#July} {#August} - {#August} {#September} - {#September} {#October} - {#October} {#November} - {#November} {#December} - {#December} {#January})) - - (def: (pred month) - (case month - {#February} {#January} - {#March} {#February} - {#April} {#March} - {#May} {#April} - {#June} {#May} - {#July} {#June} - {#August} {#July} - {#September} {#August} - {#October} {#September} - {#November} {#October} - {#December} {#November} - {#January} {#December}))) + (implementation + (def: order ..order) + + (def: (succ month) + (case month + {#January} {#February} + {#February} {#March} + {#March} {#April} + {#April} {#May} + {#May} {#June} + {#June} {#July} + {#July} {#August} + {#August} {#September} + {#September} {#October} + {#October} {#November} + {#November} {#December} + {#December} {#January})) + + (def: (pred month) + (case month + {#February} {#January} + {#March} {#February} + {#April} {#March} + {#May} {#April} + {#June} {#May} + {#July} {#June} + {#August} {#July} + {#September} {#August} + {#October} {#September} + {#November} {#October} + {#December} {#November} + {#January} {#December})))) (def: .public (days month) (-> Month Nat) @@ -211,41 +211,41 @@ (exception.report "Value" (text.format value))) -(implementation: .public codec +(def: .public codec (Codec Text Month) - - (def: (encoded value) - (case value - (^.with_template [<tag>] - [{<tag>} - (text.replaced "#" "" (template.text [<tag>]))]) - ([..#January] - [..#February] - [..#March] - [..#April] - [..#May] - [..#June] - [..#July] - [..#August] - [..#September] - [..#October] - [..#November] - [..#December]))) - (def: (decoded value) - (case (text#composite "#" value) - (^.with_template [<tag>] - [(pattern (template.text [<tag>])) - {try.#Success {<tag>}}]) - ([..#January] - [..#February] - [..#March] - [..#April] - [..#May] - [..#June] - [..#July] - [..#August] - [..#September] - [..#October] - [..#November] - [..#December]) - _ (exception.except ..not_a_month_of_the_year [value])))) + (implementation + (def: (encoded value) + (case value + (^.with_template [<tag>] + [{<tag>} + (text.replaced "#" "" (template.text [<tag>]))]) + ([..#January] + [..#February] + [..#March] + [..#April] + [..#May] + [..#June] + [..#July] + [..#August] + [..#September] + [..#October] + [..#November] + [..#December]))) + (def: (decoded value) + (case (text#composite "#" value) + (^.with_template [<tag>] + [(pattern (template.text [<tag>])) + {try.#Success {<tag>}}]) + ([..#January] + [..#February] + [..#March] + [..#April] + [..#May] + [..#June] + [..#July] + [..#August] + [..#September] + [..#October] + [..#November] + [..#December]) + _ (exception.except ..not_a_month_of_the_year [value]))))) diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index a815cbd1c..78093d222 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -121,22 +121,22 @@ {.#Left _} (i.* -1 raw_year) {.#Right _} raw_year))))) -(implementation: .public codec +(def: .public codec (Codec Text Year) - - (def: encoded ..encoded) - (def: decoded (<text>.result ..parser))) + (implementation + (def: encoded ..encoded) + (def: decoded (<text>.result ..parser)))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Year) + (implementation + (def: (= reference subject) + (i.= (..value reference) (..value subject))))) - (def: (= reference subject) - (i.= (..value reference) (..value subject)))) - -(implementation: .public order +(def: .public order (Order Year) + (implementation + (def: equivalence ..equivalence) - (def: equivalence ..equivalence) - - (def: (< reference subject) - (i.< (..value reference) (..value subject)))) + (def: (< reference subject) + (i.< (..value reference) (..value subject))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index 7563bce90..669484890 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -72,47 +72,47 @@ (type: .public Match (Match' Analysis)) -(implementation: (branch_equivalence equivalence) +(def: (branch_equivalence equivalence) (-> (Equivalence Analysis) (Equivalence Branch)) + (implementation + (def: (= [reference_pattern reference_body] [sample_pattern sample_body]) + (and (at /pattern.equivalence = reference_pattern sample_pattern) + (at equivalence = reference_body sample_body))))) - (def: (= [reference_pattern reference_body] [sample_pattern sample_body]) - (and (at /pattern.equivalence = reference_pattern sample_pattern) - (at equivalence = reference_body sample_body)))) - -(implementation: .public equivalence +(def: .public equivalence (Equivalence Analysis) - - (def: (= reference sample) - (.case [reference sample] - [{#Simple reference} {#Simple sample}] - (at /simple.equivalence = reference sample) - - [{#Structure reference} {#Structure sample}] - (at (/complex.equivalence =) = reference sample) - - [{#Reference reference} {#Reference sample}] - (at reference.equivalence = reference sample) - - [{#Case [reference_analysis reference_match]} - {#Case [sample_analysis sample_match]}] - (and (= reference_analysis sample_analysis) - (at (list.equivalence (branch_equivalence =)) = {.#Item reference_match} {.#Item sample_match})) - - [{#Function [reference_environment reference_analysis]} - {#Function [sample_environment sample_analysis]}] - (and (= reference_analysis sample_analysis) - (at (list.equivalence =) = reference_environment sample_environment)) - - [{#Apply [reference_input reference_abstraction]} - {#Apply [sample_input sample_abstraction]}] - (and (= reference_input sample_input) - (= reference_abstraction sample_abstraction)) - - [{#Extension reference} {#Extension sample}] - (at (extension.equivalence =) = reference sample) - - _ - false))) + (implementation + (def: (= reference sample) + (.case [reference sample] + [{#Simple reference} {#Simple sample}] + (at /simple.equivalence = reference sample) + + [{#Structure reference} {#Structure sample}] + (at (/complex.equivalence =) = reference sample) + + [{#Reference reference} {#Reference sample}] + (at reference.equivalence = reference sample) + + [{#Case [reference_analysis reference_match]} + {#Case [sample_analysis sample_match]}] + (and (= reference_analysis sample_analysis) + (at (list.equivalence (branch_equivalence =)) = {.#Item reference_match} {.#Item sample_match})) + + [{#Function [reference_environment reference_analysis]} + {#Function [sample_environment sample_analysis]}] + (and (= reference_analysis sample_analysis) + (at (list.equivalence =) = reference_environment sample_environment)) + + [{#Apply [reference_input reference_abstraction]} + {#Apply [sample_input sample_abstraction]}] + (and (= reference_input sample_input) + (= reference_abstraction sample_abstraction)) + + [{#Extension reference} {#Extension sample}] + (at (extension.equivalence =) = reference sample) + + _ + false)))) (with_template [<name> <tag>] [(def: .public <name> diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux index 8727b6852..9be2aa322 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux @@ -49,41 +49,41 @@ [(..lefts right? pick) right?])) -(implementation: .public (equivalence (open "/#[0]")) +(def: .public (equivalence (open "/#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Complex a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Variant [reference_lefts reference_right? reference_value]} - {#Variant [sample_lefts sample_right? sample_value]}] - (and (n.= reference_lefts sample_lefts) - (bit#= reference_right? sample_right?) - (/#= reference_value sample_value)) - - [{#Tuple reference} {#Tuple sample}] - (at (list.equivalence /#=) = reference sample) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Variant [reference_lefts reference_right? reference_value]} + {#Variant [sample_lefts sample_right? sample_value]}] + (and (n.= reference_lefts sample_lefts) + (bit#= reference_right? sample_right?) + (/#= reference_value sample_value)) + + [{#Tuple reference} {#Tuple sample}] + (at (list.equivalence /#=) = reference sample) - _ - false))) + _ + false)))) -(implementation: .public (hash super) +(def: .public (hash super) (All (_ a) (-> (Hash a) (Hash (Complex a)))) - - (def: equivalence - (..equivalence (at super equivalence))) - - (def: (hash value) - (case value - {#Variant [lefts right? value]} - (all n.* 2 - (at n.hash hash lefts) - (at bit.hash hash right?) - (at super hash value)) - - {#Tuple members} - (all n.* 3 - (at (list.hash super) hash members)) - ))) + (implementation + (def: equivalence + (..equivalence (at super equivalence))) + + (def: (hash value) + (case value + {#Variant [lefts right? value]} + (all n.* 2 + (at n.hash hash lefts) + (at bit.hash hash right?) + (at super hash value)) + + {#Tuple members} + (all n.* 3 + (at (list.hash super) hash members)) + )))) (def: .public (format %it it) (All (_ a) (-> (Format a) (Format (Complex a)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux index cbb1e7ea4..f7d2734bf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux @@ -79,44 +79,44 @@ _ (list coverage))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Coverage) - - (def: (= reference sample) - (case [reference sample] - [{#Exhaustive} {#Exhaustive}] - #1 - - [{#Bit sideR} {#Bit sideS}] - (bit#= sideR sideS) - - (^.with_template [<tag>] - [[{<tag> partialR} {<tag> partialS}] - (set#= partialR partialS)]) - ([#Nat] - [#Int] - [#Rev] - [#Frac] - [#Text]) - - [{#Variant allR casesR} {#Variant allS casesS}] - (and (at (maybe.equivalence n.equivalence) = allR allS) - (at (dictionary.equivalence =) = casesR casesS)) - - [{#Seq leftR rightR} {#Seq leftS rightS}] - (and (= leftR leftS) - (= rightR rightS)) - - [{#Alt _} {#Alt _}] - (let [flatR (alternatives reference) - flatS (alternatives sample)] - (and (n.= (list.size flatR) (list.size flatS)) - (list.every? (function (_ [coverageR coverageS]) - (= coverageR coverageS)) - (list.zipped_2 flatR flatS)))) - - _ - #0))) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Exhaustive} {#Exhaustive}] + #1 + + [{#Bit sideR} {#Bit sideS}] + (bit#= sideR sideS) + + (^.with_template [<tag>] + [[{<tag> partialR} {<tag> partialS}] + (set#= partialR partialS)]) + ([#Nat] + [#Int] + [#Rev] + [#Frac] + [#Text]) + + [{#Variant allR casesR} {#Variant allS casesS}] + (and (at (maybe.equivalence n.equivalence) = allR allS) + (at (dictionary.equivalence =) = casesR casesS)) + + [{#Seq leftR rightR} {#Seq leftS rightS}] + (and (= leftR leftS) + (= rightR rightS)) + + [{#Alt _} {#Alt _}] + (let [flatR (alternatives reference) + flatS (alternatives sample)] + (and (n.= (list.size flatR) (list.size flatS)) + (list.every? (function (_ [coverageR coverageS]) + (= coverageR coverageS)) + (list.zipped_2 flatR flatS)))) + + _ + #0)))) (open: "/#[0]" ..equivalence) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux index 23f8796db..3209261d4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -23,22 +23,22 @@ {#Complex (Complex Pattern)} {#Bind Register}))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Pattern) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Simple reference} {#Simple sample}] + (at //simple.equivalence = reference sample) + + [{#Complex reference} {#Complex sample}] + (at (//complex.equivalence =) = reference sample) - (def: (= reference sample) - (case [reference sample] - [{#Simple reference} {#Simple sample}] - (at //simple.equivalence = reference sample) - - [{#Complex reference} {#Complex sample}] - (at (//complex.equivalence =) = reference sample) + [{#Bind reference} {#Bind sample}] + (n.= reference sample) - [{#Bind reference} {#Bind sample}] - (n.= reference sample) - - _ - false))) + _ + false)))) (def: .public (format it) (%.Format Pattern) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux index e9d2d8b87..8001696c1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux @@ -26,26 +26,26 @@ {#Frac Frac} {#Text Text})) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Simple) - - (def: (= reference sample) - (case [reference sample] - [{#Unit} {#Unit}] - true - - (^.with_template [<tag> <=>] - [[{<tag> reference} {<tag> sample}] - (<=> reference sample)]) - ([#Bit bit#=] - [#Nat n.=] - [#Int i.=] - [#Rev r.=] - [#Frac f.=] - [#Text text#=]) - - _ - false))) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Unit} {#Unit}] + true + + (^.with_template [<tag> <=>] + [[{<tag> reference} {<tag> sample}] + (<=> reference sample)]) + ([#Bit bit#=] + [#Nat n.=] + [#Int i.=] + [#Rev r.=] + [#Frac f.=] + [#Text text#=]) + + _ + false)))) (def: .public (format it) (Format Simple) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux index 85228162f..b64f9ecbb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System (Expression Any)) - - (def: constant _.var) - (def: variable _.var)) + (implementation + (def: constant _.var) + (def: variable _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/reference.lux index 68a3376c5..8a042db48 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System Expression) - - (def: constant' _.var) - (def: variable' _.var)) + (implementation + (def: constant' _.var) + (def: variable' _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux index 84c1dab75..d98a16050 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System Expression) - - (def: constant' _.var) - (def: variable' _.var)) + (implementation + (def: constant' _.var) + (def: variable' _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/reference.lux index 68332a0ee..1fb4ce3e2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System Expression) - - (def: constant _.global) - (def: variable _.var)) + (implementation + (def: constant _.global) + (def: variable _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/reference.lux index 607b7127f..47b64cd94 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System (Expression Any)) - - (def: constant' _.var) - (def: variable' _.var)) + (implementation + (def: constant' _.var) + (def: variable' _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/reference.lux index fffaab6b8..5a37d97b7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System Expression) - - (def: constant _.var) - (def: variable _.var)) + (implementation + (def: constant _.var) + (def: variable _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux index 84558a49f..b464719fc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System Expression) - - (def: constant' _.global) - (def: variable' _.local)) + (implementation + (def: constant' _.global) + (def: variable' _.local))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux index 2f04921ed..7e0b61970 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux @@ -6,8 +6,8 @@ [/// [reference (.only System)]]) -(implementation: .public system +(def: .public system (System Expression) - - (def: constant _.var) - (def: variable _.var)) + (implementation + (def: constant _.var) + (def: variable _.var))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index 831374079..726b4f3bf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -417,303 +417,303 @@ (Format Path) (%path' %synthesis)) -(implementation: .public (path'_equivalence equivalence) +(def: .public (path'_equivalence equivalence) (All (_ a) (-> (Equivalence a) (Equivalence (Path' a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Pop} {#Pop}] - true - - [{#Bit_Fork reference_when reference_then reference_else} - {#Bit_Fork sample_when sample_then sample_else}] - (and (bit#= reference_when sample_when) - (= reference_then sample_then) - (at (maybe.equivalence =) = reference_else sample_else)) - - (^.with_template [<tag> <equivalence>] - [[{<tag> reference_item} - {<tag> sample_item}] - (at (list.equivalence (product.equivalence <equivalence> =)) = - {.#Item reference_item} - {.#Item sample_item})]) - ([#I64_Fork (is (Equivalence I64) i64.equivalence)] - [#F64_Fork f.equivalence] - [#Text_Fork text.equivalence]) - - (^.with_template [<tag> <equivalence>] - [[{<tag> reference'} {<tag> sample'}] - (at <equivalence> = reference' sample')]) - ([#Access /access.equivalence] - [#Then equivalence]) - - [{#Bind reference'} {#Bind sample'}] - (n.= reference' sample') - - (^.with_template [<tag>] - [[{<tag> leftR rightR} {<tag> leftS rightS}] - (and (= leftR leftS) - (= rightR rightS))]) - ([#Alt] - [#Seq]) - - _ - false))) - -(implementation: (path'_hash super) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Pop} {#Pop}] + true + + [{#Bit_Fork reference_when reference_then reference_else} + {#Bit_Fork sample_when sample_then sample_else}] + (and (bit#= reference_when sample_when) + (= reference_then sample_then) + (at (maybe.equivalence =) = reference_else sample_else)) + + (^.with_template [<tag> <equivalence>] + [[{<tag> reference_item} + {<tag> sample_item}] + (at (list.equivalence (product.equivalence <equivalence> =)) = + {.#Item reference_item} + {.#Item sample_item})]) + ([#I64_Fork (is (Equivalence I64) i64.equivalence)] + [#F64_Fork f.equivalence] + [#Text_Fork text.equivalence]) + + (^.with_template [<tag> <equivalence>] + [[{<tag> reference'} {<tag> sample'}] + (at <equivalence> = reference' sample')]) + ([#Access /access.equivalence] + [#Then equivalence]) + + [{#Bind reference'} {#Bind sample'}] + (n.= reference' sample') + + (^.with_template [<tag>] + [[{<tag> leftR rightR} {<tag> leftS rightS}] + (and (= leftR leftS) + (= rightR rightS))]) + ([#Alt] + [#Seq]) + + _ + false)))) + +(def: (path'_hash super) (All (_ a) (-> (Hash a) (Hash (Path' a)))) - - (def: equivalence - (..path'_equivalence (at super equivalence))) - - (def: (hash value) - (case value - {#Pop} - 2 - - {#Access access} - (n.* 3 (at /access.hash hash access)) - - {#Bind register} - (n.* 5 (at n.hash hash register)) - - {#Bit_Fork when then else} - (all n.* 7 - (at bit.hash hash when) - (hash then) - (at (maybe.hash (path'_hash super)) hash else)) - - (^.with_template [<factor> <tag> <hash>] - [{<tag> item} - (let [case_hash (product.hash <hash> - (path'_hash super)) - item_hash (product.hash case_hash (list.hash case_hash))] - (n.* <factor> (at item_hash hash item)))]) - ([11 #I64_Fork i64.hash] - [13 #F64_Fork f.hash] - [17 #Text_Fork text.hash]) - - (^.with_template [<factor> <tag>] - [{<tag> fork} - (let [again_hash (path'_hash super) - fork_hash (product.hash again_hash again_hash)] - (n.* <factor> (at fork_hash hash fork)))]) - ([19 #Alt] - [23 #Seq]) - - {#Then body} - (n.* 29 (at super hash body)) - ))) - -(implementation: (branch_equivalence (open "#[0]")) + (implementation + (def: equivalence + (..path'_equivalence (at super equivalence))) + + (def: (hash value) + (case value + {#Pop} + 2 + + {#Access access} + (n.* 3 (at /access.hash hash access)) + + {#Bind register} + (n.* 5 (at n.hash hash register)) + + {#Bit_Fork when then else} + (all n.* 7 + (at bit.hash hash when) + (hash then) + (at (maybe.hash (path'_hash super)) hash else)) + + (^.with_template [<factor> <tag> <hash>] + [{<tag> item} + (let [case_hash (product.hash <hash> + (path'_hash super)) + item_hash (product.hash case_hash (list.hash case_hash))] + (n.* <factor> (at item_hash hash item)))]) + ([11 #I64_Fork i64.hash] + [13 #F64_Fork f.hash] + [17 #Text_Fork text.hash]) + + (^.with_template [<factor> <tag>] + [{<tag> fork} + (let [again_hash (path'_hash super) + fork_hash (product.hash again_hash again_hash)] + (n.* <factor> (at fork_hash hash fork)))]) + ([19 #Alt] + [23 #Seq]) + + {#Then body} + (n.* 29 (at super hash body)) + )))) + +(def: (branch_equivalence (open "#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Branch a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Let [reference_input reference_register reference_body]} - {#Let [sample_input sample_register sample_body]}] - (and (#= reference_input sample_input) - (n.= reference_register sample_register) - (#= reference_body sample_body)) - - [{#If [reference_test reference_then reference_else]} - {#If [sample_test sample_then sample_else]}] - (and (#= reference_test sample_test) - (#= reference_then sample_then) - (#= reference_else sample_else)) - - [{#Get [reference_path reference_record]} - {#Get [sample_path sample_record]}] - (and (at (list.equivalence /member.equivalence) = reference_path sample_path) - (#= reference_record sample_record)) - - [{#Case [reference_input reference_path]} - {#Case [sample_input sample_path]}] - (and (#= reference_input sample_input) - (at (path'_equivalence #=) = reference_path sample_path)) - - _ - false))) - -(implementation: (branch_hash super) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Let [reference_input reference_register reference_body]} + {#Let [sample_input sample_register sample_body]}] + (and (#= reference_input sample_input) + (n.= reference_register sample_register) + (#= reference_body sample_body)) + + [{#If [reference_test reference_then reference_else]} + {#If [sample_test sample_then sample_else]}] + (and (#= reference_test sample_test) + (#= reference_then sample_then) + (#= reference_else sample_else)) + + [{#Get [reference_path reference_record]} + {#Get [sample_path sample_record]}] + (and (at (list.equivalence /member.equivalence) = reference_path sample_path) + (#= reference_record sample_record)) + + [{#Case [reference_input reference_path]} + {#Case [sample_input sample_path]}] + (and (#= reference_input sample_input) + (at (path'_equivalence #=) = reference_path sample_path)) + + _ + false)))) + +(def: (branch_hash super) (All (_ a) (-> (Hash a) (Hash (Branch a)))) - - (def: equivalence - (..branch_equivalence (at super equivalence))) - - (def: (hash value) - (case value - {#Exec this that} - (all n.* 2 - (at super hash this) - (at super hash that)) - - {#Let [input register body]} - (all n.* 3 - (at super hash input) - (at n.hash hash register) - (at super hash body)) - - {#If [test then else]} - (all n.* 5 - (at super hash test) - (at super hash then) - (at super hash else)) - - {#Get [path record]} - (all n.* 7 - (at (list.hash /member.hash) hash path) - (at super hash record)) - - {#Case [input path]} - (all n.* 11 - (at super hash input) - (at (..path'_hash super) hash path)) - ))) - -(implementation: (loop_equivalence (open "/#[0]")) + (implementation + (def: equivalence + (..branch_equivalence (at super equivalence))) + + (def: (hash value) + (case value + {#Exec this that} + (all n.* 2 + (at super hash this) + (at super hash that)) + + {#Let [input register body]} + (all n.* 3 + (at super hash input) + (at n.hash hash register) + (at super hash body)) + + {#If [test then else]} + (all n.* 5 + (at super hash test) + (at super hash then) + (at super hash else)) + + {#Get [path record]} + (all n.* 7 + (at (list.hash /member.hash) hash path) + (at super hash record)) + + {#Case [input path]} + (all n.* 11 + (at super hash input) + (at (..path'_hash super) hash path)) + )))) + +(def: (loop_equivalence (open "/#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Loop a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Scope [reference_start reference_inits reference_iteration]} - {#Scope [sample_start sample_inits sample_iteration]}] - (and (n.= reference_start sample_start) - (at (list.equivalence /#=) = reference_inits sample_inits) - (/#= reference_iteration sample_iteration)) - - [{#Again reference} {#Again sample}] - (at (list.equivalence /#=) = reference sample) - - _ - false))) - -(implementation: (loop_hash super) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Scope [reference_start reference_inits reference_iteration]} + {#Scope [sample_start sample_inits sample_iteration]}] + (and (n.= reference_start sample_start) + (at (list.equivalence /#=) = reference_inits sample_inits) + (/#= reference_iteration sample_iteration)) + + [{#Again reference} {#Again sample}] + (at (list.equivalence /#=) = reference sample) + + _ + false)))) + +(def: (loop_hash super) (All (_ a) (-> (Hash a) (Hash (Loop a)))) - - (def: equivalence - (..loop_equivalence (at super equivalence))) - - (def: (hash value) - (case value - {#Scope [start inits iteration]} - (all n.* 2 - (at n.hash hash start) - (at (list.hash super) hash inits) - (at super hash iteration)) - - {#Again resets} - (all n.* 3 - (at (list.hash super) hash resets)) - ))) - -(implementation: (function_equivalence (open "#[0]")) + (implementation + (def: equivalence + (..loop_equivalence (at super equivalence))) + + (def: (hash value) + (case value + {#Scope [start inits iteration]} + (all n.* 2 + (at n.hash hash start) + (at (list.hash super) hash inits) + (at super hash iteration)) + + {#Again resets} + (all n.* 3 + (at (list.hash super) hash resets)) + )))) + +(def: (function_equivalence (open "#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Function a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Abstraction [reference_environment reference_arity reference_body]} - {#Abstraction [sample_environment sample_arity sample_body]}] - (and (at (list.equivalence #=) = reference_environment sample_environment) - (n.= reference_arity sample_arity) - (#= reference_body sample_body)) - - [{#Apply [reference_abstraction reference_arguments]} - {#Apply [sample_abstraction sample_arguments]}] - (and (#= reference_abstraction sample_abstraction) - (at (list.equivalence #=) = reference_arguments sample_arguments)) - - _ - false))) - -(implementation: (function_hash super) + (implementation + (def: (= reference sample) + (case [reference sample] + [{#Abstraction [reference_environment reference_arity reference_body]} + {#Abstraction [sample_environment sample_arity sample_body]}] + (and (at (list.equivalence #=) = reference_environment sample_environment) + (n.= reference_arity sample_arity) + (#= reference_body sample_body)) + + [{#Apply [reference_abstraction reference_arguments]} + {#Apply [sample_abstraction sample_arguments]}] + (and (#= reference_abstraction sample_abstraction) + (at (list.equivalence #=) = reference_arguments sample_arguments)) + + _ + false)))) + +(def: (function_hash super) (All (_ a) (-> (Hash a) (Hash (Function a)))) - - (def: equivalence - (..function_equivalence (at super equivalence))) - - (def: (hash value) - (case value - {#Abstraction [environment arity body]} - (all n.* 2 - (at (list.hash super) hash environment) - (at n.hash hash arity) - (at super hash body)) - - {#Apply [abstraction arguments]} - (all n.* 3 - (at super hash abstraction) - (at (list.hash super) hash arguments)) - ))) - -(implementation: (control_equivalence (open "#[0]")) + (implementation + (def: equivalence + (..function_equivalence (at super equivalence))) + + (def: (hash value) + (case value + {#Abstraction [environment arity body]} + (all n.* 2 + (at (list.hash super) hash environment) + (at n.hash hash arity) + (at super hash body)) + + {#Apply [abstraction arguments]} + (all n.* 3 + (at super hash abstraction) + (at (list.hash super) hash arguments)) + )))) + +(def: (control_equivalence (open "#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Control a)))) - - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag> <equivalence>] - [[{<tag> reference} {<tag> sample}] - (at (<equivalence> #=) = reference sample)]) - ([#Branch ..branch_equivalence] - [#Loop ..loop_equivalence] - [#Function ..function_equivalence]) - - _ - false))) - -(implementation: (control_hash super) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag> <equivalence>] + [[{<tag> reference} {<tag> sample}] + (at (<equivalence> #=) = reference sample)]) + ([#Branch ..branch_equivalence] + [#Loop ..loop_equivalence] + [#Function ..function_equivalence]) + + _ + false)))) + +(def: (control_hash super) (All (_ a) (-> (Hash a) (Hash (Control a)))) - - (def: equivalence - (..control_equivalence (at super equivalence))) - - (def: (hash value) - (case value - (^.with_template [<factor> <tag> <hash>] - [{<tag> value} - (n.* <factor> (at (<hash> super) hash value))]) - ([2 #Branch ..branch_hash] - [3 #Loop ..loop_hash] - [5 #Function ..function_hash]) - ))) - -(implementation: .public equivalence + (implementation + (def: equivalence + (..control_equivalence (at super equivalence))) + + (def: (hash value) + (case value + (^.with_template [<factor> <tag> <hash>] + [{<tag> value} + (n.* <factor> (at (<hash> super) hash value))]) + ([2 #Branch ..branch_hash] + [3 #Loop ..loop_hash] + [5 #Function ..function_hash]) + )))) + +(def: .public equivalence (Equivalence Synthesis) - - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag> <equivalence>] - [[{<tag> reference'} {<tag> sample'}] - (at <equivalence> = reference' sample')]) - ([#Simple /simple.equivalence] - [#Structure (analysis/complex.equivalence =)] - [#Reference reference.equivalence] - [#Control (control_equivalence =)] - [#Extension (extension.equivalence =)]) - - _ - false))) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag> <equivalence>] + [[{<tag> reference'} {<tag> sample'}] + (at <equivalence> = reference' sample')]) + ([#Simple /simple.equivalence] + [#Structure (analysis/complex.equivalence =)] + [#Reference reference.equivalence] + [#Control (control_equivalence =)] + [#Extension (extension.equivalence =)]) + + _ + false)))) (def: .public path_equivalence (Equivalence Path) (path'_equivalence equivalence)) -(implementation: .public hash +(def: .public hash (Hash Synthesis) - - (def: equivalence ..equivalence) - - (def: (hash value) - (let [again_hash [..equivalence hash]] - (case value - (^.with_template [<tag> <hash>] - [{<tag> value} - (at <hash> hash value)]) - ([#Simple /simple.hash] - [#Structure (analysis/complex.hash again_hash)] - [#Reference reference.hash] - [#Control (..control_hash again_hash)] - [#Extension (extension.hash again_hash)]))))) + (implementation + (def: equivalence ..equivalence) + + (def: (hash value) + (let [again_hash [..equivalence hash]] + (case value + (^.with_template [<tag> <hash>] + [{<tag> value} + (at <hash> hash value)]) + ([#Simple /simple.hash] + [#Structure (analysis/complex.hash again_hash)] + [#Reference reference.hash] + [#Control (..control_hash again_hash)] + [#Extension (extension.hash again_hash)])))))) (def: .public !bind_top (template (!bind_top register thenP) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux index 6a6e4b3b0..d9e04bdef 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux @@ -39,35 +39,35 @@ {#I64 value} (%.int (.int value)))) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Simple) - - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag> <eq> <format>] - [[{<tag> reference'} {<tag> sample'}] - (<eq> reference' sample')]) - ([#Bit bit#= %.bit] - [#F64 f.= %.frac] - [#Text text#= %.text]) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag> <eq> <format>] + [[{<tag> reference'} {<tag> sample'}] + (<eq> reference' sample')]) + ([#Bit bit#= %.bit] + [#F64 f.= %.frac] + [#Text text#= %.text]) - [{#I64 reference'} {#I64 sample'}] - (i64#= reference' sample') + [{#I64 reference'} {#I64 sample'}] + (i64#= reference' sample') - _ - false))) + _ + false)))) -(implementation: .public hash +(def: .public hash (Hash Simple) + (implementation + (def: equivalence ..equivalence) - (def: equivalence ..equivalence) - - (def: hash - (|>> (pipe.case - (^.with_template [<factor> <tag> <hash>] - [{<tag> value'} - (n.* <factor> (at <hash> hash value'))]) - ([2 #Bit bit.hash] - [3 #F64 f.hash] - [5 #Text text.hash] - [7 #I64 i64.hash]))))) + (def: hash + (|>> (pipe.case + (^.with_template [<factor> <tag> <hash>] + [{<tag> value'} + (n.* <factor> (at <hash> hash value'))]) + ([2 #Bit bit.hash] + [3 #F64 f.hash] + [5 #Text text.hash] + [7 #I64 i64.hash])))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux index a3780a1b8..9e00a5b51 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux @@ -40,25 +40,25 @@ {#Directive Text} {#Custom Text})) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Category) - - (def: (= left right) - (case [left right] - [{#Anonymous} {#Anonymous}] - true + (implementation + (def: (= left right) + (case [left right] + [{#Anonymous} {#Anonymous}] + true - [{#Definition left} {#Definition right}] - (at definition_equivalence = left right) - - (^.with_template [<tag>] - [[{<tag> left} {<tag> right}] - (text#= left right)]) - ([#Analyser] - [#Synthesizer] - [#Generator] - [#Directive] - [#Custom]) + [{#Definition left} {#Definition right}] + (at definition_equivalence = left right) + + (^.with_template [<tag>] + [[{<tag> left} {<tag> right}] + (text#= left right)]) + ([#Analyser] + [#Synthesizer] + [#Generator] + [#Directive] + [#Custom]) - _ - false))) + _ + false)))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux index bc35ee361..702be60b8 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -36,20 +36,20 @@ #state Module_State #references (Set Module)])) -(implementation: module_state_equivalence +(def: module_state_equivalence (Equivalence Module_State) - - (def: (= left right) - (case [left right] - (^.with_template [<tag>] - [[{<tag>} {<tag>}] - true]) - ([.#Active] - [.#Compiled] - [.#Cached]) + (implementation + (def: (= left right) + (case [left right] + (^.with_template [<tag>] + [[{<tag>} {<tag>}] + true]) + ([.#Active] + [.#Compiled] + [.#Cached]) - _ - false))) + _ + false)))) (def: .public equivalence (Equivalence Descriptor) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index 48b08b54b..26e6e7637 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -23,35 +23,35 @@ (type: .public (Operation s o) (state.+State Try s o)) -(implementation: .public functor +(def: .public functor (All (_ s) (Functor (Operation s))) - - (def: (each f it) - (function (_ state) - (case (it state) - {try.#Success [state' output]} - {try.#Success [state' (f output)]} - - {try.#Failure error} - {try.#Failure error})))) - -(implementation: .public monad + (implementation + (def: (each f it) + (function (_ state) + (case (it state) + {try.#Success [state' output]} + {try.#Success [state' (f output)]} + + {try.#Failure error} + {try.#Failure error}))))) + +(def: .public monad (All (_ s) (Monad (Operation s))) - - (def: functor ..functor) - - (def: (in it) - (function (_ state) - {try.#Success [state it]})) - - (def: (conjoint it) - (function (_ state) - (case (it state) - {try.#Success [state' it']} - (it' state') - - {try.#Failure error} - {try.#Failure error})))) + (implementation + (def: functor ..functor) + + (def: (in it) + (function (_ state) + {try.#Success [state it]})) + + (def: (conjoint it) + (function (_ state) + (case (it state) + {try.#Success [state' it']} + (it' state') + + {try.#Failure error} + {try.#Failure error}))))) (type: .public (Phase s i o) (-> Archive i (Operation s o))) diff --git a/stdlib/source/library/lux/tool/compiler/reference.lux b/stdlib/source/library/lux/tool/compiler/reference.lux index cd028073c..33940e6f7 100644 --- a/stdlib/source/library/lux/tool/compiler/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/reference.lux @@ -27,36 +27,36 @@ {#Variable Variable} {#Constant Constant})) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Reference) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag> <equivalence>] + [[{<tag> reference} {<tag> sample}] + (at <equivalence> = reference sample)]) + ([#Variable /variable.equivalence] + [#Constant symbol.equivalence]) - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag> <equivalence>] - [[{<tag> reference} {<tag> sample}] - (at <equivalence> = reference sample)]) - ([#Variable /variable.equivalence] - [#Constant symbol.equivalence]) + _ + false)))) - _ - false))) - -(implementation: .public hash +(def: .public hash (Hash Reference) + (implementation + (def: equivalence + ..equivalence) - (def: equivalence - ..equivalence) - - (def: (hash value) - (case value - (^.with_template [<factor> <tag> <hash>] - [{<tag> value} - (|> value - (at <hash> hash) - (n.* <factor>))]) - ([2 #Variable /variable.hash] - [3 #Constant symbol.hash]) - ))) + (def: (hash value) + (case value + (^.with_template [<factor> <tag> <hash>] + [{<tag> value} + (|> value + (at <hash> hash) + (n.* <factor>))]) + ([2 #Variable /variable.hash] + [3 #Constant symbol.hash]) + )))) (with_template [<name> <family> <tag>] [(def: .public <name> diff --git a/stdlib/source/library/lux/tool/compiler/reference/variable.lux b/stdlib/source/library/lux/tool/compiler/reference/variable.lux index ad3be0e06..787f15e9f 100644 --- a/stdlib/source/library/lux/tool/compiler/reference/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/reference/variable.lux @@ -24,34 +24,34 @@ {#Local Register} {#Foreign Register})) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Variable) - - (def: (= reference sample) - (case [reference sample] - (^.with_template [<tag>] - [[{<tag> reference'} {<tag> sample'}] - (n.= reference' sample')]) - ([#Local] [#Foreign]) + (implementation + (def: (= reference sample) + (case [reference sample] + (^.with_template [<tag>] + [[{<tag> reference'} {<tag> sample'}] + (n.= reference' sample')]) + ([#Local] [#Foreign]) - _ - #0))) + _ + #0)))) -(implementation: .public hash +(def: .public hash (Hash Variable) - - (def: equivalence - ..equivalence) - - (def: hash - (|>> (pipe.case - (^.with_template [<factor> <tag>] - [{<tag> register} - (|> register - (at n.hash hash) - (n.* <factor>))]) - ([2 #Local] - [3 #Foreign]))))) + (implementation + (def: equivalence + ..equivalence) + + (def: hash + (|>> (pipe.case + (^.with_template [<factor> <tag>] + [{<tag> register} + (|> register + (at n.hash hash) + (n.* <factor>))]) + ([2 #Local] + [3 #Foreign])))))) (def: .public self (template (self) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index fd506820d..5a8d85829 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -176,52 +176,52 @@ type )) -(implementation: .public equivalence +(def: .public equivalence (Equivalence Type) - - (def: (= x y) - (or (for @.php - ... TODO: Remove this once JPHP is gone. - false - (same? x y)) - (case [x y] - [{.#Primitive xname xparams} {.#Primitive yname yparams}] - (and (text#= xname yname) - (n.= (list.size yparams) (list.size xparams)) - (list#mix (.function (_ [x y] prev) (and prev (= x y))) - #1 - (list.zipped_2 xparams yparams))) - - (^.with_template [<tag>] - [[{<tag> xid} {<tag> yid}] - (n.= yid xid)]) - ([.#Var] [.#Ex] [.#Parameter]) - - (^.or [{.#Function xleft xright} {.#Function yleft yright}] - [{.#Apply xleft xright} {.#Apply yleft yright}]) - (and (= xleft yleft) - (= xright yright)) - - [{.#Named xname xtype} {.#Named yname ytype}] - (and (symbol#= xname yname) - (= xtype ytype)) - - (^.with_template [<tag>] - [[{<tag> xL xR} {<tag> yL yR}] - (and (= xL yL) (= xR yR))]) - ([.#Sum] [.#Product]) - - (^.or [{.#UnivQ xenv xbody} {.#UnivQ yenv ybody}] - [{.#ExQ xenv xbody} {.#ExQ yenv ybody}]) - (and (n.= (list.size yenv) (list.size xenv)) - (= xbody ybody) - (list#mix (.function (_ [x y] prev) (and prev (= x y))) - #1 - (list.zipped_2 xenv yenv))) - - _ - #0 - )))) + (implementation + (def: (= x y) + (or (for @.php + ... TODO: Remove this once JPHP is gone. + false + (same? x y)) + (case [x y] + [{.#Primitive xname xparams} {.#Primitive yname yparams}] + (and (text#= xname yname) + (n.= (list.size yparams) (list.size xparams)) + (list#mix (.function (_ [x y] prev) (and prev (= x y))) + #1 + (list.zipped_2 xparams yparams))) + + (^.with_template [<tag>] + [[{<tag> xid} {<tag> yid}] + (n.= yid xid)]) + ([.#Var] [.#Ex] [.#Parameter]) + + (^.or [{.#Function xleft xright} {.#Function yleft yright}] + [{.#Apply xleft xright} {.#Apply yleft yright}]) + (and (= xleft yleft) + (= xright yright)) + + [{.#Named xname xtype} {.#Named yname ytype}] + (and (symbol#= xname yname) + (= xtype ytype)) + + (^.with_template [<tag>] + [[{<tag> xL xR} {<tag> yL yR}] + (and (= xL yL) (= xR yR))]) + ([.#Sum] [.#Product]) + + (^.or [{.#UnivQ xenv xbody} {.#UnivQ yenv ybody}] + [{.#ExQ xenv xbody} {.#ExQ yenv ybody}]) + (and (n.= (list.size yenv) (list.size xenv)) + (= xbody ybody) + (list#mix (.function (_ [x y] prev) (and prev (= x y))) + #1 + (list.zipped_2 xenv yenv))) + + _ + #0 + ))))) (def: .public (applied params func) (-> (List Type) Type (Maybe Type)) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index f494749f2..d96c460b1 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -74,63 +74,63 @@ (type: Type_Vars (List [Var (Maybe Type)])) -(implementation: .public functor +(def: .public functor (Functor Check) - - (def: (each f fa) - (function (_ context) - (case (fa context) - {try.#Success [context' output]} - {try.#Success [context' (f output)]} + (implementation + (def: (each f fa) + (function (_ context) + (case (fa context) + {try.#Success [context' output]} + {try.#Success [context' (f output)]} - {try.#Failure error} - {try.#Failure error})))) + {try.#Failure error} + {try.#Failure error}))))) -(implementation: .public apply +(def: .public apply (Apply Check) - - (def: functor ..functor) - - (def: (on fa ff) - (function (_ context) - (case (ff context) - {try.#Success [context' f]} - (case (fa context') - {try.#Success [context'' a]} - {try.#Success [context'' (f a)]} - - {try.#Failure error} - {try.#Failure error}) - - {try.#Failure error} - {try.#Failure error} - ))) - ) + (implementation + (def: functor ..functor) + + (def: (on fa ff) + (function (_ context) + (case (ff context) + {try.#Success [context' f]} + (case (fa context') + {try.#Success [context'' a]} + {try.#Success [context'' (f a)]} + + {try.#Failure error} + {try.#Failure error}) + + {try.#Failure error} + {try.#Failure error} + ))) + )) -(implementation: .public monad +(def: .public monad (Monad Check) - - (def: functor ..functor) - - (def: (in x) - (function (_ context) - {try.#Success [context x]})) - - (def: (conjoint ffa) - (function (_ context) - (case (ffa context) - {try.#Success [context' fa]} - (case (fa context') - {try.#Success [context'' a]} - {try.#Success [context'' a]} - - {try.#Failure error} - {try.#Failure error}) - - {try.#Failure error} - {try.#Failure error} - ))) - ) + (implementation + (def: functor ..functor) + + (def: (in x) + (function (_ context) + {try.#Success [context x]})) + + (def: (conjoint ffa) + (function (_ context) + (case (ffa context) + {try.#Success [context' fa]} + (case (fa context') + {try.#Success [context'' a]} + {try.#Success [context'' a]} + + {try.#Failure error} + {try.#Failure error}) + + {try.#Failure error} + {try.#Failure error} + ))) + )) (open: "check#[0]" ..monad) diff --git a/stdlib/source/library/lux/type/quotient.lux b/stdlib/source/library/lux/type/quotient.lux index 0382c5e1f..9ae7ac08e 100644 --- a/stdlib/source/library/lux/type/quotient.lux +++ b/stdlib/source/library/lux/type/quotient.lux @@ -66,8 +66,8 @@ ... (..Quotient (~ g!t) (~ g!c) (~ g!%)))) ))))) -(implementation: .public (equivalence super) +(def: .public (equivalence super) (All (_ t c %) (-> (Equivalence c) (Equivalence (..Quotient t c %)))) - - (def: (= reference sample) - (at super = (..label reference) (..label sample)))) + (implementation + (def: (= reference sample) + (at super = (..label reference) (..label sample))))) diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index d6150bdf6..63c450792 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -40,18 +40,18 @@ (All (_ keys) (Procedure monad [permissions keys] keys value))) -(implementation: .public (monad monad) +(def: .public (monad monad) (All (_ !) (-> (Monad !) (IxMonad (Procedure !)))) - - (def: (in value) - (function (_ keys) - (at monad in [keys value]))) - - (def: (then f input) - (function (_ keysI) - (do monad - [[keysT value] (input keysI)] - ((f value) keysT))))) + (implementation + (def: (in value) + (function (_ keys) + (at monad in [keys value]))) + + (def: (then f input) + (function (_ keysI) + (do monad + [[keysT value] (input keysI)] + ((f value) keysT)))))) (def: .public (run! monad procedure) (All (_ ! v) (-> (Monad !) (Linear ! v) (! v))) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index 8dbda8dd2..b3eed082a 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -97,11 +97,11 @@ (in (list (` (type: (~ export_policy) (~ g!type) (Primitive (~ (code.text (%.symbol [@ type_name])))))) - (` (implementation: (~ export_policy) (~ (code.local unit_name)) + (` (def: (~ export_policy) (~ (code.local unit_name)) (..Unit (~ g!type)) - - (def: (~' in) (~! ..in')) - (def: (~' out) (~! ..out')))) + (implementation + (def: (~' in) (~! ..in')) + (def: (~' out) (~! ..out'))))) ))))) (def: scaleP @@ -129,22 +129,22 @@ (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u)) (Primitive (~ (code.text (%.symbol [@ type_name]))) [(~' u)]))) - (` (implementation: (~ export_policy) (~ (code.local scale_name)) + (` (def: (~ export_policy) (~ (code.local scale_name)) (..Scale (~ g!scale)) - - (def: (~' scale) - (|>> ((~! ..out')) - (i.* (~ (code.int (.int _#numerator)))) - (i./ (~ (code.int (.int _#denominator)))) - ((~! ..in')))) - (def: (~' de_scale) - (|>> ((~! ..out')) - (i.* (~ (code.int (.int _#denominator)))) - (i./ (~ (code.int (.int _#numerator)))) - ((~! ..in')))) - (def: (~' ratio) - [(~ (code.nat _#numerator)) - (~ (code.nat _#denominator))]))) + (implementation + (def: (~' scale) + (|>> ((~! ..out')) + (i.* (~ (code.int (.int _#numerator)))) + (i./ (~ (code.int (.int _#denominator)))) + ((~! ..in')))) + (def: (~' de_scale) + (|>> ((~! ..out')) + (i.* (~ (code.int (.int _#denominator)))) + (i./ (~ (code.int (.int _#numerator)))) + ((~! ..in')))) + (def: (~' ratio) + [(~ (code.nat _#numerator)) + (~ (code.nat _#denominator))])))) ))))) (def: .public (re_scaled from to quantity) @@ -185,23 +185,23 @@ [Second] ) -(implementation: .public equivalence +(def: .public equivalence (All (_ unit) (Equivalence (Qty unit))) - - (def: (= reference sample) - (i.= (..out' reference) (..out' sample)))) + (implementation + (def: (= reference sample) + (i.= (..out' reference) (..out' sample))))) -(implementation: .public order +(def: .public order (All (_ unit) (Order (Qty unit))) - - (def: equivalence ..equivalence) - - (def: (< reference sample) - (i.< (..out' reference) (..out' sample)))) + (implementation + (def: equivalence ..equivalence) + + (def: (< reference sample) + (i.< (..out' reference) (..out' sample))))) -(implementation: .public enum +(def: .public enum (All (_ unit) (Enum (Qty unit))) - - (def: order ..order) - (def: succ (|>> ..out' ++ ..in')) - (def: pred (|>> ..out' -- ..in'))) + (implementation + (def: order ..order) + (def: succ (|>> ..out' ++ ..in')) + (def: pred (|>> ..out' -- ..in')))) diff --git a/stdlib/source/library/lux/world/db/jdbc/input.lux b/stdlib/source/library/lux/world/db/jdbc/input.lux index 19272665f..7a8c47899 100644 --- a/stdlib/source/library/lux/world/db/jdbc/input.lux +++ b/stdlib/source/library/lux/world/db/jdbc/input.lux @@ -47,12 +47,12 @@ (-> a [Nat java/sql/PreparedStatement] (Try [Nat java/sql/PreparedStatement]))) -(implementation: .public contravariant +(def: .public contravariant (Contravariant Input) - - (def: (each f fb) - (function (fa value circumstance) - (fb (f value) circumstance)))) + (implementation + (def: (each f fb) + (function (fa value circumstance) + (fb (f value) circumstance))))) (def: .public (and pre post) (All (_ l r) (-> (Input l) (Input r) (Input [l r]))) diff --git a/stdlib/source/library/lux/world/db/jdbc/output.lux b/stdlib/source/library/lux/world/db/jdbc/output.lux index 65feaba99..3035cff80 100644 --- a/stdlib/source/library/lux/world/db/jdbc/output.lux +++ b/stdlib/source/library/lux/world/db/jdbc/output.lux @@ -50,54 +50,54 @@ (type: .public (Output a) (-> [Nat java/sql/ResultSet] (Try [Nat a]))) -(implementation: .public functor +(def: .public functor (Functor Output) - - (def: (each f fa) - (function (_ idx+rs) - (case (fa idx+rs) - {try.#Failure error} - {try.#Failure error} - - {try.#Success [idx' value]} - {try.#Success [idx' (f value)]})))) + (implementation + (def: (each f fa) + (function (_ idx+rs) + (case (fa idx+rs) + {try.#Failure error} + {try.#Failure error} + + {try.#Success [idx' value]} + {try.#Success [idx' (f value)]}))))) -(implementation: .public apply +(def: .public apply (Apply Output) - - (def: functor ..functor) + (implementation + (def: functor ..functor) - (def: (apply ff fa) - (function (_ [idx rs]) - (case (ff [idx rs]) - {try.#Success [idx' f]} - (case (fa [idx' rs]) - {try.#Success [idx'' a]} - {try.#Success [idx'' (f a)]} + (def: (apply ff fa) + (function (_ [idx rs]) + (case (ff [idx rs]) + {try.#Success [idx' f]} + (case (fa [idx' rs]) + {try.#Success [idx'' a]} + {try.#Success [idx'' (f a)]} - {try.#Failure msg} - {try.#Failure msg}) + {try.#Failure msg} + {try.#Failure msg}) - {try.#Failure msg} - {try.#Failure msg})))) + {try.#Failure msg} + {try.#Failure msg}))))) -(implementation: .public monad +(def: .public monad (Monad Output) - - (def: functor ..functor) - - (def: (in a) - (function (_ [idx rs]) - {.#Some [idx a]})) - - (def: (conjoint mma) - (function (_ [idx rs]) - (case (mma [idx rs]) - {try.#Failure error} - {try.#Failure error} - - {try.#Success [idx' ma]} - (ma [idx' rs]))))) + (implementation + (def: functor ..functor) + + (def: (in a) + (function (_ [idx rs]) + {.#Some [idx a]})) + + (def: (conjoint mma) + (function (_ [idx rs]) + (case (mma [idx rs]) + {try.#Failure error} + {try.#Failure error} + + {try.#Success [idx' ma]} + (ma [idx' rs])))))) (def: .public (fail error) (All (_ a) (-> Text (Output a))) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 697621578..0a5917557 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -200,105 +200,105 @@ "[1]::[0]" (new [java/io/File] "io" "try")) - (`` (implementation: .public default + (`` (def: .public default (System IO) - - (def: separator - (ffi.of_string (java/io/File::separator))) - - (~~ (with_template [<name> <method>] - [(def: <name> - (|>> ffi.as_string - java/io/File::new - <method> - (io#each (|>> (try#each (|>> ffi.of_boolean)) (try.else false)))))] - - [file? java/io/File::isFile] - [directory? java/io/File::isDirectory] - )) - - (def: make_directory - (|>> ffi.as_string - java/io/File::new - java/io/File::mkdir)) - - (~~ (with_template [<name> <method>] - [(def: (<name> path) - (do [! (try.with io.monad)] - [?children (java/io/File::listFiles (java/io/File::new (ffi.as_string path)))] - (case ?children - {.#Some children} - (|> children - (array.list {.#None}) - (monad.only ! (|>> <method> (at ! each (|>> ffi.of_boolean)))) - (at ! each (monad.each ! (|>> java/io/File::getAbsolutePath (at ! each (|>> ffi.of_string))))) - (at ! conjoint)) - - {.#None} - (at io.monad in (exception.except ..cannot_find_directory [path])))))] - - [directory_files java/io/File::isFile] - [sub_directories java/io/File::isDirectory] - )) - - (def: file_size - (|>> ffi.as_string + (implementation + (def: separator + (ffi.of_string (java/io/File::separator))) + + (~~ (with_template [<name> <method>] + [(def: <name> + (|>> ffi.as_string + java/io/File::new + <method> + (io#each (|>> (try#each (|>> ffi.of_boolean)) (try.else false)))))] + + [file? java/io/File::isFile] + [directory? java/io/File::isDirectory] + )) + + (def: make_directory + (|>> ffi.as_string + java/io/File::new + java/io/File::mkdir)) + + (~~ (with_template [<name> <method>] + [(def: (<name> path) + (do [! (try.with io.monad)] + [?children (java/io/File::listFiles (java/io/File::new (ffi.as_string path)))] + (case ?children + {.#Some children} + (|> children + (array.list {.#None}) + (monad.only ! (|>> <method> (at ! each (|>> ffi.of_boolean)))) + (at ! each (monad.each ! (|>> java/io/File::getAbsolutePath (at ! each (|>> ffi.of_string))))) + (at ! conjoint)) + + {.#None} + (at io.monad in (exception.except ..cannot_find_directory [path])))))] + + [directory_files java/io/File::isFile] + [sub_directories java/io/File::isDirectory] + )) + + (def: file_size + (|>> ffi.as_string + java/io/File::new + java/io/File::length + (at (try.with io.monad) each (|>> ffi.of_long .nat)))) + + (def: last_modified + (|>> ffi.as_string + java/io/File::new + (java/io/File::lastModified) + (at (try.with io.monad) each (|>> ffi.of_long duration.of_millis instant.absolute)))) + + (def: can_execute? + (|>> ffi.as_string + java/io/File::new + java/io/File::canExecute + (io#each (try#each (|>> ffi.of_boolean))))) + + (def: (read path) + (do (try.with io.monad) + [.let [file (java/io/File::new (ffi.as_string path))] + size (java/io/File::length file) + stream (java/io/FileInputStream::new file) + .let [data (binary.empty (.nat (ffi.of_long size)))] + bytes_read (java/io/InputStream::read data stream) + _ (java/lang/AutoCloseable::close stream)] + (in data))) + + (def: (delete path) + (|> path + ffi.as_string java/io/File::new - java/io/File::length - (at (try.with io.monad) each (|>> ffi.of_long .nat)))) + java/io/File::delete)) - (def: last_modified - (|>> ffi.as_string + (def: (modify path time_stamp) + (|> path + ffi.as_string java/io/File::new - (java/io/File::lastModified) - (at (try.with io.monad) each (|>> ffi.of_long duration.of_millis instant.absolute)))) - - (def: can_execute? - (|>> ffi.as_string + (java/io/File::setLastModified (|> time_stamp instant.relative duration.millis ffi.as_long)))) + + (~~ (with_template [<flag> <name>] + [(def: (<name> path data) + (do (try.with io.monad) + [stream (java/io/FileOutputStream::new (java/io/File::new (ffi.as_string path)) (ffi.as_boolean <flag>)) + _ (java/io/OutputStream::write data stream) + _ (java/io/OutputStream::flush stream)] + (java/lang/AutoCloseable::close stream)))] + + [#0 write] + [#1 append] + )) + + (def: (move origin destination) + (|> origin + ffi.as_string java/io/File::new - java/io/File::canExecute - (io#each (try#each (|>> ffi.of_boolean))))) - - (def: (read path) - (do (try.with io.monad) - [.let [file (java/io/File::new (ffi.as_string path))] - size (java/io/File::length file) - stream (java/io/FileInputStream::new file) - .let [data (binary.empty (.nat (ffi.of_long size)))] - bytes_read (java/io/InputStream::read data stream) - _ (java/lang/AutoCloseable::close stream)] - (in data))) - - (def: (delete path) - (|> path - ffi.as_string - java/io/File::new - java/io/File::delete)) - - (def: (modify path time_stamp) - (|> path - ffi.as_string - java/io/File::new - (java/io/File::setLastModified (|> time_stamp instant.relative duration.millis ffi.as_long)))) - - (~~ (with_template [<flag> <name>] - [(def: (<name> path data) - (do (try.with io.monad) - [stream (java/io/FileOutputStream::new (java/io/File::new (ffi.as_string path)) (ffi.as_boolean <flag>)) - _ (java/io/OutputStream::write data stream) - _ (java/io/OutputStream::flush stream)] - (java/lang/AutoCloseable::close stream)))] - - [#0 write] - [#1 append] - )) - - (def: (move origin destination) - (|> origin - ffi.as_string - java/io/File::new - (java/io/File::renameTo (java/io/File::new (ffi.as_string destination))))) - )))] + (java/io/File::renameTo (java/io/File::new (ffi.as_string destination))))) + ))))] (for @.old (these <for_jvm>) @.jvm (these <for_jvm>) @@ -548,87 +548,87 @@ (def: python_separator (os/path::sep)) - (`` (implementation: .public default + (`` (def: .public default (System IO) - - (def: separator - ..python_separator) - - (~~ (with_template [<name> <method>] - [(def: <name> - (|>> <method> - (io#each (|>> (try.else false)))))] - - [file? os/path::isfile] - [directory? os/path::isdir] - )) - - (def: make_directory - os::mkdir) - - (~~ (with_template [<name> <method>] - [(def: (<name> path) - (let [! (try.with io.monad)] - (|> path - os::listdir - (at ! each (|>> (array.list {.#None}) - (list#each (|>> (format path ..python_separator))) - (monad.each ! (function (_ sub) - (at ! each (|>> [sub]) (<method> sub)))) - (at ! each (|>> (list.only product.right) - (list#each product.left))))) - (at ! conjoint))))] - - [directory_files os/path::isfile] - [sub_directories os/path::isdir] - )) - - (def: file_size - (|>> os/path::getsize - (at (try.with io.monad) each (|>> .nat)))) - - (def: last_modified - (|>> os/path::getmtime - (at (try.with io.monad) each (|>> f.int - (i.* +1,000) - duration.of_millis - instant.absolute)))) - - (def: (can_execute? path) - (os::access path (os::X_OK))) - - (def: (read path) - (do (try.with io.monad) - [file (..open path "rb") - data (PyFile::read file) - _ (PyFile::close file)] - (in data))) - - (def: (delete path) - (do (try.with io.monad) - [? (os/path::isfile path)] - (if ? - (os::remove path) - (os::rmdir path)))) - - (def: (modify path time_stamp) - (let [when (|> time_stamp instant.relative duration.millis (i./ +1,000))] - (os::utime path (..tuple [when when])))) - - (~~ (with_template [<name> <mode>] - [(def: (<name> path data) - (do (try.with io.monad) - [file (..open path <mode>) - _ (PyFile::write data file)] - (PyFile::close file)))] - - [write "w+b"] - [append "ab"] - )) - - (def: (move origin destination) - (os::rename origin destination)) - ))) + (implementation + (def: separator + ..python_separator) + + (~~ (with_template [<name> <method>] + [(def: <name> + (|>> <method> + (io#each (|>> (try.else false)))))] + + [file? os/path::isfile] + [directory? os/path::isdir] + )) + + (def: make_directory + os::mkdir) + + (~~ (with_template [<name> <method>] + [(def: (<name> path) + (let [! (try.with io.monad)] + (|> path + os::listdir + (at ! each (|>> (array.list {.#None}) + (list#each (|>> (format path ..python_separator))) + (monad.each ! (function (_ sub) + (at ! each (|>> [sub]) (<method> sub)))) + (at ! each (|>> (list.only product.right) + (list#each product.left))))) + (at ! conjoint))))] + + [directory_files os/path::isfile] + [sub_directories os/path::isdir] + )) + + (def: file_size + (|>> os/path::getsize + (at (try.with io.monad) each (|>> .nat)))) + + (def: last_modified + (|>> os/path::getmtime + (at (try.with io.monad) each (|>> f.int + (i.* +1,000) + duration.of_millis + instant.absolute)))) + + (def: (can_execute? path) + (os::access path (os::X_OK))) + + (def: (read path) + (do (try.with io.monad) + [file (..open path "rb") + data (PyFile::read file) + _ (PyFile::close file)] + (in data))) + + (def: (delete path) + (do (try.with io.monad) + [? (os/path::isfile path)] + (if ? + (os::remove path) + (os::rmdir path)))) + + (def: (modify path time_stamp) + (let [when (|> time_stamp instant.relative duration.millis (i./ +1,000))] + (os::utime path (..tuple [when when])))) + + (~~ (with_template [<name> <mode>] + [(def: (<name> path data) + (do (try.with io.monad) + [file (..open path <mode>) + _ (PyFile::write data file)] + (PyFile::close file)))] + + [write "w+b"] + [append "ab"] + )) + + (def: (move origin destination) + (os::rename origin destination)) + )))) @.ruby (these (ffi.import Time @@ -674,108 +674,108 @@ Text (..RubyFile::SEPARATOR)) - (`` (implementation: .public default + (`` (def: .public default (System IO) - - (def: separator - ..ruby_separator) - - (~~ (with_template [<name> <test>] - [(def: <name> - (|>> <test> - (io#each (|>> (try.else false)))))] - - [file? RubyFile::file?] - [directory? RubyFile::directory?] - )) - - (def: make_directory - FileUtils::mkdir) - - (~~ (with_template [<name> <test>] - [(def: (<name> path) - (do [! (try.with io.monad)] - [self (Dir::open path) - children (Dir::children self) - output (loop (again [input (|> children - (array.list {.#None}) - (list#each (|>> (format path ..ruby_separator)))) - output (is (List ..Path) - (list))]) - (case input - {.#End} - (in output) - - {.#Item head tail} - (do ! - [verdict (<test> head)] - (again tail (if verdict - {.#Item head output} - output))))) - _ (Dir::close self)] - (in output)))] - - [directory_files RubyFile::file?] - [sub_directories RubyFile::directory?] - )) - - (~~ (with_template [<name> <pipeline>] - [(def: <name> - (let [! (try.with io.monad)] - (|>> RubyFile::stat - (at ! each (`` (|>> (~~ (template.spliced <pipeline>))))))))] - - [file_size [Stat::size .nat]] - [last_modified [Stat::mtime - Time::to_f - (f.* +1,000.0) - f.int - duration.of_millis - instant.absolute]] - [can_execute? [Stat::executable?]] - )) - - (def: (read path) - (do (try.with io.monad) - [file (RubyFile::open path "rb") - data (RubyFile::read file) - _ (RubyFile::close file)] - (in data))) - - (def: (delete path) - (do (try.with io.monad) - [? (RubyFile::file? path)] - (if ? - (RubyFile::delete path) - (FileUtils::rmdir path)))) - - (def: (modify path moment) - (let [moment (|> moment - instant.relative - duration.millis - i.frac - (f./ +1,000.0) - Time::at)] - (RubyFile::utime moment moment path))) - - (~~ (with_template [<mode> <name>] - [(def: (<name> path data) - (do [! (try.with io.monad)] - [file (RubyFile::open path <mode>) - data (RubyFile::write data file) - _ (RubyFile::flush file) - _ (RubyFile::close file)] - (in [])))] - - ["wb" write] - ["ab" append] - )) - - (def: (move origin destination) - (do (try.with io.monad) - [_ (FileUtils::move origin destination)] - (in []))) - ))) + (implementation + (def: separator + ..ruby_separator) + + (~~ (with_template [<name> <test>] + [(def: <name> + (|>> <test> + (io#each (|>> (try.else false)))))] + + [file? RubyFile::file?] + [directory? RubyFile::directory?] + )) + + (def: make_directory + FileUtils::mkdir) + + (~~ (with_template [<name> <test>] + [(def: (<name> path) + (do [! (try.with io.monad)] + [self (Dir::open path) + children (Dir::children self) + output (loop (again [input (|> children + (array.list {.#None}) + (list#each (|>> (format path ..ruby_separator)))) + output (is (List ..Path) + (list))]) + (case input + {.#End} + (in output) + + {.#Item head tail} + (do ! + [verdict (<test> head)] + (again tail (if verdict + {.#Item head output} + output))))) + _ (Dir::close self)] + (in output)))] + + [directory_files RubyFile::file?] + [sub_directories RubyFile::directory?] + )) + + (~~ (with_template [<name> <pipeline>] + [(def: <name> + (let [! (try.with io.monad)] + (|>> RubyFile::stat + (at ! each (`` (|>> (~~ (template.spliced <pipeline>))))))))] + + [file_size [Stat::size .nat]] + [last_modified [Stat::mtime + Time::to_f + (f.* +1,000.0) + f.int + duration.of_millis + instant.absolute]] + [can_execute? [Stat::executable?]] + )) + + (def: (read path) + (do (try.with io.monad) + [file (RubyFile::open path "rb") + data (RubyFile::read file) + _ (RubyFile::close file)] + (in data))) + + (def: (delete path) + (do (try.with io.monad) + [? (RubyFile::file? path)] + (if ? + (RubyFile::delete path) + (FileUtils::rmdir path)))) + + (def: (modify path moment) + (let [moment (|> moment + instant.relative + duration.millis + i.frac + (f./ +1,000.0) + Time::at)] + (RubyFile::utime moment moment path))) + + (~~ (with_template [<mode> <name>] + [(def: (<name> path data) + (do [! (try.with io.monad)] + [file (RubyFile::open path <mode>) + data (RubyFile::write data file) + _ (RubyFile::flush file) + _ (RubyFile::close file)] + (in [])))] + + ["wb" write] + ["ab" append] + )) + + (def: (move origin destination) + (do (try.with io.monad) + [_ (FileUtils::move origin destination)] + (in []))) + )))) ... @.php ... (these (ffi.import (FILE_APPEND Int)) @@ -818,143 +818,143 @@ ... [cannot_write_to_file] ... ) - ... (`` (implementation: (file path) + ... (`` (def: (file path) ... (-> Path (File IO)) - - ... (~~ (with_template [<name> <mode>] - ... [(def: (<name> data) - ... (do [! (try.with io.monad)] - ... [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] - ... (if (bit#= false (as Bit outcome)) - ... (at io.monad in (exception.except ..cannot_write_to_file [path])) - ... (in []))))] + ... (implementation + ... (~~ (with_template [<name> <mode>] + ... [(def: (<name> data) + ... (do [! (try.with io.monad)] + ... [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] + ... (if (bit#= false (as Bit outcome)) + ... (at io.monad in (exception.except ..cannot_write_to_file [path])) + ... (in []))))] - ... [over_write +0] - ... [append (..FILE_APPEND)] - ... )) - - ... (def: (content _) - ... (do [! (try.with io.monad)] - ... [data (..file_get_contents [path])] - ... (if (bit#= false (as Bit data)) - ... (at io.monad in (exception.except ..cannot_find_file [path])) - ... (in (..unpack [..byte_array_format data]))))) - - ... (def: path - ... path) - - ... (~~ (with_template [<name> <ffi> <pipeline>] - ... [(def: (<name> _) - ... (do [! (try.with io.monad)] - ... [value (<ffi> [path])] - ... (if (bit#= false (as Bit value)) - ... (at io.monad in (exception.except ..cannot_find_file [path])) - ... (in (`` (|> value (~~ (template.spliced <pipeline>))))))))] - - ... [size ..filesize [.nat]] - ... [last_modified ..filemtime [(i.* +1,000) duration.of_millis instant.absolute]] - ... )) - - ... (def: (can_execute? _) - ... (..is_executable [path])) - - ... (def: (modify moment) - ... (do [! (try.with io.monad)] - ... [verdict (..touch [path (|> moment instant.relative duration.millis (i./ +1,000))])] - ... (if (bit#= false (as Bit verdict)) - ... (at io.monad in (exception.except ..cannot_find_file [path])) - ... (in [])))) - - ... (def: (move destination) - ... (do [! (try.with io.monad)] - ... [verdict (..rename [path destination])] - ... (if (bit#= false (as Bit verdict)) - ... (at io.monad in (exception.except ..cannot_find_file [path])) - ... (in (file destination))))) - - ... (def: (delete _) - ... (do (try.with io.monad) - ... [verdict (..unlink [path])] - ... (if (bit#= false (as Bit verdict)) - ... (at io.monad in (exception.except ..cannot_find_file [path])) - ... (in [])))) - ... )) - - ... (`` (implementation: (directory path) + ... [over_write +0] + ... [append (..FILE_APPEND)] + ... )) + + ... (def: (content _) + ... (do [! (try.with io.monad)] + ... [data (..file_get_contents [path])] + ... (if (bit#= false (as Bit data)) + ... (at io.monad in (exception.except ..cannot_find_file [path])) + ... (in (..unpack [..byte_array_format data]))))) + + ... (def: path + ... path) + + ... (~~ (with_template [<name> <ffi> <pipeline>] + ... [(def: (<name> _) + ... (do [! (try.with io.monad)] + ... [value (<ffi> [path])] + ... (if (bit#= false (as Bit value)) + ... (at io.monad in (exception.except ..cannot_find_file [path])) + ... (in (`` (|> value (~~ (template.spliced <pipeline>))))))))] + + ... [size ..filesize [.nat]] + ... [last_modified ..filemtime [(i.* +1,000) duration.of_millis instant.absolute]] + ... )) + + ... (def: (can_execute? _) + ... (..is_executable [path])) + + ... (def: (modify moment) + ... (do [! (try.with io.monad)] + ... [verdict (..touch [path (|> moment instant.relative duration.millis (i./ +1,000))])] + ... (if (bit#= false (as Bit verdict)) + ... (at io.monad in (exception.except ..cannot_find_file [path])) + ... (in [])))) + + ... (def: (move destination) + ... (do [! (try.with io.monad)] + ... [verdict (..rename [path destination])] + ... (if (bit#= false (as Bit verdict)) + ... (at io.monad in (exception.except ..cannot_find_file [path])) + ... (in (file destination))))) + + ... (def: (delete _) + ... (do (try.with io.monad) + ... [verdict (..unlink [path])] + ... (if (bit#= false (as Bit verdict)) + ... (at io.monad in (exception.except ..cannot_find_file [path])) + ... (in [])))) + ... ))) + + ... (`` (def: (directory path) ... (-> Path (Directory IO)) - - ... (def: scope - ... path) - - ... (~~ (with_template [<name> <test> <constructor> <capability>] - ... [(def: (<name> _) - ... (do [! (try.with io.monad)] - ... [children (..scandir [path])] - ... (loop (again [input (|> children - ... (array.list {.#None}) - ... (list.only (function (_ child) - ... (not (or (text#= "." child) - ... (text#= ".." child)))))) - ... output (is (List (<capability> IO)) - ... (list))]) - ... (case input - ... {.#End} - ... (in output) - - ... {.#Item head tail} - ... (do ! - ... [verdict (<test> head)] - ... (if verdict - ... (again tail {.#Item (<constructor> head) output}) - ... (again tail output)))))))] - - ... [files ..is_file ..file File] - ... [directories ..is_dir directory Directory] - ... )) - - ... (def: (discard _) - ... (do (try.with io.monad) - ... [verdict (..rmdir [path])] - ... (if (bit#= false (as Bit verdict)) - ... (at io.monad in (exception.except ..cannot_find_directory [path])) - ... (in [])))) - ... )) - - ... (`` (implementation: .public default + ... (implementation + ... (def: scope + ... path) + + ... (~~ (with_template [<name> <test> <constructor> <capability>] + ... [(def: (<name> _) + ... (do [! (try.with io.monad)] + ... [children (..scandir [path])] + ... (loop (again [input (|> children + ... (array.list {.#None}) + ... (list.only (function (_ child) + ... (not (or (text#= "." child) + ... (text#= ".." child)))))) + ... output (is (List (<capability> IO)) + ... (list))]) + ... (case input + ... {.#End} + ... (in output) + + ... {.#Item head tail} + ... (do ! + ... [verdict (<test> head)] + ... (if verdict + ... (again tail {.#Item (<constructor> head) output}) + ... (again tail output)))))))] + + ... [files ..is_file ..file File] + ... [directories ..is_dir directory Directory] + ... )) + + ... (def: (discard _) + ... (do (try.with io.monad) + ... [verdict (..rmdir [path])] + ... (if (bit#= false (as Bit verdict)) + ... (at io.monad in (exception.except ..cannot_find_directory [path])) + ... (in [])))) + ... ))) + + ... (`` (def: .public default ... (System IO) - - ... (~~ (with_template [<name> <test> <constructor> <exception>] - ... [(def: (<name> path) - ... (do [! (try.with io.monad)] - ... [verdict (<test> path)] - ... (at io.monad in - ... (if verdict - ... {try.#Success (<constructor> path)} - ... (exception.except <exception> [path])))))] - - ... [file ..is_file ..file ..cannot_find_file] - ... [directory ..is_dir ..directory ..cannot_find_directory] - ... )) - - ... (def: (make_file path) - ... (do [! (try.with io.monad)] - ... [verdict (..touch [path (|> instant.now io.run! instant.relative duration.millis (i./ +1,000))])] - ... (at io.monad in - ... (if verdict - ... {try.#Success (..file path)} - ... (exception.except ..cannot_make_file [path]))))) + ... (implementation + ... (~~ (with_template [<name> <test> <constructor> <exception>] + ... [(def: (<name> path) + ... (do [! (try.with io.monad)] + ... [verdict (<test> path)] + ... (at io.monad in + ... (if verdict + ... {try.#Success (<constructor> path)} + ... (exception.except <exception> [path])))))] + + ... [file ..is_file ..file ..cannot_find_file] + ... [directory ..is_dir ..directory ..cannot_find_directory] + ... )) + + ... (def: (make_file path) + ... (do [! (try.with io.monad)] + ... [verdict (..touch [path (|> instant.now io.run! instant.relative duration.millis (i./ +1,000))])] + ... (at io.monad in + ... (if verdict + ... {try.#Success (..file path)} + ... (exception.except ..cannot_make_file [path]))))) - ... (def: (make_directory path) - ... (do [! (try.with io.monad)] - ... [verdict (..mkdir path)] - ... (at io.monad in - ... (if verdict - ... {try.#Success (..directory path)} - ... (exception.except ..cannot_make_directory [path]))))) - - ... (def: separator - ... ..default_separator) - ... )) + ... (def: (make_directory path) + ... (do [! (try.with io.monad)] + ... [verdict (..mkdir path)] + ... (at io.monad in + ... (if verdict + ... {try.#Success (..directory path)} + ... (exception.except ..cannot_make_directory [path]))))) + + ... (def: separator + ... ..default_separator) + ... ))) ... ) (these))) diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index b7fd25d65..2decbe412 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -188,58 +188,58 @@ {.#None} (in headers))))) - (implementation: .public default + (def: .public default (Client IO) - - (def: (request method url headers data) - (is (IO (Try (//.Response IO))) - (do [! (try.with io.monad)] - [connection (|> url ffi.as_string java/net/URL::new java/net/URL::openConnection) - .let [connection (as java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod (ffi.as_string (..jvm_method method)) connection) - _ (monad.each ! (function (_ [name value]) - (java/net/URLConnection::setRequestProperty (ffi.as_string name) (ffi.as_string value) connection)) - (dictionary.entries headers)) - _ (case data - {.#Some data} - (do ! - [_ (java/net/URLConnection::setDoOutput true connection) - stream (java/net/URLConnection::getOutputStream connection) - _ (java/io/OutputStream::write data stream) - _ (java/io/OutputStream::flush stream) - _ (java/lang/AutoCloseable::close stream)] - (in [])) - - {.#None} - (in [])) - status (java/net/HttpURLConnection::getResponseCode connection) - headers (..default_headers connection) - input (|> connection - java/net/URLConnection::getInputStream - (at ! each (|>> java/io/BufferedInputStream::new)))] - (in [(.nat (ffi.of_int status)) - [//.#headers headers - //.#body (..default_body input)]]))))))] + (implementation + (def: (request method url headers data) + (is (IO (Try (//.Response IO))) + (do [! (try.with io.monad)] + [connection (|> url ffi.as_string java/net/URL::new java/net/URL::openConnection) + .let [connection (as java/net/HttpURLConnection connection)] + _ (java/net/HttpURLConnection::setRequestMethod (ffi.as_string (..jvm_method method)) connection) + _ (monad.each ! (function (_ [name value]) + (java/net/URLConnection::setRequestProperty (ffi.as_string name) (ffi.as_string value) connection)) + (dictionary.entries headers)) + _ (case data + {.#Some data} + (do ! + [_ (java/net/URLConnection::setDoOutput true connection) + stream (java/net/URLConnection::getOutputStream connection) + _ (java/io/OutputStream::write data stream) + _ (java/io/OutputStream::flush stream) + _ (java/lang/AutoCloseable::close stream)] + (in [])) + + {.#None} + (in [])) + status (java/net/HttpURLConnection::getResponseCode connection) + headers (..default_headers connection) + input (|> connection + java/net/URLConnection::getInputStream + (at ! each (|>> java/io/BufferedInputStream::new)))] + (in [(.nat (ffi.of_int status)) + [//.#headers headers + //.#body (..default_body input)]])))))))] (for @.old (these <jvm>) @.jvm (these <jvm>) (these))) -(implementation: .public (async client) +(def: .public (async client) (-> (Client IO) (Client Async)) - - (def: (request method url headers data) - (|> (at client request method url headers data) - async.future - (at async.monad each - (|>> (pipe.case - {try.#Success [status message]} - {try.#Success [status (revised //.#body (is (-> (//.Body IO) (//.Body Async)) - (function (_ body) - (|>> body async.future))) - message)]} - - {try.#Failure error} - {try.#Failure error})))))) + (implementation + (def: (request method url headers data) + (|> (at client request method url headers data) + async.future + (at async.monad each + (|>> (pipe.case + {try.#Success [status message]} + {try.#Success [status (revised //.#body (is (-> (//.Body IO) (//.Body Async)) + (function (_ body) + (|>> body async.future))) + message)]} + + {try.#Failure error} + {try.#Failure error}))))))) (def: .public headers (-> (List [Text Text]) //.Headers) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 4c2a210b8..b042258fb 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -70,25 +70,25 @@ {.#None}))) (dictionary.of_list text.hash))))) -(`` (implementation: .public (async program) +(`` (def: .public (async program) (-> (Program IO) (Program Async)) + (implementation + (~~ (with_template [<method>] + [(def: <method> + (at program <method>))] - (~~ (with_template [<method>] - [(def: <method> - (at program <method>))] + [home] + [directory] + )) - [home] - [directory] - )) + (~~ (with_template [<method>] + [(def: <method> + (|>> (at program <method>) async.future))] - (~~ (with_template [<method>] - [(def: <method> - (|>> (at program <method>) async.future))] - - [available_variables] - [variable] - [exit] - )))) + [available_variables] + [variable] + [exit] + ))))) (def: .public (mock environment home directory) (-> Environment Path Path (Program IO)) @@ -283,158 +283,158 @@ (these))) -(implementation: .public default +(def: .public default (Program IO) - - (def: (available_variables _) - (with_expansions [<jvm> (|> (java/lang/System::getenv) - java/util/Map::keySet - java/util/Set::iterator - ..jvm::consume - (list#each (|>> ffi.of_string)) - io.io)] - (for @.old <jvm> - @.jvm <jvm> - @.js (io.io (if ffi.on_node_js? - (case (ffi.global Object [process env]) - {.#Some process/env} - (|> (Object::entries [process/env]) - (array.list {.#None}) - (list#each (|>> (array.item 0) maybe.trusted))) - - {.#None} - (list)) - (list))) - @.python (at io.monad each (array.list {.#None}) (os/environ::keys [])) - ... Lua offers no way to get all the environment variables available. - @.lua (io.io (list)) - @.ruby (io.io (array.list {.#None} (Env::keys []))) - ... @.php (do io.monad - ... [environment (..getenv/0 [])] - ... (in (|> environment - ... ..array_keys - ... (array.list {.#None}) - ... (list#each (function (_ variable) - ... [variable ("php array read" (as Nat variable) environment)])) - ... (dictionary.of_list text.hash)))) - ... @.scheme (do io.monad - ... [input (..get-environment-variables [])] - ... (loop (again [input input - ... output environment.empty]) - ... (if ("scheme object nil?" input) - ... (in output) - ... (let [entry (..head input)] - ... (again (..tail input) - ... (dictionary.has (..car entry) (..cdr entry) output)))))) - ))) - - (def: (variable name) - (template.let [(!fetch <method> <post>) - [(do io.monad - [value (|> name <method>)] - (in (case value - {.#Some value} - {try.#Success (<post> value)} + (implementation + (def: (available_variables _) + (with_expansions [<jvm> (|> (java/lang/System::getenv) + java/util/Map::keySet + java/util/Set::iterator + ..jvm::consume + (list#each (|>> ffi.of_string)) + io.io)] + (for @.old <jvm> + @.jvm <jvm> + @.js (io.io (if ffi.on_node_js? + (case (ffi.global Object [process env]) + {.#Some process/env} + (|> (Object::entries [process/env]) + (array.list {.#None}) + (list#each (|>> (array.item 0) maybe.trusted))) {.#None} - (exception.except ..unknown_environment_variable [name]))))]] - (with_expansions [<jvm> (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)] - (for @.old <jvm> - @.jvm <jvm> - @.js (io.io (if ffi.on_node_js? - (case (do maybe.monad - [process/env (ffi.global Object [process env])] - (array.item (as Nat name) - (as (Array Text) process/env))) + (list)) + (list))) + @.python (at io.monad each (array.list {.#None}) (os/environ::keys [])) + ... Lua offers no way to get all the environment variables available. + @.lua (io.io (list)) + @.ruby (io.io (array.list {.#None} (Env::keys []))) + ... @.php (do io.monad + ... [environment (..getenv/0 [])] + ... (in (|> environment + ... ..array_keys + ... (array.list {.#None}) + ... (list#each (function (_ variable) + ... [variable ("php array read" (as Nat variable) environment)])) + ... (dictionary.of_list text.hash)))) + ... @.scheme (do io.monad + ... [input (..get-environment-variables [])] + ... (loop (again [input input + ... output environment.empty]) + ... (if ("scheme object nil?" input) + ... (in output) + ... (let [entry (..head input)] + ... (again (..tail input) + ... (dictionary.has (..car entry) (..cdr entry) output)))))) + ))) + + (def: (variable name) + (template.let [(!fetch <method> <post>) + [(do io.monad + [value (|> name <method>)] + (in (case value {.#Some value} - {try.#Success value} + {try.#Success (<post> value)} {.#None} - (exception.except ..unknown_environment_variable [name])) - (exception.except ..unknown_environment_variable [name]))) - @.python (!fetch os/environ::get |>) - @.lua (!fetch os/getenv |>) - @.ruby (!fetch Env::fetch |>) - )))) - - (def: home - (io.run! - (with_expansions [<default> (io.io "~") - <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.home")) - (maybe#each (|>> ffi.of_string)) - (maybe.else "") - io.io)] - (for @.old <jvm> - @.jvm <jvm> - @.js (if ffi.on_node_js? - (|> (node_js.require "os") - maybe.trusted - (as NodeJs_OS) - NodeJs_OS::homedir) - <default>) - @.python (os/path::expanduser "~") - @.lua (..run_command "~" "echo ~") - @.ruby (io.io (Dir::home)) - ... @.php (do io.monad - ... [output (..getenv/1 ["HOME"])] - ... (in (if (bit#= false (as Bit output)) - ... "~" - ... output))) - - ... TODO: Replace dummy implementation. - <default>)))) - - (def: directory - (io.run! - (with_expansions [<default> "." - <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.dir")) - (maybe#each (|>> ffi.of_string)) - (maybe.else "") - io.io)] + (exception.except ..unknown_environment_variable [name]))))]] + (with_expansions [<jvm> (!fetch (<| java/lang/System::resolveEnv ffi.as_string) ffi.of_string)] + (for @.old <jvm> + @.jvm <jvm> + @.js (io.io (if ffi.on_node_js? + (case (do maybe.monad + [process/env (ffi.global Object [process env])] + (array.item (as Nat name) + (as (Array Text) process/env))) + {.#Some value} + {try.#Success value} + + {.#None} + (exception.except ..unknown_environment_variable [name])) + (exception.except ..unknown_environment_variable [name]))) + @.python (!fetch os/environ::get |>) + @.lua (!fetch os/getenv |>) + @.ruby (!fetch Env::fetch |>) + )))) + + (def: home + (io.run! + (with_expansions [<default> (io.io "~") + <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.home")) + (maybe#each (|>> ffi.of_string)) + (maybe.else "") + io.io)] + (for @.old <jvm> + @.jvm <jvm> + @.js (if ffi.on_node_js? + (|> (node_js.require "os") + maybe.trusted + (as NodeJs_OS) + NodeJs_OS::homedir) + <default>) + @.python (os/path::expanduser "~") + @.lua (..run_command "~" "echo ~") + @.ruby (io.io (Dir::home)) + ... @.php (do io.monad + ... [output (..getenv/1 ["HOME"])] + ... (in (if (bit#= false (as Bit output)) + ... "~" + ... output))) + + ... TODO: Replace dummy implementation. + <default>)))) + + (def: directory + (io.run! + (with_expansions [<default> "." + <jvm> (|> (java/lang/System::getProperty (ffi.as_string "user.dir")) + (maybe#each (|>> ffi.of_string)) + (maybe.else "") + io.io)] + (for @.old <jvm> + @.jvm <jvm> + @.js (if ffi.on_node_js? + (case (ffi.global ..NodeJs_Process [process]) + {.#Some process} + (NodeJs_Process::cwd process) + + {.#None} + (io.io <default>)) + (io.io <default>)) + @.python (os::getcwd []) + @.lua (do io.monad + [.let [default <default>] + on_windows (..run_command default "cd")] + (if (same? default on_windows) + (..run_command default "pwd") + (in on_windows))) + @.ruby (io.io (FileUtils::pwd)) + ... @.php (do io.monad + ... [output (..getcwd [])] + ... (in (if (bit#= false (as Bit output)) + ... "." + ... output))) + + ... TODO: Replace dummy implementation. + (io.io <default>))))) + + (def: (exit code) + (with_expansions [<jvm> (do io.monad + [_ (java/lang/System::exit (ffi.as_int code))] + (in (undefined)))] (for @.old <jvm> @.jvm <jvm> - @.js (if ffi.on_node_js? - (case (ffi.global ..NodeJs_Process [process]) - {.#Some process} - (NodeJs_Process::cwd process) - - {.#None} - (io.io <default>)) - (io.io <default>)) - @.python (os::getcwd []) - @.lua (do io.monad - [.let [default <default>] - on_windows (..run_command default "cd")] - (if (same? default on_windows) - (..run_command default "pwd") - (in on_windows))) - @.ruby (io.io (FileUtils::pwd)) - ... @.php (do io.monad - ... [output (..getcwd [])] - ... (in (if (bit#= false (as Bit output)) - ... "." - ... output))) - - ... TODO: Replace dummy implementation. - (io.io <default>))))) - - (def: (exit code) - (with_expansions [<jvm> (do io.monad - [_ (java/lang/System::exit (ffi.as_int code))] - (in (undefined)))] - (for @.old <jvm> - @.jvm <jvm> - @.js (cond ffi.on_node_js? - (..exit_node_js! code) - - ffi.on_browser? - (..exit_browser! code) - - ... else - (..default_exit! code)) - @.python (os::_exit code) - @.lua (os/exit code) - @.ruby (Kernel::exit code) - ... @.php (..exit [code]) - ... @.scheme (..exit [code]) - )))) + @.js (cond ffi.on_node_js? + (..exit_node_js! code) + + ffi.on_browser? + (..exit_browser! code) + + ... else + (..default_exit! code)) + @.python (os::_exit code) + @.lua (os/exit code) + @.ruby (Kernel::exit code) + ... @.php (..exit [code]) + ... @.scheme (..exit [code]) + ))))) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 0c648c17d..b4c466c77 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -291,21 +291,21 @@ (|>> java/lang/String::toLowerCase ffi.of_string (text.starts_with? "windows")) (java/lang/System::getProperty (ffi.as_string "os.name")))) - (implementation: .public default + (def: .public default (Shell IO) - - (def: (execute [environment working_directory the_command arguments]) - (do [! (try.with io.monad)] - [.let [builder (|> (partial_list the_command arguments) - ..jvm::arguments_array - java/lang/ProcessBuilder::new - (java/lang/ProcessBuilder::directory (java/io/File::new (ffi.as_string working_directory))))] - _ (|> builder - java/lang/ProcessBuilder::environment - (at try.functor each (..jvm::load_environment environment)) - (at io.monad in)) - process (java/lang/ProcessBuilder::start builder)] - (..default_process process)))) + (implementation + (def: (execute [environment working_directory the_command arguments]) + (do [! (try.with io.monad)] + [.let [builder (|> (partial_list the_command arguments) + ..jvm::arguments_array + java/lang/ProcessBuilder::new + (java/lang/ProcessBuilder::directory (java/io/File::new (ffi.as_string working_directory))))] + _ (|> builder + java/lang/ProcessBuilder::environment + (at try.functor each (..jvm::load_environment environment)) + (at io.monad in)) + process (java/lang/ProcessBuilder::start builder)] + (..default_process process))))) )] (for @.old (these <jvm>) @.jvm (these <jvm>) @@ -324,57 +324,57 @@ (is (-> s (Try [s Exit])) on_await))) -(`` (implementation: (mock_process state mock) +(`` (def: (mock_process state mock) (All (_ s) (-> (Atom s) (Mock s) (Process IO))) - - (~~ (with_template [<name> <mock>] - [(def: (<name> _) - (do [! io.monad] - [|state| (atom.read! state)] - (case (at mock <mock> |state|) - {try.#Success [|state| output]} - (do ! - [_ (atom.write! |state| state)] - (in {try.#Success output})) - - {try.#Failure error} - (in {try.#Failure error}))))] - - [read on_read] - [fail on_fail] - [await on_await] - )) - (def: (write message) - (do [! io.monad] - [|state| (atom.read! state)] - (case (at mock on_write message |state|) - {try.#Success |state|} - (do ! - [_ (atom.write! |state| state)] - (in {try.#Success []})) - - {try.#Failure error} - (in {try.#Failure error})))) - (def: (destroy _) - (do [! io.monad] - [|state| (atom.read! state)] - (case (at mock on_destroy |state|) - {try.#Success |state|} - (do ! - [_ (atom.write! |state| state)] - (in {try.#Success []})) - - {try.#Failure error} - (in {try.#Failure error})))))) - -(implementation: .public (mock mock init) + (implementation + (~~ (with_template [<name> <mock>] + [(def: (<name> _) + (do [! io.monad] + [|state| (atom.read! state)] + (case (at mock <mock> |state|) + {try.#Success [|state| output]} + (do ! + [_ (atom.write! |state| state)] + (in {try.#Success output})) + + {try.#Failure error} + (in {try.#Failure error}))))] + + [read on_read] + [fail on_fail] + [await on_await] + )) + (def: (write message) + (do [! io.monad] + [|state| (atom.read! state)] + (case (at mock on_write message |state|) + {try.#Success |state|} + (do ! + [_ (atom.write! |state| state)] + (in {try.#Success []})) + + {try.#Failure error} + (in {try.#Failure error})))) + (def: (destroy _) + (do [! io.monad] + [|state| (atom.read! state)] + (case (at mock on_destroy |state|) + {try.#Success |state|} + (do ! + [_ (atom.write! |state| state)] + (in {try.#Success []})) + + {try.#Failure error} + (in {try.#Failure error}))))))) + +(def: .public (mock mock init) (All (_ s) (-> (-> [Environment Path Command (List Argument)] (Try (Mock s))) s (Shell IO))) - - (def: execute - (|>> mock - (at try.monad each (..mock_process (atom.atom init))) - io.io))) + (implementation + (def: execute + (|>> mock + (at try.monad each (..mock_process (atom.atom init))) + io.io)))) |