From bfacc0c96e56eedf788aba44bd8ad2848a35c390 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 16 Jul 2021 02:23:00 -0400 Subject: Fixed some inconsistent naming. --- stdlib/source/library/lux.lux | 34 +++++--------- stdlib/source/library/lux/abstract/fold.lux | 2 +- .../source/library/lux/control/function/memo.lux | 6 +-- .../source/library/lux/control/function/mixin.lux | 2 +- stdlib/source/library/lux/control/parser/tree.lux | 4 +- stdlib/source/library/lux/control/state.lux | 2 +- stdlib/source/library/lux/data/collection/bits.lux | 36 +++++++-------- .../library/lux/data/collection/dictionary.lux | 8 ++-- stdlib/source/library/lux/data/collection/tree.lux | 6 +-- .../library/lux/data/collection/tree/zipper.lux | 26 +++++------ stdlib/source/library/lux/data/maybe.lux | 2 +- stdlib/source/library/lux/ffi.old.lux | 54 +++++++++++----------- stdlib/source/library/lux/ffi.rb.lux | 2 +- stdlib/source/library/lux/math/number/int.lux | 2 +- stdlib/source/library/lux/math/number/nat.lux | 28 +++++------ stdlib/source/library/lux/time/year.lux | 18 ++++---- .../lux/phase/extension/generation/jvm/host.lux | 2 +- .../lux/tool/compiler/meta/archive/document.lux | 4 +- .../library/lux/world/output/video/resolution.lux | 2 +- 19 files changed, 114 insertions(+), 126 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 9b01303ea..6d1f82632 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -2052,7 +2052,7 @@ #None} x)) -(def:''' (tuple->list tuple) +(def:''' (tuple_to_list tuple) #Nil (-> Code ($' Maybe ($' List Code))) ({[_ (#Tuple members)] @@ -2161,7 +2161,7 @@ _ (fail "Wrong syntax for template")} [(monad\map maybe_monad get_short bindings) - (monad\map maybe_monad tuple->list data)]) + (monad\map maybe_monad tuple_to_list data)]) _ (fail "Wrong syntax for template")} @@ -3294,8 +3294,7 @@ (#Cons x xs') (if ("lux i64 =" 0 idx) (#Some x) - (nth ("lux i64 -" 1 idx) xs') - ))) + (nth ("lux i64 -" 1 idx) xs')))) (def: (beta_reduce env type) (-> (List Type) Type Type) @@ -4839,7 +4838,7 @@ (case (: (Maybe (List Code)) (do maybe_monad [bindings' (monad\map maybe_monad get_short bindings) - data' (monad\map maybe_monad tuple->list data)] + data' (monad\map maybe_monad tuple_to_list data)] (let [num_bindings (list\size bindings')] (if (every? (|>> ("lux i64 =" num_bindings)) (list\map list\size data')) @@ -4943,7 +4942,7 @@ (-> (List [Code Code]) (List Code)) (|>> (list\map rejoin_pair) list\join)) -(def: (doc_example->Text prev_location baseline example) +(def: (doc_example_to_text prev_location baseline example) (-> Location Nat Code [Location Text]) (case example (^template [ ] @@ -4963,7 +4962,7 @@ (^template [ ] [[group_location ( parts)] (let [[group_location' parts_text] (list\fold (function (_ part [last_location text_accum]) - (let [[part_location part_text] (doc_example->Text last_location baseline part)] + (let [[part_location part_text] (doc_example_to_text last_location baseline part)] [part_location (text\compose text_accum part_text)])) [(delim_update_location group_location) ""] ( parts))] @@ -4977,14 +4976,14 @@ [#Record "{" "}" rejoin_all_pairs]) [new_location (#Rev value)] - ("lux io error" "@doc_example->Text Undefined behavior.") + ("lux io error" "@doc_example_to_text Undefined behavior.") )) (def: (with_baseline baseline [file line column]) (-> Nat Location Location) [file line baseline]) -(def: (doc_fragment->Text fragment) +(def: (doc_fragment_to_text fragment) (-> Doc_Fragment Text) (case fragment (#Doc_Comment comment) @@ -4996,7 +4995,7 @@ (#Doc_Example example) (let [baseline (find_baseline_column example) [location _] example - [_ text] (doc_example->Text (with_baseline baseline location) baseline example)] + [_ text] (doc_example_to_text (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) (macro: #export (doc tokens) @@ -5013,7 +5012,7 @@ " x)))"))} (return (list (` [(~ location_code) (#.Text (~ (|> tokens - (list\map (|>> identify_doc_fragment doc_fragment->Text)) + (list\map (|>> identify_doc_fragment doc_fragment_to_text)) (text\join_with "") text$)))])))) @@ -5451,17 +5450,6 @@ (#Right state scope_type_vars) )) -(def: (list_at idx xs) - (All [a] (-> Nat (List a) (Maybe a))) - (case xs - #Nil - #None - - (#Cons x xs') - (if ("lux i64 =" 0 idx) - (#Some x) - (list_at (dec idx) xs')))) - (macro: #export ($ tokens) {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." "In the example below, 0 corresponds to the 'a' variable." @@ -5475,7 +5463,7 @@ (^ (list [_ (#Nat idx)])) (do meta_monad [stvs get_scope_type_vars] - (case (list_at idx (list\reverse stvs)) + (case (..nth idx (list\reverse stvs)) (#Some var_id) (wrap (list (` (#Ex (~ (nat$ var_id)))))) diff --git a/stdlib/source/library/lux/abstract/fold.lux b/stdlib/source/library/lux/abstract/fold.lux index 168d743be..58059e634 100644 --- a/stdlib/source/library/lux/abstract/fold.lux +++ b/stdlib/source/library/lux/abstract/fold.lux @@ -10,7 +10,7 @@ (-> (-> b a a) a (F b) a)) fold)) -(def: #export (with-monoid monoid fold value) +(def: #export (with_monoid monoid fold value) (All [F a] (-> (Monoid a) (Fold F) (F a) a)) (let [(^open "/\.") monoid] diff --git a/stdlib/source/library/lux/control/function/memo.lux b/stdlib/source/library/lux/control/function/memo.lux index 5ab6c2b3b..4c50a0695 100644 --- a/stdlib/source/library/lux/control/function/memo.lux +++ b/stdlib/source/library/lux/control/function/memo.lux @@ -41,7 +41,7 @@ (All [i o] (:let [Memory (Dictionary i o)] (-> (Memo i o) (-> [Memory i] [Memory o])))) - (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo)))] + (let [memo (//.mixin (//.inherit ..memoization (//.from_recursive memo)))] (function (_ [memory input]) (|> input memo (state.run memory))))) @@ -50,7 +50,7 @@ "Memoized results will be re-used during recursive invocations, but cannot be accessed after the main invocation has ended.")} (All [i o] (-> (Hash i) (Memo i o) (-> i o))) - (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo))) + (let [memo (//.mixin (//.inherit ..memoization (//.from_recursive memo))) empty (dictionary.new hash)] (|>> memo (state.run empty) product.right))) @@ -59,6 +59,6 @@ "This is useful as a test control when measuring the effect of using memoization.")} (All [i o] (-> (Hash i) (Memo i o) (-> i o))) - (let [memo (//.mixin (//.from-recursive memo)) + (let [memo (//.mixin (//.from_recursive memo)) empty (dictionary.new hash)] (|>> memo (state.run empty) product.right))) diff --git a/stdlib/source/library/lux/control/function/mixin.lux b/stdlib/source/library/lux/control/function/mixin.lux index f70b2f9c3..8c3443339 100644 --- a/stdlib/source/library/lux/control/function/mixin.lux +++ b/stdlib/source/library/lux/control/function/mixin.lux @@ -58,7 +58,7 @@ (type: #export (Recursive i o) (-> (-> i o) (-> i o))) -(def: #export (from-recursive recursive) +(def: #export (from_recursive recursive) (All [i o] (-> (Recursive i o) (Mixin i o))) (function (_ delegate recur) (recursive recur))) diff --git a/stdlib/source/library/lux/control/parser/tree.lux b/stdlib/source/library/lux/control/parser/tree.lux index 5834c69e8..6f2080628 100644 --- a/stdlib/source/library/lux/control/parser/tree.lux +++ b/stdlib/source/library/lux/control/parser/tree.lux @@ -30,7 +30,7 @@ (function (_ zipper) (#try.Success [zipper (zipper.value zipper)]))) -(exception: #export cannot-move-further) +(exception: #export cannot_move_further) (template [ ] [(def: #export @@ -38,7 +38,7 @@ (function (_ zipper) (case ( zipper) #.None - (exception.throw ..cannot-move-further []) + (exception.throw ..cannot_move_further []) (#.Some next) (#try.Success [next []]))))] diff --git a/stdlib/source/library/lux/control/state.lux b/stdlib/source/library/lux/control/state.lux index ef0e2dbb7..b39690469 100644 --- a/stdlib/source/library/lux/control/state.lux +++ b/stdlib/source/library/lux/control/state.lux @@ -89,7 +89,7 @@ (while condition body)) (wrap [])))) -(def: #export (do-while condition body) +(def: #export (do_while condition body) (All [s] (-> (State s Bit) (State s Any) (State s Any))) (do ..monad [_ body] diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index 63e90f7c8..c90cff48c 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -17,13 +17,13 @@ (type: #export Chunk I64) -(def: #export chunk-size +(def: #export chunk_size i64.width) (type: #export Bits (Array Chunk)) -(def: empty-chunk +(def: empty_chunk Chunk (.i64 0)) @@ -40,7 +40,7 @@ (def: #export (capacity bits) (-> Bits Nat) - (|> bits array.size (n.* chunk-size))) + (|> bits array.size (n.* chunk_size))) (def: #export empty? (-> Bits Bit) @@ -48,38 +48,38 @@ (def: #export (get index bits) (-> Nat Bits Bit) - (let [[chunk-index bit-index] (n./% chunk-size index)] - (.and (n.< (array.size bits) chunk-index) - (|> (array.read chunk-index bits) - (maybe.default empty-chunk) - (i64.set? bit-index))))) + (let [[chunk_index bit_index] (n./% chunk_size index)] + (.and (n.< (array.size bits) chunk_index) + (|> (array.read chunk_index bits) + (maybe.default empty_chunk) + (i64.set? bit_index))))) (def: (chunk idx bits) (-> Nat Bits Chunk) (if (n.< (array.size bits) idx) - (|> bits (array.read idx) (maybe.default empty-chunk)) - empty-chunk)) + (|> bits (array.read idx) (maybe.default empty_chunk)) + empty_chunk)) (template [ ] [(def: #export ( index input) (-> Nat Bits Bits) - (let [[chunk-index bit-index] (n./% chunk-size index)] - (loop [size|output (n.max (inc chunk-index) + (let [[chunk_index bit_index] (n./% chunk_size index)] + (loop [size|output (n.max (inc chunk_index) (array.size input)) output ..empty] (let [idx|output (dec size|output)] (if (n.> 0 size|output) (case (|> (..chunk idx|output input) - (cond> [(new> (n.= chunk-index idx|output) [])] - [( bit-index)] + (cond> [(new> (n.= chunk_index idx|output) [])] + [( bit_index)] ## else []) .nat) 0 - ## TODO: Remove 'no-op' once new-luxc is the official compiler. - (let [no-op (recur (dec size|output) output)] - no-op) + ## TODO: Remove 'no_op' once new-luxc is the official compiler. + (let [no_op (recur (dec size|output) output)] + no_op) chunk (|> (if (is? ..empty output) @@ -102,7 +102,7 @@ (if (n.< chunks idx) (.or (|> (..chunk idx sample) (i64.and (..chunk idx reference)) - ("lux i64 =" empty-chunk) + ("lux i64 =" empty_chunk) .not) (recur (inc idx))) #0)))) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 3ae286db8..02d733d80 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -174,14 +174,14 @@ (i64.right_shift level hash))) ## A mechanism to go from indices to bit-positions. -(def: (->bit_position index) +(def: (to_bit_position index) (-> Index BitPosition) (i64.left_shift index 1)) ## The bit-position within a base that a given hash-code would have. (def: (bit_position level hash) (-> Level Hash_Code BitPosition) - (->bit_position (level_index level hash))) + (to_bit_position (level_index level hash))) (def: (bit_position_is_set? bit bitmap) (-> BitPosition BitMap Bit) @@ -241,7 +241,7 @@ (#.Some sub_node) (if (n.= except_idx idx) [insertion_idx node] [(inc insertion_idx) - [(set_bit_position (->bit_position idx) bitmap) + [(set_bit_position (to_bit_position idx) bitmap) (array.write! insertion_idx (#.Left sub_node) base)]]) ))) [0 [clean_bitmap @@ -259,7 +259,7 @@ BitMap (Base k v) (Array (Node k v)))) (product.right (list\fold (function (_ hierarchy_idx (^@ default [base_idx h_array])) - (if (bit_position_is_set? (->bit_position hierarchy_idx) + (if (bit_position_is_set? (to_bit_position hierarchy_idx) bitmap) [(inc base_idx) (case (array.read base_idx base) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index f6b3746e7..6ed986476 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -35,11 +35,11 @@ {#value value #children children}) -(type: #rec Tree-Code - [Code (List Tree-Code)]) +(type: #rec Tree_Code + [Code (List Tree_Code)]) (def: tree^ - (Parser Tree-Code) + (Parser Tree_Code) (|> (|>> <>.some .record (<>.and .any)) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index bb36e3e38..942ca5c09 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -112,7 +112,7 @@ rights)) parent)))))) -(template [ ] +(template [ ] [(def: #export ( zipper) (All [a] (-> (Zipper a) (Maybe (Zipper a)))) (case (get@ #family zipper) @@ -122,12 +122,12 @@ (#.Some (for {@.old {#family (#.Some (|> family (set@ side') - (update@ (|>> (#.Cons (get@ #node zipper)))))) + (update@ (|>> (#.Cons (get@ #node zipper)))))) #node next}} (let [move (: (All [a] (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) (function (_ side' zipper) (|>> (set@ side') - (update@ (|>> (#.Cons (get@ #node zipper)))))))] + (update@ (|>> (#.Cons (get@ #node zipper)))))))] {#family (#.Some (move side' zipper family)) #node next}))) @@ -151,13 +151,13 @@ (#.Cons last prevs) (#.Some (for {@.old {#family (#.Some (|> family (set@ #.Nil) - (update@ (|>> (#.Cons (get@ #node zipper)) + (update@ (|>> (#.Cons (get@ #node zipper)) (list\compose prevs))))) #node last}} (let [move (: (All [a] (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) (function (_ prevs zipper) (|>> (set@ #.Nil) - (update@ (|>> (#.Cons (get@ #node zipper)) + (update@ (|>> (#.Cons (get@ #node zipper)) (list\compose prevs))))))] {#family (#.Some (move prevs zipper family)) #node last}))))))] @@ -281,8 +281,8 @@ (#.Some (update@ (|>> (#.Cons (//.leaf value))) family)) zipper))))] - [insert-left #lefts] - [insert-right #rights] + [insert_left #lefts] + [insert_right #rights] ) (implementation: #export functor @@ -304,15 +304,15 @@ (def: unwrap (get@ [#node #//.value])) (def: (split (^slots [#family #node])) - (let [tree-splitter (: (All [a] (-> (Tree a) (Tree (Zipper a)))) - (function (tree-splitter tree) + (let [tree_splitter (: (All [a] (-> (Tree a) (Tree (Zipper a)))) + (function (tree_splitter tree) {#//.value (..zip tree) #//.children (|> tree (get@ #//.children) - (list\map tree-splitter))}))] + (list\map tree_splitter))}))] {#family (maybe\map (function (_ (^slots [#parent #lefts #rights])) {#parent (split parent) - #lefts (list\map tree-splitter lefts) - #rights (list\map tree-splitter rights)}) + #lefts (list\map tree_splitter lefts) + #rights (list\map tree_splitter rights)}) family) - #node (tree-splitter node)}))) + #node (tree_splitter node)}))) diff --git a/stdlib/source/library/lux/data/maybe.lux b/stdlib/source/library/lux/data/maybe.lux index d7f010f13..ed6a875ce 100644 --- a/stdlib/source/library/lux/data/maybe.lux +++ b/stdlib/source/library/lux/data/maybe.lux @@ -141,7 +141,7 @@ (All [a] (-> (Maybe a) a)) (|>> (..default (undefined)))) -(def: #export (to-list value) +(def: #export (to_list value) (All [a] (-> (Maybe a) (List a))) (case value #.None diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index fdb5d1412..c8de0eb03 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -424,7 +424,7 @@ ast' ast')) -(def: (parser->replacer p ast) +(def: (parser_to_replacer p ast) (-> (Parser Code) (-> Code Code)) (case (<>.run p (list ast)) (#.Right [#.Nil ast']) @@ -434,7 +434,7 @@ ast )) -(def: (field->parser class_name [[field_name _ _] field]) +(def: (field_to_parser class_name [[field_name _ _] field]) (-> Text [Member_Declaration FieldDecl] (Parser Code)) (case field (#ConstantField _) @@ -481,7 +481,7 @@ [make_virtual_method_parser "jvm invokevirtual"] ) -(def: (method->parser params class_name [[method_name _ _] meth_def]) +(def: (method_to_parser params class_name [[method_name _ _] meth_def]) (-> (List Type_Parameter) Text [Member_Declaration Method_Definition] (Parser Code)) (case meth_def (#ConstructorMethod strict? type_vars args constructor_args return_expr exs) @@ -1092,16 +1092,16 @@ (~ body)))))))) (#OverridenMethod strict_fp? class_decl type_vars this_name arg_decls return_type body exs) - (let [super_replacer (parser->replacer (.form (do <>.monad - [_ (.this! (' ::super!)) - args (.tuple (<>.exactly (list.size arg_decls) .any)) - #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list))) - arg_decls))]] - (wrap (`' ((~ (code.text (format "jvm invokespecial" - ":" (get@ #super_class_name super_class) - ":" name - ":" (text.join_with "," arg_decls')))) - (~' _jvm_this) (~+ args)))))))] + (let [super_replacer (parser_to_replacer (.form (do <>.monad + [_ (.this! (' ::super!)) + args (.tuple (<>.exactly (list.size arg_decls) .any)) + #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list))) + arg_decls))]] + (wrap (`' ((~ (code.text (format "jvm invokespecial" + ":" (get@ #super_class_name super_class) + ":" name + ":" (text.join_with "," arg_decls')))) + (~' _jvm_this) (~+ args)))))))] (with_parens (spaced (list "override" (class_decl$ class_decl) @@ -1210,11 +1210,11 @@ (do meta.monad [current_module meta.current_module_name #let [fully_qualified_class_name (format (sanitize current_module) "." full_class_name) - field_parsers (list\map (field->parser fully_qualified_class_name) fields) - method_parsers (list\map (method->parser (product.right class_decl) fully_qualified_class_name) methods) - replacer (parser->replacer (list\fold <>.either - (<>.fail "") - (list\compose field_parsers method_parsers))) + field_parsers (list\map (field_to_parser fully_qualified_class_name) fields) + method_parsers (list\map (method_to_parser (product.right class_decl) fully_qualified_class_name) methods) + replacer (parser_to_replacer (list\fold <>.either + (<>.fail "") + (list\compose field_parsers method_parsers))) def_code (format "jvm class:" (spaced (list (class_decl$ class_decl) (super_class_decl$ super) @@ -1449,7 +1449,7 @@ #.Nil #1 _ #0)) -(def: (type_param->type_arg [name _]) +(def: (type_param_to_type_arg [name _]) (-> Type_Parameter Code) (code.identifier ["" name])) @@ -1498,7 +1498,7 @@ full_name (sanitize full_name) all_params (|> (member_type_vars class_tvars member) (list.filter free_type_param?) - (list\map type_param->type_arg))] + (list\map type_param_to_type_arg))] (case member (#EnumDecl enum_members) (do {! meta.monad} @@ -1510,7 +1510,7 @@ _ (let [=class_tvars (|> class_tvars (list.filter free_type_param?) - (list\map type_param->type_arg))] + (list\map type_param_to_type_arg))] (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)])))))) getter_interop (: (-> Text Code) (function (_ name) @@ -1576,7 +1576,7 @@ tvar_asts (: (List Code) (|> class_tvars (list.filter free_type_param?) - (list\map type_param->type_arg))) + (list\map type_param_to_type_arg))) getter_name (code.identifier ["" (..import_name import_format method_prefix import_field_name)]) setter_name (code.identifier ["" (..import_name import_format method_prefix (format import_field_name "!"))])] getter_interop (with_gensyms [g!obj] @@ -1740,7 +1740,7 @@ (array_length my_array))} (wrap (list (` ("jvm arraylength" (~ array)))))) -(def: (type->class_name type) +(def: (type_to_class_name type) (-> Type (Meta Text)) (if (type\= Any type) (\ meta.monad wrap "java.lang.Object") @@ -1754,10 +1754,10 @@ (meta.fail (format "Cannot apply type: " (type.format F) " to " (type.format A))) (#.Some type') - (type->class_name type')) + (type_to_class_name type')) (#.Named _ type') - (type->class_name type') + (type_to_class_name type') _ (meta.fail (format "Cannot convert to JvmType: " (type.format type)))))) @@ -1769,7 +1769,7 @@ [_ (#.Identifier array_name)] (do meta.monad [array_type (meta.find_type array_name) - array_jvm_type (type->class_name array_type)] + array_jvm_type (type_to_class_name array_type)] (case array_jvm_type (^template [ ] [ @@ -1798,7 +1798,7 @@ [_ (#.Identifier array_name)] (do meta.monad [array_type (meta.find_type array_name) - array_jvm_type (type->class_name array_type)] + array_jvm_type (type_to_class_name array_type)] (case array_jvm_type (^template [ ] [ diff --git a/stdlib/source/library/lux/ffi.rb.lux b/stdlib/source/library/lux/ffi.rb.lux index 511351bad..f3f483e23 100644 --- a/stdlib/source/library/lux/ffi.rb.lux +++ b/stdlib/source/library/lux/ffi.rb.lux @@ -27,7 +27,7 @@ (template [] [(with_expansions [ (template.identifier [ "'"])] - (abstract: #export Any) + (abstract: Any) (type: #export (..Object )))] diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index c72c31e16..b5806e0db 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -131,7 +131,7 @@ +0 a _ (gcd b (..% b a)))) -(def: #export (co-prime? a b) +(def: #export (co_prime? a b) (-> Int Int Bit) (..= +1 (..gcd a b))) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index 52e252c84..ebec1b4e9 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -130,7 +130,7 @@ 0 a _ (gcd b (..% b a)))) -(def: #export (co-prime? a b) +(def: #export (co_prime? a b) (-> Nat Nat Bit) (..= 1 (..gcd a b))) @@ -194,21 +194,21 @@ [maximum ..max (\ ..interval bottom)] ) -(def: (binary-character value) +(def: (binary_character value) (-> Nat Text) (case value 0 "0" 1 "1" _ (undefined))) -(def: (binary-value digit) +(def: (binary_value digit) (-> Nat (Maybe Nat)) (case digit (^ (char "0")) (#.Some 0) (^ (char "1")) (#.Some 1) _ #.None)) -(def: (octal-character value) +(def: (octal_character value) (-> Nat Text) (case value 0 "0" @@ -221,7 +221,7 @@ 7 "7" _ (undefined))) -(def: (octal-value digit) +(def: (octal_value digit) (-> Nat (Maybe Nat)) (case digit (^ (char "0")) (#.Some 0) @@ -234,7 +234,7 @@ (^ (char "7")) (#.Some 7) _ #.None)) -(def: (decimal-character value) +(def: (decimal_character value) (-> Nat Text) (case value 0 "0" @@ -249,7 +249,7 @@ 9 "9" _ (undefined))) -(def: (decimal-value digit) +(def: (decimal_value digit) (-> Nat (Maybe Nat)) (case digit (^ (char "0")) (#.Some 0) @@ -264,7 +264,7 @@ (^ (char "9")) (#.Some 9) _ #.None)) -(def: (hexadecimal-character value) +(def: (hexadecimal_character value) (-> Nat Text) (case value 0 "0" @@ -285,7 +285,7 @@ 15 "F" _ (undefined))) -(def: (hexadecimal-value digit) +(def: (hexadecimal_value digit) (-> Nat (Maybe Nat)) (case digit (^template [ ] @@ -336,9 +336,9 @@ (#try.Success output))) (#try.Failure ("lux text concat" repr))))))] - [1 binary binary-character binary-value "Invalid binary syntax for Nat: "] - [3 octal octal-character octal-value "Invalid octal syntax for Nat: "] - [4 hex hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "] + [1 binary binary_character binary_value "Invalid binary syntax for Nat: "] + [3 octal octal_character octal_value "Invalid octal syntax for Nat: "] + [4 hex hexadecimal_character hexadecimal_value "Invalid hexadecimal syntax for Nat: "] ) (implementation: #export decimal @@ -347,7 +347,7 @@ (def: (encode value) (loop [input value output ""] - (let [digit (decimal-character (..% 10 input)) + (let [digit (decimal_character (..% 10 input)) output' ("lux text concat" digit output)] (case (../ 10 input) 0 @@ -363,7 +363,7 @@ (loop [idx 0 output 0] (if (..< input-size idx) - (case (decimal-value ("lux text char" idx repr)) + (case (decimal_value ("lux text char" idx repr)) #.None diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index 95280df9c..b3f3e7ecf 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -32,7 +32,7 @@ year (dec year))) -(exception: #export there-is-no-year-0) +(exception: #export there_is_no_year_0) (abstract: #export Year Int @@ -40,7 +40,7 @@ (def: #export (year value) (-> Int (Try Year)) (case value - +0 (exception.throw ..there-is-no-year-0 []) + +0 (exception.throw ..there_is_no_year_0 []) _ (#try.Success (:abstraction (..internal value))))) (def: #export value @@ -80,9 +80,9 @@ (or (not (..divisible? (.int ..century) year)) (..divisible? (.int ..era) year))))) -(def: (with-year-0-leap year days) - (let [after-year-0? (i.> +0 year)] - (if after-year-0? +(def: (with_year_0_leap year days) + (let [after_year_0? (i.> +0 year)] + (if after_year_0? (i.+ +1 days) days))) @@ -100,7 +100,7 @@ [i.- ..century] [i.+ ..era] )) - (..with-year-0-leap year))))) + (..with_year_0_leap year))))) (def: (encode year) (-> Year Text) @@ -114,10 +114,10 @@ (do {! <>.monad} [sign (<>.or (.this "-") (wrap [])) digits (.many .decimal) - raw-year (<>.codec i.decimal (wrap (text\compose "+" digits)))] + raw_year (<>.codec i.decimal (wrap (text\compose "+" digits)))] (<>.lift (..year (case sign - (#.Left _) (i.* -1 raw-year) - (#.Right _) raw-year))))) + (#.Left _) (i.* -1 raw_year) + (#.Right _) raw_year))))) (implementation: #export codec {#.doc (doc "Based on ISO 8601." 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 b46934a86..079fc96ec 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 @@ -1021,7 +1021,7 @@ list\join ## Remove duplicates. (set.from-list //////synthesis.hash) - set.to-list) + set.to_list) global-mapping (|> total-environment ## Give them names as "foreign" variables. list.enumeration diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux index ea5ce1006..39edd668e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux @@ -20,7 +20,7 @@ ["." key (#+ Key)] [descriptor (#+ Module)]]) -(exception: #export (invalid-signature {expected Signature} {actual Signature}) +(exception: #export (invalid_signature {expected Signature} {actual Signature}) (exception.report ["Expected" (signature.description expected)] ["Actual" (signature.description actual)])) @@ -41,7 +41,7 @@ e (:assume document//content))) - (exception.throw ..invalid-signature [(key.signature key) + (exception.throw ..invalid_signature [(key.signature key) document//signature])))) (def: #export (write key content) diff --git a/stdlib/source/library/lux/world/output/video/resolution.lux b/stdlib/source/library/lux/world/output/video/resolution.lux index 24f48182c..8822c268c 100644 --- a/stdlib/source/library/lux/world/output/video/resolution.lux +++ b/stdlib/source/library/lux/world/output/video/resolution.lux @@ -43,5 +43,5 @@ [fhd 1920 1080] [wuxga 1920 1200] [wqhd 2560 1440] - [uhd-4k 3840 2160] + [uhd_4k 3840 2160] ) -- cgit v1.2.3