From eff4c59794868b89d60fdc411f9b544a270b817e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 2 Aug 2021 20:26:21 -0400 Subject: Fixed a bug in the new compiler which allowed the same module to be imported more than once. --- stdlib/source/library/lux.lux | 249 ++++++++++----------- .../source/library/lux/control/concurrency/frp.lux | 4 +- .../library/lux/control/concurrency/thread.lux | 2 +- stdlib/source/library/lux/control/exception.lux | 12 +- .../library/lux/control/function/contract.lux | 4 +- .../source/library/lux/control/parser/analysis.lux | 4 +- .../source/library/lux/control/parser/binary.lux | 2 +- stdlib/source/library/lux/control/parser/json.lux | 18 +- .../library/lux/control/parser/synthesis.lux | 6 +- stdlib/source/library/lux/control/parser/text.lux | 14 +- stdlib/source/library/lux/control/parser/type.lux | 26 +-- stdlib/source/library/lux/control/parser/xml.lux | 4 +- stdlib/source/library/lux/control/region.lux | 2 +- stdlib/source/library/lux/control/remember.lux | 2 +- .../source/library/lux/data/collection/array.lux | 10 +- .../lux/data/collection/dictionary/ordered.lux | 30 +-- stdlib/source/library/lux/data/collection/list.lux | 12 +- stdlib/source/library/lux/data/collection/row.lux | 4 +- .../library/lux/data/collection/sequence.lux | 8 +- stdlib/source/library/lux/data/format/json.lux | 4 +- stdlib/source/library/lux/data/format/tar.lux | 12 +- stdlib/source/library/lux/data/text.lux | 6 +- stdlib/source/library/lux/data/text/escape.lux | 6 +- stdlib/source/library/lux/data/text/regex.lux | 6 +- stdlib/source/library/lux/ffi.jvm.lux | 10 +- stdlib/source/library/lux/macro.lux | 2 +- stdlib/source/library/lux/macro/local.lux | 2 +- .../source/library/lux/macro/syntax/definition.lux | 3 +- stdlib/source/library/lux/macro/syntax/export.lux | 1 + stdlib/source/library/lux/macro/syntax/input.lux | 1 + .../source/library/lux/math/logic/continuous.lux | 16 +- stdlib/source/library/lux/math/logic/fuzzy.lux | 3 + stdlib/source/library/lux/math/modular.lux | 2 +- stdlib/source/library/lux/math/number/complex.lux | 7 +- stdlib/source/library/lux/math/number/i16.lux | 1 + stdlib/source/library/lux/math/number/i32.lux | 4 +- stdlib/source/library/lux/math/number/i64.lux | 31 ++- stdlib/source/library/lux/math/number/i8.lux | 1 + stdlib/source/library/lux/meta.lux | 10 +- stdlib/source/library/lux/target/jvm/bytecode.lux | 2 +- .../library/lux/target/jvm/constant/pool.lux | 2 +- stdlib/source/library/lux/target/jvm/loader.lux | 4 +- stdlib/source/library/lux/target/php.lux | 4 +- stdlib/source/library/lux/target/r.lux | 4 +- stdlib/source/library/lux/test.lux | 6 +- .../library/lux/tool/compiler/default/init.lux | 10 +- .../library/lux/tool/compiler/default/platform.lux | 111 +++++---- .../lux/tool/compiler/language/lux/analysis.lux | 4 +- .../tool/compiler/language/lux/analysis/macro.lux | 10 +- .../lux/tool/compiler/language/lux/generation.lux | 2 +- .../compiler/language/lux/phase/analysis/case.lux | 4 +- .../language/lux/phase/analysis/case/coverage.lux | 26 ++- .../language/lux/phase/analysis/function.lux | 2 +- .../language/lux/phase/analysis/inference.lux | 4 +- .../language/lux/phase/analysis/module.lux | 4 +- .../language/lux/phase/analysis/structure.lux | 6 +- .../tool/compiler/language/lux/phase/extension.lux | 4 +- .../language/lux/phase/extension/analysis/jvm.lux | 14 +- .../language/lux/phase/extension/analysis/lux.lux | 12 +- .../lux/phase/extension/generation/jvm/host.lux | 2 +- .../lux/phase/extension/generation/lua/host.lux | 2 +- .../lux/phase/extension/generation/php/host.lux | 2 +- .../lux/phase/extension/generation/python/host.lux | 2 +- .../lux/phase/extension/generation/ruby/host.lux | 2 +- .../lux/phase/generation/common_lisp/runtime.lux | 4 +- .../language/lux/phase/generation/js/runtime.lux | 2 +- .../language/lux/phase/generation/lua/case.lux | 4 +- .../language/lux/phase/generation/lua/function.lux | 2 +- .../language/lux/phase/generation/lua/runtime.lux | 18 +- .../language/lux/phase/generation/php/case.lux | 8 +- .../lux/phase/generation/php/extension/common.lux | 2 +- .../language/lux/phase/generation/php/function.lux | 2 +- .../language/lux/phase/generation/php/loop.lux | 2 +- .../language/lux/phase/generation/php/runtime.lux | 30 +-- .../language/lux/phase/generation/python/case.lux | 4 +- .../lux/phase/generation/python/function.lux | 2 +- .../language/lux/phase/generation/python/loop.lux | 2 +- .../lux/phase/generation/python/runtime.lux | 16 +- .../language/lux/phase/generation/r/case.lux | 10 +- .../language/lux/phase/generation/r/function.lux | 2 +- .../language/lux/phase/generation/r/runtime.lux | 38 ++-- .../language/lux/phase/generation/ruby/case.lux | 4 +- .../lux/phase/generation/ruby/function.lux | 2 +- .../language/lux/phase/generation/ruby/loop.lux | 2 +- .../language/lux/phase/generation/ruby/runtime.lux | 18 +- .../lux/phase/generation/scheme/runtime.lux | 4 +- .../language/lux/phase/synthesis/function.lux | 4 +- .../compiler/language/lux/phase/synthesis/loop.lux | 2 +- .../lux/tool/compiler/language/lux/program.lux | 2 +- .../lux/tool/compiler/language/lux/syntax.lux | 6 +- .../library/lux/tool/compiler/meta/archive.lux | 2 +- .../lux/tool/compiler/meta/archive/artifact.lux | 2 +- .../library/lux/tool/compiler/meta/io/context.lux | 8 +- stdlib/source/library/lux/tool/compiler/phase.lux | 2 +- stdlib/source/library/lux/tool/interpreter.lux | 2 +- stdlib/source/library/lux/type.lux | 2 +- stdlib/source/library/lux/type/check.lux | 2 +- stdlib/source/library/lux/type/implicit.lux | 4 +- stdlib/source/library/lux/type/resource.lux | 6 +- stdlib/source/library/lux/world/db/sql.lux | 16 +- 100 files changed, 538 insertions(+), 486 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 5b7f56b2a..c342863e7 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1476,7 +1476,7 @@ ys} xs)) -(def:''' (_$_joiner op a1 a2) +(def:''' (right_associativity op a1 a2) #End (-> Code Code Code Code) ({[_ (#Form parts)] @@ -1486,7 +1486,7 @@ (form$ (list op a1 a2))} op)) -(def:''' (function/flip func) +(def:''' (function\flip func) #End (All [a b c] (-> (-> a b c) (-> b a c))) @@ -1505,7 +1505,7 @@ #End) ({(#Item op tokens') ({(#Item first nexts) - (return (list (list\fold (function/flip (_$_joiner op)) first nexts))) + (return (list (list\fold (function\flip (right_associativity op)) first nexts))) _ (failure "Wrong syntax for _$")} @@ -1527,7 +1527,7 @@ #End) ({(#Item op tokens') ({(#Item last prevs) - (return (list (list\fold (_$_joiner op) last prevs))) + (return (list (list\fold (right_associativity op) last prevs))) _ (failure "Wrong syntax for $_")} @@ -1734,7 +1734,7 @@ #None} def_meta))) -(def:''' (resolve_global_identifier full_name state) +(def:''' (global_identifier full_name state) #End (-> Name ($' Meta Name)) (let' [[module name] full_name @@ -1850,7 +1850,7 @@ [real_name ({"" (if (text\= "" subst) (in [module name]) - (resolve_global_identifier [subst name])) + (global_identifier [subst name])) _ (in [module name])} @@ -2069,7 +2069,7 @@ #None} x)) -(def:''' (tuple_to_list tuple) +(def:''' (tuple_list tuple) #End (-> Code ($' Maybe ($' List Code))) ({[_ (#Tuple members)] @@ -2178,7 +2178,7 @@ _ (failure "Wrong syntax for template")} [(monad\map maybe_monad get_short bindings) - (monad\map maybe_monad tuple_to_list data)]) + (monad\map maybe_monad tuple_list data)]) _ (failure "Wrong syntax for template")} @@ -2465,20 +2465,20 @@ (return (list syntax))} syntax)) -(def:''' (walk_type type) +(def:''' (normal_type type) #End (-> Code Code) ({[_ (#Form (#Item [_ (#Tag tag)] parts))] - (form$ (#Item [(tag$ tag) (list\map walk_type parts)])) + (form$ (#Item [(tag$ tag) (list\map normal_type parts)])) [_ (#Tuple members)] - (` (Tuple (~+ (list\map walk_type members)))) + (` (Tuple (~+ (list\map normal_type members)))) [_ (#Form (#Item [_ (#Text "lux in-module")] (#Item [_ (#Text module)] (#Item type' #End))))] - (` ("lux in-module" (~ (text$ module)) (~ (walk_type type')))) + (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) [_ (#Form (#Item [_ (#Identifier ["" ":~"])] (#Item expression #End)))] expression @@ -2486,8 +2486,8 @@ [_ (#Form (#Item type_fn args))] (list\fold ("lux type check" (-> Code Code Code) (function' [arg type_fn] (` (#.Apply (~ arg) (~ type_fn))))) - (walk_type type_fn) - (list\map walk_type args)) + (normal_type type_fn) + (list\map normal_type args)) _ type} @@ -2502,7 +2502,7 @@ (do meta_monad [type+ (full_expansion type)] ({(#Item type' #End) - (in (list (walk_type type'))) + (in (list (normal_type type'))) _ (failure "The expansion of the type-syntax had to yield a single element.")} @@ -2552,7 +2552,7 @@ [first a x] [second b y]) -(def:''' (unfold_type_def type_codes) +(def:''' (type_declaration type_codes) #End (-> ($' List Code) ($' Meta (Tuple Code ($' Maybe ($' List Text))))) ({(#Item [_ (#Record pairs)] #End) @@ -2705,11 +2705,6 @@ (failure "Wrong syntax for def'")} parts))) -(def:' (rejoin_pair pair) - (-> [Code Code] (List Code)) - (let' [[left right] pair] - (list left right))) - (def:' (text\encode original) (-> Text Text) ($_ text\compose ..double_quote original ..double_quote)) @@ -2940,7 +2935,7 @@ #None (failure "Wrong syntax for function"))) -(def:' (process_def_meta_value code) +(def:' (definition_annotation_value code) (-> Code Code) (case code [_ (#Bit value)] @@ -2969,7 +2964,7 @@ [_ (#Tuple xs)] (|> xs - (list\map process_def_meta_value) + (list\map definition_annotation_value) untemplated_list (meta_code ["library/lux" "Tuple"])) @@ -2977,18 +2972,18 @@ (|> kvs (list\map (: (-> [Code Code] Code) (function (_ [k v]) - (` [(~ (process_def_meta_value k)) - (~ (process_def_meta_value v))])))) + (` [(~ (definition_annotation_value k)) + (~ (definition_annotation_value v))])))) untemplated_list (meta_code ["library/lux" "Record"])) )) -(def:' (process_def_meta kvs) +(def:' (definition_annotations kvs) (-> (List [Code Code]) Code) (untemplated_list (list\map (: (-> [Code Code] Code) (function (_ [k v]) - (` [(~ (process_def_meta_value k)) - (~ (process_def_meta_value v))]))) + (` [(~ (definition_annotation_value k)) + (~ (definition_annotation_value v))]))) kvs))) (def:' (with_func_args args meta) @@ -3028,7 +3023,7 @@ (list [(tag$ ["library/lux" "doc"]) (text$ ($_ "lux text concat" "## Defines global constants/functions." ..\n - "(def: (rejoin_pair pair)" ..\n + "(def: (pair_list pair)" ..\n " (-> [Code Code] (List Code))" ..\n " (let [[left right] pair]" ..\n " (list left right)))" @@ -3079,7 +3074,7 @@ #None body) - =meta (process_def_meta meta)] + =meta (definition_annotations meta)] (return (list (` ("lux def" (~ name) (~ body) [(~ location_code) @@ -3089,7 +3084,7 @@ #None (failure "Wrong syntax for def:")))) -(def: (meta_code_add addition meta) +(def: (with_definition_annotation addition meta) (-> [Code Code] Code Code) (case [addition meta] [[name value] [location (#Record pairs)]] @@ -3098,11 +3093,11 @@ _ meta)) -(def: (meta_code_merge addition base) +(def: (merged_definition_annotations addition base) (-> Code Code Code) (case addition [location (#Record pairs)] - (list\fold meta_code_add base pairs) + (list\fold with_definition_annotation base pairs) _ base)) @@ -3147,7 +3142,7 @@ _ (` ("lux macro" (function ((~ name) (~+ args)) (~ body))))) - =meta (process_def_meta meta)] + =meta (definition_annotations meta)] (return (list (` ("lux def" (~ name) (~ body) [(~ location_code) @@ -3210,8 +3205,8 @@ (function (_ [m_name m_type]) [(local_tag$ m_name) m_type])) members)) - sig_meta (meta_code_merge (` {#.sig? #1}) - meta) + sig_meta (merged_definition_annotations (` {#.sig? #1}) + meta) usage (case args #End def_name @@ -3265,14 +3260,14 @@ (-> Text Nothing) ("lux io error" message)) -(macro: (default tokens state) +(macro: (else tokens state) {#.doc (text$ ($_ "lux text concat" "## Allows you to provide a default value that will be used" ..\n "## if a (Maybe x) value turns out to be #.None." __paragraph - "(default +20 (#.Some +10)) ## => +10" + "(else +20 (#.Some +10)) ## => +10" __paragraph - "(default +20 #.None) ## => +20"))} + "(else +20 #.None) ## => +20"))} (case tokens (^ (list else maybe)) (let [g!temp (: Code [dummy_location (#Identifier ["" ""])]) @@ -3285,7 +3280,7 @@ (#Right [state (list code)])) _ - (#Left "Wrong syntax for default"))) + (#Left "Wrong syntax for else"))) (def: (text\split_all_with splitter input) (-> Text Text (List Text)) @@ -3302,7 +3297,7 @@ ("lux text size" input))] ("lux text clip" after_offset after_length input)))))) -(def: (nth idx xs) +(def: (item idx xs) (All [a] (-> Nat (List a) (Maybe a))) (case xs @@ -3312,7 +3307,7 @@ (#Item x xs') (if ("lux i64 =" 0 idx) (#Some x) - (nth ("lux i64 -" 1 idx) xs')))) + (item ("lux i64 -" 1 idx) xs')))) ## https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction (def: (reduced env type) @@ -3347,7 +3342,7 @@ (#Function (reduced env ?input) (reduced env ?output)) (#Parameter idx) - (case (nth idx env) + (case (item idx env) (#Some parameter) parameter @@ -3361,7 +3356,7 @@ type )) -(def: (apply_type type_fn param) +(def: (applied_type param type_fn) (-> Type Type (Maybe Type)) (case type_fn (#UnivQ env body) @@ -3372,11 +3367,11 @@ (#Apply A F) (do maybe_monad - [type_fn* (apply_type F A)] - (apply_type type_fn* param)) + [type_fn* (applied_type A F)] + (applied_type param type_fn*)) (#Named name type) - (apply_type type param) + (applied_type param type) _ #None)) @@ -3396,17 +3391,17 @@ [flat_lambda #Function] ) -(def: (flat_app type) +(def: (flat_application type) (-> Type [Type (List Type)]) (case type (#Apply head func') - (let [[func tail] (flat_app func')] + (let [[func tail] (flat_application func')] [func (#Item head tail)]) _ [type (list)])) -(def: (resolve_struct_type type) +(def: (interface_methods type) (-> Type (Maybe (List Type))) (case type (#Product _) @@ -3414,17 +3409,17 @@ (#Apply arg func) (do maybe_monad - [output (apply_type func arg)] - (resolve_struct_type output)) + [output (applied_type arg func)] + (interface_methods output)) (#UnivQ _ body) - (resolve_struct_type body) + (interface_methods body) (#ExQ _ body) - (resolve_struct_type body) + (interface_methods body) (#Named name type) - (resolve_struct_type type) + (interface_methods type) (#Sum _) #None @@ -3452,7 +3447,7 @@ [module_name current_module_name] (module module_name))) -(def: (resolve_tag [module name]) +(def: (type_tag [module name]) (-> Name (Meta [Nat (List Name) Bit Type])) (do meta_monad [=module (..module module) @@ -3464,17 +3459,17 @@ _ (failure (text\compose "Unknown tag: " (name\encode [module name])))))) -(def: (resolve_type_tags type) +(def: (record_slots type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) (case type (#Apply arg func) - (resolve_type_tags func) + (record_slots func) (#UnivQ env body) - (resolve_type_tags body) + (record_slots body) (#ExQ env body) - (resolve_type_tags body) + (record_slots body) (#Named [module name] unnamed) (do meta_monad @@ -3482,7 +3477,7 @@ #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] (case (get name types) (#Some [tags exported? (#Named _ _type)]) - (case (resolve_struct_type _type) + (case (interface_methods _type) (#Some members) (return (#Some [tags members])) @@ -3490,7 +3485,7 @@ (return #None)) _ - (resolve_type_tags unnamed))) + (record_slots unnamed))) _ (return #None))) @@ -3514,7 +3509,7 @@ (do meta_monad [tokens' (monad\map meta_monad expansion tokens) struct_type get_expected_type - tags+type (resolve_type_tags struct_type) + tags+type (record_slots struct_type) tags (: (Meta (List Name)) (case tags+type (#Some [tags _]) @@ -3595,8 +3590,8 @@ _ (` ((~ name) (~+ args))))] (return (list (` (..def: (~+ (export exported?)) (~ usage) - (~ (meta_code_merge (` {#.implementation? #1}) - meta)) + (~ (merged_definition_annotations (` {#.implementation? #1}) + meta)) (~ type) (implementation (~+ definitions))))))) @@ -3643,7 +3638,7 @@ (case parts (#Some name args meta type_codes) (do meta_monad - [type+tags?? (unfold_type_def type_codes) + [type+tags?? (..type_declaration type_codes) module_name current_module_name] (let [type_name (local_identifier$ name) [type tags??] type+tags?? @@ -3663,7 +3658,7 @@ _ (#Some (` (.All (~ type_name) [(~+ args)] (~ type))))))) - total_meta (let [meta (process_def_meta meta) + total_meta (let [meta (definition_annotations meta) meta (if rec? (` (#.Item (~ (flag_meta "type_rec?")) (~ meta))) meta)] @@ -3726,7 +3721,7 @@ #import_alias (Maybe Text) #import_refer Refer}) -(def: (extract_defs defs) +(def: (referral_references defs) (-> (List Code) (Meta (List Text))) (monad\map meta_monad (: (-> Code (Meta Text)) @@ -3745,13 +3740,13 @@ (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens'))) (do meta_monad - [defs' (extract_defs defs)] + [defs' (..referral_references defs)] (in [(#Only defs') tokens'])) (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens'))) (do meta_monad - [defs' (extract_defs defs)] + [defs' (..referral_references defs)] (in [(#Exclude defs') tokens'])) (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) @@ -3818,7 +3813,7 @@ (def: contextual_reference "#") (def: self_reference ".") -(def: (de_alias context self aliased) +(def: (module_alias context self aliased) (-> Text Text Text Text) (|> aliased (replace_all ..self_reference self) @@ -3977,15 +3972,15 @@ #let [[referral extra] referral+extra] openings+extra (openings_parser extra) #let [[openings extra] openings+extra - de_aliased (de_alias context_alias m_name alias)] - sub_imports (imports_parser #1 import_name de_aliased extra)] + module_alias (..module_alias context_alias m_name alias)] + sub_imports (imports_parser #1 import_name module_alias extra)] (in (case [referral openings] [#Ignore #End] sub_imports _ (list& {#import_name import_name - #import_alias (#Some de_aliased) + #import_alias (#Some module_alias) #import_refer {#refer_defs referral #refer_open openings}} sub_imports)))) @@ -4109,8 +4104,8 @@ (#Some definition) (case definition - (#Left de_aliased) - (definition_type de_aliased state) + (#Left real_name) + (definition_type real_name state) (#Right [exported? def_type def_meta def_value]) (#Some def_type)))))) @@ -4133,8 +4128,8 @@ (#Some definition) (case definition - (#Left de_aliased) - (definition_value de_aliased state) + (#Left real_name) + (definition_value real_name state) (#Right [exported? def_type def_meta def_value]) (#Right [state [def_type def_value]])))))) @@ -4242,7 +4237,7 @@ ($_ text\compose "(Ex " (type\encode body) ")") (#Apply _) - (let [[func args] (flat_app type)] + (let [[func args] (flat_application type)] ($_ text\compose "(" (type\encode func) " " (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) @@ -4268,7 +4263,7 @@ (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) (do meta_monad [init_type (type_definition name) - struct_evidence (resolve_type_tags init_type)] + struct_evidence (record_slots init_type)] (case struct_evidence #None (failure (text\compose "Can only 'open' structs: " (type\encode init_type))) @@ -4278,14 +4273,14 @@ [full_body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) (let [locals (list\map (function (_ [t_module t_name]) - ["" (de_alias "" t_name alias)]) + ["" (..module_alias "" t_name alias)]) tags) pattern (tuple$ (list\map identifier$ locals))] (do meta_monad [enhanced_target (monad\fold meta_monad (function (_ [m_local m_type] enhanced_target) (do meta_monad - [m_implementation (resolve_type_tags m_type)] + [m_implementation (record_slots m_type)] (case m_implementation (#Some m_tags&members) (recur m_local @@ -4353,11 +4348,11 @@ (^ (list [_ (#Tag slot')] record)) (do meta_monad [slot (normal slot') - output (resolve_tag slot) + output (..type_tag slot) #let [[idx tags exported? type] output] g!_ (gensym "_") g!output (gensym "")] - (case (resolve_struct_type type) + (case (interface_methods type) (#Some members) (let [pattern (record$ (list\map (: (-> [Name [Nat Type]] [Code Code]) (function (_ [[r_prefix r_name] [r_idx r_type]]) @@ -4387,10 +4382,10 @@ _ (failure "Wrong syntax for get@"))) -(def: (open_field alias tags my_tag_index [module short] source type) +(def: (open_declaration alias tags my_tag_index [module short] source type) (-> Text (List Name) Nat Name Code Type (Meta (List Code))) (do meta_monad - [output (resolve_type_tags type) + [output (record_slots type) g!_ (gensym "g!_") #let [g!output (local_identifier$ short) pattern (|> tags @@ -4407,12 +4402,12 @@ [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) (function (_ [sub_tag_index sname stype]) - (open_field alias tags' sub_tag_index sname source+ stype))) + (open_declaration alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped/2 tags' members')))] (return (list\join decls'))) _ - (return (list (` ("lux def" (~ (local_identifier$ (de_alias "" short alias))) + (return (list (` ("lux def" (~ (local_identifier$ (..module_alias "" short alias))) (~ source+) [(~ location_code) (#.Record #End)] #0))))))) @@ -4435,14 +4430,14 @@ [_ (#Identifier struct_name)] (do meta_monad [struct_type (type_definition struct_name) - output (resolve_type_tags struct_type) + output (record_slots struct_type) #let [source (identifier$ struct_name)]] (case output (#Some [tags members]) (do meta_monad [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) (function (_ [tag_index sname stype]) - (open_field alias tags tag_index sname source stype))) + (open_declaration alias tags tag_index sname source stype))) (enumeration (zipped/2 tags members)))] (return (list\join decls'))) @@ -4489,7 +4484,7 @@ #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] (in (is_member? imports import_name)))) -(def: (read_refer module_name options) +(def: (referrals module_name options) (-> Text (List Code) (Meta Refer)) (do meta_monad [referral+options (referrals_parser options) @@ -4509,7 +4504,7 @@ (interpose " ") (list\fold text\compose ""))))))) -(def: (write_refer module_name [r_defs r_opens]) +(def: (referral_definitions module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) (do meta_monad [current_module current_module_name @@ -4554,22 +4549,21 @@ (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) list\join)]] - (in (list\compose defs openings)) - )) + (in (list\compose defs openings)))) (macro: #export (refer tokens) (case tokens (^ (list& [_ (#Text module_name)] options)) (do meta_monad - [=refer (read_refer module_name options)] - (write_refer module_name =refer)) + [=refer (referrals module_name options)] + (referral_definitions module_name =refer)) _ (failure "Wrong syntax for refer"))) (def: (refer_code module_name module_alias' [r_defs r_opens]) (-> Text (Maybe Text) Refer Code) - (let [module_alias (..default module_name module_alias') + (let [module_alias (..else module_name module_alias') localizations (: (List Code) (case r_defs #All @@ -4625,14 +4619,14 @@ #let [=imports (|> imports (list\map (: (-> Importation Code) (function (_ [m_name m_alias =refer]) - (` [(~ (text$ m_name)) (~ (text$ (default "" m_alias)))])))) + (` [(~ (text$ m_name)) (~ (text$ (..else "" m_alias)))])))) tuple$) =refers (list\map (: (-> Importation Code) (function (_ [m_name m_alias =refer]) (refer_code m_name m_alias =refer))) imports) =module (` ("lux def module" [(~ location_code) - (#.Record (~ (process_def_meta _meta)))] + (#.Record (~ (definition_annotations _meta)))] (~ =imports)))]] (in (#Item =module =refers)))) @@ -4668,9 +4662,9 @@ (^ (list [_ (#Tag slot')] value record)) (do meta_monad [slot (normal slot') - output (resolve_tag slot) + output (..type_tag slot) #let [[idx tags exported? type] output]] - (case (resolve_struct_type type) + (case (interface_methods type) (#Some members) (do meta_monad [pattern' (monad\map meta_monad @@ -4757,9 +4751,9 @@ (^ (list [_ (#Tag slot')] fun record)) (do meta_monad [slot (normal slot') - output (resolve_tag slot) + output (..type_tag slot) #let [[idx tags exported? type] output]] - (case (resolve_struct_type type) + (case (interface_methods type) (#Some members) (do meta_monad [pattern' (monad\map meta_monad @@ -4847,7 +4841,7 @@ " ([#.UnivQ] [#.ExQ])" __paragraph " (#.Parameter idx)" ..\n - " (default type (list.nth idx env))" + " (else type (list.item idx env))" __paragraph " _" ..\n " type" ..\n @@ -4860,7 +4854,7 @@ (case (: (Maybe (List Code)) (do maybe_monad [bindings' (monad\map maybe_monad get_short bindings) - data' (monad\map maybe_monad tuple_to_list data)] + data' (monad\map maybe_monad tuple_list data)] (let [num_bindings (list\size bindings')] (if (every? (|>> ("lux i64 =" num_bindings)) (list\map list\size data')) @@ -4962,7 +4956,12 @@ (def: un_paired (-> (List [Code Code]) (List Code)) - (|>> (list\map rejoin_pair) list\join)) + (let [pair_list (: (-> [Code Code] (List Code)) + (function (_ pair) + (let [[left right] pair] + (list left right))))] + (|>> (list\map pair_list) + list\join))) (def: (doc_example_to_text prev_location baseline example) (-> Location Nat Code [Location Text]) @@ -5162,7 +5161,7 @@ #let [[hslot tslots] slots] hslot (..normal hslot) tslots (monad\map meta_monad ..normal tslots) - output (resolve_tag hslot) + output (..type_tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output slot_pairings (list\map (: (-> Name [Text Code]) @@ -5181,7 +5180,7 @@ _ (failure "Wrong syntax for ^slots"))) -(def: (place_tokens label tokens target) +(def: (with_expansions' label tokens target) (-> Text (List Code) Code (Maybe (List Code))) (case target (^or [_ (#Bit _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Rev _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) @@ -5196,7 +5195,7 @@ (^template [] [[location ( elems)] (do maybe_monad - [placements (monad\map maybe_monad (place_tokens label tokens) elems)] + [placements (monad\map maybe_monad (with_expansions' label tokens) elems)] (in (list [location ( (list\join placements))])))]) ([#Tuple] [#Form]) @@ -5207,8 +5206,8 @@ (: (-> [Code Code] (Maybe [Code Code])) (function (_ [slot value]) (do maybe_monad - [slot' (place_tokens label tokens slot) - value' (place_tokens label tokens value)] + [slot' (with_expansions' label tokens slot) + value' (with_expansions' label tokens value)] (case [slot' value'] (^ [(list =slot) (list =value)]) (in [=slot =value]) @@ -5216,8 +5215,7 @@ _ #None)))) pairs)] - (in (list [location (#Record =pairs)]))) - )) + (in (list [location (#Record =pairs)]))))) (macro: #export (with_expansions tokens) {#.doc (doc "Controlled macro-expansion." @@ -5245,9 +5243,10 @@ (^ (list& [_ (#Identifier ["" var_name])] expr bindings')) (do meta_monad [expansion (single_expansion expr)] - (case (place_tokens var_name expansion (` (.with_expansions - [(~+ bindings')] - (~+ bodies)))) + (case (with_expansions' var_name expansion + (` (.with_expansions + [(~+ bindings')] + (~+ bodies)))) (#Some output) (in output) @@ -5487,7 +5486,7 @@ (^ (list [_ (#Nat idx)])) (do meta_monad [stvs get_scope_type_vars] - (case (..nth idx (list\reverse stvs)) + (case (..item idx (list\reverse stvs)) (#Some var_id) (in (list (` (#Ex (~ (nat$ var_id)))))) @@ -5720,7 +5719,7 @@ (function (_ compiler) (#Right [compiler (get@ [#info #target] compiler)]))) -(def: (resolve_target choice) +(def: (platform_name choice) (-> Code (Meta Text)) (case choice [_ (#Text platform)] @@ -5728,7 +5727,7 @@ [_ (#Identifier identifier)] (do meta_monad - [identifier (..resolve_global_identifier identifier) + [identifier (..global_identifier identifier) type+value (..definition_value identifier) #let [[type value] type+value]] (case (..flat_alias type) @@ -5759,7 +5758,7 @@ (#Item [key pick] options') (do meta_monad - [platform (..resolve_target key)] + [platform (..platform_name key)] (if (text\= target platform) (return (list pick)) (target_pick target options' default))))) @@ -5786,7 +5785,7 @@ [left a x] [right b y]) -(def: (label_code code) +(def: (embedded_expansions code) (-> Code (Meta [(List [Code Code]) Code])) (case code (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) @@ -5797,7 +5796,7 @@ (^template [] [[ann ( parts)] (do meta_monad - [=parts (monad\map meta_monad label_code parts)] + [=parts (monad\map meta_monad embedded_expansions parts)] (in [(list\fold list\compose (list) (list\map left =parts)) [ann ( (list\map right =parts))]]))]) ([#Form] [#Tuple]) @@ -5807,8 +5806,8 @@ [=kvs (monad\map meta_monad (function (_ [key val]) (do meta_monad - [=key (label_code key) - =val (label_code val) + [=key (embedded_expansions key) + =val (embedded_expansions val) #let [[key_labels key_labelled] =key [val_labels val_labelled] =val]] (in [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) @@ -5823,7 +5822,7 @@ (case tokens (^ (list raw)) (do meta_monad - [=raw (label_code raw) + [=raw (..embedded_expansions raw) #let [[labels labelled] =raw]] (in (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index beecb2511..7d0ac6129 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -240,13 +240,13 @@ (-> Nat [(Channel Any) (Sink Any)]) (..poll milli_seconds (io []))) -(def: #export (iterate f init) +(def: #export (iterations f init) (All [s o] (-> (-> s (Async (Maybe [s o]))) s (Channel o))) (do async.monad [?next (f init)] (case ?next (#.Some [state output]) - (in (#.Some [output (iterate f state)])) + (in (#.Some [output (iterations f state)])) #.None (in #.None)))) diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 9a6f3a7b1..edfc01f8c 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -169,6 +169,6 @@ (do ! [_ (monad.map ! (|>> (get@ #action) ..execute! io.io) ready)] (recur [])) - (error! (exception.construct ..cannot_continue_running_threads [])))) + (error! (exception.error ..cannot_continue_running_threads [])))) )))) )) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 8358da7b3..65ddd84f1 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -73,15 +73,15 @@ (All [a] (-> a (Try a))) (#//.Success value)) -(def: #export (construct exception message) - {#.doc "Constructs an exception."} +(def: #export (error exception message) + {#.doc "Constructs an error message from an exception."} (All [e] (-> (Exception e) e Text)) ((get@ #..constructor exception) message)) (def: #export (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 (..construct exception message))) + (#//.Failure (..error exception message))) (def: #export (assertion exception message test) (All [e] (-> (Exception e) e Bit (Try Any))) @@ -161,7 +161,7 @@ (list\map (function (_ [header message]) (` [(~ header) (~ message)]))))))))))) -(def: #export (enumerate format entries) +(def: #export (listing format entries) {#.doc (doc "A numbered report of the entries on a list." "NOTE: 0-based numbering.")} (All [a] @@ -198,10 +198,10 @@ (#//.Failure error) (#//.Failure (case error "" - (..construct exception message) + (..error exception message) _ - (..decorate (..construct exception message) error))) + (..decorate (..error exception message) error))) success success)) diff --git a/stdlib/source/library/lux/control/function/contract.lux b/stdlib/source/library/lux/control/function/contract.lux index 00c1bb59c..59ad5b681 100644 --- a/stdlib/source/library/lux/control/function/contract.lux +++ b/stdlib/source/library/lux/control/function/contract.lux @@ -35,7 +35,7 @@ (pre (i.= +4 (i.+ +2 +2)) (foo +123 +456 +789)))} (in (list (` (exec - ((~! ..assert!) (~ (code.text (exception.construct ..pre_condition_failed test))) + ((~! ..assert!) (~ (code.text (exception.error ..pre_condition_failed test))) (~ test)) (~ expr)))))) @@ -49,6 +49,6 @@ (with_gensyms [g!output] (in (list (` (let [(~ g!output) (~ expr)] (exec - ((~! ..assert!) (~ (code.text (exception.construct ..post_condition_failed test))) + ((~! ..assert!) (~ (code.text (exception.error ..post_condition_failed test))) ((~ test) (~ g!output))) (~ g!output)))))))) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index 19b02e507..738960e55 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -42,11 +42,11 @@ (exception: #export (cannot_parse {input (List Analysis)}) (exception.report - ["Input" (exception.enumerate /.%analysis input)])) + ["Input" (exception.listing /.%analysis input)])) (exception: #export (unconsumed_input {input (List Analysis)}) (exception.report - ["Input" (exception.enumerate /.%analysis input)])) + ["Input" (exception.listing /.%analysis input)])) (type: #export Parser {#.doc (doc "A parser for Lux code analysis nodes.")} diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index ec683489f..7827bd8c0 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -240,7 +240,7 @@ (do //.monad [raw (..list value) #let [output (set.of_list hash raw)] - _ (//.assertion (exception.construct ..set_elements_are_not_unique []) + _ (//.assertion (exception.error ..set_elements_are_not_unique []) (n.= (list.size raw) (set.size output)))] (in output))) diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index f186a315a..741933205 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -28,7 +28,7 @@ (exception: #export (unconsumed_input {input (List JSON)}) (exception.report - ["Input" (exception.enumerate /.format input)])) + ["Input" (exception.listing /.format input)])) (exception: #export empty_input) @@ -74,7 +74,7 @@ (in value) _ - (//.failure (exception.construct ..unexpected_value [head])))))] + (//.failure (exception.error ..unexpected_value [head])))))] [null /.Null #/.Null "null"] [boolean /.Boolean #/.Boolean "boolean"] @@ -98,7 +98,7 @@ (in (\ = test value)) _ - (//.failure (exception.construct ..unexpected_value [head]))))) + (//.failure (exception.error ..unexpected_value [head]))))) (def: #export ( test) {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " "."))} @@ -109,10 +109,10 @@ ( value) (if (\ = test value) (in []) - (//.failure (exception.construct ..value_mismatch [( test) ( value)]))) + (//.failure (exception.error ..value_mismatch [( test) ( value)]))) _ - (//.failure (exception.construct ..unexpected_value [head])))))] + (//.failure (exception.error ..unexpected_value [head])))))] [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"] [number? number! /.Number frac.equivalence #/.Number "number"] @@ -142,10 +142,10 @@ (in output) _ - (//.failure (exception.construct ..unconsumed_input remainder)))) + (//.failure (exception.error ..unconsumed_input remainder)))) _ - (//.failure (exception.construct ..unexpected_value [head]))))) + (//.failure (exception.error ..unexpected_value [head]))))) (def: #export (object parser) {#.doc (doc "Parses the contents of a JSON object." @@ -170,10 +170,10 @@ (in output) _ - (//.failure (exception.construct ..unconsumed_input remainder)))) + (//.failure (exception.error ..unconsumed_input remainder)))) _ - (//.failure (exception.construct ..unexpected_value [head]))))) + (//.failure (exception.error ..unexpected_value [head]))))) (def: #export (field field_name parser) {#.doc (doc "Parses a field inside a JSON object." diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/library/lux/control/parser/synthesis.lux index d8406d3ec..1ecdaab9e 100644 --- a/stdlib/source/library/lux/control/parser/synthesis.lux +++ b/stdlib/source/library/lux/control/parser/synthesis.lux @@ -31,15 +31,15 @@ (exception: #export (cannot_parse {input (List Synthesis)}) (exception.report - ["Input" (exception.enumerate /.%synthesis input)])) + ["Input" (exception.listing /.%synthesis input)])) (exception: #export (unconsumed_input {input (List Synthesis)}) (exception.report - ["Input" (exception.enumerate /.%synthesis input)])) + ["Input" (exception.listing /.%synthesis input)])) (exception: #export (expected_empty_input {input (List Synthesis)}) (exception.report - ["Input" (exception.enumerate /.%synthesis input)])) + ["Input" (exception.listing /.%synthesis input)])) (exception: #export (wrong_arity {expected Arity} {actual Arity}) (exception.report diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index 345eae8ee..1806d77e4 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -90,7 +90,7 @@ {#.doc "Yields the next character without applying any logic."} (Parser Text) (function (_ [offset tape]) - (case (/.nth offset tape) + (case (/.char offset tape) (#.Some output) (#try.Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]) @@ -101,7 +101,7 @@ {#.doc "Yields the next character (as a slice) without applying any logic."} (Parser Slice) (function (_ [offset tape]) - (case (/.nth offset tape) + (case (/.char offset tape) (#.Some _) (#try.Success [[("lux i64 +" 1 offset) tape] {#basis offset @@ -156,7 +156,7 @@ {#.doc "Yields the next character (without consuming it from the input)."} (Parser Text) (function (_ (^@ input [offset tape])) - (case (/.nth offset tape) + (case (/.char offset tape) (#.Some output) (#try.Success [input (/.of_char output)]) @@ -174,7 +174,7 @@ (-> Nat Nat (Parser Text)) (do //.monad [char any - #let [char' (maybe.assume (/.nth 0 char))] + #let [char' (maybe.assume (/.char 0 char))] _ (//.assertion ($_ /\compose "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) (.and (n.>= bottom char') (n.<= top char')))] @@ -225,7 +225,7 @@ {#.doc (code.text ($_ /\compose "Yields characters that are" " part of a piece of text."))} (-> Text (Parser Text)) (function (_ [offset tape]) - (case (/.nth offset tape) + (case (/.char offset tape) (#.Some output) (let [output' (/.of_char output)] (if ( (/.contains? output' options)) @@ -244,7 +244,7 @@ {#.doc (code.text ($_ /\compose "Yields characters (as a slice) that are" " part of a piece of text."))} (-> Text (Parser Slice)) (function (_ [offset tape]) - (case (/.nth offset tape) + (case (/.char offset tape) (#.Some output) (let [output' (/.of_char output)] (if ( (/.contains? output' options)) @@ -268,7 +268,7 @@ {#.doc "Yields characters that satisfy a predicate."} (-> (-> Char Bit) (Parser Text)) (function (_ [offset tape]) - (case (/.nth offset tape) + (case (/.char offset tape) (#.Some output) (if (parser output) (#try.Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index 7933f3a90..9c4dae7ee 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -169,7 +169,7 @@ (let [members ( (type.anonymous headT))] (if (n.> 1 (list.size members)) (local members poly) - (//.failure (exception.construct headT)))))))] + (//.failure (exception.error headT)))))))] [variant type.flat_variant #.Sum ..not_variant] [tuple type.flat_tuple #.Product ..not_tuple] @@ -181,7 +181,7 @@ [headT any #let [[num_arg bodyT] (type.flat_univ_q (type.anonymous headT))]] (if (n.= 0 num_arg) - (//.failure (exception.construct ..not_polymorphic headT)) + (//.failure (exception.error ..not_polymorphic headT)) (in [num_arg bodyT])))) (def: #export (polymorphic poly) @@ -230,7 +230,7 @@ (if (n.> 0 (list.size inputsT)) (//.and (local inputsT in_poly) (local (list outputT) out_poly)) - (//.failure (exception.construct ..not_function headT))))) + (//.failure (exception.error ..not_function headT))))) (def: #export (applied poly) {#.doc (doc "Parses a type application.")} @@ -239,7 +239,7 @@ [headT any #let [[funcT paramsT] (type.flat_application (type.anonymous headT))]] (if (n.= 0 (list.size paramsT)) - (//.failure (exception.construct ..not_application headT)) + (//.failure (exception.error ..not_application headT)) (..local (#.Item funcT paramsT) poly)))) (template [ ] @@ -250,7 +250,7 @@ [actual any] (if ( expected actual) (in []) - (//.failure (exception.construct ..types_do_not_match [expected actual])))))] + (//.failure (exception.error ..types_do_not_match [expected actual])))))] [exactly type\= "Parses a type exactly."] @@ -279,10 +279,10 @@ (in poly_code) #.None - (//.failure (exception.construct ..unknown_parameter headT))) + (//.failure (exception.error ..unknown_parameter headT))) _ - (//.failure (exception.construct ..not_parameter headT))))) + (//.failure (exception.error ..not_parameter headT))))) (def: #export (parameter! id) (-> Nat (Parser Any)) @@ -293,10 +293,10 @@ (#.Parameter idx) (if (n.= id (adjusted_idx env idx)) (in []) - (//.failure (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) + (//.failure (exception.error ..wrong_parameter [(#.Parameter id) headT]))) _ - (//.failure (exception.construct ..not_parameter headT))))) + (//.failure (exception.error ..not_parameter headT))))) (def: #export existential {#.doc (doc "Yields an existential type.")} @@ -308,7 +308,7 @@ (in ex_id) _ - (//.failure (exception.construct ..not_existential headT))))) + (//.failure (exception.error ..not_existential headT))))) (def: #export named {#.doc (doc "Yields a named type.")} @@ -320,7 +320,7 @@ (in [name anonymousT]) _ - (//.failure (exception.construct ..not_named inputT))))) + (//.failure (exception.error ..not_named inputT))))) (`` (template: (|nothing|) (#.Named [(~~ (static .prelude_module)) "Nothing"] @@ -341,7 +341,7 @@ (in [recT output])) _ - (//.failure (exception.construct ..not_recursive headT))))) + (//.failure (exception.error ..not_recursive headT))))) (def: #export recursive_self (Parser Code) @@ -355,7 +355,7 @@ (in self_call) _ - (//.failure (exception.construct ..not_recursive headT))))) + (//.failure (exception.error ..not_recursive headT))))) (def: #export recursive_call (Parser Code) diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux index 4af88b9b3..91fd7e67c 100644 --- a/stdlib/source/library/lux/control/parser/xml.lux +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -32,11 +32,11 @@ (exception: #export (unknown_attribute {expected Attribute} {available (List Attribute)}) (exception.report ["Expected" (%.text (/.attribute expected))] - ["Available" (exception.enumerate (|>> /.attribute %.text) available)])) + ["Available" (exception.listing (|>> /.attribute %.text) available)])) (exception: #export (unconsumed_inputs {inputs (List XML)}) (exception.report - ["Inputs" (exception.enumerate (\ /.codec encode) inputs)])) + ["Inputs" (exception.listing (\ /.codec encode) inputs)])) (def: (run' parser attrs documents) (All [a] (-> (Parser a) Attrs (List XML) (Try a))) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index a7cda544b..6911ef015 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -152,7 +152,7 @@ (All [! e a] (-> (Monad !) (Exception e) e (All [r] (Region r ! a)))) - (failure monad (exception.construct exception message))) + (failure monad (exception.error exception message))) (def: #export (lift monad operation) {#.doc (doc "Lift an effectful computation into a region-based computation.")} diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index 659c1cc39..48a7e8abf 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -64,7 +64,7 @@ #.None (list))) - (meta.failure (exception.construct ..must_remember [deadline today message focus]))))) + (meta.failure (exception.error ..must_remember [deadline today message focus]))))) (template [ ] [(`` (syntax: #export ( {deadline ..deadline} {message .text} {focus (<>.maybe .any)}) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index 9c07bef65..e823c4212 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -293,8 +293,11 @@ (All [a] (-> (Array a) (List a))) (loop [idx (dec (size array)) output #.End] - (if (n.= ..underflow idx) + (case idx + (^ (static ..underflow)) output + + _ (recur (dec idx) (case (read idx array) (#.Some head) @@ -308,8 +311,11 @@ (All [a] (-> a (Array a) (List a))) (loop [idx (dec (size array)) output #.End] - (if (n.= ..underflow idx) + (case idx + (^ (static ..underflow)) output + + _ (recur (dec idx) (#.Item (maybe.else default (read idx array)) output))))) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index ffe34dc92..3b4e7a17c 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -151,7 +151,7 @@ [reddened #Black #Red (error! error_message)] ) -(def: (add_left addition center) +(def: (with_left addition center) (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red @@ -200,7 +200,7 @@ #Black )))) -(def: (add_right addition center) +(def: (with_right addition center) (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red @@ -268,8 +268,8 @@ (#.Some ( (maybe.assume outcome) root))))] - [_\< #left add_left] - [(order.> (get@ #&order dict)) #right add_right] + [_\< #left ..with_left] + [(order.> (get@ #&order dict)) #right ..with_right] )) ## (_\= reference key) @@ -334,7 +334,7 @@ _ (black key value ?left ?right))) -(def: (balance_left_remove key value ?left ?right) +(def: (without_left key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left (^multi (#.Some left) @@ -363,7 +363,7 @@ (error! error_message)) )) -(def: (balance_right_remove key value ?left ?right) +(def: (without_right key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right (^multi (#.Some right) @@ -459,13 +459,13 @@ (get@ #right right))))) #Black - (in (balance_left_remove (get@ #key left) - (get@ #value left) - (get@ #left left) - (#.Some (black (get@ #key right) - (get@ #value right) - (#.Some fused) - (get@ #right right))))) + (in (without_left (get@ #key left) + (get@ #value left) + (get@ #left left) + (#.Some (black (get@ #key right) + (get@ #value right) + (#.Some fused) + (get@ #right right))))) )) ) @@ -499,7 +499,7 @@ (case (get@ #left root) (^multi (#.Some left) {(get@ #color left) #Black}) - [(#.Some (balance_left_remove root_key root_val side_outcome (get@ #right root))) + [(#.Some (without_left root_key root_val side_outcome (get@ #right root))) #0] _ @@ -508,7 +508,7 @@ (case (get@ #right root) (^multi (#.Some right) {(get@ #color right) #Black}) - [(#.Some (balance_right_remove root_key root_val (get@ #left root) side_outcome)) + [(#.Some (without_right root_key root_val (get@ #left root) side_outcome)) #0] _ diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index df4b33c2e..5b20c22fb 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -172,23 +172,23 @@ (#.Item x (repeat (dec n) x)) #.End)) -(def: (iterate' f x) +(def: (iterations' f x) (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) (#.Some x') - (#.Item x (iterate' f x')) + (#.Item x (iterations' f x')) #.None (list))) -(def: #export (iterate f x) +(def: #export (iterations f x) {#.doc "Generates a list element by element until the function returns #.None."} (All [a] (-> (-> a (Maybe a)) a (List a))) (case (f x) (#.Some x') - (#.Item x (iterate' f x')) + (#.Item x (iterations' f x')) #.None (list x))) @@ -283,7 +283,7 @@ [any? #0 or] ) -(def: #export (nth i xs) +(def: #export (item i xs) {#.doc "Fetches the element at the specified index."} (All [a] (-> Nat (List a) (Maybe a))) @@ -294,7 +294,7 @@ (#.Item x xs') (if (n.= 0 i) (#.Some x) - (nth (dec i) xs')))) + (item (dec i) xs')))) (implementation: #export (equivalence Equivalence) (All [a] (-> (Equivalence a) (Equivalence (List a)))) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index 4e341dfbd..1af5037ce 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -268,7 +268,7 @@ (exception.except ..incorrect_row_structure [])))) (exception.except ..index_out_of_bounds [row idx]))) -(def: #export (nth idx row) +(def: #export (item idx row) (All [a] (-> Nat (Row a) (Try a))) (do try.monad [base (base_for idx row)] @@ -296,7 +296,7 @@ (def: #export (update idx f row) (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) (do try.monad - [val (..nth idx row)] + [val (..item idx row)] (..put idx (f val) row))) (def: #export (pop row) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 4105e22e5..44755f0db 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -23,11 +23,11 @@ {#.doc "An infinite sequence of values."} (Cont [a (Sequence a)])) -(def: #export (iterate f x) +(def: #export (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 (iterate f (f x))])) + (//.pending [x (iterations f (f x))])) (def: #export (repeat x) {#.doc "Repeat a value forever."} @@ -59,12 +59,12 @@ [tail (Sequence a)] ) -(def: #export (nth idx sequence) +(def: #export (item idx sequence) (All [a] (-> Nat (Sequence a) a)) (let [[head tail] (//.run sequence)] (case idx 0 head - _ (nth (dec idx) tail)))) + _ (item (dec idx) tail)))) (template [ ] [(def: #export ( pred xs) diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index daac4e81d..cc186e849 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -186,8 +186,8 @@ (and prev (maybe.else #0 (do maybe.monad - [x' (row.nth idx xs) - y' (row.nth idx ys)] + [x' (row.item idx xs) + y' (row.item idx ys)] (in (= x' y')))))) #1 (list.indices (row.size xs)))) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 996bb27f9..1f4f71967 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -119,10 +119,10 @@ [pre_end .bits/8 end .bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assertion (exception.construct ..wrong_character [expected pre_end]) + (<>.assertion (exception.error ..wrong_character [expected pre_end]) (n.= expected pre_end))) _ (let [expected (`` (char (~~ (static ..null))))] - (<>.assertion (exception.construct ..wrong_character [expected end]) + (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end)))] (in []))) @@ -144,7 +144,7 @@ digits (<>.lift (\ utf8.codec decode digits)) end .bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assertion (exception.construct ..wrong_character [expected end]) + (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end)))] (<>.lift (do {! try.monad} @@ -277,7 +277,7 @@ [string (.segment ) end .bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assertion (exception.construct ..wrong_character [expected end]) + _ (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end))] (<>.lift (do {! try.monad} @@ -319,7 +319,7 @@ [string (.segment ..magic_size) end .bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assertion (exception.construct ..wrong_character [expected end]) + _ (<>.assertion (exception.error ..wrong_character [expected end]) (n.= expected end))] (<>.lift (\ try.monad map (|>> :abstraction) @@ -798,7 +798,7 @@ (-> Link_Flag (Parser File)) (do <>.monad [header ..header_parser - _ (<>.assertion (exception.construct ..wrong_link_flag [expected (get@ #link_flag header)]) + _ (<>.assertion (exception.error ..wrong_link_flag [expected (get@ #link_flag header)]) (is? expected (get@ #link_flag header))) #let [size (get@ #size header) rounded_size (..rounded_content_size size)] diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 68ce8ec38..76ae69e33 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -1,6 +1,6 @@ (.module: [library - [lux #* + [lux (#- char) ["@" target] [abstract [hash (#+ Hash)] @@ -51,7 +51,7 @@ (-> Text Nat) (|>> "lux text size")) -(def: #export (nth index input) +(def: #export (char index input) {#.doc (doc "Yields the character at the specified index.")} (-> Nat Text (Maybe Char)) (if (n.< ("lux text size" input) index) @@ -314,7 +314,7 @@ {#.doc "Checks whether the character is white-space."} (-> Char Bit) (with_expansions [ (template [] - [(^ (char (~~ (static ))))] + [(^ (.char (~~ (static ))))] [..tab] [..vertical_tab] diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 02cb8baaa..d34c91d70 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -24,7 +24,7 @@ (template [ ] [(def: - (|> (//.nth 0) maybe.assume))] + (|> (//.char 0) maybe.assume))] [sigil_char ..sigil] [\u_sigil "u"] @@ -32,7 +32,7 @@ (template [ ] [(def: - (|> (//.nth 0) maybe.assume)) + (|> (//.char 0) maybe.assume)) (def: (format ..sigil ))] @@ -51,7 +51,7 @@ (template [ ] [(def: - (|> (//.nth 0) maybe.assume))] + (|> (//.char 0) maybe.assume))] [\0 //.\0] [\a //.\a] diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 45798b920..0c5d42d02 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -87,9 +87,9 @@ (def: re_range^ (Parser Code) (do {! <>.monad} - [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume))) + [from (|> regex_char^ (\ ! map (|>> (//.char 0) maybe.assume))) _ (.this "-") - to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] + to (|> regex_char^ (\ ! map (|>> (//.char 0) maybe.assume)))] (in (` ((~! .range) (~ (code.nat from)) (~ (code.nat to))))))) (def: re_char^ @@ -243,7 +243,7 @@ ($_ <>.either (do ! [[from to] (<>.and number^ (<>.after (.this ",") number^)) - _ (<>.assertion (exception.construct ..incorrect_quantification [from to]) + _ (<>.assertion (exception.error ..incorrect_quantification [from to]) (n.<= to from))] (in (` ((~! join_text^) ((~! <>.between) (~ (code.nat from)) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 27233fb11..81202885a 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -545,11 +545,11 @@ {type_vars (List (Type Var))}) (exception.report ["Name" (%.text name)] - ["Type Variables" (exception.enumerate parser.name type_vars)])) + ["Type Variables" (exception.listing parser.name type_vars)])) (def: (assertion exception payload test) (All [e] (-> (Exception e) e Bit (Parser Any))) - (<>.assertion (exception.construct exception payload) + (<>.assertion (exception.error exception payload) test)) (def: (valid_class_name type_vars) @@ -579,7 +579,7 @@ {type_vars (List (Type Var))}) (exception.report ["Unexpected Type Variable" (%.text name)] - ["Expected Type Variables" (exception.enumerate parser.name type_vars)])) + ["Expected Type Variables" (exception.listing parser.name type_vars)])) (def: (variable^ type_vars) (-> (List (Type Var)) (Parser (Type Parameter))) @@ -1832,7 +1832,7 @@ (exception.report ["Lux Type" (%.type type)])) -(with_expansions [ (as_is (meta.failure (exception.construct ..cannot_convert_to_jvm_type [type])))] +(with_expansions [ (as_is (meta.failure (exception.error ..cannot_convert_to_jvm_type [type])))] (def: (lux_type->jvm_type type) (-> .Type (Meta (Type Value))) (if (lux_type\= .Any type) @@ -2058,4 +2058,4 @@ ("jvm object cast" (~ object)))))) _ - (meta.failure (exception.construct ..cannot_cast_to_non_object [type])))) + (meta.failure (exception.error ..cannot_cast_to_non_object [type])))) diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index 11509f0cc..04a9324c4 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -111,7 +111,7 @@ "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")} (-> Text (Meta Code)) (do //.monad - [id //.count] + [id //.seed] (in (|> id (\ nat.decimal encode) ($_ text\compose "__gensym__" prefix) diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index 3e37d174f..2872adb12 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -99,7 +99,7 @@ (-> (List [Name Macro]) (Meta Code)) (do meta.monad [_ (monad.map meta.monad ..push_one macros) - seed meta.count + seed meta.seed g!pop (//.gensym "pop") _ (let [g!pop (: Name ["" (//code.format g!pop)])] (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))] diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index da2adcd82..4ad19d041 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -26,6 +26,7 @@ ["#." check (#+ Check)]]) (type: #export Definition + {#.doc (doc "Syntax for a constant definition.")} {#name Text #value (Either Check Code) @@ -100,7 +101,7 @@ )))) (def: #export (parser compiler) - {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} + {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it is a definition."} (-> Lux (Parser Definition)) (do {! <>.monad} [raw .any diff --git a/stdlib/source/library/lux/macro/syntax/export.lux b/stdlib/source/library/lux/macro/syntax/export.lux index d51b28bcd..f1e3c7a0f 100644 --- a/stdlib/source/library/lux/macro/syntax/export.lux +++ b/stdlib/source/library/lux/macro/syntax/export.lux @@ -1,4 +1,5 @@ (.module: + {#.doc (.doc "Syntax for marking a definition as an export.")} [library [lux #* [control diff --git a/stdlib/source/library/lux/macro/syntax/input.lux b/stdlib/source/library/lux/macro/syntax/input.lux index 9307322d9..c8630283e 100644 --- a/stdlib/source/library/lux/macro/syntax/input.lux +++ b/stdlib/source/library/lux/macro/syntax/input.lux @@ -12,6 +12,7 @@ ["." code]]]]) (type: #export Input + {#.doc (doc "The common typed-argument syntax used by many macros.")} {#binding Code #type Code}) diff --git a/stdlib/source/library/lux/math/logic/continuous.lux b/stdlib/source/library/lux/math/logic/continuous.lux index 631219671..e68527938 100644 --- a/stdlib/source/library/lux/math/logic/continuous.lux +++ b/stdlib/source/library/lux/math/logic/continuous.lux @@ -1,14 +1,18 @@ +## https://en.wikipedia.org/wiki/Many-valued_logic (.module: + {#.doc (.doc "Continuous logic using Rev values." + "Continuous logic is logic in the interval [0,1] instead of just the binary #0 and #1 options." + "Because Rev is being used, the interval is actual [0,1).")} [library [lux (#- false true or and not) [abstract [monoid (#+ Monoid)]] [math [number - ["r" rev ("#\." interval)]]]]]) + ["/" rev ("#\." interval)]]]]]) -(def: #export false Rev r\bottom) -(def: #export true Rev r\top) +(def: #export false Rev /\bottom) +(def: #export true Rev /\top) (template [ ] [(def: #export @@ -21,13 +25,13 @@ (def: identity ) (def: compose ))] - [or r.max disjunction ..false] - [and r.min conjunction ..true] + [or /.max disjunction ..false] + [and /.min conjunction ..true] ) (def: #export (not input) (-> Rev Rev) - (r.- input ..true)) + (/.- input ..true)) (def: #export (implies consequent antecedent) (-> Rev Rev Rev) diff --git a/stdlib/source/library/lux/math/logic/fuzzy.lux b/stdlib/source/library/lux/math/logic/fuzzy.lux index c00f63c43..d869eb4a7 100644 --- a/stdlib/source/library/lux/math/logic/fuzzy.lux +++ b/stdlib/source/library/lux/math/logic/fuzzy.lux @@ -1,4 +1,6 @@ +## https://en.wikipedia.org/wiki/Fuzzy_logic (.module: + {#.doc (.doc "Fuzzy logic, implemented on top of the Rev type.")} [library [lux #* [abstract @@ -16,6 +18,7 @@ ["#" continuous]]) (type: #export (Fuzzy a) + {#.doc (doc "A fuzzy set.")} (-> a Rev)) (implementation: #export functor diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index a6ab5afc1..bc92467b1 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -75,7 +75,7 @@ (.run (do <>.monad [[value _ actual] ($_ <>.and intL (.this ..separator) intL) - _ (<>.assertion (exception.construct ..incorrect_modulus [expected actual]) + _ (<>.assertion (exception.error ..incorrect_modulus [expected actual]) (i.= (//.divisor expected) actual))] (in (..modular expected value)))))) diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index e927bc791..de73592f0 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -24,13 +24,14 @@ ["." int]]]]]) (type: #export Complex + {#.doc (doc "A complex number.")} {#real Frac #imaginary Frac}) (syntax: #export (complex real {?imaginary (<>.maybe .any)}) {#.doc (doc "Complex literals." (complex real imaginary) - "The imaginary part can be omitted if it's 0." + "The imaginary part can be omitted if it's +0.0." (complex real))} (in (list (` {#..real (~ real) #..imaginary (~ (maybe.else (' +0.0) ?imaginary))})))) @@ -224,7 +225,7 @@ [pow' Frac ..*'] ) -(def: (copy_sign sign magnitude) +(def: (with_sign sign magnitude) (-> Frac Frac Frac) (f.* (f.signum sign) magnitude)) @@ -238,7 +239,7 @@ imaginary)} {#real (f./ (f.* +2.0 t) (f.abs imaginary)) - #imaginary (f.* t (..copy_sign imaginary +1.0))}))) + #imaginary (f.* t (..with_sign imaginary +1.0))}))) (def: (root/2-1z input) (-> Complex Complex) diff --git a/stdlib/source/library/lux/math/number/i16.lux b/stdlib/source/library/lux/math/number/i16.lux index 1fd3e6b02..569e228fd 100644 --- a/stdlib/source/library/lux/math/number/i16.lux +++ b/stdlib/source/library/lux/math/number/i16.lux @@ -13,6 +13,7 @@ (maybe.assume (i64.sub 16))) (def: #export I16 + {#.doc (doc "A 16-bit integer.")} (:by_example [size] (Sub size) ..sub diff --git a/stdlib/source/library/lux/math/number/i32.lux b/stdlib/source/library/lux/math/number/i32.lux index a0ecfabc2..33374d19a 100644 --- a/stdlib/source/library/lux/math/number/i32.lux +++ b/stdlib/source/library/lux/math/number/i32.lux @@ -9,9 +9,11 @@ [// ["." i64 (#+ Sub)]]) -(def: sub (maybe.assume (i64.sub 32))) +(def: sub + (maybe.assume (i64.sub 32))) (def: #export I32 + {#.doc (doc "A 32-bit integer.")} (:by_example [size] (Sub size) ..sub diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux index a5d72f5e7..02dc98748 100644 --- a/stdlib/source/library/lux/math/number/i64.lux +++ b/stdlib/source/library/lux/math/number/i64.lux @@ -35,14 +35,18 @@ [Nat right_shifted "lux i64 right-shift" "Unsigned/logic bitwise right-shift."] ) +## https://en.wikipedia.org/wiki/Mask_(computing) (type: #export Mask + {#.doc (doc "A pattern of bits that can be imposed on I64 values.")} I64) (def: #export (bit position) + {#.doc (doc "A mask with only a specific bit set.")} (-> Nat Mask) (|> 1 .i64 (..left_shifted (n.% ..width position)))) (def: #export sign + {#.doc (doc "A mask for the sign bit of ints.")} Mask (..bit (dec ..width))) @@ -60,6 +64,7 @@ (..not ..false)) (def: #export (mask amount_of_bits) + {#.doc (doc "Mask a block of bits of the specified size.")} (-> Nat Mask) (case amount_of_bits 0 ..false @@ -84,28 +89,28 @@ (add_shift 32) (..and 127)))) -(def: #export (clear idx input) - {#.doc "Clear bit at given index."} +(def: #export (clear index input) + {#.doc "Clear bit at the given index."} (All [s] (-> Nat (I64 s) (I64 s))) - (|> idx ..bit ..not (..and input))) + (|> index ..bit ..not (..and input))) (template [ ] - [(def: #export ( idx input) + [(def: #export ( index input) {#.doc } (All [s] (-> Nat (I64 s) (I64 s))) - (|> idx ..bit ( input)))] + (|> index ..bit ( input)))] [set ..or "Set bit at given index."] [flip ..xor "Flip bit at given index."] ) -(def: #export (set? idx input) +(def: #export (set? index input) (-> Nat (I64 Any) Bit) - (|> input (:as I64) (..and (..bit idx)) (n.= 0) .not)) + (|> input (:as I64) (..and (..bit index)) (n.= 0) .not)) -(def: #export (clear? idx input) +(def: #export (clear? index input) (-> Nat (I64 Any) Bit) - (.not (..set? idx input))) + (.not (..set? index input))) (template [ ] [(def: #export ( distance input) @@ -117,9 +122,10 @@ [right_rotated ..right_shifted ..left_shifted] ) -(def: #export (region size offset) +(def: #export (region offset size) + {#.doc (doc "A mask for a block of bits of the given size, starting at the given offset.")} (-> Nat Nat Mask) - (..left_shifted offset (..mask size))) + (..left_rotated offset (..mask size))) (implementation: #export equivalence (All [a] (Equivalence (I64 a))) @@ -183,6 +189,8 @@ swap/01))) (interface: #export (Sub size) + {#.doc (doc "A sub-space of I64 with a reduce amount of bits.")} + (: (Equivalence (I64 size)) &equivalence) (: Nat @@ -193,6 +201,7 @@ widen)) (def: #export (sub width) + {#.doc (doc "Given a width in the interval (0,64), yields an implementation for integers of that width.")} (Ex [size] (-> Nat (Maybe (Sub size)))) (if (.and (n.> 0 width) (n.< ..width width)) diff --git a/stdlib/source/library/lux/math/number/i8.lux b/stdlib/source/library/lux/math/number/i8.lux index 16da5b679..1f02b508b 100644 --- a/stdlib/source/library/lux/math/number/i8.lux +++ b/stdlib/source/library/lux/math/number/i8.lux @@ -13,6 +13,7 @@ (maybe.assume (i64.sub 8))) (def: #export I8 + {#.doc (doc "An 8-bit integer.")} (:by_example [size] (Sub size) ..sub diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 924401e04..26d7d44c7 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -198,7 +198,7 @@ (macro' (get@ #.modules compiler) this_module module name))] (#try.Success [compiler macro])))))) -(def: #export count +(def: #export seed (Meta Nat) (function (_ compiler) (#try.Success [(update@ #.seed inc compiler) @@ -484,11 +484,11 @@ (|>> (get@ #.imports) (list.any? (text\= import))) ..current_module)) -(def: #export (resolve_tag tag) +(def: #export (tag tag_name) {#.doc "Given a tag, finds out what is its index, its related tag-list and its associated type."} (-> Name (Meta [Nat (List Name) Type])) (do ..monad - [#let [[module name] tag] + [#let [[module name] tag_name] =module (..module module) this_module_name ..current_module_name imported! (..imported? module)] @@ -497,11 +497,11 @@ (if (or (text\= this_module_name module) (and imported! exported?)) (in [idx tag_list type]) - (..failure ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name))) + (..failure ($_ text\compose "Cannot access tag: " (name\encode tag_name) " from module " this_module_name))) _ (..failure ($_ text\compose - "Unknown tag: " (name\encode tag) text.new_line + "Unknown tag: " (name\encode tag_name) text.new_line " Known tags: " (|> =module (get@ #.tags) (list\map (|>> product.left [module] name\encode (text.prefix text.new_line))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 539408dfc..c281f119f 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -168,7 +168,7 @@ (def: #export (except exception value) (All [e] (-> (exception.Exception e) e Bytecode)) - (..failure (exception.construct exception value))) + (..failure (exception.error exception value))) (def: #export (resolve environment bytecode) (All [a] (-> Environment (Bytecode a) (Resource [Environment (Row Exception) Instruction a]))) diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index e2c12039e..6c85e6e61 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -55,7 +55,7 @@ (let [' ] (with_expansions [ (as_is (recur (.inc idx)))] (loop [idx 0] - (case (row.nth idx pool) + (case (row.item idx pool) (#try.Success entry) (case entry [index ( reference)] diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux index a1f9d285b..ec7931743 100644 --- a/stdlib/source/library/lux/target/jvm/loader.lux +++ b/stdlib/source/library/lux/target/jvm/loader.lux @@ -121,10 +121,10 @@ (:assume class) (#try.Failure error) - (error! (exception.construct ..cannot_define [class_name error]))) + (error! (exception.error ..cannot_define [class_name error]))) #.None - (error! (exception.construct ..unknown [class_name]))))))))) + (error! (exception.error ..unknown [class_name]))))))))) (def: #export (store name bytecode library) (-> Text Binary Library (IO (Try Any))) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index 150833a70..e80fdbecd 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -343,14 +343,14 @@ (..arguments inputs)) :abstraction)) - (def: #export (nth idx array) + (def: #export (item idx array) (-> Expression Expression Access) (|> (format (:representation array) "[" (:representation idx) "]") :abstraction)) (def: #export (global name) (-> Text Global) - (|> (..var "GLOBALS") (..nth (..string name)) :transmutation)) + (|> (..var "GLOBALS") (..item (..string name)) :transmutation)) (def: #export (? test then else) (-> Expression Expression Expression Computation) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 9907e7c84..20aeb8d4b 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -241,7 +241,7 @@ (-> Expression Expression) (..apply/1 (..var "as.integer"))) - (def: #export (nth idx list) + (def: #export (item idx list) (-> Expression Expression Expression) (..self_contained (format (:representation list) "[[" (:representation idx) "]]"))) @@ -372,7 +372,7 @@ (..self_contained (format (:representation var) " <- " (:representation value)))) - (def: #export (set_nth! idx value list) + (def: #export (set_item! idx value list) (-> Expression Expression SVar Expression) (..self_contained (format (:representation list) "[[" (:representation idx) "]] <- " (:representation value)))) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 59a5a6a12..e3007a55f 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -171,7 +171,7 @@ (def: #export (times amount test) (-> Nat Test Test) (case amount - 0 (..failure (exception.construct ..must_try_test_at_least_once [])) + 0 (..failure (exception.error ..must_try_test_at_least_once [])) _ (do random.monad [seed random.nat] (function (recur prng) @@ -198,7 +198,7 @@ report (: (-> (Set Name) Text) (|>> set.to_list (list.sort (\ name.order <)) - (exception.enumerate %.name))) + (exception.listing %.name))) expected_definitions_to_cover (set.size (get@ #expected_coverage tally)) unexpected_definitions_covered (set.size unexpected) actual_definitions_covered (n.- unexpected_definitions_covered @@ -390,7 +390,7 @@ output (#try.Failure error) - (..assertion (exception.construct ..error_during_execution [error]) false)) + (..assertion (exception.error ..error_during_execution [error]) false)) io.io async.future async\join)) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 1a8617f53..ecd883cfe 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -186,7 +186,7 @@ post_payload (..get_current_payload pre_payoad)] (in [requirements post_payload]))) -(def: (iteration archive expander reader source pre_payload) +(def: (iteration' archive expander reader source pre_payload) (All [directive] (-> Archive Expander Reader Source (Payload directive) (All [anchor expression] @@ -198,7 +198,7 @@ [requirements post_payload] (process_directive archive expander pre_payload code)] (in [source requirements post_payload]))) -(def: (iterate archive expander module source pre_payload aliases) +(def: (iteration archive expander module source pre_payload aliases) (All [directive] (-> Archive Expander Module Source (Payload directive) Aliases (All [anchor expression] @@ -208,7 +208,7 @@ [reader (///directive.lift_analysis (..reader module aliases source))] (function (_ state) - (case (///phase.run' state (..iteration archive expander reader source pre_payload)) + (case (///phase.run' state (..iteration' archive expander reader source pre_payload)) (#try.Success [state source&requirements&buffer]) (#try.Success [state (#.Some source&requirements&buffer)]) @@ -243,7 +243,7 @@ (..begin dependencies hash input)) #let [module (get@ #///.module input)]] (loop [iteration (<| (///phase.run' state) - (..iterate archive expander module source buffer ///syntax.no_aliases))] + (..iteration archive expander module source buffer ///syntax.no_aliases))] (do ! [[state ?source&requirements&temporary_payload] iteration] (case ?source&requirements&temporary_payload @@ -284,5 +284,5 @@ (get@ #///directive.referrals) (monad.map ! (execute! archive))) temporary_payload (..get_current_payload temporary_payload)] - (..iterate archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) + (..iteration archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) )))))})))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 1848c28bc..8a3f17237 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -8,7 +8,7 @@ ["." monad (#+ Monad do)]] [control ["." function] - ["." try (#+ Try) ("#\." functor)] + ["." try (#+ Try) ("#\." monad)] ["." exception (#+ exception:)] [concurrency ["." async (#+ Async Resolver) ("#\." monad)] @@ -366,6 +366,12 @@ ["Importer" (%.text importer)] ["importee" (%.text importee)])) + (exception: #export (cannot_import_twice {importer Module} + {duplicates (Set Module)}) + (exception.report + ["Importer" (%.text importer)] + ["Duplicates" (%.list %.text (set.to_list duplicates))])) + (def: (verify_dependencies importer importee dependence) (-> Module Module Dependence (Try Any)) (cond (text\= importer importee) @@ -541,20 +547,34 @@ module)] (loop [[archive state] [archive state] compilation (base_compiler (:as ///.Input input)) - all_dependencies (: (List Module) - (list))] - (let [new_dependencies (get@ #///.dependencies compilation) - all_dependencies (list\compose new_dependencies all_dependencies) - continue! (:sharing [] - - platform - - (-> (///.Compilation .Module Any) (List Module) - (Action [Archive ])) - (:assume - recur))] - (do ! - [[archive state] (case new_dependencies + all_dependencies (: (Set Module) + (set.of_list text.hash (list)))] + (do ! + [#let [new_dependencies (get@ #///.dependencies compilation) + continue! (:sharing [] + + platform + + (-> (///.Compilation .Module Any) (Set Module) + (Action [Archive ])) + (:assume recur)) + ## TODO: Come up with a less hacky way to prevent duplicate imports. + ## This currently assumes that all imports will be specified once in a single .module: form. + ## This might not be the case in the future. + [all_dependencies duplicates _] (: [(Set Module) (Set Module) Bit] + (list\fold (function (_ new [all duplicates seen_prelude?]) + (if (set.member? all new) + (if (text\= .prelude_module new) + (if seen_prelude? + [all (set.add new duplicates) seen_prelude?] + [all duplicates true]) + [all (set.add new duplicates) seen_prelude?]) + [(set.add new all) duplicates seen_prelude?])) + (: [(Set Module) (Set Module) Bit] + [all_dependencies ..empty (set.empty? all_dependencies)]) + new_dependencies))] + [archive state] (if (set.empty? duplicates) + (case new_dependencies #.End (in [archive state]) @@ -567,36 +587,37 @@ (list\map product.left) (list\fold archive.merged archive))]] (in [archive (try.assumed - (..updated_state archive state))])))] - (case ((get@ #///.process compilation) - ## TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP. - ## TODO: The context shouldn't need to be re-set either. - (|> (///directive.set_current_module module) - (///phase.run' state) - try.assumed - product.left) - archive) - (#try.Success [state more|done]) - (case more|done - (#.Left more) - (continue! [archive state] more all_dependencies) - - (#.Right [descriptor document output]) - (do ! - [#let [_ (debug.log! (..module_compilation_log module state)) - descriptor (set@ #descriptor.references (set.of_list text.hash all_dependencies) descriptor)] - _ (..cache_module static platform module_id [descriptor document output])] - (case (archive.add module [descriptor document output] archive) - (#try.Success archive) - (in [archive - (..with_reset_log state)]) - - (#try.Failure error) - (async\in (#try.Failure error))))) - - (#try.Failure error) + (..updated_state archive state))]))) + (async\in (exception.except ..cannot_import_twice [module duplicates])))] + (case ((get@ #///.process compilation) + ## TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP. + ## TODO: The context shouldn't need to be re-set either. + (|> (///directive.set_current_module module) + (///phase.run' state) + try.assumed + product.left) + archive) + (#try.Success [state more|done]) + (case more|done + (#.Left more) + (continue! [archive state] more all_dependencies) + + (#.Right [descriptor document output]) (do ! - [_ (ioW.freeze (get@ #&file_system platform) static archive)] - (async\in (#try.Failure error))))))))))] + [#let [_ (debug.log! (..module_compilation_log module state)) + descriptor (set@ #descriptor.references all_dependencies descriptor)] + _ (..cache_module static platform module_id [descriptor document output])] + (case (archive.add module [descriptor document output] archive) + (#try.Success archive) + (in [archive + (..with_reset_log state)]) + + (#try.Failure error) + (async\in (#try.Failure error))))) + + (#try.Failure error) + (do ! + [_ (ioW.freeze (get@ #&file_system platform) static archive)] + (async\in (#try.Failure error)))))))))] (compiler archive.runtime_module compilation_module))) ))) 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 02100305d..7dc985749 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -471,7 +471,7 @@ (def: #export (except exception parameters) (All [e] (-> (Exception e) e Operation)) - (..failure (exception.construct exception parameters))) + (..failure (exception.error exception parameters))) (def: #export (assertion exception parameters condition) (All [e] (-> (Exception e) e Bit (Operation Any))) @@ -486,7 +486,7 @@ (def: #export (except' exception parameters) (All [e] (-> (Exception e) e (phase.Operation Lux))) - (..failure' (exception.construct exception parameters))) + (..failure' (exception.error exception parameters))) (def: #export (with_stack exception message action) (All [e o] (-> (Exception e) e (Operation o) (Operation o))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux index ecc765794..95f38c760 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux @@ -16,14 +16,14 @@ (exception: #export (expansion_failed {macro Name} {inputs (List Code)} {error Text}) (exception.report ["Macro" (%.name macro)] - ["Inputs" (exception.enumerate %.code inputs)] + ["Inputs" (exception.listing %.code inputs)] ["Error" error])) (exception: #export (must_have_single_expansion {macro Name} {inputs (List Code)} {outputs (List Code)}) (exception.report ["Macro" (%.name macro)] - ["Inputs" (exception.enumerate %.code inputs)] - ["Outputs" (exception.enumerate %.code outputs)])) + ["Inputs" (exception.listing %.code inputs)] + ["Outputs" (exception.listing %.code outputs)])) (type: #export Expander (-> Macro (List Code) Lux (Try (Try [Lux (List Code)])))) @@ -38,7 +38,7 @@ (#try.Success output) (#try.Failure error) - ((meta.failure (exception.construct ..expansion_failed [name inputs error])) state))))) + ((meta.failure (exception.error ..expansion_failed [name inputs error])) state))))) (def: #export (expand_one expander name macro inputs) (-> Expander Name Macro (List Code) (Meta Code)) @@ -49,4 +49,4 @@ (in single) _ - (meta.failure (exception.construct ..must_have_single_expansion [name inputs expansion]))))) + (meta.failure (exception.error ..must_have_single_expansion [name inputs expansion]))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index bbe6da451..856a044fb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -258,7 +258,7 @@ (exception.report ["Definition" (name.short name)] ["Module" (name.module name)] - ["Known Definitions" (exception.enumerate function.identity known_definitions)])) + ["Known Definitions" (exception.listing function.identity known_definitions)])) (def: #export (remember archive name) (All [anchor expression directive] 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 c7b843385..fe7de804f 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 @@ -255,7 +255,7 @@ size_sum (list.size flat_sum) num_cases (maybe.else size_sum num_tags) idx (/.tag lefts right?)] - (.case (list.nth idx flat_sum) + (.case (list.item idx flat_sum) (^multi (#.Some caseT) (n.< num_cases idx)) (do ///.monad @@ -288,7 +288,7 @@ (/.with_location location (do ///.monad [tag (///extension.lift (meta.normal tag)) - [idx group variantT] (///extension.lift (meta.resolve_tag tag)) + [idx group variantT] (///extension.lift (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 7799be183..a0d02badc 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 @@ -1,12 +1,12 @@ (.module: [library - [lux #* + [lux (#- Variant) [abstract equivalence ["." monad (#+ do)]] [control ["." try (#+ Try) ("#\." monad)] - ["ex" exception (#+ exception:)]] + ["." exception (#+ exception:)]] [data ["." bit ("#\." equivalence)] ["." maybe] @@ -166,8 +166,9 @@ ## Because of that, the presence of redundant patterns is assumed to ## be a bug, likely due to programmer carelessness. (exception: #export (redundant_pattern {so_far Coverage} {addition Coverage}) - (ex.report ["Coverage so-far" (%coverage so_far)] - ["Coverage addition" (%coverage addition)])) + (exception.report + ["Coverage so-far" (%coverage so_far)] + ["Coverage addition" (%coverage addition)])) (def: (flat_alt coverage) (-> Coverage (List Coverage)) @@ -210,8 +211,9 @@ (open: "coverage/." ..equivalence) (exception: #export (variants_do_not_match {addition_cases Nat} {so_far_cases Nat}) - (ex.report ["So-far Cases" (%.nat so_far_cases)] - ["Addition Cases" (%.nat addition_cases)])) + (exception.report + ["So-far Cases" (%.nat so_far_cases)] + ["Addition Cases" (%.nat addition_cases)])) ## After determining the coverage of each individual pattern, it is ## necessary to merge them all to figure out if the entire @@ -234,10 +236,10 @@ (cond (and (known_cases? addition_cases) (known_cases? so_far_cases) (not (n.= addition_cases so_far_cases))) - (ex.except ..variants_do_not_match [addition_cases so_far_cases]) + (exception.except ..variants_do_not_match [addition_cases so_far_cases]) (\ (dictionary.equivalence ..equivalence) = casesSF casesA) - (ex.except ..redundant_pattern [so_far addition]) + (exception.except ..redundant_pattern [so_far addition]) ## else (do {! try.monad} @@ -291,11 +293,11 @@ ## There is nothing the addition adds to the coverage. [#1 #1] - (ex.except ..redundant_pattern [so_far addition])) + (exception.except ..redundant_pattern [so_far addition])) ## The addition cannot possibly improve the coverage. [_ #Exhaustive] - (ex.except ..redundant_pattern [so_far addition]) + (exception.except ..redundant_pattern [so_far addition]) ## The addition completes the coverage. [#Exhaustive _] @@ -304,7 +306,7 @@ ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] (coverage/= left single)) - (ex.except ..redundant_pattern [so_far addition]) + (exception.except ..redundant_pattern [so_far addition]) ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] @@ -368,6 +370,6 @@ _ (if (coverage/= so_far addition) ## The addition cannot possibly improve the coverage. - (ex.except ..redundant_pattern [so_far addition]) + (exception.except ..redundant_pattern [so_far addition]) ## There are now 2 alternative paths. (try\in (#Alt so_far addition))))) 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 7fb985f4b..d50f72630 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 @@ -58,7 +58,7 @@ (recur value) #.None - (/.failure (ex.construct cannot_analyse [expectedT function_name arg_name body]))) + (/.failure (ex.error cannot_analyse [expectedT function_name arg_name body]))) (^template [ ] [( _) 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 05a147c3d..8daf5242f 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 @@ -37,7 +37,7 @@ (exception: #export (cannot_infer {type Type} {args (List Code)}) (exception.report ["Type" (%.type type)] - ["Arguments" (exception.enumerate %.code args)])) + ["Arguments" (exception.listing %.code args)])) (exception: #export (cannot_infer_argument {inferred Type} {argument Code}) (exception.report @@ -264,7 +264,7 @@ (cond (or (n.= expected_size actual_size) (and (n.> expected_size actual_size) (n.< boundary tag))) - (case (list.nth tag cases) + (case (list.item tag cases) (#.Some caseT) (///\in (if (n.= 0 depth) (type.function (list caseT) currentT) 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 0af3736ac..b0d9920df 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 @@ -67,7 +67,7 @@ ["Old annotations" (%.code old)] ["New annotations" (%.code new)])) -(def: #export (new hash) +(def: #export (empty hash) (-> Nat Module) {#.module_hash hash #.module_aliases (list) @@ -158,7 +158,7 @@ (///extension.lift (function (_ state) (#try.Success [(update@ #.modules - (plist.put name (new hash)) + (plist.put name (..empty hash)) state) []])))) 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 4ecca3d1a..1a787efec 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 @@ -102,7 +102,7 @@ (case expectedT (#.Sum _) (let [flat (type.flat_variant expectedT)] - (case (list.nth tag flat) + (case (list.item tag flat) (#.Some variant_type) (do ! [valueA (//type.with_type variant_type @@ -263,7 +263,7 @@ (-> Phase Name Phase) (do {! ///.monad} [tag (///extension.lift (meta.normal tag)) - [idx group variantT] (///extension.lift (meta.resolve_tag tag)) + [idx group variantT] (///extension.lift (meta.tag tag)) #let [case_size (list.size group) [lefts right?] (/.choice case_size idx)] expectedT (///extension.lift meta.expected_type)] @@ -308,7 +308,7 @@ (#.Item [head_k head_v] _) (do {! ///.monad} [head_k (///extension.lift (meta.normal head_k)) - [_ tag_set recordT] (///extension.lift (meta.resolve_tag head_k)) + [_ tag_set recordT] (///extension.lift (meta.tag head_k)) #let [size_record (list.size record) size_ts (list.size tag_set)] _ (if (n.= size_ts size_record) 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 aa78e8ade..60f625250 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 @@ -73,7 +73,7 @@ (exception: #export [a] (invalid_syntax {name Name} {%format (Format a)} {inputs (List a)}) (exception.report ["Extension" (%.text name)] - ["Inputs" (exception.enumerate %format inputs)])) + ["Inputs" (exception.listing %format inputs)])) (exception: #export [s i o] (unknown {name Name} {bundle (Bundle s i o)}) (exception.report @@ -81,7 +81,7 @@ ["Available" (|> bundle dictionary.keys (list.sort text\<) - (exception.enumerate %.text))])) + (exception.listing %.text))])) (type: #export (Extender s i o) (-> Any (Handler s i o))) 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 0a60511ab..8d38f4754 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 @@ -230,8 +230,8 @@ (exception.report ["Class" class] ["Method" method] - ["Arguments" (exception.enumerate ..signature inputsJT)] - ["Hints" (exception.enumerate %.type (list\map product.left hints))]))] + ["Arguments" (exception.listing ..signature inputsJT)] + ["Hints" (exception.listing %.type (list\map product.left hints))]))] [no_candidates] [too_many_candidates] @@ -1589,7 +1589,7 @@ (template [] [(exception: #export ( {methods (List [Text (Type Method)])}) (exception.report - ["Methods" (exception.enumerate + ["Methods" (exception.listing (function (_ [name type]) (format (%.text name) " " (..signature type))) methods)]))] @@ -1889,7 +1889,7 @@ (exception: #export (unknown_super {name Text} {supers (List (Type Class))}) (exception.report ["Name" (%.text name)] - ["Available" (exception.enumerate (|>> jvm_parser.read_class product.left) supers)])) + ["Available" (exception.listing (|>> jvm_parser.read_class product.left) supers)])) (exception: #export (mismatched_super_parameters {name Text} {expected Nat} {actual Nat}) (exception.report @@ -2052,9 +2052,9 @@ {actual (List (Type Parameter))}) (exception.report ["Expected (amount)" (%.nat (list.size expected))] - ["Expected (parameters)" (exception.enumerate %.text expected)] + ["Expected (parameters)" (exception.listing %.text expected)] ["Actual (amount)" (%.nat (list.size actual))] - ["Actual (parameters)" (exception.enumerate ..signature actual)])) + ["Actual (parameters)" (exception.listing ..signature actual)])) (def: (super_aliasing class_loader class) (-> java/lang/ClassLoader (Type Class) (Operation Aliasing)) @@ -2141,7 +2141,7 @@ super_interfaces)) selfT (///.lift (do meta.monad [where meta.current_module_name - id meta.count] + id meta.seed] (in (inheritance_relationship_type (#.Primitive (..anonymous_class_name where id) (list)) super_classT super_interfaceT+)))) 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 906b54e23..470078b0f 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,8 +90,8 @@ (do <>.monad [raw .text] (case (text.size raw) - 1 (in (|> raw (text.nth 0) maybe.assume)) - _ (<>.failure (exception.construct ..char_text_must_be_size_1 [raw]))))) + 1 (in (|> raw (text.char 0) maybe.assume)) + _ (<>.failure (exception.error ..char_text_must_be_size_1 [raw]))))) (def: lux::syntax_char_case! (..custom @@ -164,9 +164,9 @@ (case args (^ (list typeC valueC)) (do {! ////.monad} - [count (///.lift meta.count) + [seed (///.lift meta.seed) actualT (\ ! map (|>> (:as Type)) - (eval archive count Type typeC)) + (eval archive seed Type typeC)) _ (typeA.infer actualT)] (typeA.with_type actualT (analyse archive valueC))) @@ -180,9 +180,9 @@ (case args (^ (list typeC valueC)) (do {! ////.monad} - [count (///.lift meta.count) + [seed (///.lift meta.seed) actualT (\ ! map (|>> (:as Type)) - (eval archive count Type typeC)) + (eval archive seed Type typeC)) _ (typeA.infer actualT) [valueT valueA] (typeA.with_inference (analyse archive valueC))] 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 2c78f5988..8f61e7ea8 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 @@ -345,7 +345,7 @@ (in elementJT) #.None - (<>.failure (exception.construct ..not_an_object_array arrayJT))) + (<>.failure (exception.error ..not_an_object_array arrayJT))) #.None (undefined)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux index a66a198c7..b728760c0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux @@ -43,7 +43,7 @@ (def: (array::read [indexG arrayG]) (Binary Expression) - (_.nth (_.+ (_.int +1) indexG) arrayG)) + (_.item (_.+ (_.int +1) indexG) arrayG)) (def: (array::write [indexG valueG arrayG]) (Trinary Expression) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux index 39ddd3df9..f7a42c5d2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux @@ -39,7 +39,7 @@ (def: (array::read [indexG arrayG]) (Binary Expression) - (_.nth indexG arrayG)) + (_.item indexG arrayG)) (def: (array::write [indexG valueG arrayG]) (Trinary Expression) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index 56393387f..57e53f579 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -42,7 +42,7 @@ (def: (array::read [indexG arrayG]) (Binary (Expression Any)) - (_.nth indexG arrayG)) + (_.item indexG arrayG)) (def: (array::write [indexG valueG arrayG]) (Trinary (Expression Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux index 9e6df81c7..cb2e4d28b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux @@ -43,7 +43,7 @@ (def: (array::read [indexG arrayG]) (Binary Expression) - (_.nth indexG arrayG)) + (_.item indexG arrayG)) (def: (array::write [indexG valueG arrayG]) (Trinary Expression) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux index 6b390352b..b69836192 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -90,7 +90,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -104,7 +104,7 @@ (<>.some .local_identifier))))} code) (do meta.monad - [runtime_id meta.count] + [runtime_id meta.seed] (macro.with_gensyms [g!_] (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (~ (code.text (%.code runtime)))))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 5ac8a93ec..d351cd6ac 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -88,7 +88,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 0e1b681c4..6d1fda16c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -113,7 +113,7 @@ (def: peek Expression - (_.nth (_.length @cursor) @cursor)) + (_.item (_.length @cursor) @cursor)) (def: save! Statement @@ -214,7 +214,7 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\in (|> ..peek (_.nth (_.int +1)) ..push!)) + (///////phase\in (|> ..peek (_.item (_.int +1)) ..push!)) (^template [ ] [(^ ( lefts)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 9affe12f6..28c33a86a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -82,7 +82,7 @@ initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! - (_.local/1 (..input post) (_.nth (|> post inc .int _.int) @curried)))) + (_.local/1 (..input post) (_.item (|> post inc .int _.int) @curried)))) initialize_self! (list.indices arity)) pack (|>> (list) _.array) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 7d92f48d3..935caf949 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -105,7 +105,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -122,7 +122,7 @@ (<>.some .local_identifier))))} code) (do meta.monad - [runtime_id meta.count] + [runtime_id meta.seed] (macro.with_gensyms [g!_] (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (~ (code.text (%.code runtime)))))] @@ -158,16 +158,16 @@ (_.function (~ g!_) (list (~+ inputsC)) (~ code)))))))))))))))) -(def: (nth index table) +(def: (item index table) (-> Expression Expression Location) - (_.nth (_.+ (_.int +1) index) table)) + (_.item (_.+ (_.int +1) index) table)) (def: last_index (|>> _.length (_.- (_.int +1)))) (with_expansions [ (as_is ($_ _.then (_.set (list lefts) (_.- last_index_right lefts)) - (_.set (list tuple) (..nth last_index_right tuple))))] + (_.set (list tuple) (..item last_index_right tuple))))] (runtime: (tuple//left lefts tuple) (with_vars [last_index_right] (<| (_.while (_.bool true)) @@ -175,7 +175,7 @@ (_.local/1 last_index_right (..last_index tuple)) (_.if (_.> lefts last_index_right) ## No need for recursion - (_.return (..nth lefts tuple)) + (_.return (..item lefts tuple)) ## Needs recursion ))))) @@ -186,7 +186,7 @@ (_.local/1 last_index_right (..last_index tuple)) (_.local/1 right_index (_.+ (_.int +1) lefts)) (_.cond (list [(_.= last_index_right right_index) - (_.return (..nth right_index tuple))] + (_.return (..item right_index tuple))] [(_.> last_index_right right_index) ## Needs recursion. ]) @@ -246,7 +246,7 @@ ($_ _.then (_.let (list tail) ..none) (<| (_.for_step idx (_.length raw) (_.int +1) (_.int -1)) - (_.set (list tail) (..some (_.array (list (_.nth idx raw) + (_.set (list tail) (..some (_.array (list (_.item idx raw) tail))))) (_.return tail)))) @@ -399,7 +399,7 @@ (runtime: (array//write idx value array) ($_ _.then - (_.set (list (..nth idx array)) value) + (_.set (list (..item idx array)) value) (_.return array))) (def: runtime//array diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 5eb23e1a9..549d19954 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -50,7 +50,7 @@ (in (|> bodyG (list (_.set (..register register) valueG)) _.array/* - (_.nth (_.int +1)))))) + (_.item (_.int +1)))))) (def: #export (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) @@ -112,8 +112,8 @@ (def: peek Expression - (_.nth (|> @cursor _.count/1 (_.- (_.int +1))) - @cursor)) + (_.item (|> @cursor _.count/1 (_.- (_.int +1))) + @cursor)) (def: save! Statement @@ -216,7 +216,7 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\in (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\in (|> ..peek (_.item (_.int +0)) ..push!)) (^template [ ] [(^ ( lefts)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux index 08a124e2c..f3ad84b3d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux @@ -86,7 +86,7 @@ (bundle.install "index" (trinary text//index)) (bundle.install "size" (unary _.strlen/1)) (bundle.install "char" (binary (function (text//char [text idx]) - (|> text (_.nth idx) _.ord/1)))) + (|> text (_.item idx) _.ord/1)))) (bundle.install "clip" (trinary (function (text//clip [from to text]) (_.substr/3 [text from (_.- from to)])))) ))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux index 9f02325d3..6318a9d88 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -87,7 +87,7 @@ initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! - (_.set! (..input post) (_.nth (|> post .int _.int) @curried)))) + (_.set! (..input post) (_.item (|> post .int _.int) @curried)))) initialize_self! (list.indices arity))] #let [[definition instantiation] (..with_closure closureG+ @selfG @selfL diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 630e222e5..0c3c94f1f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -118,5 +118,5 @@ (|> argsO+ list.enumeration (list\map (function (_ [idx _]) - (_.nth (_.int (.int idx)) @temp)))) + (_.item (_.int (.int idx)) @temp)))) (_.go_to @scope)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux index 6c08b4ed0..a18335967 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux @@ -73,7 +73,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -90,7 +90,7 @@ (<>.some .local_identifier))))} code) (do meta.monad - [runtime_id meta.count] + [runtime_id meta.seed] (macro.with_gensyms [g!_] (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.constant (~ (code.text (%.code runtime)))))] @@ -149,7 +149,7 @@ "_lux_size") (def: tuple_size - (_.nth (_.string ..tuple_size_field))) + (_.item (_.string ..tuple_size_field))) (def: jphp? (_.=== (_.string "5.6.99") (_.phpversion/0 []))) @@ -162,7 +162,7 @@ (runtime: (array//write idx value array) ($_ _.then - (_.set! (_.nth idx array) value) + (_.set! (_.item idx array) value) (_.return array))) (def: runtime//array @@ -180,7 +180,7 @@ (with_expansions [ (as_is ($_ _.then (_.set! lefts (_.- last_index_right lefts)) - (_.set! tuple (_.nth last_index_right tuple))))] + (_.set! tuple (_.item last_index_right tuple))))] (runtime: (tuple//make size values) (_.if ..jphp? ($_ _.then @@ -202,7 +202,7 @@ (_.set! last_index_right (..normal_last_index tuple))) (_.if (_.> lefts last_index_right) ## No need for recursion - (_.return (_.nth lefts tuple)) + (_.return (_.item lefts tuple)) ## Needs recursion ))))) @@ -215,7 +215,7 @@ (_.set! output (_.array/* (list))) (<| (_.while (|> index (_.+ offset) (_.< size))) ($_ _.then - (_.set! (_.nth index output) (_.nth (_.+ offset index) input)) + (_.set! (_.item index output) (_.item (_.+ offset index) input)) (_.set! index (_.+ (_.int +1) index)) )) (_.return (..tuple//make (_.- offset size) output)) @@ -230,7 +230,7 @@ (_.set! last_index_right (..normal_last_index tuple))) (_.set! right_index (_.+ (_.int +1) lefts)) (_.cond (list [(_.=== last_index_right right_index) - (_.return (_.nth right_index tuple))] + (_.return (_.item right_index tuple))] [(_.> last_index_right right_index) ## Needs recursion. ]) @@ -274,12 +274,12 @@ (runtime: (sum//get sum wantsLast wantedTag) (let [no_match! (_.return _.null) - sum_tag (_.nth (_.string ..variant_tag_field) sum) - ## sum_tag (_.nth (_.int +0) sum) - sum_flag (_.nth (_.string ..variant_flag_field) sum) - ## sum_flag (_.nth (_.int +1) sum) - sum_value (_.nth (_.string ..variant_value_field) sum) - ## sum_value (_.nth (_.int +2) sum) + sum_tag (_.item (_.string ..variant_tag_field) sum) + ## sum_tag (_.item (_.int +0) sum) + sum_flag (_.item (_.string ..variant_flag_field) sum) + ## sum_flag (_.item (_.int +1) sum) + sum_value (_.item (_.string ..variant_value_field) sum) + ## sum_value (_.item (_.int +2) sum) is_last? (_.=== ..unit sum_flag) test_recursion! (_.if is_last? ## Must recurse. @@ -540,7 +540,7 @@ _.iconv/3 [(_.string "V")] _.unpack/2 - (_.nth (_.int +1))))) + (_.item (_.int +1))))) (_.throw (_.new (_.constant "Exception") (list (_.string "[Lux Error] Cannot get char from text.")))))) (def: runtime//text diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index cdfaf74fe..fa1a42e49 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -117,7 +117,7 @@ (def: peek (Expression Any) - (_.nth (_.int -1) @cursor)) + (_.item (_.int -1) @cursor)) (def: save! (Statement Any) @@ -246,7 +246,7 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\in (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\in (|> ..peek (_.item (_.int +0)) ..push!)) (^template [ ] [(^ ( lefts)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux index 58d814dcc..fd225dfe4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -83,7 +83,7 @@ initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! - (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried)))) + (_.set (list (..input post)) (_.item (|> post .int _.int) @curried)))) initialize_self! (list.indices arity))]] (with_closure function_artifact @self environment diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 830154cbd..37296dd7c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -115,7 +115,7 @@ #let [re_binds (|> argsO+ list.enumeration (list\map (function (_ [idx _]) - (_.nth (_.int (.int idx)) @temp))))]] + (_.item (_.int (.int idx)) @temp))))]] (in ($_ _.then (_.set (list @temp) (_.list argsO+)) (..setup offset re_binds diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 44ea19376..b653d67b7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -112,7 +112,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -209,7 +209,7 @@ (with_expansions [ (as_is ($_ _.then (_.set (list lefts) (_.- last_index_right lefts)) - (_.set (list tuple) (_.nth last_index_right tuple))))] + (_.set (list tuple) (_.item last_index_right tuple))))] (runtime: (tuple::left lefts tuple) (with_vars [last_index_right] (_.while (_.bool true) @@ -217,7 +217,7 @@ (_.set (list last_index_right) (..last_index tuple)) (_.if (_.> lefts last_index_right) ## No need for recursion - (_.return (_.nth lefts tuple)) + (_.return (_.item lefts tuple)) ## Needs recursion )) #.None))) @@ -229,7 +229,7 @@ (_.set (list last_index_right) (..last_index tuple)) (_.set (list right_index) (_.+ (_.int +1) lefts)) (_.cond (list [(_.= last_index_right right_index) - (_.return (_.nth right_index tuple))] + (_.return (_.item right_index tuple))] [(_.> last_index_right right_index) ## Needs recursion. ]) @@ -238,9 +238,9 @@ (runtime: (sum::get sum wantsLast wantedTag) (let [no_match! (_.return _.none) - sum_tag (_.nth (_.int +0) sum) - sum_flag (_.nth (_.int +1) sum) - sum_value (_.nth (_.int +2) sum) + sum_tag (_.item (_.int +0) sum) + sum_flag (_.item (_.int +1) sum) + sum_value (_.item (_.int +2) sum) is_last? (_.= ..unit sum_flag) test_recursion! (_.if is_last? ## Must recurse. @@ -421,7 +421,7 @@ (runtime: (array::write idx value array) ($_ _.then - (_.set (list (_.nth idx array)) value) + (_.set (list (_.item idx array)) value) (_.return array))) (def: runtime::array diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux index 8ef713643..dcaf7f395 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux @@ -90,11 +90,11 @@ (def: (push! value var) (-> Expression SVar Expression) - (_.set_nth! (next var) value var)) + (_.set_item! (next var) value var)) (def: (pop! var) (-> SVar Expression) - (_.set_nth! (top var) _.null var)) + (_.set_item! (top var) _.null var)) (def: (push_cursor! value) (-> Expression Expression) @@ -107,11 +107,11 @@ (def: restore_cursor! Expression - (_.set! $cursor (_.nth (top $savepoint) $savepoint))) + (_.set! $cursor (_.item (top $savepoint) $savepoint))) (def: peek Expression - (|> $cursor (_.nth (top $cursor)))) + (|> $cursor (_.item (top $cursor)))) (def: pop_cursor! Expression @@ -190,7 +190,7 @@ [/////synthesis.side/right true inc]) (^ (/////synthesis.member/left 0)) - (///////phase\in (_.nth (_.int +1) ..peek)) + (///////phase\in (_.item (_.int +1) ..peek)) (^template [ ] [(^ ( lefts)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux index a6497d206..850f99475 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux @@ -69,7 +69,7 @@ (def: (input_declaration register) (-> Register Expression) (_.set! (|> register inc //case.register) - (|> $curried (_.nth (|> register inc .int _.int))))) + (|> $curried (_.item (|> register inc .int _.int))))) (def: #export (function expression archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux index 0dcaf6ac8..f71070979 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux @@ -79,7 +79,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -93,7 +93,7 @@ (<>.some .local_identifier))))} code) (do meta.monad - [runtime_id meta.count] + [runtime_id meta.seed] (macro.with_gensyms [g!_] (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (~ (code.text (%.code runtime)))))] @@ -180,14 +180,14 @@ (runtime: (i64::unsigned_low input) (with_vars [low] ($_ _.then - (_.set! low (|> input (_.nth (_.string ..i64_low_field)))) + (_.set! low (|> input (_.item (_.string ..i64_low_field)))) (_.if (|> low (_.>= (_.int +0))) low (|> low (_.+ f2^32)))))) (runtime: (i64::to_float input) (let [high (|> input - (_.nth (_.string ..i64_high_field)) + (_.item (_.string ..i64_high_field)) high_shift) low (|> input i64::unsigned_low)] @@ -227,8 +227,8 @@ [i64::max i\top] ) -(def: #export i64_high (_.nth (_.string ..i64_high_field))) -(def: #export i64_low (_.nth (_.string ..i64_low_field))) +(def: #export i64_high (_.item (_.string ..i64_high_field))) +(def: #export i64_low (_.item (_.string ..i64_low_field))) (runtime: (i64::not input) (i64::new (|> input i64_high _.bit_not) @@ -524,8 +524,8 @@ (..right value)) #.None (#.Some (_.function (list error) - (..left (_.nth (_.string "message") - error)))) + (..left (_.item (_.string "message") + error)))) #.None))) (runtime: (lux::program_args program_args) @@ -565,11 +565,11 @@ (def: (product_element product index) (-> Expression Expression Expression) - (|> product (_.nth (|> index (_.+ (_.int +1)))))) + (|> product (_.item (|> index (_.+ (_.int +1)))))) (def: (product_tail product) (-> SVar Expression) - (|> product (_.nth (_.length product)))) + (|> product (_.item (_.length product)))) (def: (updated_index min_length product) (-> Expression Expression Expression) @@ -602,9 +602,9 @@ (runtime: (sum::get sum wants_last? wanted_tag) (let [no_match _.null - sum_tag (|> sum (_.nth (_.string ..variant_tag_field))) - sum_flag (|> sum (_.nth (_.string ..variant_flag_field))) - sum_value (|> sum (_.nth (_.string ..variant_value_field))) + sum_tag (|> sum (_.item (_.string ..variant_tag_field))) + sum_flag (|> sum (_.item (_.string ..variant_flag_field))) + sum_value (|> sum (_.item (_.string ..variant_value_field))) is_last? (|> sum_flag (_.= (_.string ""))) test_recursion (_.if is_last? ## Must recurse. @@ -754,7 +754,7 @@ subject))) (list ["fixed" (_.bool #1)]) (_.var "regexpr")) - (_.nth (_.int +1)))) + (_.item (_.int +1)))) (_.if (|> idx (_.= (_.int -1))) ..none (..some (i64::of_float (|> idx (_.+ startF)))))) @@ -799,16 +799,16 @@ (with_vars [output] ($_ _.then (_.set! output (_.list (list))) - (_.set_nth! (|> size (_.+ (_.int +1))) - _.null - output) + (_.set_item! (|> size (_.+ (_.int +1))) + _.null + output) output))) (runtime: (array::get array idx) (with_vars [temp] (<| (check_index_out_of_bounds array idx) ($_ _.then - (_.set! temp (|> array (_.nth (_.+ (_.int +1) idx)))) + (_.set! temp (|> array (_.item (_.+ (_.int +1) idx)))) (_.if (|> temp (_.= _.null)) ..none (..some temp)))))) @@ -816,7 +816,7 @@ (runtime: (array::put array idx value) (<| (check_index_out_of_bounds array idx) ($_ _.then - (_.set_nth! (_.+ (_.int +1) idx) value array) + (_.set_item! (_.+ (_.int +1) idx) value array) array))) (def: runtime::array diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index d1bbfae39..18185171c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -119,7 +119,7 @@ (def: peek Expression - (_.nth (_.int -1) @cursor)) + (_.item (_.int -1) @cursor)) (def: save! Statement @@ -287,7 +287,7 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\in (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\in (|> ..peek (_.item (_.int +0)) ..push!)) (^template [ ] [(^ ( lefts)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 8c849da68..e7e831a77 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -80,7 +80,7 @@ initialize! (list\fold (.function (_ post pre!) ($_ _.then pre! - (_.set (list (..input post)) (_.nth (|> post .int _.int) @curried)))) + (_.set (list (..input post)) (_.item (|> post .int _.int) @curried)))) initialize_self! (list.indices arity)) [declaration instatiation] (with_closure closureO+ function_name diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index d021df198..5c255fcc9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -89,7 +89,7 @@ #let [re_binds (|> argsO+ list.enumeration (list\map (function (_ [idx _]) - (_.nth (_.int (.int idx)) @temp))))]] + (_.item (_.int (.int idx)) @temp))))]] (in ($_ _.then (_.set (list @temp) (_.array argsO+)) (..setup offset re_binds diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index 1ab1ab616..989fdf220 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -74,7 +74,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -91,7 +91,7 @@ (<>.some .local_identifier))))} code) (do meta.monad - [runtime_id meta.count] + [runtime_id meta.seed] (macro.with_gensyms [g!_] (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.local (~ (code.text (%.code runtime)))))] @@ -132,7 +132,7 @@ (with_expansions [ (as_is ($_ _.then (_.set (list lefts) (_.- last_index_right lefts)) - (_.set (list tuple) (_.nth last_index_right tuple))))] + (_.set (list tuple) (_.item last_index_right tuple))))] (runtime: (tuple//left lefts tuple) (with_vars [last_index_right] (<| (_.while (_.bool true)) @@ -140,7 +140,7 @@ (_.set (list last_index_right) (..last_index tuple)) (_.if (_.> lefts last_index_right) ## No need for recursion - (_.return (_.nth lefts tuple)) + (_.return (_.item lefts tuple)) ## Needs recursion ))))) @@ -151,7 +151,7 @@ (_.set (list last_index_right) (..last_index tuple)) (_.set (list right_index) (_.+ (_.int +1) lefts)) (_.cond (list [(_.= last_index_right right_index) - (_.return (_.nth right_index tuple))] + (_.return (_.item right_index tuple))] [(_.> last_index_right right_index) ## Needs recursion. ]) @@ -189,9 +189,9 @@ (runtime: (sum//get sum wantsLast wantedTag) (let [no_match! (_.return _.nil) - sum_tag (_.nth (_.string ..variant_tag_field) sum) - sum_flag (_.nth (_.string ..variant_flag_field) sum) - sum_value (_.nth (_.string ..variant_value_field) sum) + sum_tag (_.item (_.string ..variant_tag_field) sum) + sum_flag (_.item (_.string ..variant_flag_field) sum) + sum_value (_.item (_.string ..variant_value_field) sum) is_last? (_.= ..unit sum_flag) test_recursion! (_.if is_last? ## Must recurse. @@ -369,7 +369,7 @@ (runtime: (array//write idx value array) ($_ _.then - (_.set (list (_.nth idx array)) value) + (_.set (list (_.item idx array)) value) (_.return array))) (def: runtime//array diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux index 2e5c8d495..72ec2ef27 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -61,7 +61,7 @@ (syntax: #export (with_vars {vars (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} - [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] + [ids (monad.seq ! (list.repeat (list.size vars) meta.seed))] (in (list (` (let [(~+ (|> vars (list.zipped/2 ids) (list\map (function (_ [id var]) @@ -75,7 +75,7 @@ (<>.some .local_identifier))))} code) (do meta.monad - [runtime_id meta.count] + [runtime_id meta.seed] (macro.with_gensyms [g!_] (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (~ (code.text (%.code runtime)))))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 4dc984bae..b19403e90 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -30,7 +30,7 @@ (exception: #export (cannot_find_foreign_variable_in_environment {foreign Register} {environment (Environment Synthesis)}) (exception.report ["Foreign" (%.nat foreign)] - ["Environment" (exception.enumerate /.%synthesis environment)])) + ["Environment" (exception.listing /.%synthesis environment)])) (def: arity_arguments (-> Arity (List Synthesis)) @@ -83,7 +83,7 @@ (def: (find_foreign environment register) (-> (Environment Synthesis) Register (Operation Synthesis)) - (case (list.nth register environment) + (case (list.item register environment) (#.Some aliased) (phase\in aliased) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index f64693134..6e83a6a6a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -110,7 +110,7 @@ (^ (reference.foreign register)) (if true_loop? - (list.nth register scope_environment) + (list.item register scope_environment) (#.Some expr))) (^ (/.branch/case [input path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux index 16b59870b..be1eead63 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -30,7 +30,7 @@ (exception: #export (cannot_find_program {modules (List Module)}) (exception.report - ["Modules" (exception.enumerate %.text modules)])) + ["Modules" (exception.listing %.text modules)])) (def: #export (context archive) (-> Archive (Try Context)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index d6c43e896..4c930475b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -169,11 +169,11 @@ (template: (!failure parser where offset source_code) (#.Left [[where offset source_code] - (exception.construct ..unrecognized_input [where (%.name (name_of parser)) source_code offset])])) + (exception.error ..unrecognized_input [where (%.name (name_of parser)) source_code offset])])) (template: (!end_of_file where offset source_code current_module) (#.Left [[where offset source_code] - (exception.construct ..end_of_file current_module)])) + (exception.error ..end_of_file current_module)])) (type: (Parser a) (-> Source (Either [Source Text] [Source a]))) @@ -263,7 +263,7 @@ g!_ (#.Left [[where offset source_code] - (exception.construct ..text_cannot_contain_new_lines content)]))) + (exception.error ..text_cannot_contain_new_lines content)]))) (def: (text_parser where offset source_code) (-> Location Offset Text (Either [Source Text] [Source Code])) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index a45c7ad59..cd6b245ee 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -45,7 +45,7 @@ {known_modules (List Module)}) (exception.report ["Module" (%.text module)] - ["Known Modules" (exception.enumerate %.text known_modules)])) + ["Known Modules" (exception.listing %.text known_modules)])) (exception: #export (cannot_replace_document {module Module} {old (Document Any)} diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index 7feeac2a0..76266ad19 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -141,7 +141,7 @@ [5 #Directive .text] [6 #Custom .text]) - _ (<>.failure (exception.construct ..invalid_category [tag])))))] + _ (<>.failure (exception.error ..invalid_category [tag])))))] (|> (.row/64 category) (\ <>.monad map (row\fold (function (_ artifact registry) (product.right diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux index 8903ab503..e049ef8b5 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -138,7 +138,7 @@ (type: #export Enumeration (Dictionary file.Path Binary)) -(def: (enumerate_context fs directory enumeration) +(def: (context_listing fs directory enumeration) (-> (file.System Async) Context Enumeration (Async (Try Enumeration))) (do {! (try.with async.monad)} [enumeration (|> directory @@ -153,17 +153,17 @@ (\ ! join))] (|> directory (\ fs sub_directories) - (\ ! map (monad.fold ! (enumerate_context fs) enumeration)) + (\ ! map (monad.fold ! (context_listing fs) enumeration)) (\ ! join)))) (def: Action (type (All [a] (Async (Try a))))) -(def: #export (enumerate fs contexts) +(def: #export (listing fs contexts) (-> (file.System Async) (List Context) (Action Enumeration)) (monad.fold (: (Monad Action) (try.with async.monad)) - (..enumerate_context fs) + (..context_listing fs) (: Enumeration (dictionary.empty text.hash)) contexts)) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index ed4def938..0a0db986e 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -74,7 +74,7 @@ (def: #export (except exception parameters) (All [e] (-> (Exception e) e Operation)) - (..failure (ex.construct exception parameters))) + (..failure (ex.error exception parameters))) (def: #export (lift error) (All [s a] (-> (Try a) (Operation s a))) diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index ccd32f12a..c374d9bd1 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -221,6 +221,6 @@ (#try.Failure error) (if (ex.match? syntax.end_of_file error) (recur context #1) - (exec (log! (ex.construct ..error error)) + (exec (log! (ex.error ..error error)) (recur (set@ #source ..fresh_source context) #0)))))) ))) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index f12adc89b..950d71c63 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -170,7 +170,7 @@ (n\encode index) " " (..format type)))) (text.join_with (text\compose text.new_line " "))))) - (list.nth idx env)) + (list.item idx env)) _ type diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 882b723ff..dcdf4ba58 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -180,7 +180,7 @@ (def: #export (except exception message) (All [e a] (-> (Exception e) e (Check a))) - (..failure (exception.construct exception message))) + (..failure (exception.error exception message))) (def: #export existential {#.doc "A producer of existential types."} diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 167c25c0e..80e2f1ca2 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -88,7 +88,7 @@ ["" simple_name] (meta.either (do meta.monad [member (meta.normal member) - _ (meta.resolve_tag member)] + _ (meta.tag member)] (in member)) (do {! meta.monad} [this_module_name meta.current_module_name @@ -114,7 +114,7 @@ (-> Name (Meta [Nat Type])) (do meta.monad [member (member_name member) - [idx tag_list sig_type] (meta.resolve_tag member)] + [idx tag_list sig_type] (meta.tag member)] (in [idx sig_type]))) (def: (available_definitions source_module target_module constants aggregate) diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 2cda92c15..b61fb2d9f 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -119,7 +119,7 @@ (in (list)) (do ! [head .nat - _ (<>.assertion (exception.construct ..index_cannot_be_repeated head) + _ (<>.assertion (exception.error ..index_cannot_be_repeated head) (not (set.member? seen head))) tail (recur (set.add head seen))] (in (list& head tail)))))))) @@ -142,7 +142,7 @@ #let [g!outputs (|> (monad.fold maybe.monad (function (_ from to) (do maybe.monad - [input (list.nth from g!inputs)] + [input (list.item from g!inputs)] (in (row.add input to)))) (: (Row Code) row.empty) swaps) @@ -163,7 +163,7 @@ (Parser Nat) (do <>.monad [raw .nat - _ (<>.assertion (exception.construct ..amount_cannot_be_zero []) + _ (<>.assertion (exception.error ..amount_cannot_be_zero []) (n.> 0 raw))] (in raw))) diff --git a/stdlib/source/library/lux/world/db/sql.lux b/stdlib/source/library/lux/world/db/sql.lux index 656e079b4..4d29ad803 100644 --- a/stdlib/source/library/lux/world/db/sql.lux +++ b/stdlib/source/library/lux/world/db/sql.lux @@ -106,7 +106,7 @@ (-> Statement Text) (format (:representation action) ";")) - (def: enumerate + (def: listing (-> (List (SQL Any)) Text) (|>> (list\map (|>> :representation)) (text.join_with ", "))) @@ -133,7 +133,7 @@ (def: #export (call function parameters) (-> Function (List Value) Value) (:abstraction (format (:representation function) - (..parenthesize (..enumerate parameters))))) + (..parenthesize (..listing parameters))))) ## Condition (template [ ] @@ -169,7 +169,7 @@ (:abstraction (format (:representation value) " IN " - (..parenthesize (enumerate options))))) + (..parenthesize (listing options))))) (template [ ] [(def: #export ( left right) @@ -313,17 +313,17 @@ (:abstraction (format (:representation query) " GROUP BY " - (..enumerate pairs))))) + (..listing pairs))))) ## Command (def: #export (insert table columns rows) (-> Table (List Column) (List (List Value)) (Command Without_Where Without_Having)) (:abstraction (format "INSERT INTO " (:representation table) " " - (..parenthesize (..enumerate columns)) + (..parenthesize (..listing columns)) " VALUES " (|> rows - (list\map (|>> ..enumerate ..parenthesize)) + (list\map (|>> ..listing ..parenthesize)) (text.join_with ", ")) ))) @@ -399,7 +399,7 @@ "CREATE TABLE IF NOT EXISTS")] (:abstraction (format command " " (:representation table) - (..parenthesize (..enumerate columns)))))) + (..parenthesize (..listing columns)))))) (def: #export (create_table_as table query) (-> Table Any_Query Definition) @@ -462,7 +462,7 @@ (-> Index Table Bit (List Column) Definition) (:abstraction (format "CREATE " (if unique? "UNIQUE" "") " INDEX " (:representation index) - " ON " (:representation table) " " (..parenthesize (..enumerate columns))))) + " ON " (:representation table) " " (..parenthesize (..listing columns))))) (def: #export (with alias query body) (All [where having order group limit offset] -- cgit v1.2.3