diff options
Diffstat (limited to '')
38 files changed, 261 insertions, 226 deletions
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 5f2b553d3..dabd82b7d 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -116,8 +116,8 @@ (syntax: #export (apply {arity (|> <c>.nat (<>.filter (n.> 0)))}) (with-gensyms [g! g!func g!stack g!output] - (monad.do {@ meta.monad} - [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq @))] + (monad.do {! meta.monad} + [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq !))] (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] (-> (-> (~+ g!inputs) (~ g!output)) (=> [(~+ g!inputs)] [(~ g!output)]))) diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index 7a4c46856..5e1bf7c3c 100644 --- a/stdlib/source/lux/control/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux @@ -146,7 +146,7 @@ (def: #export (run! _) (-> Any (IO Any)) - (do {@ io.monad} + (do {! io.monad} [processes (atom.read ..runner)] (case processes ## And... we're done! @@ -154,7 +154,7 @@ (wrap []) _ - (do @ + (do ! [#let [now (.nat ("lux io current-time")) [ready pending] (list.partition (function (_ process) (|> (get@ #creation process) @@ -163,8 +163,8 @@ processes)] swapped? (atom.compare-and-swap processes pending ..runner)] (if swapped? - (do @ - [_ (monad.map @ (get@ #action) ready)] + (do ! + [_ (monad.map ! (get@ #action) ready)] (run! [])) (error! (ex.construct ..cannot-continue-running-processes [])))) ))) diff --git a/stdlib/source/lux/control/function/memo.lux b/stdlib/source/lux/control/function/memo.lux index c03237cf8..324fae7d1 100644 --- a/stdlib/source/lux/control/function/memo.lux +++ b/stdlib/source/lux/control/function/memo.lux @@ -20,14 +20,14 @@ (Mixin i (State (Dictionary i o) o))) (function (_ delegate recur) (function (_ input) - (do {@ state.monad} + (do {! state.monad} [memory state.get] (case (dictionary.get input memory) (#.Some output) (wrap output) #.None - (do @ + (do ! [output (delegate input) _ (state.update (dictionary.put input output))] (wrap output))))))) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 485c1091c..e69493f69 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -46,10 +46,10 @@ {declaration reader.declaration} {annotations (<>.maybe reader.annotations)} {[forge input output] (<c>.form ($_ <>.and <c>.local-identifier <c>.any <c>.any))}) - (do {@ meta.monad} + (do {! meta.monad} [this-module meta.current-module-name #let [[name vars] declaration] - g!brand (:: @ map (|>> %.code code.text) + g!brand (:: ! map (|>> %.code code.text) (meta.gensym (format (%.name [this-module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (writer.export export)) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 38a9bf63b..d35df1b53 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -581,13 +581,13 @@ (def: wrap (|>> (:: ..monad wrap) (:: monad wrap))) (def: (join MlMla) - (do {@ monad} + (do {! monad} [lMla MlMla ## TODO: Remove this version ASAP and use one below. lla (for {@.old (: (($ 0) (List (List ($ 1)))) - (monad.seq @ lMla))} - (monad.seq @ lMla))] + (monad.seq ! lMla))} + (monad.seq ! lMla))] (wrap (concat lla))))) (def: #export (lift monad) diff --git a/stdlib/source/lux/data/collection/stack.lux b/stdlib/source/lux/data/collection/stack.lux index 089398ca5..e9a7f8bf4 100644 --- a/stdlib/source/lux/data/collection/stack.lux +++ b/stdlib/source/lux/data/collection/stack.lux @@ -5,51 +5,61 @@ [functor (#+ Functor)]] [data [collection - ["//" list]]]]) + ["//" list]]] + [type + abstract]]) -(type: #export (Stack a) - (List a)) +(abstract: #export (Stack a) + (List a) -(def: #export empty - Stack - (list)) + (def: #export empty + Stack + (:abstraction (list))) -(def: #export size - (All [a] (-> (Stack a) Nat)) - //.size) + (def: #export size + (All [a] (-> (Stack a) Nat)) + (|>> :representation //.size)) -(def: #export empty? - (All [a] (-> (Stack a) Bit)) - //.empty?) + (def: #export empty? + (All [a] (-> (Stack a) Bit)) + (|>> :representation //.empty?)) -(def: #export (peek stack) - (All [a] (-> (Stack a) (Maybe a))) - (case stack - #.Nil - #.None - - (#.Cons value _) - (#.Some value))) - -(def: #export (pop stack) - (All [a] (-> (Stack a) (Maybe (Stack a)))) - (case stack - #.Nil - #.None + (def: #export (peek stack) + (All [a] (-> (Stack a) (Maybe a))) + (case (:representation stack) + #.Nil + #.None + + (#.Cons value _) + (#.Some value))) + + (def: #export (pop stack) + (All [a] (-> (Stack a) (Maybe [a (Stack a)]))) + (case (:representation stack) + #.Nil + #.None + + (#.Cons top stack') + (#.Some [top (:abstraction stack')]))) + + (def: #export (push value stack) + (All [a] (-> a (Stack a) (Stack a))) + (:abstraction (#.Cons value (:representation stack)))) + + (structure: #export (equivalence super) + (All [a] + (-> (Equivalence a) + (Equivalence (Stack a)))) + + (def: (= reference subject) + (:: (//.equivalence super) = (:representation reference) (:representation subject)))) + + (structure: #export functor + (Functor Stack) - (#.Cons _ stack') - (#.Some stack'))) - -(def: #export (push value stack) - (All [a] (-> a (Stack a) (Stack a))) - (#.Cons value stack)) - -(def: #export equivalence - (All [a] - (-> (Equivalence a) - (Equivalence (Stack a)))) - //.equivalence) - -(def: #export functor - (Functor Stack) - //.functor) + (def: (map f value) + (|> value + :representation + (:: //.functor map f) + :abstraction))) + ) diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux index 612d8be49..aab50c4f3 100644 --- a/stdlib/source/lux/data/collection/tree.lux +++ b/stdlib/source/lux/data/collection/tree.lux @@ -43,14 +43,15 @@ <>.rec <>.some <c>.record - (<>.and <c>.any) - <c>.tuple)) + (<>.and <c>.any))) (syntax: #export (tree {root tree^}) {#.doc (doc "Tree literals." - (tree Int [+10 {+20 {} - +30 {} - +40 {}}]))} + (: (Tree Nat) + (tree 10 + {20 {} + 30 {} + 40 {}})))} (wrap (list (` (~ (loop [[value children] root] (` {#value (~ value) #children (list (~+ (list@map recur children)))}))))))) diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux index d4b7ec4f6..a0b9eca9c 100644 --- a/stdlib/source/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/lux/data/collection/tree/zipper.lux @@ -9,15 +9,14 @@ [data ["." maybe ("#@." monad)] [collection - ["." list ("#@." functor fold monoid)] - ["." stack (#+ Stack)]]]] + ["." list ("#@." functor fold monoid)]]]] ["." // (#+ Tree) ("#@." functor)]) (type: #export (Zipper a) {#.doc "Tree zippers, for easy navigation and editing over trees."} {#parent (Maybe (Zipper a)) - #lefts (Stack (Tree a)) - #rights (Stack (Tree a)) + #lefts (List (Tree a)) + #rights (List (Tree a)) #node (Tree a)}) (structure: #export (equivalence ,equivalence) @@ -28,10 +27,10 @@ (and (:: (//.equivalence ,equivalence) = (get@ #node reference) (get@ #node sample)) - (:: (stack.equivalence (//.equivalence ,equivalence)) = + (:: (list.equivalence (//.equivalence ,equivalence)) = (get@ #lefts reference) (get@ #lefts sample)) - (:: (stack.equivalence (//.equivalence ,equivalence)) = + (:: (list.equivalence (//.equivalence ,equivalence)) = (get@ #rights reference) (get@ #rights sample)) (:: (maybe.equivalence (equivalence ,equivalence)) = @@ -42,8 +41,8 @@ (def: #export (zip tree) (All [a] (-> (Tree a) (Zipper a))) {#parent #.None - #lefts stack.empty - #rights stack.empty + #lefts #.Nil + #rights #.Nil #node tree}) (def: #export (unzip zipper) @@ -83,7 +82,7 @@ (#.Cons head tail) {#parent (#.Some zipper) - #lefts stack.empty + #lefts #.Nil #rights tail #node head})) @@ -203,8 +202,8 @@ (function (_ children) (list& (for {@.old (: (Tree ($ 0)) - (//.tree [value {}]))} - (//.tree [value {}])) + (//.tree value {}))} + (//.tree value {})) children)) zipper)) @@ -215,8 +214,8 @@ (list@compose children (list (for {@.old (: (Tree ($ 0)) - (//.tree [value {}]))} - (//.tree [value {}]))))) + (//.tree value {}))} + (//.tree value {}))))) zipper)) (def: #export (remove zipper) @@ -248,8 +247,8 @@ (update@ <side> (function (_ side) (#.Cons (for {@.old (: (Tree ($ 0)) - (//.tree [value {}]))} - (//.tree [value {}])) + (//.tree value {}))} + (//.tree value {})) side)))))))] [insert-left #lefts] diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 98d33258b..a71498055 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -83,10 +83,10 @@ (def: re-range^ (Parser Code) - (do {@ <>.monad} - [from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume))) + (do {! <>.monad} + [from (|> regex-char^ (:: ! map (|>> (//.nth 0) maybe.assume))) _ (<t>.this "-") - to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))] + to (|> regex-char^ (:: ! map (|>> (//.nth 0) maybe.assume)))] (wrap (` (<t>.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ @@ -229,22 +229,22 @@ (def: (re-counted-quantified^ current-module) (-> Text (Parser Code)) - (do {@ <>.monad} + (do {! <>.monad} [base (re-simple^ current-module)] (<t>.enclosed ["{" "}"] ($_ <>.either - (do @ + (do ! [[from to] (<>.and number^ (<>.after (<t>.this ",") number^))] (wrap (` ((~! join-text^) (<>.between (~ (code.nat from)) (~ (code.nat to)) (~ base)))))) - (do @ + (do ! [limit (<>.after (<t>.this ",") number^)] (wrap (` ((~! join-text^) (<>.at-most (~ (code.nat limit)) (~ base)))))) - (do @ + (do ! [limit (<>.before (<t>.this ",") number^)] (wrap (` ((~! join-text^) (<>.at-least (~ (code.nat limit)) (~ base)))))) - (do @ + (do ! [limit number^] (wrap (` ((~! join-text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b4260c691..87ec823d6 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1166,9 +1166,9 @@ (type.class "java.lang.Object" (list))) (syntax: #export (class: - {#let [@ <>.monad]} + {#let [! <>.monad]} {im inheritance-modifier^} - {[full-class-name class-vars] (:: @ map parser.declaration ..declaration^)} + {[full-class-name class-vars] (:: ! map parser.declaration ..declaration^)} {super (<>.default $Object (class^ class-vars))} {interfaces (<>.default (list) @@ -1224,8 +1224,8 @@ [(~+ (list@map (method-def$ replacer super) methods))])))))) (syntax: #export (interface: - {#let [@ <>.monad]} - {[full-class-name class-vars] (:: @ map parser.declaration ..declaration^)} + {#let [! <>.monad]} + {[full-class-name class-vars] (:: ! map parser.declaration ..declaration^)} {supers (<>.default (list) (<c>.tuple (<>.some (class^ class-vars))))} {annotations ..annotations^} @@ -1396,8 +1396,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 (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) (with-gensyms [arg-name] @@ -1756,9 +1756,9 @@ (java/util/List::size [] my-list) java/lang/Character$UnicodeScript::LATIN )} - (do {@ meta.monad} + (do {! meta.monad} [kind (class-kind declaration) - =members (monad.map @ (member-import$ class-type-vars kind declaration) members)] + =members (monad.map ! (member-import$ class-type-vars kind declaration) members)] (wrap (list& (class-import$ declaration) (list@join =members))))) (syntax: #export (array {type (..type^ (list))} diff --git a/stdlib/source/lux/meta/annotation.lux b/stdlib/source/lux/meta/annotation.lux index fa412d6d0..ea47f6970 100644 --- a/stdlib/source/lux/meta/annotation.lux +++ b/stdlib/source/lux/meta/annotation.lux @@ -86,9 +86,9 @@ [(def: #export (<name> ann) (-> Annotation (List Text)) (maybe.default (list) - (do {@ maybe.monad} + (do {! maybe.monad} [args (..tuple (name-of <tag>) ann)] - (monad.map @ ..parse-text args))))] + (monad.map ! ..parse-text args))))] [function-arguments #.func-args] [type-arguments #.type-args] diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index ecfb1edb1..18457f024 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -130,7 +130,7 @@ minute (to-millis duration.minute) second (to-millis duration.second) millis (to-millis duration.milli-second)] - (do {@ <>.monad} + (do {! <>.monad} [utc-hour ..parse-hour _ (<t>.this ..separator) utc-minute ..parse-minute diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 53312a487..f38b20ccd 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -155,17 +155,23 @@ (def: parser (Parser Duration) - (let [section (: (-> Text (Parser Nat)) - (function (_ suffix) - (|> (<t>.many <t>.decimal) (<>.codec nat.decimal) (<>.before (<t>.this suffix)) (<>.default 0))))] + (let [section (: (-> Text Text (Parser Nat)) + (function (_ suffix false-suffix) + (|> (<t>.many <t>.decimal) + (<>.codec nat.decimal) + (<>.before (case false-suffix + "" (<t>.this suffix) + _ (<>.after (<>.not (<t>.this false-suffix)) + (<t>.this suffix)))) + (<>.default 0))))] (do <>.monad [sign (<>.or (<t>.this ..negative-sign) (<t>.this ..positive-sign)) - days (section ..day-suffix) - hours (section hour-suffix) - minutes (section ..minute-suffix) - seconds (section ..second-suffix) - millis (section ..milli-second-suffix) + days (section ..day-suffix "") + hours (section hour-suffix "") + minutes (section ..minute-suffix ..milli-second-suffix) + seconds (section ..second-suffix "") + millis (section ..milli-second-suffix "") #let [span (|> ..empty (..merge (..scale-up days ..day)) (..merge (..scale-up hours ..hour)) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 5f044fa71..252fccc68 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -129,10 +129,10 @@ (def: parser (Parser Instant) - (do {@ <>.monad} - [days (:: @ map date.days date.parser) + (do {! <>.monad} + [days (:: ! map date.days date.parser) _ (<t>.this ..date-suffix) - time (:: @ map //.to-millis //.parser) + time (:: ! map //.to-millis //.parser) _ (<t>.this ..time-suffix)] (wrap (|> (if (i.< +0 days) (|> duration.day diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux index 43e2181ab..3be07b2ca 100644 --- a/stdlib/source/lux/time/year.lux +++ b/stdlib/source/lux/time/year.lux @@ -109,7 +109,7 @@ (def: #export parser (Parser Year) - (do {@ <>.monad} + (do {! <>.monad} [sign (<>.or (<t>.this "-") (wrap [])) digits (<t>.many <t>.decimal) raw-year (<>.codec i.decimal (wrap (text@compose "+" digits)))] diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 8a6e0825d..64e66be2d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -219,7 +219,7 @@ (def: #export (save! name code) (All [anchor expression directive] (-> Text directive (Operation anchor expression directive Any))) - (do {@ phase.monad} + (do {! phase.monad} [?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux index ab1cc08de..6d66678ac 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -230,7 +230,7 @@ (///////phase@wrap (_.define (..register register) ..peek-cursor)) (#/////synthesis.Bit-Fork when thenP elseP) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [then! (recur thenP) else! (.case elseP (#.Some elseP) @@ -247,9 +247,9 @@ then!)))) (#/////synthesis.I64-Fork cons) - (do {@ ///////phase.monad} - [clauses (monad.map @ (function (_ [match then]) - (do @ + (do {! ///////phase.monad} + [clauses (monad.map ! (function (_ [match then]) + (do ! [then! (recur then)] (wrap [(//runtime.i64//= (//primitive.i64 (.int match)) ..peek-cursor) @@ -259,9 +259,9 @@ (^template [<tag> <format> <type>] (<tag> cons) - (do {@ ///////phase.monad} - [cases (monad.map @ (function (_ [match then]) - (:: @ map (|>> [(list (<format> match))]) (recur then))) + (do {! ///////phase.monad} + [cases (monad.map ! (function (_ [match then]) + (:: ! map (|>> [(list (<format> match))]) (recur then))) (#.Cons cons))] (wrap (_.switch ..peek-cursor cases diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 93b400c37..0f311d61b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -30,9 +30,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) (def: (with-closure @self inits function-body) @@ -64,10 +64,10 @@ (def: #export (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name body!] (/////generation.with-new-context archive - (do @ - [scope (:: @ map ..@scope + (do ! + [scope (:: ! map ..@scope (/////generation.context archive))] (/////generation.with-anchor [1 scope] (statement expression archive bodyS)))) @@ -84,7 +84,7 @@ (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) initialize-self! (list.indices arity))] - environment (monad.map @ (expression archive) environment) + environment (monad.map ! (expression archive) environment) #let [[definition instantiation] (with-closure @self environment ($_ _.then (_.define @num-args (_.the "length" @@arguments)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 05ac70a6a..f73decb82 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -85,8 +85,8 @@ (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) - (do {@ macro.monad} - [ids (monad.seq @ (list.repeat (list.size vars) macro.count))] + (do {! macro.monad} + [ids (monad.seq ! (list.repeat (list.size vars) macro.count))] (wrap (list (` (let [(~+ (|> vars (list.zip/2 ids) (list@map (function (_ [id var]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index dee0aa051..acd36a5ba 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -23,8 +23,8 @@ (generate archive singletonS) _ - (do {@ ///////phase.monad} - [elemsT+ (monad.map @ (generate archive) elemsS+)] + (do {! ///////phase.monad} + [elemsT+ (monad.map ! (generate archive) elemsS+)] (wrap (_.array elemsT+))))) (def: #export (variant generate archive [lefts right? valueS]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 0f440080f..8f9a4ce74 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -27,9 +27,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ functionO)))) (def: #export capture @@ -45,8 +45,8 @@ (wrap (|> (_.var function-name) (_.apply/* inits)))) _ - (do {@ ///////phase.monad} - [@closure (:: @ map _.var (/////generation.gensym "closure")) + (do {! ///////phase.monad} + [@closure (:: ! map _.var (/////generation.gensym "closure")) #let [directive (_.function @closure (|> (list.enumeration inits) (list@map (|>> product.left ..capture))) @@ -62,15 +62,15 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context - (do @ - [function-name (:: @ map ///reference.artifact-name + (do ! + [function-name (:: ! map ///reference.artifact-name /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map ! (:: //reference.system variable) environment)) #let [function-name (///reference.artifact-name function-name) @curried (_.var "curried") arityO (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index 957924e8f..f65883c4c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -27,9 +27,9 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {@ ///////phase.monad} - [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ (generate archive) initsS+) + (do {! ///////phase.monad} + [@loop (:: ! map ..loop-name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) bodyO (/////generation.with-anchor @loop (generate archive bodyS)) #let [directive (_.function @loop (|> initsS+ @@ -42,7 +42,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 34368c147..811ce3c93 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -216,13 +216,13 @@ (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation (Expression Any))) - (do {@ ////.monad} + (do {! ////.monad} [initG (generate valueS) pattern-matching! (pattern-matching generate pathP) @case (..gensym "case") #let [@caseG (_.global @case) @caseL (_.var @case)] - @init (:: @ map _.var (..gensym "init")) + @init (:: ! map _.var (..gensym "init")) #let [@dependencies+ (|> (case.storage pathP) (get@ #case.dependencies) set.to-list diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux index d03d4babc..58fb0a4b9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -26,9 +26,9 @@ (def: #export (apply generate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation (Expression Any))) - (do {@ ////.monad} + (do {! ////.monad} [functionG (generate functionS) - argsG+ (monad.map @ generate argsS+)] + argsG+ (monad.map ! generate argsS+)] (wrap (_.apply/* argsG+ functionG)))) (def: #export capture @@ -39,15 +39,15 @@ (def: #export (function generate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) - (do {@ ////.monad} + (do {! ////.monad} [[function-name bodyG] (///.with-context - (do @ + (do ! [function-name ///.context] (///.with-anchor (_.var function-name) (generate bodyS)))) closureG+ (: (Operation (List Argument)) - (monad.map @ (|>> (:: //reference.system variable) - (:: @ map _.reference)) + (monad.map ! (|>> (:: //reference.system variable) + (:: ! map _.reference)) environment)) #let [@curried (_.var "curried") arityG (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 15734c737..000789484 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -22,11 +22,11 @@ (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do {@ ////.monad} - [@loop (:: @ map (|>> %.nat (format "loop")) ///.next) + (do {! ////.monad} + [@loop (:: ! map (|>> %.nat (format "loop")) ///.next) #let [@loopG (_.global @loop) @loopL (_.var @loop)] - initsO+ (monad.map @ generate initsS+) + initsO+ (monad.map ! generate initsS+) bodyO (///.with-anchor @loopL (generate bodyS)) #let [directive ($_ _.then @@ -44,7 +44,7 @@ (def: #export (recur generate argsS+) (-> Phase (List Synthesis) (Operation (Expression Any))) - (do {@ ////.monad} + (do {! ////.monad} [@scope ///.anchor - argsO+ (monad.map @ generate argsS+)] + argsO+ (monad.map ! generate argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index 30f3f38fd..043941530 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -27,9 +27,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) (def: #export capture @@ -45,8 +45,8 @@ (wrap (_.apply/* (_.var function-name) inits))) _ - (do {@ ///////phase.monad} - [@closure (:: @ map _.var (/////generation.gensym "closure")) + (do {! ///////phase.monad} + [@closure (:: ! map _.var (/////generation.gensym "closure")) #let [directive (_.def @closure (|> (list.enumeration inits) (list@map (|>> product.left ..capture))) @@ -62,15 +62,15 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context - (do @ - [function-name (:: @ map ///reference.artifact-name + (do ! + [function-name (:: ! map ///reference.artifact-name /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map ! (:: //reference.system variable) environment)) #let [function-name (///reference.artifact-name function-name) @curried (_.var "curried") arityO (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 042cbba35..49fd86575 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -27,9 +27,9 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {@ ///////phase.monad} - [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ (generate archive) initsS+) + (do {! ///////phase.monad} + [@loop (:: ! map ..loop-name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) bodyO (/////generation.with-anchor @loop (generate archive bodyS)) #let [directive (_.def @loop (|> initsS+ @@ -42,7 +42,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 76a25d333..df8fccb33 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -27,9 +27,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.do "call" argsO+ functionO)))) (def: #export capture @@ -54,15 +54,15 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context - (do @ - [function-name (:: @ map ///reference.artifact-name + (do ! + [function-name (:: ! map ///reference.artifact-name /////generation.context)] (/////generation.with-anchor (_.local function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map ! (:: //reference.system variable) environment)) #let [function-name (///reference.artifact-name function-name) @curried (_.local "curried") arityO (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index 149e67c31..c9c68139c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -27,9 +27,9 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {@ ///////phase.monad} - [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ (generate archive) initsS+) + (do {! ///////phase.monad} + [@loop (:: ! map ..loop-name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) bodyO (/////generation.with-anchor @loop (generate archive bodyS))] (wrap (|> (_.return bodyO) @@ -41,7 +41,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux index a413a878a..034c72a19 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux @@ -164,8 +164,8 @@ (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation Computation)) - (do {@ ////.monad} + (do {! ////.monad} [valueO (generate valueS)] - (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))] + (<| (:: ! map (_.let (list [@cursor (_.list/* (list valueO))] [@savepoint (_.list/* (list))]))) (pattern-matching generate pathP)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux index d56ae6504..18a74a4a3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux @@ -22,8 +22,8 @@ (generate singletonS) _ - (do {@ ///.monad} - [elemsT+ (monad.map @ generate elemsS+)] + (do {! ///.monad} + [elemsT+ (monad.map ! generate elemsS+)] (wrap (_.vector/* elemsT+))))) (def: #export (variant generate [lefts right? valueS]) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux index 1619794d1..f34f72acd 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -124,15 +124,15 @@ (def: #export parser (Parser Registry) (let [category (: (Parser Category) - (do {@ <>.monad} + (do {! <>.monad} [tag <b>.nat] (case tag - 0 (:: @ map (|>> #Anonymous) <b>.any) - 1 (:: @ map (|>> #Definition) <b>.text) - 2 (:: @ map (|>> #Analyser) <b>.text) - 3 (:: @ map (|>> #Synthesizer) <b>.text) - 4 (:: @ map (|>> #Generator) <b>.text) - 5 (:: @ map (|>> #Directive) <b>.text) + 0 (:: ! map (|>> #Anonymous) <b>.any) + 1 (:: ! map (|>> #Definition) <b>.text) + 2 (:: ! map (|>> #Analyser) <b>.text) + 3 (:: ! map (|>> #Synthesizer) <b>.text) + 4 (:: ! map (|>> #Generator) <b>.text) + 5 (:: ! map (|>> #Directive) <b>.text) _ (<>.fail (exception.construct ..invalid-category [tag])))))] (|> (<b>.row/64 category) (:: <>.monad map (row@fold (function (_ artifact registry) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index f4cf769eb..c807e5279 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -131,7 +131,7 @@ (def: #export (package monad file-system static archive program) (All [!] (Packager !)) - (do {@ (try.with monad)} + (do {! (try.with monad)} [cache (:share [!] {(Monad !) monad} @@ -152,7 +152,7 @@ (:: monad wrap)) #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte)) sink (java/util/jar/JarOutputStream::new buffer (..manifest program))] - sink (monad.fold @ (..write-module monad file-system static) sink order) + sink (monad.fold ! (..write-module monad file-system static) sink order) #let [_ (do-to sink (java/io/Flushable::flush) (java/io/Closeable::close))]] diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index bbbba4978..a80c28af1 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -72,7 +72,7 @@ (-> directive directive directive) (Packager !))) (function (package monad file-system static archive program) - (do {@ (try.with monad)} + (do {! (try.with monad)} [cache (!.use (:: file-system directory) [(get@ #static.target static)]) order (:: monad wrap (dependency.load-order $.key archive))] (|> order @@ -83,5 +83,5 @@ artifact.artifacts row.to-list (list@map (|>> (get@ #artifact.id))))])) - (monad.fold @ (..write-module monad file-system static sequence) header) - (:: @ map (|>> to-code encoding.to-utf8)))))) + (monad.fold ! (..write-module monad file-system static sequence) header) + (:: ! map (|>> to-code encoding.to-utf8)))))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 0478b906e..639f58137 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -10,8 +10,7 @@ ["." name ("#@." codec)] ["." text ("#@." equivalence monoid)] [collection - ["." list ("#@." functor monoid)] - ["." stack (#+ Stack)]]] + ["." list ("#@." functor monoid)]]] ["." meta] [macro ["." code] @@ -21,6 +20,20 @@ ["csw" writer]]]] [type (#+ :cast)]]) +(type: Stack List) + +(def: peek + (All [a] (-> (Stack a) (Maybe a))) + list.head) + +(def: (push value stack) + (All [a] (-> a (Stack a) (Stack a))) + (#.Cons value stack)) + +(def: pop + (All [a] (-> (Stack a) (Maybe (Stack a)))) + list.tail) + (type: Scope {#name Text #type-vars (List Code) @@ -29,7 +42,7 @@ (def: scopes (Stack Scope) - stack.empty) + #.Nil) (template: (!peek <source> <reference> <then>) (loop [entries <source>] @@ -71,7 +84,7 @@ current-scopes) #.None - (stack.peek current-scopes)) + (..peek current-scopes)) (#.Some scope) (#.Right [compiler scope]) @@ -102,12 +115,12 @@ (#.Right [exported? scopes-type scopes-anns - (stack.push scope (:coerce (Stack Scope) scopes-value))])))) + (..push scope (:coerce (Stack Scope) scopes-value))])))) (def: (push-scope [module-reference definition-reference] scope source) (-> Name Scope (List [Text Module]) (List [Text Module])) (!push source module-reference - (|> head (update@ #.definitions (push-scope-definition definition-reference scope))))) + (update@ #.definitions (push-scope-definition definition-reference scope) head))) (def: (push! scope) (-> Scope (Meta Any)) @@ -129,7 +142,7 @@ scopes-type scopes-anns (let [current-scopes (:coerce (Stack Scope) scopes-value)] - (case (stack.pop current-scopes) + (case (..pop current-scopes) (#.Some current-scopes') current-scopes' diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 277a3018d..00b259c40 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -647,37 +647,43 @@ [(def: #export (<get> monad system path) (All [!] (-> (Monad !) (System !) Path (! (Try (<signature> !))))) (do monad - [outcome (!.use (:: system <create>) path)] + [outcome (!.use (:: system <find>) path)] (case outcome (#try.Success file) (wrap (#try.Success file)) (#try.Failure error) (if (exception.match? <exception> error) - (!.use (:: system <find>) path) + (!.use (:: system <create>) path) (wrap (#try.Failure error))))))] - [get-file File create-file file ..cannot-create-file] - [get-directory Directory create-directory directory ..cannot-create-directory] + [get-file File create-file file ..cannot-find-file] + [get-directory Directory create-directory directory ..cannot-find-directory] + ) + +(template [<predicate> <capability>] + [(def: #export (<predicate> monad system path) + (All [!] (-> (Monad !) (System !) Path (! Bit))) + (do monad + [?file (!.use (:: system <capability>) path)] + (case ?file + (#try.Success file) + (wrap true) + + (#try.Failure _) + (wrap false))))] + + [file-exists? file] + [directory-exists? directory] ) (def: #export (exists? monad system path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do monad - [?file (!.use (:: system file) path)] - (case ?file - (#try.Success file) - (wrap true) - - (#try.Failure _) - (do monad - [?directory (!.use (:: system directory) path)] - (case ?directory - (#try.Success directory) - (wrap true) - - (#try.Failure _) - (wrap false)))))) + [verdict (..file-exists? monad system path)] + (if verdict + (wrap verdict) + (..directory-exists? monad system path)))) (type: Mock-File {#mock-last-modified Instant @@ -1118,7 +1124,7 @@ (do {! stm.monad} [|store| (stm.read store)] (case (..create-mock-directory! separator path |store|) - (#try.Success _) + (#try.Success |store|) (do ! [_ (stm.write |store| store)] (wrap (#try.Success (..mock-directory separator path store)))) diff --git a/stdlib/source/lux/world/net/http/query.lux b/stdlib/source/lux/world/net/http/query.lux index 05946c427..315872b00 100644 --- a/stdlib/source/lux/world/net/http/query.lux +++ b/stdlib/source/lux/world/net/http/query.lux @@ -20,21 +20,21 @@ (Parser Text) (p.rec (function (_ component) - (do {@ p.monad} + (do {! p.monad} [head (l.some (l.none-of "+%&;"))] ($_ p.either (p.after (p.either l.end (l.this "&")) (wrap head)) - (do @ + (do ! [_ (l.this "+") tail component] (wrap (format head " " tail))) - (do @ + (do ! [_ (l.this "%") code (|> (l.exactly 2 l.hexadecimal) (p.codec nat.hex) - (:: @ map text.from-code)) + (:: ! map text.from-code)) tail component] (wrap (format head code tail)))))))) @@ -44,14 +44,14 @@ (do p.monad [_ l.end] (wrap context)) - (do {@ p.monad} + (do {! p.monad} [key (l.some (l.none-of "=&;")) key (l.local key ..component)] - (p.either (do @ + (p.either (do ! [_ (l.this "=") value ..component] (form (dictionary.put key value context))) - (do @ + (do ! [_ ($_ p.or (l.one-of "&;") l.end)] diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 90bdac6b1..f9f214562 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -153,12 +153,12 @@ (def: #export (execute environment command arguments) (-> Context Text (List Text) (IO (Try (Console IO)))) (`` (for {(~~ (static host.old)) - (do {@ (try.with io.monad)} - [windows? (:: @ map (|>> java/lang/String::toLowerCase ..windows?) + (do {! (try.with io.monad)} + [windows? (:: ! map (|>> java/lang/String::toLowerCase ..windows?) (java/lang/System::getProperty "os.name")) #let [builder (java/lang/ProcessBuilder::new (arguments-array (list& (sanitize-command windows? command) (list;map (sanitize-argument windows?) arguments))))] - environment (:: @ map (load-environment environment) + environment (:: ! map (load-environment environment) (java/lang/ProcessBuilder::environment builder)) process (java/lang/ProcessBuilder::start builder)] (process-console process))}))) |