diff options
Diffstat (limited to 'stdlib/source/library')
155 files changed, 935 insertions, 1232 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index f534a51d9..f9be2bf36 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1981,7 +1981,7 @@ (failure "Wrong syntax for <|")} (list\reverse tokens))) -(def:''' .private (compose f g) +(def:''' .private (function\composite f g) (list [(tag$ ["library/lux" "doc"]) (text$ "Function composition.")]) (All [a b c] @@ -2097,7 +2097,7 @@ #1 ("lux i64 =" reference sample))) -(def:''' .private (list\join xs) +(def:''' .private (list\joined xs) #End (All [a] (-> ($' List ($' List a)) ($' List a))) @@ -2119,8 +2119,8 @@ (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list\map list\size data')) (|> data' - (list\map (compose apply (replacement_environment bindings'))) - list\join + (list\map (function\composite apply (replacement_environment bindings'))) + list\joined in_meta) (failure "Irregular arguments tuples for template."))) @@ -2355,7 +2355,7 @@ (do meta_monad [top_level_expansion (("lux type as" Macro' macro) args) recursive_expansion (monad\map meta_monad expansion top_level_expansion)] - (in (list\join recursive_expansion))) + (in (list\joined recursive_expansion))) #None (in_meta (list token))} @@ -2376,23 +2376,23 @@ (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad full_expansion expansion)] - (in (list\join expansion'))) + (in (list\joined expansion'))) #None (do meta_monad [args' (monad\map meta_monad full_expansion args)] - (in (list (form$ (#Item (identifier$ name) (list\join args'))))))} + (in (list (form$ (#Item (identifier$ name) (list\joined args'))))))} ?macro)) [_ (#Form members)] (do meta_monad [members' (monad\map meta_monad full_expansion members)] - (in (list (form$ (list\join members'))))) + (in (list (form$ (list\joined members'))))) [_ (#Tuple members)] (do meta_monad [members' (monad\map meta_monad full_expansion members)] - (in (list (tuple$ (list\join members'))))) + (in (list (tuple$ (list\joined members'))))) [_ (#Record pairs)] (do meta_monad @@ -2807,7 +2807,7 @@ _ (let' [pairs (|> patterns (list\map (function' [pattern] (list pattern body))) - (list\join))] + (list\joined))] (in_meta (list\compose pairs branches)))) _ (failure "Wrong syntax for ^or"))) @@ -3568,10 +3568,10 @@ _ (failure "Invalid implementation member.")))) - (list\join tokens'))] + (list\joined tokens'))] (in (list (record$ members))))) -(def: (text\join_with separator parts) +(def: (text\interposed separator parts) (-> Text (List Text) Text) (case parts #End @@ -3822,7 +3822,7 @@ _ (failure "Interfaces require typed members!")))) - (list\join methods'))) + (list\joined methods'))) .let [def_name (local_identifier$ name) interface_type (record$ (list\map (: (-> [Text Code] [Code Code]) (function (_ [module_name m_type]) @@ -4010,23 +4010,14 @@ (relative_ups ("lux i64 +" 1 relatives) input) relatives))) -(def: (list\take amount list) - (All [a] (-> Nat (List a) (List a))) - (case [amount list] - (^or [0 _] [_ #End]) - #End - - [_ (#Item head tail)] - (#Item head (list\take ("lux i64 -" 1 amount) tail)))) - -(def: (list\drop amount list) +(def: (list\after amount list) (All [a] (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ #End]) list [_ (#Item _ tail)] - (list\drop ("lux i64 -" 1 amount) tail))) + (list\after ("lux i64 -" 1 amount) tail))) (def: (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) @@ -4042,10 +4033,9 @@ (if (n/< (list\size parts) jumps) (let [prefix (|> parts list\reverse - (list\drop jumps) + (list\after jumps) list\reverse - (list\interposed ..module_separator) - (text\join_with "")) + (text\interposed ..module_separator)) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) 0 prefix @@ -4130,7 +4120,7 @@ "Wrong syntax for import @ " current_module ..\n (code\encode token))))))) imports)] - (in (list\join imports')))) + (in (list\joined imports')))) (def: (exported_definitions module state) (-> Text (Meta (List Text))) @@ -4155,7 +4145,7 @@ (list))))) (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] definitions))] - (#Right state (list\join to_alias))) + (#Right state (list\joined to_alias))) #None (#Left ($_ text\compose @@ -4541,7 +4531,7 @@ (function (_ [sub_tag_index sname stype]) (open_declaration alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped/2 tags' members')))] - (in_meta (list\join decls'))) + (in_meta (list\joined decls'))) _ (in_meta (list (` ("lux def" (~ (local_identifier$ (..module_alias "" short alias))) @@ -4576,7 +4566,7 @@ (function (_ [tag_index sname stype]) (open_declaration alias tags tag_index sname source stype))) (enumeration (zipped/2 tags members)))] - (in_meta (list\join decls'))) + (in_meta (list\joined decls'))) _ (failure (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) @@ -4685,7 +4675,7 @@ (list\map (function (_ name) (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) - list\join)]] + list\joined)]] (in (list\compose defs openings)))) (macro: (refer tokens) @@ -4851,7 +4841,7 @@ (#Item (list new_binding old_record) accesses')])) [record (: (List (List Code)) #End)] pairs) - accesses (list\join (list\reverse accesses'))]] + accesses (list\joined (list\reverse accesses'))]] (in (list (` (let [(~+ accesses)] (~ update_expr))))))) @@ -4998,8 +4988,8 @@ (let [apply (: (-> Replacement_Environment (List Code)) (function (_ env) (list\map (realized_template env) templates)))] (|> data' - (list\map (compose apply (replacement_environment bindings'))) - list\join + (list\map (function\composite apply (replacement_environment bindings'))) + list\joined in)) #None)))) (#Some output) @@ -5074,9 +5064,9 @@ (def: (location_padding baseline [_ old_line old_column] [_ new_line new_column]) (-> Nat Location Location Text) (if ("lux i64 =" old_line new_line) - (text\join_with "" (repeated (.int ("lux i64 -" old_column new_column)) " ")) - (let [extra_lines (text\join_with "" (repeated (.int ("lux i64 -" old_line new_line)) ..\n)) - space_padding (text\join_with "" (repeated (.int ("lux i64 -" baseline new_column)) " "))] + (text\interposed "" (repeated (.int ("lux i64 -" old_column new_column)) " ")) + (let [extra_lines (text\interposed "" (repeated (.int ("lux i64 -" old_line new_line)) ..\n)) + space_padding (text\interposed "" (repeated (.int ("lux i64 -" baseline new_column)) " "))] (text\compose extra_lines space_padding)))) (def: (text\size x) @@ -5093,7 +5083,7 @@ (function (_ [left right]) (list left right)))] (|>> (list\map pair_list) - list\join))) + list\joined))) (def: (example_documentation prev_location baseline example) (-> Location Nat Code [Location Text]) @@ -5139,7 +5129,7 @@ (|> comment (text\all_split_by ..\n) (list\map (function (_ line) ($_ text\compose "... " line ..\n))) - (text\join_with "")) + (text\interposed "")) (#Documentation_Example example) (let [baseline (baseline_column example) @@ -5162,7 +5152,7 @@ (in_meta (list (` [(~ location_code) (#.Text (~ (|> tokens (list\map (|>> ..documentation_fragment ..fragment_documentation)) - (text\join_with "") + (text\interposed "") text$)))])))) (def: (interleaved xs ys) @@ -5324,7 +5314,7 @@ [[location (<tag> elems)] (do maybe_monad [placements (monad\map maybe_monad (with_expansions' label tokens) elems)] - (in (list [location (<tag> (list\join placements))])))]) + (in (list [location (<tag> (list\joined placements))])))]) ([#Tuple] [#Form]) @@ -5973,7 +5963,7 @@ .let [[labels labelled] =raw]] (in (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) - list\join))] + list\joined))] (~ labelled)))))) _ diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux index adac4d3a2..7b57f5671 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -12,13 +12,14 @@ (-> (f (-> a b)) (f a) (f b))) apply)) -(implementation: .public (compose f_monad f_apply g_apply) +(implementation: .public (composite f_monad f_apply g_apply) (All [F G] (-> (Monad F) (Apply F) (Apply G) ... TODO: Replace (All [a] (F (G a))) with (functor.Then F G) (Apply (All [a] (F (G a)))))) - (def: &functor (functor.compose (get@ #&functor f_apply) (get@ #&functor g_apply))) + (def: &functor + (functor.composite (get@ #&functor f_apply) (get@ #&functor g_apply))) (def: (apply fgf fgx) ... TODO: Switch from this version to the one below (in comments) ASAP. diff --git a/stdlib/source/library/lux/abstract/codec.lux b/stdlib/source/library/lux/abstract/codec.lux index 0c3901361..53c95a816 100644 --- a/stdlib/source/library/lux/abstract/codec.lux +++ b/stdlib/source/library/lux/abstract/codec.lux @@ -13,7 +13,7 @@ (: (-> m (Try a)) decode)) -(implementation: .public (compose cb_codec ba_codec) +(implementation: .public (composite cb_codec ba_codec) (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) diff --git a/stdlib/source/library/lux/abstract/fold.lux b/stdlib/source/library/lux/abstract/fold.lux index 1a7ba054f..ba8a93381 100644 --- a/stdlib/source/library/lux/abstract/fold.lux +++ b/stdlib/source/library/lux/abstract/fold.lux @@ -5,13 +5,11 @@ [monoid (#+ Monoid)]]) (interface: .public (Fold F) - {#.doc "Iterate over a structure's values to build a summary value."} (: (All [a b] (-> (-> b a a) a (F b) a)) fold)) (def: .public (with_monoid monoid fold value) - {#.doc "Fold over a foldable structure using the monoid's identity as the initial value."} (All [F a] (-> (Monoid a) (Fold F) (F a) a)) (let [(^open "/\.") monoid] diff --git a/stdlib/source/library/lux/abstract/functor.lux b/stdlib/source/library/lux/abstract/functor.lux index d06f82ed7..6f7053018 100644 --- a/stdlib/source/library/lux/abstract/functor.lux +++ b/stdlib/source/library/lux/abstract/functor.lux @@ -38,7 +38,7 @@ (type: .public (Then f g) (All [a] (f (g a)))) -(def: .public (compose (^open "f\.") (^open "g\.")) +(def: .public (composite (^open "f\.") (^open "g\.")) (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G)))) (implementation (def: (map f fga) diff --git a/stdlib/source/library/lux/abstract/functor/contravariant.lux b/stdlib/source/library/lux/abstract/functor/contravariant.lux index 1cf16ce24..9c5fe673a 100644 --- a/stdlib/source/library/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/library/lux/abstract/functor/contravariant.lux @@ -3,8 +3,6 @@ [lux #*]]) (interface: .public (Functor f) - {#.doc (example "The contravariant functor.")} - (: (All [a b] (-> (-> b a) (-> (f a) (f b)))) diff --git a/stdlib/source/library/lux/abstract/hash.lux b/stdlib/source/library/lux/abstract/hash.lux index 3a27317de..3180691f3 100644 --- a/stdlib/source/library/lux/abstract/hash.lux +++ b/stdlib/source/library/lux/abstract/hash.lux @@ -7,8 +7,6 @@ ["." contravariant]]]) (interface: .public (Hash a) - {#.doc (example "A way to produce hash-codes for a type's instances." - "A necessity when working with some data-structures, such as dictionaries or sets.")} (: (Equivalence a) &equivalence) (: (-> a Nat) diff --git a/stdlib/source/library/lux/abstract/interval.lux b/stdlib/source/library/lux/abstract/interval.lux index 5961039b9..cea44c57b 100644 --- a/stdlib/source/library/lux/abstract/interval.lux +++ b/stdlib/source/library/lux/abstract/interval.lux @@ -8,7 +8,6 @@ [enum (#+ Enum)]]) (interface: .public (Interval a) - {#.doc "A representation of top and bottom boundaries for an ordered type."} (: (Enum a) &enum) @@ -70,13 +69,11 @@ ) (def: .public (borders? interval elem) - {#.doc (example "Where a value is at the border of an interval.")} (All [a] (-> (Interval a) a Bit)) (or (starts_with? elem interval) (ends_with? elem interval))) (implementation: .public (union left right) - {#.doc (example "An interval that spans both predecessors.")} (All [a] (-> (Interval a) (Interval a) (Interval a))) (def: &enum (get@ #&enum right)) @@ -84,7 +81,6 @@ (def: top (order.max (\ right &order) (\ left top) (\ right top)))) (implementation: .public (intersection left right) - {#.doc (example "An interval spanned by both predecessors.")} (All [a] (-> (Interval a) (Interval a) (Interval a))) (def: &enum (get@ #&enum right)) @@ -92,7 +88,6 @@ (def: top (order.min (\ right &order) (\ left top) (\ right top)))) (implementation: .public (complement interval) - {#.doc (example "The inverse of an interval.")} (All [a] (-> (Interval a) (Interval a))) (def: &enum (get@ #&enum interval)) @@ -122,7 +117,6 @@ ) (def: .public (meets? reference sample) - {#.doc (example "Whether an interval meets another one on its bottom/lower side.")} (All [a] (-> (Interval a) (Interval a) Bit)) (let [(^open ",\.") reference limit (\ reference bottom)] diff --git a/stdlib/source/library/lux/abstract/monoid.lux b/stdlib/source/library/lux/abstract/monoid.lux index 4e55a9a3b..53c3288c6 100644 --- a/stdlib/source/library/lux/abstract/monoid.lux +++ b/stdlib/source/library/lux/abstract/monoid.lux @@ -10,7 +10,7 @@ (: (-> a a a) compose)) -(def: .public (compose left right) +(def: .public (composite left right) (All [l r] (-> (Monoid l) (Monoid r) (Monoid [l r]))) (implementation (def: identity diff --git a/stdlib/source/library/lux/abstract/order.lux b/stdlib/source/library/lux/abstract/order.lux index 17bb2109d..279c3beb0 100644 --- a/stdlib/source/library/lux/abstract/order.lux +++ b/stdlib/source/library/lux/abstract/order.lux @@ -9,8 +9,6 @@ ["." contravariant]]]) (interface: .public (Order a) - {#.doc "A signature for types that possess some sense of ordering among their elements."} - (: (Equivalence a) &equivalence) @@ -19,37 +17,30 @@ ) (type: .public (Comparison a) - {#.doc (example "An arbitrary comparison between two values, with the knowledge of how to order them.")} (-> (Order a) a a Bit)) (def: .public (<= order parameter subject) - {#.doc (example "Less than or equal.")} Comparison (or (\ order < parameter subject) (\ order = parameter subject))) (def: .public (> order parameter subject) - {#.doc (example "Greater than.")} Comparison (\ order < subject parameter)) (def: .public (>= order parameter subject) - {#.doc (example "Greater than or equal.")} Comparison (or (\ order < subject parameter) (\ order = subject parameter))) (type: .public (Choice a) - {#.doc (example "A choice comparison between two values, with the knowledge of how to order them.")} (-> (Order a) a a a)) (def: .public (min order x y) - {#.doc (example "Minimum.")} Choice (if (\ order < y x) x y)) (def: .public (max order x y) - {#.doc (example "Maximum.")} Choice (if (\ order < y x) y x)) diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux index a3702c20c..20101f7a9 100644 --- a/stdlib/source/library/lux/abstract/predicate.lux +++ b/stdlib/source/library/lux/abstract/predicate.lux @@ -9,29 +9,21 @@ ["." contravariant]]]) (type: .public (Predicate a) - {#.doc (example "A question that can be asked of a value, yield either false (#0) or true (#1).")} (-> a Bit)) -(template [<identity_name> <identity_value> <composition_name> <composition> - <identity_doc> <composition_doc>] +(template [<identity_name> <identity_value> <composition_name> <composition>] [(def: .public <identity_name> - {#.doc <identity_doc>} Predicate (function.constant <identity_value>)) (def: .public (<composition_name> left right) - {#.doc <composition_doc>} (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) (function (_ value) (<composition> (left value) (right value))))] - [none #0 or .or - (example "A predicate that always fails.") - (example "A predicate that meets either predecessor.")] - [all #1 and .and - (example "A predicate that always succeeds.") - (example "A predicate that meets both predecessors.")] + [none #0 or .or] + [all #1 and .and] ) (template [<name> <identity> <composition>] @@ -46,19 +38,16 @@ ) (def: .public (complement predicate) - {#.doc (example "The opposite of a predicate.")} (All [a] (-> (Predicate a) (Predicate a))) (|>> predicate not)) (def: .public (difference sub base) - {#.doc (example "A predicate that meeds 'base', but not 'sub'.")} (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) (function (_ value) (.and (base value) (not (sub value))))) (def: .public (rec predicate) - {#.doc (example "Ties the knot for a recursive predicate.")} (All [a] (-> (-> (Predicate a) (Predicate a)) (Predicate a))) diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index 2dbcfda97..03ae8afe6 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -26,7 +26,8 @@ ["<>" parser ("#\." monad) ["<.>" code (#+ Parser)]]]) -(type: Alias [Text Code]) +(type: Alias + [Text Code]) (type: Stack {#bottom (Maybe Nat) @@ -67,20 +68,11 @@ _ (meta.failure (format "Cannot expand to more than a single AST/Code node:" text.new_line - (|> expansion (list\map %.code) (text.join_with " "))))))) + (|> expansion (list\map %.code) (text.interposed " "))))))) (syntax: .public (=> [aliases aliases^ inputs stack^ outputs stack^]) - {#.doc (example "Concatenative function types." - (=> [Nat] [Nat]) - (All [a] (-> a (=> [] [a]))) - (All [t] (=> [t] [])) - (All [a b c] (=> [a b c] [b c a])) - (All [___a ___z] - (=> {then (=> ___a ___z) - else (=> ___a ___z)} - ___a [Bit then else] ___z)))} (let [de_alias (function (_ aliased) (list\fold (function (_ [from to] pre) (code.replaced (code.local_identifier from) to pre)) @@ -104,7 +96,9 @@ (-> (~ (de_alias inputC)) (~ (de_alias outputC)))))))))))) -(def: begin! Any []) +(def: begin! + Any + []) (def: end! (All [a] (-> [Any a] a)) @@ -112,13 +106,6 @@ top)) (syntax: .public (||> [commands (<>.some <code>.any)]) - {#.doc (example "A self-contained sequence of concatenative instructions." - (same? value - (||> (..push sample))) - - (||> (push 123) - dup - n/=))} (in (list (` (|> (~! ..begin!) (~+ commands) ((~! ..end!))))))) (def: word @@ -135,21 +122,12 @@ ))) (syntax: .public (word: [[export_policy name annotations type commands] ..word]) - {#.doc (example "A named concatenative function." - (word: square - (=> [Nat] [Nat]) - - dup - (apply/2 n.*)))} (in (list (` (def: (~ export_policy) (~ (code.local_identifier name)) (~ (|annotations|.format annotations)) (~ type) (|>> (~+ commands))))))) (syntax: .public (apply [arity (<>.only (n.> 0) <code>.nat)]) - {#.doc (example "A generator for functions that turn arity N functions into arity N concatenative functions." - (: (=> [Nat] [Nat]) - ((apply 1) inc)))} (with_identifiers [g! g!func g!stack g!output] (monad.do {! meta.monad} [g!inputs (|> (macro.identifier "input") (list.repeated arity) (monad.seq !))] @@ -161,80 +139,65 @@ [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) (template [<arity>] - [(with_expansions [<name> (template.identifier ["apply/" <arity>]) - <doc> (template.text ["Lift a function of arity " <arity> - " into a concatenative function of arity " <arity> "."])] - (def: .public <name> - {#.doc (example <doc>)} - (apply <arity>)))] + [(`` (def: .public (~~ (template.identifier ["apply/" <arity>])) + (..apply <arity>)))] [1] [2] [3] [4] [5] [6] [7] [8] ) (def: .public (push x) - {#.doc (example "Push a value onto the stack.")} (All [a] (-> a (=> [] [a]))) (function (_ stack) [stack x])) (def: .public drop - {#.doc (example "Drop/pop a value from the top of the stack.")} (All [t] (=> [t] [])) (function (_ [stack top]) stack)) (def: .public nip - {#.doc (example "Drop the second-to-last value from the top of the stack.")} (All [_ a] (=> [_ a] [a])) (function (_ [[stack _] top]) [stack top])) (def: .public dup - {#.doc (example "Duplicate the top of the stack.")} (All [a] (=> [a] [a a])) (function (_ [stack top]) [[stack top] top])) (def: .public swap - {#.doc (example "Swaps the 2 topmost stack values.")} (All [a b] (=> [a b] [b a])) (function (_ [[stack l] r]) [[stack r] l])) (def: .public rotL - {#.doc (example "Rotes the 3 topmost stack values to the left.")} (All [a b c] (=> [a b c] [b c a])) (function (_ [[[stack a] b] c]) [[[stack b] c] a])) (def: .public rotR - {#.doc (example "Rotes the 3 topmost stack values to the right.")} (All [a b c] (=> [a b c] [c a b])) (function (_ [[[stack a] b] c]) [[[stack c] a] b])) (def: .public && - {#.doc (example "Groups the 2 topmost stack values as a 2-tuple.")} (All [a b] (=> [a b] [(Tuple a b)])) (function (_ [[stack l] r]) [stack [l r]])) (def: .public ||L - {#.doc (example "Left-injects the top into sum.")} (All [a b] (=> [a] [(Or a b)])) (function (_ [stack l]) [stack (0 #0 l)])) (def: .public ||R - {#.doc (example "Right-injects the top into sum.")} (All [a b] (=> [b] [(Or a b)])) (function (_ [stack r]) [stack (0 #1 r)])) (template [<input> <output> <word> <func>] [(`` (def: .public <word> - {#.doc (example (~~ (template.text [<func> " for " <input> " arithmetic."])))} (=> [<input> <input>] [<output>]) (function (_ [[stack subject] param]) [stack (<func> param subject)])))] @@ -285,12 +248,6 @@ ) (def: .public if - {#.doc (example "If expression." - (same? "then" - (||> (push true) - (push "then") - (push "else") - if)))} (All [___a ___z] (=> {then (=> ___a ___z) else (=> ___a ___z)} @@ -301,7 +258,6 @@ (else stack)))) (def: .public call - {#.doc (example "Executes an anonymous block on the stack.")} (All [___a ___z] (=> {quote (=> ___a ___z)} ___a [quote] ___z)) @@ -309,7 +265,6 @@ (quote stack))) (def: .public loop - {#.doc (example "Executes a block as a loop until it yields #0 to stop.")} (All [___] (=> {test (=> ___ ___ [Bit])} ___ [test] ___)) @@ -320,7 +275,6 @@ stack')))) (def: .public dip - {#.doc (example "Executes a block on the stack, save for the topmost value.")} (All [___ a] (=> ___ [a (=> ___ ___)] ___ [a])) @@ -328,7 +282,6 @@ [(quote stack) a])) (def: .public dip/2 - {#.doc (example "Executes a block on the stack, save for the 2 topmost values.")} (All [___ a b] (=> ___ [a b (=> ___ ___)] ___ [a b])) @@ -336,12 +289,6 @@ [[(quote stack) a] b])) (def: .public do - {#.doc (example "Do-while loop expression." - (n.= (inc sample) - (||> (push sample) - (push (push false)) - (push (|>> (push 1) n/+)) - do while)))} (All [___a ___z] (=> {body (=> ___a ___z) pred (=> ___z ___a [Bit])} @@ -351,14 +298,6 @@ [[(body stack) pred] body])) (def: .public while - {#.doc (example "While loop expression." - (n.= (n.+ distance start) - (||> (push start) - (push (|>> dup - (push start) n/- - (push distance) n/<)) - (push (|>> (push 1) n/+)) - while)))} (All [___a ___z] (=> {body (=> ___z ___a) pred (=> ___a ___z [Bit])} @@ -371,13 +310,6 @@ stack')))) (def: .public compose - {#.doc (example "Function composition." - (n.= (n.+ 2 sample) - (||> (push sample) - (push (|>> (push 1) n/+)) - (push (|>> (push 1) n/+)) - compose - call)))} (All [___a ___ ___z] (=> [(=> ___a ___) (=> ___ ___z)] [(=> ___a ___z)])) @@ -385,13 +317,6 @@ [stack (|>> f g)])) (def: .public partial - {#.doc (example "Partial application." - (n.= (n.+ sample sample) - (||> (push sample) - (push sample) - (push n/+) - partial - call)))} (All [___a ___z a] (=> ___a [a (=> ___a [a] ___z)] ___a [(=> ___a ___z)])) @@ -399,7 +324,6 @@ [stack (|>> (push arg) quote)])) (word: .public when - {#.doc (example "Only execute the block when #1.")} (All [___] (=> {body (=> ___ ___)} ___ [Bit body] @@ -410,7 +334,6 @@ if) (word: .public ? - {#.doc (example "Choose the top value when #0 and the second-to-top when #1.")} (All [a] (=> [Bit a a] [a])) rotL diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 1557a9f89..e51be0b98 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -1,5 +1,4 @@ (.module: - {#.doc "The actor model of concurrency."} [library [lux #* ["." debug] @@ -64,27 +63,23 @@ (in #.End)))) (abstract: .public (Actor s) - {#.doc (example "An entity that can react to messages (mail) sent to it concurrently.")} + {} {#obituary [(Async <Obituary>) (Resolver <Obituary>)] #mailbox (Atom <Mailbox>)} (type: .public (Mail s) - {#.doc (example "A one-way message sent to an actor, without expecting a reply.")} <Mail>) (type: .public (Obituary s) - {#.doc (example "Details on the death of an actor.")} <Obituary>) (type: .public (Behavior o s) - {#.doc (example "An actor's behavior when mail is received and when a fatal error occurs.")} {#on_init (-> o s) #on_mail (-> (Mail s) s (Actor s) (Async (Try s)))}) (def: .public (spawn! behavior init) - {#.doc (example "Given a behavior and initial state, spawns an actor and returns it.")} (All [o s] (-> (Behavior o s) o (IO (Actor s)))) (io (let [[on_init on_mail] behavior self (:sharing [o s] @@ -130,14 +125,12 @@ (async.value obituary))) (def: .public obituary - {#.doc (example "Await for an actor to stop working.")} (All [s] (-> (Actor s) (Async (Obituary s)))) (|>> :representation (get@ #obituary) product.left)) (def: .public (mail! mail actor) - {#.doc (example "Send mail to an actor.")} (All [s] (-> (Mail s) (Actor s) (IO (Try Any)))) (do {! io.monad} [alive? (..alive? actor)] @@ -163,7 +156,6 @@ (in (exception.except ..dead []))))) (type: .public (Message s o) - {#.doc (example "A two-way message sent to an actor, expecting a reply.")} (-> s (Actor s) (Async (Try [s o])))) (def: (mail message) @@ -191,7 +183,6 @@ (async.resolved (#try.Failure error))))))])) (def: .public (tell! message actor) - {#.doc (example "Communicate with an actor through message-passing.")} (All [s o] (-> (Message s o) (Actor s) (Async (Try o)))) (let [[async mail] (..mail message)] (do async.monad @@ -210,14 +201,11 @@ (mail state self)) (def: .public default - {#.doc (example "Default actor behavior.")} (All [s] (Behavior s s)) {#on_init function.identity #on_mail ..default_on_mail}) (def: .public (poison! actor) - {#.doc (example "Kills the actor by sending mail that will kill it upon processing," - "but allows the actor to handle previous mail.")} (All [s] (-> (Actor s) (IO (Try Any)))) (..mail! (function (_ state self) (async.resolved (exception.except ..poisoned []))) @@ -270,151 +258,102 @@ (<>.and <code>.any private) (<>.and (<>\in (` .private)) private)))) -(with_expansions [<examples> (as_is (actor: .public (stack a) - {} - - (List a) - - ((on_mail mail state self) - (do (try.with async.monad) - [.let [_ (debug.log! "BEFORE")] - output (mail state self) - .let [_ (debug.log! "AFTER")]] - (in output))) - - (message: .public (push {value a} state self) - (List a) - (let [state' (#.Item value state)] - (async.resolved (#try.Success [state' state']))))) - - (actor: .public counter - {} - - Nat - - (message: .public (count! {increment Nat} state self) - Any - (let [state' (n.+ increment state)] - (async.resolved (#try.Success [state' state'])))) - - (message: .public (read! state self) - Nat - (async.resolved (#try.Success [state state])))))] - (syntax: .public (actor: [[export_policy [name vars] annotations state_type [?on_mail messages]] ..actorP]) - {#.doc (example "Defines a named actor, with its behavior and internal state." - "Messages for the actor must be defined after the on_mail handler." - <examples>)} - (with_identifiers [g!_] - (do meta.monad - [g!type (macro.identifier (format name "_abstract_type")) - .let [g!actor (code.local_identifier name) - g!vars (list\map code.local_identifier vars)]] - (in (list (` ((~! abstract:) (~ export_policy) ((~ g!type) (~+ g!vars)) - {} - - (~ state_type) - - (def: (~ export_policy) (~ g!actor) - (All [(~+ g!vars)] - (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) - {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) - #..on_mail (~ (..on_mail g!_ ?on_mail))}) - - (~+ messages)))))))) - - (syntax: .public (actor [[state_type init] (<code>.record (<>.and <code>.any <code>.any)) - [?on_mail messages] behavior^]) - {#.doc (example "Defines an anonymous actor, with its behavior and internal state." - "Messages for the actor must be defined after the on_mail handler." - (actor {Nat - 123} - ((on_mail message state self) - (message (inc state) self))))} - (with_identifiers [g!_] - (in (list (` (: ((~! io.IO) (..Actor (~ state_type))) - (..spawn! (: (..Behavior (~ state_type) (~ state_type)) - {#..on_init (|>>) - #..on_mail (~ (..on_mail g!_ ?on_mail))}) - (: (~ state_type) - (~ init))))))))) - - (type: Signature - {#vars (List Text) - #name Text - #inputs (List |input|.Input) - #state Text - #self Text}) - - (def: signature^ - (Parser Signature) - (<code>.form ($_ <>.and - (<>.else (list) (<code>.tuple (<>.some <code>.local_identifier))) - <code>.local_identifier - (<>.some |input|.parser) - <code>.local_identifier - <code>.local_identifier))) - - (def: reference^ - (Parser [Name (List Text)]) - (<>.either (<code>.form (<>.and <code>.identifier (<>.some <code>.local_identifier))) - (<>.and <code>.identifier (\ <>.monad in (list))))) - - (def: messageP - (Parser [Code Signature |annotations|.Annotations Code Code]) - (let [private ($_ <>.and - ..signature^ - (<>.else |annotations|.empty |annotations|.parser) - <code>.any - <code>.any)] - ($_ <>.either - (<>.and <code>.any private) - (<>.and (<>\in (` .private)) private)))) - - (syntax: .public (message: [[export_policy signature annotations output_type body] ..messageP]) - {#.doc (example "A message can access the actor's state through the state parameter." - "A message can also access the actor itself through the self parameter." - "A message's output must be an async containing a 2-tuple with the updated state and a return value." - "A message may succeed or fail (in case of failure, the actor dies)." - - <examples>)} - (with_identifiers [g!_ g!return] - (do meta.monad - [actor_scope abstract.current - .let [g!type (code.local_identifier (get@ #abstract.name actor_scope)) - g!message (code.local_identifier (get@ #name signature)) - g!actor_vars (get@ #abstract.type_vars actor_scope) - g!all_vars (|> signature (get@ #vars) (list\map code.local_identifier) (list\compose g!actor_vars)) - g!inputsC (|> signature (get@ #inputs) (list\map product.left)) - g!inputsT (|> signature (get@ #inputs) (list\map product.right)) - g!state (|> signature (get@ #state) code.local_identifier) - g!self (|> signature (get@ #self) code.local_identifier)]] - (in (list (` (def: (~ export_policy) ((~ g!message) (~+ g!inputsC)) - (~ (|annotations|.format annotations)) - (All [(~+ g!all_vars)] - (-> (~+ g!inputsT) - (..Message (~ (get@ #abstract.abstraction actor_scope)) - (~ output_type)))) - (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) - (~ g!state))] - (|> (~ body) - (: ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) - (~ output_type)]))) - (:as ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) - (~ output_type)])))))))) - )))))) +(syntax: .public (actor: [[export_policy [name vars] annotations state_type [?on_mail messages]] ..actorP]) + (with_identifiers [g!_] + (do meta.monad + [g!type (macro.identifier (format name "_abstract_type")) + .let [g!actor (code.local_identifier name) + g!vars (list\map code.local_identifier vars)]] + (in (list (` ((~! abstract:) (~ export_policy) ((~ g!type) (~+ g!vars)) + {} + + (~ state_type) + + (def: (~ export_policy) (~ g!actor) + (All [(~+ g!vars)] + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) + #..on_mail (~ (..on_mail g!_ ?on_mail))}) + + (~+ messages)))))))) + +(syntax: .public (actor [[state_type init] (<code>.record (<>.and <code>.any <code>.any)) + [?on_mail messages] behavior^]) + (with_identifiers [g!_] + (in (list (` (: ((~! io.IO) (..Actor (~ state_type))) + (..spawn! (: (..Behavior (~ state_type) (~ state_type)) + {#..on_init (|>>) + #..on_mail (~ (..on_mail g!_ ?on_mail))}) + (: (~ state_type) + (~ init))))))))) + +(type: Signature + {#vars (List Text) + #name Text + #inputs (List |input|.Input) + #state Text + #self Text}) + +(def: signature^ + (Parser Signature) + (<code>.form ($_ <>.and + (<>.else (list) (<code>.tuple (<>.some <code>.local_identifier))) + <code>.local_identifier + (<>.some |input|.parser) + <code>.local_identifier + <code>.local_identifier))) + +(def: reference^ + (Parser [Name (List Text)]) + (<>.either (<code>.form (<>.and <code>.identifier (<>.some <code>.local_identifier))) + (<>.and <code>.identifier (\ <>.monad in (list))))) + +(def: messageP + (Parser [Code Signature |annotations|.Annotations Code Code]) + (let [private ($_ <>.and + ..signature^ + (<>.else |annotations|.empty |annotations|.parser) + <code>.any + <code>.any)] + ($_ <>.either + (<>.and <code>.any private) + (<>.and (<>\in (` .private)) private)))) + +(syntax: .public (message: [[export_policy signature annotations output_type body] ..messageP]) + (with_identifiers [g!_ g!return] + (do meta.monad + [actor_scope abstract.current + .let [g!type (code.local_identifier (get@ #abstract.name actor_scope)) + g!message (code.local_identifier (get@ #name signature)) + g!actor_vars (get@ #abstract.type_vars actor_scope) + g!all_vars (|> signature (get@ #vars) (list\map code.local_identifier) (list\compose g!actor_vars)) + g!inputsC (|> signature (get@ #inputs) (list\map product.left)) + g!inputsT (|> signature (get@ #inputs) (list\map product.right)) + g!state (|> signature (get@ #state) code.local_identifier) + g!self (|> signature (get@ #self) code.local_identifier)]] + (in (list (` (def: (~ export_policy) ((~ g!message) (~+ g!inputsC)) + (~ (|annotations|.format annotations)) + (All [(~+ g!all_vars)] + (-> (~+ g!inputsT) + (..Message (~ (get@ #abstract.abstraction actor_scope)) + (~ output_type)))) + (function ((~ g!_) (~ g!state) (~ g!self)) + (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) + (~ g!state))] + (|> (~ body) + (: ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) + (~ output_type)]))) + (:as ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) + (~ output_type)])))))))) + ))))) (type: .public Stop - {#.doc (example "A signal to stop an actor from observing a channel.")} (IO Any)) (def: continue! true) (def: stop! false) (def: .public (observe! action channel actor) - {#.doc (example "Use an actor to observe a channel by transforming each datum" - "flowing through the channel into mail the actor can process." - "Can stop observing the channel by executing the Stop value.")} (All [e s] (-> (-> e Stop (Mail s)) (Channel e) (Actor s) (IO Any))) (let [signal (: (Atom Bit) (atom.atom ..continue!)) diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 32f1913b6..3dcb864b6 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -18,13 +18,11 @@ ["." atom (#+ Atom atom)]]) (abstract: .public (Async a) - {#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} + {} (Atom [(Maybe a) (List (-> a (IO Any)))]) (type: .public (Resolver a) - {#.doc (example "The function used to give a value to an async." - "Will signal 'true' if the async has been resolved for the 1st time, 'false' otherwise.")} (-> a (IO Bit))) (def: (resolver async) @@ -50,25 +48,21 @@ (resolve value)))))))) (def: .public (resolved value) - {#.doc (example "Produces an async that has already been resolved to the given value.")} (All [a] (-> a (Async a))) (:abstraction (atom [(#.Some value) (list)]))) (def: .public (async _) - {#.doc (example "Creates a fresh async that has not been resolved yet.")} (All [a] (-> Any [(Async a) (Resolver a)])) (let [async (:abstraction (atom [#.None (list)]))] [async (..resolver async)])) (def: .public value - {#.doc "Polls an async for its value."} (All [a] (-> (Async a) (IO (Maybe a)))) (|>> :representation atom.read! (\ io.functor map product.left))) (def: .public (upon! f async) - {#.doc (example "Executes the given function as soon as the async has been resolved.")} (All [a] (-> (-> a (IO Any)) (Async a) (IO Any))) (do {! io.monad} [.let [async (:representation async)] @@ -87,7 +81,6 @@ ) (def: .public resolved? - {#.doc "Checks whether an async's value has already been resolved."} (All [a] (-> (Async a) (IO Bit))) (|>> ..value (\ io.functor map @@ -133,7 +126,6 @@ ma)))) (def: .public (and left right) - {#.doc (example "Combines the results of both asyncs, in-order.")} (All [a b] (-> (Async a) (Async b) (Async [a b]))) (let [[read! write!] (:sharing [a b] [(Async a) (Async b)] @@ -150,8 +142,6 @@ read!)) (def: .public (or left right) - {#.doc (example "Yields the results of whichever async gets resolved first." - "You can tell which one was resolved first through pattern-matching.")} (All [a b] (-> (Async a) (Async b) (Async (Or a b)))) (let [[a|b resolve] (..async [])] (with_expansions @@ -166,8 +156,6 @@ a|b)))) (def: .public (either left right) - {#.doc (example "Yields the results of whichever async gets resolved first." - "You cannot tell which one was resolved first.")} (All [a] (-> (Async a) (Async a) (Async a))) (let [[left||right resolve] (..async [])] (`` (exec @@ -179,8 +167,6 @@ left||right)))) (def: .public (schedule! milli_seconds computation) - {#.doc (example "Runs an I/O computation on its own thread (after a specified delay)." - "Returns an async that will eventually host its result.")} (All [a] (-> Nat (IO a) (Async a))) (let [[!out resolve] (..async [])] (exec @@ -192,22 +178,17 @@ !out))) (def: .public future - {#.doc (example "Runs an I/O computation on its own thread." - "Returns an async that will eventually host its result.")} (All [a] (-> (IO a) (Async a))) (..schedule! 0)) (def: .public (delayed milli_seconds value) - {#.doc "Delivers a value after a certain period has passed."} (All [a] (-> Nat a (Async a))) (..schedule! milli_seconds (io value))) (def: .public (delay milli_seconds) - {#.doc "An async that will be resolved after the specified amount of milli-seconds."} (-> Nat (Async Any)) (..delayed milli_seconds [])) (def: .public (time_out milli_seconds async) - {#.doc "Wait for an async to be resolved within the specified amount of milli-seconds."} (All [a] (-> Nat (Async a) (Async (Maybe a)))) (..or (..delay milli_seconds) async)) diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux index 07e2640f8..b6d9461f0 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -47,7 +47,7 @@ @.scheme "scheme array read"} (as_is))] (abstract: .public (Atom a) - {#.doc "Atomic references that are safe to mutate concurrently."} + {} (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)] (for {@.old <jvm> @@ -69,8 +69,6 @@ (<read> 0 (:representation atom)))))) (def: .public (compare_and_swap! current new atom) - {#.doc (example "Only mutates an atom if you can present its current value." - "That guarantees that atom was not updated since you last read from it.")} (All [a] (-> a a (Atom a) (IO Bit))) (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))] (for {@.old <jvm> @@ -83,9 +81,6 @@ )) (def: .public (update! f atom) - {#.doc (example "Updates an atom by applying a function to its current value." - "If it fails to update it (because some other process wrote to it first), it will retry until it succeeds." - "The retries will be done with the new values of the atom, as they show up.")} (All [a] (-> (-> a a) (Atom a) (IO [a a]))) (loop [_ []] (do io.monad @@ -97,8 +92,6 @@ (recur []))))) (def: .public (write! value atom) - {#.doc (example "Writes the given value to an atom." - "If it fails to write it (because some other process wrote to it first), it will retry until it succeeds.")} (All [a] (-> a (Atom a) (IO a))) (|> atom (..update! (function.constant value)) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index 676aa0b8a..e14fb6505 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -18,13 +18,11 @@ ["." async (#+ Async) ("#\." functor)]]) (type: .public (Channel a) - {#.doc "An asynchronous channel to distribute values."} (Async (Maybe [a (Channel a)]))) (exception: .public channel_is_already_closed) (interface: .public (Sink a) - {#.doc (example "The tail-end of a channel, which can be written-to to fee the channel.")} (: (IO (Try Any)) close) (: (-> a (IO (Try Any))) @@ -80,7 +78,6 @@ (recur [])))))))))) (def: .public (channel _) - {#.doc (example "Creates a brand-new channel and hands it over, along with the sink to write to it.")} (All [a] (-> Any [(Channel a) (Sink a)])) (let [[async resolve] (async.async [])] [async (..sink resolve)])) @@ -150,7 +147,6 @@ output)))) (type: .public (Subscriber a) - {#.doc (example "A function that can receive every value fed into a channel.")} (-> a (IO (Maybe Any)))) (def: .public (subscribe! subscriber channel) @@ -174,8 +170,6 @@ []))) (def: .public (only pass? channel) - {#.doc (example "Produces a new channel based on the old one, only with values" - "that pass the test.")} (All [a] (-> (-> a Bit) (Channel a) (Channel a))) (do async.monad [item channel] @@ -190,14 +184,12 @@ (in #.None)))) (def: .public (of_async async) - {#.doc (example "A one-element channel containing the output from an async.")} (All [a] (-> (Async a) (Channel a))) (async\map (function (_ value) (#.Some [value ..empty])) async)) (def: .public (fold f init channel) - {#.doc "Asynchronous fold over channels."} (All [a b] (-> (-> b a (Async a)) a (Channel b) (Async a))) @@ -291,7 +283,6 @@ (in #.End)))) (def: .public (sequential milli_seconds values) - {#.doc (example "Transforms the given list into a channel with the same elements.")} (All [a] (-> Nat (List a) (Channel a))) (case values #.End diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index f7f4f5f50..c266617a5 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -30,7 +30,7 @@ #waiting_list (Queue (Resolver Any))}) (abstract: .public Semaphore - {#.doc "A tool for controlling access to resources by multiple concurrent processes."} + {} (Atom State) @@ -46,25 +46,24 @@ #waiting_list queue.empty})))) (def: .public (wait! semaphore) - {#.doc (example "Wait on a semaphore until there are open positions." - "After finishing your work, you must 'signal' to the semaphore that you're done.")} (Ex [k] (-> Semaphore (Async Any))) (let [semaphore (:representation semaphore) [signal sink] (: [(Async Any) (Resolver Any)] (async.async []))] - (exec (io.run! - (with_expansions [<had_open_position?> (as_is (get@ #open_positions) (i.> -1))] - (do io.monad - [[_ state'] (atom.update! (|>> (update@ #open_positions dec) - (if> [<had_open_position?>] - [] - [(update@ #waiting_list (queue.end sink))])) - semaphore)] - (with_expansions [<go_ahead> (sink []) - <get_in_line> (in false)] - (if (|> state' <had_open_position?>) - <go_ahead> - <get_in_line>))))) + (exec + (io.run! + (with_expansions [<had_open_position?> (as_is (get@ #open_positions) (i.> -1))] + (do io.monad + [[_ state'] (atom.update! (|>> (update@ #open_positions dec) + (if> [<had_open_position?>] + [] + [(update@ #waiting_list (queue.end sink))])) + semaphore)] + (with_expansions [<go_ahead> (sink []) + <get_in_line> (in false)] + (if (|> state' <had_open_position?>) + <go_ahead> + <get_in_line>))))) signal))) (exception: .public (semaphore_is_maxed_out {max_positions Nat}) @@ -72,7 +71,6 @@ ["Max Positions" (%.nat max_positions)])) (def: .public (signal! semaphore) - {#.doc (example "Signal to a semaphore that you're done with your work, and that there is a new open position.")} (Ex [k] (-> Semaphore (Async (Try Int)))) (let [semaphore (:representation semaphore)] (async.future @@ -98,12 +96,11 @@ ) (abstract: .public Mutex - {#.doc "A mutual-exclusion lock that can only be acquired by one process at a time."} + {} Semaphore (def: .public (mutex _) - {#.doc (example "Creates a brand-new mutex.")} (-> Any Mutex) (:abstraction (semaphore 1))) @@ -116,7 +113,6 @@ (|>> :representation ..signal!)) (def: .public (synchronize! mutex procedure) - {#.doc (example "Runs the procedure with exclusive control of the mutex.")} (All [a] (-> Mutex (IO (Async a)) (Async a))) (do async.monad [_ (..acquire! mutex) @@ -126,15 +122,13 @@ ) (def: .public limit - {#.doc (example "Produce a limit for a barrier.")} (refinement.refiner (n.> 0))) (type: .public Limit - {#.doc (example "A limit for barriers.")} (:~ (refinement.type limit))) (abstract: .public Barrier - {#.doc "A barrier that blocks all processes from proceeding until a given number of processes are parked at the barrier."} + {} {#limit Limit #count (Atom Nat) @@ -174,7 +168,6 @@ ) (def: .public (block! barrier) - {#.doc (example "Wait on a barrier until all processes have arrived and met the barrier's limit.")} (-> Barrier (Async Any)) (do async.monad [_ (..start! barrier)] diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index f3bdbcbb6..a41d12aba 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -24,12 +24,11 @@ (-> a (IO Any))) (abstract: .public (Var a) - {#.doc "A mutable cell containing a value, and observers that will be alerted of any change to it."} + {} (Atom [a (List (Sink a))]) (def: .public (var value) - {#.doc "Creates a new STM var, with a default value."} (All [a] (-> a (Var a))) (:abstraction (atom.atom [value (list)]))) @@ -67,7 +66,6 @@ (write! new_value var)))) (def: .public (follow! target) - {#.doc "Creates a channel that will receive all changes to the value of the given var."} (All [a] (-> (Var a) (IO [(Channel a) (Sink a)]))) (do io.monad [.let [[channel sink] (frp.channel [])] @@ -86,7 +84,6 @@ (List (Ex [a] (Tx_Frame a)))) (type: .public (STM a) - {#.doc "A computation which updates a transaction and produces a value."} (-> Tx [Tx a])) (def: (var_value var tx) @@ -175,7 +172,6 @@ (ma tx'))))) (def: .public (update f var) - {#.doc "Update a var's value, and return a tuple with the old and the new values."} (All [a] (-> (-> a a) (Var a) (STM [a a]))) (do ..monad [a (..read var) @@ -261,9 +257,6 @@ ))) (def: .public (commit! stm_proc) - {#.doc (example "Commits a transaction and returns its result (asynchronously)." - "Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first." - "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} (All [a] (-> (STM a) (Async a))) (let [[output resolver] (async.async [])] (exec diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 6d47059b0..e067d1ac5 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -65,7 +65,6 @@ )) (def: .public parallelism - {#.doc (example "How many processes can run in parallel.")} Nat (with_expansions [<jvm> (|> (java/lang/Runtime::getRuntime) (java/lang/Runtime::availableProcessors) @@ -102,7 +101,6 @@ [])) (def: .public (schedule! milli_seconds action) - {#.doc (example "Executes an I/O procedure after some milli-seconds.")} (-> Nat (IO Any) (IO Any)) (with_expansions [<jvm> (as_is (let [runnable (ffi.object [] [java/lang/Runnable] [] diff --git a/stdlib/source/library/lux/control/continuation.lux b/stdlib/source/library/lux/control/continuation.lux index e9b702f55..9a65c9d3e 100644 --- a/stdlib/source/library/lux/control/continuation.lux +++ b/stdlib/source/library/lux/control/continuation.lux @@ -14,21 +14,17 @@ ["." code]]]]) (type: .public (Cont i o) - {#.doc "Continuations."} (-> (-> i o) o)) -(def: .public (continue next cont) - {#.doc "Continues a continuation thunk."} +(def: .public (continued next cont) (All [i o] (-> (-> i o) (Cont i o) o)) (cont next)) -(def: .public (result cont) - {#.doc "Forces a continuation thunk to be evaluated."} +(def: .public result (All [a] (-> (Cont a a) a)) - (cont function.identity)) + (..continued function.identity)) -(def: .public (call/cc f) - {#.doc "Call with current continuation."} +(def: .public (with_current f) (All [a b z] (-> (-> (-> a (Cont b z)) (Cont a z)) @@ -38,8 +34,6 @@ k))) (syntax: .public (pending [expr <code>.any]) - {#.doc (example "Turns any expression into a function that is pending a continuation." - (pending (some_function some_input)))} (with_identifiers [g!_ g!k] (in (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) @@ -61,7 +55,8 @@ (All [o] (Functor (All [i] (Cont i o)))) (def: (map f fv) - (function (_ k) (fv (function.compose k f))))) + (function (_ k) + (fv (function.composite k f))))) (implementation: .public apply (All [o] (Apply (All [i] (Cont i o)))) @@ -84,7 +79,7 @@ (def: (join ffa) (function (_ k) - (ffa (continue k))))) + (ffa (continued k))))) (def: .public (portal init) (All [i o z] @@ -92,9 +87,10 @@ (Cont [(-> i (Cont o z)) i] z))) - (call/cc (function (_ k) - (do ..monad - [.let [nexus (function (nexus val) - (k [nexus val]))] - _ (k [nexus init])] - (in (undefined)))))) + (with_current + (function (_ k) + (do ..monad + [.let [nexus (function (nexus val) + (k [nexus val]))] + _ (k [nexus init])] + (in (undefined)))))) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 9a9e7f845..f89611e19 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -28,18 +28,14 @@ ["//" try (#+ Try)]]) (type: .public (Exception a) - {#.doc "An exception provides a way to decorate error messages."} {#label Text #constructor (-> a Text)}) (def: .public (match? exception error) - {#.doc (example "Is this exception the cause of the error message?")} (All [e] (-> (Exception e) Text Bit)) (text.starts_with? (get@ #label exception) error)) (def: .public (when exception then try) - {#.doc (example "If a particular exception is detected on a possibly-erroneous value, handle it." - "If no exception was detected, or a different one from the one being checked, then pass along the original value.")} (All [e a] (-> (Exception e) (-> Text a) (Try a) (Try a))) @@ -52,12 +48,11 @@ (if (text.starts_with? reference error) (#//.Success (|> error (text.clip' (text.size reference)) - maybe.assume + maybe.trusted then)) (#//.Failure error))))) (def: .public (otherwise else try) - {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} (All [a] (-> (-> Text a) (Try a) a)) (case try @@ -68,12 +63,10 @@ (else error))) (def: .public (error exception message) - {#.doc "Constructs an error message from an exception."} (All [e] (-> (Exception e) e Text)) ((get@ #..constructor exception) message)) (def: .public (except exception message) - {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."} (All [e a] (-> (Exception e) e (Try a))) (#//.Failure (..error exception message))) @@ -98,15 +91,9 @@ ))) (syntax: .public (exception: [[export_policy t_vars [name inputs] body] ..exception]) - {#.doc (example "Define a new exception type." - "It mostly just serves as a way to tag error messages for later catching." + {#.doc (example "" - "Simple case:" - (exception: .public some_exception) - "" - "Complex case:" - (exception: .public [arbitrary type variables] (some_exception {optional Text} {arguments Int}) - optional_body))} + )} (macro.with_identifiers [g!descriptor] (do meta.monad [current_module meta.current_module_name @@ -132,14 +119,14 @@ on_new_line (|> " " (list.repeated (n.+ (text.size header_separator) largest_header_size)) - (text.join_with "") + text.joined (text\compose text.new_line)) on_entry (: (-> [Text Text] Text) (function (_ [header message]) (let [padding (|> " " (list.repeated (n.- (text.size header) largest_header_size)) - (text.join_with ""))] + text.joined)] (|> message (text.replaced text.new_line on_new_line) ($_ text\compose padding header header_separator)))))] @@ -154,19 +141,11 @@ tail)))) (syntax: .public (report [entries (<>.many (<code>.tuple (<>.and <code>.any <code>.any)))]) - {#.doc (example "An error report." - (: Text - (report ["Row 0" value/0] - ["Row 1" value/1] - ,,, - ["Row N" value/N])))} (in (list (` ((~! report') (list (~+ (|> entries (list\map (function (_ [header message]) (` [(~ header) (~ message)]))))))))))) (def: .public (listing format entries) - {#.doc (example "A numbered report of the entries on a list." - "NOTE: 0-based numbering.")} (All [a] (-> (-> a Text) (List a) Text)) (|> entries @@ -181,7 +160,7 @@ (def: separator (let [gap ($_ "lux text concat" text.new_line text.new_line) - horizontal_line (|> "-" (list.repeated 64) (text.join_with ""))] + horizontal_line (|> "-" (list.repeated 64) text.joined)] ($_ "lux text concat" gap horizontal_line @@ -195,7 +174,6 @@ error)) (def: .public (with exception message computation) - {#.doc (example "If a computation fails, prepends the exception to the error.")} (All [e a] (-> (Exception e) e (Try a) (Try a))) (case computation (#//.Failure error) diff --git a/stdlib/source/library/lux/control/function.lux b/stdlib/source/library/lux/control/function.lux index d0bc286ae..865ea6930 100644 --- a/stdlib/source/library/lux/control/function.lux +++ b/stdlib/source/library/lux/control/function.lux @@ -5,38 +5,24 @@ [monoid (#+ Monoid)]]]]) (def: .public identity - {#.doc (example "Identity function." - "Does nothing to its argument and just returns it." - (same? (identity value) - value))} (All [a] (-> a a)) (|>>)) -(def: .public (compose f g) - {#.doc (example "Function composition." - (= ((compose f g) "foo") - (f (g "foo"))))} +(def: .public (composite f g) (All [a b c] (-> (-> b c) (-> a b) (-> a c))) (|>> g f)) (def: .public (constant value) - {#.doc (example "Create constant functions." - (= ((constant "foo") "bar") - "foo"))} (All [o] (-> o (All [i] (-> i o)))) (function (_ _) value)) (def: .public (flipped f) - {#.doc (example "Flips the order of the arguments of a function." - (= ((flipped f) "foo" "bar") - (f "bar" "foo")))} (All [a b c] (-> (-> a b c) (-> b a c))) (function (_ x y) (f y x))) (def: .public (apply input function) - {#.doc (example "Simple 1-argument function application.")} (All [i o] (-> i (-> i o) o)) (function input)) @@ -45,4 +31,4 @@ (All [a] (Monoid (-> a a))) (def: identity ..identity) - (def: compose ..compose)) + (def: compose ..composite)) diff --git a/stdlib/source/library/lux/control/io.lux b/stdlib/source/library/lux/control/io.lux index 321b7159e..1b3b58f7b 100644 --- a/stdlib/source/library/lux/control/io.lux +++ b/stdlib/source/library/lux/control/io.lux @@ -16,7 +16,7 @@ ["." template]]]]) (abstract: .public (IO a) - {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."} + {} (-> Any a) @@ -34,17 +34,11 @@ [((:representation io) [])]) (syntax: .public (io [computation <code>.any]) - {#.doc (example "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." - "Great for wrapping effectful computations (which will not be performed until the IO is 'run!')." - (io (exec - (log! msg) - "Some value...")))} (with_identifiers [g!func g!arg] (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) (~ computation)))))))) (def: .public run! - {#.doc "A way to execute IO computations and perform their side-effects."} (All [a] (-> (IO a) a)) (|>> run!')) diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux index dec12c5f5..46901a3c1 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -18,8 +18,7 @@ abstract]]]) (abstract: .public (Lazy a) - {#.doc (example "A value specified by an expression that is calculated only at the last moment possible." - "Afterwards, the value is cached for future reference.")} + {} (-> [] a) @@ -42,7 +41,6 @@ ((:representation lazy) []))) (syntax: .public (lazy [expression <code>.any]) - {#.doc (example "Specifies a lazy value by providing the expression that computes it.")} (with_identifiers [g!_] (in (list (` ((~! lazy') (function ((~ g!_) (~ g!_)) (~ expression)))))))) diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index 2d9b56039..74b5f06d2 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -96,7 +96,8 @@ (implementation: .public (with monad) (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a)))))) - (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) + (def: &functor + (functor.composite (get@ #monad.&functor monad) ..functor)) (def: in (|>> (\ ..monad in) (\ monad in))) @@ -110,22 +111,11 @@ (#.Some Mma) Mma)))) -(def: .public (lift monad) - {#.doc (example "Wraps a monadic value with Maybe machinery.")} +(def: .public (lifted monad) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) (\ monad map (\ ..monad in))) (macro: .public (else tokens state) - {#.doc (example "Allows you to provide a default value that will be used" - "if a (Maybe x) value turns out to be #.None." - "Note: the expression for the default value will not be computed if the base computation succeeds." - (else +20 (#.Some +10)) - "=>" - +10 - -------------------------- - (else +20 #.None) - "=>" - +20)} (case tokens (^ (.list else maybe)) (let [g!temp (: Code [location.dummy (#.Identifier ["" ""])])] @@ -139,10 +129,7 @@ _ (#.Left "Wrong syntax for else"))) -(def: .public assume - {#.doc (example "Assumes that a Maybe value is a #.Some and yields its value." - "Raises/throws a runtime error otherwise." - "WARNING: Use with caution.")} +(def: .public trusted (All [a] (-> (Maybe a) a)) (|>> (..else (undefined)))) @@ -156,11 +143,6 @@ (#.Item value #.End))) (macro: .public (when tokens state) - {#.doc (example "Can be used as a guard in (co)monadic be/do expressions." - (do monad - [value (do_something 1 2 3) - ..when (passes_test? value)] - (do_something_else 4 5 6)))} (case tokens (^ (.list test then)) (#.Right [state (.list (` (.if (~ test) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index 4c86373f5..f4e304045 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -230,7 +230,7 @@ (function (_ input) (#try.Failure message))) -(def: .public (lift operation) +(def: .public (lifted operation) {#.doc (example "Lift a potentially failed computation into a parser.")} (All [s a] (-> (Try a) (Parser s a))) (function (_ input) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index 94e7ca9c1..fb32f4608 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -37,8 +37,7 @@ (format text.new_line "Remaining input: " (|> asts (list\map /.%analysis) - (list.interposed " ") - (text.join_with "")))) + (text.interposed " ")))) (exception: .public (cannot_parse {input (List Analysis)}) (exception.report diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index 7cf526d41..d2d195888 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -121,7 +121,7 @@ (^template [<number> <tag> <parser>] [<number> (\ ! map (|>> <tag>) <parser>)]) ((~~ (template.spliced <case>+))) - _ (//.lift (exception.except ..invalid_tag [(~~ (template.amount <case>+)) flag])))))]) + _ (//.lifted (exception.except ..invalid_tag [(~~ (template.amount <case>+)) flag])))))]) (def: .public (or left right) (All [l r] (-> (Parser l) (Parser r) (Parser (Or l r)))) @@ -153,7 +153,7 @@ (case value 0 (in #0) 1 (in #1) - _ (//.lift (exception.except ..not_a_bit [value]))))) + _ (//.lifted (exception.except ..not_a_bit [value]))))) (def: .public (segment size) {#.doc (example "Parses a chunk of data of a given size.")} @@ -185,7 +185,7 @@ (Parser Text) (do //.monad [utf8 <binary>] - (//.lift (\ utf8.codec decode utf8)))))] + (//.lifted (\ utf8.codec decode utf8)))))] [08 utf8/8 ..binary/8] [16 utf8/16 ..binary/16] diff --git a/stdlib/source/library/lux/control/parser/cli.lux b/stdlib/source/library/lux/control/parser/cli.lux index cc9bf19ab..3dd50a349 100644 --- a/stdlib/source/library/lux/control/parser/cli.lux +++ b/stdlib/source/library/lux/control/parser/cli.lux @@ -24,7 +24,7 @@ (#try.Success output) _ - (#try.Failure (format "Remaining CLI inputs: " (text.join_with " " remaining)))) + (#try.Failure (format "Remaining CLI inputs: " (text.interposed " " remaining)))) (#try.Failure try) (#try.Failure try))) @@ -85,7 +85,7 @@ (function (_ inputs) (case inputs #.End (#try.Success [inputs []]) - _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs)))))) + _ (#try.Failure (format "Unknown parameters: " (text.interposed " " inputs)))))) (def: .public (named name value) {#.doc (example "Parses a named parameter and yields its value.")} diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux index d22039f4a..93a2f65d9 100644 --- a/stdlib/source/library/lux/control/parser/code.lux +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -31,10 +31,11 @@ {#.doc "A Lux code parser."} (//.Parser (List Code))) -(def: (remaining_inputs codes) +(def: remaining_inputs (-> (List Code) Text) - ($_ text\compose text.new_line "Remaining input: " - (|> codes (list\map code.format) (list.interposed " ") (text.join_with "")))) + (|>> (list\map code.format) + (text.interposed " ") + ($_ text\compose text.new_line "Remaining input: "))) (def: .public any {#.doc "Yields the next input without applying any logic."} @@ -189,9 +190,10 @@ (#try.Success value) _ - (#try.Failure (text\compose "Unconsumed inputs: " - (|> (list\map code.format unconsumed) - (text.join_with ", "))))))) + (#try.Failure (|> unconsumed + (list\map code.format) + (text.interposed ", ") + (text\compose "Unconsumed inputs: ")))))) (def: .public (local inputs parser) {#.doc "Runs parser against the given list of inputs."} diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index ffe6e6f27..fb2c59128 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -39,7 +39,7 @@ (def: (remaining' offset tape) (-> Offset Text Text) - (|> tape (/.split_at offset) maybe.assume product.right)) + (|> tape (/.split_at offset) maybe.trusted product.right)) (exception: .public (unconsumed_input {offset Offset} {tape Text}) (exception.report @@ -174,7 +174,7 @@ (-> Nat Nat (Parser Text)) (do //.monad [char any - .let [char' (maybe.assume (/.char 0 char))] + .let [char' (maybe.trusted (/.char 0 char))] _ (//.assertion ($_ /\compose "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) (.and (n.>= bottom char') (n.<= top char')))] @@ -392,4 +392,4 @@ (//.Parser s a))) (do //.monad [raw text] - (//.lift (..result structured raw)))) + (//.lifted (..result structured raw)))) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index 619526cdb..8016080b5 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -58,7 +58,7 @@ (exception.report ["Types" (|> remaining (list\map (|>> %.type (format text.new_line "* "))) - (text.join_with ""))])) + (text.interposed ""))])) (type: .public Env {#.doc (example "An environment for type parsing.")} diff --git a/stdlib/source/library/lux/control/reader.lux b/stdlib/source/library/lux/control/reader.lux index 73737cb54..09fcd2058 100644 --- a/stdlib/source/library/lux/control/reader.lux +++ b/stdlib/source/library/lux/control/reader.lux @@ -57,9 +57,11 @@ {#.doc "Monad transformer for Reader."} (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: &functor (functor.compose ..functor (get@ #monad.&functor monad))) + (def: &functor + (functor.composite ..functor (get@ #monad.&functor monad))) - (def: in (|>> (\ monad in) (\ ..monad in))) + (def: in + (|>> (\ monad in) (\ ..monad in))) (def: (join eMeMa) (function (_ env) @@ -67,7 +69,7 @@ [eMa (result env eMeMa)] (result env eMa))))) -(def: .public lift +(def: .public lifted {#.doc "Lift monadic values to the Reader wrapper."} (All [M e a] (-> (M a) (Reader e (M a)))) (\ ..monad in)) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index ba3962400..191c6a328 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -154,7 +154,7 @@ (All [r] (Region r ! a)))) (failure monad (exception.error exception message))) -(def: .public (lift monad operation) +(def: .public (lifted monad operation) {#.doc (example "Lift an effectful computation into a region-based computation.")} (All [! a] (-> (Monad !) (! a) diff --git a/stdlib/source/library/lux/control/state.lux b/stdlib/source/library/lux/control/state.lux index 9cb56fb89..470751832 100644 --- a/stdlib/source/library/lux/control/state.lux +++ b/stdlib/source/library/lux/control/state.lux @@ -142,7 +142,7 @@ [[state' sMa] (sMsMa state)] (sMa state'))))) -(def: .public (lift monad ma) +(def: .public (lifted monad ma) {#.doc "Lift monadic values to the +State wrapper."} (All [M s a] (-> (Monad M) (M a) (+State M s a))) (function (_ state) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index 7e785b6fa..c7dc9f1d9 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -65,7 +65,7 @@ (All [!] (-> (Monad !) (Monad (All [a] (! (Try a)))))) (def: &functor - (functor.compose (get@ #monad.&functor monad) ..functor)) + (functor.composite (get@ #monad.&functor monad) ..functor)) (def: in (|>> (\ ..monad in) @@ -101,7 +101,7 @@ false ))) -(def: .public (assumed try) +(def: .public (trusted try) {#.doc (example "Assumes a Try value succeeded, and yields its value." "If it didn't, raises the error as a runtime error." "WARNING: Use with caution.")} diff --git a/stdlib/source/library/lux/control/writer.lux b/stdlib/source/library/lux/control/writer.lux index fe7511a68..18a0fc7e1 100644 --- a/stdlib/source/library/lux/control/writer.lux +++ b/stdlib/source/library/lux/control/writer.lux @@ -55,8 +55,8 @@ (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) (def: &functor - (functor.compose (get@ #monad.&functor monad) - ..functor)) + (functor.composite (get@ #monad.&functor monad) + ..functor)) (def: in (let [writer (..monad monoid)] @@ -72,7 +72,7 @@ [l2 a] Mla] (in [(\ monoid compose l1 l2) a])))) -(def: .public (lift monoid monad) +(def: .public (lifted monoid monad) {#.doc (example "Wraps a monadic value with Writer machinery.")} (All [l M a] (-> (Monoid l) (Monad M) diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index 22ff7fe2f..efdca1f5b 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -64,4 +64,4 @@ {#.doc (example "Generates the complement of a predicate." "That is a predicate that returns the oposite of the original predicate.")} (All [a] (-> (-> a Bit) (-> a Bit))) - (function.compose not)) + (function.composite not)) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index e6b05bf51..84e883b1d 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -266,7 +266,7 @@ outcome (recur side_root)] (if (same? side_root outcome) ?root - (#.Some (<add> (maybe.assume outcome) + (#.Some (<add> (maybe.trusted outcome) root))))] [_\< #left ..with_left] diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 7298a5039..8cba7efb2 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -592,9 +592,11 @@ {#.doc (.example "Enhances a monad with List functionality.")} (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) - (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) + (def: &functor + (functor.composite (get@ #monad.&functor monad) ..functor)) - (def: in (|>> (\ ..monad in) (\ monad in))) + (def: in + (|>> (\ ..monad in) (\ monad in))) (def: (join MlMla) (do {! monad} @@ -606,7 +608,7 @@ (monad.seq ! lMla))] (in (..joined lla))))) -(def: .public (lift monad) +(def: .public (lifted monad) {#.doc (.example "Wraps a monadic value with List machinery.")} (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) (\ monad map (\ ..monad in))) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index 230de34a1..6a4b88587 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -126,13 +126,13 @@ (array.copy! tail_size 0 tail 0) (array.write! tail_size val)))) -(def: (put' level idx val hierarchy) +(def: (has' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) (let [sub_idx (branch_idx (i64.right_shifted level idx))] (case (array.read! sub_idx hierarchy) (#.Some (#Hierarchy sub_node)) (|> (array.clone hierarchy) - (array.write! sub_idx (#Hierarchy (put' (level_down level) idx val sub_node)))) + (array.write! sub_idx (#Hierarchy (has' (level_down level) idx val sub_node)))) (^multi (#.Some (#Base base)) (n.= 0 (level_down level))) @@ -279,7 +279,7 @@ #.None (exception.except ..incorrect_row_structure [])))) -(def: .public (put idx val row) +(def: .public (has idx val row) (All [a] (-> Nat a (Row a) (Try (Row a)))) (let [row_size (get@ #size row)] (if (within_bounds? row idx) @@ -289,7 +289,7 @@ (|>> array.clone (array.write! (branch_idx idx) val)))} (|>> array.clone (array.write! (branch_idx idx) val))) row) - (update@ #root (put' (get@ #level row) idx val) + (update@ #root (has' (get@ #level row) idx val) row))) (exception.except ..index_out_of_bounds [row idx])))) @@ -297,7 +297,7 @@ (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) (do try.monad [val (..item idx row)] - (..put idx (f val) row))) + (..has idx (f val) row))) (def: .public (pop row) (All [a] (-> (Row a) (Row a))) @@ -316,7 +316,7 @@ (update@ #size dec) (set@ #tail (|> (array.empty new_tail_size) (array.copy! new_tail_size 0 old_tail 0))))) - (maybe.assume + (maybe.trusted (do maybe.monad [new_tail (base_for (n.- 2 row_size) row) .let [[level' root'] (let [init_level (get@ #level row)] diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index d60fd99d4..a7d2cc0b4 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -23,11 +23,12 @@ {#.doc "An infinite sequence of values."} (Cont [a (Sequence a)])) -(def: .public (iterations f x) - {#.doc "Create a sequence by applying a function to a value, and to its result, on and on..."} - (All [a] - (-> (-> a a) a (Sequence a))) - (//.pending [x (iterations f (f x))])) +(def: .public (iterations step init) + {#.doc "A stateful way of infinitely calculating the values of a sequence."} + (All [a b] + (-> (-> a [a b]) a (Sequence b))) + (let [[next x] (step init)] + (//.pending [x (iterations step next)]))) (def: .public (repeated x) {#.doc "Repeat a value forever."} @@ -101,13 +102,6 @@ [split_at Nat (n.= 0 pred) (dec pred)] ) -(def: .public (unfold step init) - {#.doc "A stateful way of infinitely calculating the values of a sequence."} - (All [a b] - (-> (-> a [a b]) a (Sequence b))) - (let [[next x] (step init)] - (//.pending [x (unfold step next)]))) - (def: .public (only predicate sequence) {#.doc (example "A new sequence only with items that satisfy the predicate.")} (All [a] (-> (-> a Bit) (Sequence a) (Sequence a))) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index e16c2cebd..e23ade3fb 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -78,7 +78,7 @@ [(n.+ <size> offset) (|> binary (<write> offset value) - try.assumed)])]))] + try.trusted)])]))] [bits/8 /.size/8 binary.write/8!] [bits/16 /.size/16 binary.write/16!] @@ -97,7 +97,7 @@ (function (_ [offset binary]) (|> binary (binary.write/8! offset <number>) - try.assumed + try.trusted [(.inc offset)] caseT))])]) ([0 #.Left left] @@ -142,7 +142,7 @@ [size (function (_ [offset binary]) [(n.+ size offset) - (try.assumed + (try.trusted (binary.copy (n.min size (binary.size value)) 0 value @@ -159,7 +159,7 @@ [size' (function (_ [offset binary]) [(n.+ size' offset) - (try.assumed + (try.trusted (do try.monad [_ (<write> offset size binary)] (binary.copy size 0 value (n.+ <size> offset) binary)))])]))))] @@ -202,7 +202,7 @@ specification\identity))] [(n.+ <size> size) (function (_ [offset binary]) - (try.assumed + (try.trusted (do try.monad [_ (<write> offset capped_count binary)] (in (mutation [(n.+ <size> offset) binary])))))])))] @@ -247,7 +247,7 @@ (function (_ [offset binary]) (|> binary (binary.write/8! offset <number>) - try.assumed + try.trusted [(.inc offset)] caseT))])]) ([0 #.Primitive (..and ..text (..list recur))] @@ -282,7 +282,7 @@ (function (_ [offset binary]) (|> binary (binary.write/8! offset <number>) - try.assumed + try.trusted [(.inc offset)] caseT))])]) ([0 #.Bit ..bit] diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux index d86deb7e5..7ec9a0d35 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -67,7 +67,7 @@ with_unicode) (list\map (function (_ [property value]) (format property ": " value ";"))) - (text.join_with /style.separator) + (text.interposed /style.separator) (text.enclosed ["{" "}"]) (format "@font-face") :abstraction))) @@ -98,7 +98,7 @@ (format (/value.percentage (get@ #when frame)) " {" (/style.inline (get@ #what frame)) "}"))) - (text.join_with ..css_separator)) + (text.interposed ..css_separator)) "}"))) (template: (!compose <pre> <post>) @@ -115,7 +115,7 @@ :representation (text.all_split_by ..css_separator) (list\map (|>> (format (/selector.selector (|> selector (combinator (/selector.tag ""))))))) - (text.join_with ..css_separator) + (text.interposed ..css_separator) :abstraction)) (def: .public (dependent combinator selector style inner) diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index c2fb914c2..0c8e8f70f 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -61,7 +61,7 @@ (let [raw (%.frac value)] (if (f.< +0.0 value) raw - (|> raw (text.split_at 1) maybe.assume product.right)))) + (|> raw (text.split_at 1) maybe.trusted product.right)))) (abstract: .public (Value brand) {} @@ -786,7 +786,7 @@ (def: (apply name inputs) (-> Text (List Text) Value) (|> inputs - (text.join_with ..value_separator) + (text.interposed ..value_separator) (text.enclosed ["(" ")"]) (format name) :abstraction)) @@ -1042,7 +1042,7 @@ (|> blur (maybe.else ..default_shadow_length) :representation) (|> spread (maybe.else ..default_shadow_length) :representation) (:representation color)) - (text.join_with " ") + (text.interposed " ") (list) (..apply "drop-shadow"))) @@ -1119,7 +1119,7 @@ (|> spread (maybe.else ..default_shadow_length) :representation) (:representation color) with_inset) - (text.join_with " ") + (text.interposed " ") :abstraction))) (type: .public Rectangle @@ -1172,7 +1172,7 @@ (#.Item _) (|> options (list\map ..font_name) - (text.join_with ",") + (text.interposed ",") (:abstraction Value)) #.End @@ -1212,9 +1212,9 @@ (:abstraction "."))] (|>> (list\map (|>> (list\map (|>> (maybe.else empty) :representation)) - (text.join_with ..grid_column_separator) + (text.interposed ..grid_column_separator) (text.enclosed ["'" "'"]))) - (text.join_with ..grid_row_separator) + (text.interposed ..grid_row_separator) :abstraction))) (def: .public (resolution dpi) @@ -1248,7 +1248,7 @@ (-> [Quote Quote] [Quote Quote] (Value Quotes)) (|> (list left0 right0 left1 right1) (list\map (|>> ..quote_text %.text)) - (text.join_with ..quote_separator) + (text.interposed ..quote_separator) :abstraction)) (def: .public (matrix_2d [a b] [c d] [tx ty]) diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index 3c3566a56..3a8daf5c0 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -64,7 +64,7 @@ (-> Attributes Text) (|>> (list\map (function (_ [key val]) (format key "=" text.double_quote (..safe val) text.double_quote))) - (text.join_with " "))) + (text.interposed " "))) (def: (open tag attributes) (-> Tag Attributes Text) @@ -259,7 +259,7 @@ (Format Polygon) (|> (list& first second third extra) (list\map %coord) - (text.join_with ..coord_separator))) + (text.interposed ..coord_separator))) (type: .public Shape (#Rectangle Rectangle) diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 7f6ca24a8..c6a7ebef0 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -227,7 +227,7 @@ value (let [raw (\ f.decimal encode value)] (if (f.< +0.0 value) raw - (|> raw (text.split_at 1) maybe.assume product.right)))))) + (|> raw (text.split_at 1) maybe.trusted product.right)))))) (def: escape "\") (def: escaped_dq (text\compose ..escape text.double_quote)) @@ -256,7 +256,7 @@ (-> (-> JSON Text) (-> Array Text)) (|>> (row\map format) row.list - (text.join_with ..value_separator) + (text.interposed ..value_separator) (text.enclosed [..array_start ..array_end]))) (def: (kv_format format [key value]) @@ -271,7 +271,7 @@ (-> (-> JSON Text) (-> Object Text)) (|>> dictionary.entries (list\map (..kv_format format)) - (text.join_with ..value_separator) + (text.interposed ..value_separator) (text.enclosed [..object_start ..object_end]))) (def: .public (format json) diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index 281425105..11254a92c 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -93,7 +93,7 @@ (if (text.empty? line) line (format with line)))) - (text.join_with text.new_line))) + (text.interposed text.new_line))) (def: indent (-> Text Text) @@ -121,7 +121,7 @@ #.None "")))) - (text.join_with text.new_line) + (text.interposed text.new_line) ..block)) (def: .public bullet_list @@ -139,7 +139,7 @@ #.None "")))) - (text.join_with text.new_line) + (text.interposed text.new_line) ..block)) (def: .public snippet diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 8dd91b2ee..7f1346df1 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -44,7 +44,7 @@ max_size) padding (|> "0" (list.repeated padding_size) - (text.join_with ""))] + text.joined)] (format padding number))) (def: blank " ") @@ -132,9 +132,9 @@ (Parser Small) (do <>.monad [digits (<binary>.segment ..small_size) - digits (<>.lift (\ utf8.codec decode digits)) + digits (<>.lifted (\ utf8.codec decode digits)) _ ..small_suffix] - (<>.lift + (<>.lifted (do {! try.monad} [value (\ n.octal decode digits)] (..small value))))) @@ -143,12 +143,12 @@ (Parser Big) (do <>.monad [digits (<binary>.segment ..big_size) - digits (<>.lift (\ utf8.codec decode digits)) + digits (<>.lifted (\ utf8.codec decode digits)) end <binary>.bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end)))] - (<>.lift + (<>.lifted (do {! try.monad} [value (\ n.octal decode digits)] (..big value))))) @@ -201,9 +201,9 @@ (Parser [Nat Checksum]) (do <>.monad [ascii (<binary>.segment ..small_size) - digits (<>.lift (\ utf8.codec decode ascii)) + digits (<>.lifted (\ utf8.codec decode ascii)) _ ..small_suffix - value (<>.lift + value (<>.lifted (\ n.octal decode digits))] (in [value (:abstraction (format digits ..checksum_suffix))]))) @@ -285,7 +285,7 @@ .let [expected (`` (char (~~ (static ..null))))] _ (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end))] - (<>.lift + (<>.lifted (do {! try.monad} [ascii (..un_padded string) text (\ utf8.codec decode ascii)] @@ -293,7 +293,7 @@ (def: .public <none> <type> - (try.assumed (<in> ""))) + (try.trusted (<in> ""))) )] [Name Text ..name_size name_is_too_long name from_name name_writer name_parser anonymous] @@ -329,7 +329,7 @@ .let [expected (`` (char (~~ (static ..null))))] _ (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end))] - (<>.lift + (<>.lifted (\ try.monad map (|>> :abstraction) (\ utf8.codec decode string))))) ) @@ -436,7 +436,7 @@ (<options>) _ - (<>.lift + (<>.lifted (exception.except ..invalid_link_flag [(.nat linkflag)])))))) ) @@ -459,7 +459,7 @@ (Writer Mode) (|>> :representation ..small - try.assumed + try.trusted ..small_writer)) (exception: .public (invalid_mode {value Nat}) @@ -520,7 +520,7 @@ (if (n.<= (:representation ..maximum_mode) value) (in (:abstraction value)) - (<>.lift + (<>.lifted (exception.except ..invalid_mode [value])))))) ) @@ -584,7 +584,7 @@ (def: no_device Device - (try.assumed (..small 0))) + (try.trusted (..small 0))) (type: .public Tar (Row Entry)) @@ -777,7 +777,7 @@ modification_time ..big_parser [actual checksum_code] ..checksum_parser _ (let [expected (expected_checksum checksum_code binary_header)] - (<>.lift + (<>.lifted (exception.assertion ..wrong_checksum [expected actual] (n.= expected actual)))) link_flag ..link_flag_parser @@ -817,7 +817,7 @@ .let [size (get@ #size header) rounded_size (..rounded_content_size size)] content (<binary>.segment (..from_big size)) - content (<>.lift (..content content)) + content (<>.lifted (..content content)) _ (<binary>.segment (n.- (..from_big size) rounded_size))] (in [(get@ #path header) (|> header @@ -838,7 +838,7 @@ (-> Link_Flag (-> Header Path) (Parser Path)) (do <>.monad [header ..header_parser - _ (<>.lift + _ (<>.lifted (exception.assertion ..wrong_link_flag [expected (get@ #link_flag header)] (n.= (..link_flag expected) (..link_flag (get@ #link_flag header)))))] @@ -864,7 +864,7 @@ (do <>.monad [block (<binary>.segment ..block_size)] (let [actual (..checksum block)] - (<>.lift + (<>.lifted (exception.assertion ..wrong_checksum [0 actual] (n.= 0 actual)))))) @@ -875,7 +875,7 @@ (do <>.monad [_ (<>.at_most 2 end_of_archive_block_parser) done? <binary>.end?] - (<>.lift + (<>.lifted (exception.assertion ..invalid_end_of_archive [] done?)))) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 637ba71f7..67722607c 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -239,7 +239,7 @@ dictionary.entries (list\map (function (_ [key value]) ($_ text\compose (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) - (text.join_with " "))))] + (text.interposed " "))))] (function (_ input) ($_ text\compose ..xml_header text.new_line @@ -269,7 +269,7 @@ ($_ text\compose prefix "<" tag attrs ">" (|> xml_children (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new_line))) - (text.join_with "")) + text.joined) text.new_line prefix "</" tag ">"))))) )))) (def: decode diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index e2f781d64..2670bdae3 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -297,7 +297,7 @@ (|>> list.reversed (list\fold compose identity)))) -(def: .public (join_with separator texts) +(def: .public (interposed separator texts) (-> Text (List Text) Text) (case separator "" (..joined texts) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index fe56f754b..f46331176 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -23,7 +23,7 @@ (template [<char> <sigil>] [(def: <char> - (|> <sigil> (//.char 0) maybe.assume))] + (|> <sigil> (//.char 0) maybe.trusted))] [sigil_char ..sigil] [\u_sigil "u"] @@ -31,7 +31,7 @@ (template [<literal> <sigil> <escaped>] [(def: <sigil> - (|> <literal> (//.char 0) maybe.assume)) + (|> <literal> (//.char 0) maybe.trusted)) (def: <escaped> (format ..sigil <literal>))] @@ -50,7 +50,7 @@ (template [<char> <text>] [(def: <char> - (|> <text> (//.char 0) maybe.assume))] + (|> <text> (//.char 0) maybe.trusted))] [\0 //.\0] [\a //.\a] diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index 3438e3f96..1a274b692 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -121,7 +121,7 @@ (def: .public (list formatter) (All [a] (-> (Format a) (Format (List a)))) (|>> (list\map (|>> formatter (format " "))) - (text.join_with "") + text.joined (text.enclosed ["(list" ")"]))) (def: .public (maybe format) diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 795bee383..4998e9ce9 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -52,11 +52,9 @@ (-> Text (Parser Text)) (<>.after (<text>.this reference) (<>\in reference))) -(def: (join_text^ part^) +(def: join_text^ (-> (Parser (List Text)) (Parser Text)) - (do <>.monad - [parts part^] - (in (//.join_with "" parts)))) + (\ <>.monad map //.joined)) (def: name_char^ (Parser Text) @@ -87,9 +85,9 @@ (def: re_range^ (Parser Code) (do {! <>.monad} - [from (|> regex_char^ (\ ! map (|>> (//.char 0) maybe.assume))) + [from (|> regex_char^ (\ ! map (|>> (//.char 0) maybe.trusted))) _ (<text>.this "-") - to (|> regex_char^ (\ ! map (|>> (//.char 0) maybe.assume)))] + to (|> regex_char^ (\ ! map (|>> (//.char 0) maybe.trusted)))] (in (` ((~! <text>.range) (~ (code.nat from)) (~ (code.nat to))))))) (def: re_char^ diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index ab3c1672b..be47d038a 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -31,7 +31,7 @@ (Tree :@: Block []) - (def: .public (compose left right) + (def: .public (composite left right) (-> Set Set Set) (:abstraction (\ builder branch @@ -47,7 +47,7 @@ (-> [Block (List Block)] Set) (list\fold (: (-> Block Set Set) (function (_ block set) - (..compose (..singleton block) set))) + (..composite (..singleton block) set))) (..singleton head) tail)) @@ -154,7 +154,7 @@ (def: .public character Set - ($_ ..compose + ($_ ..composite ..character/0 ..character/1 ..character/2 @@ -197,7 +197,7 @@ (def: .public full Set - ($_ ..compose + ($_ ..composite ..character ..non_character )) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 488933f58..8183fb6ff 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -137,7 +137,7 @@ <adaption> array.list (list\map inspection) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"]))))) (def: .public (inspection value) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index 798bf3056..8651dbdcc 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -72,13 +72,15 @@ (def: (padding reference_column [_ old_line old_column] [_ new_line new_column]) (-> Nat Location Location Text) (if (n.= old_line new_line) - (text.joined (list.repeated (n.- old_column new_column) " ")) - (format (if (n.< new_line old_line) - (text.joined (list.repeated (n.- old_line new_line) \n)) - "") - (if (n.< new_column reference_column) - (text.joined (list.repeated (n.- reference_column new_column) " ")) - "")))) + (if (n.< old_column new_column) + "" + (text.joined (list.repeated (n.- old_column new_column) " "))) + (format (if (n.< old_line new_line) + "" + (text.joined (list.repeated (n.- old_line new_line) \n))) + (if (n.< reference_column new_column) + "" + (text.joined (list.repeated (n.- reference_column new_column) " ")))))) (def: un_paired (All [a] (-> (List [a a]) (List a))) @@ -186,7 +188,7 @@ (-> Example Code) (|>> (list\map ..fragment_documentation) (list.interposed ..blank_line) - (text.join_with "") + (text.interposed "") code.text)) (syntax: (minimal_definition_documentation @@ -239,6 +241,7 @@ (type: .public #rec Module {#module Text + #description Text #expected (Set Text) #definitions (List Definition)}) @@ -284,20 +287,23 @@ (|>> (text.all_split_by ..expected_separator) (set.of_list text.hash))) -(def: (module' name expected definitions) - (-> Text Text (List Definition) Module) +(def: (module' name description expected definitions) + (-> Text Text Text (List Definition) Module) {#module name + #description description #expected (..expected expected) #definitions definitions}) (syntax: .public (module [[name _] ..qualified_identifier + description <code>.any definitions (<code>.tuple (<>.some <code>.any)) subs (<code>.tuple (<>.some <code>.any))]) (do meta.monad [expected (meta.exports name)] (in (list (` (: (List Module) - (list& ((~! module') + (list& ((~! ..module') (~ (code.text name)) + (~ description) (~ (code.text (|> expected (list\map product.left) ..expected_format))) @@ -321,6 +327,10 @@ ($_ md.then ... Name (md.heading/1 (get@ #module module)) + ... Description + (<| md.paragraph + md.text + (get@ #description module)) ... Definitions (md.heading/2 "Definitions") (|> module diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 0f81e4bda..acc859dba 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -19,33 +19,12 @@ [compiler ["." phase]]]]]) -(type: Input - {#variable Text - #parser Code}) - -(def: (simple default) - (-> Code (Parser Input)) - ($_ <>.and - <c>.local_identifier - (<>\in default))) - -(def: complex - (Parser Input) - (<c>.record ($_ <>.and - <c>.local_identifier - <c>.any))) - -(def: (input default) - (-> Code (Parser Input)) - (<>.either (..simple default) - ..complex)) - (type: Declaration {#name Code #label Text #phase Text #archive Text - #inputs (List Input)}) + #inputs (List Code)}) (def: (declaration default) (-> Code (Parser Declaration)) @@ -54,28 +33,25 @@ <c>.local_identifier <c>.local_identifier <c>.local_identifier - (<>.some (..input default))))) + (<c>.tuple (<>.some <c>.any))))) (template [<any> <end> <and> <result> <extension> <name>] [(syntax: .public (<name> [[name extension phase archive inputs] (..declaration (` <any>)) body <c>.any]) - (let [g!parser (case (list\map product.right inputs) - #.End - (` <end>) - - parsers - (` (.$_ <and> (~+ parsers)))) - g!name (code.local_identifier extension) + (let [g!name (code.local_identifier extension) g!phase (code.local_identifier phase) g!archive (code.local_identifier archive)] - (with_identifiers [g!handler g!inputs g!error] + (with_identifiers [g!handler g!inputs g!error g!_] (in (list (` (<extension> (~ name) (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) - (.case ((~! <result>) (~ g!parser) (~ g!inputs)) - (#.Right [(~+ (list\map (|>> product.left - code.local_identifier) - inputs))]) - (~ body) + (.case ((~! <result>) + ((~! monad.do) (~! <>.monad) + [(~+ inputs) + (~ g!_) <end>] + (.\ (~! <>.monad) (~' in) (~ body))) + (~ g!inputs)) + (#.Right (~ g!_)) + (~ g!_) (#.Left (~ g!error)) ((~! phase.failure) (~ g!error))) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 1030a353a..52fdef075 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -1,6 +1,6 @@ (.module: [library - ["." lux (#- Type type int char interface:) + ["." lux (#- Type type int char interface: :as) ["#_." type ("#\." equivalence)] [abstract ["." monad (#+ Monad do)] @@ -1455,8 +1455,8 @@ ... else (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] (` (let [(~ g!temp) (~ return_term)] - (if (not (..null? (:as (primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (.:as (primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (panic! "Cannot produce null references from method calls.")))))) @@ -1729,11 +1729,11 @@ (|>> ("jvm member invoke virtual" [] "java.lang.Class" "isInterface" []) "jvm object cast" (: ..Boolean) - (:as Bit))) + (.:as Bit))) (def: load_class (-> External (Try (primitive "java.lang.Class" [Any]))) - (|>> (:as (primitive "java.lang.String")) + (|>> (.:as (primitive "java.lang.String")) ["Ljava/lang/String;"] ("jvm member invoke static" [] "java.lang.Class" "forName" []) try)) @@ -1897,7 +1897,7 @@ (text.starts_with? descriptor.array_prefix name) (case params #.End - (let [[_ unprefixed] (maybe.assume (text.split_by descriptor.array_prefix name))] + (let [[_ unprefixed] (maybe.trusted (text.split_by descriptor.array_prefix name))] (\ meta.monad map type.array (lux_type->jvm_type (#.Primitive unprefixed (list))))) @@ -2062,8 +2062,8 @@ ["Signature" (..signature type)] ["Reflection" (..reflection type)])) -(syntax: .public (:cast [type (..type^ (list)) - object <code>.any]) +(syntax: .public (:as [type (..type^ (list)) + object <code>.any]) (case [(parser.array? type) (parser.class? type)] (^or [(#.Some _) _] [_ (#.Some _)]) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 0e041f5a1..29c286b23 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -299,7 +299,7 @@ (code.identifier ["" name]) (#.Some [pname pbounds]) - (class_type' mode type_params in_array? (maybe.assume (list.head pbounds)))) + (class_type' mode type_params in_array? (maybe.trusted (list.head pbounds)))) (#GenericClass name+params) (generic_class_type' mode type_params in_array? name+params @@ -352,7 +352,7 @@ type_var_class (#.Some [pname pbounds]) - (simple_class$ env (maybe.assume (list.head pbounds)))) + (simple_class$ env (maybe.trusted (list.head pbounds)))) (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _]))) type_var_class @@ -451,7 +451,7 @@ (<code>.form (<>.after (<code>.this! (' ::new!)) (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) .let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] - (in (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls')))) + (in (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.interposed "," arg_decls')))) (~+ args)))))) (def: (static_method_parser params class_name method_name arg_decls) @@ -462,7 +462,7 @@ (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) .let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] - (in (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) + (in (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.interposed "," arg_decls')))) (~+ args)))))) (template [<name> <jvm_op>] @@ -474,7 +474,7 @@ (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) .let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] - (in (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) + (in (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.interposed "," arg_decls')))) (~' _jvm_this) (~+ args))))))] [special_method_parser "jvm invokespecial"] @@ -949,7 +949,7 @@ (def: spaced (-> (List JVM_Code) JVM_Code) - (text.join_with " ")) + (text.interposed " ")) (def: (privacy_modifier$ pm) (-> Privacy JVM_Code) @@ -972,7 +972,7 @@ (def: (annotation$ [name params]) (-> Annotation JVM_Code) - (format "(" name " " "{" (text.join_with text.tab (list\map annotation_param$ params)) "}" ")")) + (format "(" name " " "{" (text.interposed text.tab (list\map annotation_param$ params)) "}" ")")) (def: (bound_kind$ kind) (-> BoundKind JVM_Code) @@ -1100,7 +1100,7 @@ (in (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super_class_name super_class) ":" name - ":" (text.join_with "," arg_decls')))) + ":" (text.interposed "," arg_decls')))) (~' _jvm_this) (~+ args)))))))] (with_parens (spaced (list "override" @@ -1528,7 +1528,7 @@ (#ConstructorDecl [commons _]) (do meta.monad [.let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))]) - jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.join_with "," arg_classes))) + jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.interposed "," arg_classes))) jvm_interop (|> (` ((~ jvm_extension) (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs)))) (decorate_return_maybe class member) @@ -1559,7 +1559,7 @@ ["invokeinterface" (list g!obj)] ))) - jvm_extension (code.text (format "jvm " jvm_op ":" full_name ":" import_method_name ":" (text.join_with "," arg_classes))) + jvm_extension (code.text (format "jvm " jvm_op ":" full_name ":" import_method_name ":" (text.interposed "," arg_classes))) jvm_interop (|> [(simple_class$ (list) (get@ #import_method_return method)) (` ((~ jvm_extension) (~+ (list\map un_quote object_ast)) (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))] diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index 2067663ad..cdb788bc9 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -114,7 +114,7 @@ ((~ g!body) (~ g!state)) (#.Left (~ g!error)) - (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))} + (#.Left ((~! text.interposed) (~! text.new_line) (list (~ error_msg) (~ g!error))))} ((~! </>.result) (: ((~! </>.Parser) (Meta (List Code))) ((~! do) (~! <>.monad) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index b0322f507..7ebf281d4 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -108,7 +108,7 @@ me_raw (|> raw macro.full_expansion (meta.result compiler) - <>.lift)] + <>.lifted)] (<| (<code>.local me_raw) <code>.form (<>.after (<code>.text! ..extension)) @@ -138,5 +138,5 @@ (in []) (#.Right _) - (<>.lift (exception.except ..lacks_type! [definition])))] + (<>.lifted (exception.except ..lacks_type! [definition])))] (in definition))) diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index b5a364ffd..8de4f2501 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -91,7 +91,7 @@ (text [#0 123 +456 +789.0 "abc" .def ..ghi]) "=>" "#0123+456+789.0abcdefghi")} - (in (list (|> simple (text.join_with "") code.text)))) + (in (list (|> simple (text.interposed "") code.text)))) (template [<a/an> <name> <simple> <complex> <short_example> <full_example>] [(`` (syntax: .public (<name> [name (<>.or (<>.and (..part true) (..part false)) @@ -107,11 +107,11 @@ <full_example>)} (case name (#.Left [simple complex]) - (in (list (<complex> [(text.join_with "" simple) - (text.join_with "" complex)]))) + (in (list (<complex> [(text.interposed "" simple) + (text.interposed "" complex)]))) (#.Right simple) - (in (list (|> simple (text.join_with "") <simple>))))))] + (in (list (|> simple (text.interposed "") <simple>))))))] ["An" identifier code.local_identifier code.identifier abcdefghi diff --git a/stdlib/source/library/lux/math/modulus.lux b/stdlib/source/library/lux/math/modulus.lux index 92d9a5903..3c360bf60 100644 --- a/stdlib/source/library/lux/math/modulus.lux +++ b/stdlib/source/library/lux/math/modulus.lux @@ -55,7 +55,7 @@ "Failure!" (literal 0))} - (meta.lift + (meta.lifted (do try.monad [_ (..modulus divisor)] - (in (list (` ((~! try.assumed) (..modulus (~ (code.int divisor)))))))))) + (in (list (` ((~! try.trusted) (..modulus (~ (code.int divisor)))))))))) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 981424626..9e49975f8 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -233,7 +233,7 @@ [(def: <name> (|> <hex> (\ //nat.hex decode) - try.assumed + try.trusted <cast>))] [.i64 "FFF8000000000000" not_a_number_bits] diff --git a/stdlib/source/library/lux/math/number/i16.lux b/stdlib/source/library/lux/math/number/i16.lux index 3bbbbe6f4..59d067f31 100644 --- a/stdlib/source/library/lux/math/number/i16.lux +++ b/stdlib/source/library/lux/math/number/i16.lux @@ -10,7 +10,7 @@ ["." i64 (#+ Sub)]]) (def: sub - (maybe.assume (i64.sub 16))) + (maybe.trusted (i64.sub 16))) (def: .public I16 {#.doc (example "A 16-bit integer.")} diff --git a/stdlib/source/library/lux/math/number/i32.lux b/stdlib/source/library/lux/math/number/i32.lux index bd0a705cf..75e6c6ec3 100644 --- a/stdlib/source/library/lux/math/number/i32.lux +++ b/stdlib/source/library/lux/math/number/i32.lux @@ -10,7 +10,7 @@ ["." i64 (#+ Sub)]]) (def: sub - (maybe.assume (i64.sub 32))) + (maybe.trusted (i64.sub 32))) (def: .public I32 {#.doc (example "A 32-bit integer.")} diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux index df8d01dbe..fd0c5545b 100644 --- a/stdlib/source/library/lux/math/number/i64.lux +++ b/stdlib/source/library/lux/math/number/i64.lux @@ -169,7 +169,7 @@ (repetitions size "1") (repetitions size "0"))) - high (try.assumed (\ n.binary decode pattern)) + high (try.trusted (\ n.binary decode pattern)) low (..right_rotated size high)] (function (_ value) (..or (..right_shifted size (..and high value)) diff --git a/stdlib/source/library/lux/math/number/i8.lux b/stdlib/source/library/lux/math/number/i8.lux index ba935b2d8..e0721117c 100644 --- a/stdlib/source/library/lux/math/number/i8.lux +++ b/stdlib/source/library/lux/math/number/i8.lux @@ -10,7 +10,7 @@ ["." i64 (#+ Sub)]]) (def: sub - (maybe.assume (i64.sub 8))) + (maybe.trusted (i64.sub 8))) (def: .public I8 {#.doc (example "An 8-bit integer.")} diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 72f0b2b51..b415adb91 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -298,7 +298,7 @@ (-> (List Text) Text) (|>> ..without_lux_runtime (list.sorted text\<) - (text.join_with ..listing_separator))) + (text.interposed ..listing_separator))) (def: .public (definition name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} @@ -344,7 +344,7 @@ #.None)))))) list.joined (list.sorted text\<) - (text.join_with ..listing_separator)) + (text.interposed ..listing_separator)) imports (|> this_module (get@ #.imports) ..module_listing) @@ -352,7 +352,7 @@ (get@ #.module_aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (list.sorted text\<) - (text.join_with ..listing_separator))] + (text.interposed ..listing_separator))] ($_ text\compose " Candidates: " candidates text.new_line " Imports: " imports text.new_line @@ -536,7 +536,7 @@ " Known tags: " (|> =module (get@ #.tags) (list\map (|>> product.left [module] name\encode (text.prefix text.new_line))) - (text.join_with "")) + text.joined) ))))) (def: .public (tag_lists module) @@ -591,7 +591,7 @@ (function (_ lux) (#try.Success [lux (get@ #.type_context lux)]))) -(def: .public (lift result) +(def: .public (lifted result) (All [a] (-> (Try a) (Meta a))) (case result (#try.Success output) diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux index b57326480..a53fac36f 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -147,7 +147,7 @@ (def: .public args (-> (List Var/1) Var/*) (|>> (list\map ..code) - (text.join_with " ") + (text.interposed " ") ..as_form :abstraction)) @@ -160,7 +160,7 @@ (#.Item _) (|> singles (list\map ..code) - (text.join_with " ") + (text.interposed " ") (text.suffix " "))) (format "&rest " (:representation rest)) ..as_form @@ -169,7 +169,7 @@ (def: form (-> (List (Expression Any)) Expression) (|>> (list\map ..code) - (text.join_with " ") + (text.interposed " ") ..as_form :abstraction)) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index 2e3d62147..95c49a200 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -120,7 +120,7 @@ (def: .public array (-> (List Expression) Computation) (|>> (list\map ..code) - (text.join_with ..argument_separator) + (text.interposed ..argument_separator) ..element :abstraction)) @@ -140,7 +140,7 @@ (-> Expression (List Expression) Computation) (|> inputs (list\map ..code) - (text.join_with ..argument_separator) + (text.interposed ..argument_separator) ..expression (format (:representation function)) :abstraction)) @@ -153,7 +153,7 @@ (-> (List [Text Expression]) Computation) (|>> (list\map (.function (_ [key val]) (format (:representation (..string key)) ..field_separator (:representation val)))) - (text.join_with ..argument_separator) + (text.interposed ..argument_separator) (text.enclosed ["{" "}"]) ..expression :abstraction)) @@ -185,7 +185,7 @@ (format "function " (:representation name) (|> inputs (list\map ..code) - (text.join_with ..argument_separator) + (text.interposed ..argument_separator) ..expression) " ") :abstraction)) @@ -204,7 +204,7 @@ (format "function" (|> inputs (list\map ..code) - (text.join_with ..argument_separator) + (text.interposed ..argument_separator) ..expression) " ") ..expression @@ -286,7 +286,7 @@ (|> (format "new " (:representation constructor) (|> inputs (list\map ..code) - (text.join_with ..argument_separator) + (text.interposed ..argument_separator) ..expression)) ..expression :abstraction)) @@ -411,9 +411,9 @@ (list\map (.function (_ [when then]) (format (|> when (list\map (|>> :representation (text.enclosed ["case " ":"]))) - (text.join_with text.new_line)) + (text.interposed text.new_line)) (..nested (:representation then))))) - (text.join_with text.new_line)) + (text.interposed text.new_line)) text.new_line (case default (#.Some default) diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux index 72e054d5f..1dd3c323e 100644 --- a/stdlib/source/library/lux/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/target/jvm/attribute.lux @@ -87,7 +87,7 @@ (def: (constant' @name index) (-> (Index UTF8) (Constant Any) Attribute) (#Constant {#name @name - #length (|> /constant.length //unsigned.u4 try.assumed) + #length (|> /constant.length //unsigned.u4 try.trusted) #info index})) (def: .public (constant index) @@ -104,7 +104,7 @@ #length (|> specification (/code.length ..length) //unsigned.u4 - try.assumed) + try.trusted) #info specification})) (def: .public (code specification) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index b742f16cc..87b0a75c5 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -198,7 +198,7 @@ []]])))) (template [<name> <frames>] - [(def: <name> U2 (|> <frames> //unsigned.u2 try.assumed))] + [(def: <name> U2 (|> <frames> //unsigned.u2 try.trusted))] [$0 0] [$1 1] @@ -210,7 +210,7 @@ ) (template [<name> <registry>] - [(def: <name> Registry (|> <registry> //unsigned.u2 try.assumed /registry.registry))] + [(def: <name> Registry (|> <registry> //unsigned.u2 try.trusted /registry.registry))] [@_ 0] [@0 1] @@ -436,7 +436,7 @@ (-> S1 (Bytecode Any)) (..bytecode $0 $1 @_ _.bipush [byte])) -(def: (lift resource) +(def: (lifted resource) (All [a] (-> (Resource a) (Bytecode a))) @@ -450,7 +450,7 @@ (def: .public (string value) (-> //constant.UTF8 (Bytecode Any)) (do ..monad - [index (..lift (//constant/pool.string value))] + [index (..lifted (//constant/pool.string value))] (case (|> index //index.value //unsigned.value //unsigned.u1) (#try.Success index) (..bytecode $0 $1 @_ _.ldc [index]) @@ -475,7 +475,7 @@ <specializations> _ (do ..monad - [index (..lift (<constant> (<constructor> value)))] + [index (..lifted (<constant> (<constructor> value)))] (case (|> index //index.value //unsigned.value //unsigned.u1) (#try.Success index) (..bytecode $0 $1 @_ _.ldc [index]) @@ -497,7 +497,7 @@ (def: (arbitrary_float value) (-> java/lang/Float (Bytecode Any)) (do ..monad - [index (..lift (//constant/pool.float (//constant.float value)))] + [index (..lifted (//constant/pool.float (//constant.float value)))] (case (|> index //index.value //unsigned.value //unsigned.u1) (#try.Success index) (..bytecode $0 $1 @_ _.ldc [index]) @@ -537,7 +537,7 @@ <specializations> _ (do ..monad - [index (..lift (<constant> (<constructor> value)))] + [index (..lifted (<constant> (<constructor> value)))] (..bytecode $0 $2 @_ <wide> [index]))))] [long Int //constant.long //constant/pool.long _.ldc2_w/long @@ -549,7 +549,7 @@ (def: (arbitrary_double value) (-> java/lang/Double (Bytecode Any)) (do ..monad - [index (..lift (//constant/pool.double (//constant.double (:as Frac value))))] + [index (..lifted (//constant/pool.double (//constant.double (:as Frac value))))] (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) (def: double_bits @@ -821,7 +821,7 @@ (in [..no_exceptions (bytecode jump)])] [goto_w _.goto_w (in [..no_exceptions (bytecode jump)]) - (in [..no_exceptions (bytecode (/jump.lift jump))])] + (in [..no_exceptions (bytecode (/jump.lifted jump))])] ) (def: (big_jump jump) @@ -831,7 +831,7 @@ big (#.Right small) - (/jump.lift small))) + (/jump.lifted small))) (exception: .public invalid_tableswitch) @@ -924,7 +924,7 @@ (-> (Type <category>) (Bytecode Any)) (do ..monad [... TODO: Make sure it's impossible to have indexes greater than U2. - index (..lift (//constant/pool.class (//name.internal (..reflection class))))] + index (..lifted (//constant/pool.class (//name.internal (..reflection class))))] (..bytecode <consumption> <production> @_ <instruction> [index])))] [$0 $1 new Class _.new] @@ -949,8 +949,8 @@ (case (|> dimensions //unsigned.value) 0 (..except ..multiarray_cannot_be_zero_dimensional [class]) _ (in []))) - index (..lift (//constant/pool.class (//name.internal (..reflection class))))] - (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) + index (..lifted (//constant/pool.class (//name.internal (..reflection class))))] + (..bytecode (//unsigned.lifted/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) (def: (type_size type) (-> (Type Return) Nat) @@ -969,7 +969,7 @@ (-> (Type Class) Text (Type Method) (Bytecode Any)) (let [[type_variables inputs output exceptions] (parser.method type)] (do ..monad - [index (<| ..lift + [index (<| ..lifted (<method> (..reflection class)) {#//constant/pool.name method #//constant/pool.descriptor (type.descriptor type)}) @@ -977,10 +977,10 @@ (list\map ..type_size) (list\fold n.+ (if <static?> 0 1)) //unsigned.u1 - try.assumed) - production (|> output ..type_size //unsigned.u1 try.assumed)]] - (..bytecode (//unsigned.lift/2 consumption) - (//unsigned.lift/2 production) + try.trusted) + production (|> output ..type_size //unsigned.u1 try.trusted)]] + (..bytecode (//unsigned.lifted/2 consumption) + (//unsigned.lifted/2 production) @_ <instruction> [index consumption production]))))] @@ -994,7 +994,7 @@ [(def: .public (<name> class field type) (-> (Type Class) Text (Type Value) (Bytecode Any)) (do ..monad - [index (<| ..lift + [index (<| ..lifted (//constant/pool.field (..reflection class)) {#//constant/pool.name field #//constant/pool.descriptor (type.descriptor type)})] @@ -1017,7 +1017,7 @@ (def: .public (try @start @end @handler catch) (-> Label Label Label (Type Class) (Bytecode Any)) (do ..monad - [@catch (..lift (//constant/pool.class (//name.internal (..reflection catch))))] + [@catch (..lifted (//constant/pool.class (//name.internal (..reflection catch))))] (function (_ [pool environment tracker]) (#try.Success [[pool @@ -1038,7 +1038,7 @@ _.empty]))) []]])))) -(def: .public (compose pre post) +(def: .public (composite pre post) (All [pre post] (-> (Bytecode pre) (Bytecode post) (Bytecode post))) (do ..monad diff --git a/stdlib/source/library/lux/target/jvm/bytecode/address.lux b/stdlib/source/library/lux/target/jvm/bytecode/address.lux index d7f2f612f..669b49548 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/address.lux @@ -34,7 +34,7 @@ (def: .public start Address - (|> 0 ///unsigned.u2 try.assumed :abstraction)) + (|> 0 ///unsigned.u2 try.trusted :abstraction)) (def: .public (move distance) (-> U2 (-> Address (Try Address))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux index ddc600162..43cb70e87 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -78,10 +78,10 @@ (template [<name> <extra>] [(def: .public <name> (-> Register Registry) - (let [extra (|> <extra> /////unsigned.u2 try.assumed)] - (|>> /////unsigned.lift/2 + (let [extra (|> <extra> /////unsigned.u2 try.trusted)] + (|>> /////unsigned.lifted/2 (/////unsigned.+/2 extra) - try.assumed + try.trusted :abstraction)))] [for ..normal] diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux index 5499207cf..ac3934f87 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux @@ -25,7 +25,7 @@ (template [<frames> <name>] [(def: .public <name> Stack - (|> <frames> /////unsigned.u2 maybe.assume :abstraction))] + (|> <frames> /////unsigned.u2 maybe.trusted :abstraction))] [0 empty] [1 catch] diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index 22777c083..7f8638dca 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -59,7 +59,7 @@ (type: Opcode Nat) (template [<name> <size>] - [(def: <name> Size (|> <size> ///unsigned.u2 try.assumed))] + [(def: <name> Size (|> <size> ///unsigned.u2 try.trusted))] [opcode_size 1] [register_size 1] @@ -74,7 +74,7 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..opcode_size) offset) - (try.assumed + (try.trusted (binary.write/8! offset opcode binary))])) (def: nullary @@ -90,7 +90,7 @@ Size (|> ..opcode_size (///unsigned.+/2 <size>) - try.assumed))] + try.trusted))] [size/1 ..register_size] [size/2 ..index_size] @@ -103,7 +103,7 @@ (-> Opcode <inputT> Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value <shift>) offset) - (try.assumed + (try.trusted (do try.monad [_ (binary.write/8! offset opcode binary)] (<writer> (n.+ (///unsigned.value ..opcode_size) offset) @@ -129,7 +129,7 @@ (-> Opcode <inputT> Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value <shift>) offset) - (try.assumed + (try.trusted (do try.monad [_ (binary.write/8! offset opcode binary)] (<writer> (n.+ (///unsigned.value ..opcode_size) offset) @@ -150,14 +150,14 @@ (def: size/11 Size (|> ..opcode_size - (///unsigned.+/2 ..register_size) try.assumed - (///unsigned.+/2 ..byte_size) try.assumed)) + (///unsigned.+/2 ..register_size) try.trusted + (///unsigned.+/2 ..byte_size) try.trusted)) (def: (binary/11' opcode input0 input1) (-> Opcode U1 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/11) offset) - (try.assumed + (try.trusted (do try.monad [_ (binary.write/8! offset opcode binary) _ (binary.write/8! (n.+ (///unsigned.value ..opcode_size) offset) @@ -177,14 +177,14 @@ (def: size/21 Size (|> ..opcode_size - (///unsigned.+/2 ..index_size) try.assumed - (///unsigned.+/2 ..byte_size) try.assumed)) + (///unsigned.+/2 ..index_size) try.trusted + (///unsigned.+/2 ..byte_size) try.trusted)) (def: (binary/21' opcode input0 input1) (-> Opcode U2 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/21) offset) - (try.assumed + (try.trusted (do try.monad [_ (binary.write/8! offset opcode binary) _ (binary.write/16! (n.+ (///unsigned.value ..opcode_size) offset) @@ -204,15 +204,15 @@ (def: size/211 Size (|> ..opcode_size - (///unsigned.+/2 ..index_size) try.assumed - (///unsigned.+/2 ..byte_size) try.assumed - (///unsigned.+/2 ..byte_size) try.assumed)) + (///unsigned.+/2 ..index_size) try.trusted + (///unsigned.+/2 ..byte_size) try.trusted + (///unsigned.+/2 ..byte_size) try.trusted)) (def: (trinary/211' opcode input0 input1 input2) (-> Opcode U2 U1 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/211) offset) - (try.assumed + (try.trusted (do try.monad [_ (binary.write/8! offset opcode binary) _ (binary.write/16! (n.+ (///unsigned.value ..opcode_size) offset) @@ -242,7 +242,7 @@ (|>> :representation)) (template [<code> <name>] - [(def: .public <name> (|> <code> ///unsigned.u1 try.assumed :abstraction))] + [(def: .public <name> (|> <code> ///unsigned.u1 try.trusted :abstraction))] [04 t_boolean] [05 t_char] @@ -573,7 +573,7 @@ [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.value index) count]]]] [..trinary/211 - [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index) count (try.assumed (///unsigned.u1 0))]]]] + [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index) count (try.trusted (///unsigned.u1 0))]]]] )) (def: (switch_padding offset) @@ -598,14 +598,14 @@ (n.* (///unsigned.value ..big_jump_size) (inc amount_of_afterwards))) ///unsigned.u2 - try.assumed)))] + try.trusted)))] [estimator (function (_ minimum default [at_minimum afterwards]) (let [amount_of_afterwards (list.size afterwards) estimator (estimator amount_of_afterwards)] (function (_ [size mutation]) (let [padding (switch_padding size) - tableswitch_size (try.assumed + tableswitch_size (try.trusted (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) @@ -613,7 +613,7 @@ tableswitch_mutation (: Mutation (function (_ [offset binary]) [(n.+ tableswitch_size offset) - (try.assumed + (try.trusted (do {! try.monad} [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) maximum (///signed.+/4 minimum amount_of_afterwards) @@ -662,14 +662,14 @@ (///unsigned.value ..integer_size) (n.* amount_of_cases case_size)) ///unsigned.u2 - try.assumed)))] + try.trusted)))] [estimator (function (_ default cases) (let [amount_of_cases (list.size cases) estimator (estimator amount_of_cases)] (function (_ [size mutation]) (let [padding (switch_padding size) - lookupswitch_size (try.assumed + lookupswitch_size (try.trusted (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) @@ -677,7 +677,7 @@ lookupswitch_mutation (: Mutation (function (_ [offset binary]) [(n.+ lookupswitch_size offset) - (try.assumed + (try.trusted (do {! try.monad} [_ (binary.write/8! offset (hex "AB") binary) .let [offset (n.+ (///unsigned.value ..opcode_size) offset)] diff --git a/stdlib/source/library/lux/target/jvm/bytecode/jump.lux b/stdlib/source/library/lux/target/jvm/bytecode/jump.lux index 53fdd6081..74821d838 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/jump.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/jump.lux @@ -22,6 +22,6 @@ (type: .public Big_Jump S4) -(def: .public lift +(def: .public lifted (-> Jump Big_Jump) - ///signed.lift/4) + ///signed.lifted/4) diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index a82683e1b..2278889b8 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -154,5 +154,5 @@ (def: .public empty Pool - [(|> 1 //unsigned.u2 try.assumed //index.index) + [(|> 1 //unsigned.u2 try.trusted //index.index) row.empty]) diff --git a/stdlib/source/library/lux/target/jvm/constant/tag.lux b/stdlib/source/library/lux/target/jvm/constant/tag.lux index 7d53837f0..54b4dbba1 100644 --- a/stdlib/source/library/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux @@ -28,7 +28,7 @@ (template [<code> <name>] [(def: .public <name> Tag - (|> <code> ///unsigned.u1 try.assumed :abstraction))] + (|> <code> ///unsigned.u1 try.trusted :abstraction))] [01 utf8] [03 integer] diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index 196f60380..8fed13354 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -93,8 +93,8 @@ (-> <from> <to>) (|>> :transmutation))] - [lift/2 S1 S2] - [lift/4 S2 S4] + [lifted/2 S1 S2] + [lifted/4 S2 S4] ) (template [<writer_name> <type> <writer>] diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux index e9084bb9d..8a889a1ad 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -107,8 +107,8 @@ (-> <from> <to>) (|>> :transmutation))] - [lift/2 U1 U2] - [lift/4 U2 U4] + [lifted/2 U1 U2] + [lifted/4 U2 U4] ) (template [<writer_name> <type> <writer>] diff --git a/stdlib/source/library/lux/target/jvm/magic.lux b/stdlib/source/library/lux/target/jvm/magic.lux index c08360f9e..b2b547fcf 100644 --- a/stdlib/source/library/lux/target/jvm/magic.lux +++ b/stdlib/source/library/lux/target/jvm/magic.lux @@ -14,7 +14,9 @@ (def: .public code Magic - (|> (hex "CAFEBABE") //unsigned.u4 try.assumed)) + (|> (hex "CAFEBABE") + //unsigned.u4 + try.trusted)) (def: .public writer //unsigned.writer/4) diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux index 523a9a722..c7eb021b2 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -43,7 +43,7 @@ (template: (!wrap value) [(|> value //unsigned.u2 - try.assumed + try.trusted :abstraction)]) (template: (!unwrap value) diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index 6b3a2ee45..5ba678bf6 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -128,4 +128,4 @@ return (..return aliasing) exceptions (<>.some (..exception aliasing))] (in (//.method [type_variables inputs return exceptions])))) - try.assumed)) + try.trusted)) diff --git a/stdlib/source/library/lux/target/jvm/type/descriptor.lux b/stdlib/source/library/lux/target/jvm/type/descriptor.lux index 60e8eead3..9c0f56021 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -98,7 +98,7 @@ (:abstraction (format (|> inputs (list\map ..descriptor) - (text.join_with "") + text.joined (text.enclosed ["(" ")"])) (:representation output)))) @@ -122,5 +122,5 @@ (n.- prefix_size) (n.- suffix_size))) (\ maybe.monad map ///name.internal) - maybe.assume)))))) + maybe.trusted)))))) ) diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 6712f7ee0..2bbbca6ca 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -98,7 +98,7 @@ (|>> //.signature //signature.signature (<text>.result ..var') - try.assumed)) + try.trusted)) (template [<name> <prefix> <constructor>] [(def: <name> @@ -166,7 +166,7 @@ (|>> //.signature //signature.signature (<text>.result (..class'' ..parameter)) - try.assumed)) + try.trusted)) (def: .public value (Parser (Type Value)) @@ -224,7 +224,7 @@ (|>> //.signature //signature.signature (<text>.result parser) - try.assumed))) + try.trusted))) (template [<name> <category> <parser>] [(def: .public <name> @@ -262,4 +262,4 @@ (|>> //.signature //signature.signature (<text>.result ..declaration') - try.assumed)) + try.trusted)) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index 23038130a..683ba1432 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -94,7 +94,7 @@ (format ..parameters_start (|> parameters (list\map ..signature) - (text.join_with "")) + text.joined) ..parameters_end)) //descriptor.class_suffix))) @@ -130,18 +130,18 @@ (|> type_variables (list\map (|>> ..var_name (text.suffix ..class_bound))) - (text.join_with "") + text.joined (text.enclosed [..parameters_start ..parameters_end]))) (|> inputs (list\map ..signature) - (text.join_with "") + text.joined (text.enclosed [..arguments_start ..arguments_end])) (:representation output) (|> exceptions (list\map (|>> :representation (format ..exception_prefix))) - (text.join_with ""))))) + text.joined)))) (implementation: .public equivalence (All [category] (Equivalence (Signature category))) diff --git a/stdlib/source/library/lux/target/jvm/version.lux b/stdlib/source/library/lux/target/jvm/version.lux index f5db348ef..7fbf55c35 100644 --- a/stdlib/source/library/lux/target/jvm/version.lux +++ b/stdlib/source/library/lux/target/jvm/version.lux @@ -13,12 +13,16 @@ (def: .public default_minor Minor - (|> 0 //unsigned.u2 try.assumed)) + (|> 0 + //unsigned.u2 + try.trusted)) (template [<number> <name>] [(def: .public <name> Major - (|> <number> //unsigned.u2 try.assumed))] + (|> <number> + //unsigned.u2 + try.trusted))] [45 v1_1] [46 v1_2] diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 0bf872340..b79db8fc4 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -141,13 +141,13 @@ (def: .public multi (-> (List Expression) Literal) (|>> (list\map ..code) - (text.join_with ..input_separator) + (text.interposed ..input_separator) :abstraction)) (def: .public array (-> (List Expression) Literal) (|>> (list\map ..code) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["{" "}"]) :abstraction)) @@ -155,7 +155,7 @@ (-> (List [Text Expression]) Literal) (|>> (list\map (.function (_ [key value]) (format key " = " (:representation value)))) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["{" "}"]) :abstraction)) @@ -177,7 +177,7 @@ (-> (List Expression) Expression Computation) (|> args (list\map ..code) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["(" ")"]) (format (:representation func)) :abstraction)) @@ -186,7 +186,7 @@ (-> Text (List Expression) Expression Computation) (|> args (list\map ..code) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["(" ")"]) (format (:representation table) ":" method) :abstraction)) @@ -256,7 +256,7 @@ (def: locations (-> (List Location) Text) (|>> (list\map ..code) - (text.join_with ..input_separator))) + (text.interposed ..input_separator))) (def: .public (local vars) (-> (List Var) Statement) @@ -306,7 +306,7 @@ (:abstraction (format "for " (|> vars (list\map ..code) - (text.join_with ..input_separator)) + (text.interposed ..input_separator)) " in " (:representation source) " do" (..nested (:representation body!)) text.new_line "end"))) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index 16ebbe5af..11aea7808 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -183,7 +183,7 @@ (def: arguments (-> (List Expression) Text) - (|>> (list\map ..code) (text.join_with ..input_separator) ..group)) + (|>> (list\map ..code) (text.interposed ..input_separator) ..group)) (def: .public (apply/* args func) (-> (List Expression) Expression Computation) @@ -201,7 +201,7 @@ (.if reference? (format "&" (:representation var)) (:representation var)))) - (text.join_with ..input_separator) + (text.interposed ..input_separator) ..group)) (template [<name> <reference?>] @@ -310,7 +310,7 @@ (-> (List Expression) Literal) (|> values (list\map ..code) - (text.join_with ..input_separator) + (text.interposed ..input_separator) ..group (format "array") :abstraction)) @@ -324,7 +324,7 @@ (|> kvs (list\map (function (_ [key value]) (format (:representation key) " => " (:representation value)))) - (text.join_with ..input_separator) + (text.interposed ..input_separator) ..group (format "array") :abstraction)) @@ -493,7 +493,7 @@ text.new_line (|> excepts (list\map catch) - (text.join_with text.new_line))))) + (text.interposed text.new_line))))) (template [<name> <keyword>] [(def: .public <name> diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 4fd525f46..c8a62c58b 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -192,7 +192,7 @@ (format left_delimiter (|> entries (list\map entry_serializer) - (text.join_with ", ")) + (text.interposed ", ")) right_delimiter)))) (template [<name> <pre> <post>] @@ -224,7 +224,7 @@ (-> (Expression Any) (List (Expression Any)) (Computation Any)) (<| :abstraction ... ..expression - (format (:representation func) "(" (text.join_with ", " (list\map ..code args)) ")"))) + (format (:representation func) "(" (text.interposed ", " (list\map ..code args)) ")"))) (template [<name> <brand> <prefix>] [(def: (<name> var) @@ -243,7 +243,7 @@ (format (:representation func) (format "(" (|> args (list\map (function (_ arg) (format (:representation arg) ", "))) - (text.join_with "")) + text.joined) (<splat> extra) ")"))))] [apply_poly splat_poly] @@ -323,13 +323,13 @@ (-> (List (Var Any)) (Expression Any) (Computation Any)) (<| :abstraction ..expression - (format "lambda " (|> arguments (list\map ..code) (text.join_with ", ")) ": " + (format "lambda " (|> arguments (list\map ..code) (text.interposed ", ")) ": " (:representation body)))) (def: .public (set vars value) (-> (List (Location Any)) (Expression Any) (Statement Any)) (:abstraction - (format (|> vars (list\map ..code) (text.join_with ", ")) + (format (|> vars (list\map ..code) (text.interposed ", ")) " = " (:representation value)))) @@ -406,10 +406,10 @@ (..nested (:representation body!)) (|> excepts (list\map (function (_ [classes exception catch!]) - (format text.new_line "except (" (text.join_with ", " (list\map ..code classes)) + (format text.new_line "except (" (text.interposed ", " (list\map ..code classes)) ") as " (:representation exception) ":" (..nested (:representation catch!))))) - (text.join_with ""))))) + text.joined)))) (template [<name> <keyword> <pre>] [(def: .public (<name> value) @@ -437,7 +437,7 @@ (-> SVar (List (Ex [k] (Var k))) (Statement Any) (Statement Any)) (:abstraction (format "def " (:representation name) - "(" (|> args (list\map ..code) (text.join_with ", ")) "):" + "(" (|> args (list\map ..code) (text.interposed ", ")) "):" (..nested (:representation body))))) (def: .public (import module_name) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index a41440b7a..15804b77b 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -168,12 +168,14 @@ (def: .public (apply args func) (-> (List Expression) Expression Expression) (let [func (:representation func) - spacing (|> " " (list.repeated (text.size func)) (text.join_with ""))] + spacing (|> " " + (list.repeated (text.size func)) + text.joined)] (:abstraction (format func "(" (|> args (list\map ..code) - (text.join_with (format "," text.new_line)) + (text.interposed (format "," text.new_line)) ..nested) ")")))) @@ -197,10 +199,10 @@ (..self_contained (format (:representation func) (format "(" - (text.join_with "," (list\map ..code args)) "," - (text.join_with "," (list\map (.function (_ [key val]) - (format key "=" (:representation val))) - kw_args)) + (text.interposed "," (list\map ..code args)) "," + (text.interposed "," (list\map (.function (_ [key val]) + (format key "=" (:representation val))) + kw_args)) ")")))) (syntax: (arity_inputs [arity <code>.nat]) @@ -326,7 +328,7 @@ (def: .public (function inputs body) (-> (List (Ex [k] (Var k))) Expression Expression) - (let [args (|> inputs (list\map ..code) (text.join_with ", "))] + (let [args (|> inputs (list\map ..code) (text.interposed ", "))] (..self_contained (format "function(" args ") " (.._block (:representation body)))))) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index b717ef7cb..032ebb265 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -201,7 +201,7 @@ (def: .public array (-> (List Expression) Literal) (|>> (list\map (|>> :representation)) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["[" "]"]) :abstraction)) @@ -209,7 +209,7 @@ (-> (List [Expression Expression]) Literal) (|>> (list\map (.function (_ [k v]) (format (:representation k) " => " (:representation v)))) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["{" "}"]) :abstraction)) @@ -217,7 +217,7 @@ (-> (List Expression) Expression Computation) (|> args (list\map (|>> :representation)) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["(" ")"]) (format (:representation func)) :abstraction)) @@ -226,7 +226,7 @@ (-> (List Expression) Expression Computation) (|> args (list\map (|>> :representation)) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["[" "]"]) (format (:representation lambda)) :abstraction)) @@ -268,7 +268,7 @@ (:abstraction (format (|> vars (list\map (|>> :representation)) - (text.join_with ..input_separator)) + (text.interposed ..input_separator)) " = " (:representation value) ..statement_suffix))) (def: (block content) @@ -318,10 +318,10 @@ (format "begin" (..nested (:representation body!)) (|> rescues (list\map (.function (_ [classes exception rescue]) - (format text.new_line "rescue " (text.join_with ..input_separator classes) + (format text.new_line "rescue " (text.interposed ..input_separator classes) " => " (:representation exception) (..nested (:representation rescue))))) - (text.join_with text.new_line))))) + (text.interposed text.new_line))))) (def: .public (catch expectation body!) (-> Expression Statement Statement) @@ -357,7 +357,7 @@ (format "def " (:representation name) (|> args (list\map (|>> :representation)) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed ["(" ")"])) (..nested (:representation body!))))) @@ -365,7 +365,7 @@ (-> (Maybe LVar) (List Var) Statement Literal) (let [proc (|> (format (|> args (list\map (|>> :representation)) - (text.join_with ..input_separator) + (text.interposed ..input_separator) (text.enclosed' "|")) (..nested (:representation body!))) (text.enclosed ["{" "}"]) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index 6dcc744ca..7e910a91f 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -86,14 +86,14 @@ (|> (format " . " (:representation rest)) (format (|> mandatory (list\map ..code) - (text.join_with " "))) + (text.interposed " "))) (text.enclosed ["(" ")"]) :abstraction)) #.None (|> mandatory (list\map ..code) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["(" ")"]) :abstraction))) @@ -164,7 +164,7 @@ (|> tail (list\map (|>> :representation ..nested)) (#.Item (:representation head)) - (text.join_with nested_new_line) + (text.interposed nested_new_line) (text.enclosed ["(" ")"]) :abstraction))))) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 867304aa7..dbd87627e 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -116,7 +116,7 @@ [tally (|> documentation (text.all_split_by ..separator) (list\map (|>> (format context_prefix))) - (text.join_with ..separator) + (text.interposed ..separator) (format description ..separator))])))) (def: failure_prefix "[Failure] ") @@ -143,7 +143,7 @@ (-> Text Bit Test) (random\in (..assertion message condition))) -(def: .public (lift message random) +(def: .public (lifted message random) (-> Text (Random Bit) Test) (random\map (..assertion message) random)) @@ -273,7 +273,7 @@ (-> (List Name) Bit Assertion) (let [message (|> coverage (list\map %.name) - (text.join_with " & ")) + (text.interposed " & ")) coverage (set.of_list name.hash coverage)] (|> (..assertion message condition) (async\map (function (_ [tally documentation]) @@ -289,7 +289,7 @@ (-> (List Name) Test Test) (let [context (|> coverage (list\map %.name) - (text.join_with " & ")) + (text.interposed " & ")) coverage (set.of_list name.hash coverage)] (random\map (async\map (function (_ [tally documentation]) [(update@ #actual_coverage (set.union coverage) tally) @@ -441,7 +441,7 @@ (list\fold ..total ..start)) (|> assertions (list\map product.right) - (text.join_with ..separator))])) + (text.interposed ..separator))])) (in [])))) (run! test))) (list.enumeration tests)))]] diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 9429e7081..eb0928f5c 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -74,7 +74,7 @@ [value <sub_parser>] (if (n.< <maximum> value) (in value) - (<>.lift (exception.except <exception> [value])))))] + (<>.lifted (exception.except <exception> [value])))))] [..hours hour_parser invalid_hour ..section_parser] [..minutes minute_parser invalid_minute ..section_parser] diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index 310be7a0e..75e5609ea 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -87,7 +87,7 @@ (def: .public epoch Date - (try.assumed + (try.trusted (..date //year.epoch #//month.January ..minimum_day))) @@ -166,7 +166,7 @@ (if (and (n.>= <minimum> value) (n.<= <maximum> value)) (in value) - (<>.lift (exception.except <exception> [value])))))] + (<>.lifted (exception.except <exception> [value])))))] [1 12 month_parser invalid_month] ) @@ -178,9 +178,9 @@ _ (<text>.this ..separator) utc_month ..month_parser _ (<text>.this ..separator) - .let [month (maybe.assume (dictionary.value utc_month ..month_by_number))] + .let [month (maybe.trusted (dictionary.value utc_month ..month_by_number))] utc_day ..section_parser] - (<>.lift (..date utc_year month utc_day)))) + (<>.lifted (..date utc_year month utc_day)))) (def: (format value) (-> Date Text) @@ -337,9 +337,9 @@ (inc year) year)] ... Coercing, because the year is already in internal form. - (try.assumed + (try.trusted (..date (:as Year year) - (maybe.assume (dictionary.value month ..month_by_number)) + (maybe.trusted (dictionary.value month ..month_by_number)) day)))) (implementation: .public enum diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index cc19a4ecc..36e0b2504 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -122,7 +122,7 @@ duration.millis .nat //.of_millis - try.assumed)) + try.trusted)) (def: (format instant) (-> Instant Text) diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index e7ed644ce..dd303ed85 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -125,9 +125,9 @@ [sign (<>.or (<text>.this "-") (in [])) digits (<text>.many <text>.decimal) raw_year (<>.codec i.decimal (in (text\compose "+" digits)))] - (<>.lift (..year (case sign - (#.Left _) (i.* -1 raw_year) - (#.Right _) raw_year))))) + (<>.lifted (..year (case sign + (#.Left _) (i.* -1 raw_year) + (#.Right _) raw_year))))) (implementation: .public codec {#.doc (example "Based on ISO 8601." diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 6af02e080..e8b91db8c 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -127,7 +127,7 @@ (do ///phase.monad [.let [module (get@ #///.module input)] _ (///directive.set_current_module module)] - (///directive.lift_analysis + (///directive.lifted_analysis (do {! ///phase.monad} [_ (module.create hash module) _ (monad.map ! module.import dependencies) @@ -141,15 +141,15 @@ (All [anchor expression directive] (///directive.Operation anchor expression directive [.Module (Payload directive)]))) (do ///phase.monad - [_ (///directive.lift_analysis + [_ (///directive.lifted_analysis (module.set_compiled module)) analysis_module (<| (: (Operation .Module)) - ///directive.lift_analysis - extension.lift + ///directive.lifted_analysis + extension.lifted meta.current_module) - final_buffer (///directive.lift_generation + final_buffer (///directive.lifted_generation ///generation.buffer) - final_registry (///directive.lift_generation + final_registry (///directive.lifted_generation ///generation.get_registry)] (in [analysis_module [final_buffer final_registry]]))) @@ -162,9 +162,9 @@ (///directive.Operation anchor expression directive (Payload directive))))) (do ///phase.monad - [buffer (///directive.lift_generation + [buffer (///directive.lifted_generation ///generation.buffer) - registry (///directive.lift_generation + registry (///directive.lifted_generation ///generation.get_registry)] (in [buffer registry]))) @@ -177,9 +177,9 @@ [Requirements (Payload directive)])))) (do ///phase.monad [.let [[pre_buffer pre_registry] pre_payoad] - _ (///directive.lift_generation + _ (///directive.lifted_generation (///generation.set_buffer pre_buffer)) - _ (///directive.lift_generation + _ (///directive.lifted_generation (///generation.set_registry pre_registry)) requirements (let [execute! (directiveP.phase expander)] (execute! archive code)) @@ -193,7 +193,7 @@ (///directive.Operation anchor expression directive [Source Requirements (Payload directive)])))) (do ///phase.monad - [[source code] (///directive.lift_analysis + [[source code] (///directive.lifted_analysis (..read source reader)) [requirements post_payload] (process_directive archive expander pre_payload code)] (in [source requirements post_payload]))) @@ -205,7 +205,7 @@ (///directive.Operation anchor expression directive (Maybe [Source Requirements (Payload directive)]))))) (do ///phase.monad - [reader (///directive.lift_analysis + [reader (///directive.lifted_analysis (..reader module aliases source))] (function (_ state) (case (///phase.result' state (..iteration' archive expander reader source pre_payload)) @@ -273,12 +273,12 @@ (recur (<| (///phase.result' state) (do {! ///phase.monad} [analysis_module (<| (: (Operation .Module)) - ///directive.lift_analysis - extension.lift + ///directive.lifted_analysis + extension.lifted meta.current_module) - _ (///directive.lift_generation + _ (///directive.lifted_generation (///generation.set_buffer temporary_buffer)) - _ (///directive.lift_generation + _ (///directive.lifted_generation (///generation.set_registry temporary_registry)) _ (|> requirements (get@ #///directive.referrals) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index f19ec248c..53cb07e22 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -150,14 +150,14 @@ (///directive.Operation <type_vars> [Archive [Descriptor (Document .Module) Output]]))) (do ///phase.monad - [[registry payload] (///directive.lift_generation + [[registry payload] (///directive.lifted_generation (..compile_runtime! platform)) .let [[descriptor document] [(..runtime_descriptor registry) ..runtime_document]] - archive (///phase.lift (if (archive.reserved? archive archive.runtime_module) - (archive.has archive.runtime_module [descriptor document payload] archive) - (do try.monad - [[_ archive] (archive.reserve archive.runtime_module archive)] - (archive.has archive.runtime_module [descriptor document payload] archive))))] + archive (///phase.lifted (if (archive.reserved? archive archive.runtime_module) + (archive.has archive.runtime_module [descriptor document payload] archive) + (do try.monad + [[_ archive] (archive.reserve archive.runtime_module archive)] + (archive.has archive.runtime_module [descriptor document payload] archive))))] (in [archive [descriptor document payload]]))) (def: (initialize_state extender @@ -182,13 +182,13 @@ (///directive.Operation <type_vars> Any) (do ///phase.monad - [_ (///directive.lift_analysis + [_ (///directive.lifted_analysis (///analysis.install analysis_state)) - _ (///directive.lift_analysis + _ (///directive.lifted_analysis (extension.with extender analysers)) - _ (///directive.lift_synthesis + _ (///directive.lifted_synthesis (extension.with extender synthesizers)) - _ (///directive.lift_generation + _ (///directive.lifted_generation (extension.with extender (:expected generators))) _ (extension.with extender (:expected directives))] (in []))) @@ -201,7 +201,7 @@ (let [phase_wrapper (get@ #phase_wrapper platform)] (|> archive phase_wrapper - ///directive.lift_generation + ///directive.lifted_generation (///phase.result' state)))) (def: (complete_extensions host_directive_bundle phase_wrapper [analysers synthesizers generators directives]) @@ -520,7 +520,7 @@ (-> Module <State+> <State+>)) (|> (///directive.set_current_module module) (///phase.result' state) - try.assumed + try.trusted product.left)) (def: .public (compile import static expander platform compilation context) @@ -586,7 +586,7 @@ .let [archive (|> archive,document+ (list\map product.left) (list\fold archive.merged archive))]] - (in [archive (try.assumed + (in [archive (try.trusted (..updated_state archive state))]))) (async\in (exception.except ..cannot_import_twice [module duplicates])))] (case ((get@ #///.process compilation) @@ -594,7 +594,7 @@ ... TODO: The context shouldn't need to be re-set either. (|> (///directive.set_current_module module) (///phase.result' state) - try.assumed + try.trusted product.left) archive) (#try.Success [state more|done]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index eb325ddd0..571185dee 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -355,7 +355,7 @@ (#Tuple members) (|> members (list\map %analysis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"]))) (#Reference reference) @@ -369,7 +369,7 @@ (format " ") (format (|> environment (list\map %analysis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"]))) (text.enclosed ["(" ")"])) @@ -378,13 +378,13 @@ ..application #.Item (list\map %analysis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["(" ")"])) (#Extension name parameters) (|> parameters (list\map %analysis) - (text.join_with " ") + (text.interposed " ") (format (%.text name) " ") (text.enclosed ["(" ")"])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux index 5ae124d96..1859802d6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux @@ -46,12 +46,12 @@ (do phase.monad [exprA (type.with_type type (analyze archive exprC)) - module (extensionP.lift + module (extensionP.lifted meta.current_module_name)] - (phase.lift (do try.monad - [exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))] - (phase.result generation_state - (do phase.monad - [exprO (generate archive exprS) - module_id (generation.module_id module archive)] - (generation.evaluate! (..context [module_id count]) exprO))))))))) + (phase.lifted (do try.monad + [exprS (|> exprA (synthesisP.phase archive) (phase.result synthesis_state))] + (phase.result generation_state + (do phase.monad + [exprO (generate archive exprS) + module_id (generation.module_id module archive)] + (generation.evaluate! (..context [module_id count]) exprO))))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux index 5383d2ae4..478697fd4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux @@ -80,18 +80,18 @@ (Operation anchor expression directive output))) (|>> (phase.sub [(get@ [<component> #..state]) (set@ [<component> #..state])]) - extension.lift))] + extension.lifted))] - [lift_analysis #..analysis analysis.Operation] - [lift_synthesis #..synthesis synthesis.Operation] - [lift_generation #..generation (generation.Operation anchor expression directive)] + [lifted_analysis #..analysis analysis.Operation] + [lifted_synthesis #..synthesis synthesis.Operation] + [lifted_generation #..generation (generation.Operation anchor expression directive)] ) (def: .public (set_current_module module) (All [anchor expression directive] (-> Module (Operation anchor expression directive Any))) (do phase.monad - [_ (..lift_analysis + [_ (..lifted_analysis (analysis.set_current_module module))] - (..lift_generation + (..lifted_generation (generation.enter_module module)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index b9b230b42..c8cfe9c0e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -116,11 +116,11 @@ (case functionA (#/.Reference (#reference.Constant def_name)) (do ! - [?macro (//extension.lift (meta.macro def_name))] + [?macro (//extension.lifted (meta.macro def_name))] (case ?macro (#.Some macro) (do ! - [expansion (//extension.lift (/macro.expand_one expander def_name macro argsC+))] + [expansion (//extension.lifted (/macro.expand_one expander def_name macro argsC+))] (compile archive expansion)) _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index 2188bb54a..9463eeb8f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -102,7 +102,7 @@ (do ///.monad [[var_id varT] (//type.with_env check.var)] - (recur envs (maybe.assume (type.applied (list varT) caseT)))) + (recur envs (maybe.trusted (type.applied (list varT) caseT)))) (#.Apply inputT funcT) (.case funcT @@ -277,7 +277,7 @@ [[ex_id exT] (//type.with_env check.existential)] (analyse_pattern num_tags - (maybe.assume (type.applied (list exT) inputT')) + (maybe.trusted (type.applied (list exT) inputT')) pattern next)) @@ -287,8 +287,8 @@ (^ [location (#.Form (list& [_ (#.Tag tag)] values))]) (/.with_location location (do ///.monad - [tag (///extension.lift (meta.normal tag)) - [idx group variantT] (///extension.lift (meta.tag tag)) + [tag (///extension.lifted (meta.normal tag)) + [idx group variantT] (///extension.lifted (meta.tag tag)) _ (//type.with_env (check.check inputT variantT)) .let [[lefts right?] (/.choice (list.size group) idx)]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index 996272df7..25c85514e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -80,7 +80,7 @@ dictionary.entries (list\map (function (_ [idx coverage]) (format (%.nat idx) " " (%coverage coverage)))) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["{" "}"]) (format (%.nat (..cases ?max_cases)) " ") (text.enclosed ["(#Variant " ")"])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux index 8063f450d..69e75f374 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -40,12 +40,12 @@ list.enumeration (list\map (.function (_ [idx argC]) (format (%.nat idx) " " (%.code argC)))) - (text.join_with text.new_line))])) + (text.interposed text.new_line))])) (def: .public (function analyse function_name arg_name archive body) (-> Phase Text Text Phase) (do {! ///.monad} - [functionT (///extension.lift meta.expected_type)] + [functionT (///extension.lifted meta.expected_type)] (loop [expectedT functionT] (/.with_stack ..cannot_analyse [expectedT function_name arg_name body] (case expectedT @@ -64,7 +64,7 @@ [(<tag> _) (do ! [[_ instanceT] (//type.with_env <instancer>)] - (recur (maybe.assume (type.applied (list instanceT) expectedT))))]) + (recur (maybe.trusted (type.applied (list instanceT) expectedT))))]) ([#.UnivQ check.existential] [#.ExQ check.var]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux index af25a5856..6282980be 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -96,7 +96,7 @@ (def: new_named_type (Operation Type) (do ///.monad - [location (///extension.lift meta.location) + [location (///extension.lifted meta.location) [ex_id _] (//type.with_env check.existential)] (in (named_type location ex_id)))) @@ -123,13 +123,13 @@ (#.UnivQ _) (do ///.monad [[var_id varT] (//type.with_env check.var)] - (general archive analyse (maybe.assume (type.applied (list varT) inferT)) args)) + (general archive analyse (maybe.trusted (type.applied (list varT) inferT)) args)) (#.ExQ _) (do {! ///.monad} [[var_id varT] (//type.with_env check.var) output (general archive analyse - (maybe.assume (type.applied (list varT) inferT)) + (maybe.trusted (type.applied (list varT) inferT)) args) bound? (//type.with_env (check.bound? var_id)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux index db51c3d77..d5e2fd691 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -36,7 +36,7 @@ (template [<name>] [(exception: .public (<name> {tags (List Text)} {owner Type}) (exception.report - ["Tags" (text.join_with " " tags)] + ["Tags" (text.interposed " " tags)] ["Type" (%.type owner)]))] [cannot_declare_tags_for_unnamed_type] @@ -80,7 +80,7 @@ (def: .public (set_annotations annotations) (-> Code (Operation Any)) - (///extension.lift + (///extension.lifted (do ///.monad [self_name meta.current_module_name self meta.current_module] @@ -97,7 +97,7 @@ (def: .public (import module) (-> Text (Operation Any)) - (///extension.lift + (///extension.lifted (do ///.monad [self_name meta.current_module_name] (function (_ state) @@ -112,7 +112,7 @@ (def: .public (alias alias module) (-> Text Text (Operation Any)) - (///extension.lift + (///extension.lifted (do ///.monad [self_name meta.current_module_name] (function (_ state) @@ -124,7 +124,7 @@ (def: .public (exists? module) (-> Text (Operation Bit)) - (///extension.lift + (///extension.lifted (function (_ state) (|> state (get@ #.modules) @@ -134,7 +134,7 @@ (def: .public (define name definition) (-> Text Global (Operation Any)) - (///extension.lift + (///extension.lifted (do ///.monad [self_name meta.current_module_name self meta.current_module] @@ -155,7 +155,7 @@ (def: .public (create hash name) (-> Nat Text (Operation Any)) - (///extension.lift + (///extension.lifted (function (_ state) (#try.Success [(update@ #.modules (plist.has name (..empty hash)) @@ -168,13 +168,13 @@ [_ (create hash name) output (/.with_current_module name action) - module (///extension.lift (meta.module name))] + module (///extension.lifted (meta.module name))] (in [module output]))) (template [<setter> <asker> <tag>] [(def: .public (<setter> module_name) (-> Text (Operation Any)) - (///extension.lift + (///extension.lifted (function (_ state) (case (|> state (get@ #.modules) (plist.value module_name)) (#.Some module) @@ -194,7 +194,7 @@ (def: .public (<asker> module_name) (-> Text (Operation Bit)) - (///extension.lift + (///extension.lifted (function (_ state) (case (|> state (get@ #.modules) (plist.value module_name)) (#.Some module) @@ -214,7 +214,7 @@ (template [<name> <tag> <type>] [(def: (<name> module_name) (-> Text (Operation <type>)) - (///extension.lift + (///extension.lifted (function (_ state) (case (|> state (get@ #.modules) (plist.value module_name)) (#.Some module) @@ -246,7 +246,7 @@ (def: .public (declare_tags tags exported? type) (-> (List Tag) Bit Type (Operation Any)) (do ///.monad - [self_name (///extension.lift meta.current_module_name) + [self_name (///extension.lifted meta.current_module_name) [type_module type_name] (case type (#.Named type_name _) (in type_name) @@ -256,7 +256,7 @@ _ (ensure_undeclared_tags self_name tags) _ (///.assertion cannot_declare_tags_for_foreign_type [tags type] (text\= self_name type_module))] - (///extension.lift + (///extension.lifted (function (_ state) (case (|> state (get@ #.modules) (plist.value self_name)) (#.Some module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 92e43368e..92a7a8f9c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -33,7 +33,7 @@ (-> Name (Operation Analysis)) (with_expansions [<return> (in (|> def_name ///reference.constant #/.Reference))] (do {! ///.monad} - [constant (///extension.lift (meta.definition def_name))] + [constant (///extension.lifted (meta.definition def_name))] (case constant (#.Left real_def_name) (definition real_def_name) @@ -41,13 +41,13 @@ (#.Right [exported? actualT def_anns _]) (do ! [_ (//type.infer actualT) - (^@ def_name [::module ::name]) (///extension.lift (meta.normal def_name)) - current (///extension.lift meta.current_module_name)] + (^@ def_name [::module ::name]) (///extension.lifted (meta.normal def_name)) + current (///extension.lifted meta.current_module_name)] (if (text\= current ::module) <return> (if exported? (do ! - [imported! (///extension.lift (meta.imported_by? ::module current))] + [imported! (///extension.lifted (meta.imported_by? ::module current))] (if imported! <return> (/.except foreign_module_has_not_been_imported [current ::module]))) @@ -78,7 +78,7 @@ #.None (do ! - [this_module (///extension.lift meta.current_module_name)] + [this_module (///extension.lifted meta.current_module_name)] (definition [this_module simple_name])))) _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux index 98c36ec05..052173d1f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux @@ -78,7 +78,7 @@ (def: .public (find name) (-> Text (Operation (Maybe [Type Variable]))) - (///extension.lift + (///extension.lifted (function (_ state) (let [[inner outer] (|> state (get@ #.scopes) @@ -183,7 +183,7 @@ (def: .public next_local (Operation Register) - (///extension.lift + (///extension.lifted (function (_ state) (case (get@ #.scopes state) (#.Item top _) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 8f254c5d6..56924a102 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -95,7 +95,7 @@ (let [tag (/.tag lefts right?)] (function (recur valueC) (do {! ///.monad} - [expectedT (///extension.lift meta.expected_type) + [expectedT (///extension.lifted meta.expected_type) expectedT' (//type.with_env (check.clean expectedT))] (/.with_stack ..cannot_analyse_variant [expectedT' tag valueC] @@ -135,7 +135,7 @@ [(<tag> _) (do ! [[instance_id instanceT] (//type.with_env <instancer>)] - (//type.with_type (maybe.assume (type.applied (list instanceT) expectedT)) + (//type.with_type (maybe.trusted (type.applied (list instanceT) expectedT)) (recur valueC)))]) ([#.UnivQ check.existential] [#.ExQ check.var]) @@ -168,7 +168,7 @@ (def: (typed_product archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) (do {! ///.monad} - [expectedT (///extension.lift meta.expected_type) + [expectedT (///extension.lifted meta.expected_type) membersA+ (: (Operation (List Analysis)) (loop [membersT+ (type.flat_tuple expectedT) membersC+ members] @@ -195,7 +195,7 @@ (def: .public (product archive analyse membersC) (-> Archive Phase (List Code) (Operation Analysis)) (do {! ///.monad} - [expectedT (///extension.lift meta.expected_type)] + [expectedT (///extension.lifted meta.expected_type)] (/.with_stack ..cannot_analyse_tuple [expectedT membersC] (case expectedT (#.Product _) @@ -228,7 +228,7 @@ [(<tag> _) (do ! [[instance_id instanceT] (//type.with_env <instancer>)] - (//type.with_type (maybe.assume (type.applied (list instanceT) expectedT)) + (//type.with_type (maybe.trusted (type.applied (list instanceT) expectedT)) (product archive analyse membersC)))]) ([#.UnivQ check.existential] [#.ExQ check.var]) @@ -262,17 +262,17 @@ (def: .public (tagged_sum analyse tag archive valueC) (-> Phase Name Phase) (do {! ///.monad} - [tag (///extension.lift (meta.normal tag)) - [idx group variantT] (///extension.lift (meta.tag tag)) + [tag (///extension.lifted (meta.normal tag)) + [idx group variantT] (///extension.lifted (meta.tag tag)) .let [case_size (list.size group) [lefts right?] (/.choice case_size idx)] - expectedT (///extension.lift meta.expected_type)] + expectedT (///extension.lifted meta.expected_type)] (case expectedT (#.Var _) (do ! [inferenceT (//inference.variant idx case_size variantT) [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC))] - (in (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) + (in (/.variant [lefts right? (|> valueA+ list.head maybe.trusted)]))) _ (..sum analyse lefts right? archive valueC)))) @@ -288,7 +288,7 @@ (case key [_ (#.Tag key)] (do ///.monad - [key (///extension.lift (meta.normal key))] + [key (///extension.lifted (meta.normal key))] (in [key val])) _ @@ -307,8 +307,8 @@ (#.Item [head_k head_v] _) (do {! ///.monad} - [head_k (///extension.lift (meta.normal head_k)) - [_ tag_set recordT] (///extension.lift (meta.tag head_k)) + [head_k (///extension.lifted (meta.normal head_k)) + [_ tag_set recordT] (///extension.lifted (meta.tag head_k)) .let [size_record (list.size record) size_ts (list.size tag_set)] _ (if (n.= size_ts size_record) @@ -319,7 +319,7 @@ idx->val (monad.fold ! (function (_ [key val] idx->val) (do ! - [key (///extension.lift (meta.normal key))] + [key (///extension.lifted (meta.normal key))] (case (dictionary.value key tag->idx) (#.Some idx) (if (dictionary.key? idx->val idx) @@ -331,7 +331,8 @@ (: (Dictionary Nat Code) (dictionary.empty n.hash)) record) - .let [ordered_tuple (list\map (function (_ idx) (maybe.assume (dictionary.value idx idx->val))) + .let [ordered_tuple (list\map (function (_ idx) + (maybe.trusted (dictionary.value idx idx->val))) tuple_range)]] (in [ordered_tuple recordT])) )) @@ -349,7 +350,7 @@ (do {! ///.monad} [members (normal members) [membersC recordT] (order members) - expectedT (///extension.lift meta.expected_type)] + expectedT (///extension.lifted meta.expected_type)] (case expectedT (#.Var _) (do ! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux index 374663c95..ed980b1e6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux @@ -40,7 +40,7 @@ (def: .public (infer actualT) (-> Type (Operation Any)) (do ///.monad - [expectedT (///extension.lift meta.expected_type)] + [expectedT (///extension.lifted meta.expected_type)] (with_env (check.check expectedT actualT)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index 8bb5d475f..81fc21caa 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -47,21 +47,21 @@ (^ [_ (#.Form (list& macro inputs))]) (do {! //.monad} - [expansion (/.lift_analysis + [expansion (/.lifted_analysis (do ! [macroA (//analysis/type.with_type Macro (analyze archive macro))] (case macroA (^ (///analysis.constant macro_name)) (do ! - [?macro (//extension.lift (meta.macro macro_name)) + [?macro (//extension.lifted (meta.macro macro_name)) macro (case ?macro (#.Some macro) (in macro) #.None (//.except ..macro_was_not_found macro_name))] - (//extension.lift (///analysis/macro.expand expander macro_name macro inputs))) + (//extension.lifted (///analysis/macro.expand expander macro_name macro inputs))) _ (//.except ..invalid_macro_call code))))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux index 354f40fd2..206ae9f64 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux @@ -164,7 +164,7 @@ (function (_ [bundle state]) (#try.Success [[bundle (transform state)] []]))) -(def: .public (lift action) +(def: .public (lifted action) (All [s i o v] (-> (//.Operation s v) (//.Operation [(Bundle s i o) s] v))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 6fc53dd20..aa1730655 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -137,7 +137,7 @@ (def: (ensure_fresh_class! class_loader name) (-> java/lang/ClassLoader External (Operation Any)) (do phase.monad - [class (phase.lift (reflection!.load class_loader name))] + [class (phase.lifted (reflection!.load class_loader name))] (phase.assertion ..deprecated_class [name] (|> class java/lang/Class::getDeclaredAnnotations @@ -401,7 +401,7 @@ (|> objectJ ..signature (<text>.result jvm_parser.array) - phase.lift))) + phase.lifted))) (def: (primitive_array_length_handler primitive_type) (-> (Type Primitive) Handler) @@ -460,7 +460,7 @@ (do phase.monad [lengthA (typeA.with_type ..int (analyse archive lengthC)) - expectedT (///.lift meta.expected_type) + expectedT (///.lifted meta.expected_type) expectedJT (jvm_array_type expectedT) elementJT (case (jvm_parser.array? expectedJT) (#.Some elementJT) @@ -556,7 +556,7 @@ [jvm.char])) (text.starts_with? descriptor.array_prefix name) - (let [[_ unprefixed] (maybe.assume (text.split_by descriptor.array_prefix name))] + (let [[_ unprefixed] (maybe.trusted (text.split_by descriptor.array_prefix name))] (\ phase.monad map jvm.array (check_jvm (#.Primitive unprefixed (list))))) @@ -750,7 +750,7 @@ (case args (^ (list)) (do phase.monad - [expectedT (///.lift meta.expected_type) + [expectedT (///.lifted meta.expected_type) _ (check_object expectedT)] (in (#/////analysis.Extension extension_name (list)))) @@ -797,7 +797,7 @@ [exceptionT exceptionA] (typeA.with_inference (analyse archive exceptionC)) exception_class (check_object exceptionT) - ? (phase.lift (reflection!.sub? class_loader "java.lang.Throwable" exception_class)) + ? (phase.lifted (reflection!.sub? class_loader "java.lang.Throwable" exception_class)) _ (: (Operation Any) (if ? (in []) @@ -817,7 +817,7 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) _ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) - _ (phase.lift (reflection!.load class_loader class))] + _ (phase.lifted (reflection!.load class_loader class))] (in (#/////analysis.Extension extension_name (list (/////analysis.text class))))) _ @@ -837,7 +837,7 @@ [objectT objectA] (typeA.with_inference (analyse archive objectC)) object_class (check_object objectT) - ? (phase.lift (reflection!.sub? class_loader object_class sub_class))] + ? (phase.lifted (reflection!.sub? class_loader object_class sub_class))] (if ? (in (#/////analysis.Extension extension_name (list (/////analysis.text sub_class) objectA))) (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) @@ -862,14 +862,14 @@ (def: (class_candidate_parents class_loader source_name fromT target_name target_class) (-> java/lang/ClassLoader External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) (do {! phase.monad} - [source_class (phase.lift (reflection!.load class_loader source_name)) - mapping (phase.lift (reflection!.correspond source_class fromT))] + [source_class (phase.lifted (reflection!.load class_loader source_name)) + mapping (phase.lifted (reflection!.correspond source_class fromT))] (monad.map ! (function (_ superJT) (do ! - [superJT (phase.lift (reflection!.type superJT)) + [superJT (phase.lifted (reflection!.type superJT)) .let [super_name (|> superJT ..reflection)] - super_class (phase.lift (reflection!.load class_loader super_name)) + super_class (phase.lifted (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)]))) (case (java/lang/Class::getGenericSuperclass source_class) @@ -890,7 +890,7 @@ (function (_ superT) (do {! phase.monad} [super_name (\ ! map ..reflection (check_jvm superT)) - super_class (phase.lift (reflection!.load class_loader super_name))] + super_class (phase.lifted (reflection!.load class_loader super_name))] (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)]))) (list& super_classT super_interfacesT+)) @@ -904,7 +904,7 @@ (case args (^ (list fromC)) (do {! phase.monad} - [toT (///.lift meta.expected_type) + [toT (///.lifted meta.expected_type) target_name (\ ! map ..reflection (check_jvm toT)) [fromT fromA] (typeA.with_inference (analyse archive fromC)) @@ -934,11 +934,11 @@ (not (dictionary.key? ..boxes source_name))) _ (phase.assertion ..primitives_are_not_objects [target_name] (not (dictionary.key? ..boxes target_name))) - target_class (phase.lift (reflection!.load class_loader target_name)) + target_class (phase.lifted (reflection!.load class_loader target_name)) _ (if (text\= ..inheritance_relationship_type_name source_name) (in []) (do ! - [source_class (phase.lift (reflection!.load class_loader source_name))] + [source_class (phase.lifted (reflection!.load class_loader source_name))] (phase.assertion ..cannot_cast [fromT toT fromC] (java/lang/Class::isAssignableFrom source_class target_class))))] (loop [[current_name currentT] [source_name fromT]] @@ -986,7 +986,7 @@ (function (_ extension_name analyse archive [class field]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) - [final? deprecated? fieldJT] (phase.lift + [final? deprecated? fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class)] (reflection!.static_field field class))) @@ -1007,7 +1007,7 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) _ (typeA.infer Any) - [final? deprecated? fieldJT] (phase.lift + [final? deprecated? fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class)] (reflection!.static_field field class))) @@ -1032,7 +1032,7 @@ [_ (..ensure_fresh_class! class_loader class) [objectT objectA] (typeA.with_inference (analyse archive objectC)) - [deprecated? mapping fieldJT] (phase.lift + [deprecated? mapping fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class) [final? deprecated? fieldJT] (reflection!.virtual_field field class) @@ -1058,7 +1058,7 @@ [objectT objectA] (typeA.with_inference (analyse archive objectC)) _ (typeA.infer objectT) - [final? deprecated? mapping fieldJT] (phase.lift + [final? deprecated? mapping fieldJT] (phase.lifted (do try.monad [class (reflection!.load class_loader class) [final? deprecated? fieldJT] (reflection!.virtual_field field class) @@ -1091,7 +1091,7 @@ [parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.list (monad.map try.monad reflection!.type) - phase.lift) + phase.lifted) .let [modifiers (java/lang/reflect/Method::getModifiers method) correct_class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method)) correct_method? (text\= method_name (java/lang/reflect/Method::getName method)) @@ -1137,7 +1137,7 @@ [parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) array.list (monad.map try.monad reflection!.type) - phase.lift)] + phase.lifted)] (in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) (n.= (list.size inputsJT) (list.size parameters)) (list\fold (function (_ [expectedJC actualJC] prev) @@ -1191,18 +1191,18 @@ (do {! phase.monad} [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.list - (monad.map ! (|>> reflection!.type phase.lift)) + (monad.map ! (|>> reflection!.type phase.lifted)) (phase\map (monad.map ! (..reflection_type mapping))) phase\join) outputT (|> method java/lang/reflect/Method::getGenericReturnType reflection!.return - phase.lift + phase.lifted (phase\map (..reflection_return mapping)) phase\join) exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method) array.list - (monad.map ! (|>> reflection!.type phase.lift)) + (monad.map ! (|>> reflection!.type phase.lifted)) (phase\map (monad.map ! (..reflection_type mapping))) phase\join) .let [methodT (<| (type.univ_q (dictionary.size mapping)) @@ -1231,12 +1231,12 @@ (do {! phase.monad} [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) array.list - (monad.map ! (|>> reflection!.type phase.lift)) + (monad.map ! (|>> reflection!.type phase.lifted)) (phase\map (monad.map ! (reflection_type mapping))) phase\join) exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor) array.list - (monad.map ! (|>> reflection!.type phase.lift)) + (monad.map ! (|>> reflection!.type phase.lifted)) (phase\map (monad.map ! (reflection_type mapping))) phase\join) .let [objectT (#.Primitive (java/lang/Class::getName owner) owner_tvarsT) @@ -1285,7 +1285,7 @@ (def: (method_candidate class_loader actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) (-> java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) Text Method_Style (List (Type Value)) (Operation Method_Signature)) (do {! phase.monad} - [class (phase.lift (reflection!.load class_loader class_name)) + [class (phase.lifted (reflection!.load class_loader class_name)) .let [expected_class_tvars (class_type_variables class)] candidates (|> class java/lang/Class::getDeclaredMethods @@ -1318,7 +1318,7 @@ (def: (constructor_candidate class_loader actual_class_tvars class_name actual_method_tvars inputsJT) (-> java/lang/ClassLoader (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method_Signature)) (do {! phase.monad} - [class (phase.lift (reflection!.load class_loader class_name)) + [class (phase.lifted (reflection!.load class_loader class_name)) .let [expected_class_tvars (class_type_variables class)] candidates (|> class java/lang/Class::getConstructors @@ -1436,7 +1436,7 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class_name) .let [argsT (list\map product.left argsTC)] - class (phase.lift (reflection!.load class_loader class_name)) + class (phase.lifted (reflection!.load class_loader class_name)) _ (phase.assertion non_interface class_name (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class))) [methodT deprecated? exceptionsT] (..method_candidate class_loader class_tvars class_name method_tvars method #Interface argsT) @@ -1914,14 +1914,14 @@ [parent_parameters (|> parent_parameters (monad.map maybe.monad jvm_parser.var?) try.of_maybe - phase.lift)] + phase.lifted)] (|> super_parameters (monad.map ! (..reflection_type mapping)) (\ ! map (|>> (list.zipped/2 parent_parameters))))) - (phase.lift (exception.except ..mismatched_super_parameters [parent_name expected_count actual_count])))) + (phase.lifted (exception.except ..mismatched_super_parameters [parent_name expected_count actual_count])))) #.None - (phase.lift (exception.except ..unknown_super [parent_name supers]))))) + (phase.lifted (exception.except ..unknown_super [parent_name supers]))))) (def: .public (with_fresh_type_vars vars mapping) (-> (List (Type Var)) Mapping (Operation Mapping)) @@ -2060,7 +2060,7 @@ (-> java/lang/ClassLoader (Type Class) (Operation Aliasing)) (do phase.monad [.let [[name actual_parameters] (jvm_parser.read_class class)] - class (phase.lift (reflection!.load class_loader name)) + class (phase.lifted (reflection!.load class_loader name)) .let [expected_parameters (|> (java/lang/Class::getTypeParameters class) array.list (list\map (|>> java/lang/reflect/TypeVariable::getName)))] @@ -2086,8 +2086,8 @@ (def: .public (require_complete_method_concretion class_loader supers methods) (-> java/lang/ClassLoader (List (Type Class)) (List (Overriden_Method Code)) (Operation Any)) (do {! phase.monad} - [required_abstract_methods (phase.lift (all_abstract_methods class_loader supers)) - available_methods (phase.lift (all_methods class_loader supers)) + [required_abstract_methods (phase.lifted (all_abstract_methods class_loader supers)) + available_methods (phase.lifted (all_methods class_loader supers)) overriden_methods (monad.map ! (function (_ [parent_type method_name strict_fp? annotations type_vars self_name arguments return exceptions @@ -2139,12 +2139,12 @@ (monad.map check.monad (|>> ..signature (luxT.check (luxT.class mapping))) super_interfaces)) - selfT (///.lift (do meta.monad - [where meta.current_module_name - id meta.seed] - (in (inheritance_relationship_type (#.Primitive (..anonymous_class_name where id) (list)) - super_classT - super_interfaceT+)))) + selfT (///.lifted (do meta.monad + [where meta.current_module_name + id meta.seed] + (in (inheritance_relationship_type (#.Primitive (..anonymous_class_name where id) (list)) + super_classT + super_interfaceT+)))) _ (typeA.infer selfT) constructor_argsA+ (monad.map ! (function (_ [type term]) (do ! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 979af197a..d26820e9a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -90,7 +90,7 @@ (do <>.monad [raw <code>.text] (case (text.size raw) - 1 (in (|> raw (text.char 0) maybe.assume)) + 1 (in (|> raw (text.char 0) maybe.trusted)) _ (<>.failure (exception.error ..char_text_must_be_size_1 [raw]))))) (def: lux::syntax_char_case! @@ -104,7 +104,7 @@ (do {! ////.monad} [input (typeA.with_type text.Char (phase archive input)) - expectedT (///.lift meta.expected_type) + expectedT (///.lifted meta.expected_type) conditionals (monad.map ! (function (_ [cases branch]) (do ! [branch (typeA.with_type expectedT @@ -164,7 +164,7 @@ (case args (^ (list typeC valueC)) (do {! ////.monad} - [seed (///.lift meta.seed) + [seed (///.lifted meta.seed) actualT (\ ! map (|>> (:as Type)) (eval archive seed Type typeC)) _ (typeA.infer actualT)] @@ -180,7 +180,7 @@ (case args (^ (list typeC valueC)) (do {! ////.monad} - [seed (///.lift meta.seed) + [seed (///.lifted meta.seed) actualT (\ ! map (|>> (:as Type)) (eval archive seed Type typeC)) _ (typeA.infer actualT) @@ -210,7 +210,7 @@ [_ (typeA.infer .Macro) input_type (loop [input_name (name_of .Macro')] (do ! - [input_type (///.lift (meta.definition (name_of .Macro')))] + [input_type (///.lifted (meta.definition (name_of .Macro')))] (case input_type (#.Definition [exported? def_type def_data def_value]) (in (:as Type def_value)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 04e197099..61f4e3763 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -223,7 +223,7 @@ (function (_ methodC) (do phase.monad [methodA (: (Operation analysis.Analysis) - (directive.lift_analysis + (directive.lifted_analysis (case methodC (#Constructor method) (jvm.analyse_constructor_method analyse selfT mapping method) @@ -236,7 +236,7 @@ (#Overriden_Method method) (jvm.analyse_overriden_method analyse selfT mapping method))))] - (directive.lift_synthesis + (directive.lifted_synthesis (synthesize methodA))))) (def: jvm::class @@ -260,17 +260,17 @@ fields methods]) (do {! phase.monad} - [parameters (directive.lift_analysis + [parameters (directive.lifted_analysis (typeA.with_env (jvm.parameter_types parameters))) .let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) (dictionary.has (parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] - super_classT (directive.lift_analysis + super_classT (directive.lifted_analysis (typeA.with_env (luxT.check (luxT.class mapping) (..signature super_class)))) - super_interfaceT+ (directive.lift_analysis + super_interfaceT+ (directive.lifted_analysis (typeA.with_env (monad.map check.monad (|>> ..signature (luxT.check (luxT.class mapping))) @@ -278,13 +278,13 @@ .let [selfT (jvm.inheritance_relationship_type (#.Primitive name (list\map product.right parameters)) super_classT super_interfaceT+)] - state (extension.lift phase.get_state) + state (extension.lifted phase.get_state) .let [analyse (get@ [#directive.analysis #directive.phase] state) synthesize (get@ [#directive.synthesis #directive.phase] state) generate (get@ [#directive.generation #directive.phase] state)] methods (monad.map ! (..method_definition [mapping selfT] [analyse synthesize generate]) methods) - ... _ (directive.lift_generation + ... _ (directive.lifted_generation ... (generation.save! true ["" name] ... [name ... (class.class version.v6_0 @@ -294,7 +294,7 @@ ... (list\map ..field_definition fields) ... (list) ... TODO: Add methods ... (row.row))])) - _ (directive.lift_generation + _ (directive.lifted_generation (generation.log! (format "Class " name)))] (in directive.no_requirements)))])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 04df2b765..604292cdd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -73,7 +73,7 @@ Type Synthesis (Operation anchor expression directive [Type expression Any]))) - (/////directive.lift_generation + (/////directive.lifted_generation (do phase.monad [module /////generation.module id /////generation.next @@ -86,16 +86,16 @@ (All [anchor expression directive] (-> Archive Type Code (Operation anchor expression directive [Type expression Any]))) (do phase.monad - [state (///.lift phase.get_state) + [state (///.lifted phase.get_state) .let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - [_ codeA] (/////directive.lift_analysis + [_ codeA] (/////directive.lifted_analysis (/////analysis.with_scope (typeA.with_fresh_env (typeA.with_type type (analyse archive codeC))))) - codeS (/////directive.lift_synthesis + codeS (/////directive.lifted_synthesis (synthesize archive codeA))] (evaluate!' archive generate type codeS))) @@ -108,11 +108,11 @@ Type Synthesis (Operation anchor expression directive [Type expression Any]))) - (/////directive.lift_generation + (/////directive.lifted_generation (do phase.monad [codeG (generate archive codeS) id (/////generation.learn name) - module_id (phase.lift (archive.id module archive)) + module_id (phase.lifted (archive.id module archive)) [target_name value directive] (/////generation.define! [module_id id] #.None codeG) _ (/////generation.save! id #.None directive)] (in [code//type codeG value])))) @@ -122,11 +122,11 @@ (-> Archive Name (Maybe Type) Code (Operation anchor expression directive [Type expression Any]))) (do {! phase.monad} - [state (///.lift phase.get_state) + [state (///.lifted phase.get_state) .let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - [_ code//type codeA] (/////directive.lift_analysis + [_ code//type codeA] (/////directive.lifted_analysis (/////analysis.with_scope (typeA.with_fresh_env (case expected @@ -143,7 +143,7 @@ [codeA (typeA.with_type expected (analyse archive codeC))] (in [expected codeA])))))) - codeS (/////directive.lift_synthesis + codeS (/////directive.lifted_synthesis (synthesize archive codeA))] (definition' archive generate name code//type codeS))) @@ -158,12 +158,12 @@ Synthesis (Operation anchor expression directive [expression Any]))) (do phase.monad - [current_module (/////directive.lift_analysis - (///.lift meta.current_module_name))] - (/////directive.lift_generation + [current_module (/////directive.lifted_analysis + (///.lifted meta.current_module_name))] + (/////directive.lifted_generation (do phase.monad [codeG (generate archive codeS) - module_id (phase.lift (archive.id current_module archive)) + module_id (phase.lifted (archive.id current_module archive)) id (<learn> extension) [target_name value directive] (/////generation.define! [module_id id] #.None codeG) _ (/////generation.save! id #.None directive)] @@ -174,16 +174,16 @@ (-> Archive Text Type Code (Operation anchor expression directive [expression Any]))) (do phase.monad - [state (///.lift phase.get_state) + [state (///.lifted phase.get_state) .let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] - [_ codeA] (/////directive.lift_analysis + [_ codeA] (/////directive.lifted_analysis (/////analysis.with_scope (typeA.with_fresh_env (typeA.with_type codeT (analyse archive codeC))))) - codeS (/////directive.lift_synthesis + codeS (/////directive.lifted_synthesis (synthesize archive codeA))] (<partial> archive generate extension codeT codeS)))] @@ -212,7 +212,7 @@ (def: (announce_definition! short type) (All [anchor expression directive] (-> Text Type (Operation anchor expression directive Any))) - (/////directive.lift_generation + (/////directive.lifted_generation (/////generation.log! (format short " : " (%.type type))))) (def: (lux::def expander host_analysis) @@ -221,13 +221,13 @@ (case inputsC+ (^ (list [_ (#.Identifier ["" short_name])] valueC annotationsC exported?C)) (do phase.monad - [current_module (/////directive.lift_analysis - (///.lift meta.current_module_name)) + [current_module (/////directive.lifted_analysis + (///.lifted meta.current_module_name)) .let [full_name [current_module short_name]] [type valueT value] (..definition archive full_name #.None valueC) [_ _ exported?] (evaluate! archive Bit exported?C) [_ _ annotations] (evaluate! archive Code annotationsC) - _ (/////directive.lift_analysis + _ (/////directive.lifted_analysis (module.define short_name (#.Right [(:as Bit exported?) type (:as Code annotations) value]))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type)] @@ -242,15 +242,15 @@ [($_ <>.and <code>.local_identifier <code>.any <code>.any (<code>.tuple (<>.some <code>.text)) <code>.any) (function (_ extension_name phase archive [short_name valueC annotationsC tags exported?C]) (do phase.monad - [current_module (/////directive.lift_analysis - (///.lift meta.current_module_name)) + [current_module (/////directive.lifted_analysis + (///.lifted meta.current_module_name)) .let [full_name [current_module short_name]] [_ _ exported?] (evaluate! archive Bit exported?C) [_ _ annotations] (evaluate! archive Code annotationsC) .let [exported? (:as Bit exported?) annotations (:as Code annotations)] [type valueT value] (..definition archive full_name (#.Some .Type) valueC) - _ (/////directive.lift_analysis + _ (/////directive.lifted_analysis (do phase.monad [_ (module.define short_name (#.Right [exported? type annotations value]))] (module.declare_tags tags exported? (:as Type value)))) @@ -272,7 +272,7 @@ (do {! phase.monad} [[_ _ annotationsV] (evaluate! archive Code annotationsC) .let [annotationsV (:as Code annotationsV)] - _ (/////directive.lift_analysis + _ (/////directive.lifted_analysis (do ! [_ (monad.map ! (function (_ [module alias]) (do ! @@ -294,8 +294,8 @@ (def: (define_alias alias original) (-> Text Name (/////analysis.Operation Any)) (do phase.monad - [current_module (///.lift meta.current_module_name) - constant (///.lift (meta.definition original))] + [current_module (///.lifted meta.current_module_name) + constant (///.lifted (meta.definition original))] (case constant (#.Left de_aliased) (phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased]) @@ -309,7 +309,7 @@ [($_ <>.and <code>.local_identifier <code>.identifier) (function (_ extension_name phase archive [alias def_name]) (do phase.monad - [_ (///.lift + [_ (///.lifted (phase.sub [(get@ [#/////directive.analysis #/////directive.state]) (set@ [#/////directive.analysis #/////directive.state])] (define_alias alias def_name)))] @@ -336,7 +336,7 @@ <type> (:expected handlerV))) - _ (/////directive.lift_generation + _ (/////directive.lifted_generation (/////generation.log! (format <description> " " (%.text (:as Text name)))))] (in /////directive.no_requirements)) @@ -346,17 +346,17 @@ ["Analysis" def::analysis /////analysis.Handler /////analysis.Handler - /////directive.lift_analysis + /////directive.lifted_analysis ..analyser] ["Synthesis" def::synthesis /////synthesis.Handler /////synthesis.Handler - /////directive.lift_synthesis + /////directive.lifted_synthesis ..synthesizer] ["Generation" def::generation (/////generation.Handler anchorT expressionT directiveT) (/////generation.Handler anchor expression directive) - /////directive.lift_generation + /////directive.lifted_generation ..generator] ["Directive" def::directive @@ -376,12 +376,12 @@ Code (Operation anchor expression directive Synthesis))) (do phase.monad - [[_ programA] (/////directive.lift_analysis + [[_ programA] (/////directive.lifted_analysis (/////analysis.with_scope (typeA.with_fresh_env (typeA.with_type (type (-> (List Text) (IO Any))) (analyse archive programC)))))] - (/////directive.lift_synthesis + (/////directive.lifted_synthesis (synthesize archive programA)))) (def: (define_program archive module_id generate program programS) @@ -404,15 +404,15 @@ (case inputsC+ (^ (list programC)) (do phase.monad - [state (///.lift phase.get_state) + [state (///.lifted phase.get_state) .let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) generate (get@ [#/////directive.generation #/////directive.phase] state)] programS (prepare_program archive analyse synthesize programC) - current_module (/////directive.lift_analysis - (///.lift meta.current_module_name)) - module_id (phase.lift (archive.id current_module archive)) - _ (/////directive.lift_generation + current_module (/////directive.lifted_analysis + (///.lifted meta.current_module_name)) + module_id (phase.lifted (archive.id current_module archive)) + _ (/////directive.lifted_generation (define_program archive module_id generate program programS))] (in /////directive.no_requirements)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 770e1cce0..a8caf13bf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -67,13 +67,13 @@ (def: lux_int (Bytecode Any) - ($_ _.compose + ($_ _.composite _.i2l (///value.wrap type.long))) (def: jvm_int (Bytecode Any) - ($_ _.compose + ($_ _.composite (///value.unwrap type.long) _.l2i)) @@ -87,7 +87,7 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite (bytecode @then) (_.getstatic $Boolean "FALSE" $Boolean) (_.goto @end) @@ -116,9 +116,9 @@ [branchG (phase archive branch) @branch ///runtime.forge_label] (in [(list\map (function (_ char) - [(try.assumed (signed.s4 (.int char))) @branch]) + [(try.trusted (signed.s4 (.int char))) @branch]) chars) - ($_ _.compose + ($_ _.composite (_.set_label @branch) branchG (_.goto @end))]))) @@ -131,7 +131,7 @@ (monad.seq _.monad))]] (in (do _.monad [@else _.new_label] - ($_ _.compose + ($_ _.composite inputG (///value.unwrap type.long) _.l2i (_.lookupswitch @else table) conditionalsG @@ -142,14 +142,14 @@ (def: (lux::is [referenceG sampleG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite referenceG sampleG (..predicate _.if_acmpeq))) (def: (lux::try riskyG) (Unary (Bytecode Any)) - ($_ _.compose + ($_ _.composite riskyG (_.checkcast ///function.class) ///runtime.try)) @@ -164,7 +164,7 @@ (template [<name> <op>] [(def: (<name> [maskG inputG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite inputG (///value.unwrap type.long) maskG (///value.unwrap type.long) <op> (///value.wrap type.long)))] @@ -177,7 +177,7 @@ (template [<name> <op>] [(def: (<name> [shiftG inputG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite inputG (///value.unwrap type.long) shiftG ..jvm_int <op> (///value.wrap type.long)))] @@ -189,7 +189,7 @@ (template [<name> <type> <op>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite subjectG (///value.unwrap <type>) paramG (///value.unwrap <type>) <op> (///value.wrap <type>)))] @@ -211,7 +211,7 @@ [(template [<name> <reference>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite subjectG (///value.unwrap <type>) paramG (///value.unwrap <type>) <cmp> @@ -232,27 +232,27 @@ (template [<name> <prepare> <transform>] [(def: (<name> inputG) (Unary (Bytecode Any)) - ($_ _.compose + ($_ _.composite inputG <prepare> <transform>))] [i64::f64 (///value.unwrap type.long) - ($_ _.compose + ($_ _.composite _.l2d (///value.wrap type.double))] [i64::char (///value.unwrap type.long) - ($_ _.compose + ($_ _.composite _.l2i _.i2c (..::toString ..$Character type.char))] [f64::i64 (///value.unwrap type.double) - ($_ _.compose + ($_ _.composite _.d2l (///value.wrap type.long))] @@ -301,7 +301,7 @@ (def: (text::size inputG) (Unary (Bytecode Any)) - ($_ _.compose + ($_ _.composite inputG ..ensure_string (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)])) @@ -312,7 +312,7 @@ (template [<name> <pre_subject> <pre_param> <op> <post>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite subjectG <pre_subject> paramG <pre_param> <op> <post>))] @@ -330,14 +330,14 @@ (def: (text::concat [leftG rightG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite leftG ..ensure_string rightG ..ensure_string (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)])))) (def: (text::clip [startG endG subjectG]) (Trinary (Bytecode Any)) - ($_ _.compose + ($_ _.composite subjectG ..ensure_string startG ..jvm_int endG ..jvm_int @@ -349,7 +349,7 @@ (do _.monad [@not_found _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite textG ..ensure_string partG ..ensure_string startG ..jvm_int @@ -380,7 +380,7 @@ (def: string_method (type.method [(list ..$String) type.void (list)])) (def: (io::log messageG) (Unary (Bytecode Any)) - ($_ _.compose + ($_ _.composite (_.getstatic ..$System "out" ..$PrintStream) messageG ..ensure_string @@ -389,7 +389,7 @@ (def: (io::error messageG) (Unary (Bytecode Any)) - ($_ _.compose + ($_ _.composite (_.new ..$Error) _.dup messageG diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index a79807c28..a749fb6cd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -72,7 +72,7 @@ (template [<name> <0> <1>] [(def: <name> (Bytecode Any) - ($_ _.compose + ($_ _.composite <0> <1>))] @@ -86,7 +86,7 @@ (Unary (Bytecode Any)) (if (same? _.nop <conversion>) inputG - ($_ _.compose + ($_ _.composite inputG <conversion>)))] @@ -149,7 +149,7 @@ (template [<name> <op>] [(def: (<name> [xG yG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite xG yG <op>))] @@ -201,7 +201,7 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite xG yG (<op> @then) @@ -224,7 +224,7 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite xG yG <op> @@ -357,7 +357,7 @@ (function (_ extension_name generate archive arrayS) (do //////.monad [arrayG (generate archive arrayS)] - (in ($_ _.compose + (in ($_ _.composite arrayG (_.checkcast (type.array jvm_primitive)) _.arraylength))))])) @@ -369,7 +369,7 @@ (function (_ extension_name generate archive [elementJT arrayS]) (do //////.monad [arrayG (generate archive arrayS)] - (in ($_ _.compose + (in ($_ _.composite arrayG (_.checkcast (type.array elementJT)) _.arraylength))))])) @@ -381,7 +381,7 @@ (function (_ extension_name generate archive [lengthS]) (do //////.monad [lengthG (generate archive lengthS)] - (in ($_ _.compose + (in ($_ _.composite lengthG (_.newarray jvm_primitive)))))])) @@ -392,7 +392,7 @@ (function (_ extension_name generate archive [objectJT lengthS]) (do //////.monad [lengthG (generate archive lengthS)] - (in ($_ _.compose + (in ($_ _.composite lengthG (_.anewarray objectJT)))))])) @@ -404,7 +404,7 @@ (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] - (in ($_ _.compose + (in ($_ _.composite arrayG (_.checkcast (type.array jvm_primitive)) idxG @@ -418,7 +418,7 @@ (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] - (in ($_ _.compose + (in ($_ _.composite arrayG (_.checkcast (type.array elementJT)) idxG @@ -433,7 +433,7 @@ [arrayG (generate archive arrayS) idxG (generate archive idxS) valueG (generate archive valueS)] - (in ($_ _.compose + (in ($_ _.composite arrayG (_.checkcast (type.array jvm_primitive)) _.dup @@ -450,7 +450,7 @@ [arrayG (generate archive arrayS) idxG (generate archive idxS) valueG (generate archive valueS)] - (in ($_ _.compose + (in ($_ _.composite arrayG (_.checkcast (type.array elementJT)) _.dup @@ -517,7 +517,7 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite objectG (_.ifnull @then) ..falseG @@ -528,7 +528,7 @@ (def: (object::synchronized [monitorG exprG]) (Binary (Bytecode Any)) - ($_ _.compose + ($_ _.composite monitorG _.dup _.monitorenter @@ -538,7 +538,7 @@ (def: (object::throw exceptionG) (Unary (Bytecode Any)) - ($_ _.compose + ($_ _.composite exceptionG _.athrow)) @@ -552,7 +552,7 @@ (function (_ extension_name generate archive [class]) (do //////.monad [] - (in ($_ _.compose + (in ($_ _.composite (_.string class) (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))])) @@ -563,7 +563,7 @@ (function (_ extension_name generate archive [class objectS]) (do //////.monad [objectG (generate archive objectS)] - (in ($_ _.compose + (in ($_ _.composite objectG (_.instanceof (type.class class (list))) (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))])) @@ -586,7 +586,7 @@ (text\= <object> to)) (let [$<object> (type.class <object> (list))] - ($_ _.compose + ($_ _.composite valueG (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)])))) @@ -595,7 +595,7 @@ (text\= (..reflection <type>) to)) (let [$<object> (type.class <object> (list))] - ($_ _.compose + ($_ _.composite valueG (_.checkcast $<object>) (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))] @@ -662,13 +662,13 @@ .let [$class (type.class class (list))]] (case (dictionary.value unboxed ..primitives) (#.Some primitive) - (in ($_ _.compose + (in ($_ _.composite valueG (_.putstatic $class field primitive) ..unitG)) #.None - (in ($_ _.compose + (in ($_ _.composite valueG (_.checkcast $class) (_.putstatic $class field $class) @@ -688,7 +688,7 @@ #.None (_.getfield $class field (type.class unboxed (list))))]] - (in ($_ _.compose + (in ($_ _.composite objectG (_.checkcast $class) getG))))])) @@ -708,10 +708,10 @@ #.None (let [$unboxed (type.class unboxed (list))] - ($_ _.compose + ($_ _.composite (_.checkcast $unboxed) (_.putfield $class field $unboxed))))]] - (in ($_ _.compose + (in ($_ _.composite objectG (_.checkcast $class) _.dup @@ -733,7 +733,7 @@ (in [valueT valueG]) (#.Left valueT) - (in [valueT ($_ _.compose + (in [valueT ($_ _.composite valueG (_.checkcast valueT))])))) @@ -753,7 +753,7 @@ (function (_ extension_name generate archive [class method outputT inputsTS]) (do {! //////.monad} [inputsTG (monad.map ! (generate_input generate archive) inputsTS)] - (in ($_ _.compose + (in ($_ _.composite (monad.map _.monad product.right inputsTG) (_.invokestatic class method (type.method [(list\map product.left inputsTG) outputT (list)])) (prepare_output outputT)))))])) @@ -767,7 +767,7 @@ (do {! //////.monad} [objectG (generate archive objectS) inputsTG (monad.map ! (generate_input generate archive) inputsTS)] - (in ($_ _.compose + (in ($_ _.composite objectG (_.checkcast class) (monad.map _.monad product.right inputsTG) @@ -786,7 +786,7 @@ (function (_ extension_name generate archive [class inputsTS]) (do {! //////.monad} [inputsTG (monad.map ! (generate_input generate archive) inputsTS)] - (in ($_ _.compose + (in ($_ _.composite (_.new class) _.dup (monad.map _.monad product.right inputsTG) @@ -946,13 +946,13 @@ list.size list.indices (monad.map _.monad (.function (_ register) - ($_ _.compose + ($_ _.composite (_.aload 0) (_.aload (inc register)) (_.putfield class (///reference.foreign_name register) $Object)))))] (method.method method.public "<init>" (anonymous_init_method env) (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite (_.aload 0) (monad.map _.monad product.right inputsTG) (_.invokespecial super_class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)])) @@ -963,7 +963,7 @@ (-> Phase Archive (Type category.Class) (Environment Synthesis) (Operation (Bytecode Any))) (do {! //////.monad} [captureG+ (monad.map ! (generate archive) env)] - (in ($_ _.compose + (in ($_ _.composite (_.new class) _.dup (monad.seq _.monad captureG+) @@ -978,7 +978,7 @@ (#.Left returnT) (case (type.primitive? returnT) (#.Left returnT) - ($_ _.compose + ($_ _.composite (_.checkcast returnT) _.areturn) @@ -1040,7 +1040,7 @@ [(#//////variable.Foreign foreign_id) (|> global_mapping (dictionary.value capture) - maybe.assume)])) + maybe.trusted)])) (dictionary.from_list //////variable.hash))] [ownerT name strict_fp? annotations vars @@ -1066,12 +1066,12 @@ returnT exceptionsT]) (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite bodyG (returnG returnT))))))) normalized_methods) bytecode (<| (\ ! map (format.result class.writer)) - //////.lift + //////.lifted (class.class version.v6_0 ($_ modifier\compose class.public class.final) (name.internal anonymous_class_name) (name.internal (..reflection super_class)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index d7a20b360..aebb30404 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -42,7 +42,7 @@ 1 _.pop 2 _.pop2 _ ... (n.> 2) - ($_ _.compose + ($_ _.composite _.pop2 (pop_alt (n.- 2 stack_depth))))) @@ -60,19 +60,19 @@ (def: peek (Bytecode Any) - ($_ _.compose + ($_ _.composite _.dup (//runtime.get //runtime.stack_head))) (def: pop (Bytecode Any) - ($_ _.compose + ($_ _.composite (//runtime.get //runtime.stack_tail) (_.checkcast //type.stack))) (def: (left_projection lefts) (-> Nat (Bytecode Any)) - ($_ _.compose + ($_ _.composite (_.checkcast //type.tuple) (..int lefts) (.case lefts @@ -84,7 +84,7 @@ (def: (right_projection lefts) (-> Nat (Bytecode Any)) - ($_ _.compose + ($_ _.composite (_.checkcast //type.tuple) (..int lefts) //runtime.right_projection)) @@ -96,14 +96,14 @@ (operation\in ..pop) (#synthesis.Bind register) - (operation\in ($_ _.compose + (operation\in ($_ _.composite ..peek (_.astore register))) (#synthesis.Then bodyS) (do phase.monad [bodyG (phase archive bodyS)] - (in ($_ _.compose + (in ($_ _.composite (..pop_alt stack_depth) bodyG (_.goto @end)))) @@ -114,7 +114,7 @@ (do _.monad [@success _.new_label @fail _.new_label] - ($_ _.compose + ($_ _.composite ..peek (_.checkcast //type.variant) (//structure.tag lefts <right?>) @@ -133,7 +133,7 @@ (^template [<pattern> <projection>] [(^ (<pattern> lefts)) - (operation\in ($_ _.compose + (operation\in ($_ _.composite ..peek (<projection> lefts) //runtime.push))]) @@ -146,7 +146,7 @@ (synthesis.!bind_top register thenP))) (do phase.monad [thenG (path' stack_depth @else @end phase archive thenP)] - (in ($_ _.compose + (in ($_ _.composite ..peek (_.checkcast //type.tuple) _.iconst_0 @@ -161,7 +161,7 @@ (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] - (in ($_ _.compose + (in ($_ _.composite ..peek (_.checkcast //type.tuple) (..int lefts) @@ -176,7 +176,7 @@ [@alt_else //runtime.forge_label left! (path' (inc stack_depth) @alt_else @end phase archive leftP) right! (path' stack_depth @else @end phase archive rightP)] - (in ($_ _.compose + (in ($_ _.composite _.dup left! (_.set_label @alt_else) @@ -187,7 +187,7 @@ (do phase.monad [left! (path' stack_depth @else @end phase archive leftP) right! (path' stack_depth @else @end phase archive rightP)] - (in ($_ _.compose + (in ($_ _.composite left! right!))) @@ -200,7 +200,7 @@ (do phase.monad [@else //runtime.forge_label pathG (..path' 1 @else @end phase archive path)] - (in ($_ _.compose + (in ($_ _.composite pathG (_.set_label @else) _.pop @@ -217,7 +217,7 @@ (in (do _.monad [@else _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite conditionG (//value.unwrap type.boolean) (_.ifeq @else) @@ -232,7 +232,7 @@ (do phase.monad [inputG (phase archive inputS) bodyG (phase archive bodyS)] - (in ($_ _.compose + (in ($_ _.composite inputG (_.astore register) bodyG)))) @@ -248,7 +248,7 @@ (#.Right lefts) (..right_projection lefts))] - (_.compose so_far next))) + (_.composite so_far next))) recordG (list.reversed path))))) @@ -258,7 +258,7 @@ [@end //runtime.forge_label valueG (phase archive valueS) pathG (..path @end phase archive path)] - (in ($_ _.compose + (in ($_ _.composite _.aconst_null valueG //runtime.push diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 095c973b4..f3938db06 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -104,13 +104,13 @@ (generate archive bodyS))) .let [function_class (//runtime.class_name function_context)] [fields methods instance] (..with generate archive @begin function_class environment arity bodyG) - class (phase.lift (class.class version.v6_0 - ..modifier - (name.internal function_class) - (..internal /abstract.class) (list) - fields - methods - (row.row))) + class (phase.lifted (class.class version.v6_0 + ..modifier + (name.internal function_class) + (..internal /abstract.class) (list) + fields + methods + (row.row))) .let [bytecode (format.result class.writer class)] _ (generation.execute! [function_class bytecode]) _ (generation.save! function_class #.None [function_class bytecode])] @@ -121,13 +121,13 @@ (do {! phase.monad} [abstractionG (generate archive abstractionS) inputsG (monad.map ! (generate archive) inputsS)] - (in ($_ _.compose + (in ($_ _.composite abstractionG (|> inputsG (list.sub /arity.maximum) (monad.map _.monad (function (_ batchG) - ($_ _.compose + ($_ _.composite (_.checkcast /abstract.class) (monad.seq _.monad batchG) (_.invokevirtual /abstract.class //runtime.apply::name (//runtime.apply::type (list.size batchG))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux index 328921a19..ba69187b8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux @@ -25,14 +25,14 @@ (def: .public (get class name) (-> (Type Class) Text (Bytecode Any)) - ($_ _.compose + ($_ _.composite ////reference.this (_.getfield class name ..type) )) (def: .public (put naming class register value) (-> (-> Register Text) (Type Class) Register (Bytecode Any) (Bytecode Any)) - ($_ _.compose + ($_ _.composite ////reference.this value (_.putfield class (naming register) ..type))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux index 0b4208bec..57d285e8a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux @@ -32,7 +32,7 @@ (def: .public (initial amount) (-> Nat (Bytecode Any)) - ($_ _.compose + ($_ _.composite (|> _.aconst_null (list.repeated amount) (monad.seq _.monad)) @@ -53,7 +53,7 @@ (def: .public (new arity) (-> Arity (Bytecode Any)) (if (arity.multiary? arity) - ($_ _.compose + ($_ _.composite /count.initial (initial (n.- ///arity.minimum arity))) (_\in []))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux index 4bc179078..30f27def6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux @@ -18,14 +18,17 @@ (def: .public initial (Bytecode Any) - (|> +0 signed.s1 try.assumed _.bipush)) + (|> +0 + signed.s1 + try.trusted + _.bipush)) (def: this _.aload_0) (def: .public value (Bytecode Any) - ($_ _.compose + ($_ _.composite ..this (_.getfield /////abstract.class ..field ..type) )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index f90f1999b..da3292be8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -49,13 +49,13 @@ (def: (increment by) (-> Nat (Bytecode Any)) - ($_ _.compose + ($_ _.composite (<| _.int .i64 by) _.iadd)) (def: (inputs offset amount) (-> Register Nat (Bytecode Any)) - ($_ _.compose + ($_ _.composite (|> amount list.indices (monad.map _.monad (|>> (n.+ offset) _.aload))) @@ -65,7 +65,7 @@ (def: (apply offset amount) (-> Register Nat (Bytecode Any)) (let [arity (n.min amount ///arity.maximum)] - ($_ _.compose + ($_ _.composite (_.checkcast ///abstract.class) (..inputs offset arity) (_.invokevirtual ///abstract.class ////runtime.apply::name (////runtime.apply::type arity)) @@ -86,7 +86,7 @@ (////runtime.apply::type apply_arity) (list) (#.Some (case num_partials - 0 ($_ _.compose + 0 ($_ _.composite ////reference.this (..inputs ..this_offset apply_arity) (_.invokevirtual class //implementation.name (//implementation.type function_arity)) @@ -107,10 +107,10 @@ already_partial? (n.> 0 stage) exact_match? (i.= over_extent (.int stage)) has_more_than_necessary? (i.> over_extent (.int stage))] - ($_ _.compose + ($_ _.composite (_.set_label @case) (cond exact_match? - ($_ _.compose + ($_ _.composite ////reference.this (if already_partial? (_.invokevirtual class //reset.name (//reset.type class)) @@ -123,7 +123,7 @@ has_more_than_necessary? (let [arity_inputs (|> function_arity (n.- stage)) additional_inputs (|> apply_arity (n.- arity_inputs))] - ($_ _.compose + ($_ _.composite ////reference.this (_.invokevirtual class //reset.name (//reset.type class)) current_partials @@ -139,7 +139,7 @@ missing_partials (|> _.aconst_null (list.repeated (|> num_partials (n.- apply_arity) (n.- stage))) (monad.seq _.monad))] - ($_ _.compose + ($_ _.composite (_.new class) _.dup current_environment @@ -151,7 +151,7 @@ (_.invokevirtual class //init.name (//init.type environment function_arity)) _.areturn))))))) (monad.seq _.monad))]] - ($_ _.compose + ($_ _.composite ///partial/count.value - (_.tableswitch (try.assumed (signed.s4 +0)) @default [@labelsH @labelsT]) + (_.tableswitch (try.trusted (signed.s4 +0)) @default [@labelsH @labelsT]) cases))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux index a43a4c0bc..a6bd0ef6b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux @@ -31,7 +31,7 @@ (method.method //.modifier name (..type arity) (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite (_.set_label @begin) body _.areturn diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux index ac11c1cf3..cd92f4aca 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux @@ -56,12 +56,16 @@ type.void (list)])) -(def: no_partials (|> 0 unsigned.u1 try.assumed _.bipush)) +(def: no_partials + (|> 0 + unsigned.u1 + try.trusted + _.bipush)) (def: .public (super environment_size arity) (-> Nat Arity (Bytecode Any)) (let [arity_register (inc environment_size)] - ($_ _.compose + ($_ _.composite (if (arity.unary? arity) ..no_partials (_.iload arity_register)) @@ -90,7 +94,7 @@ (method.method //.modifier ..name (..type environment arity) (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite ////reference.this (..super environment_size arity) (store_all environment_size (///foreign.put class) offset_foreign) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux index 45ea0b010..d153b35e9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux @@ -44,7 +44,7 @@ (def: .public (instance' foreign_setup class environment arity) (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) - ($_ _.compose + ($_ _.composite (_.new class) _.dup (monad.seq _.monad foreign_setup) @@ -69,7 +69,7 @@ (method.method //.modifier //init.name (//init.type environment arity) (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite ////reference.this (//init.super environment_size arity) (monad.map _.monad (function (_ register) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux index 615cc0388..d787bf16e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux @@ -43,7 +43,7 @@ (method.method //.modifier ..name (..type class) (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite (if (arity.multiary? arity) (//new.instance' (..current_environment class environment) class environment arity) ////reference.this) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index 4db70e828..4915e010a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -108,7 +108,7 @@ (list (method.method ..init::modifier "<clinit>" ..init::type (list) (#.Some - ($_ _.compose + ($_ _.composite valueG (_.putstatic (type.class bytecode_name (list)) ..value::field ..value::type) _.return)))) @@ -128,7 +128,7 @@ [existing_class? (|> (atom.read! library) (\ io.monad map (function (_ library) (dictionary.key? library class_name))) - (try.lift io.monad) + (try.lifted io.monad) (: (IO (Try Bit)))) _ (if existing_class? (in []) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index 3e009b116..6757bc987 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -53,7 +53,7 @@ [fetchG (translate archive updateS) .let [storeG (_.astore register)]] (in [fetchG storeG]))))))] - (in ($_ _.compose + (in ($_ _.composite ... It may look weird that first I fetch all the values separately, ... and then I store them all. ... It must be done that way in order to avoid a potential bug. @@ -80,11 +80,11 @@ (translate archive iterationS)) .let [initializationG (|> (list.enumeration initsI+) (list\map (function (_ [index initG]) - ($_ _.compose + ($_ _.composite initG (_.astore (n.+ offset index))))) (monad.seq _.monad))]] - (in ($_ _.compose + (in ($_ _.composite initializationG (_.set_label @begin) iterationG)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux index f7ba0eb93..419c4eac9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux @@ -58,19 +58,19 @@ (def: amount_of_inputs (Bytecode Any) - ($_ _.compose + ($_ _.composite _.aload_0 _.arraylength)) (def: decrease (Bytecode Any) - ($_ _.compose + ($_ _.composite _.iconst_1 _.isub)) (def: head (Bytecode Any) - ($_ _.compose + ($_ _.composite _.dup _.aload_0 _.swap @@ -81,7 +81,7 @@ (def: pair (Bytecode Any) - ($_ _.compose + ($_ _.composite _.iconst_2 (_.anewarray ^Object) _.dup_x1 @@ -102,7 +102,7 @@ (do _.monad [@loop _.new_label @end _.new_label] - ($_ _.compose + ($_ _.composite ..nil ..amount_of_inputs (_.set_label @loop) @@ -122,7 +122,7 @@ (def: run_io (Bytecode Any) - ($_ _.compose + ($_ _.composite (_.checkcast //function/abstract.class) _.aconst_null //runtime.apply)) @@ -132,7 +132,7 @@ (let [super_class (|> ..^Object type.reflection reflection.reflection name.internal) main (method.method ..main::modifier "main" ..main::type (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite program ..input_list ..feed_inputs @@ -140,7 +140,7 @@ _.return)))] [..class (<| (format.result class.writer) - try.assumed + try.trusted (class.class version.v6_0 ..program::modifier (name.internal ..class) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux index d983068b9..3dafea811 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux @@ -44,7 +44,7 @@ (do {! ////.monad} [bytecode_name (\ ! map //runtime.class_name (generation.context archive))] - (in ($_ _.compose + (in ($_ _.composite ..this (_.getfield (type.class bytecode_name (list)) (..foreign_name variable) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 8fcd70360..f11c871c1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -113,13 +113,13 @@ (def: .public (get index) (-> (Bytecode Any) (Bytecode Any)) - ($_ _.compose + ($_ _.composite index _.aaload)) (def: (set! index value) (-> (Bytecode Any) (Bytecode Any) (Bytecode Any)) - ($_ _.compose + ($_ _.composite ... A _.dup ... AA index ... AAI @@ -138,10 +138,10 @@ (def: variant_value _.iconst_2) (def: variant::method - (let [new_variant ($_ _.compose + (let [new_variant ($_ _.composite _.iconst_3 (_.anewarray //type.value)) - $tag ($_ _.compose + $tag ($_ _.composite _.iload_0 (//value.wrap type.int)) $last? _.aload_1 @@ -149,7 +149,7 @@ (method.method ..modifier ..variant::name ..variant::type (list) - (#.Some ($_ _.compose + (#.Some ($_ _.composite new_variant ... A[3] (..set! ..variant_tag $tag) ... A[3] (..set! ..variant_last? $last?) ... A[3] @@ -161,7 +161,7 @@ (def: .public left_injection (Bytecode Any) - ($_ _.compose + ($_ _.composite _.iconst_0 ..left_flag _.dup2_x1 @@ -170,7 +170,7 @@ (def: .public right_injection (Bytecode Any) - ($_ _.compose + ($_ _.composite _.iconst_1 ..right_flag _.dup2_x1 @@ -181,7 +181,7 @@ (def: .public none_injection (Bytecode Any) - ($_ _.compose + ($_ _.composite _.iconst_0 ..left_flag ..unit @@ -192,7 +192,7 @@ (do _.monad [@try _.new_label @handler _.new_label] - ($_ _.compose + ($_ _.composite (_.try @try @handler @handler //type.error) (_.set_label @try) $unsafe @@ -213,7 +213,7 @@ (list) (#.Some (..risky - ($_ _.compose + ($_ _.composite _.aload_0 (_.invokestatic //type.frac "parseDouble" (type.method [(list) (list //type.text) type.double (list)])) (//value.wrap type.double) @@ -226,7 +226,7 @@ out (_.getstatic ^System "out" ^PrintStream) print_type (type.method [(list) (list //type.value) type.void (list)]) print! (function (_ method) (_.invokevirtual ^PrintStream method print_type))] - ($_ _.compose + ($_ _.composite out (_.string "LUX LOG: ") (print! "print") out _.swap (print! "println")))) @@ -234,7 +234,7 @@ (def: (illegal_state_exception message) (-> Text (Bytecode Any)) (let [^IllegalStateException (type.class "java.lang.IllegalStateException" (list))] - ($_ _.compose + ($_ _.composite (_.new ^IllegalStateException) _.dup (_.string message) @@ -249,7 +249,7 @@ ..failure::type (list) (#.Some - ($_ _.compose + ($_ _.composite (..illegal_state_exception message) _.athrow)))) @@ -271,12 +271,12 @@ ..push::type (list) (#.Some - (let [new_stack_frame! ($_ _.compose + (let [new_stack_frame! ($_ _.composite _.iconst_2 (_.anewarray //type.value)) $head _.aload_1 $tail _.aload_0] - ($_ _.compose + ($_ _.composite new_stack_frame! (..set! ..stack_head $head) (..set! ..stack_tail $tail) @@ -296,7 +296,7 @@ @tags_match! _.new_label @maybe_nested _.new_label @mismatch! _.new_label - .let [::tag ($_ _.compose + .let [::tag ($_ _.composite (..get ..variant_tag) (//value.unwrap type.int)) ::last? (..get ..variant_last?) @@ -309,29 +309,29 @@ not_found _.aconst_null update_$tag _.isub - update_$variant ($_ _.compose + update_$variant ($_ _.composite $variant ::value (_.checkcast //type.variant) _.astore_0) recur (: (-> Label (Bytecode Any)) (function (_ @loop_start) - ($_ _.compose + ($_ _.composite ... tag, sumT update_$variant ... tag, sumT update_$tag ... sub_tag (_.goto @loop_start)))) - super_nested_tag ($_ _.compose + super_nested_tag ($_ _.composite ... tag, sumT _.swap ... sumT, tag _.isub) - super_nested ($_ _.compose + super_nested ($_ _.composite ... tag, sumT super_nested_tag ... super_tag $variant ::last? ... super_tag, super_last $variant ::value ... super_tag, super_last, super_value ..variant)]] - ($_ _.compose + ($_ _.composite $tag (_.set_label @loop) $variant ::tag @@ -369,23 +369,23 @@ (def: projection::method2 [(Resource Method) (Resource Method)] (let [$tuple _.aload_0 - $tuple::size ($_ _.compose + $tuple::size ($_ _.composite $tuple _.arraylength) $lefts _.iload_1 - $last_right ($_ _.compose + $last_right ($_ _.composite $tuple::size _.iconst_1 _.isub) - update_$lefts ($_ _.compose + update_$lefts ($_ _.composite $lefts $last_right _.isub _.istore_1) - update_$tuple ($_ _.compose + update_$tuple ($_ _.composite $tuple $last_right _.aaload (_.checkcast //type.tuple) _.astore_0) recur (: (-> Label (Bytecode Any)) (function (_ @loop) - ($_ _.compose + ($_ _.composite update_$lefts update_$tuple (_.goto @loop)))) @@ -397,9 +397,9 @@ (do _.monad [@loop _.new_label @recursive _.new_label - .let [::left ($_ _.compose + .let [::left ($_ _.composite $lefts _.aaload)]] - ($_ _.compose + ($_ _.composite (_.set_label @loop) $lefts $last_right (_.if_icmpge @recursive) $tuple ::left @@ -416,19 +416,19 @@ [@loop _.new_label @not_tail _.new_label @slice _.new_label - .let [$right ($_ _.compose + .let [$right ($_ _.composite $lefts _.iconst_1 _.iadd) - $::nested ($_ _.compose + $::nested ($_ _.composite $tuple _.swap _.aaload) - super_nested ($_ _.compose + super_nested ($_ _.composite $tuple $right $tuple::size (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" (type.method [(list) (list //type.tuple //type.index //type.index) //type.tuple (list)])))]] - ($_ _.compose + ($_ _.composite (_.set_label @loop) $last_right $right _.dup2 (_.if_icmpne @not_tail) @@ -472,13 +472,13 @@ unit _.aconst_null ^StringWriter (type.class "java.io.StringWriter" (list)) - string_writer ($_ _.compose + string_writer ($_ _.composite (_.new ^StringWriter) _.dup (_.invokespecial ^StringWriter "<init>" (type.method [(list) (list) type.void (list)]))) ^PrintWriter (type.class "java.io.PrintWriter" (list)) - print_writer ($_ _.compose + print_writer ($_ _.composite ... WTW (_.new ^PrintWriter) ... WTWP _.dup_x1 ... WTPWP @@ -487,7 +487,7 @@ (_.invokespecial ^PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) ... WTP )]] - ($_ _.compose + ($_ _.composite (_.try @try @handler @handler //type.error) (_.set_label @try) $unsafe unit ..apply @@ -516,7 +516,7 @@ class.public class.final)) bytecode (<| (format.result class.writer) - try.assumed + try.trusted (class.class jvm/version.v6_0 modifier (name.internal class) @@ -551,7 +551,7 @@ (let [previous_inputs (|> arity list.indices (monad.map _.monad _.aload))] - ($_ _.compose + ($_ _.composite previous_inputs (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity))) (_.checkcast //function.class) @@ -566,7 +566,7 @@ (list) (#.Some (let [$partials _.iload_1] - ($_ _.compose + ($_ _.composite ..this (_.invokespecial ^Object "<init>" (type.method [(list) (list) type.void (list)])) ..this @@ -584,7 +584,7 @@ //function/count.type (row.row))) bytecode (<| (format.result class.writer) - try.assumed + try.trusted (class.class jvm/version.v6_0 modifier (name.internal class) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux index fa7627b97..2eff33115 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux @@ -44,6 +44,6 @@ (def: .public (unwrap type) (-> (Type Primitive) (Bytecode Any)) (let [wrapper (type.class (primitive_wrapper type) (list))] - ($_ _.compose + ($_ _.composite (_.checkcast wrapper) (_.invokevirtual wrapper (primitive_unwrap type) (type.method [(list) (list) type (list)]))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux index 2b9202239..c234f9902 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -100,4 +100,4 @@ Phase (do phase.monad [synthesis (..optimization archive analysis)] - (phase.lift (/variable.optimization synthesis)))) + (phase.lifted (/variable.optimization synthesis)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 78dc5dce1..feadf7fa5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -241,7 +241,7 @@ dictionary.entries (list\map (function (_ [register redundant?]) (%.format (%.nat register) ": " (%.bit redundant?)))) - (text.join_with ", "))) + (text.interposed ", "))) (def: (path_optimization optimization) (-> (Optimization Synthesis) (Optimization Path)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index 806fdc3c9..58dc336dd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -279,7 +279,7 @@ (|> (#.Item item) (list\map (function (_ [test then]) (format (<format> test) " " (%path' %then then)))) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["(? " ")"]))]) ([#I64_Fork (|>> .int %.int)] [#F64_Fork %.frac] @@ -341,7 +341,7 @@ (#analysis.Tuple members) (|> members (list\map %synthesis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"]))) (#Reference reference) @@ -354,7 +354,7 @@ (#Abstraction [environment arity body]) (let [environment' (|> environment (list\map %synthesis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"]))] (|> (format environment' " " (%.nat arity) " " (%synthesis body)) (text.enclosed ["(#function " ")"]))) @@ -362,7 +362,7 @@ (#Apply func args) (|> args (list\map %synthesis) - (text.join_with " ") + (text.interposed " ") (format (%synthesis func) " ") (text.enclosed ["(" ")"]))) @@ -392,7 +392,7 @@ (|> (format (%.nat (get@ #start scope)) " " (|> (get@ #inits scope) (list\map %synthesis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"])) " " (%synthesis (get@ #iteration scope))) (text.enclosed ["(#loop " ")"])) @@ -400,12 +400,12 @@ (#Recur args) (|> args (list\map %synthesis) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["(#recur " ")"])))) (#Extension [name args]) (|> (list\map %synthesis args) - (text.join_with " ") + (text.interposed " ") (format (%.text name) " ") (text.enclosed ["(" ")"])))) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index d1cecbe50..92680654d 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -70,13 +70,13 @@ (def: .public failure (-> Text Operation) - (|>> #try.Failure (state.lift try.monad))) + (|>> #try.Failure (state.lifted try.monad))) (def: .public (except exception parameters) (All [e] (-> (Exception e) e Operation)) (..failure (ex.error exception parameters))) -(def: .public (lift error) +(def: .public (lifted error) (All [s a] (-> (Try a) (Operation s a))) (function (_ state) (try\map (|>> [state]) error))) @@ -93,7 +93,7 @@ (function (_ archive input state) (#try.Success [state input]))) -(def: .public (compose pre post) +(def: .public (composite pre post) (All [s0 s1 i t o] (-> (Phase s0 i t) (Phase s1 t o) diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index 14f53e927..6e28d5c1a 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -60,7 +60,7 @@ (def: enter_module (All [anchor expression directive] (Operation anchor expression directive Any)) - (directive.lift_analysis + (directive.lifted_analysis (do phase.monad [_ (module.create 0 ..module)] (analysis.set_current_module ..module)))) @@ -101,11 +101,11 @@ (All [anchor expression directive] (-> Code <Interpretation>)) (do {! phase.monad} - [state (extension.lift phase.get_state) + [state (extension.lifted phase.get_state) .let [analyse (get@ [#directive.analysis #directive.phase] state) synthesize (get@ [#directive.synthesis #directive.phase] state) generate (get@ [#directive.generation #directive.phase] state)] - [_ codeT codeA] (directive.lift_analysis + [_ codeT codeA] (directive.lifted_analysis (analysis.with_scope (type.with_fresh_env (do ! @@ -114,9 +114,9 @@ codeT (type.with_env (check.clean codeT))] (in [codeT codeA]))))) - codeS (directive.lift_synthesis + codeS (directive.lifted_synthesis (synthesize codeA))] - (directive.lift_generation + (directive.lifted_generation (generation.with_buffer (do ! [codeH (generate codeS) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index 97cdf5a3d..c6be00945 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -1,7 +1,7 @@ (.module: {#.doc "Basic functionality for working with types."} [library - [lux (#- function) + [lux (#- function :as) ["@" target] [abstract [equivalence (#+ Equivalence)] @@ -132,7 +132,7 @@ (^template [<tag> <desc>] [(<tag> env body) - ($_ text\compose "(" <desc> " {" (|> env (list\map format) (text.join_with " ")) "} " (format body) ")")]) + ($_ text\compose "(" <desc> " {" (|> env (list\map format) (text.interposed " ")) "} " (format body) ")")]) ([#.UnivQ "All"] [#.ExQ "Ex"]) @@ -174,7 +174,7 @@ ($_ text\compose (n\encode index) " " (..format type)))) - (text.join_with (text\compose text.new_line " "))))) + (text.interposed (text\compose text.new_line " "))))) (list.item idx env)) _ @@ -441,18 +441,18 @@ (Parser (List Text)) (<code>.tuple (<>.some <code>.local_identifier))) -(syntax: .public (:cast [type_vars type_parameters - input <code>.any - output <code>.any - value (<>.maybe <code>.any)]) +(syntax: .public (:as [type_vars type_parameters + input <code>.any + output <code>.any + value (<>.maybe <code>.any)]) {#.doc (example "Casts a value to a specific type." "The specified type can depend on type variables of the original type of the value." (: (Bar Bit Nat Text) - (:cast [a b c] - (Foo a [b c]) - (Bar a b c) - (: (Foo Bit [Nat Text]) - (foo expression)))) + (:as [a b c] + (Foo a [b c]) + (Bar a b c) + (: (Foo Bit [Nat Text]) + (foo expression)))) "NOTE: Careless use of type-casts is an easy way to introduce bugs. USE WITH CAUTION.")} (let [casterC (` (: (All [(~+ (list\map code.local_identifier type_vars))] (-> (~ input) (~ output))) @@ -478,13 +478,13 @@ computation ..typed]) {#.doc (example "Allows specifing the type of an expression as sharing type-variables with the type of another expression." (: (Bar Bit Nat Text) - (:cast [a b c] - (Foo a [b c]) - (: (Foo Bit [Nat Text]) - (foo expression)) - - (Bar a b c) - (bar expression))))} + (:sharing [a b c] + (Foo a [b c]) + (: (Foo Bit [Nat Text]) + (foo expression)) + + (Bar a b c) + (bar expression))))} (macro.with_identifiers [g!_] (let [shareC (` (: (All [(~+ (list\map code.local_identifier type_vars))] (-> (~ (get@ #type exemplar)) diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux index 362167393..25c864755 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -1,7 +1,6 @@ (.module: [library [lux #* - [type (#+ :cast)] ["." meta] [abstract [monad (#+ Monad do)]] @@ -17,7 +16,8 @@ [macro ["." code] [syntax (#+ syntax:) - ["|.|" annotations]]]]]) + ["|.|" annotations]]]]] + ["." //]) (type: Stack List) @@ -185,7 +185,7 @@ value))))} (do meta.monad [[name type_vars abstraction representation] (peek! frame)] - (in (list (` ((~! :cast) [(~+ type_vars)] (~ <from>) (~ <to>) + (in (list (` ((~! //.:as) [(~+ type_vars)] (~ <from>) (~ <to>) (~ value)))))))] [:abstraction representation abstraction] diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 6d5195708..99cafdcda 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -170,7 +170,7 @@ [[id var] check.var] (|> func (type.applied (list var)) - maybe.assume + maybe.trusted (on_argument arg))) (#.Function input output) @@ -187,7 +187,7 @@ (#.UnivQ _) (do check.monad [[id var] check.var - [ids final_output] (concrete_type (maybe.assume (type.applied (list var) type)))] + [ids final_output] (concrete_type (maybe.trusted (type.applied (list var) type)))] (in [(#.Item id ids) final_output])) @@ -359,7 +359,7 @@ (meta.failure (format "Too many implementations available: " (|> chosen_ones (list\map (|>> product.left %.name)) - (text.join_with ", ")) + (text.interposed ", ")) " --- for type: " (%.type sig_type))))) (#.Right [args _]) diff --git a/stdlib/source/library/lux/macro/poly.lux b/stdlib/source/library/lux/type/poly.lux index a4aa6ba23..edd21a88c 100644 --- a/stdlib/source/library/lux/macro/poly.lux +++ b/stdlib/source/library/lux/type/poly.lux @@ -85,13 +85,13 @@ (#.Parameter idx) (let [idx (<type>.adjusted_idx env idx)] (if (n.= 0 idx) - (|> (dictionary.value idx env) maybe.assume product.left (code env)) + (|> (dictionary.value idx env) maybe.trusted product.left (code env)) (` (.$ (~ (code.nat (dec idx))))))) (#.Apply (#.Named [(~~ (static .prelude_module)) "Nothing"] _) (#.Parameter idx)) (let [idx (<type>.adjusted_idx env idx)] (if (n.= 0 idx) - (|> (dictionary.value idx env) maybe.assume product.left (code env)) + (|> (dictionary.value idx env) maybe.trusted product.left (code env)) (undefined))) (^template [<tag>] diff --git a/stdlib/source/library/lux/type/refinement.lux b/stdlib/source/library/lux/type/refinement.lux index c171f3b3e..4e1a88c09 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -40,7 +40,7 @@ [predicate (Predicate t) #predicate] ) - (def: .public (lift transform) + (def: .public (lifted transform) {#.doc (example "Yields a function that can work on refined values." "Respects the constraints of the refinement.")} (All [t %] diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 8a815c47b..5ee949bd3 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -174,7 +174,7 @@ (in (row.add input to)))) (: (Row Code) row.empty) swaps) - maybe.assume + maybe.trusted row.list) g!inputsT+ (list\map (|>> (~) (..Key ..Commutative) (`)) g!inputs) g!outputsT+ (list\map (|>> (~) (..Key ..Commutative) (`)) g!outputs)]] diff --git a/stdlib/source/library/lux/world/db/sql.lux b/stdlib/source/library/lux/world/db/sql.lux index ce9842b8d..a3b7aff6a 100644 --- a/stdlib/source/library/lux/world/db/sql.lux +++ b/stdlib/source/library/lux/world/db/sql.lux @@ -109,7 +109,7 @@ (def: listing (-> (List (SQL Any)) Text) (|>> (list\map (|>> :representation)) - (text.join_with ", "))) + (text.interposed ", "))) ... Value (def: .public ? Placeholder (:abstraction "?")) @@ -219,7 +219,7 @@ (if (text\= ..no_alias alias) (:representation column) (format (:representation column) " AS " alias)))) - (text.join_with ", "))) + (text.interposed ", "))) " FROM " (:representation source))))] @@ -298,7 +298,7 @@ (|> pairs (list\map (.function (_ [value order]) (format (:representation value) " " (:representation order)))) - (text.join_with ", ")))))) + (text.interposed ", ")))))) (def: .public (group_by pairs query) (All [where having order limit offset] @@ -324,7 +324,7 @@ " VALUES " (|> rows (list\map (|>> ..listing ..parenthesize)) - (text.join_with ", ")) + (text.interposed ", ")) ))) (def: .public (update table pairs) @@ -338,7 +338,7 @@ (format " SET " (|> pairs (list\map (.function (_ [column value]) (format (:representation column) "=" (:representation value)))) - (text.join_with ", "))))))) + (text.interposed ", "))))))) (def: .public delete (-> Table (Command No_Where No_Having)) diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index 5c8d162c6..6d9e94b8e 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -31,7 +31,7 @@ (def: (merge inputs) (-> (List Binary) Binary) - (let [[_ output] (try.assumed + (let [[_ output] (try.trusted (monad.fold try.monad (function (_ input [offset output]) (let [amount (binary.size input)] diff --git a/stdlib/source/library/lux/world/net/http/route.lux b/stdlib/source/library/lux/world/net/http/route.lux index d9519a95d..a650f53d2 100644 --- a/stdlib/source/library/lux/world/net/http/route.lux +++ b/stdlib/source/library/lux/world/net/http/route.lux @@ -58,7 +58,7 @@ (server [identification protocol (update@ #//.uri - (|>> (text.clip' (text.size path)) maybe.assume) + (|>> (text.clip' (text.size path)) maybe.trusted) resource) message]) (async.resolved //response.not_found)))) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index d5195e39f..05f9cd8a6 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -319,7 +319,7 @@ (#.Some process/env) (|> (Object::entries [process/env]) array.list - (list\map (|>> (array.read! 0) maybe.assume))) + (list\map (|>> (array.read! 0) maybe.trusted))) #.None (list)) |