diff options
53 files changed, 622 insertions, 445 deletions
diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index 642f42018..0f841ba96 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -79,7 +79,7 @@ (let [output (host.array java/lang/String (list.size values))] (exec (list@map (function (_ [idx value]) (host.array-write idx value output)) - (list.enumerate values)) + (list.enumeration values)) output))) (def: (version-flag version) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index f0de62d52..26db95ac1 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -998,7 +998,7 @@ set.to-list) global-mapping (|> total-environment ## Give them names as "foreign" variables. - list.enumerate + list.enumeration (list@map (function (_ [id capture]) [capture (#variable.Foreign id)])) (dictionary.from-list synthesis.hash)) @@ -1008,7 +1008,7 @@ self-name arguments returnT exceptionsT body]]) (let [local-mapping (|> environment - list.enumerate + list.enumeration (list@map (function (_ [foreign-id capture]) [(synthesis.variable/foreign foreign-id) (|> global-mapping diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 2a792612c..97b32f8c2 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -201,7 +201,7 @@ @labels (list@map $.new-label (list.repeat num-partials [])) over-extent (|> (.int function-arity) (i.- (.int apply-arity))) casesI (|> (list@compose @labels (list @default)) - (list.zip2 (enum.range n.enum 0 num-partials)) + (list.zip/2 (enum.range n.enum 0 num-partials)) (list@map (.function (_ [stage @label]) (let [load-partialsI (if (n.> 0 stage) (|> (enum.range n.enum 0 (dec stage)) @@ -259,7 +259,7 @@ (def: #export with-environment (-> (Environment Synthesis) Def) - (|>> list.enumerate + (|>> list.enumeration (list@map (.function (_ [env-idx env-source]) (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value))) def.fuse)) @@ -324,7 +324,7 @@ [functionI (generate archive functionS) argsI (monad.map @ (generate archive) argsS) #let [applyI (|> argsI - (list.split-all //runtime.num-apply-variants) + (list.chunk //runtime.num-apply-variants) (list@map (.function (_ chunkI+) (|>> (_.CHECKCAST //.$Function) (_.fuse chunkI+) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux index 27a7d58f9..1d22b0e63 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux @@ -39,7 +39,7 @@ (do {@ phase.monad} [[@begin start] generation.anchor #let [pairs (|> argsS - list.enumerate + list.enumeration (list@map (function (_ [register argument]) [(n.+ start register) argument])))] ## It may look weird that first I compile the values separately, @@ -73,7 +73,7 @@ initsI+ (monad.map @ (translate archive) initsS+) iterationI (generation.with-anchor [@begin start] (translate archive iterationS)) - #let [initializationI (|> (list.enumerate initsI+) + #let [initializationI (|> (list.enumeration initsI+) (list@map (function (_ [register initI]) (|>> initI (_.ASTORE (n.+ start register))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index 4a4c30e0f..c268cb14a 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -47,7 +47,7 @@ _ (phase.assert not-a-tuple size (n.>= 2 size)) membersI (|> members - list.enumerate + list.enumeration (monad.map @ (function (_ [idx member]) (do @ [memberI (generate archive member)] diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index f8458caf3..3c423692a 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -53,11 +53,11 @@ [(Promise [a Mailbox]) (Resolver [a Mailbox])]) (IO (List a)))) - (do {@ io.monad} + (do {! io.monad} [current (promise.poll read)] (case current (#.Some [head tail]) - (:: @ map (|>> (#.Cons head)) + (:: ! map (|>> (#.Cons head)) (pending tail)) #.None @@ -99,12 +99,12 @@ (promise.promise [])) process (loop [state init [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] - (do {@ promise.monad} + (do {! promise.monad} [[head tail] |mailbox| ?state' (handle head state self)] (case ?state' (#try.Failure error) - (do @ + (do ! [_ (end error state)] (let [[_ resolve] (get@ #obituary (:representation self))] (exec (io.run @@ -137,21 +137,21 @@ (def: #export (send message actor) {#.doc "Communicate with an actor through message passing."} (All [s] (-> (Message s) (Actor s) (IO Bit))) - (do {@ io.monad} + (do {! io.monad} [alive? (..alive? actor)] (if alive? (let [entry [message (promise.promise [])]] - (do @ + (do ! [|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))] (loop [[|mailbox| resolve] |mailbox|&resolve] - (do @ + (do ! [|mailbox| (promise.poll |mailbox|)] (case |mailbox| #.None - (do @ + (do ! [resolved? (resolve entry)] (if resolved? - (do @ + (do ! [_ (atom.write (product.right entry) (get@ #mailbox (:representation actor)))] (wrap true)) (recur |mailbox|&resolve))) diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index 2850f454f..50c26e769 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -40,14 +40,14 @@ (structure (def: close (loop [_ []] - (do {@ io.monad} + (do {! io.monad} [current (atom.read sink) stopped? (current #.None)] (if stopped? ## I closed the sink. (wrap (exception.return [])) ## Someone else interacted with the sink. - (do @ + (do ! [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink. @@ -57,7 +57,7 @@ (def: (feed value) (loop [_ []] - (do {@ io.monad} + (do {! io.monad} [current (atom.read sink) #let [[next resolve-next] (:share [a] {(promise.Resolver (Maybe [a (Channel a)])) @@ -68,11 +68,11 @@ fed? (current (#.Some [value next]))] (if fed? ## I fed the sink. - (do @ + (do ! [_ (atom.compare-and-swap current resolve-next sink)] (wrap (exception.return []))) ## Someone else interacted with the sink. - (do @ + (do ! [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink while I was feeding it. @@ -124,13 +124,13 @@ (let [[output sink] (channel [])] (exec (: (Promise Any) (loop [mma mma] - (do {@ promise.monad} + (do {! promise.monad} [?mma mma] (case ?mma (#.Some [ma mma']) - (do @ + (do ! [_ (loop [ma ma] - (do @ + (do ! [?ma ma] (case ?ma (#.Some [a ma']) @@ -185,14 +185,14 @@ (All [a b] (-> (-> b a (Promise a)) a (Channel b) (Promise a))) - (do {@ promise.monad} + (do {! promise.monad} [cons channel] (case cons #.None (wrap init) (#.Some [head tail]) - (do @ + (do ! [init' (f head init)] (fold f init' tail))))) @@ -201,14 +201,14 @@ (All [a b] (-> (-> b a (Promise a)) a (Channel b) (Channel a))) - (do {@ promise.monad} + (do {! promise.monad} [cons channel] (case cons #.None (wrap (#.Some [init (wrap #.None)])) (#.Some [head tail]) - (do @ + (do ! [init' (f head init)] (wrap (#.Some [init (folds f init' tail)])))))) @@ -265,11 +265,11 @@ (def: #export (consume channel) {#.doc "Reads the entirety of a channel's content and returns it as a list."} (All [a] (-> (Channel a) (Promise (List a)))) - (do {@ promise.monad} + (do {! promise.monad} [cons channel] (case cons (#.Some [head tail]) - (:: @ map (|>> (#.Cons head)) + (:: ! map (|>> (#.Cons head)) (consume tail)) #.None diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index e396b0769..3b6341cf1 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -29,19 +29,19 @@ (All [a] (-> (Promise a) (Resolver a))) (function (resolve value) (let [promise (:representation promise)] - (do {@ io.monad} + (do {! io.monad} [(^@ old [_value _observers]) (atom.read promise)] (case _value (#.Some _) (wrap #0) #.None - (do @ + (do ! [#let [new [(#.Some value) #.None]] succeeded? (atom.compare-and-swap old new promise)] (if succeeded? - (do @ - [_ (monad.map @ (function (_ f) (f value)) + (do ! + [_ (monad.map ! (function (_ f) (f value)) _observers)] (wrap #1)) (resolve value)))))))) diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index 83e5ad005..36ac7cd34 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -75,7 +75,7 @@ (let [semaphore (:representation semaphore)] (promise.future (loop [_ []] - (do {@ io.monad} + (do {! io.monad} [state (atom.read semaphore) #let [[?sink state' maxed-out?] (: [(Maybe (Resolver Any)) State Bit] (case (queue.peek (get@ #waiting-list state)) @@ -97,11 +97,11 @@ false]))]] (if maxed-out? (wrap (exception.throw ..semaphore-is-maxed-out [(get@ #max-positions state)])) - (do @ + (do ! [#let [open-positions (get@ #open-positions state')] success? (atom.compare-and-swap state state' semaphore)] (if success? - (do @ + (do ! [_ (case ?sink #.None (wrap true) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 0743a0720..259511eb7 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -46,14 +46,14 @@ (def: (write! new-value var) (All [a] (-> a (Var a) (IO Any))) - (do {@ io.monad} + (do {! io.monad} [#let [var' (:representation var)] (^@ old [old-value observers]) (atom.read var') succeeded? (atom.compare-and-swap old [new-value observers] var')] (if succeeded? - (do @ - [_ (monad.map @ (function (_ sink) - (do @ + (do ! + [_ (monad.map ! (function (_ sink) + (do ! [result (:: sink feed new-value)] (case result (#try.Success _) @@ -217,10 +217,10 @@ (def: (issue-commit commit) (All [a] (-> (Commit a) (IO Any))) (let [entry [commit (promise.promise [])]] - (do {@ io.monad} + (do {! io.monad} [|commits|&resolve (atom.read pending-commits)] (loop [[|commits| resolve] |commits|&resolve] - (do @ + (do ! [|commits| (promise.poll |commits|)] (case |commits| #.None @@ -238,24 +238,24 @@ (let [[stm-proc output resolve] commit [finished-tx value] (stm-proc fresh-tx)] (if (can-commit? finished-tx) - (do {@ io.monad} - [_ (monad.map @ commit-var! finished-tx)] + (do {! io.monad} + [_ (monad.map ! commit-var! finished-tx)] (resolve value)) (issue-commit commit)))) (def: init-processor! (IO Any) - (do {@ io.monad} + (do {! io.monad} [flag (atom.read commit-processor-flag)] (if flag (wrap []) - (do @ + (do ! [was-first? (atom.compare-and-swap flag #1 commit-processor-flag)] (if was-first? - (do @ + (do ! [[promise resolve] (atom.read pending-commits)] (promise.await (function (recur [head [tail _resolve]]) - (do @ + (do ! [_ (process-commit head)] (promise.await recur tail))) promise)) diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 905afba3f..30d99716c 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -102,12 +102,12 @@ ["Tag value" (%.nat byte)])) (template: (!variant <case>+) - (do {@ //.monad} + (do {! //.monad} [flag (: (Parser Nat) ..bits/8)] (`` (case flag (^template [<number> <tag> <parser>] - <number> (:: @ map (|>> <tag>) <parser>)) + <number> (:: ! map (|>> <tag>) <parser>)) ((~~ (template.splice <case>+))) _ (//.lift (exception.throw ..invalid-tag [(~~ (template.count <case>+)) flag])))))) diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index d541ecec4..f361809e5 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -172,9 +172,9 @@ (def: #export (polymorphic poly) (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) - (do {@ //.monad} + (do {! //.monad} [headT any - funcI (:: @ map dictionary.size ..env) + funcI (:: ! map dictionary.size ..env) [num-args non-poly] (local (list headT) polymorphic') env ..env #let [funcL (label funcI) @@ -201,7 +201,7 @@ (dictionary.put partial-varI [(#.Parameter partial-varI) partial-varL])) (#.Cons partial-varL all-varsL)))) [all-varsL env']))]] - (|> (do @ + (|> (do ! [output poly] (wrap [funcL all-varsL output])) (local (list non-poly)) @@ -302,11 +302,11 @@ (def: #export (recursive poly) (All [a] (-> (Parser a) (Parser [Code a]))) - (do {@ //.monad} + (do {! //.monad} [headT any] (case (type.un-name headT) (#.Apply (#.Named ["lux" "Nothing"] _) (#.UnivQ _ headT')) - (do @ + (do ! [[recT _ output] (|> poly (with-extension .Nothing) (with-extension headT) @@ -332,12 +332,12 @@ (def: #export recursive-call (Parser Code) - (do {@ //.monad} + (do {! //.monad} [env ..env [funcT argsT] (apply (//.and any (//.many any))) _ (local (list funcT) (..parameter! 0)) allC (let [allT (list& funcT argsT)] (|> allT - (monad.map @ (function.constant ..parameter)) + (monad.map ! (function.constant ..parameter)) (local allT)))] (wrap (` ((~+ allC)))))) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index 8d0dfab29..e99a49c6f 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -238,8 +238,7 @@ (def: #export (within-bounds? row idx) (All [a] (-> (Row a) Nat Bit)) - (and (n.>= 0 idx) - (n.< (get@ #size row) idx))) + (n.< (get@ #size row) idx)) (def: (base-for idx row) (All [a] (-> Index (Row a) (Try (Base a)))) @@ -291,8 +290,8 @@ (def: #export (update idx f row) (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) (do try.monad - [val (nth idx row)] - (put idx (f val) row))) + [val (..nth idx row)] + (..put idx (f val) row))) (def: #export (pop row) (All [a] (-> (Row a) (Row a))) @@ -358,7 +357,9 @@ (row +10 +20 +30 +40))} (wrap (list (` (..from-list (list (~+ elems))))))) -(structure: #export (node-equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Node a)))) +(structure: (node-equivalence Equivalence<a>) + (All [a] (-> (Equivalence a) (Equivalence (Node a)))) + (def: (= v1 v2) (case [v1 v2] [(#Base b1) (#Base b2)] @@ -370,16 +371,20 @@ _ #0))) -(structure: #export (equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Row a)))) +(structure: #export (equivalence Equivalence<a>) + (All [a] (-> (Equivalence a) (Equivalence (Row a)))) + (def: (= v1 v2) (and (n.= (get@ #size v1) (get@ #size v2)) - (let [(^open "Node/.") (node-equivalence Equivalence<a>)] - (and (Node/= (#Base (get@ #tail v1)) + (let [(^open "node@.") (node-equivalence Equivalence<a>)] + (and (node@= (#Base (get@ #tail v1)) (#Base (get@ #tail v2))) - (Node/= (#Hierarchy (get@ #root v1)) + (node@= (#Hierarchy (get@ #root v1)) (#Hierarchy (get@ #root v2)))))))) -(structure: node-fold (Fold Node) +(structure: node-fold + (Fold Node) + (def: (fold f init xs) (case xs (#Base base) @@ -390,7 +395,9 @@ init hierarchy)))) -(structure: #export fold (Fold Row) +(structure: #export fold + (Fold Row) + (def: (fold f init xs) (let [(^open ".") node-fold] (fold f @@ -399,13 +406,17 @@ (#Hierarchy (get@ #root xs))) (#Base (get@ #tail xs)))))) -(structure: #export monoid (All [a] (Monoid (Row a))) +(structure: #export monoid + (All [a] (Monoid (Row a))) + (def: identity ..empty) (def: (compose xs ys) (list@fold add xs (..to-list ys)))) -(structure: node-functor (Functor Node) +(structure: node-functor + (Functor Node) + (def: (map f xs) (case xs (#Base base) @@ -414,14 +425,18 @@ (#Hierarchy hierarchy) (#Hierarchy (array@map (map f) hierarchy))))) -(structure: #export functor (Functor Row) +(structure: #export functor + (Functor Row) + (def: (map f xs) {#level (get@ #level xs) #size (get@ #size xs) #root (|> xs (get@ #root) (array@map (:: node-functor map f))) #tail (|> xs (get@ #tail) (array@map f))})) -(structure: #export apply (Apply Row) +(structure: #export apply + (Apply Row) + (def: &functor ..functor) (def: (apply ff fa) @@ -432,7 +447,9 @@ ff)] (fold compose identity results)))) -(structure: #export monad (Monad Row) +(structure: #export monad + (Monad Row) + (def: &functor ..functor) (def: wrap (|>> row)) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index e9b6ab8b6..643d12969 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -81,8 +81,8 @@ (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list@map wrapper members)))))))) [_ (#.Record pairs)] - (do {@ ..monad} - [pairs' (monad.map @ + (do {! ..monad} + [pairs' (monad.map ! (function (_ [slot value]) (case slot [_ (#.Text key-name)] @@ -282,15 +282,15 @@ (def: number~ (Parser Number) - (do {@ <>.monad} + (do {! <>.monad} [signed? (<>.parses? (<t>.this "-")) digits (<t>.many <t>.decimal) decimals (<>.default "0" - (do @ + (do ! [_ (<t>.this ".")] (<t>.many <t>.decimal))) exp (<>.default "" - (do @ + (do ! [mark (<t>.one-of "eE") signed?' (<>.parses? (<t>.this "-")) offset (<t>.many <t>.decimal)] @@ -324,11 +324,11 @@ (Parser String) (<| (<t>.enclosed [text.double-quote text.double-quote]) (loop [_ []]) - (do {@ <>.monad} + (do {! <>.monad} [chars (<t>.some (<t>.none-of (text@compose "\" text.double-quote))) stop <t>.peek]) (if (text@= "\" stop) - (do @ + (do ! [escaped escaped~ next-chars (recur [])] (wrap ($_ text@compose chars escaped next-chars))) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index ca5037a65..0e13e1ee6 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -130,7 +130,7 @@ (encoding.from-utf8 digits)) _ ..verify-small-suffix] (<>.lift - (do {@ try.monad} + (do {! try.monad} [value (:: n.octal decode digits)] (..small value))))) @@ -145,7 +145,7 @@ (<>.assert (exception.construct ..wrong-character [expected end]) (n.= expected end)))] (<>.lift - (do {@ try.monad} + (do {! try.monad} [value (:: n.octal decode digits)] (..big value))))) @@ -279,7 +279,7 @@ _ (<>.assert (exception.construct ..wrong-character [expected end]) (n.= expected end))] (<>.lift - (do {@ try.monad} + (do {! try.monad} [ascii (..un-pad string) text (encoding.from-utf8 ascii)] (<in> text))))) @@ -502,8 +502,8 @@ (def: mode-parser (Parser Mode) - (do {@ <>.monad} - [value (:: @ map ..from-small ..small-parser)] + (do {! <>.monad} + [value (:: ! map ..from-small ..small-parser)] (if (n.<= (:representation ..maximum-mode) value) (wrap (:abstraction value)) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index fa726442b..b65058c88 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -1389,8 +1389,8 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do {@ meta.monad} - [arg-inputs (monad.map @ + (do {! meta.monad} + [arg-inputs (monad.map ! (: (-> [Bit GenericType] (Meta [Bit Code])) (function (_ [maybe? _]) (with-gensyms [arg-name] @@ -1495,7 +1495,7 @@ (list@map type-param->type-arg))] (case member (#EnumDecl enum-members) - (do {@ meta.monad} + (do {! meta.monad} [#let [enum-type (: Code (case class-tvars #.Nil @@ -1690,9 +1690,9 @@ (java/util/List::size [] my-list) java/lang/Character$UnicodeScript::LATIN )} - (do {@ meta.monad} + (do {! meta.monad} [kind (class-kind class-decl) - =members (monad.map @ (member-import$ (product.right class-decl) kind class-decl) members)] + =members (monad.map ! (member-import$ (product.right class-decl) kind class-decl) members)] (wrap (list& (class-import$ class-decl) (list@join =members))))) (syntax: #export (array {type (..generic-type^ (list))} diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 32c549a90..31f56f16b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -57,8 +57,8 @@ {?name (p.maybe s.local-identifier)} {[poly-func poly-args] (s.form (p.and s.identifier (p.many s.identifier)))} {?custom-impl (p.maybe s.any)}) - (do {@ meta.monad} - [poly-args (monad.map @ meta.normalize poly-args) + (do {! meta.monad} + [poly-args (monad.map ! meta.normalize poly-args) name (case ?name (#.Some name) (wrap name) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 4963ef943..8adc4321b 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -65,8 +65,8 @@ (case ?parts (#.Some [name args meta body]) (with-gensyms [g!tokens g!body g!error] - (do {@ meta.monad} - [vars+parsers (monad.map @ + (do {! meta.monad} + [vars+parsers (monad.map ! (: (-> Code (Meta [Code Code])) (function (_ arg) (case arg diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 680162742..4d0e6b97e 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -104,14 +104,14 @@ (def: #export (definition compiler) {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} (-> Lux (Parser //.Definition)) - (do {@ p.monad} + (do {! p.monad} [definition-raw s.any me-definition-raw (|> definition-raw meta.expand-all (meta.run compiler) p.lift)] (s.local me-definition-raw - (s.form (do @ + (s.form (do ! [_ (s.text! "lux def") definition-name s.local-identifier [?definition-type definition-value] check^ diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 33dea631a..ed6d3a66b 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -28,10 +28,10 @@ (syntax: #export (with-locals {locals (<code>.tuple (<>.some <code>.local-identifier))} body) - (do {@ meta.monad} + (do {! meta.monad} [g!locals (|> locals (list@map meta.gensym) - (monad.seq @))] + (monad.seq !))] (wrap (list (` (.with-expansions [(~+ (|> (list.zip/2 locals g!locals) (list@map (function (_ [name identifier]) (list (code.local-identifier name) (as-is identifier)))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index c26bd7c38..f38a0c571 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -192,13 +192,13 @@ (def: #export (or left right) {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Random a) (Random b) (Random (| a b)))) - (do {@ ..monad} + (do {! ..monad} [? bit] (if ? - (do @ + (do ! [=left left] (wrap (0 #0 =left))) - (do @ + (do ! [=right right] (wrap (0 #1 =right)))))) @@ -220,10 +220,10 @@ (def: #export (maybe value-gen) (All [a] (-> (Random a) (Random (Maybe a)))) - (do {@ ..monad} + (do {! ..monad} [some? bit] (if some? - (do @ + (do ! [value value-gen] (wrap (#.Some value))) (wrap #.None)))) @@ -257,10 +257,10 @@ (def: #export (set Hash<a> size value-gen) (All [a] (-> (Hash a) Nat (Random a) (Random (Set a)))) (if (n.> 0 size) - (do {@ ..monad} + (do {! ..monad} [xs (set Hash<a> (dec size) value-gen)] (loop [_ []] - (do @ + (do ! [x value-gen #let [xs+ (set.add x xs)]] (if (n.= size (set.size xs+)) @@ -271,10 +271,10 @@ (def: #export (dictionary Hash<a> size key-gen value-gen) (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v)))) (if (n.> 0 size) - (do {@ ..monad} + (do {! ..monad} [kv (dictionary Hash<a> (dec size) key-gen value-gen)] (loop [_ []] - (do @ + (do ! [k key-gen v value-gen #let [kv+ (dictionary.put k v kv)]] diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index e94aa1578..47e7a5721 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -315,8 +315,8 @@ )))} (case tokens (^ (list [_ (#.Tuple identifiers)] body)) - (do {@ ..monad} - [identifier-names (monad.map @ get-local-identifier identifiers) + (do {! ..monad} + [identifier-names (monad.map ! get-local-identifier identifiers) #let [identifier-defs (list@join (list@map (: (-> Text (List Code)) (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) identifier-names))]] diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index 8b59f77ba..2b3d600f7 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -183,11 +183,11 @@ (def: (bytecode consumption production registry [estimator bytecode] input) (All [a] (-> U2 U2 Registry [Estimator (-> [a] Instruction)] [a] (Bytecode Any))) (function (_ [pool environment tracker]) - (do {@ try.monad} + (do {! try.monad} [environment' (|> environment (/environment.consumes consumption) - (monad.bind @ (/environment.produces production)) - (monad.bind @ (/environment.has registry))) + (monad.bind ! (/environment.produces production)) + (monad.bind ! (/environment.has registry))) program-counter' (step estimator (get@ #program-counter tracker))] (wrap [[pool environment' @@ -687,8 +687,8 @@ (def: (jump @from @to) (-> Address Address (Try Any-Jump)) - (do {@ try.monad} - [jump (:: @ map //signed.value + (do {! try.monad} + [jump (:: ! map //signed.value (/address.jump @from @to))] (let [big? (n.> (//unsigned.value //unsigned.maximum/2) (.nat (i.* (if (i.>= +0 jump) @@ -696,8 +696,8 @@ -1) jump)))] (if big? - (:: @ map (|>> #.Left) (//signed.s4 jump)) - (:: @ map (|>> #.Right) (//signed.s2 jump)))))) + (:: ! map (|>> #.Left) (//signed.s4 jump)) + (:: ! map (|>> #.Right) (//signed.s2 jump)))))) (exception: #export (unset-label {label Label}) (exception.report @@ -849,18 +849,18 @@ (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] - (case (do {@ maybe.monad} - [@default (|> default get (monad.bind @ product.right)) - @at-minimum (|> at-minimum get (monad.bind @ product.right)) + (case (do {! maybe.monad} + [@default (|> default get (monad.bind ! product.right)) + @at-minimum (|> at-minimum get (monad.bind ! product.right)) @afterwards (|> afterwards - (monad.map @ get) - (monad.bind @ (monad.map @ product.right)))] + (monad.map ! get) + (monad.bind ! (monad.map ! product.right)))] (wrap [@default @at-minimum @afterwards])) (#.Some [@default @at-minimum @afterwards]) - (do {@ try.monad} - [>default (:: @ map ..big-jump (..jump @from @default)) - >at-minimum (:: @ map ..big-jump (..jump @from @at-minimum)) - >afterwards (monad.map @ (|>> (..jump @from) (:: @ map ..big-jump)) + (do {! try.monad} + [>default (:: ! map ..big-jump (..jump @from @default)) + >at-minimum (:: ! map ..big-jump (..jump @from @at-minimum)) + >afterwards (monad.map ! (|>> (..jump @from) (:: ! map ..big-jump)) @afterwards)] (wrap [..no-exceptions (bytecode minimum >default [>at-minimum >afterwards])])) @@ -892,18 +892,18 @@ (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] - (case (do {@ maybe.monad} - [@default (|> default get (monad.bind @ product.right)) + (case (do {! maybe.monad} + [@default (|> default get (monad.bind ! product.right)) @cases (|> cases - (monad.map @ (|>> product.right get)) - (monad.bind @ (monad.map @ product.right)))] + (monad.map ! (|>> product.right get)) + (monad.bind ! (monad.map ! product.right)))] (wrap [@default @cases])) (#.Some [@default @cases]) - (do {@ try.monad} - [>default (:: @ map ..big-jump (..jump @from @default)) + (do {! try.monad} + [>default (:: ! map ..big-jump (..jump @from @default)) >cases (|> @cases - (monad.map @ (|>> (..jump @from) (:: @ map ..big-jump))) - (:: @ map (|>> (list.zip/2 (list@map product.left cases)))))] + (monad.map ! (|>> (..jump @from) (:: ! map ..big-jump))) + (:: ! map (|>> (list.zip/2 (list@map product.left cases)))))] (wrap [..no-exceptions (bytecode >default >cases)])) #.None diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index fc7e74987..eac3f8651 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -601,21 +601,21 @@ (function (_ [size mutation]) (let [padding (switch-padding size) tableswitch-size (try.assume - (do {@ try.monad} + (do {! try.monad} [size (///unsigned.u2 size)] - (:: @ map (|>> estimator ///unsigned.value) + (:: ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) tableswitch-mutation (: Mutation (function (_ [offset binary]) [(n.+ tableswitch-size offset) (try.assume - (do {@ try.monad} + (do {! try.monad} [amount-of-afterwards (|> amount-of-afterwards .int ///signed.s4) maximum (///signed.+/4 minimum amount-of-afterwards) _ (binary.write/8 offset (hex "AA") binary) #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] _ (case padding - 3 (do @ + 3 (do ! [_ (binary.write/8 offset 0 binary)] (binary.write/16 (inc offset) 0 binary)) 2 (binary.write/16 offset 0 binary) @@ -635,7 +635,7 @@ (wrap binary) (#.Cons head tail) - (do @ + (do ! [_ (binary.write/32 offset (///signed.value head) binary)] (recur (n.+ (///unsigned.value ..big-jump-size) offset) tail))))))]))] @@ -665,19 +665,19 @@ (function (_ [size mutation]) (let [padding (switch-padding size) lookupswitch-size (try.assume - (do {@ try.monad} + (do {! try.monad} [size (///unsigned.u2 size)] - (:: @ map (|>> estimator ///unsigned.value) + (:: ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) lookupswitch-mutation (: Mutation (function (_ [offset binary]) [(n.+ lookupswitch-size offset) (try.assume - (do {@ try.monad} + (do {! try.monad} [_ (binary.write/8 offset (hex "AB") binary) #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] _ (case padding - 3 (do @ + 3 (do ! [_ (binary.write/8 offset 0 binary)] (binary.write/16 (inc offset) 0 binary)) 2 (binary.write/16 offset 0 binary) @@ -694,7 +694,7 @@ (wrap binary) (#.Cons [value jump] tail) - (do @ + (do ! [_ (binary.write/32 offset (///signed.value value) binary) _ (binary.write/32 (n.+ (///unsigned.value ..integer-size) offset) (///signed.value jump) binary)] (recur (n.+ case-size offset) diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index db5ab9b4c..5a975cf8a 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -72,12 +72,12 @@ (def: (install-classes this super interfaces) (-> Internal Internal (List Internal) (Resource [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))])) - (do {@ //constant/pool.monad} + (do {! //constant/pool.monad} [@this (//constant/pool.class this) @super (//constant/pool.class super) @interfaces (: (Resource (Row (Index //constant.Class))) - (monad.fold @ (function (_ interface @interfaces) - (do @ + (monad.fold ! (function (_ interface @interfaces) + (do ! [@interface (//constant/pool.class interface)] (wrap (row.add @interface @interfaces)))) row.empty diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 8028787d7..2d2b1b940 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -66,13 +66,13 @@ (#try.Failure _) (let [new (<tag> <value>')] - (do {@ try.monad} + (do {! try.monad} [@new (//unsigned.u2 (//.size new)) next (: (Try Index) (|> current //index.value (//unsigned.+/2 @new) - (:: @ map //index.index)))] + (:: ! map //index.index)))] (wrap [[next (row.add [current new] pool)] current]))))))))) diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index e17496ffb..14c19bb86 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -122,11 +122,11 @@ (def: #export (store name bytecode library) (-> Text Binary Library (IO (Try Any))) - (do {@ io.monad} + (do {! io.monad} [library' (atom.read library)] (if (dictionary.contains? name library') (wrap (exception.throw ..already-stored name)) - (do @ + (do ! [_ (atom.update (dictionary.put name bytecode) library)] (wrap (#try.Success [])))))) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index 9f902f55e..daae88521 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -53,15 +53,15 @@ (def: #export (method modifier name type attributes code) (-> (Modifier Method) UTF8 (Type //type/category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any)) (Resource Method)) - (do {@ //constant/pool.monad} + (do {! //constant/pool.monad} [@name (//constant/pool.utf8 name) @descriptor (//constant/pool.descriptor (//type.descriptor type)) attributes (|> attributes - (monad.seq @) - (:: @ map row.from-list)) + (monad.seq !) + (:: ! map row.from-list)) attributes (case code (#.Some code) - (do @ + (do ! [environment (case (if (//modifier.has? static modifier) (//bytecode/environment.static type) (//bytecode/environment.virtual type)) diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 7bc23199d..9cbcd4535 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -151,11 +151,11 @@ (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)] (case (host.check java/lang/Class raw) (#.Some raw) - (do {@ try.monad} + (do {! try.monad} [paramsT (|> reflection java/lang/reflect/ParameterizedType::getActualTypeArguments array.to-list - (monad.map @ parameter))] + (monad.map ! parameter))] (wrap (/.class (|> raw (:coerce (java/lang/Class java/lang/Object)) java/lang/Class::getName) @@ -341,14 +341,14 @@ (template [<name> <exception> <then?> <else?>] [(def: #export (<name> field class) (-> Text (java/lang/Class java/lang/Object) (Try [Bit (/.Type Value)])) - (do {@ try.monad} + (do {! try.monad} [fieldJ (..field field class) #let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]] (case (java/lang/reflect/Modifier::isStatic modifiers) <then?> (|> fieldJ java/lang/reflect/Field::getGenericType ..type - (:: @ map (|>> [(java/lang/reflect/Modifier::isFinal modifiers)]))) + (:: ! map (|>> [(java/lang/reflect/Modifier::isFinal modifiers)]))) <else?> (exception.throw <exception> [field class]))))] [static-field ..not-a-static-field #1 #0] diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux index 0ac0d013c..83a61de01 100644 --- a/stdlib/source/lux/target/jvm/type/lux.lux +++ b/stdlib/source/lux/target/jvm/type/lux.lux @@ -103,8 +103,8 @@ (<>.after (<t>.this //signature.parameters-start)) (<>.before (<t>.this //signature.parameters-end)) (<>.default (list)))] - (wrap (do {@ check.monad} - [parameters (monad.seq @ parameters)] + (wrap (do {! check.monad} + [parameters (monad.seq ! parameters)] (wrap (#.Primitive name parameters))))) (<>.after (<t>.this //descriptor.class-prefix)) (<>.before (<t>.this //descriptor.class-suffix)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index f05b0e1ba..5f06a02cf 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -88,7 +88,7 @@ (def: (named-type location id) (-> Location Nat Type) - (let [name (format "{New Type " (format.location location) " " (%.nat id) "}")] + (let [name (format "{New Type " (%.location location) " " (%.nat id) "}")] (#.Primitive name (list)))) (def: new-named-type diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index eb85bc9ca..f2c9a4afa 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -95,8 +95,6 @@ (def: #export prelude "lux") -(def: #export space " ") - (def: #export text-delimiter text.double-quote) (def: #export open-form "(") @@ -117,13 +115,13 @@ (def: #export frac-separator ".") -## The parts of an name are separated by a single mark. +## The parts of a name are separated by a single mark. ## E.g. module.short. ## Only one such mark may be used in an name, since there -## can only be 2 parts to an name (the module [before the +## can only be 2 parts to a name (the module [before the ## mark], and the short [after the mark]). ## There are also some extra rules regarding name syntax, -## encoded on the parser. +## encoded in the parser. (def: #export name-separator ".") (exception: #export (end-of-file {module Text}) @@ -151,7 +149,7 @@ (template: (!failure parser where offset source-code) (#.Left [[where offset source-code] - (exception.construct unrecognized-input [where (%.name (name-of parser)) source-code offset])])) + (exception.construct ..unrecognized-input [where (%.name (name-of parser)) source-code offset])])) (template: (!end-of-file where offset source-code current-module) (#.Left [[where offset source-code] @@ -174,9 +172,10 @@ (case <computation> (#.Right <binding>) <body> - - (#.Left error) - (#.Left error))) + + ## (#.Left error) + <<otherwise>> + (:assume <<otherwise>>))) (template: (!horizontal where offset source-code) [(update@ #.column inc where) @@ -277,29 +276,31 @@ (or (!digit? char) ("lux i64 =" (.char (~~ (static ..digit-separator))) char)))) -(with-expansions [<clauses> (template [<char>] - [("lux i64 =" (.char (~~ (static <char>))) char) - #0] - - [..space] [text.new-line] - [..name-separator] - [..open-form] [..close-form] - [..open-tuple] [..close-tuple] - [..open-record] [..close-record] - [..text-delimiter] - [..sigil])] +(with-expansions [<non-name-chars> (template [<char>] + [(~~ (static <char>))] + + [text.space] + [text.new-line] + [..name-separator] + [..open-form] [..close-form] + [..open-tuple] [..close-tuple] + [..open-record] [..close-record] + [..text-delimiter] + [..sigil])] (`` (template: (!strict-name-char? char) - (cond <clauses> - ## else - #1)))) + ("lux syntax char case!" char + [[<non-name-chars>] + #0] + + ## else + #1)))) (template: (!name-char?|head char) (and (!strict-name-char? char) (not (!digit? char)))) (template: (!name-char? char) - (or (!strict-name-char? char) - (!digit? char))) + (!strict-name-char? char)) (template: (!number-output <start> <end> <codec> <tag>) (case (|> source-code @@ -418,20 +419,20 @@ (with-expansions [<simple> (as-is (#.Right [source' ["" simple]]))] (`` (def: (parse-full-name aliases start source) (-> Aliases Offset (Parser Name)) - (!letE [source' simple] (..parse-name-part start source) - (let [[where' offset' source-code'] source'] - (<| (!with-char source-code' offset' char/separator <simple>) - (if (!n/= (char (~~ (static ..name-separator))) char/separator) - (let [offset'' (!inc offset')] - (!letE [source'' complex] (..parse-name-part offset'' [(!forward 1 where') offset'' source-code']) - (if ("lux text =" "" complex) - (let [[where offset source-code] source] - (!failure ..parse-full-name where offset source-code)) - (#.Right [source'' [(|> aliases - (dictionary.get simple) - (maybe.default simple)) - complex]])))) - <simple>))))))) + (<| (!letE [source' simple] (..parse-name-part start source)) + (let [[where' offset' source-code'] source']) + (!with-char source-code' offset' char/separator <simple>) + (if (!n/= (char (~~ (static ..name-separator))) char/separator) + (let [offset'' (!inc offset')] + (!letE [source'' complex] (..parse-name-part offset'' [(!forward 1 where') offset'' source-code']) + (if ("lux text =" "" complex) + (let [[where offset source-code] source] + (!failure ..parse-full-name where offset source-code)) + (#.Right [source'' [(|> aliases + (dictionary.get simple) + (maybe.default simple)) + complex]])))) + <simple>))))) (template: (!parse-full-name @offset @source @where @aliases @tag) (!letE [source' full-name] (..parse-full-name @aliases @offset @source) @@ -470,9 +471,9 @@ [..open-tuple ..close-tuple parse-tuple] [..open-record ..close-record parse-record] )] - ## TODO: Add ..space as just another case for "lux syntax char case!" ASAP. - ## It"s currently failing for some reason. - (`` (if (!n/= (char (~~ (static ..space))) char/0) + ## TODO: Add text.space as just another case for "lux syntax char case!" ASAP. + ## It's currently failing for some reason. + (`` (if (!n/= (char (~~ (static text.space))) char/0) <horizontal-move> ("lux syntax char case!" char/0 [[(~~ (static text.carriage-return))] @@ -523,7 +524,7 @@ ## else (!failure ..parse where offset/0 source-code))))) - ## Coincidentally (= name-separator frac-separator) + ## Coincidentally (= ..name-separator ..frac-separator) [(~~ (static ..name-separator))] (let [offset/1 (!inc offset/0)] (<| (!with-char+ source-code//size source-code offset/1 char/1 diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 6f07e1deb..0478b906e 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -3,7 +3,7 @@ [abstract [monad (#+ Monad do)]] [control - ["ex" exception (#+ exception:)] + ["." exception (#+ exception:)] ["<>" parser ("#@." monad) ["<c>" code (#+ Parser)]]] [data @@ -57,8 +57,7 @@ (!peek source reference (peek-scopes-definition definition-reference (get@ #.definitions head)))) -(exception: #export (no-active-scopes) - "") +(exception: #export no-active-scopes) (def: (peek! scope) (-> (Maybe Text) (Meta Scope)) @@ -77,7 +76,7 @@ (#.Right [compiler scope]) #.None - (ex.throw no-active-scopes []))))) + (exception.throw ..no-active-scopes []))))) (template: (!push <source> <reference> <then>) (loop [entries <source>] diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 7ca34e7de..4918a0b87 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -354,10 +354,10 @@ (do ..monad [_ (..bind type id)] then) - (do {@ ..monad} + (do {! ..monad} [ring (..ring id) _ (assert "" (n.> 1 (set.size ring))) - _ (monad.map @ (update type) (set.to-list ring))] + _ (monad.map ! (update type) (set.to-list ring))] then) (do ..monad [?bound (read id)] @@ -382,13 +382,13 @@ (-> (Checker Type) (Checker Var)) (if (!n/= idE idA) (check@wrap assumptions) - (do {@ ..monad} + (do {! ..monad} [ebound (attempt (peek idE)) abound (attempt (peek idA))] (case [ebound abound] ## Link the 2 variables circularly [#.None #.None] - (do @ + (do ! [_ (link-2 idE idA)] (wrap assumptions)) @@ -396,7 +396,7 @@ [(#.Some etype) #.None] (case etype (#.Var targetE) - (do @ + (do ! [_ (link-3 idA targetE idE)] (wrap assumptions)) @@ -407,7 +407,7 @@ [#.None (#.Some atype)] (case atype (#.Var targetA) - (do @ + (do ! [_ (link-3 idE targetA idA)] (wrap assumptions)) @@ -417,15 +417,15 @@ [(#.Some etype) (#.Some atype)] (case [etype atype] [(#.Var targetE) (#.Var targetA)] - (do @ + (do ! [ringE (..ring idE) ringA (..ring idA)] (if (:: set.equivalence = ringE ringA) (wrap assumptions) ## Fuse 2 rings - (do @ - [_ (monad.fold @ (function (_ interpose to) - (do @ + (do ! + [_ (monad.fold ! (function (_ interpose to) + (do ! [_ (link-3 interpose to idE)] (wrap interpose))) targetE @@ -434,9 +434,9 @@ (^template [<pattern> <id> <type>] <pattern> - (do @ + (do ! [ring (..ring <id>) - _ (monad.map @ (update <type>) (set.to-list ring))] + _ (monad.map ! (update <type>) (set.to-list ring))] (wrap assumptions))) ([[(#.Var _) _] idE atype] [[_ (#.Var _)] idA etype]) @@ -695,8 +695,8 @@ (^template [<tag>] (<tag> envT+ unquantifiedT) - (do {@ ..monad} - [envT+' (monad.map @ clean envT+)] + (do {! ..monad} + [envT+' (monad.map ! clean envT+)] (wrap (<tag> envT+' unquantifiedT)))) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 2295a3ed3..afd1f68c6 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -89,10 +89,10 @@ [member (meta.normalize member) _ (meta.resolve-tag member)] (wrap member)) - (do {@ meta.monad} + (do {! meta.monad} [this-module-name meta.current-module-name imp-mods (meta.imported-modules this-module-name) - tag-lists (monad.map @ meta.tag-lists imp-mods) + tag-lists (monad.map ! meta.tag-lists imp-mods) #let [tag-lists (|> tag-lists list@join (list@map product.left) list@join) candidates (list.filter (|>> product.right (text@= simple-name)) tag-lists)]] @@ -141,18 +141,18 @@ (def: local-structs (Meta (List [Name Type])) - (do {@ meta.monad} + (do {! meta.monad} [this-module-name meta.current-module-name] - (:: @ map (prepare-definitions this-module-name this-module-name) + (:: ! map (prepare-definitions this-module-name this-module-name) (meta.definitions this-module-name)))) (def: import-structs (Meta (List [Name Type])) - (do {@ meta.monad} + (do {! meta.monad} [this-module-name meta.current-module-name imp-mods (meta.imported-modules this-module-name) - export-batches (monad.map @ (function (_ imp-mod) - (:: @ map (prepare-definitions imp-mod this-module-name) + export-batches (monad.map ! (function (_ imp-mod) + (:: ! map (prepare-definitions imp-mod this-module-name) (meta.definitions imp-mod))) imp-mods)] (wrap (list@join export-batches)))) @@ -213,12 +213,12 @@ (case (|> alts (list@map (function (_ [alt-name alt-type]) (case (check.run context - (do {@ check.monad} + (do {! check.monad} [[tvars alt-type] (concrete-type alt-type) #let [[deps alt-type] (type.flatten-function alt-type)] _ (check.check dep alt-type) context' check.context - =deps (monad.map @ (provision compiler context') deps)] + =deps (monad.map ! (provision compiler context') deps)] (wrap =deps))) (#.Left error) (list) @@ -262,14 +262,14 @@ (case (|> alts (list@map (function (_ [alt-name alt-type]) (case (check.run context - (do {@ check.monad} + (do {! check.monad} [[tvars alt-type] (concrete-type alt-type) #let [[deps alt-type] (type.flatten-function alt-type)] _ (check.check alt-type sig-type) member-type (find-member-type member-idx alt-type) _ (check-apply member-type input-types output-type) context' check.context - =deps (monad.map @ (provision compiler context') deps)] + =deps (monad.map ! (provision compiler context') deps)] (wrap =deps))) (#.Left error) (list) @@ -342,9 +342,9 @@ "Otherwise, this macro will not find it.")} (case args (#.Left [args _]) - (do {@ meta.monad} + (do {! meta.monad} [[member-idx sig-type] (resolve-member member) - input-types (monad.map @ resolve-type args) + input-types (monad.map ! resolve-type args) output-type meta.expected-type chosen-ones (find-alternatives sig-type member-idx input-types output-type)] (case chosen-ones @@ -364,8 +364,8 @@ " --- for type: " (%.type sig-type))))) (#.Right [args _]) - (do {@ meta.monad} - [labels (|> (meta.gensym "") (list.repeat (list.size args)) (monad.seq @))] + (do {! meta.monad} + [labels (|> (meta.gensym "") (list.repeat (list.size args)) (monad.seq !))] (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list@map join-pair) list@join))] (..::: (~ (code.identifier member)) (~+ labels))))))) )) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index 0bd65325b..8b87ef50b 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -138,11 +138,11 @@ (def: indices (Parser (List Nat)) (s.tuple (loop [seen (set.new n.hash)] - (do {@ p.monad} + (do {! p.monad} [done? s.end?] (if done? (wrap (list)) - (do @ + (do ! [head s.nat _ (p.assert (exception.construct index-cannot-be-repeated head) (not (set.member? seen head))) @@ -161,9 +161,9 @@ (wrap (list (` ((~! no-op) <monad>)))) (#.Cons head tail) - (do {@ meta.monad} + (do {! meta.monad} [#let [max-idx (list@fold n.max head tail)] - g!inputs (<| (monad.seq @) (list.repeat (inc max-idx)) (meta.gensym "input")) + g!inputs (<| (monad.seq !) (list.repeat (inc max-idx)) (meta.gensym "input")) #let [g!outputs (|> (monad.fold maybe.monad (function (_ from to) (do maybe.monad @@ -199,8 +199,8 @@ (template [<name> <m> <monad> <from> <to>] [(syntax: #export (<name> {amount ..amount}) (meta.with-gensyms [g!_ g!context] - (do {@ meta.monad} - [g!keys (<| (monad.seq @) (list.repeat amount) (meta.gensym "keys"))] + (do {! meta.monad} + [g!keys (<| (monad.seq !) (list.repeat amount) (meta.gensym "keys"))] (wrap (list (` (: (All [(~+ g!keys) (~ g!context)] (Procedure (~! <m>) [<from> (~ g!context)] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index c21d20d80..5f1bbc6a8 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -368,15 +368,15 @@ [(def: <name> (..can-query (function (<name> _) - (do {@ (try.with io.monad)} + (do {! (try.with io.monad)} [?children (java/io/File::listFiles (java/io/File::new path))] (case ?children (#.Some children) (|> children array.to-list - (monad.filter @ (|>> <method>)) - (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map <capability>)))) - (:: @ join)) + (monad.filter ! (|>> <method>)) + (:: ! map (monad.map ! (|>> java/io/File::getAbsolutePath (:: ! map <capability>)))) + (:: ! join)) #.None (:: io.monad wrap (exception.throw ..not-a-directory [path])))))))] @@ -575,11 +575,11 @@ [(def: <name> (..can-query (function (<name> _) - (do {@ (try.with io.monad)} + (do {! (try.with io.monad)} [#let [node-fs (..node-fs [])] subs (Fs::readdirSync [path] node-fs) - subs (monad.map @ (function (_ sub) - (do @ + subs (monad.map ! (function (_ sub) + (do ! [stats (Fs::statSync [sub] node-fs) verdict (<method> [] stats)] (wrap [verdict sub]))) @@ -805,11 +805,11 @@ (def: (try-update! transform var) (All [a] (-> (-> a (Try a)) (Var a) (STM (Try Any)))) - (do {@ stm.monad} + (do {! stm.monad} [|var| (stm.read var)] (case (transform |var|) (#try.Success |var|) - (do @ + (do ! [_ (stm.write |var| var)] (wrap (#try.Success []))) @@ -911,7 +911,7 @@ (..can-open (function (_ path) (stm.commit - (do {@ stm.monad} + (do {! stm.monad} [|store| (stm.read store)] (case (do try.monad [[name file] (..retrieve-mock-file! separator path |store|) @@ -920,7 +920,7 @@ |store| (..update-mock-file! separator path (get@ #mock-last-modified file) (get@ #mock-content file) |store|)] (wrap [|store| (mock-file separator name path store)])) (#try.Success [|store| moved]) - (do @ + (do ! [_ (stm.write |store| store)] (wrap (#try.Success moved))) @@ -1056,11 +1056,11 @@ (..can-delete (function (_ _) (stm.commit - (do {@ stm.monad} + (do {! stm.monad} [|store| (stm.read store)] (case (..delete-mock-directory! separator path |store|) (#try.Success |store|) - (do @ + (do ! [_ (stm.write |store| store)] (wrap (#try.Success []))) @@ -1090,11 +1090,11 @@ (do promise.monad [now (promise.future instant.now)] (stm.commit - (do {@ stm.monad} + (do {! stm.monad} [|store| (stm.read store)] (case (..create-mock-file! separator path now |store|) (#try.Success [name |store|]) - (do @ + (do ! [_ (stm.write |store| store)] (wrap (#try.Success (..mock-file separator name path store)))) @@ -1115,11 +1115,11 @@ (..can-open (function (_ path) (stm.commit - (do {@ stm.monad} + (do {! stm.monad} [|store| (stm.read store)] (case (..create-mock-directory! separator path |store|) (#try.Success _) - (do @ + (do ! [_ (stm.write |store| store)] (wrap (#try.Success (..mock-directory separator path store)))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 327eb8902..76db24a47 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -33,6 +33,7 @@ [action (#+ Action)] ["#" profile] ["#." project (#+ Project)] + ["#." input] ["#." parser] ["#." pom] ["#." cli] @@ -46,26 +47,6 @@ ["#/." auto] ["#/." deploy]]]) -(def: (read-file! path) - (-> Path (IO (Try Binary))) - (do (try.with io.monad) - [project-file (!.use (:: file.system file) [path])] - (!.use (:: project-file content) []))) - -(def: (read-code source-code) - (-> Text (Try Code)) - (let [parse (syntax.parse "" - syntax.no-aliases - (text.size source-code)) - start (: Source - [["" 0 0] 0 source-code])] - (case (parse start) - (#.Left [end error]) - (#try.Failure error) - - (#.Right [end lux-code]) - (#try.Success lux-code)))) - (def: (install! profile) (-> /.Profile (Promise Any)) (do promise.monad @@ -99,20 +80,10 @@ (log! (format "Could not resolve dependencies:" text.new-line error)))))) -(def: project - (-> Binary (Try Project)) - (|>> (do> try.monad - [encoding.from-utf8] - [..read-code] - [(list) (<c>.run /parser.project)]))) - (program: [{[profile operation] /cli.command}] (do {@ io.monad} - [data (..read-file! /.file)] - (case (do try.monad - [data data - project (..project data)] - (/project.profile profile project)) + [?profile (/input.read io.monad file.system profile)] + (case ?profile (#try.Success profile) (case operation #/cli.POM diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux new file mode 100644 index 000000000..ffed02d28 --- /dev/null +++ b/stdlib/source/program/aedifex/input.lux @@ -0,0 +1,59 @@ +(.module: + [lux #* + [abstract + [monad (#+ Monad do)]] + [control + [pipe (#+ do>)] + ["." try (#+ Try)] + [parser + ["<c>" code]] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + ["." text + ["." encoding]]] + [meta + ["." location]] + [tool + [compiler + [language + [lux + ["." syntax]]]]] + [world + ["." file]]] + ["." // #_ + ["#" profile (#+ Profile)] + ["#." action (#+ Action)] + ["#." project (#+ Project)] + ["#." parser]]) + +(def: (parse-lux source-code) + (-> Text (Try Code)) + (let [parse (syntax.parse "" + syntax.no-aliases + (text.size source-code))] + (case (parse [location.dummy 0 source-code]) + (#.Left [_ error]) + (#try.Failure error) + + (#.Right [_ lux-code]) + (#try.Success lux-code)))) + +(def: parse-project + (-> Binary (Try Project)) + (|>> (do> try.monad + [encoding.from-utf8] + [..parse-lux] + [(list) (<c>.run //parser.project)]))) + +(def: #export (read monad fs profile) + (All [!] (-> (Monad !) (file.System !) Text (! (Try Profile)))) + (do (try.with monad) + [project-file (!.use (:: fs file) //project.file) + project-file (!.use (:: project-file content) [])] + (:: monad wrap + (|> project-file + (do> try.monad + [..parse-project] + [(//project.profile profile)]))))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index bc2dbfb91..c7c72c827 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -137,13 +137,13 @@ [pom (encoding.from-utf8 pom) pom (:: xml.codec decode pom) profile (<xml>.run //pom.parser pom)] - (wrap [pom (set.to-list (get@ #/.dependencies profile))]))) + (wrap [pom (get@ #/.dependencies profile)]))) library (..read! system (format prefix (//artifact/extension.extension type))) sha1 (..read! system (format prefix //artifact/extension.sha1)) md5 (..read! system (format prefix //artifact/extension.md5))] (wrap {#//dependency/resolution.library library #//dependency/resolution.pom pom - #//dependency/resolution.dependencies dependencies + #//dependency/resolution.dependencies (set.to-list dependencies) #//dependency/resolution.sha1 (|> sha1 (:coerce (//hash.Hash //hash.SHA-1)) (:: //hash.sha1-codec encode)) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index d8ebf9b18..190ed3714 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -24,9 +24,6 @@ ["." artifact (#+ Artifact)] ["." dependency]]) -(def: #export file - "project.lux") - (type: #export Distribution #Repo #Manual) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index 071f54b12..9bc80c462 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -17,6 +17,9 @@ ["." // #_ ["#" profile (#+ Name Profile)]]) +(def: #export file + "project.lux") + (type: #export Project (Dictionary Name Profile)) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 50d194e43..fd92d9b40 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -7,6 +7,7 @@ [cli (#+ program:)]]]] ["." / #_ ["#." artifact] + ["#." input] ["#." command #_ ["#/." pom]] ["#." dependency] @@ -21,6 +22,7 @@ Test ($_ _.and /artifact.test + /input.test /command/pom.test /dependency.test /profile.test diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux new file mode 100644 index 000000000..39a71eb81 --- /dev/null +++ b/stdlib/source/test/aedifex/input.lux @@ -0,0 +1,51 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try) ("#@." functor)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." binary] + ["." text ("#@." equivalence) + ["%" format] + ["." encoding]]] + [math + ["." random (#+ Random)]] + [world + ["." file (#+ File)]]] + [// + ["@." profile]] + {#program + ["." / + ["/#" // #_ + ["#" profile (#+ Profile)] + ["#." project] + ["#." action] + ["#." format]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {@ random.monad} + [expected (:: @ map (set@ #//.parents (list)) @profile.random) + #let [fs (: (file.System Promise) + (file.mock (:: file.system separator)))]] + (wrap (do promise.monad + [verdict (do //action.monad + [file (: (Promise (Try (File Promise))) + (file.get-file promise.monad fs //project.file)) + _ (|> expected + //format.profile + %.code + encoding.to-utf8 + (!.use (:: file over-write))) + actual (: (Promise (Try Profile)) + (/.read promise.monad fs //.default))] + (wrap (:: //.equivalence = expected actual)))] + (_.claim [/.read] + (try.default false verdict))))))) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 12c3625b3..d99d3c063 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -10,7 +10,6 @@ ["#." fold] ["#." functor ["#/." contravariant]] - ["#." hash] ["#." interval] ["#." monad ["#/." free]] @@ -42,7 +41,6 @@ /equivalence.test /fold.test ..functor - /hash.test /interval.test ..monad /monoid.test diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux deleted file mode 100644 index f7f82ffe2..000000000 --- a/stdlib/source/test/lux/abstract/hash.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [data - ["." bit ("#@." equivalence)] - [number - ["n" nat] - ["i" int]]] - [math - ["." random]]] - {1 - ["." /]}) - -(def: #export test - Test - (do random.monad - [left random.nat - right random.int - other-left random.nat - other-right random.int] - (<| (_.covering /._) - ($_ _.and - (_.cover [/.product] - (and (n.= (:: (/.product n.hash i.hash) hash [left right]) - (n.* (:: n.hash hash left) - (:: i.hash hash right))) - (bit@= (:: (/.product n.hash i.hash) = [left right] [left right]) - (and (:: n.hash = left left) - (:: i.hash = right right))) - (bit@= (:: (/.product n.hash i.hash) = [left right] [other-left other-right]) - (and (:: n.hash = left other-left) - (:: i.hash = right other-right))))) - )))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 1a9cfd383..e096c9085 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -13,69 +12,176 @@ ["$." apply] ["$." monad]]}] [control - ["." try]] + ["." try (#+ Try)] + ["." exception]] [data + ["." bit ("#@." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." fold)]]] + ["." list ("#@." fold)] + ["." set]]] [math - ["r" random]]] + ["." random]]] {1 ["." / ("#@." monad)]}) +(def: signatures + Test + (do {@ random.monad} + [size (:: @ map (n.% 100) random.nat)] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.row size random.nat))) + (_.with-cover [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.row size random.nat))) + (_.with-cover [/.fold] + ($fold.spec /@wrap /.equivalence /.fold)) + (_.with-cover [/.functor] + ($functor.spec /@wrap /.equivalence /.functor)) + (_.with-cover [/.apply] + ($apply.spec /@wrap /.equivalence /.apply)) + (_.with-cover [/.monad] + ($monad.spec /@wrap /.equivalence /.monad)) + ))) + +(def: whole + Test + (do {@ random.monad} + [size (:: @ map (n.% 100) random.nat) + sample (random.set n.hash size random.nat) + #let [sample (|> sample set.to-list /.from-list)] + #let [(^open "/@.") (/.equivalence n.equivalence)]] + ($_ _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (/.empty? sample) (n.= 0 (/.size sample)))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.to-list /.from-list] + (|> sample /.to-list /.from-list (/@= sample))) + (_.cover [/.reverse] + (or (n.< 2 (/.size sample)) + (let [not-same! + (not (/@= sample + (/.reverse sample))) + + self-symmetry! + (/@= sample + (/.reverse (/.reverse sample)))] + (and not-same! + self-symmetry!)))) + (_.cover [/.every? /.any?] + (if (/.every? n.even? sample) + (not (/.any? (bit.complement n.even?) sample)) + (/.any? (bit.complement n.even?) sample))) + ))) + +(def: index-based + Test + (do {@ random.monad} + [size (:: @ map (|>> (n.% 100) inc) random.nat)] + ($_ _.and + (do @ + [good-index (|> random.nat (:: @ map (n.% size))) + #let [bad-index (n.+ size good-index)] + sample (random.set n.hash size random.nat) + non-member (random.filter (|>> (set.member? sample) not) + random.nat) + #let [sample (|> sample set.to-list /.from-list)]] + ($_ _.and + (_.cover [/.nth] + (case (/.nth good-index sample) + (#try.Success member) + (/.member? n.equivalence sample member) + + (#try.Failure error) + false)) + (_.cover [/.put] + (<| (try.default false) + (do try.monad + [sample (/.put good-index non-member sample) + actual (/.nth good-index sample)] + (wrap (is? non-member actual))))) + (_.cover [/.update] + (<| (try.default false) + (do try.monad + [sample (/.put good-index non-member sample) + sample (/.update good-index inc sample) + actual (/.nth good-index sample)] + (wrap (n.= (inc non-member) actual))))) + (_.cover [/.within-bounds?] + (and (/.within-bounds? sample good-index) + (not (/.within-bounds? sample bad-index)))) + (_.cover [/.index-out-of-bounds] + (let [fails! (: (All [a] (-> (Try a) Bit)) + (function (_ situation) + (case situation + (#try.Success member) + false + + (#try.Failure error) + (exception.match? /.index-out-of-bounds error))))] + (and (fails! (/.nth bad-index sample)) + (fails! (/.put bad-index non-member sample)) + (fails! (/.update bad-index inc sample))))) + )) + ))) + (def: #export test Test - (<| (_.context (%.name (name-of /._))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))] + (<| (_.covering /._) + (_.with-cover [/.Row]) + (do {@ random.monad} + [size (:: @ map (|>> (n.% 100) inc) random.nat)] ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (r.row size r.nat)) - ($monoid.spec (/.equivalence n.equivalence) /.monoid (r.row size r.nat)) - ($fold.spec /@wrap /.equivalence /.fold) - ($functor.spec /@wrap /.equivalence /.functor) - ($apply.spec /@wrap /.equivalence /.apply) - ($monad.spec /@wrap /.equivalence /.monad) + ..signatures + ..whole + ..index-based (do @ - [idx (|> r.nat (:: @ map (n.% size))) - sample (r.row size r.nat) - other-sample (r.row size r.nat) - non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not))) + [sample (random.set n.hash size random.nat) + non-member (random.filter (|>> (set.member? sample) not) + random.nat) + #let [sample (|> sample set.to-list /.from-list)] #let [(^open "/@.") (/.equivalence n.equivalence)]] ($_ _.and - (_.test (format (%.name (name-of /.size)) - " " (%.name (name-of /.empty?))) - (if (/.empty? sample) - (and (n.= 0 size) - (n.= 0 (/.size sample))) - (n.= size (/.size sample)))) - (_.test (format (%.name (name-of /.add)) - " " (%.name (name-of /.pop))) - (and (n.= (inc size) (/.size (/.add non-member sample))) - (n.= (dec size) (/.size (/.pop sample))))) - (_.test (format (%.name (name-of /.put)) - " &&& " (%.name (name-of /.nth))) - (|> sample - (/.put idx non-member) try.assume - (/.nth idx) try.assume - (is? non-member))) - (_.test (%.name (name-of /.update)) - (|> sample - (/.put idx non-member) try.assume - (/.update idx inc) try.assume - (/.nth idx) try.assume - (n.= (inc non-member)))) - (_.test (format (%.name (name-of /.to-list)) - " &&& " (%.name (name-of /.from-list))) - (|> sample /.to-list /.from-list (/@= sample))) - (_.test (%.name (name-of /.member?)) - (and (not (/.member? n.equivalence sample non-member)) - (/.member? n.equivalence (/.add non-member sample) non-member))) - (_.test (%.name (name-of /.reverse)) - (and (not (/@= sample - (/.reverse sample))) - (/@= sample - (/.reverse (/.reverse sample))))) + (do @ + [value/0 random.nat + value/1 random.nat + value/2 random.nat] + (_.cover [/.row] + (/@= (/.from-list (list value/0 value/1 value/2)) + (/.row value/0 value/1 value/2)))) + (_.cover [/.member?] + (and (list.every? (/.member? n.equivalence sample) + (/.to-list sample)) + (not (/.member? n.equivalence sample non-member)))) + (_.cover [/.add] + (let [added (/.add non-member sample) + + size-increases! + (n.= (inc (/.size sample)) + (/.size added)) + + is-a-member! + (/.member? n.equivalence added non-member)] + (and size-increases! + is-a-member!))) + (_.cover [/.pop] + (if (/.empty? sample) + (/.empty? (/.pop sample)) + (let [expected-size! + (n.= (dec (/.size sample)) + (/.size (/.pop sample))) + + symmetry! + (|> sample + (/.add non-member) + /.pop + (/@= sample))] + (and expected-size! + symmetry!)))) )) )))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index f6a1ca855..52955680e 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -37,14 +37,14 @@ (def: (random-sequence random) (All [a] (-> (Random a) (Random (List a)))) - (do {@ random.monad} - [size (|> random.nat (:: @ map (n.% 3)))] + (do {! random.monad} + [size (|> random.nat (:: ! map (n.% 3)))] (random.list size random))) (def: (random-record random) (All [a] (-> (Random a) (Random (List [a a])))) - (do {@ random.monad} - [size (|> random.nat (:: @ map (n.% 3)))] + (do {! random.monad} + [size (|> random.nat (:: ! map (n.% 3)))] (random.list size (random.and random random)))) (def: #export random @@ -85,13 +85,13 @@ (function (_ replace-simulation) (let [for-sequence (: (-> (-> (List Code) Code) (Random [Code Code])) (function (_ to-code) - (do {@ random.monad} + (do {! random.monad} [parts (..random-sequence replace-simulation)] (wrap [(to-code (list@map product.left parts)) (to-code (list@map product.right parts))]))))] ($_ random.either (random@wrap [original substitute]) - (do {@ random.monad} + (do {! random.monad} [sample (random.filter (|>> (:: /.equivalence = original) not) ($_ random.either (random@map /.bit random.bit) @@ -105,7 +105,7 @@ (wrap [sample sample])) (for-sequence /.form) (for-sequence /.tuple) - (do {@ random.monad} + (do {! random.monad} [parts (..random-sequence replace-simulation)] (wrap [(/.record (let [parts' (list@map product.left parts)] (list.zip/2 parts' parts'))) @@ -122,7 +122,7 @@ (_.with-cover [/.format] (`` ($_ _.and (~~ (template [<coverage> <random> <tag>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<coverage>] (and (case (..read (/.format (<coverage> expected))) @@ -149,7 +149,7 @@ [/.tuple (..random-sequence ..random) #.Tuple] [/.record (..random-record ..random) #.Record])) (~~ (template [<coverage> <random> <tag>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<coverage>] (and (case (..read (/.format (<coverage> expected))) @@ -168,7 +168,7 @@ [/.local-tag ..random-text #.Tag] [/.local-identifier ..random-text #.Identifier] ))))) - (do {@ random.monad} + (do {! random.monad} [[original substitute] (random.and ..random ..random) [sample expected] (..replace-simulation [original substitute])] (_.cover [/.replace] diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index bfd0a2540..985da657c 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -44,8 +44,9 @@ (def: gen-recursive (Random Recursive) (random.rec (function (_ gen-recursive) - (random.or random.frac - (random.and random.frac gen-recursive))))) + (random.or random.safe-frac + (random.and random.safe-frac + gen-recursive))))) (def: gen-record (Random Record) @@ -55,15 +56,22 @@ ($_ random.and random.bit gen-int - random.frac + random.safe-frac (random.unicode size) (random.maybe gen-int) (random.list size gen-int) - ($_ random.or random.bit gen-int random.frac) - ($_ random.and gen-int random.frac (random.unicode size)) + ($_ random.or + random.bit + gen-int + random.safe-frac) + ($_ random.and + gen-int + random.safe-frac + (random.unicode size)) gen-recursive))) -(derived: equivalence (/.equivalence Record)) +(derived: equivalence + (/.equivalence Record)) (def: #export test Test diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index 1aaf851a9..d50b94eaa 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -44,8 +44,8 @@ (def: random-annotations (Random /.Annotations) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 3)) random.nat)] + (do {! random.monad} + [size (:: ! map (|>> (n.% 3)) random.nat)] (random.list size (random.and random-name ///code.random)))) @@ -89,8 +89,8 @@ (#try.Failure error) false))) )) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 3)) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 3)) random.nat) expected (random.list size ..random-text)] (_.cover [/.Type-Var /reader.type-variables /writer.type-variables] (|> expected @@ -101,8 +101,8 @@ (#try.Failure error) false)))) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 3)) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 3)) random.nat) expected (: (Random /.Declaration) (random.and ..random-text (random.list size ..random-text)))] @@ -117,7 +117,7 @@ (#try.Failure error) false)))) - (do {@ random.monad} + (do {! random.monad} [expected (: (Random /.Typed-Input) (random.and ///code.random ///code.random))] diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index c29b25b97..673099c34 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -36,8 +36,8 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and (<| (_.context "Trigonometry") - (do {@ r.monad} - [angle (|> r.safe-frac (:: @ map (f.* /.tau)))] + (do {! r.monad} + [angle (|> r.safe-frac (:: ! map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." (trigonometric-symmetry /.sin /.asin angle)) @@ -47,8 +47,8 @@ (trigonometric-symmetry /.tan /.atan angle)) ))) (<| (_.context "Rounding") - (do {@ r.monad} - [sample (|> r.safe-frac (:: @ map (f.* +1000.0)))] + (do {! r.monad} + [sample (|> r.safe-frac (:: ! map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (/.ceil sample)] @@ -66,13 +66,13 @@ (f.<= +1.0 (f.abs (f.- sample round'd)))))) ))) (<| (_.context "Exponentials and logarithms") - (do {@ r.monad} - [sample (|> r.safe-frac (:: @ map (f.* +10.0)))] + (do {! r.monad} + [sample (|> r.safe-frac (:: ! map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") - (do {@ r.monad} - [#let [gen-nat (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1))))] + (do {! r.monad} + [#let [gen-nat (|> r.nat (:: ! map (|>> (n.% 1000) (n.max 1))))] x gen-nat y gen-nat] ($_ _.and diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index d692cb3f4..16e9116c1 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -143,9 +143,9 @@ (def: predicates-and-sets Test - (do {@ random.monad} + (do {! random.monad} [#let [set-10 (set.from-list n.hash (enum.range n.enum 0 10))] - sample (|> random.nat (:: @ map (n.% 20)))] + sample (|> random.nat (:: ! map (n.% 20)))] ($_ _.and (_.test (%.name (name-of /.from-predicate)) (bit@= (r.= //.true (/.membership sample (/.from-predicate n.even?))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 4eefd9e03..3a98b5380 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -299,8 +299,8 @@ (template [<name> <bits> <type> <push> <wrap> <message> <to-long> <signed>] [(def: <name> Test - (do {@ random.monad} - [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)] + (do {! random.monad} + [expected (:: ! map (i64.and (i64.mask <bits>)) random.nat)] (<| (_.lift <message>) (..bytecode (for {@.old (|>> (:coerce <type>) <to-long> ("jvm leq" expected)) @@ -377,8 +377,8 @@ instruction))))) shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) - (do {@ random.monad} - [parameter (:: @ map (|>> (n.% 32) .int (:coerce java/lang/Long) host.long-to-int) random.nat) + (do {! random.monad} + [parameter (:: ! map (|>> (n.% 32) .int (:coerce java/lang/Long) host.long-to-int) random.nat) subject ..$Integer::random] (int (reference parameter subject) (do /.monad @@ -456,8 +456,8 @@ instruction))))) shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) (function (_ reference instruction) - (do {@ random.monad} - [parameter (:: @ map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) + (do {! random.monad} + [parameter (:: ! map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) subject ..$Long::random] (long (reference (host.long-to-int parameter) subject) (do /.monad @@ -937,8 +937,8 @@ (-> a Any Bit) Test)) (function (_ constructor random literal [*store *load *wrap] test) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 1024) (n.max 1)) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 1024) (n.max 1)) random.nat) value random] ($_ _.and (<| (_.lift "length") @@ -1009,12 +1009,12 @@ (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] (function (_ expected) (|>> (:coerce Text) (text@= (:coerce Text expected)))))) (<| (_.context "multi") - (do {@ random.monad} - [#let [size (:: @ map (|>> (n.% 10) (n.+ 1)) + (do {! random.monad} + [#let [size (:: ! map (|>> (n.% 10) (n.+ 1)) random.nat)] dimensions size sizesH size - sizesT (monad.seq @ (list.repeat (dec dimensions) size)) + sizesT (monad.seq ! (list.repeat (dec dimensions) size)) #let [type (loop [dimensions dimensions type (: (Type Object) ..$Object)] @@ -1023,8 +1023,8 @@ _ (recur (dec dimensions) (/type.array type))))]] (<| (_.lift "MULTIANEWARRAY") (..bytecode (|>> (:coerce Nat) (n.= sizesH))) - (do {@ /.monad} - [_ (monad.map @ (|>> (:coerce java/lang/Long) host.long-to-int ..$Integer::literal) + (do {! /.monad} + [_ (monad.map ! (|>> (:coerce java/lang/Long) host.long-to-int ..$Integer::literal) (#.Cons sizesH sizesT)) _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume)) _ ?length] @@ -1121,9 +1121,9 @@ (-> a (-> Any Bit)) (Random Bit))) (function (_ random-value literal *wrap [store load] test) - (do {@ random.monad} + (do {! random.monad} [expected random-value - register (:: @ map (n.% 128) random.nat)] + register (:: ! map (n.% 128) random.nat)] (<| (..bytecode (test expected)) (do /.monad [_ (literal expected) @@ -1145,9 +1145,9 @@ (_.lift "ISTORE/ILOAD" (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) (_.lift "IINC" - (do {@ random.monad} + (do {! random.monad} [base ..$Byte::random - increment (:: @ map (|>> (n.% 100) /unsigned.u1 try.assume) + increment (:: ! map (|>> (n.% 100) /unsigned.u1 try.assume) random.nat) #let [expected (: java/lang/Long (for {@.old @@ -1468,12 +1468,12 @@ Test ($_ _.and (<| (_.lift "TABLESWITCH") - (do {@ random.monad} + (do {! random.monad} [expected ..$Long::random dummy ..$Long::random - minimum (:: @ map (|>> (n.% 100) .int /signed.s4 try.assume) + minimum (:: ! map (|>> (n.% 100) .int /signed.s4 try.assume) random.nat) - afterwards (:: @ map (n.% 10) random.nat)]) + afterwards (:: ! map (n.% 10) random.nat)]) (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad [@right /.new-label @@ -1489,14 +1489,14 @@ _ (/.set-label @return)] ..$Long::wrap)) (<| (_.lift "LOOKUPSWITCH") - (do {@ random.monad} - [options (:: @ map (|>> (n.% 10) (n.+ 1)) + (do {! random.monad} + [options (:: ! map (|>> (n.% 10) (n.+ 1)) random.nat) - choice (:: @ map (n.% options) random.nat) + choice (:: ! map (n.% options) random.nat) options (|> random.int - (:: @ map (|>> (:coerce java/lang/Long) host.long-to-int host.int-to-long (:coerce Int))) + (:: ! map (|>> (:coerce java/lang/Long) host.long-to-int host.int-to-long (:coerce Int))) (random.set i.hash options) - (:: @ map set.to-list)) + (:: ! map set.to-list)) #let [choice (maybe.assume (list.nth choice options))] expected ..$Long::random dummy ..$Long::random]) |