From 4ca397765805eda5ddee393901ed3a02001a960a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 25 Dec 2020 09:22:38 -0400 Subject: Replaced kebab-case with snake_case for naming convention. --- stdlib/source/lux.lux | 2734 ++++++++++---------- stdlib/source/lux/abstract/comonad.lux | 4 +- stdlib/source/lux/abstract/interval.lux | 18 +- stdlib/source/lux/abstract/monad.lux | 8 +- stdlib/source/lux/abstract/monad/indexed.lux | 14 +- stdlib/source/lux/control/concatenative.lux | 42 +- stdlib/source/lux/control/concurrency/actor.lux | 178 +- stdlib/source/lux/control/concurrency/atom.lux | 14 +- stdlib/source/lux/control/concurrency/frp.lux | 36 +- stdlib/source/lux/control/concurrency/promise.lux | 22 +- .../source/lux/control/concurrency/semaphore.lux | 76 +- stdlib/source/lux/control/concurrency/stm.lux | 78 +- stdlib/source/lux/control/concurrency/thread.lux | 40 +- stdlib/source/lux/control/continuation.lux | 6 +- stdlib/source/lux/control/exception.lux | 64 +- stdlib/source/lux/control/function/contract.lux | 12 +- stdlib/source/lux/control/io.lux | 6 +- stdlib/source/lux/control/parser.lux | 18 +- stdlib/source/lux/control/parser/analysis.lux | 24 +- stdlib/source/lux/control/parser/binary.lux | 24 +- stdlib/source/lux/control/parser/cli.lux | 40 +- stdlib/source/lux/control/parser/code.lux | 34 +- stdlib/source/lux/control/parser/json.lux | 42 +- stdlib/source/lux/control/parser/synthesis.lux | 36 +- stdlib/source/lux/control/parser/text.lux | 128 +- stdlib/source/lux/control/parser/type.lux | 178 +- stdlib/source/lux/control/parser/xml.lux | 38 +- stdlib/source/lux/control/pipe.lux | 22 +- stdlib/source/lux/control/region.lux | 20 +- stdlib/source/lux/control/remember.lux | 10 +- stdlib/source/lux/control/security/capability.lux | 10 +- stdlib/source/lux/control/security/policy.lux | 28 +- stdlib/source/lux/control/try.lux | 6 +- stdlib/source/lux/data/binary.lux | 146 +- stdlib/source/lux/data/collection/array.lux | 80 +- stdlib/source/lux/data/collection/dictionary.lux | 314 +-- .../lux/data/collection/dictionary/ordered.lux | 118 +- stdlib/source/lux/data/collection/list.lux | 84 +- stdlib/source/lux/data/collection/queue.lux | 8 +- .../source/lux/data/collection/queue/priority.lux | 10 +- stdlib/source/lux/data/collection/row.lux | 242 +- stdlib/source/lux/data/collection/sequence.lux | 28 +- stdlib/source/lux/data/collection/set.lux | 16 +- stdlib/source/lux/data/collection/set/multi.lux | 16 +- stdlib/source/lux/data/collection/set/ordered.lux | 18 +- stdlib/source/lux/data/collection/tree/finger.lux | 8 +- stdlib/source/lux/data/color.lux | 126 +- stdlib/source/lux/data/color/named.lux | 182 +- stdlib/source/lux/data/format/binary.lux | 24 +- stdlib/source/lux/data/format/json.lux | 178 +- stdlib/source/lux/data/format/tar.lux | 660 ++--- stdlib/source/lux/data/format/xml.lux | 148 +- stdlib/source/lux/data/lazy.lux | 10 +- stdlib/source/lux/data/name.lux | 7 +- stdlib/source/lux/data/number.lux | 26 +- stdlib/source/lux/data/number/complex.lux | 36 +- stdlib/source/lux/data/number/frac.lux | 196 +- stdlib/source/lux/data/number/i16.lux | 4 +- stdlib/source/lux/data/number/i32.lux | 4 +- stdlib/source/lux/data/number/i64.lux | 66 +- stdlib/source/lux/data/number/i8.lux | 4 +- stdlib/source/lux/data/number/int.lux | 12 +- stdlib/source/lux/data/number/ratio.lux | 2 +- stdlib/source/lux/data/number/rev.lux | 98 +- stdlib/source/lux/data/text.lux | 92 +- stdlib/source/lux/data/text/buffer.lux | 14 +- stdlib/source/lux/data/text/encoding.lux | 312 +-- stdlib/source/lux/data/text/format.lux | 4 +- stdlib/source/lux/data/text/regex.lux | 230 +- stdlib/source/lux/data/text/unicode/block.lux | 162 +- stdlib/source/lux/data/text/unicode/set.lux | 178 +- stdlib/source/lux/debug.lux | 72 +- stdlib/source/lux/extension.lux | 22 +- stdlib/source/lux/host.jvm.lux | 1658 ++++++------ stdlib/source/lux/host.old.lux | 1666 ++++++------ stdlib/source/lux/locale.lux | 8 +- stdlib/source/lux/locale/language.lux | 132 +- stdlib/source/lux/locale/territory.lux | 144 +- stdlib/source/lux/macro/code.lux | 4 +- stdlib/source/lux/macro/poly.lux | 68 +- stdlib/source/lux/macro/syntax.lux | 60 +- stdlib/source/lux/macro/syntax/common.lux | 14 +- .../source/lux/macro/syntax/common/definition.lux | 36 +- stdlib/source/lux/macro/syntax/common/reader.lux | 36 +- stdlib/source/lux/macro/syntax/common/writer.lux | 20 +- stdlib/source/lux/macro/template.lux | 48 +- stdlib/source/lux/math.lux | 6 +- stdlib/source/lux/math/infix.lux | 24 +- stdlib/source/lux/math/logic/fuzzy.lux | 30 +- stdlib/source/lux/math/modular.lux | 26 +- stdlib/source/lux/math/modulus.lux | 4 +- stdlib/source/lux/math/random.lux | 96 +- stdlib/source/lux/meta.lux | 264 +- stdlib/source/lux/meta/annotation.lux | 20 +- stdlib/source/lux/target/js.lux | 118 +- stdlib/source/lux/target/jvm.lux | 44 +- stdlib/source/lux/target/jvm/attribute.lux | 18 +- stdlib/source/lux/target/jvm/attribute/code.lux | 10 +- stdlib/source/lux/target/jvm/bytecode.lux | 526 ++-- stdlib/source/lux/target/jvm/bytecode/address.lux | 10 +- .../source/lux/target/jvm/bytecode/environment.lux | 4 +- .../jvm/bytecode/environment/limit/registry.lux | 2 +- .../source/lux/target/jvm/bytecode/instruction.lux | 402 +-- stdlib/source/lux/target/jvm/bytecode/jump.lux | 4 +- stdlib/source/lux/target/jvm/class.lux | 26 +- stdlib/source/lux/target/jvm/constant.lux | 104 +- stdlib/source/lux/target/jvm/constant/pool.lux | 32 +- stdlib/source/lux/target/jvm/constant/tag.lux | 10 +- stdlib/source/lux/target/jvm/encoding/name.lux | 14 +- stdlib/source/lux/target/jvm/encoding/signed.lux | 22 +- stdlib/source/lux/target/jvm/encoding/unsigned.lux | 16 +- stdlib/source/lux/target/jvm/loader.lux | 54 +- stdlib/source/lux/target/jvm/method.lux | 6 +- stdlib/source/lux/target/jvm/modifier.lux | 4 +- stdlib/source/lux/target/jvm/type.lux | 20 +- stdlib/source/lux/target/jvm/type/category.lux | 2 +- stdlib/source/lux/target/jvm/type/descriptor.lux | 26 +- stdlib/source/lux/target/jvm/type/parser.lux | 64 +- stdlib/source/lux/target/jvm/type/reflection.lux | 10 +- stdlib/source/lux/target/jvm/type/signature.lux | 46 +- stdlib/source/lux/target/jvm/version.lux | 2 +- stdlib/source/lux/test.lux | 166 +- stdlib/source/lux/time.lux | 92 +- stdlib/source/lux/time/date.lux | 200 +- stdlib/source/lux/time/duration.lux | 100 +- stdlib/source/lux/time/instant.lux | 86 +- stdlib/source/lux/time/month.lux | 10 +- .../lux/tool/compiler/language/lux/analysis.lux | 138 +- .../lux/tool/compiler/language/lux/directive.lux | 20 +- .../lux/tool/compiler/language/lux/generation.lux | 94 +- .../compiler/language/lux/phase/analysis/type.lux | 26 +- .../tool/compiler/language/lux/phase/extension.lux | 12 +- .../lux/tool/compiler/language/lux/syntax.lux | 386 +-- .../lux/tool/compiler/language/lux/synthesis.lux | 258 +- stdlib/source/lux/tool/compiler/meta/archive.lux | 56 +- .../lux/tool/compiler/meta/archive/artifact.lux | 6 +- .../lux/tool/compiler/meta/archive/descriptor.lux | 2 +- stdlib/source/lux/tool/compiler/meta/io.lux | 4 +- .../source/lux/tool/compiler/meta/io/context.lux | 62 +- stdlib/source/lux/tool/compiler/phase.lux | 4 +- stdlib/source/lux/type.lux | 136 +- stdlib/source/lux/type/abstract.lux | 134 +- stdlib/source/lux/type/check.lux | 242 +- stdlib/source/lux/type/dynamic.lux | 10 +- stdlib/source/lux/type/implicit.lux | 222 +- stdlib/source/lux/type/refinement.lux | 14 +- stdlib/source/lux/type/resource.lux | 68 +- stdlib/source/lux/type/unit.lux | 34 +- stdlib/source/lux/world/console.lux | 96 +- stdlib/source/lux/world/file.lux | 602 ++--- stdlib/source/lux/world/file/watch.lux | 152 +- stdlib/source/lux/world/program.lux | 22 +- stdlib/source/lux/world/shell.lux | 192 +- stdlib/source/poly/lux/abstract/equivalence.lux | 24 +- stdlib/source/poly/lux/abstract/functor.lux | 30 +- stdlib/source/poly/lux/data/format/json.lux | 90 +- stdlib/source/program/aedifex.lux | 20 +- stdlib/source/program/aedifex/artifact.lux | 16 +- .../source/program/aedifex/artifact/extension.lux | 6 +- stdlib/source/program/aedifex/artifact/type.lux | 4 +- stdlib/source/program/aedifex/cache.lux | 52 +- stdlib/source/program/aedifex/cli.lux | 22 +- stdlib/source/program/aedifex/command/auto.lux | 4 +- stdlib/source/program/aedifex/command/build.lux | 60 +- stdlib/source/program/aedifex/command/clean.lux | 8 +- stdlib/source/program/aedifex/command/deploy.lux | 38 +- stdlib/source/program/aedifex/command/deps.lux | 8 +- stdlib/source/program/aedifex/command/install.lux | 18 +- stdlib/source/program/aedifex/command/pom.lux | 6 +- stdlib/source/program/aedifex/command/test.lux | 8 +- stdlib/source/program/aedifex/command/version.lux | 2 +- .../program/aedifex/dependency/resolution.lux | 30 +- .../source/program/aedifex/dependency/status.lux | 4 +- stdlib/source/program/aedifex/format.lux | 50 +- stdlib/source/program/aedifex/hash.lux | 44 +- stdlib/source/program/aedifex/input.lux | 24 +- .../source/program/aedifex/metadata/artifact.lux | 60 +- .../source/program/aedifex/metadata/snapshot.lux | 184 +- stdlib/source/program/aedifex/package.lux | 12 +- stdlib/source/program/aedifex/parser.lux | 58 +- stdlib/source/program/aedifex/pom.lux | 64 +- stdlib/source/program/aedifex/profile.lux | 40 +- stdlib/source/program/aedifex/project.lux | 12 +- stdlib/source/program/aedifex/repository.lux | 34 +- .../source/program/aedifex/repository/identity.lux | 2 +- stdlib/source/program/compositor/export.lux | 28 +- stdlib/source/program/compositor/import.lux | 14 +- stdlib/source/spec/aedifex/repository.lux | 6 +- stdlib/source/spec/lux/world/console.lux | 10 +- stdlib/source/spec/lux/world/shell.lux | 20 +- stdlib/source/test/aedifex/artifact.lux | 2 +- stdlib/source/test/aedifex/artifact/extension.lux | 10 +- stdlib/source/test/aedifex/artifact/type.lux | 10 +- stdlib/source/test/aedifex/cache.lux | 50 +- stdlib/source/test/aedifex/command/auto.lux | 56 +- stdlib/source/test/aedifex/command/build.lux | 118 +- stdlib/source/test/aedifex/command/clean.lux | 86 +- stdlib/source/test/aedifex/command/deploy.lux | 68 +- stdlib/source/test/aedifex/command/deps.lux | 54 +- stdlib/source/test/aedifex/command/install.lux | 38 +- stdlib/source/test/aedifex/command/pom.lux | 12 +- stdlib/source/test/aedifex/command/test.lux | 74 +- stdlib/source/test/aedifex/command/version.lux | 26 +- .../source/test/aedifex/dependency/resolution.lux | 250 +- stdlib/source/test/aedifex/hash.lux | 16 +- stdlib/source/test/aedifex/input.lux | 10 +- stdlib/source/test/aedifex/local.lux | 4 +- stdlib/source/test/aedifex/metadata.lux | 4 +- stdlib/source/test/aedifex/metadata/artifact.lux | 10 +- stdlib/source/test/aedifex/metadata/snapshot.lux | 18 +- stdlib/source/test/aedifex/package.lux | 6 +- stdlib/source/test/aedifex/parser.lux | 32 +- stdlib/source/test/aedifex/pom.lux | 2 +- stdlib/source/test/aedifex/profile.lux | 30 +- stdlib/source/test/aedifex/project.lux | 54 +- stdlib/source/test/aedifex/repository.lux | 8 +- stdlib/source/test/aedifex/runtime.lux | 4 +- stdlib/source/test/lux.lux | 94 +- stdlib/source/test/lux/abstract/codec.lux | 2 +- .../test/lux/abstract/functor/contravariant.lux | 2 +- stdlib/source/test/lux/abstract/interval.lux | 126 +- stdlib/source/test/lux/control/concatenative.lux | 12 +- .../source/test/lux/control/concurrency/actor.lux | 88 +- .../source/test/lux/control/concurrency/atom.lux | 16 +- stdlib/source/test/lux/control/concurrency/frp.lux | 58 +- .../test/lux/control/concurrency/promise.lux | 40 +- .../test/lux/control/concurrency/semaphore.lux | 50 +- .../source/test/lux/control/concurrency/thread.lux | 20 +- stdlib/source/test/lux/control/function/memo.lux | 64 +- stdlib/source/test/lux/control/parser.lux | 52 +- stdlib/source/test/lux/control/parser/analysis.lux | 12 +- stdlib/source/test/lux/control/parser/binary.lux | 142 +- stdlib/source/test/lux/control/parser/code.lux | 54 +- stdlib/source/test/lux/control/parser/json.lux | 66 +- .../source/test/lux/control/parser/synthesis.lux | 113 +- stdlib/source/test/lux/control/parser/text.lux | 316 +-- stdlib/source/test/lux/control/parser/type.lux | 152 +- stdlib/source/test/lux/control/parser/xml.lux | 44 +- stdlib/source/test/lux/control/region.lux | 82 +- stdlib/source/test/lux/control/remember.lux | 50 +- stdlib/source/test/lux/control/security/policy.lux | 58 +- stdlib/source/test/lux/control/try.lux | 12 +- stdlib/source/test/lux/data/binary.lux | 60 +- stdlib/source/test/lux/data/collection/array.lux | 122 +- .../source/test/lux/data/collection/dictionary.lux | 144 +- .../lux/data/collection/dictionary/ordered.lux | 60 +- .../test/lux/data/collection/dictionary/plist.lux | 48 +- stdlib/source/test/lux/data/collection/list.lux | 100 +- stdlib/source/test/lux/data/collection/queue.lux | 66 +- stdlib/source/test/lux/data/collection/row.lux | 86 +- .../source/test/lux/data/collection/sequence.lux | 24 +- stdlib/source/test/lux/data/collection/set.lux | 68 +- .../source/test/lux/data/collection/set/multi.lux | 172 +- .../test/lux/data/collection/set/ordered.lux | 50 +- .../test/lux/data/collection/tree/finger.lux | 140 +- stdlib/source/test/lux/data/color.lux | 70 +- stdlib/source/test/lux/data/color/named.lux | 202 +- stdlib/source/test/lux/data/format/json.lux | 36 +- stdlib/source/test/lux/data/format/tar.lux | 282 +- stdlib/source/test/lux/data/format/xml.lux | 10 +- stdlib/source/test/lux/data/name.lux | 24 +- stdlib/source/test/lux/data/number.lux | 10 +- stdlib/source/test/lux/data/number/complex.lux | 90 +- stdlib/source/test/lux/data/number/frac.lux | 80 +- stdlib/source/test/lux/data/number/i64.lux | 70 +- stdlib/source/test/lux/data/number/rev.lux | 8 +- stdlib/source/test/lux/data/text.lux | 166 +- stdlib/source/test/lux/data/text/encoding.lux | 298 +-- stdlib/source/test/lux/data/text/format.lux | 8 +- stdlib/source/test/lux/data/text/regex.lux | 248 +- stdlib/source/test/lux/data/text/unicode/block.lux | 150 +- stdlib/source/test/lux/data/text/unicode/set.lux | 8 +- stdlib/source/test/lux/extension.lux | 38 +- stdlib/source/test/lux/host.old.lux | 30 +- stdlib/source/test/lux/locale.lux | 54 +- stdlib/source/test/lux/locale/language.lux | 124 +- stdlib/source/test/lux/locale/territory.lux | 120 +- stdlib/source/test/lux/macro/code.lux | 84 +- stdlib/source/test/lux/macro/poly/equivalence.lux | 36 +- stdlib/source/test/lux/macro/poly/functor.lux | 10 +- stdlib/source/test/lux/macro/poly/json.lux | 28 +- stdlib/source/test/lux/macro/syntax.lux | 24 +- stdlib/source/test/lux/macro/syntax/common.lux | 42 +- .../test/lux/macro/syntax/common/definition.lux | 24 +- stdlib/source/test/lux/macro/template.lux | 16 +- stdlib/source/test/lux/math.lux | 26 +- stdlib/source/test/lux/math/infix.lux | 30 +- stdlib/source/test/lux/math/logic/continuous.lux | 2 +- stdlib/source/test/lux/math/logic/fuzzy.lux | 76 +- stdlib/source/test/lux/math/modular.lux | 2 +- stdlib/source/test/lux/math/modulus.lux | 8 +- stdlib/source/test/lux/meta.lux | 300 +-- stdlib/source/test/lux/meta/annotation.lux | 44 +- stdlib/source/test/lux/target/jvm.lux | 634 ++--- stdlib/source/test/lux/time/date.lux | 2 +- stdlib/source/test/lux/time/day.lux | 2 +- stdlib/source/test/lux/time/duration.lux | 10 +- stdlib/source/test/lux/time/instant.lux | 6 +- stdlib/source/test/lux/time/month.lux | 2 +- stdlib/source/test/lux/type.lux | 32 +- stdlib/source/test/lux/type/check.lux | 160 +- stdlib/source/test/lux/type/dynamic.lux | 2 +- stdlib/source/test/lux/type/implicit.lux | 2 +- stdlib/source/test/lux/type/resource.lux | 38 +- stdlib/source/test/lux/world/console.lux | 8 +- stdlib/source/test/lux/world/file.lux | 134 +- stdlib/source/test/lux/world/file/watch.lux | 42 +- stdlib/source/test/lux/world/shell.lux | 36 +- 308 files changed, 13297 insertions(+), 13293 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index f45bab179..4d0ac9c4d 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,21 +1,21 @@ -("lux def" dummy-location +("lux def" dummy_location ["" 0 0] [["" 0 0] (9 #1 (0 #0))] #0) -("lux def" double-quote +("lux def" double_quote ("lux i64 char" +34) - [dummy-location (9 #1 (0 #0))] + [dummy_location (9 #1 (0 #0))] #0) -("lux def" new-line +("lux def" new_line ("lux i64 char" +10) - [dummy-location (9 #1 (0 #0))] + [dummy_location (9 #1 (0 #0))] #0) ("lux def" __paragraph - ("lux text concat" new-line new-line) - [dummy-location (9 #1 (0 #0))] + ("lux text concat" new_line new_line) + [dummy_location (9 #1 (0 #0))] #0) ## (type: Any @@ -24,9 +24,9 @@ ("lux check type" (9 #1 ["lux" "Any"] (8 #0 (0 #0) (4 #0 1)))) - [dummy-location - (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "The type of things whose type is irrelevant." __paragraph) "It can be used to write functions or data-structures that can take, or return, anything."))]] (0 #0)))] @@ -38,9 +38,9 @@ ("lux check type" (9 #1 ["lux" "Nothing"] (7 #0 (0 #0) (4 #0 1)))) - [dummy-location - (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "The type of things whose type is undefined." __paragraph) "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] (0 #0)))] @@ -57,11 +57,11 @@ ## "lux.Cons" (2 #0 (4 #0 1) (9 #0 (4 #0 1) (4 #0 0)))))) - [dummy-location - (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (0 #1 [dummy-location (5 #0 "a")] (0 #0)))]] - (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "A potentially empty list of values.")]] + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (0 #1 [dummy_location (5 #0 "a")] (0 #0)))]] + (0 #1 [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "A potentially empty list of values.")]] (0 #0))))] ["Nil" "Cons"] #1) @@ -70,9 +70,9 @@ ("lux check type" (9 #1 ["lux" "Bit"] (0 #0 "#Bit" #Nil))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] #Nil))] #1) @@ -81,9 +81,9 @@ (9 #1 ["lux" "I64"] (7 #0 (0 #0) (0 #0 "#I64" (#Cons (4 #0 1) #Nil))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "64-bit integers without any semantics.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "64-bit integers without any semantics.")]] #Nil))] #1) @@ -91,9 +91,9 @@ ("lux check type" (9 #1 ["lux" "Nat"] (0 #0 "#I64" (#Cons (0 #0 "#Nat" #Nil) #Nil)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) "They start at zero (0) and extend in the positive direction."))]] #Nil))] @@ -103,9 +103,9 @@ ("lux check type" (9 #1 ["lux" "Int"] (0 #0 "#I64" (#Cons (0 #0 "#Int" #Nil) #Nil)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill integer numbers.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill integer numbers.")]] #Nil))] #1) @@ -113,9 +113,9 @@ ("lux check type" (9 #1 ["lux" "Rev"] (0 #0 "#I64" (#Cons (0 #0 "#Rev" #Nil) #Nil)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) "Useful for probability, and other domains that work within that interval."))]] #Nil))] @@ -125,9 +125,9 @@ ("lux check type" (9 #1 ["lux" "Frac"] (0 #0 "#Frac" #Nil))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] #Nil))] #1) @@ -135,9 +135,9 @@ ("lux check type" (9 #1 ["lux" "Text"] (0 #0 "#Text" #Nil))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill string values.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill string values.")]] #Nil))] #1) @@ -145,9 +145,9 @@ ("lux check type" (9 #1 ["lux" "Name"] (2 #0 Text Text))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] #Nil))] #1) @@ -161,11 +161,11 @@ Any ## "lux.Some" (4 #0 1)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "a")] #Nil))]] - (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "A potentially missing value.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "a")] #Nil))]] + (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "A potentially missing value.")]] #Nil)))] ["None" "Some"] #1) @@ -186,18 +186,18 @@ ("lux def type tagged" Type (9 #1 ["lux" "Type"] ({Type - ({Type-List - ({Type-Pair + ({Type_List + ({Type_Pair (9 #0 Nothing (7 #0 #Nil (1 #0 ## "lux.Primitive" - (2 #0 Text Type-List) + (2 #0 Text Type_List) (1 #0 ## "lux.Sum" - Type-Pair + Type_Pair (1 #0 ## "lux.Product" - Type-Pair + Type_Pair (1 #0 ## "lux.Function" - Type-Pair + Type_Pair (1 #0 ## "lux.Parameter" Nat (1 #0 ## "lux.Var" @@ -205,21 +205,21 @@ (1 #0 ## "lux.Ex" Nat (1 #0 ## "lux.UnivQ" - (2 #0 Type-List Type) + (2 #0 Type_List Type) (1 #0 ## "lux.ExQ" - (2 #0 Type-List Type) + (2 #0 Type_List Type) (1 #0 ## "lux.Apply" - Type-Pair + Type_Pair ## "lux.Named" (2 #0 Name Type)))))))))))))} ("lux check type" (2 #0 Type Type)))} ("lux check type" (9 #0 Type List)))} ("lux check type" (9 #0 (4 #0 1) (4 #0 0))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] - (#Cons [[dummy-location (7 #0 ["lux" "type-rec?"])] - [dummy-location (0 #0 #1)]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy_location (7 #0 ["lux" "type-rec?"])] + [dummy_location (0 #0 #1)]] #Nil)))] ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"] #1) @@ -231,9 +231,9 @@ ("lux def type tagged" Location (#Named ["lux" "Location"] (#Product Text (#Product Nat Nat))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Locations are for specifying the location of Code nodes in Lux files during compilation.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Locations are for specifying the location of Code nodes in Lux files during compilation.")]] #Nil))] ["module" "line" "column"] #1) @@ -247,11 +247,11 @@ (#UnivQ #Nil (#Product (#Parameter 3) (#Parameter 1))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] - (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "m")] (#Cons [dummy-location (5 #0 "v")] #Nil)))]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] + (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "m")] (#Cons [dummy_location (5 #0 "v")] #Nil)))]] #Nil)))] ["meta" "datum"] #1) @@ -271,7 +271,7 @@ ("lux def type tagged" Code' (#Named ["lux" "Code'"] ({Code - ({Code-List + ({Code_List (#UnivQ #Nil (#Sum ## "lux.Bit" Bit @@ -290,9 +290,9 @@ (#Sum ## "lux.Tag" Name (#Sum ## "lux.Form" - Code-List + Code_List (#Sum ## "lux.Tuple" - Code-List + Code_List ## "lux.Record" (#Apply (#Product Code Code) List) )))))))))) @@ -301,9 +301,9 @@ ("lux check type" (#Apply (#Apply (#Parameter 1) (#Parameter 0)) (#Parameter 1))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "w")] #Nil))]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "w")] #Nil))]] #Nil))] ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"] #1) @@ -315,9 +315,9 @@ ({w (#Apply (#Apply w Code') w)} ("lux check type" (#Apply Location Ann)))) - [dummy-location - (#Record (#Cons [[dummy-location (#Tag ["lux" "doc"])] - [dummy-location (#Text "The type of Code nodes for Lux syntax.")]] + [dummy_location + (#Record (#Cons [[dummy_location (#Tag ["lux" "doc"])] + [dummy_location (#Text "The type of Code nodes for Lux syntax.")]] #Nil))] #1) @@ -326,86 +326,86 @@ Code') Code) ([_ data] - [dummy-location data])) - [dummy-location (#Record #Nil)] + [dummy_location data])) + [dummy_location (#Record #Nil)] #0) ("lux def" bit$ ("lux check" (#Function Bit Code) ([_ value] (_ann (#Bit value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" nat$ ("lux check" (#Function Nat Code) ([_ value] (_ann (#Nat value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" int$ ("lux check" (#Function Int Code) ([_ value] (_ann (#Int value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" rev$ ("lux check" (#Function Rev Code) ([_ value] (_ann (#Rev value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" frac$ ("lux check" (#Function Frac Code) ([_ value] (_ann (#Frac value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" text$ ("lux check" (#Function Text Code) ([_ text] (_ann (#Text text)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" identifier$ ("lux check" (#Function Name Code) ([_ name] (_ann (#Identifier name)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) -("lux def" local-identifier$ +("lux def" local_identifier$ ("lux check" (#Function Text Code) ([_ name] (_ann (#Identifier ["" name])))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" tag$ ("lux check" (#Function Name Code) ([_ name] (_ann (#Tag name)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) -("lux def" local-tag$ +("lux def" local_tag$ ("lux check" (#Function Text Code) ([_ name] (_ann (#Tag ["" name])))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" form$ ("lux check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Form tokens)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" tuple$ ("lux check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Tuple tokens)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" record$ ("lux check" (#Function (#Apply (#Product Code Code) List) Code) ([_ tokens] (_ann (#Record tokens)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ## (type: Definition @@ -492,7 +492,7 @@ ["name" "inner" "locals" "captured"] #1) -("lux def" Code-List +("lux def" Code_List ("lux check type" (#Apply Code List)) (record$ #Nil) @@ -526,12 +526,12 @@ (record$ #Nil) #1) -## (type: Module-State +## (type: Module_State ## #Active ## #Compiled ## #Cached) -("lux def type tagged" Module-State - (#Named ["lux" "Module-State"] +("lux def type tagged" Module_State + (#Named ["lux" "Module_State"] (#Sum ## #Active Any @@ -545,19 +545,19 @@ #1) ## (type: Module -## {#module-hash Nat -## #module-aliases (List [Text Text]) +## {#module_hash Nat +## #module_aliases (List [Text Text]) ## #definitions (List [Text Global]) ## #imports (List Text) ## #tags (List [Text [Nat (List Name) Bit Type]]) ## #types (List [Text [(List Name) Bit Type]]) -## #module-annotations (Maybe Code) -## #module-state Module-State}) +## #module_annotations (Maybe Code) +## #module_state Module_State}) ("lux def type tagged" Module (#Named ["lux" "Module"] - (#Product ## "lux.module-hash" + (#Product ## "lux.module_hash" Nat - (#Product ## "lux.module-aliases" + (#Product ## "lux.module_aliases" (#Apply (#Product Text Text) List) (#Product ## "lux.definitions" (#Apply (#Product Text Global) List) @@ -576,31 +576,31 @@ (#Product Bit Type))) List) - (#Product ## "lux.module-annotations" + (#Product ## "lux.module_annotations" (#Apply Code Maybe) - Module-State)) + Module_State)) )))))) (record$ (#Cons [(tag$ ["lux" "doc"]) (text$ "All the information contained within a Lux module.")] #Nil)) - ["module-hash" "module-aliases" "definitions" "imports" "tags" "types" "module-annotations" "module-state"] + ["module_hash" "module_aliases" "definitions" "imports" "tags" "types" "module_annotations" "module_state"] #1) -## (type: Type-Context -## {#ex-counter Nat -## #var-counter Nat -## #var-bindings (List [Nat (Maybe Type)])}) -("lux def type tagged" Type-Context - (#Named ["lux" "Type-Context"] - (#Product ## ex-counter +## (type: Type_Context +## {#ex_counter Nat +## #var_counter Nat +## #var_bindings (List [Nat (Maybe Type)])}) +("lux def type tagged" Type_Context + (#Named ["lux" "Type_Context"] + (#Product ## ex_counter Nat - (#Product ## var-counter + (#Product ## var_counter Nat - ## var-bindings + ## var_bindings (#Apply (#Product Nat (#Apply Type Maybe)) List)))) (record$ #Nil) - ["ex-counter" "var-counter" "var-bindings"] + ["ex_counter" "var_counter" "var_bindings"] #1) ## (type: Mode @@ -645,13 +645,13 @@ ## {#info Info ## #source Source ## #location Location -## #current-module (Maybe Text) +## #current_module (Maybe Text) ## #modules (List [Text Module]) ## #scopes (List Scope) -## #type-context Type-Context +## #type_context Type_Context ## #expected (Maybe Type) ## #seed Nat -## #scope-type-vars (List Nat) +## #scope_type_vars (List Nat) ## #extensions Any ## #host Any}) ("lux def type tagged" Lux @@ -662,19 +662,19 @@ Source (#Product ## "lux.location" Location - (#Product ## "lux.current-module" + (#Product ## "lux.current_module" (#Apply Text Maybe) (#Product ## "lux.modules" (#Apply (#Product Text Module) List) (#Product ## "lux.scopes" (#Apply Scope List) - (#Product ## "lux.type-context" - Type-Context + (#Product ## "lux.type_context" + Type_Context (#Product ## "lux.expected" (#Apply Type Maybe) (#Product ## "lux.seed" Nat - (#Product ## scope-type-vars + (#Product ## scope_type_vars (#Apply Nat List) (#Product ## extensions Any @@ -687,7 +687,7 @@ ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] #Nil)) - ["info" "source" "location" "current-module" "modules" "scopes" "type-context" "expected" "seed" "scope-type-vars" "extensions" "host"] + ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "host"] #1) ## (type: (Meta a) @@ -713,7 +713,7 @@ ("lux def" Macro' ("lux check type" (#Named ["lux" "Macro'"] - (#Function Code-List (#Apply Code-List Meta)))) + (#Function Code_List (#Apply Code_List Meta)))) (record$ #Nil) #1) @@ -805,52 +805,52 @@ (record$ #.Nil) #0) -("lux def" location-code +("lux def" location_code ("lux check" Code (tuple$ (#Cons (text$ "") (#Cons (nat$ 0) (#Cons (nat$ 0) #Nil))))) (record$ #Nil) #0) -("lux def" meta-code +("lux def" meta_code ("lux check" (#Function Name (#Function Code Code)) ([_ tag] ([_ value] - (tuple$ (#Cons location-code + (tuple$ (#Cons location_code (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) #Nil)))))) (record$ #Nil) #0) -("lux def" flag-meta +("lux def" flag_meta ("lux check" (#Function Text Code) ([_ tag] - (tuple$ (#Cons [(meta-code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) - (#Cons [(meta-code ["lux" "Bit"] (bit$ #1)) + (tuple$ (#Cons [(meta_code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) + (#Cons [(meta_code ["lux" "Bit"] (bit$ #1)) #Nil])])))) (record$ #Nil) #0) -("lux def" doc-meta +("lux def" doc_meta ("lux check" (#Function Text (#Product Code Code)) (function'' [doc] [(tag$ ["lux" "doc"]) (text$ doc)])) (record$ #Nil) #0) -("lux def" as-def +("lux def" as_def ("lux check" (#Function Code (#Function Code (#Function Code (#Function Bit Code)))) (function'' [name value annotations exported?] (form$ (#Cons (text$ "lux def") (#Cons name (#Cons value (#Cons annotations (#Cons (bit$ exported?) #Nil)))))))) (record$ #Nil) #0) -("lux def" as-checked +("lux def" as_checked ("lux check" (#Function Code (#Function Code Code)) (function'' [type value] (form$ (#Cons (text$ "lux check") (#Cons type (#Cons value #Nil)))))) (record$ #Nil) #0) -("lux def" as-function +("lux def" as_function ("lux check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) (function'' [self inputs output] (form$ (#Cons (identifier$ ["lux" "function''"]) @@ -860,7 +860,7 @@ (record$ #Nil) #0) -("lux def" as-macro +("lux def" as_macro ("lux check" (#Function Code Code) (function'' [expression] (form$ (#Cons (text$ "lux macro") @@ -875,7 +875,7 @@ ({(#Cons [[_ (#Tag ["" "export"])] (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(as-def name (as-checked type (as-function name args body)) + (return (#Cons [(as_def name (as_checked type (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -883,7 +883,7 @@ #Nil])) (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(as-def name (as-checked type body) + (return (#Cons [(as_def name (as_checked type body) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -892,7 +892,7 @@ (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(as-def name (as-checked type (as-function name args body)) + (return (#Cons [(as_def name (as_checked type (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -900,7 +900,7 @@ #Nil])) (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(as-def name (as-checked type body) + (return (#Cons [(as_def name (as_checked type body) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -917,7 +917,7 @@ ("lux macro" (function'' [tokens] ({(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (return (#Cons (as-def name (as-macro (as-function name args body)) + (return (#Cons (as_def name (as_macro (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons (tag$ ["lux" "Nil"]) #Nil))) @@ -925,17 +925,17 @@ #Nil)) (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) - (return (#Cons (as-def name (as-macro (as-function name args body)) + (return (#Cons (as_def name (as_macro (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons (tag$ ["lux" "Nil"]) #Nil))) #1) #Nil)) - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) - (return (#Cons (as-def name (as-macro (as-function name args body)) + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta_data (#Cons body #Nil)))) + (return (#Cons (as_def name (as_macro (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) - (#Cons meta-data + (#Cons meta_data #Nil))) #1) #Nil)) @@ -990,11 +990,11 @@ Type ($' List (#Product Text Code))) -(def:'' (make-env xs ys) +(def:'' (make_env xs ys) #Nil (#Function ($' List Text) (#Function ($' List Code) RepEnv)) ({[(#Cons x xs') (#Cons y ys')] - (#Cons [x y] (make-env xs' ys')) + (#Cons [x y] (make_env xs' ys')) _ #Nil} @@ -1005,7 +1005,7 @@ (#Function Text (#Function Text Bit)) ("lux text =" reference sample)) -(def:'' (get-rep key env) +(def:'' (get_rep key env) #Nil (#Function Text (#Function RepEnv ($' Maybe Code))) ({#Nil @@ -1016,11 +1016,11 @@ (#Some v) #0 - (get-rep key env')} + (get_rep key env')} (text\= k key))} env)) -(def:'' (replace-syntax reps syntax) +(def:'' (replace_syntax reps syntax) #Nil (#Function RepEnv (#Function Code Code)) ({[_ (#Identifier "" name)] @@ -1029,19 +1029,19 @@ #None syntax} - (get-rep name reps)) + (get_rep name reps)) [meta (#Form parts)] - [meta (#Form (list\map (replace-syntax reps) parts))] + [meta (#Form (list\map (replace_syntax reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (list\map (replace-syntax reps) members))] + [meta (#Tuple (list\map (replace_syntax reps) members))] [meta (#Record slots)] [meta (#Record (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] ({[k v] - [(replace-syntax reps k) (replace-syntax reps v)]} + [(replace_syntax reps k) (replace_syntax reps v)]} slot))) slots))] @@ -1050,37 +1050,37 @@ syntax)) (def:'' (n/* param subject) - (#.Cons (doc-meta "Nat(ural) multiplication.") #.Nil) + (#.Cons (doc_meta "Nat(ural) multiplication.") #.Nil) (#Function Nat (#Function Nat Nat)) ("lux coerce" Nat ("lux i64 *" ("lux coerce" Int param) ("lux coerce" Int subject)))) -(def:'' (update-parameters code) +(def:'' (update_parameters code) #Nil (#Function Code Code) ({[_ (#Tuple members)] - (tuple$ (list\map update-parameters members)) + (tuple$ (list\map update_parameters members)) [_ (#Record pairs)] (record$ (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair - [name (update-parameters val)]))) + [name (update_parameters val)]))) pairs)) [_ (#Form (#Cons [_ (#Tag "lux" "Parameter")] (#Cons [_ (#Nat idx)] #Nil)))] (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ ("lux i64 +" 2 idx)) #Nil))) [_ (#Form members)] - (form$ (list\map update-parameters members)) + (form$ (list\map update_parameters members)) _ code} code)) -(def:'' (parse-quantified-args args next) +(def:'' (parse_quantified_args args next) #Nil ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) (#Function ($' List Code) @@ -1090,14 +1090,14 @@ ({#Nil (next #Nil) - (#Cons [_ (#Identifier "" arg-name)] args') - (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + (#Cons [_ (#Identifier "" arg_name)] args') + (parse_quantified_args args' (function'' [names] (next (#Cons arg_name names)))) _ (fail "Expected identifier.")} args)) -(def:'' (make-parameter idx) +(def:'' (make_parameter idx) #Nil (#Function Nat Code) (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ idx) #Nil)))) @@ -1134,21 +1134,21 @@ ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) "(All List [a] (| Any [a (List a)]))"))))] #Nil) - (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) - [self-name tokens] + (let'' [self_name tokens] ({(#Cons [_ (#Identifier "" self_name)] tokens) + [self_name tokens] _ ["" tokens]} tokens) ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args + (parse_quantified_args args (function'' [names] (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-parameter 1)] #Nil) - (update-parameters body')) #Nil)))))) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) body names) (return (#Cons ({[#1 _] @@ -1158,10 +1158,10 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] #Nil) body')} - [(text\= "" self-name) names]) + [(text\= "" self_name) names]) #Nil))))) _ @@ -1178,21 +1178,21 @@ ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) "(Ex Self [a] [(Codec Text a) a (List (Self a))])"))))] #Nil) - (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) - [self-name tokens] + (let'' [self_name tokens] ({(#Cons [_ (#Identifier "" self_name)] tokens) + [self_name tokens] _ ["" tokens]} tokens) ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args + (parse_quantified_args args (function'' [names] (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-parameter 1)] #Nil) - (update-parameters body')) #Nil)))))) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) body names) (return (#Cons ({[#1 _] @@ -1202,10 +1202,10 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] #Nil) body')} - [(text\= "" self-name) names]) + [(text\= "" self_name) names]) #Nil))))) _ @@ -1322,10 +1322,10 @@ (fail "function' requires a non-empty arguments tuple.") (#Cons [harg targs]) - (return (list (form$ (list (tuple$ (list (local-identifier$ name) + (return (list (form$ (list (tuple$ (list (local_identifier$ name) harg)) (list\fold (function'' [arg body'] - (form$ (list (tuple$ (list (local-identifier$ "") + (form$ (list (tuple$ (list (local_identifier$ "") arg)) body'))) body @@ -1392,11 +1392,11 @@ (fail "Wrong syntax for def:'''")} tokens)) -(def:''' (as-pairs xs) +(def:''' (as_pairs xs) #Nil (All [a] (-> ($' List a) ($' List (& a a)))) ({(#Cons x (#Cons y xs')) - (#Cons [x y] (as-pairs xs')) + (#Cons [x y] (as_pairs xs')) _ #Nil} @@ -1411,7 +1411,7 @@ (form$ (list (record$ (list [label body])) value))} binding))) body - (list\reverse (as-pairs bindings))))) + (list\reverse (as_pairs bindings))))) _ (fail "Wrong syntax for let'")} @@ -1430,20 +1430,20 @@ (p x))} xs)) -(def:''' (wrap-meta content) +(def:''' (wrap_meta content) #Nil (-> Code Code) (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) content))) -(def:''' (untemplate-list tokens) +(def:''' (untemplate_list tokens) #Nil (-> ($' List Code) Code) ({#Nil (_ann (#Tag ["lux" "Nil"])) (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))} + (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate_list tokens'))))} tokens)) (def:''' (list\compose xs ys) @@ -1476,11 +1476,11 @@ (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new-line) + ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new_line) ("lux text concat" - ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..new_line) ("lux text concat" - ("lux text concat" "## =>" ..new-line) + ("lux text concat" "## =>" ..new_line) "(text\compose (text\compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') @@ -1498,11 +1498,11 @@ (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new-line) + ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new_line) ("lux text concat" - ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..new_line) ("lux text concat" - ("lux text concat" "## =>" ..new-line) + ("lux text concat" "## =>" ..new_line) "(text\compose ''Hello, '' (text\compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') @@ -1533,7 +1533,7 @@ ["wrap" "bind"] #0) -(def:''' maybe-monad +(def:''' maybe_monad #Nil ($' Monad Maybe) {#wrap @@ -1545,7 +1545,7 @@ (#Some a) (f a)} ma))}) -(def:''' meta-monad +(def:''' meta_monad #Nil ($' Monad Meta) {#wrap @@ -1565,8 +1565,8 @@ (macro:' (do tokens) ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (local-identifier$ "wrap") - g!bind (local-identifier$ " bind ") + (let' [g!wrap (local_identifier$ "wrap") + g!bind (local_identifier$ " bind ") body' (list\fold ("lux check" (-> (& Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] @@ -1575,11 +1575,11 @@ _ (form$ (list g!bind - (form$ (list (tuple$ (list (local-identifier$ "") var)) body')) + (form$ (list (tuple$ (list (local_identifier$ "") var)) body')) value))} var)))) body - (list\reverse (as-pairs bindings)))] + (list\reverse (as_pairs bindings)))] (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) body'])) monad))))) @@ -1682,67 +1682,67 @@ (-> Text Text Text) ("lux text concat" x y)) -(def:''' (name\encode full-name) +(def:''' (name\encode full_name) #Nil (-> Name Text) - (let' [[module name] full-name] + (let' [[module name] full_name] ({"" name _ ($_ text\compose module "." name)} module))) -(def:''' (get-meta tag def-meta) +(def:''' (get_meta tag def_meta) #Nil (-> Name Code ($' Maybe Code)) (let' [[prefix name] tag] - ({[_ (#Record def-meta)] - ({(#Cons [key value] def-meta') + ({[_ (#Record def_meta)] + ({(#Cons [key value] def_meta') ({[_ (#Tag [prefix' name'])] ({[#1 #1] (#Some value) _ - (get-meta tag (record$ def-meta'))} + (get_meta tag (record$ def_meta'))} [(text\= prefix prefix') (text\= name name')]) _ - (get-meta tag (record$ def-meta'))} + (get_meta tag (record$ def_meta'))} key) #Nil #None} - def-meta) + def_meta) _ #None} - def-meta))) + def_meta))) -(def:''' (resolve-global-identifier full-name state) +(def:''' (resolve_global_identifier full_name state) #Nil (-> Name ($' Meta Name)) - (let' [[module name] full-name - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let' [[module name] full_name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] - ({(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _}) + #scope_type_vars scope_type_vars} state] + ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _}) ({(#Some constant) - ({(#Left real-name) - (#Right [state real-name]) + ({(#Left real_name) + (#Right [state real_name]) - (#Right [exported? def-type def-meta def-value]) - (#Right [state full-name])} + (#Right [exported? def_type def_meta def_value]) + (#Right [state full_name])} constant) #None - (#Left ($_ text\compose "Unknown definition: " (name\encode full-name)))} + (#Left ($_ text\compose "Unknown definition: " (name\encode full_name)))} (get name definitions)) #None - (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full-name)))} + (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full_name)))} (get module modules)))) -(def:''' (as-code-list expression) +(def:''' (as_code_list expression) #Nil (-> Code Code) (let' [type (form$ (list (tag$ ["lux" "Apply"]) @@ -1758,26 +1758,26 @@ (return (tag$ ["lux" "Nil"])) (#Cons lastI inits) - (do meta-monad + (do meta_monad [lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap (as-code-list spliced)) + (wrap (as_code_list spliced)) _ - (do meta-monad + (do meta_monad [lastO (untemplate lastI)] - (wrap (as-code-list (form$ (list (tag$ ["lux" "Cons"]) + (wrap (as_code_list (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"]))))))))} lastI)] - (monad\fold meta-monad + (monad\fold meta_monad (function' [leftI rightO] ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "lux") (identifier$ ["lux" "list\compose"])))] - (wrap (form$ (list g!in-module (as-code-list spliced) rightO)))) + (wrap (form$ (list g!in-module (as_code_list spliced) rightO)))) _ - (do meta-monad + (do meta_monad [leftO (untemplate leftI)] (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))} leftI)) @@ -1785,39 +1785,39 @@ inits))} (list\reverse elems)) #0 - (do meta-monad - [=elems (monad\map meta-monad untemplate elems)] - (wrap (untemplate-list =elems)))} + (do meta_monad + [=elems (monad\map meta_monad untemplate elems)] + (wrap (untemplate_list =elems)))} replace?)) -(def:''' (untemplate-text value) +(def:''' (untemplate_text value) #Nil (-> Text Code) - (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) + (wrap_meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) (def:''' (untemplate replace? subst token) #Nil (-> Bit Text Code ($' Meta Code)) ({[_ [_ (#Bit value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Bit"]) (bit$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Bit"]) (bit$ value))))) [_ [_ (#Nat value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) [_ [_ (#Int value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) [_ [_ (#Rev value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Rev"]) (rev$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Rev"]) (rev$ value))))) [_ [_ (#Frac value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] - (return (untemplate-text value)) + (return (untemplate_text value)) [#0 [_ (#Tag [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Tag [module name])]] (let' [module' ({"" @@ -1826,23 +1826,23 @@ _ module} module)] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) [#1 [_ (#Identifier [module name])]] - (do meta-monad - [real-name ({"" + (do meta_monad + [real_name ({"" (if (text\= "" subst) (wrap [module name]) - (resolve-global-identifier [subst name])) + (resolve_global_identifier [subst name])) _ (wrap [module name])} module) - #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) + #let [[module name] real_name]] + (return (wrap_meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) [#0 [_ (#Identifier [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))]] (return (form$ (list (text$ "lux check") @@ -1850,40 +1850,40 @@ unquoted))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]] - (do meta-monad + (do meta_monad [independent (untemplate replace? subst dependent)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Form"]) - (untemplate-list (list (untemplate-text "lux in-module") - (untemplate-text subst) + (wrap (wrap_meta (form$ (list (tag$ ["lux" "Form"]) + (untemplate_list (list (untemplate_text "lux in-module") + (untemplate_text subst) independent))))))) - [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] - (untemplate #0 subst keep-quoted) + [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep_quoted #Nil])]))]] + (untemplate #0 subst keep_quoted) [_ [meta (#Form elems)]] - (do meta-monad + (do meta_monad [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] + #let [[_ output'] (wrap_meta (form$ (list (tag$ ["lux" "Form"]) output)))]] (wrap [meta output'])) [_ [meta (#Tuple elems)]] - (do meta-monad + (do meta_monad [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] + #let [[_ output'] (wrap_meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] (wrap [meta output'])) [_ [_ (#Record fields)]] - (do meta-monad - [=fields (monad\map meta-monad + (do meta_monad + [=fields (monad\map meta_monad ("lux check" (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] - (do meta-monad + (do meta_monad [=k (untemplate replace? subst k) =v (untemplate replace? subst v)] (wrap (tuple$ (list =k =v))))))) fields)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} + (wrap (wrap_meta (form$ (list (tag$ ["lux" "Record"]) (untemplate_list =fields))))))} [replace? token])) (macro:' #export (primitive tokens) @@ -1892,29 +1892,29 @@ "## Macro to treat define new primitive types." __paragraph "(primitive ''java.lang.Object'')" __paragraph "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) - ({(#Cons [_ (#Text class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + ({(#Cons [_ (#Text class_name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class_name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Text class_name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class_name) (untemplate_list params))))) _ (fail "Wrong syntax for primitive")} tokens)) -(def:'' (current-module-name state) +(def:'' (current_module_name state) #Nil ($' Meta Text) - ({{#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host + ({{#info info #source source #current_module current_module #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - ({(#Some module-name) - (#Right [state module-name]) + #scope_type_vars scope_type_vars} + ({(#Some module_name) + (#Right [state module_name]) _ (#Left "Cannot get the module name without a module!")} - current-module)} + current_module)} state)) (macro:' #export (` tokens) @@ -1924,9 +1924,9 @@ "## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." __paragraph "(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) - (do meta-monad - [current-module current-module-name - =template (untemplate #1 current-module template)] + (do meta_monad + [current_module current_module_name + =template (untemplate #1 current_module template)] (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) @@ -1941,7 +1941,7 @@ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph "(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) - (do meta-monad + (do meta_monad [=template (untemplate #1 "" template)] (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) @@ -1955,7 +1955,7 @@ "## Quotation as a macro." __paragraph "(' YOLO)"))]) ({(#Cons template #Nil) - (do meta-monad + (do meta_monad [=template (untemplate #0 "" template)] (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) @@ -2022,7 +2022,7 @@ (-> (-> b c) (-> a b) (-> a c))) (function' [x] (f (g x)))) -(def:''' (get-name x) +(def:''' (get_name x) #Nil (-> Code ($' Maybe Name)) ({[_ (#Identifier sname)] @@ -2032,7 +2032,7 @@ #None} x)) -(def:''' (get-tag x) +(def:''' (get_tag x) #Nil (-> Code ($' Maybe Name)) ({[_ (#Tag sname)] @@ -2042,7 +2042,7 @@ #None} x)) -(def:''' (get-short x) +(def:''' (get_short x) #Nil (-> Code ($' Maybe Text)) ({[_ (#Identifier "" sname)] @@ -2062,7 +2062,7 @@ #None} tuple)) -(def:''' (apply-template env template) +(def:''' (apply_template env template) #Nil (-> RepEnv Code Code) ({[_ (#Identifier "" sname)] @@ -2071,19 +2071,19 @@ _ template} - (get-rep sname env)) + (get_rep sname env)) [meta (#Tuple elems)] - [meta (#Tuple (list\map (apply-template env) elems))] + [meta (#Tuple (list\map (apply_template env) elems))] [meta (#Form elems)] - [meta (#Form (list\map (apply-template env) elems))] + [meta (#Form (list\map (apply_template env) elems))] [meta (#Record members)] [meta (#Record (list\map ("lux check" (-> (& Code Code) (& Code Code)) (function' [kv] (let' [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) + [(apply_template env slot) (apply_template env value)]))) members))] _ @@ -2096,32 +2096,32 @@ (-> (-> a Bit) ($' List a) Bit)) (list\fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) -(def:''' (high-bits value) +(def:''' (high_bits value) (list) (-> ($' I64 Any) I64) ("lux i64 logical-right-shift" 32 value)) -(def:''' low-mask +(def:''' low_mask (list) I64 (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) -(def:''' (low-bits value) +(def:''' (low_bits value) (list) (-> ($' I64 Any) I64) - ("lux i64 and" low-mask value)) + ("lux i64 and" low_mask value)) (def:''' (n/< reference sample) (list) (-> Nat Nat Bit) - (let' [referenceH (high-bits reference) - sampleH (high-bits sample)] + (let' [referenceH (high_bits reference) + sampleH (high_bits sample)] (if ("lux i64 <" referenceH sampleH) #1 (if ("lux i64 =" referenceH sampleH) ("lux i64 <" - (low-bits reference) - (low-bits sample)) + (low_bits reference) + (low_bits sample)) #0)))) (def:''' (n/<= reference sample) @@ -2141,27 +2141,27 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." __paragraph - "(template [ ]" ..new-line + "(template [ ]" ..new_line " " "[(def: #export (-> Int Int) (+ ))]" __paragraph - " " "[inc +1]" ..new-line + " " "[inc +1]" ..new_line " " "[dec -1]"))]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (list\map (apply-template env) templates))) - num-bindings (list\size bindings')] - (if (every? (function' [size] ("lux i64 =" num-bindings size)) + (function' [env] (list\map (apply_template env) templates))) + num_bindings (list\size bindings')] + (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list\map list\size data')) (|> data' - (list\map (compose apply (make-env bindings'))) + (list\map (compose apply (make_env bindings'))) list\join return) (fail "Irregular arguments tuples for template."))) _ (fail "Wrong syntax for template")} - [(monad\map maybe-monad get-short bindings) - (monad\map maybe-monad tuple->list data)]) + [(monad\map maybe_monad get_short bindings) + (monad\map maybe_monad tuple->list data)]) _ (fail "Wrong syntax for template")} @@ -2277,7 +2277,7 @@ (-> Bit Bit) (if x #0 #1)) -(def:''' (macro-type? type) +(def:''' (macro_type? type) (list) (-> Type Bit) ({(#Named ["lux" "Macro"] (#Primitive "#Macro" #Nil)) @@ -2287,24 +2287,24 @@ #0} type)) -(def:''' (find-macro' modules current-module module name) +(def:''' (find_macro' modules current_module module name) #Nil (-> ($' List (& Text Module)) Text Text Text ($' Maybe Macro)) - (do maybe-monad + (do maybe_monad [$module (get module modules) - gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] + gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux check" Module $module)] (get name bindings))] - ({(#Left [r-module r-name]) - (find-macro' modules current-module r-module r-name) + ({(#Left [r_module r_name]) + (find_macro' modules current_module r_module r_name) - (#Right [exported? def-type def-meta def-value]) - (if (macro-type? def-type) + (#Right [exported? def_type def_meta def_value]) + (if (macro_type? def_type) (if exported? - (#Some ("lux coerce" Macro def-value)) - (if (text\= module current-module) - (#Some ("lux coerce" Macro def-value)) + (#Some ("lux coerce" Macro def_value)) + (if (text\= module current_module) + (#Some ("lux coerce" Macro def_value)) #None)) #None)} ("lux check" Global gdef)))) @@ -2313,35 +2313,35 @@ #Nil (-> Name ($' Meta Name)) ({["" name] - (do meta-monad - [module-name current-module-name] - (wrap [module-name name])) + (do meta_monad + [module_name current_module_name] + (wrap [module_name name])) _ (return name)} name)) -(def:''' (find-macro full-name) +(def:''' (find_macro full_name) #Nil (-> Name ($' Meta ($' Maybe Macro))) - (do meta-monad - [current-module current-module-name] - (let' [[module name] full-name] + (do meta_monad + [current_module current_module_name] + (let' [[module name] full_name] (function' [state] - ({{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + ({{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (#Right state (find-macro' modules current-module module name))} + #scope_type_vars scope_type_vars} + (#Right state (find_macro' modules current_module module name))} state))))) (def:''' (macro? name) #Nil (-> Name ($' Meta Bit)) - (do meta-monad + (do meta_monad [name (normalize name) - output (find-macro name)] + output (find_macro name)] (wrap ({(#Some _) #1 #None #0} output)))) @@ -2360,13 +2360,13 @@ (list& x sep (interpose sep xs'))} xs)) -(def:''' (macro-expand-once token) +(def:''' (macro_expand_once token) #Nil (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))] - (do meta-monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] ({(#Some macro) (("lux coerce" Macro' macro) args) @@ -2378,17 +2378,17 @@ (return (list token))} token)) -(def:''' (macro-expand token) +(def:''' (macro_expand token) #Nil (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))] - (do meta-monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] ({(#Some macro) - (do meta-monad + (do meta_monad [expansion (("lux coerce" Macro' macro) args) - expansion' (monad\map meta-monad macro-expand expansion)] + expansion' (monad\map meta_monad macro_expand expansion)] (wrap (list\join expansion'))) #None @@ -2399,42 +2399,42 @@ (return (list token))} token)) -(def:''' (macro-expand-all syntax) +(def:''' (macro_expand_all syntax) #Nil (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))] - (do meta-monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] ({(#Some macro) - (do meta-monad + (do meta_monad [expansion (("lux coerce" Macro' macro) args) - expansion' (monad\map meta-monad macro-expand-all expansion)] + expansion' (monad\map meta_monad macro_expand_all expansion)] (wrap (list\join expansion'))) #None - (do meta-monad - [args' (monad\map meta-monad macro-expand-all args)] - (wrap (list (form$ (#Cons (identifier$ macro-name) (list\join args'))))))} + (do meta_monad + [args' (monad\map meta_monad macro_expand_all args)] + (wrap (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} ?macro)) [_ (#Form members)] - (do meta-monad - [members' (monad\map meta-monad macro-expand-all members)] + (do meta_monad + [members' (monad\map meta_monad macro_expand_all members)] (wrap (list (form$ (list\join members'))))) [_ (#Tuple members)] - (do meta-monad - [members' (monad\map meta-monad macro-expand-all members)] + (do meta_monad + [members' (monad\map meta_monad macro_expand_all members)] (wrap (list (tuple$ (list\join members'))))) [_ (#Record pairs)] - (do meta-monad - [pairs' (monad\map meta-monad + (do meta_monad + [pairs' (monad\map meta_monad (function' [kv] (let' [[key val] kv] - (do meta-monad - [val' (macro-expand-all val)] + (do meta_monad + [val' (macro_expand_all val)] ({(#Cons val'' #Nil) (return [key val'']) @@ -2448,29 +2448,29 @@ (return (list syntax))} syntax)) -(def:''' (walk-type type) +(def:''' (walk_type type) #Nil (-> Code Code) ({[_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (list\map walk-type parts)])) + (form$ (#Cons [(tag$ tag) (list\map walk_type parts)])) [_ (#Tuple members)] - (` (& (~+ (list\map walk-type members)))) + (` (& (~+ (list\map walk_type members)))) [_ (#Form (#Cons [_ (#Text "lux in-module")] (#Cons [_ (#Text module)] (#Cons type' #Nil))))] - (` ("lux in-module" (~ (text$ module)) (~ (walk-type type')))) + (` ("lux in-module" (~ (text$ module)) (~ (walk_type type')))) [_ (#Form (#Cons [_ (#Identifier ["" ":~"])] (#Cons expression #Nil)))] expression - [_ (#Form (#Cons type-fn args))] + [_ (#Form (#Cons type_fn args))] (list\fold ("lux check" (-> Code Code Code) - (function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn))))) - (walk-type type-fn) - (list\map walk-type args)) + (function' [arg type_fn] (` (#.Apply (~ arg) (~ type_fn))))) + (walk_type type_fn) + (list\map walk_type args)) _ type} @@ -2482,10 +2482,10 @@ "## Takes a type expression and returns it's representation as data-structure." __paragraph "(type (All [a] (Maybe (List a))))"))]) ({(#Cons type #Nil) - (do meta-monad - [type+ (macro-expand-all type)] + (do meta_monad + [type+ (macro_expand_all type)] ({(#Cons type' #Nil) - (wrap (list (walk-type type'))) + (wrap (list (walk_type type'))) _ (fail "The expansion of the type-syntax had to yield a single element.")} @@ -2535,16 +2535,16 @@ [first a x] [second b y]) -(def:''' (unfold-type-def type-codes) +(def:''' (unfold_type_def type_codes) #Nil (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) ({(#Cons [_ (#Record pairs)] #Nil) - (do meta-monad - [members (monad\map meta-monad + (do meta_monad + [members (monad\map meta_monad (: (-> [Code Code] (Meta [Text Code])) (function' [pair] - ({[[_ (#Tag "" member-name)] member-type] - (return [member-name member-type]) + ({[[_ (#Tag "" member_name)] member_type] + (return [member_name member_type]) _ (fail "Wrong syntax for variant case.")} @@ -2554,29 +2554,29 @@ (#Some (list\map first members))])) (#Cons type #Nil) - ({[_ (#Tag "" member-name)] - (return [(` .Any) (#Some (list member-name))]) + ({[_ (#Tag "" member_name)] + (return [(` .Any) (#Some (list member_name))]) - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [(` (& (~+ member-types))) (#Some (list member-name))]) + [_ (#Form (#Cons [_ (#Tag "" member_name)] member_types))] + (return [(` (& (~+ member_types))) (#Some (list member_name))]) _ (return [type #None])} type) (#Cons case cases) - (do meta-monad - [members (monad\map meta-monad + (do meta_monad + [members (monad\map meta_monad (: (-> Code (Meta [Text Code])) (function' [case] - ({[_ (#Tag "" member-name)] - (return [member-name (` .Any)]) + ({[_ (#Tag "" member_name)] + (return [member_name (` .Any)]) - [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] - (return [member-name member-type]) + [_ (#Form (#Cons [_ (#Tag "" member_name)] (#Cons member_type #Nil)))] + (return [member_name member_type]) - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [member-name (` (& (~+ member-types)))]) + [_ (#Form (#Cons [_ (#Tag "" member_name)] member_types))] + (return [member_name (` (& (~+ member_types)))]) _ (fail "Wrong syntax for variant case.")} @@ -2587,22 +2587,22 @@ _ (fail "Improper type-definition syntax")} - type-codes)) + type_codes)) (def:''' (gensym prefix state) #Nil (-> Text ($' Meta Code)) - ({{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + ({{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (#Right {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + #scope_type_vars scope_type_vars} + (#Right {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed ("lux i64 +" 1 seed) #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (local-identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} + #scope_type_vars scope_type_vars} + (local_identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} state)) (macro:' #export (Rec tokens) @@ -2612,8 +2612,8 @@ "## A name has to be given to the whole type, to use it within its body." __paragraph "(Rec Self [Int (List Self)])"))]) ({(#Cons [_ (#Identifier "" name)] (#Cons body #Nil)) - (let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-parameter 1)) (~ (make-parameter 0))))]) - (update-parameters body))] + (let' [body' (replace_syntax (list [name (` (#.Apply (~ (make_parameter 1)) (~ (make_parameter 0))))]) + (update_parameters body))] (return (list (` (#.Apply .Nothing (#.UnivQ #.Nil (~ body'))))))) _ @@ -2624,13 +2624,13 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Sequential execution of expressions (great for side-effects)." __paragraph - "(exec" ..new-line - " " "(log! ''#1'')" ..new-line - " " "(log! ''#2'')" ..new-line - " " "(log! ''#3'')" ..new-line + "(exec" ..new_line + " " "(log! ''#1'')" ..new_line + " " "(log! ''#2'')" ..new_line + " " "(log! ''#3'')" ..new_line "''YOLO'')"))]) ({(#Cons value actions) - (let' [dummy (local-identifier$ "")] + (let' [dummy (local_identifier$ "")] (return (list (list\fold ("lux check" (-> Code Code Code) (function' [pre post] (` ({(~ dummy) (~ post)} (~ pre))))) @@ -2679,7 +2679,7 @@ ?type)] (return (list (` ("lux def" (~ name) (~ body'') - [(~ location-code) + [(~ location_code) (#.Record #.Nil)] (~ (bit$ export?))))))) @@ -2687,14 +2687,14 @@ (fail "Wrong syntax for def'")} parts))) -(def:' (rejoin-pair pair) +(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)) + ($_ text\compose ..double_quote original ..double_quote)) (def:' (code\encode code) (-> Code Text) @@ -2751,28 +2751,28 @@ (def:' (expander branches) (-> (List Code) (Meta (List Code))) - ({(#Cons [_ (#Form (#Cons [_ (#Identifier macro-name)] macro-args))] + ({(#Cons [_ (#Form (#Cons [_ (#Identifier macro_name)] macro_args))] (#Cons body branches')) - (do meta-monad - [??? (macro? macro-name)] + (do meta_monad + [??? (macro? macro_name)] (if ??? - (do meta-monad - [init-expansion (macro-expand-once (form$ (list& (identifier$ macro-name) (form$ macro-args) body branches')))] - (expander init-expansion)) - (do meta-monad - [sub-expansion (expander branches')] - (wrap (list& (form$ (list& (identifier$ macro-name) macro-args)) + (do meta_monad + [init_expansion (macro_expand_once (form$ (list& (identifier$ macro_name) (form$ macro_args) body branches')))] + (expander init_expansion)) + (do meta_monad + [sub_expansion (expander branches')] + (wrap (list& (form$ (list& (identifier$ macro_name) macro_args)) body - sub-expansion))))) + sub_expansion))))) (#Cons pattern (#Cons body branches')) - (do meta-monad - [sub-expansion (expander branches')] - (wrap (list& pattern body sub-expansion))) + (do meta_monad + [sub_expansion (expander branches')] + (wrap (list& pattern body sub_expansion))) #Nil - (do meta-monad [] (wrap (list))) + (do meta_monad [] (wrap (list))) _ (fail ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches @@ -2785,17 +2785,17 @@ (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## The pattern-matching macro." ..new-line - "## Allows the usage of macros within the patterns to provide custom syntax." ..new-line - "(case (: (List Int) (list +1 +2 +3))" ..new-line - " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new-line + "## The pattern-matching macro." ..new_line + "## Allows the usage of macros within the patterns to provide custom syntax." ..new_line + "(case (: (List Int) (list +1 +2 +3))" ..new_line + " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new_line " " "(#Some ($_ * x y z))" __paragraph - " " "_" ..new-line + " " "_" ..new_line " " "#None)"))]) ({(#Cons value branches) - (do meta-monad + (do meta_monad [expansion (expander branches)] - (wrap (list (` ((~ (record$ (as-pairs expansion))) (~ value)))))) + (wrap (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) _ (fail "Wrong syntax for case")} @@ -2804,18 +2804,18 @@ (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-expanding patterns." ..new-line - "## It's a special macro meant to be used with 'case'." ..new-line - "(case (: (List Int) (list +1 +2 +3))" ..new-line - " (^ (list x y z))" ..new-line + "## Macro-expanding patterns." ..new_line + "## It's a special macro meant to be used with 'case'." ..new_line + "(case (: (List Int) (list +1 +2 +3))" ..new_line + " (^ (list x y z))" ..new_line " (#Some ($_ * x y z))" __paragraph - " _" ..new-line + " _" ..new_line " #None)"))]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) - (do meta-monad - [pattern+ (macro-expand-all pattern)] + (do meta_monad + [pattern+ (macro_expand_all pattern)] (case pattern+ (#Cons pattern' #Nil) (wrap (list& pattern' body branches)) @@ -2829,17 +2829,17 @@ (macro:' #export (^or tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Or-patterns." ..new-line - "## It's a special macro meant to be used with 'case'." ..new-line + "## Or-patterns." ..new_line + "## It's a special macro meant to be used with 'case'." ..new_line "(type: Weekday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday)" __paragraph - "(def: (weekend? day)" ..new-line - " (-> Weekday Bit)" ..new-line - " (case day" ..new-line - " (^or #Saturday #Sunday)" ..new-line + "(def: (weekend? day)" ..new_line + " (-> Weekday Bit)" ..new_line + " (case day" ..new_line + " (^or #Saturday #Sunday)" ..new_line " #1" __paragraph - " _" ..new-line + " _" ..new_line " #0))"))]) (case tokens (^ (list& [_ (#Form patterns)] body branches)) @@ -2867,15 +2867,15 @@ (macro:' #export (let tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Creates local bindings." ..new-line - "## Can (optionally) use pattern-matching macros when binding." ..new-line - "(let [x (foo bar)" ..new-line - " y (baz quux)]" ..new-line + "## Creates local bindings." ..new_line + "## Can (optionally) use pattern-matching macros when binding." ..new_line + "(let [x (foo bar)" ..new_line + " y (baz quux)]" ..new_line " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (list\size bindings)) - (|> bindings as-pairs list\reverse + (|> bindings as_pairs list\reverse (list\fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] @@ -2893,12 +2893,12 @@ (macro:' #export (function tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Syntax for creating functions." ..new-line - "## Allows for giving the function itself a name, for the sake of recursion." ..new-line - "(: (All [a b] (-> a b a))" ..new-line + "## Syntax for creating functions." ..new_line + "## Allows for giving the function itself a name, for the sake of recursion." ..new_line + "(: (All [a b] (-> a b a))" ..new_line " (function (_ x y) x))" __paragraph - "(: (All [a b] (-> a b a))" ..new-line + "(: (All [a b] (-> a b a))" ..new_line " (function (const x y) x))"))]) (case (: (Maybe [Text Code (List Code) Code]) (case tokens @@ -2908,7 +2908,7 @@ _ #None)) (#Some g!name head tail body) - (let [g!blank (local-identifier$ "") + (let [g!blank (local_identifier$ "") nest (: (-> Code (-> Code Code Code)) (function' [g!name] (function' [arg body'] @@ -2916,77 +2916,77 @@ (` ([(~ g!name) (~ arg)] (~ body'))) (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] - (return (list (nest (..local-identifier$ g!name) head + (return (list (nest (..local_identifier$ g!name) head (list\fold (nest g!blank) body (list\reverse tail)))))) #None (fail "Wrong syntax for function"))) -(def:' (process-def-meta-value code) +(def:' (process_def_meta_value code) (-> Code Code) (case code [_ (#Bit value)] - (meta-code ["lux" "Bit"] (bit$ value)) + (meta_code ["lux" "Bit"] (bit$ value)) [_ (#Nat value)] - (meta-code ["lux" "Nat"] (nat$ value)) + (meta_code ["lux" "Nat"] (nat$ value)) [_ (#Int value)] - (meta-code ["lux" "Int"] (int$ value)) + (meta_code ["lux" "Int"] (int$ value)) [_ (#Rev value)] - (meta-code ["lux" "Rev"] (rev$ value)) + (meta_code ["lux" "Rev"] (rev$ value)) [_ (#Frac value)] - (meta-code ["lux" "Frac"] (frac$ value)) + (meta_code ["lux" "Frac"] (frac$ value)) [_ (#Text value)] - (meta-code ["lux" "Text"] (text$ value)) + (meta_code ["lux" "Text"] (text$ value)) [_ (#Tag [prefix name])] - (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) + (meta_code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) (^or [_ (#Form _)] [_ (#Identifier _)]) code [_ (#Tuple xs)] (|> xs - (list\map process-def-meta-value) - untemplate-list - (meta-code ["lux" "Tuple"])) + (list\map process_def_meta_value) + untemplate_list + (meta_code ["lux" "Tuple"])) [_ (#Record kvs)] (|> kvs (list\map (: (-> [Code Code] Code) (function (_ [k v]) - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))])))) - untemplate-list - (meta-code ["lux" "Record"])) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))])))) + untemplate_list + (meta_code ["lux" "Record"])) )) -(def:' (process-def-meta kvs) +(def:' (process_def_meta kvs) (-> (List [Code Code]) Code) - (untemplate-list (list\map (: (-> [Code Code] Code) + (untemplate_list (list\map (: (-> [Code Code] Code) (function (_ [k v]) - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))]))) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))]))) kvs))) -(def:' (with-func-args args meta) +(def:' (with_func_args args meta) (-> (List Code) Code Code) (case args #Nil meta _ - (` (#.Cons [[(~ location-code) (#.Tag ["lux" "func-args"])] - [(~ location-code) (#.Tuple (.list (~+ (list\map (function (_ arg) - (` [(~ location-code) (#.Text (~ (text$ (code\encode arg))))])) + (` (#.Cons [[(~ location_code) (#.Tag ["lux" "func-args"])] + [(~ location_code) (#.Tuple (.list (~+ (list\map (function (_ arg) + (` [(~ location_code) (#.Text (~ (text$ (code\encode arg))))])) args))))]] (~ meta))))) -(def:' (with-type-args args) +(def:' (with_type_args args) (-> (List Code) Code) (` {#.type-args [(~+ (list\map (function (_ arg) (text$ (code\encode arg))) args))]})) @@ -3009,29 +3009,29 @@ (macro:' #export (def: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Defines global constants/functions." ..new-line - "(def: (rejoin-pair pair)" ..new-line - " (-> [Code Code] (List Code))" ..new-line - " (let [[left right] pair]" ..new-line + "## Defines global constants/functions." ..new_line + "(def: (rejoin_pair pair)" ..new_line + " (-> [Code Code] (List Code))" ..new_line + " (let [[left right] pair]" ..new_line " (list left right)))" __paragraph - "(def: branching-exponent" ..new-line - " Int" ..new-line + "(def: branching_exponent" ..new_line + " Int" ..new_line " +5)"))]) (let [[exported? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) (case tokens' - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) - (#Some [name args (#Some type) body meta-kvs]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta_kvs)] type body)) + (#Some [name args (#Some type) body meta_kvs]) - (^ (list name [_ (#Record meta-kvs)] type body)) - (#Some [name #Nil (#Some type) body meta-kvs]) + (^ (list name [_ (#Record meta_kvs)] type body)) + (#Some [name #Nil (#Some type) body meta_kvs]) - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) - (#Some [name args #None body meta-kvs]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta_kvs)] body)) + (#Some [name args #None body meta_kvs]) - (^ (list name [_ (#Record meta-kvs)] body)) - (#Some [name #Nil #None body meta-kvs]) + (^ (list name [_ (#Record meta_kvs)] body)) + (#Some [name #Nil #None body meta_kvs]) (^ (list [_ (#Form (#Cons name args))] type body)) (#Some [name args (#Some type) body #Nil]) @@ -3061,17 +3061,17 @@ #None body) - =meta (process-def-meta meta)] + =meta (process_def_meta meta)] (return (list (` ("lux def" (~ name) (~ body) - [(~ location-code) - (#.Record (~ (with-func-args args =meta)))] + [(~ location_code) + (#.Record (~ (with_func_args args =meta)))] (~ (bit$ exported?))))))) #None (fail "Wrong syntax for def:")))) -(def: (meta-code-add addition meta) +(def: (meta_code_add addition meta) (-> [Code Code] Code Code) (case [addition meta] [[name value] [location (#Record pairs)]] @@ -3080,11 +3080,11 @@ _ meta)) -(def: (meta-code-merge addition base) +(def: (meta_code_merge addition base) (-> Code Code Code) (case addition [location (#Record pairs)] - (list\fold meta-code-add base pairs) + (list\fold meta_code_add base pairs) _ base)) @@ -3092,16 +3092,16 @@ (macro:' #export (macro: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-definition macro." ..new-line - "(macro: #export (name-of tokens)" ..new-line - " (case tokens" ..new-line - " (^template []" ..new-line - " [(^ (list [_ ( [prefix name])]))" ..new-line - " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new-line + "## Macro-definition macro." ..new_line + "(macro: #export (name_of tokens)" ..new_line + " (case tokens" ..new_line + " (^template []" ..new_line + " [(^ (list [_ ( [prefix name])]))" ..new_line + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new_line " ([#Identifier] [#Tag])" __paragraph - " _" ..new-line - " (fail ''Wrong syntax for name-of'')))"))]) + " _" ..new_line + " (fail ''Wrong syntax for name_of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) (List [Code Code]) Code]) (case tokens @@ -3111,11 +3111,11 @@ (^ (list [_ (#Identifier name)] body)) (#Some [name #Nil (list) body]) - (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [_ (#Record meta-rec-parts)] body)) - (#Some [name args meta-rec-parts body]) + (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [_ (#Record meta_rec_parts)] body)) + (#Some [name args meta_rec_parts body]) - (^ (list [_ (#Identifier name)] [_ (#Record meta-rec-parts)] body)) - (#Some [name #Nil meta-rec-parts body]) + (^ (list [_ (#Identifier name)] [_ (#Record meta_rec_parts)] body)) + (#Some [name #Nil meta_rec_parts body]) _ #None))] @@ -3129,10 +3129,10 @@ _ (` ("lux macro" (function ((~ name) (~+ args)) (~ body))))) - =meta (process-def-meta meta)] + =meta (process_def_meta meta)] (return (list (` ("lux def" (~ name) (~ body) - [(~ location-code) + [(~ location_code) (#Record (~ =meta))] (~ (bit$ exported?))))))) @@ -3141,26 +3141,26 @@ (macro: #export (signature: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of signatures ala ML." ..new-line - "(signature: #export (Ord a)" ..new-line - " (: (Equivalence a)" ..new-line - " eq)" ..new-line - " (: (-> a a Bit)" ..new-line - " <)" ..new-line - " (: (-> a a Bit)" ..new-line - " <=)" ..new-line - " (: (-> a a Bit)" ..new-line - " >)" ..new-line - " (: (-> a a Bit)" ..new-line + "## Definition of signatures ala ML." ..new_line + "(signature: #export (Ord a)" ..new_line + " (: (Equivalence a)" ..new_line + " eq)" ..new_line + " (: (-> a a Bit)" ..new_line + " <)" ..new_line + " (: (-> a a Bit)" ..new_line + " <=)" ..new_line + " (: (-> a a Bit)" ..new_line + " >)" ..new_line + " (: (-> a a Bit)" ..new_line " >=))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Name (List Code) Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta-rec-location (#Record meta-rec-parts)] sigs)) - (#Some name args [meta-rec-location (#Record meta-rec-parts)] sigs) + (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta_rec_location (#Record meta_rec_parts)] sigs)) + (#Some name args [meta_rec_location (#Record meta_rec_parts)] sigs) - (^ (list& [_ (#Identifier name)] [meta-rec-location (#Record meta-rec-parts)] sigs)) - (#Some name #Nil [meta-rec-location (#Record meta-rec-parts)] sigs) + (^ (list& [_ (#Identifier name)] [meta_rec_location (#Record meta_rec_parts)] sigs)) + (#Some name #Nil [meta_rec_location (#Record meta_rec_parts)] sigs) (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] sigs)) (#Some name args (` {}) sigs) @@ -3172,11 +3172,11 @@ #None))] (case ?parts (#Some name args meta sigs) - (do meta-monad + (do meta_monad [name+ (normalize name) - sigs' (monad\map meta-monad macro-expand sigs) + sigs' (monad\map meta_monad macro_expand sigs) members (: (Meta (List [Text Code])) - (monad\map meta-monad + (monad\map meta_monad (: (-> Code (Meta [Text Code])) (function (_ token) (case token @@ -3187,20 +3187,20 @@ (fail "Signatures require typed members!")))) (list\join sigs'))) #let [[_module _name] name+ - def-name (identifier$ name) - sig-type (record$ (list\map (: (-> [Text Code] [Code Code]) - (function (_ [m-name m-type]) - [(local-tag$ m-name) m-type])) + def_name (identifier$ name) + sig_type (record$ (list\map (: (-> [Text Code] [Code Code]) + (function (_ [m_name m_type]) + [(local_tag$ m_name) m_type])) members)) - sig-meta (meta-code-merge (` {#.sig? #1}) + sig_meta (meta_code_merge (` {#.sig? #1}) meta) usage (case args #Nil - def-name + def_name _ - (` ((~ def-name) (~+ args))))]] - (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + (` ((~ def_name) (~+ args))))]] + (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig_meta) (~ sig_type)))))) #None (fail "Wrong syntax for signature:")))) @@ -3220,9 +3220,9 @@ (#Some y) (#Some y)))) -(template [
] +(template [ ] [(macro: #export ( tokens) - {#.doc } + {#.doc } (case (list\reverse tokens) (^ (list& last init)) (return (list (list\fold (: (-> Code Code Code) @@ -3236,20 +3236,20 @@ [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) -(def: (index-of part text) +(def: (index_of part text) (-> Text Text (Maybe Nat)) ("lux text index" 0 part text)) (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" - "## Causes an error, with the given error message." ..new-line + "## Causes an error, with the given error message." ..new_line "(error! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) (macro: (default tokens state) {#.doc (text$ ($_ "lux text concat" - "## Allows you to provide a default value that will be used" ..new-line + "## Allows you to provide a default value that will be used" ..new_line "## if a (Maybe x) value turns out to be #.None." __paragraph "(default +20 (#.Some +10)) ## => +10" @@ -3257,7 +3257,7 @@ "(default +20 #.None) ## => +20"))} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-location (#Identifier ["" ""])]) + (let [g!temp (: Code [dummy_location (#Identifier ["" ""])]) code (` (case (~ maybe) (#.Some (~ g!temp)) (~ g!temp) @@ -3269,15 +3269,15 @@ _ (#Left "Wrong syntax for default"))) -(def: (text\split-all-with splitter input) +(def: (text\split_all_with splitter input) (-> Text Text (List Text)) - (case (..index-of splitter input) + (case (..index_of splitter input) #None (list input) (#Some idx) (list& ("lux text clip" 0 idx input) - (text\split-all-with splitter + (text\split_all_with splitter ("lux text clip" ("lux i64 +" 1 idx) ("lux text size" input) input))))) (def: (nth idx xs) @@ -3293,36 +3293,36 @@ (nth ("lux i64 -" 1 idx) xs') ))) -(def: (beta-reduce env type) +(def: (beta_reduce env type) (-> (List Type) Type Type) (case type (#Sum left right) - (#Sum (beta-reduce env left) (beta-reduce env right)) + (#Sum (beta_reduce env left) (beta_reduce env right)) (#Product left right) - (#Product (beta-reduce env left) (beta-reduce env right)) + (#Product (beta_reduce env left) (beta_reduce env right)) (#Apply arg func) - (#Apply (beta-reduce env arg) (beta-reduce env func)) + (#Apply (beta_reduce env arg) (beta_reduce env func)) - (#UnivQ ?local-env ?local-def) - (case ?local-env + (#UnivQ ?local_env ?local_def) + (case ?local_env #Nil - (#UnivQ env ?local-def) + (#UnivQ env ?local_def) _ type) - (#ExQ ?local-env ?local-def) - (case ?local-env + (#ExQ ?local_env ?local_def) + (case ?local_env #Nil - (#ExQ env ?local-def) + (#ExQ env ?local_def) _ type) (#Function ?input ?output) - (#Function (beta-reduce env ?input) (beta-reduce env ?output)) + (#Function (beta_reduce env ?input) (beta_reduce env ?output)) (#Parameter idx) (case (nth idx env) @@ -3333,28 +3333,28 @@ type) (#Named name type) - (beta-reduce env type) + (beta_reduce env type) _ type )) -(def: (apply-type type-fn param) +(def: (apply_type type_fn param) (-> Type Type (Maybe Type)) - (case type-fn + (case type_fn (#UnivQ env body) - (#Some (beta-reduce (list& type-fn param env) body)) + (#Some (beta_reduce (list& type_fn param env) body)) (#ExQ env body) - (#Some (beta-reduce (list& type-fn param env) body)) + (#Some (beta_reduce (list& type_fn param env) body)) (#Apply A F) - (do maybe-monad - [type-fn* (apply-type F A)] - (apply-type type-fn* param)) + (do maybe_monad + [type_fn* (apply_type F A)] + (apply_type type_fn* param)) (#Named name type) - (apply-type type param) + (apply_type type param) _ #None)) @@ -3369,40 +3369,40 @@ _ (list type)))] - [flatten-variant #Sum] - [flatten-tuple #Product] - [flatten-lambda #Function] + [flatten_variant #Sum] + [flatten_tuple #Product] + [flatten_lambda #Function] ) -(def: (flatten-app type) +(def: (flatten_app type) (-> Type [Type (List Type)]) (case type (#Apply head func') - (let [[func tail] (flatten-app func')] + (let [[func tail] (flatten_app func')] [func (#Cons head tail)]) _ [type (list)])) -(def: (resolve-struct-type type) +(def: (resolve_struct_type type) (-> Type (Maybe (List Type))) (case type (#Product _) - (#Some (flatten-tuple type)) + (#Some (flatten_tuple type)) (#Apply arg func) - (do maybe-monad - [output (apply-type func arg)] - (resolve-struct-type output)) + (do maybe_monad + [output (apply_type func arg)] + (resolve_struct_type output)) (#UnivQ _ body) - (resolve-struct-type body) + (resolve_struct_type body) (#ExQ _ body) - (resolve-struct-type body) + (resolve_struct_type body) (#Named name type) - (resolve-struct-type type) + (resolve_struct_type type) (#Sum _) #None @@ -3410,13 +3410,13 @@ _ (#Some (list type)))) -(def: (find-module name) +(def: (find_module name) (-> Text (Meta Module)) (function (_ state) - (let [{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] + #scope_type_vars scope_type_vars} state] (case (get name modules) (#Some module) (#Right state module) @@ -3424,43 +3424,43 @@ _ (#Left ($_ text\compose "Unknown module: " name)))))) -(def: get-current-module +(def: get_current_module (Meta Module) - (do meta-monad - [module-name current-module-name] - (find-module module-name))) + (do meta_monad + [module_name current_module_name] + (find_module module_name))) -(def: (resolve-tag [module name]) +(def: (resolve_tag [module name]) (-> Name (Meta [Nat (List Name) Bit Type])) - (do meta-monad - [=module (find-module module) - #let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]] - (case (get name tags-table) + (do meta_monad + [=module (find_module module) + #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] + (case (get name tags_table) (#Some output) (return output) _ (fail (text\compose "Unknown tag: " (name\encode [module name])))))) -(def: (resolve-type-tags type) +(def: (resolve_type_tags type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) (case type (#Apply arg func) - (resolve-type-tags func) + (resolve_type_tags func) (#UnivQ env body) - (resolve-type-tags body) + (resolve_type_tags body) (#ExQ env body) - (resolve-type-tags body) + (resolve_type_tags body) (#Named [module name] unnamed) - (do meta-monad - [=module (find-module module) - #let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]] + (do meta_monad + [=module (find_module module) + #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 (resolve_struct_type _type) (#Some members) (return (#Some [tags members])) @@ -3468,18 +3468,18 @@ (return #None)) _ - (resolve-type-tags unnamed))) + (resolve_type_tags unnamed))) _ (return #None))) -(def: get-expected-type +(def: get_expected_type (Meta Type) (function (_ state) - (let [{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] + #scope_type_vars scope_type_vars} state] (case expected (#Some type) (#Right state type) @@ -3489,10 +3489,10 @@ (macro: #export (structure tokens) {#.doc "Not meant to be used directly. Prefer 'structure:'."} - (do meta-monad - [tokens' (monad\map meta-monad macro-expand tokens) - struct-type get-expected-type - tags+type (resolve-type-tags struct-type) + (do meta_monad + [tokens' (monad\map meta_monad macro_expand tokens) + struct_type get_expected_type + tags+type (resolve_type_tags struct_type) tags (: (Meta (List Name)) (case tags+type (#Some [tags _]) @@ -3500,27 +3500,27 @@ _ (fail "No tags available for type."))) - #let [tag-mappings (: (List [Text Code]) + #let [tag_mappings (: (List [Text Code]) (list\map (function (_ tag) [(second tag) (tag$ tag)]) tags))] - members (monad\map meta-monad + members (monad\map meta_monad (: (-> Code (Meta [Code Code])) (function (_ token) (case token - (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag-name)] value meta [_ (#Bit #0)]))]) - (case (get tag-name tag-mappings) + (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta [_ (#Bit #0)]))]) + (case (get tag_name tag_mappings) (#Some tag) (wrap [tag value]) _ - (fail (text\compose "Unknown structure member: " tag-name))) + (fail (text\compose "Unknown structure member: " tag_name))) _ (fail "Invalid structure member.")))) (list\join tokens'))] (wrap (list (record$ members))))) -(def: (text\join-with separator parts) +(def: (text\join_with separator parts) (-> Text (List Text) Text) (case parts #Nil @@ -3534,27 +3534,27 @@ (macro: #export (structure: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of structures ala ML." ..new-line - "(structure: #export order (Order Int)" ..new-line - " (def: &equivalence equivalence)" ..new-line - " (def: (< test subject)" ..new-line - " (< test subject))" ..new-line - " (def: (<= test subject)" ..new-line - " (or (< test subject)" ..new-line - " (= test subject)))" ..new-line - " (def: (> test subject)" ..new-line - " (> test subject))" ..new-line - " (def: (>= test subject)" ..new-line - " (or (> test subject)" ..new-line + "## Definition of structures ala ML." ..new_line + "(structure: #export order (Order Int)" ..new_line + " (def: &equivalence equivalence)" ..new_line + " (def: (< test subject)" ..new_line + " (< test subject))" ..new_line + " (def: (<= test subject)" ..new_line + " (or (< test subject)" ..new_line + " (= test subject)))" ..new_line + " (def: (> test subject)" ..new_line + " (> test subject))" ..new_line + " (def: (>= test subject)" ..new_line + " (or (> test subject)" ..new_line " (= test subject))))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& name args))] [meta-rec-location (#Record meta-rec-parts)] type definitions)) - (#Some name args type [meta-rec-location (#Record meta-rec-parts)] definitions) + (^ (list& [_ (#Form (list& name args))] [meta_rec_location (#Record meta_rec_parts)] type definitions)) + (#Some name args type [meta_rec_location (#Record meta_rec_parts)] definitions) - (^ (list& name [meta-rec-location (#Record meta-rec-parts)] type definitions)) - (#Some name #Nil type [meta-rec-location (#Record meta-rec-parts)] definitions) + (^ (list& name [meta_rec_location (#Record meta_rec_parts)] type definitions)) + (#Some name #Nil type [meta_rec_location (#Record meta_rec_parts)] definitions) (^ (list& [_ (#Form (list& name args))] type definitions)) (#Some name args type (` {}) definitions) @@ -3573,7 +3573,7 @@ _ (` ((~ name) (~+ args))))] (return (list (` (..def: (~+ (export exported?)) (~ usage) - (~ (meta-code-merge (` {#.struct? #1}) + (~ (meta_code_merge (` {#.struct? #1}) meta)) (~ type) (structure (~+ definitions))))))) @@ -3585,7 +3585,7 @@ (macro: #export (type: tokens) {#.doc (text$ ($_ "lux text concat" - "## The type-definition macro." ..new-line + "## The type-definition macro." ..new_line "(type: (List a) #Nil (#Cons a (List a)))"))} (let [[exported? tokens'] (export^ tokens) [rec? tokens'] (case tokens' @@ -3596,40 +3596,40 @@ [#0 tokens']) parts (: (Maybe [Text (List Code) (List [Code Code]) (List Code)]) (case tokens' - (^ (list [_ (#Identifier "" name)] [meta-location (#Record meta-parts)] [type-location (#Record type-parts)])) - (#Some [name #Nil meta-parts (list [type-location (#Record type-parts)])]) + (^ (list [_ (#Identifier "" name)] [meta_location (#Record meta_parts)] [type_location (#Record type_parts)])) + (#Some [name #Nil meta_parts (list [type_location (#Record type_parts)])]) - (^ (list& [_ (#Identifier "" name)] [meta-location (#Record meta-parts)] type-code1 type-codes)) - (#Some [name #Nil meta-parts (#Cons type-code1 type-codes)]) + (^ (list& [_ (#Identifier "" name)] [meta_location (#Record meta_parts)] type_code1 type_codes)) + (#Some [name #Nil meta_parts (#Cons type_code1 type_codes)]) - (^ (list& [_ (#Identifier "" name)] type-codes)) - (#Some [name #Nil (list) type-codes]) + (^ (list& [_ (#Identifier "" name)] type_codes)) + (#Some [name #Nil (list) type_codes]) - (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-location (#Record meta-parts)] [type-location (#Record type-parts)])) - (#Some [name args meta-parts (list [type-location (#Record type-parts)])]) + (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta_location (#Record meta_parts)] [type_location (#Record type_parts)])) + (#Some [name args meta_parts (list [type_location (#Record type_parts)])]) - (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-location (#Record meta-parts)] type-code1 type-codes)) - (#Some [name args meta-parts (#Cons type-code1 type-codes)]) + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta_location (#Record meta_parts)] type_code1 type_codes)) + (#Some [name args meta_parts (#Cons type_code1 type_codes)]) - (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type-codes)) - (#Some [name args (list) type-codes]) + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type_codes)) + (#Some [name args (list) type_codes]) _ #None))] (case parts - (#Some name args meta type-codes) - (do meta-monad - [type+tags?? (unfold-type-def type-codes) - module-name current-module-name] - (let [type-name (local-identifier$ name) + (#Some name args meta type_codes) + (do meta_monad + [type+tags?? (unfold_type_def type_codes) + module_name current_module_name] + (let [type_name (local_identifier$ name) [type tags??] type+tags?? type' (: (Maybe Code) (if rec? (if (empty? args) - (let [g!param (local-identifier$ "") - prime-name (local-identifier$ name) - type+ (replace-syntax (list [name (` ((~ prime-name) .Nothing))]) type)] - (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) + (let [g!param (local_identifier$ "") + prime_name (local_identifier$ name) + type+ (replace_syntax (list [name (` ((~ prime_name) .Nothing))]) type)] + (#Some (` ((All (~ prime_name) [(~ g!param)] (~ type+)) .Nothing)))) #None) (case args @@ -3637,31 +3637,31 @@ (#Some type) _ - (#Some (` (.All (~ type-name) [(~+ args)] (~ type))))))) - total-meta (let [meta (process-def-meta meta) + (#Some (` (.All (~ type_name) [(~+ args)] (~ type))))))) + total_meta (let [meta (process_def_meta meta) meta (if rec? - (` (#.Cons (~ (flag-meta "type-rec?")) (~ meta))) + (` (#.Cons (~ (flag_meta "type-rec?")) (~ meta))) meta)] - (` [(~ location-code) + (` [(~ location_code) (#.Record (~ meta))]))] (case type' (#Some type'') - (let [typeC (` (#.Named [(~ (text$ module-name)) + (let [typeC (` (#.Named [(~ (text$ module_name)) (~ (text$ name))] (.type (~ type''))))] (return (list (case tags?? (#Some tags) - (` ("lux def type tagged" (~ type-name) + (` ("lux def type tagged" (~ type_name) (~ typeC) - (~ total-meta) + (~ total_meta) [(~+ (list\map text$ tags))] (~ (bit$ exported?)))) _ - (` ("lux def" (~ type-name) + (` ("lux def" (~ type_name) ("lux check type" (~ typeC)) - (~ total-meta) + (~ total_meta) (~ (bit$ exported?)))))))) #None @@ -3693,17 +3693,17 @@ [Text (List Text)]) (type: Refer - {#refer-defs Referrals - #refer-open (List Openings)}) + {#refer_defs Referrals + #refer_open (List Openings)}) (type: Importation - {#import-name Text - #import-alias (Maybe Text) - #import-refer Refer}) + {#import_name Text + #import_alias (Maybe Text) + #import_refer Refer}) -(def: (extract-defs defs) +(def: (extract_defs defs) (-> (List Code) (Meta (List Text))) - (monad\map meta-monad + (monad\map meta_monad (: (-> Code (Meta Text)) (function (_ def) (case def @@ -3714,19 +3714,19 @@ (fail "only/exclude requires identifiers.")))) defs)) -(def: (parse-referrals tokens) +(def: (parse_referrals tokens) (-> (List Code) (Meta [Referrals (List Code)])) (case tokens (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens'))) - (do meta-monad - [defs' (extract-defs defs)] + (do meta_monad + [defs' (extract_defs defs)] (wrap [(#Only defs') tokens'])) (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens'))) - (do meta-monad - [defs' (extract-defs defs)] + (do meta_monad + [defs' (extract_defs defs)] (wrap [(#Exclude defs') tokens'])) (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) @@ -3740,24 +3740,24 @@ _ (return [#Nothing tokens]))) -(def: (parse-openings parts) +(def: (parse_openings parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (case parts #.Nil (return [#.Nil #.Nil]) (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) - (do meta-monad - [structs' (monad\map meta-monad + (do meta_monad + [structs' (monad\map meta_monad (function (_ struct) (case struct - [_ (#Identifier ["" struct-name])] - (return struct-name) + [_ (#Identifier ["" struct_name])] + (return struct_name) _ (fail "Expected all structures of opening form to be identifiers."))) structs) - next+remainder (parse-openings parts')] + next+remainder (parse_openings parts')] (let [[next remainder] next+remainder] (return [(#.Cons [prefix structs'] next) remainder]))) @@ -3770,43 +3770,43 @@ [("lux text clip" 0 at x) ("lux text clip" at ("lux text size" x) x)]) -(def: (split-with token sample) +(def: (split_with token sample) (-> Text Text (Maybe [Text Text])) - (do ..maybe-monad - [index (..index-of token sample) + (do ..maybe_monad + [index (..index_of token sample) #let [[pre post'] (split! index sample) [_ post] (split! ("lux text size" token) post')]] (wrap [pre post]))) -(def: (replace-all pattern value template) +(def: (replace_all pattern value template) (-> Text Text Text Text) - (case (..split-with pattern template) + (case (..split_with pattern template) (#.Some [pre post]) - ($_ "lux text concat" pre value (replace-all pattern value post)) + ($_ "lux text concat" pre value (replace_all pattern value post)) #.None template)) -(def: contextual-reference "#") -(def: self-reference ".") +(def: contextual_reference "#") +(def: self_reference ".") -(def: (de-alias context self aliased) +(def: (de_alias context self aliased) (-> Text Text Text Text) (|> aliased - (replace-all ..self-reference self) - (replace-all ..contextual-reference context))) + (replace_all ..self_reference self) + (replace_all ..contextual_reference context))) -(def: #export module-separator "/") +(def: #export module_separator "/") -(def: (count-relatives relatives input) +(def: (count_relatives relatives input) (-> Nat Text Nat) - (case ("lux text index" relatives ..module-separator input) + (case ("lux text index" relatives ..module_separator input) #None relatives (#Some found) (if ("lux i64 =" relatives found) - (count-relatives ("lux i64 +" 1 relatives) input) + (count_relatives ("lux i64 +" 1 relatives) input) relatives))) (def: (list\take amount list) @@ -3827,38 +3827,38 @@ [_ (#Cons _ tail)] (list\drop ("lux i64 -" 1 amount) tail))) -(def: (clean-module nested? relative-root module) +(def: (clean_module nested? relative_root module) (-> Bit Text Text (Meta Text)) - (case (count-relatives 0 module) + (case (count_relatives 0 module) 0 (return (if nested? - ($_ "lux text concat" relative-root ..module-separator module) + ($_ "lux text concat" relative_root ..module_separator module) module)) relatives - (let [parts (text\split-all-with ..module-separator relative-root) + (let [parts (text\split_all_with ..module_separator relative_root) jumps ("lux i64 -" 1 relatives)] (if (n/< (list\size parts) jumps) (let [prefix (|> parts list\reverse (list\drop jumps) list\reverse - (interpose ..module-separator) - (text\join-with "")) + (interpose ..module_separator) + (text\join_with "")) clean ("lux text clip" relatives ("lux text size" module) module) output (case ("lux text size" clean) 0 prefix - _ ($_ text\compose prefix ..module-separator clean))] + _ ($_ text\compose prefix ..module_separator clean))] (return output)) (fail ($_ "lux text concat" - "Cannot climb the module hierarchy..." ..new-line - "Importing module: " module ..new-line - " Relative Root: " relative-root ..new-line)))))) + "Cannot climb the module hierarchy..." ..new_line + "Importing module: " module ..new_line + " Relative Root: " relative_root ..new_line)))))) -(def: (alter-domain alteration domain import) +(def: (alter_domain alteration domain import) (-> Nat Text Importation Importation) - (let [[import-name import-alias import-refer] import - original (text\split-all-with ..module-separator import-name) + (let [[import_name import_alias import_refer] import + original (text\split_all_with ..module_separator import_name) truncated (list\drop (.nat alteration) original) parallel (case domain "" @@ -3866,124 +3866,124 @@ _ (list& domain truncated))] - {#import-name (text\join-with ..module-separator parallel) - #import-alias import-alias - #import-refer import-refer})) + {#import_name (text\join_with ..module_separator parallel) + #import_alias import_alias + #import_refer import_refer})) -(def: (parse-imports nested? relative-root context-alias imports) +(def: (parse_imports nested? relative_root context_alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) - (do meta-monad - [imports' (monad\map meta-monad + (do meta_monad + [imports' (monad\map meta_monad (: (-> Code (Meta (List Importation))) (function (_ token) (case token ## Simple - [_ (#Identifier ["" m-name])] - (do meta-monad - [m-name (clean-module nested? relative-root m-name)] - (wrap (list {#import-name m-name - #import-alias #None - #import-refer {#refer-defs #All - #refer-open (list)}}))) + [_ (#Identifier ["" m_name])] + (do meta_monad + [m_name (clean_module nested? relative_root m_name)] + (wrap (list {#import_name m_name + #import_alias #None + #import_refer {#refer_defs #All + #refer_open (list)}}))) ## Nested - (^ [_ (#Tuple (list& [_ (#Identifier ["" m-name])] extra))]) - (do meta-monad - [import-name (clean-module nested? relative-root m-name) - referral+extra (parse-referrals extra) + (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) + (do meta_monad + [import_name (clean_module nested? relative_root m_name) + referral+extra (parse_referrals extra) #let [[referral extra] referral+extra] - openings+extra (parse-openings extra) + openings+extra (parse_openings extra) #let [[openings extra] openings+extra] - sub-imports (parse-imports #1 import-name context-alias extra)] + sub_imports (parse_imports #1 import_name context_alias extra)] (wrap (case [referral openings] - [#Nothing #Nil] sub-imports - _ (list& {#import-name import-name - #import-alias #None - #import-refer {#refer-defs referral - #refer-open openings}} - sub-imports)))) - - (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m-name])] extra))]) - (do meta-monad - [import-name (clean-module nested? relative-root m-name) - referral+extra (parse-referrals extra) + [#Nothing #Nil] sub_imports + _ (list& {#import_name import_name + #import_alias #None + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) + + (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) + (do meta_monad + [import_name (clean_module nested? relative_root m_name) + referral+extra (parse_referrals extra) #let [[referral extra] referral+extra] - openings+extra (parse-openings extra) + openings+extra (parse_openings extra) #let [[openings extra] openings+extra - de-aliased (de-alias context-alias m-name alias)] - sub-imports (parse-imports #1 import-name de-aliased extra)] + de_aliased (de_alias context_alias m_name alias)] + sub_imports (parse_imports #1 import_name de_aliased extra)] (wrap (case [referral openings] - [#Ignore #Nil] sub-imports - _ (list& {#import-name import-name - #import-alias (#Some de-aliased) - #import-refer {#refer-defs referral - #refer-open openings}} - sub-imports)))) + [#Ignore #Nil] sub_imports + _ (list& {#import_name import_name + #import_alias (#Some de_aliased) + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) ## Parallel (^ [_ (#Record (list [[_ (#Tuple (list [_ (#Nat alteration)] [_ (#Tag ["" domain])]))] - parallel-tree]))]) - (do meta-monad - [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list\map (alter-domain alteration domain) parallel-imports))) + parallel_tree]))]) + (do meta_monad + [parallel_imports (parse_imports nested? relative_root context_alias (list parallel_tree))] + (wrap (list\map (alter_domain alteration domain) parallel_imports))) (^ [_ (#Record (list [[_ (#Nat alteration)] - parallel-tree]))]) - (do meta-monad - [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list\map (alter-domain alteration "") parallel-imports))) + parallel_tree]))]) + (do meta_monad + [parallel_imports (parse_imports nested? relative_root context_alias (list parallel_tree))] + (wrap (list\map (alter_domain alteration "") parallel_imports))) (^ [_ (#Record (list [[_ (#Tag ["" domain])] - parallel-tree]))]) - (do meta-monad - [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree)) - #let [alteration (list\size (text\split-all-with ..module-separator domain))]] - (wrap (list\map (alter-domain alteration domain) parallel-imports))) + parallel_tree]))]) + (do meta_monad + [parallel_imports (parse_imports nested? relative_root context_alias (list parallel_tree)) + #let [alteration (list\size (text\split_all_with ..module_separator domain))]] + (wrap (list\map (alter_domain alteration domain) parallel_imports))) _ - (do meta-monad - [current-module current-module-name] + (do meta_monad + [current_module current_module_name] (fail ($_ text\compose - "Wrong syntax for import @ " current-module - ..new-line (code\encode token))))))) + "Wrong syntax for import @ " current_module + ..new_line (code\encode token))))))) imports)] (wrap (list\join imports')))) -(def: (exported-definitions module state) +(def: (exported_definitions module state) (-> Text (Meta (List Text))) - (let [[current-module modules] (case state - {#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host + (let [[current_module modules] (case state + {#info info #source source #current_module current_module #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - [current-module modules])] + #scope_type_vars scope_type_vars} + [current_module modules])] (case (get module modules) (#Some =module) - (let [to-alias (list\map (: (-> [Text Global] + (let [to_alias (list\map (: (-> [Text Global] (List Text)) (function (_ [name definition]) (case definition (#Left _) (list) - (#Right [exported? def-type def-meta def-value]) + (#Right [exported? def_type def_meta def_value]) (if exported? (list name) (list))))) - (let [{#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] + (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] definitions))] - (#Right state (list\join to-alias))) + (#Right state (list\join to_alias))) #None (#Left ($_ text\compose - "Unknown module: " (text\encode module) ..new-line - "Current module: " (case current-module - (#Some current-module) - (text\encode current-module) + "Unknown module: " (text\encode module) ..new_line + "Current module: " (case current_module + (#Some current_module) + (text\encode current_module) #None - "???") ..new-line + "???") ..new_line "Known modules: " (|> modules (list\map (function (_ [name module]) (text$ name))) @@ -4002,7 +4002,7 @@ (#Cons x (filter p xs')) (filter p xs')))) -(def: (is-member? cases name) +(def: (is_member? cases name) (-> (List Text) Text Bit) (let [output (list\fold (function (_ case prev) (or prev @@ -4011,20 +4011,20 @@ cases)] output)) -(def: (try-both f x1 x2) +(def: (try_both f x1 x2) (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) #None (f x2) (#Some y) (#Some y))) -(def: (find-in-env name state) +(def: (find_in_env name state) (-> Text Lux (Maybe Type)) (case state - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} + #scope_type_vars scope_type_vars} (find (: (-> Scope (Maybe Type)) (function (_ env) (case env @@ -4032,7 +4032,7 @@ #inner _ #locals {#counter _ #mappings locals} #captured {#counter _ #mappings closure}} - (try-both (find (: (-> [Text [Type Any]] (Maybe Type)) + (try_both (find (: (-> [Text [Type Any]] (Maybe Type)) (function (_ [bname [type _]]) (if (text\= name bname) (#Some type) @@ -4041,55 +4041,55 @@ (: (List [Text [Type Any]]) closure))))) scopes))) -(def: (find-def-type name state) +(def: (find_def_type name state) (-> Name Lux (Maybe Type)) - (let [[v-prefix v-name] name - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [[v_prefix v_name] name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] - (case (get v-prefix modules) + #scope_type_vars scope_type_vars} state] + (case (get v_prefix modules) #None #None - (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) - (case (get v-name definitions) + (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) + (case (get v_name definitions) #None #None (#Some definition) (case definition - (#Left de-aliased) - (find-def-type de-aliased state) + (#Left de_aliased) + (find_def_type de_aliased state) - (#Right [exported? def-type def-meta def-value]) - (#Some def-type)))))) + (#Right [exported? def_type def_meta def_value]) + (#Some def_type)))))) -(def: (find-def-value name state) +(def: (find_def_value name state) (-> Name (Meta [Type Any])) - (let [[v-prefix v-name] name - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [[v_prefix v_name] name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] - (case (get v-prefix modules) + #scope_type_vars scope_type_vars} state] + (case (get v_prefix modules) #None (#Left (text\compose "Unknown definition: " (name\encode name))) - (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) - (case (get v-name definitions) + (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) + (case (get v_name definitions) #None (#Left (text\compose "Unknown definition: " (name\encode name))) (#Some definition) (case definition - (#Left de-aliased) - (find-def-value de-aliased state) + (#Left de_aliased) + (find_def_value de_aliased state) - (#Right [exported? def-type def-meta def-value]) - (#Right [state [def-type def-value]])))))) + (#Right [exported? def_type def_meta def_value]) + (#Right [state [def_type def_value]])))))) -(def: (find-type-var idx bindings) +(def: (find_type_var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #Nil @@ -4098,40 +4098,40 @@ (#Cons [var bound] bindings') (if ("lux i64 =" idx var) bound - (find-type-var idx bindings')))) + (find_type_var idx bindings')))) -(def: (find-type full-name) +(def: (find_type full_name) (-> Name (Meta Type)) - (do meta-monad - [#let [[module name] full-name] - current-module current-module-name] + (do meta_monad + [#let [[module name] full_name] + current_module current_module_name] (function (_ compiler) (let [temp (if (text\= "" module) - (case (find-in-env name compiler) - (#Some struct-type) - (#Right [compiler struct-type]) + (case (find_in_env name compiler) + (#Some struct_type) + (#Right [compiler struct_type]) _ - (case (find-def-type [current-module name] compiler) - (#Some struct-type) - (#Right [compiler struct-type]) + (case (find_def_type [current_module name] compiler) + (#Some struct_type) + (#Right [compiler struct_type]) _ - (#Left ($_ text\compose "Unknown var: " (name\encode full-name))))) - (case (find-def-type full-name compiler) - (#Some struct-type) - (#Right [compiler struct-type]) + (#Left ($_ text\compose "Unknown var: " (name\encode full_name))))) + (case (find_def_type full_name compiler) + (#Some struct_type) + (#Right [compiler struct_type]) _ - (#Left ($_ text\compose "Unknown var: " (name\encode full-name)))))] + (#Left ($_ text\compose "Unknown var: " (name\encode full_name)))))] (case temp - (#Right [compiler (#Var type-id)]) - (let [{#info _ #source _ #current-module _ #modules _ - #scopes _ #type-context type-context #host _ + (#Right [compiler (#Var type_id)]) + (let [{#info _ #source _ #current_module _ #modules _ + #scopes _ #type_context type_context #host _ #seed _ #expected _ #location _ #extensions extensions - #scope-type-vars _} compiler - {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] - (case (find-type-var type-id var-bindings) + #scope_type_vars _} compiler + {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] + (case (find_type_var type_id var_bindings) #None temp @@ -4168,13 +4168,13 @@ ($_ text\compose "(" name " " (|> params (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) (#Sum _) - ($_ text\compose "(| " (|> (flatten-variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(| " (|> (flatten_variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Product _) - ($_ text\compose "[" (|> (flatten-tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") + ($_ text\compose "[" (|> (flatten_tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flatten-lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(-> " (|> (flatten_lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Parameter id) (nat\encode id) @@ -4192,7 +4192,7 @@ ($_ text\compose "(Ex " (type\encode body) ")") (#Apply _) - (let [[func args] (flatten-app type)] + (let [[func args] (flatten_app type)] ($_ text\compose "(" (type\encode func) " " (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) @@ -4204,62 +4204,62 @@ (macro: #export (^open tokens) {#.doc (text$ ($_ "lux text concat" - "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new-line - "## Takes an 'alias' text for the generated local bindings." ..new-line - "(def: #export (range (^open ''.'') from to)" ..new-line - " (All [a] (-> (Enum a) a a (List a)))" ..new-line + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new_line + "## Takes an 'alias' text for the generated local bindings." ..new_line + "(def: #export (range (^open ''.'') from to)" ..new_line + " (All [a] (-> (Enum a) a a (List a)))" ..new_line " (range' <= succ from to))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) - (do meta-monad + (do meta_monad [g!temp (gensym "temp")] (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) - (do meta-monad - [init-type (find-type name) - struct-evidence (resolve-type-tags init-type)] - (case struct-evidence + (do meta_monad + [init_type (find_type name) + struct_evidence (resolve_type_tags init_type)] + (case struct_evidence #None - (fail (text\compose "Can only 'open' structs: " (type\encode init-type))) + (fail (text\compose "Can only 'open' structs: " (type\encode init_type))) (#Some tags&members) - (do meta-monad - [full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) + (do meta_monad + [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)]) + (let [locals (list\map (function (_ [t_module t_name]) + ["" (de_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-structure (resolve-type-tags m-type)] - (case m-structure - (#Some m-tags&members) - (recur m-local - m-tags&members - enhanced-target) + (do meta_monad + [enhanced_target (monad\fold meta_monad + (function (_ [m_local m_type] enhanced_target) + (do meta_monad + [m_structure (resolve_type_tags m_type)] + (case m_structure + (#Some m_tags&members) + (recur m_local + m_tags&members + enhanced_target) #None - (wrap enhanced-target)))) + (wrap enhanced_target)))) target (zip/2 locals members))] - (wrap (` ({(~ pattern) (~ enhanced-target)} (~ (identifier$ source))))))))) + (wrap (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) name tags&members body)] - (wrap (list full-body))))) + (wrap (list full_body))))) _ (fail "Wrong syntax for ^open"))) (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" - "## Branching structures with multiple test conditions." ..new-line - "(cond (even? num) ''even''" ..new-line + "## Branching structures with multiple test conditions." ..new_line + "(cond (even? num) ''even''" ..new_line " (odd? num) ''odd''" __paragraph - " ## else-branch" ..new-line + " ## else_branch" ..new_line " ''???'')"))} (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) (fail "cond requires an uneven number of arguments.") @@ -4270,7 +4270,7 @@ (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) else - (as-pairs branches')))) + (as_pairs branches')))) _ (fail "Wrong syntax for cond")))) @@ -4290,29 +4290,29 @@ (macro: #export (get@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Accesses the value of a record at a given tag." ..new-line - "(get@ #field my-record)" + "## Accesses the value of a record at a given tag." ..new_line + "(get@ #field my_record)" __paragraph - "## Can also work with multiple levels of nesting:" ..new-line - "(get@ [#foo #bar #baz] my-record)" + "## Can also work with multiple levels of nesting:" ..new_line + "(get@ [#foo #bar #baz] my_record)" __paragraph - "## And, if only the slot/path is given, generates an accessor function:" ..new-line - "(let [getter (get@ [#foo #bar #baz])]" ..new-line - " (getter my-record))"))} + "## And, if only the slot/path is given, generates an accessor function:" ..new_line + "(let [getter (get@ [#foo #bar #baz])]" ..new_line + " (getter my_record))"))} (case tokens (^ (list [_ (#Tag slot')] record)) - (do meta-monad + (do meta_monad [slot (normalize slot') - output (resolve-tag slot) + output (resolve_tag slot) #let [[idx tags exported? type] output] g!_ (gensym "_") g!output (gensym "")] - (case (resolve-struct-type type) + (case (resolve_struct_type type) (#Some members) (let [pattern (record$ (list\map (: (-> [Name [Nat Type]] [Code Code]) - (function (_ [[r-prefix r-name] [r-idx r-type]]) - [(tag$ [r-prefix r-name]) - (if ("lux i64 =" idx r-idx) + (function (_ [[r_prefix r_name] [r_idx r_type]]) + [(tag$ [r_prefix r_name]) + (if ("lux i64 =" idx r_idx) g!output g!_)])) (zip/2 tags (enumeration members))))] @@ -4329,7 +4329,7 @@ slots))) (^ (list selector)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] (wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) @@ -4337,73 +4337,73 @@ _ (fail "Wrong syntax for get@"))) -(def: (open-field alias tags my-tag-index [module short] source type) +(def: (open_field 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) + (do meta_monad + [output (resolve_type_tags type) g!_ (gensym "g!_") - #let [g!output (local-identifier$ short) + #let [g!output (local_identifier$ short) pattern (|> tags enumeration - (list\map (function (_ [tag-idx tag]) - (if ("lux i64 =" my-tag-index tag-idx) + (list\map (function (_ [tag_idx tag]) + (if ("lux i64 =" my_tag_index tag_idx) g!output g!_))) tuple$) source+ (` ({(~ pattern) (~ g!output)} (~ source)))]] (case output (#Some [tags' members']) - (do meta-monad - [decls' (monad\map meta-monad + (do meta_monad + [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))) + (function (_ [sub_tag_index sname stype]) + (open_field alias tags' sub_tag_index sname source+ stype))) (enumeration (zip/2 tags' members')))] (return (list\join decls'))) _ - (return (list (` ("lux def" (~ (local-identifier$ (de-alias "" short alias))) + (return (list (` ("lux def" (~ (local_identifier$ (de_alias "" short alias))) (~ source+) - [(~ location-code) (#.Record #Nil)] + [(~ location_code) (#.Record #Nil)] #0))))))) (macro: #export (open: tokens) {#.doc (text$ ($_ "lux text concat" "## Opens a structure and generates a definition for each of its members (including nested members)." __paragraph - "## For example:" ..new-line + "## For example:" ..new_line "(open: ''i:.'' number)" __paragraph - "## Will generate:" ..new-line - "(def: i:+ (\ number +))" ..new-line - "(def: i:- (\ number -))" ..new-line - "(def: i:* (\ number *))" ..new-line + "## Will generate:" ..new_line + "(def: i:+ (\ number +))" ..new_line + "(def: i:- (\ number -))" ..new_line + "(def: i:* (\ number *))" ..new_line "..."))} (case tokens (^ (list [_ (#Text alias)] struct)) (case struct - [_ (#Identifier struct-name)] - (do meta-monad - [struct-type (find-type struct-name) - output (resolve-type-tags struct-type) - #let [source (identifier$ struct-name)]] + [_ (#Identifier struct_name)] + (do meta_monad + [struct_type (find_type struct_name) + output (resolve_type_tags 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))) + (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))) (enumeration (zip/2 tags members)))] (return (list\join decls'))) _ - (fail (text\compose "Can only 'open:' structs: " (type\encode struct-type))))) + (fail (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) _ - (do meta-monad + (do meta_monad [g!struct (gensym "struct")] (return (list (` ("lux def" (~ g!struct) (~ struct) - [(~ location-code) (#.Record #Nil)] + [(~ location_code) (#.Record #Nil)] #0)) (` (..open: (~ (text$ alias)) (~ g!struct))))))) @@ -4412,81 +4412,81 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..new-line - "## =>" ..new-line + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new_line + "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..new_line + "## =>" ..new_line "(function (_ ) (fold text\compose '''' (interpose '' '' (list\map int\encode ))))"))} - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!arg (gensym "arg")] (return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..new-line - "## =>" ..new-line + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new_line + "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..new_line + "## =>" ..new_line "(function (_ ) (fold text\compose '''' (interpose '' '' (list\map int\encode ))))"))} - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!arg (gensym "arg")] (return (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) -(def: (imported-by? import-name module-name) +(def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) - (do meta-monad - [module (find-module module-name) - #let [{#module-hash _ #module-aliases _ #definitions _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]] - (wrap (is-member? imports import-name)))) + (do meta_monad + [module (find_module module_name) + #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] + (wrap (is_member? imports import_name)))) -(def: (read-refer module-name options) +(def: (read_refer module_name options) (-> Text (List Code) (Meta Refer)) - (do meta-monad - [referral+options (parse-referrals options) + (do meta_monad + [referral+options (parse_referrals options) #let [[referral options] referral+options] - openings+options (parse-openings options) + openings+options (parse_openings options) #let [[openings options] openings+options] - current-module current-module-name] + current_module current_module_name] (case options #Nil - (wrap {#refer-defs referral - #refer-open openings}) + (wrap {#refer_defs referral + #refer_open openings}) _ - (fail ($_ text\compose "Wrong syntax for refer @ " current-module - ..new-line (|> options + (fail ($_ text\compose "Wrong syntax for refer @ " current_module + ..new_line (|> options (list\map code\encode) (interpose " ") (list\fold text\compose ""))))))) -(def: (write-refer module-name [r-defs r-opens]) +(def: (write_refer module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) - (do meta-monad - [current-module current-module-name - #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) - (function (_ module-name all-defs referred-defs) - (monad\map meta-monad + (do meta_monad + [current_module current_module_name + #let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) + (function (_ module_name all_defs referred_defs) + (monad\map meta_monad (: (-> Text (Meta Any)) (function (_ _def) - (if (is-member? all-defs _def) + (if (is_member? all_defs _def) (return []) - (fail ($_ text\compose _def " is not defined in module " module-name " @ " current-module))))) - referred-defs)))] - defs' (case r-defs + (fail ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) + referred_defs)))] + defs' (case r_defs #All - (exported-definitions module-name) + (exported_definitions module_name) (#Only +defs) - (do meta-monad - [*defs (exported-definitions module-name) - _ (test-referrals module-name *defs +defs)] + (do meta_monad + [*defs (exported_definitions module_name) + _ (test_referrals module_name *defs +defs)] (wrap +defs)) - (#Exclude -defs) - (do meta-monad - [*defs (exported-definitions module-name) - _ (test-referrals module-name *defs -defs)] - (wrap (filter (|>> (is-member? -defs) not) *defs))) + (#Exclude _defs) + (do meta_monad + [*defs (exported_definitions module_name) + _ (test_referrals module_name *defs _defs)] + (wrap (filter (|>> (is_member? _defs) not) *defs))) #Ignore (wrap (list)) @@ -4495,13 +4495,13 @@ (wrap (list))) #let [defs (list\map (: (-> Text Code) (function (_ def) - (` ("lux def alias" (~ (local-identifier$ def)) (~ (identifier$ [module-name def])))))) + (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) defs') - openings (|> r-opens + openings (|> r_opens (list\map (: (-> Openings (List Code)) (function (_ [alias structs]) (list\map (function (_ name) - (` (open: (~ (text$ alias)) (~ (identifier$ [module-name name]))))) + (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) list\join)]] (wrap (list\compose defs openings)) @@ -4509,27 +4509,27 @@ (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)) + (^ (list& [_ (#Text module_name)] options)) + (do meta_monad + [=refer (read_refer module_name options)] + (write_refer module_name =refer)) _ (fail "Wrong syntax for refer"))) -(def: (refer-to-code module-name module-alias' [r-defs r-opens]) +(def: (refer_to_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 (..default module_name module_alias') localizations (: (List Code) - (case r-defs + (case r_defs #All (list (' #*)) (#Only defs) - (list (form$ (list& (' #+) (list\map local-identifier$ defs)))) + (list (form$ (list& (' #+) (list\map local_identifier$ defs)))) (#Exclude defs) - (list (form$ (list& (' #-) (list\map local-identifier$ defs)))) + (list (form$ (list& (' #-) (list\map local_identifier$ defs)))) #Ignore (list) @@ -4537,32 +4537,32 @@ #Nothing (list))) openings (list\map (function (_ [alias structs]) - (form$ (list& (text$ (..replace-all ..contextual-reference module-alias alias)) - (list\map local-identifier$ structs)))) - r-opens)] - (` (..refer (~ (text$ module-name)) + (form$ (list& (text$ (..replace_all ..contextual_reference module_alias alias)) + (list\map local_identifier$ structs)))) + r_opens)] + (` (..refer (~ (text$ module_name)) (~+ localizations) (~+ openings))))) (macro: #export (module: tokens) {#.doc (text$ ($_ "lux text concat" - "## Module-definition macro." + "## Module_definition macro." __paragraph "## Can take optional annotations and allows the specification of modules to import." __paragraph - "## Example" ..new-line - "(.module: {#.doc ''Some documentation...''}" ..new-line - " [lux #*" ..new-line - " [control" ..new-line - " [''M'' monad #*]]" ..new-line - " [data" ..new-line - " maybe" ..new-line - " [''.'' name (''#/.'' codec)]]" ..new-line - " [macro" ..new-line - " code]]" ..new-line - " [//" ..new-line + "## Example" ..new_line + "(.module: {#.doc ''Some documentation...''}" ..new_line + " [lux #*" ..new_line + " [control" ..new_line + " [''M'' monad #*]]" ..new_line + " [data" ..new_line + " maybe" ..new_line + " [''.'' name (''#/.'' codec)]]" ..new_line + " [macro" ..new_line + " code]]" ..new_line + " [//" ..new_line " [type (''.'' equivalence)]])"))} - (do meta-monad + (do meta_monad [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens (^ (list& [_ (#Record _meta)] _imports)) @@ -4570,28 +4570,28 @@ _ [(list) tokens]))] - current-module current-module-name - imports (parse-imports #0 current-module "" _imports) + current_module current_module_name + imports (parse_imports #0 current_module "" _imports) #let [=imports (|> imports (list\map (: (-> Importation Code) - (function (_ [m-name m-alias =refer]) - (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))) + (function (_ [m_name m_alias =refer]) + (` [(~ (text$ m_name)) (~ (text$ (default "" m_alias)))])))) tuple$) =refers (list\map (: (-> Importation Code) - (function (_ [m-name m-alias =refer]) - (refer-to-code m-name m-alias =refer))) + (function (_ [m_name m_alias =refer]) + (refer_to_code m_name m_alias =refer))) imports) - =module (` ("lux def module" [(~ location-code) - (#.Record (~ (process-def-meta _meta)))] + =module (` ("lux def module" [(~ location_code) + (#.Record (~ (process_def_meta _meta)))] (~ =imports)))]] (wrap (#Cons =module =refers)))) (macro: #export (\ tokens) {#.doc (text$ ($_ "lux text concat" - "## Allows accessing the value of a structure's member." ..new-line + "## Allows accessing the value of a structure's member." ..new_line "(\ codec encode)" __paragraph - "## Also allows using that value as a function." ..new-line + "## Also allows using that value as a function." ..new_line "(\ codec encode +123)"))} (case tokens (^ (list struct [_ (#Identifier member)])) @@ -4605,42 +4605,42 @@ (macro: #export (set@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Sets the value of a record at a given tag." ..new-line + "## Sets the value of a record at a given tag." ..new_line "(set@ #name ''Lux'' lang)" __paragraph - "## Can also work with multiple levels of nesting:" ..new-line - "(set@ [#foo #bar #baz] value my-record)" + "## Can also work with multiple levels of nesting:" ..new_line + "(set@ [#foo #bar #baz] value my_record)" __paragraph - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line - "(let [setter (set@ [#foo #bar #baz] value)] (setter my-record))" ..new-line - "(let [setter (set@ [#foo #bar #baz])] (setter value my-record))"))} + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new_line + "(let [setter (set@ [#foo #bar #baz] value)] (setter my_record))" ..new_line + "(let [setter (set@ [#foo #bar #baz])] (setter value my_record))"))} (case tokens (^ (list [_ (#Tag slot')] value record)) - (do meta-monad + (do meta_monad [slot (normalize slot') - output (resolve-tag slot) + output (resolve_tag slot) #let [[idx tags exported? type] output]] - (case (resolve-struct-type type) + (case (resolve_struct_type type) (#Some members) - (do meta-monad - [pattern' (monad\map meta-monad + (do meta_monad + [pattern' (monad\map meta_monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) - (function (_ [r-slot-name [r-idx r-type]]) - (do meta-monad + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (return [r_slot_name r_idx g!slot])))) (zip/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - r-var])) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) pattern')) output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - (if ("lux i64 =" idx r-idx) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + (if ("lux i64 =" idx r_idx) value - r-var)])) + r_var)])) pattern'))] (return (list (` ({(~ pattern) (~ output)} (~ record))))))) @@ -4653,35 +4653,35 @@ (fail "Wrong syntax for set@") _ - (do meta-monad - [bindings (monad\map meta-monad + (do meta_monad + [bindings (monad\map meta_monad (: (-> Code (Meta Code)) (function (_ _) (gensym "temp"))) slots) #let [pairs (zip/2 slots bindings) - update-expr (list\fold (: (-> [Code Code] Code Code) + update_expr (list\fold (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..set@ (~ s) (~ v) (~ b))))) value (list\reverse pairs)) [_ accesses'] (list\fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) - (function (_ [new-slot new-binding] [old-record accesses']) - [(` (get@ (~ new-slot) (~ new-binding))) - (#Cons (list new-binding old-record) accesses')])) + (function (_ [new_slot new_binding] [old_record accesses']) + [(` (get@ (~ new_slot) (~ new_binding))) + (#Cons (list new_binding old_record) accesses')])) [record (: (List (List Code)) #Nil)] pairs) accesses (list\join (list\reverse accesses'))]] (wrap (list (` (let [(~+ accesses)] - (~ update-expr))))))) + (~ update_expr))))))) (^ (list selector value)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] (wrap (list (` (function ((~ g!_) (~ g!record)) (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!value (gensym "value") g!record (gensym "record")] @@ -4692,42 +4692,42 @@ (macro: #export (update@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Modifies the value of a record at a given tag, based on some function." ..new-line + "## Modifies the value of a record at a given tag, based on some function." ..new_line "(update@ #age inc person)" __paragraph - "## Can also work with multiple levels of nesting:" ..new-line - "(update@ [#foo #bar #baz] func my-record)" + "## Can also work with multiple levels of nesting:" ..new_line + "(update@ [#foo #bar #baz] func my_record)" __paragraph - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line - "(let [updater (update@ [#foo #bar #baz] func)] (updater my-record))" ..new-line - "(let [updater (update@ [#foo #bar #baz])] (updater func my-record))"))} + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new_line + "(let [updater (update@ [#foo #bar #baz] func)] (updater my_record))" ..new_line + "(let [updater (update@ [#foo #bar #baz])] (updater func my_record))"))} (case tokens (^ (list [_ (#Tag slot')] fun record)) - (do meta-monad + (do meta_monad [slot (normalize slot') - output (resolve-tag slot) + output (resolve_tag slot) #let [[idx tags exported? type] output]] - (case (resolve-struct-type type) + (case (resolve_struct_type type) (#Some members) - (do meta-monad - [pattern' (monad\map meta-monad + (do meta_monad + [pattern' (monad\map meta_monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) - (function (_ [r-slot-name [r-idx r-type]]) - (do meta-monad + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (return [r_slot_name r_idx g!slot])))) (zip/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - r-var])) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) pattern')) output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - (if ("lux i64 =" idx r-idx) - (` ((~ fun) (~ r-var))) - r-var)])) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + (if ("lux i64 =" idx r_idx) + (` ((~ fun) (~ r_var))) + r_var)])) pattern'))] (return (list (` ({(~ pattern) (~ output)} (~ record))))))) @@ -4740,7 +4740,7 @@ (fail "Wrong syntax for update@") _ - (do meta-monad + (do meta_monad [g!record (gensym "record") g!temp (gensym "temp")] (wrap (list (` (let [(~ g!record) (~ record) @@ -4748,13 +4748,13 @@ (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] (wrap (list (` (function ((~ g!_) (~ g!record)) (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!fun (gensym "fun") g!record (gensym "record")] @@ -4765,38 +4765,38 @@ (macro: #export (^template tokens) {#.doc (text$ ($_ "lux text concat" - "## It's similar to template, but meant to be used during pattern-matching." ..new-line - "(def: (beta-reduce env type)" ..new-line - " (-> (List Type) Type Type)" ..new-line - " (case type" ..new-line - " (#.Primitive name params)" ..new-line - " (#.Primitive name (list\map (beta-reduce env) params))" + "## It's similar to template, but meant to be used during pattern-matching." ..new_line + "(def: (beta_reduce env type)" ..new_line + " (-> (List Type) Type Type)" ..new_line + " (case type" ..new_line + " (#.Primitive name params)" ..new_line + " (#.Primitive name (list\map (beta_reduce env) params))" __paragraph - " (^template []" ..new-line - " [( left right)" ..new-line - " ( (beta-reduce env left) (beta-reduce env right))])" ..new-line + " (^template []" ..new_line + " [( left right)" ..new_line + " ( (beta_reduce env left) (beta_reduce env right))])" ..new_line " ([#.Sum] [#.Product])" __paragraph - " (^template []" ..new-line - " [( left right)" ..new-line - " ( (beta-reduce env left) (beta-reduce env right))])" ..new-line + " (^template []" ..new_line + " [( left right)" ..new_line + " ( (beta_reduce env left) (beta_reduce env right))])" ..new_line " ([#.Function] [#.Apply])" __paragraph - " (^template []" ..new-line - " [( old-env def)" ..new-line - " (case old-env" ..new-line - " #.Nil" ..new-line + " (^template []" ..new_line + " [( old_env def)" ..new_line + " (case old_env" ..new_line + " #.Nil" ..new_line " ( env def)" __paragraph - " _" ..new-line - " type)])" ..new-line + " _" ..new_line + " type)])" ..new_line " ([#.UnivQ] [#.ExQ])" __paragraph - " (#.Parameter idx)" ..new-line + " (#.Parameter idx)" ..new_line " (default type (list.nth idx env))" __paragraph - " _" ..new-line - " type" ..new-line + " _" ..new_line + " type" ..new_line " ))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple bindings)] @@ -4804,16 +4804,16 @@ [_ (#Form data)] branches)) (case (: (Maybe (List Code)) - (do maybe-monad - [bindings' (monad\map maybe-monad get-short bindings) - data' (monad\map maybe-monad tuple->list data)] - (let [num-bindings (list\size bindings')] - (if (every? (|>> ("lux i64 =" num-bindings)) + (do maybe_monad + [bindings' (monad\map maybe_monad get_short bindings) + 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')) (let [apply (: (-> RepEnv (List Code)) - (function (_ env) (list\map (apply-template env) templates)))] + (function (_ env) (list\map (apply_template env) templates)))] (|> data' - (list\map (compose apply (make-env bindings'))) + (list\map (compose apply (make_env bindings'))) list\join wrap)) #None)))) @@ -4826,7 +4826,7 @@ _ (fail "Wrong syntax for ^template"))) -(def: (find-baseline-column code) +(def: (find_baseline_column code) (-> Code Nat) (case code (^template [] @@ -4843,28 +4843,28 @@ (^template [] [[[_ _ column] ( parts)] - (list\fold n/min column (list\map find-baseline-column parts))]) + (list\fold n/min column (list\map find_baseline_column parts))]) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] (list\fold n/min column - (list\compose (list\map (|>> first find-baseline-column) pairs) - (list\map (|>> second find-baseline-column) pairs))) + (list\compose (list\map (|>> first find_baseline_column) pairs) + (list\map (|>> second find_baseline_column) pairs))) )) -(type: Doc-Fragment - (#Doc-Comment Text) - (#Doc-Example Code)) +(type: Doc_Fragment + (#Doc_Comment Text) + (#Doc_Example Code)) -(def: (identify-doc-fragment code) - (-> Code Doc-Fragment) +(def: (identify_doc_fragment code) + (-> Code Doc_Fragment) (case code [_ (#Text comment)] - (#Doc-Comment comment) + (#Doc_Comment comment) _ - (#Doc-Example code))) + (#Doc_Example code))) (template [ ] [(def: #export @@ -4886,39 +4886,39 @@ (#Cons x (repeat ("lux i64 +" -1 n) x)) #Nil)) -(def: (location-padding baseline [_ old-line old-column] [_ new-line new-column]) +(def: (location_padding baseline [_ old_line old_column] [_ new_line new_column]) (-> Nat Location Location Text) - (if ("lux i64 =" old-line new-line) - (text\join-with "" (repeat (.int ("lux i64 -" old-column new-column)) " ")) - (let [extra-lines (text\join-with "" (repeat (.int ("lux i64 -" old-line new-line)) ..new-line)) - space-padding (text\join-with "" (repeat (.int ("lux i64 -" baseline new-column)) " "))] - (text\compose extra-lines space-padding)))) + (if ("lux i64 =" old_line new_line) + (text\join_with "" (repeat (.int ("lux i64 -" old_column new_column)) " ")) + (let [extra_lines (text\join_with "" (repeat (.int ("lux i64 -" old_line new_line)) ..new_line)) + space_padding (text\join_with "" (repeat (.int ("lux i64 -" baseline new_column)) " "))] + (text\compose extra_lines space_padding)))) (def: (text\size x) (-> Text Nat) ("lux text size" x)) -(def: (update-location [file line column] code-text) +(def: (update_location [file line column] code_text) (-> Location Text Location) - [file line ("lux i64 +" column (text\size code-text))]) + [file line ("lux i64 +" column (text\size code_text))]) -(def: (delim-update-location [file line column]) +(def: (delim_update_location [file line column]) (-> Location Location) [file line (inc column)]) -(def: rejoin-all-pairs +(def: rejoin_all_pairs (-> (List [Code Code]) (List Code)) - (|>> (list\map rejoin-pair) list\join)) + (|>> (list\map rejoin_pair) list\join)) -(def: (doc-example->Text prev-location baseline example) +(def: (doc_example->Text prev_location baseline example) (-> Location Nat Code [Location Text]) (case example (^template [ ] - [[new-location ( value)] - (let [as-text ( value)] - [(update-location new-location as-text) - (text\compose (location-padding baseline prev-location new-location) - as-text)])]) + [[new_location ( value)] + (let [as_text ( value)] + [(update_location new_location as_text) + (text\compose (location_padding baseline prev_location new_location) + as_text)])]) ([#Bit bit\encode] [#Nat nat\encode] [#Int int\encode] @@ -4928,60 +4928,60 @@ [#Tag tag\encode]) (^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)] - [part-location (text\compose text-accum part-text)])) - [(delim-update-location group-location) ""] + [[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)] + [part_location (text\compose text_accum part_text)])) + [(delim_update_location group_location) ""] ( parts))] - [(delim-update-location group-location') - ($_ text\compose (location-padding baseline prev-location group-location) + [(delim_update_location group_location') + ($_ text\compose (location_padding baseline prev_location group_location) - parts-text + parts_text )])]) ([#Form "(" ")" ..function\identity] [#Tuple "[" "]" ..function\identity] - [#Record "{" "}" rejoin-all-pairs]) + [#Record "{" "}" rejoin_all_pairs]) - [new-location (#Rev value)] + [new_location (#Rev value)] ("lux io error" "Undefined behavior.") )) -(def: (with-baseline baseline [file line column]) +(def: (with_baseline baseline [file line column]) (-> Nat Location Location) [file line baseline]) -(def: (doc-fragment->Text fragment) - (-> Doc-Fragment Text) +(def: (doc_fragment->Text fragment) + (-> Doc_Fragment Text) (case fragment - (#Doc-Comment comment) + (#Doc_Comment comment) (|> comment - (text\split-all-with ..new-line) - (list\map (function (_ line) ($_ text\compose "## " line ..new-line))) - (text\join-with "")) + (text\split_all_with ..new_line) + (list\map (function (_ line) ($_ text\compose "## " line ..new_line))) + (text\join_with "")) - (#Doc-Example example) - (let [baseline (find-baseline-column example) + (#Doc_Example example) + (let [baseline (find_baseline_column example) [location _] example - [_ text] (doc-example->Text (with-baseline baseline location) baseline example)] + [_ text] (doc_example->Text (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) (macro: #export (doc tokens) {#.doc (text$ ($_ "lux text concat" "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." __paragraph - "## For Example:" ..new-line - "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new-line - " ''Can be used in monadic code to create monadic loops.''" ..new-line - " (loop [count +0" ..new-line - " x init]" ..new-line - " (if (< +10 count)" ..new-line - " (recur (inc count) (f x))" ..new-line + "## For Example:" ..new_line + "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new_line + " ''Can be used in monadic code to create monadic loops.''" ..new_line + " (loop [count +0" ..new_line + " x init]" ..new_line + " (if (< +10 count)" ..new_line + " (recur (inc count) (f x))" ..new_line " x)))"))} - (return (list (` [(~ location-code) + (return (list (` [(~ location_code) (#.Text (~ (|> tokens - (list\map (|>> identify-doc-fragment doc-fragment->Text)) - (text\join-with "") + (list\map (|>> identify_doc_fragment doc_fragment->Text)) + (text\join_with "") text$)))])))) (def: (interleave xs ys) @@ -4998,15 +4998,15 @@ (#Cons y ys') (list& x y (interleave xs' ys'))))) -(def: (type-to-code type) +(def: (type_to_code type) (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list\map type-to-code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplate_list (list\map type_to_code params))))) (^template [] [( left right) - (` ( (~ (type-to-code left)) (~ (type-to-code right))))]) + (` ( (~ (type_to_code left)) (~ (type_to_code right))))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) @@ -5018,15 +5018,15 @@ (^template [] [( env type) - (let [env' (untemplate-list (list\map type-to-code env))] - (` ( (~ env') (~ (type-to-code type)))))]) + (let [env' (untemplate_list (list\map type_to_code env))] + (` ( (~ env') (~ (type_to_code type)))))]) ([#.UnivQ] [#.ExQ]) (#Named [module name] anonymous) ## TODO: Generate the explicit type definition instead of using ## the "identifier$" shortcut below. ## (` (#.Named [(~ (text$ module)) (~ (text$ name))] - ## (~ (type-to-code anonymous)))) + ## (~ (type_to_code anonymous)))) (identifier$ [module name]))) (macro: #export (loop tokens) @@ -5039,41 +5039,41 @@ x)) "Loops can also be given custom names." - (loop my-loop + (loop my_loop [count +0 x init] (if (< +10 count) - (my-loop (inc count) (f x)) + (my_loop (inc count) (f x)) x)))} (let [?params (case tokens (^ (list name [_ (#Tuple bindings)] body)) (#.Some [name bindings body]) (^ (list [_ (#Tuple bindings)] body)) - (#.Some [(local-identifier$ "recur") bindings body]) + (#.Some [(local_identifier$ "recur") bindings body]) _ #.None)] (case ?params (#.Some [name bindings body]) - (let [pairs (as-pairs bindings) + (let [pairs (as_pairs bindings) vars (list\map first pairs) inits (list\map second pairs)] (if (every? identifier? inits) - (do meta-monad + (do meta_monad [inits' (: (Meta (List Name)) - (case (monad\map maybe-monad get-name inits) + (case (monad\map maybe_monad get_name inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) - init-types (monad\map meta-monad find-type inits') - expected get-expected-type] - (return (list (` (("lux check" (-> (~+ (list\map type-to-code init-types)) - (~ (type-to-code expected))) + init_types (monad\map meta_monad find_type inits') + expected get_expected_type] + (return (list (` (("lux check" (-> (~+ (list\map type_to_code init_types)) + (~ (type_to_code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) - (do meta-monad - [aliases (monad\map meta-monad + (do meta_monad + [aliases (monad\map meta_monad (: (-> Code (Meta Code)) (function (_ _) (gensym ""))) inits)] @@ -5092,12 +5092,12 @@ (f foo bar baz)))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches)) - (do meta-monad + (do meta_monad [slots (: (Meta [Name (List Name)]) (case (: (Maybe [Name (List Name)]) - (do maybe-monad - [hslot (get-tag hslot') - tslots (monad\map maybe-monad get-tag tslots')] + (do maybe_monad + [hslot (get_tag hslot') + tslots (monad\map maybe_monad get_tag tslots')] (wrap [hslot tslots]))) (#Some slots) (return slots) @@ -5106,18 +5106,18 @@ (fail "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) - tslots (monad\map meta-monad normalize tslots) - output (resolve-tag hslot) + tslots (monad\map meta_monad normalize tslots) + output (resolve_tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (list\map (: (-> Name [Text Code]) + slot_pairings (list\map (: (-> Name [Text Code]) (function (_ [module name]) - [name (local-identifier$ name)])) + [name (local_identifier$ name)])) (list& hslot tslots)) pattern (record$ (list\map (: (-> Name [Code Code]) (function (_ [module name]) (let [tag (tag$ [module name])] - (case (get name slot-pairings) + (case (get name slot_pairings) (#Some binding) [tag binding] #None [tag g!_])))) tags))]] @@ -5126,7 +5126,7 @@ _ (fail "Wrong syntax for ^slots"))) -(def: (place-tokens label tokens target) +(def: (place_tokens label tokens target) (-> Text (List Code) Code (Maybe (List Code))) (case target (^or [_ (#Bit _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Rev _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) @@ -5140,20 +5140,20 @@ (^template [] [[location ( elems)] - (do maybe-monad - [placements (monad\map maybe-monad (place-tokens label tokens) elems)] + (do maybe_monad + [placements (monad\map maybe_monad (place_tokens label tokens) elems)] (wrap (list [location ( (list\join placements))])))]) ([#Tuple] [#Form]) [location (#Record pairs)] - (do maybe-monad - [=pairs (monad\map maybe-monad + (do maybe_monad + [=pairs (monad\map maybe_monad (: (-> [Code Code] (Maybe [Code Code])) (function (_ [slot value]) - (do maybe-monad - [slot' (place-tokens label tokens slot) - value' (place-tokens label tokens value)] + (do maybe_monad + [slot' (place_tokens label tokens slot) + value' (place_tokens label tokens value)] (case [slot' value'] (^ [(list =slot) (list =value)]) (wrap [=slot =value]) @@ -5164,56 +5164,56 @@ (wrap (list [location (#Record =pairs)]))) )) -(macro: #export (with-expansions tokens) +(macro: #export (with_expansions tokens) {#.doc (doc "Controlled macro-expansion." "Bind an arbitraty number of Codes resulting from macro-expansion to local bindings." "Wherever a binding appears, the bound codes will be spliced in there." (test: "Code operations & structures" - (with-expansions - [ (template [ ] - [(compare ) - (compare (\ Code/encode encode )) - (compare #1 (\ equivalence = ))] - - [(bit #1) "#1" [_ (#.Bit #1)]] - [(bit #0) "#0" [_ (#.Bit #0)]] - [(int +123) "+123" [_ (#.Int +123)]] - [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "123") "'123'" [_ (#.Text "123")]] - [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] - [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] - [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] - [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] - [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] - )] - (test-all ))))} + (with_expansions + [ (template [ ] + [(compare ) + (compare (\ Code/encode encode )) + (compare #1 (\ equivalence = ))] + + [(bit #1) "#1" [_ (#.Bit #1)]] + [(bit #0) "#0" [_ (#.Bit #0)]] + [(int +123) "+123" [_ (#.Int +123)]] + [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] + [(text "123") "'123'" [_ (#.Text "123")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] + [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] + [(local_tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local_identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] + )] + (test_all ))))} (case tokens (^ (list& [_ (#Tuple bindings)] bodies)) (case bindings - (^ (list& [_ (#Identifier ["" var-name])] macro-expr bindings')) - (do meta-monad - [expansion (macro-expand-once macro-expr)] - (case (place-tokens var-name expansion (` (.with-expansions - [(~+ bindings')] - (~+ bodies)))) + (^ (list& [_ (#Identifier ["" var_name])] macro_expr bindings')) + (do meta_monad + [expansion (macro_expand_once macro_expr)] + (case (place_tokens var_name expansion (` (.with_expansions + [(~+ bindings')] + (~+ bodies)))) (#Some output) (wrap output) _ - (fail "[with-expansions] Improper macro expansion."))) + (fail "[with_expansions] Improper macro expansion."))) #Nil (return bodies) _ - (fail "Wrong syntax for with-expansions")) + (fail "Wrong syntax for with_expansions")) _ - (fail "Wrong syntax for with-expansions"))) + (fail "Wrong syntax for with_expansions"))) -(def: (flatten-alias type) +(def: (flatten_alias type) (-> Type Type) (case type (^template [] @@ -5227,17 +5227,17 @@ ["Text"]) (#Named _ type') - (flatten-alias type') + (flatten_alias type') _ type)) -(def: (anti-quote-def name) +(def: (anti_quote_def name) (-> Name (Meta Code)) - (do meta-monad - [type+value (find-def-value name) + (do meta_monad + [type+value (find_def_value name) #let [[type value] type+value]] - (case (flatten-alias type) + (case (flatten_alias type) (^template [ ] [(#Named ["lux" ] _) (wrap ( (:coerce value)))]) @@ -5251,53 +5251,53 @@ _ (fail (text\compose "Cannot anti-quote type: " (name\encode name)))))) -(def: (anti-quote token) +(def: (anti_quote token) (-> Code (Meta Code)) (case token - [_ (#Identifier [def-prefix def-name])] - (if (text\= "" def-prefix) - (do meta-monad - [current-module current-module-name] - (anti-quote-def [current-module def-name])) - (anti-quote-def [def-prefix def-name])) + [_ (#Identifier [def_prefix def_name])] + (if (text\= "" def_prefix) + (do meta_monad + [current_module current_module_name] + (anti_quote_def [current_module def_name])) + (anti_quote_def [def_prefix def_name])) (^template [] [[meta ( parts)] - (do meta-monad - [=parts (monad\map meta-monad anti-quote parts)] + (do meta_monad + [=parts (monad\map meta_monad anti_quote parts)] (wrap [meta ( =parts)]))]) ([#Form] [#Tuple]) [meta (#Record pairs)] - (do meta-monad - [=pairs (monad\map meta-monad + (do meta_monad + [=pairs (monad\map meta_monad (: (-> [Code Code] (Meta [Code Code])) (function (_ [slot value]) - (do meta-monad - [=value (anti-quote value)] + (do meta_monad + [=value (anti_quote value)] (wrap [slot =value])))) pairs)] (wrap [meta (#Record =pairs)])) _ - (\ meta-monad return token) + (\ meta_monad return token) )) (macro: #export (static tokens) (case tokens (^ (list pattern)) - (do meta-monad - [pattern' (anti-quote pattern)] + (do meta_monad + [pattern' (anti_quote pattern)] (wrap (list pattern'))) _ (fail "Wrong syntax for 'static'."))) -(type: Multi-Level-Case +(type: Multi_Level_Case [Code (List [Code Code])]) -(def: (case-level^ level) +(def: (case_level^ level) (-> Code (Meta [Code Code])) (case level (^ [_ (#Tuple (list expr binding))]) @@ -5307,20 +5307,20 @@ (return [level (` #1)]) )) -(def: (multi-level-case^ levels) - (-> (List Code) (Meta Multi-Level-Case)) +(def: (multi_level_case^ levels) + (-> (List Code) (Meta Multi_Level_Case)) (case levels #Nil (fail "Multi-level patterns cannot be empty.") (#Cons init extras) - (do meta-monad - [extras' (monad\map meta-monad case-level^ extras)] + (do meta_monad + [extras' (monad\map meta_monad case_level^ extras)] (wrap [init extras'])))) -(def: (multi-level-case$ g!_ [[init-pattern levels] body]) - (-> Code [Multi-Level-Case Code] (List Code)) - (let [inner-pattern-body (list\fold (function (_ [calculation pattern] success) +(def: (multi_level_case$ g!_ [[init_pattern levels] body]) + (-> Code [Multi_Level_Case Code] (List Code)) + (let [inner_pattern_body (list\fold (function (_ [calculation pattern] success) (let [bind? (case pattern [_ (#.Identifier _)] #1 @@ -5336,7 +5336,7 @@ (list g!_ (` #.None)))))))) (` (#.Some (~ body))) (: (List [Code Code]) (list\reverse levels)))] - (list init-pattern inner-pattern-body))) + (list init_pattern inner_pattern_body))) (macro: #export (^multi tokens) {#.doc (doc "Multi-level pattern matching." @@ -5344,7 +5344,7 @@ "For example:" (case (split (size static) uri) (^multi (#.Some [chunk uri']) [(text\= static chunk) #1]) - (match-uri endpoint? parts' uri') + (match_uri endpoint? parts' uri') _ (#.Left (format "Static part " (%t static) " does not match URI: " uri))) @@ -5353,21 +5353,21 @@ "The example above can be rewritten as..." (case (split (size static) uri) (^multi (#.Some [chunk uri']) (text\= static chunk)) - (match-uri endpoint? parts' uri') + (match_uri endpoint? parts' uri') _ (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens - (^ (list& [_meta (#Form levels)] body next-branches)) - (do meta-monad - [mlc (multi-level-case^ levels) - #let [initial-bind? (case mlc + (^ (list& [_meta (#Form levels)] body next_branches)) + (do meta_monad + [mlc (multi_level_case^ levels) + #let [initial_bind? (case mlc [[_ (#.Identifier _)] _] #1 _ #0)] - expected get-expected-type + expected get_expected_type g!temp (gensym "temp")] (let [output (list g!temp (` ({(#Some (~ g!temp)) @@ -5375,12 +5375,12 @@ #None (case (~ g!temp) - (~+ next-branches))} - ("lux check" (#.Apply (~ (type-to-code expected)) Maybe) + (~+ next_branches))} + ("lux check" (#.Apply (~ (type_to_code expected)) Maybe) (case (~ g!temp) - (~+ (multi-level-case$ g!temp [mlc body])) + (~+ (multi_level_case$ g!temp [mlc body])) - (~+ (if initial-bind? + (~+ (if initial_bind? (list) (list g!temp (` #.None)))))))))] (wrap output))) @@ -5390,15 +5390,15 @@ ## TODO: Allow asking the compiler for the name of the definition ## currently being defined. That name can then be fed into -## 'wrong-syntax-error' for easier maintenance of the error-messages. -(def: wrong-syntax-error +## 'wrong_syntax_error' for easier maintenance of the error_messages. +(def: wrong_syntax_error (-> Name Text) (|>> name\encode (text\compose "Wrong syntax for "))) -(macro: #export (name-of tokens) +(macro: #export (name_of tokens) {#.doc (doc "Given an identifier or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." - (name-of #.doc) + (name_of #.doc) "=>" ["lux" "doc"])} (case tokens @@ -5408,19 +5408,19 @@ ([#Identifier] [#Tag]) _ - (fail (..wrong-syntax-error ["lux" "name-of"])))) + (fail (..wrong_syntax_error ["lux" "name_of"])))) -(def: (get-scope-type-vars state) +(def: (get_scope_type_vars state) (Meta (List Nat)) (case state - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (#Right state scope-type-vars) + #scope_type_vars scope_type_vars} + (#Right state scope_type_vars) )) -(def: (list-at idx xs) +(def: (list_at idx xs) (All [a] (-> Nat (List a) (Maybe a))) (case xs #Nil @@ -5429,12 +5429,12 @@ (#Cons x xs') (if ("lux i64 =" 0 idx) (#Some x) - (list-at (dec idx) xs')))) + (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." - (def: #export (from-list list) + (def: #export (from_list list) (All [a] (-> (List a) (Row a))) (list\fold add (: (Row ($ 0)) @@ -5442,17 +5442,17 @@ list)))} (case tokens (^ (list [_ (#Nat idx)])) - (do meta-monad - [stvs get-scope-type-vars] - (case (list-at idx (list\reverse stvs)) - (#Some var-id) - (wrap (list (` (#Ex (~ (nat$ var-id)))))) + (do meta_monad + [stvs get_scope_type_vars] + (case (list_at idx (list\reverse stvs)) + (#Some var_id) + (wrap (list (` (#Ex (~ (nat$ var_id)))))) #None (fail (text\compose "Indexed-type does not exist: " (nat\encode idx))))) _ - (fail (..wrong-syntax-error (name-of ..$))))) + (fail (..wrong_syntax_error (name_of ..$))))) (def: #export (is? reference sample) {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." @@ -5470,16 +5470,16 @@ (def: (hash (^@ set [Hash _])) (list\fold (function (_ elem acc) (+ (\ Hash hash elem) acc)) 0 - (to-list set))))} + (to_list set))))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches)) - (let [g!whole (local-identifier$ name)] + (let [g!whole (local_identifier$ name)] (return (list& g!whole (` (case (~ g!whole) (~ pattern) (~ body))) branches))) _ - (fail (..wrong-syntax-error (name-of ..^@))))) + (fail (..wrong_syntax_error (name_of ..^@))))) (macro: #export (^|> tokens) {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." @@ -5488,26 +5488,26 @@ (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches)) - (let [g!name (local-identifier$ name)] + (let [g!name (local_identifier$ name)] (return (list& g!name (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] (~ body))) branches))) _ - (fail (..wrong-syntax-error (name-of ..^|>))))) + (fail (..wrong_syntax_error (name_of ..^|>))))) (macro: #export (:assume tokens) {#.doc (doc "Coerces the given expression to the type of whatever is expected." (: Dinosaur (:assume (list +1 +2 +3))))} (case tokens (^ (list expr)) - (do meta-monad - [type get-expected-type] - (wrap (list (` ("lux coerce" (~ (type-to-code type)) (~ expr)))))) + (do meta_monad + [type get_expected_type] + (wrap (list (` ("lux coerce" (~ (type_to_code type)) (~ expr)))))) _ - (fail (..wrong-syntax-error (name-of ..:assume))))) + (fail (..wrong_syntax_error (name_of ..:assume))))) (macro: #export (undefined tokens) {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations." @@ -5521,13 +5521,13 @@ (return (list (` (..error! "Undefined behavior.")))) _ - (fail (..wrong-syntax-error (name-of ..undefined))))) + (fail (..wrong_syntax_error (name_of ..undefined))))) (macro: #export (:of tokens) {#.doc (doc "Generates the type corresponding to a given expression." "Example #1:" - (let [my-num +123] - (:of my-num)) + (let [my_num +123] + (:of my_num)) "==" Int "-------------------" @@ -5536,30 +5536,30 @@ "==" Int)} (case tokens - (^ (list [_ (#Identifier var-name)])) - (do meta-monad - [var-type (find-type var-name)] - (wrap (list (type-to-code var-type)))) + (^ (list [_ (#Identifier var_name)])) + (do meta_monad + [var_type (find_type var_name)] + (wrap (list (type_to_code var_type)))) (^ (list expression)) - (do meta-monad + (do meta_monad [g!temp (gensym "g!temp")] (wrap (list (` (let [(~ g!temp) (~ expression)] (..:of (~ g!temp))))))) _ - (fail (..wrong-syntax-error (name-of ..:of))))) + (fail (..wrong_syntax_error (name_of ..:of))))) -(def: (parse-complex-declaration tokens) +(def: (parse_complex_declaration tokens) (-> (List Code) (Meta [[Text (List Text)] (List Code)])) (case tokens (^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens')) - (do meta-monad - [args (monad\map meta-monad + (do meta_monad + [args (monad\map meta_monad (function (_ arg') (case arg' - [_ (#Identifier ["" arg-name])] - (wrap arg-name) + [_ (#Identifier ["" arg_name])] + (wrap arg_name) _ (fail "Could not parse an argument."))) @@ -5570,7 +5570,7 @@ (fail "Could not parse a complex declaration.") )) -(def: (parse-any tokens) +(def: (parse_any tokens) (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& token tokens')) @@ -5580,7 +5580,7 @@ (fail "Could not parse anything.") )) -(def: (parse-many tokens) +(def: (parse_many tokens) (-> (List Code) (Meta [(List Code) (List Code)])) (case tokens (^ (list& head tail)) @@ -5590,7 +5590,7 @@ (fail "Could not parse anything.") )) -(def: (parse-end tokens) +(def: (parse_end tokens) (-> (List Code) (Meta Any)) (case tokens (^ (list)) @@ -5600,7 +5600,7 @@ (fail "Expected input Codes to be empty.") )) -(def: (parse-anns tokens) +(def: (parse_anns tokens) (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) @@ -5615,38 +5615,38 @@ "For simple macros that do not need any fancy features." (template: (square x) (* x x)))} - (do meta-monad + (do meta_monad [#let [[export? tokens] (export^ tokens)] - name+args|tokens (parse-complex-declaration tokens) + name+args|tokens (parse_complex_declaration tokens) #let [[[name args] tokens] name+args|tokens] - anns|tokens (parse-anns tokens) + anns|tokens (parse_anns tokens) #let [[anns tokens] anns|tokens] - input-templates|tokens (parse-many tokens) - #let [[input-templates tokens] input-templates|tokens] - _ (parse-end tokens) + input_templates|tokens (parse_many tokens) + #let [[input_templates tokens] input_templates|tokens] + _ (parse_end tokens) g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") - #let [rep-env (list\map (function (_ arg) - [arg (` ((~' ~) (~ (local-identifier$ arg))))]) + #let [rep_env (list\map (function (_ arg) + [arg (` ((~' ~) (~ (local_identifier$ arg))))]) args)] - this-module current-module-name] + this_module current_module_name] (wrap (list (` (macro: (~+ (export export?)) - ((~ (local-identifier$ name)) (~ g!tokens) (~ g!compiler)) + ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) (~ anns) (case (~ g!tokens) - (^ (list (~+ (list\map local-identifier$ args)))) + (^ (list (~+ (list\map local_identifier$ args)))) (#.Right [(~ g!compiler) (list (~+ (list\map (function (_ template) - (` (`' (~ (replace-syntax rep-env template))))) - input-templates)))]) + (` (`' (~ (replace_syntax rep_env template))))) + input_templates)))]) (~ g!_) - (#.Left (~ (text$ (..wrong-syntax-error [this-module name])))) + (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) ))))) )) -(macro: #export (as-is tokens compiler) +(macro: #export (as_is tokens compiler) (#Right [compiler tokens])) (macro: #export (char tokens compiler) @@ -5658,14 +5658,14 @@ [compiler] #Right) _ - (#Left (..wrong-syntax-error (name-of ..char))))) + (#Left (..wrong_syntax_error (name_of ..char))))) (def: target (Meta Text) (function (_ compiler) (#Right [compiler (get@ [#info #target] compiler)]))) -(def: (target-pick target options default) +(def: (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (case options #Nil @@ -5677,45 +5677,45 @@ (return (list default))) (#Cons [key pick] options') - (with-expansions [ (target-pick target options' default)] - (case key - [_ (#Text platform)] - (if (text\= target platform) - (return (list pick)) - ) - - [_ (#Identifier identifier)] - (do meta-monad - [identifier (..resolve-global-identifier identifier) - type+value (..find-def-value identifier) - #let [[type value] type+value]] - (case (..flatten-alias type) - (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) - (if (text\= target (:coerce ..Text value)) - (wrap (list pick)) - ) + (with_expansions [ (target_pick target options' default)] + (case key + [_ (#Text platform)] + (if (text\= target platform) + (return (list pick)) + ) + + [_ (#Identifier identifier)] + (do meta_monad + [identifier (..resolve_global_identifier identifier) + type+value (..find_def_value identifier) + #let [[type value] type+value]] + (case (..flatten_alias type) + (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) + (if (text\= target (:coerce ..Text value)) + (wrap (list pick)) + ) - _ - (fail ($_ text\compose - "Invalid target platform (must be a value of type Text): " (name\encode identifier) - " : " (..code\encode (..type-to-code type)))))) + _ + (fail ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type_to_code type)))))) - _ - )) + _ + )) )) (macro: #export (for tokens) - (do meta-monad + (do meta_monad [target ..target] (case tokens (^ (list [_ (#Record options)])) - (target-pick target options #.None) + (target_pick target options #.None) (^ (list [_ (#Record options)] default)) - (target-pick target options (#.Some default)) + (target_pick target options (#.Some default)) _ - (fail (..wrong-syntax-error (name-of ..for)))))) + (fail (..wrong_syntax_error (name_of ..for)))))) (template [ ] [(def: ( xy) @@ -5726,32 +5726,32 @@ [left a x] [right b y]) -(def: (label-code code) +(def: (label_code code) (-> Code (Meta [(List [Code Code]) Code])) (case code (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) - (do meta-monad + (do meta_monad [g!expansion (gensym "g!expansion")] (wrap [(list [g!expansion expansion]) g!expansion])) (^template [] [[ann ( parts)] - (do meta-monad - [=parts (monad\map meta-monad label-code parts)] + (do meta_monad + [=parts (monad\map meta_monad label_code parts)] (wrap [(list\fold list\compose (list) (list\map left =parts)) [ann ( (list\map right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] - (do meta-monad - [=kvs (monad\map meta-monad + (do meta_monad + [=kvs (monad\map meta_monad (function (_ [key val]) - (do meta-monad - [=key (label-code key) - =val (label-code val) - #let [[key-labels key-labelled] =key - [val-labels val-labelled] =val]] - (wrap [(list\compose key-labels val-labels) [key-labelled val-labelled]]))) + (do meta_monad + [=key (label_code key) + =val (label_code val) + #let [[key_labels key_labelled] =key + [val_labels val_labelled] =val]] + (wrap [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) kvs)] (wrap [(list\fold list\compose (list) (list\map left =kvs)) [ann (#Record (list\map right =kvs))]])) @@ -5762,37 +5762,37 @@ (macro: #export (`` tokens) (case tokens (^ (list raw)) - (do meta-monad - [=raw (label-code raw) + (do meta_monad + [=raw (label_code raw) #let [[labels labelled] =raw]] - (wrap (list (` (with-expansions [(~+ (|> labels + (wrap (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) list\join))] - (~ labelled)))))) + (~ labelled)))))) _ - (fail (..wrong-syntax-error (name-of ..``))) + (fail (..wrong_syntax_error (name_of ..``))) )) (def: (name$ [module name]) (-> Name Code) (` [(~ (text$ module)) (~ (text$ name))])) -(def: (untemplate-list& last inits) +(def: (untemplate_list& last inits) (-> Code (List Code) Code) (case inits #Nil last (#Cons [init inits']) - (` (#.Cons (~ init) (~ (untemplate-list& last inits')))))) + (` (#.Cons (~ init) (~ (untemplate_list& last inits')))))) -(def: (untemplate-pattern pattern) +(def: (untemplate_pattern pattern) (-> Code (Meta Code)) (case pattern (^template [ ] [[_ ( value)] - (do meta-monad + (do meta_monad [g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) ( (~ ( value)))])))]) ([#Bit "Bit" bit$] @@ -5805,16 +5805,16 @@ [#Identifier "Identifier" name$]) [_ (#Record fields)] - (do meta-monad - [=fields (monad\map meta-monad + (do meta_monad + [=fields (monad\map meta_monad (function (_ [key value]) - (do meta-monad - [=key (untemplate-pattern key) - =value (untemplate-pattern value)] + (do meta_monad + [=key (untemplate_pattern key) + =value (untemplate_pattern value)] (wrap (` [(~ =key) (~ =value)])))) fields) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))]))) + (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))]))) [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))] (return unquoted) @@ -5827,33 +5827,33 @@ (case (list\reverse elems) (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] inits) - (do meta-monad - [=inits (monad\map meta-monad untemplate-pattern (list\reverse inits)) + (do meta_monad + [=inits (monad\map meta_monad untemplate_pattern (list\reverse inits)) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) ( (~ (untemplate-list& spliced =inits)))]))) + (wrap (` [(~ g!meta) ( (~ (untemplate_list& spliced =inits)))]))) _ - (do meta-monad - [=elems (monad\map meta-monad untemplate-pattern elems) + (do meta_monad + [=elems (monad\map meta_monad untemplate_pattern elems) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) ( (~ (untemplate-list =elems)))]))))]) + (wrap (` [(~ g!meta) ( (~ (untemplate_list =elems)))]))))]) ([#Tuple] [#Form]) )) (macro: #export (^code tokens) (case tokens (^ (list& [_meta (#Form (list template))] body branches)) - (do meta-monad - [pattern (untemplate-pattern template)] + (do meta_monad + [pattern (untemplate_pattern template)] (wrap (list& pattern body branches))) (^ (list template)) - (do meta-monad - [pattern (untemplate-pattern template)] + (do meta_monad + [pattern (untemplate_pattern template)] (wrap (list pattern))) _ - (fail (..wrong-syntax-error (name-of ..^code))))) + (fail (..wrong_syntax_error (name_of ..^code))))) (template [ ] [(def: #export #0) @@ -5868,12 +5868,12 @@ (case tokens (^ (list [_ (#Tuple bindings)] bodyT)) (if (multiple? 2 (list\size bindings)) - (return (list (` (..with-expansions [(~+ (|> bindings - ..as-pairs + (return (list (` (..with_expansions [(~+ (|> bindings + ..as_pairs (list\map (function (_ [localT valueT]) - (list localT (` (..as-is (~ valueT)))))) + (list localT (` (..as_is (~ valueT)))))) (list\fold list\compose (list))))] - (~ bodyT))))) + (~ bodyT))))) (..fail ":let requires an even number of parts")) _ diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index 0a2b6f65c..fd325759a 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -40,7 +40,7 @@ #.None)) (#.Some [?name comonad bindings body]) (if (|> bindings list.size (n.% 2) (n.= 0)) - (let [[module short] (name-of ..be) + (let [[module short] (name_of ..be) gensym (: (-> Text Code) (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) g!_ (gensym "_") @@ -57,7 +57,7 @@ (` (|> (~ value) (~ g!split) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))))) )))) body - (list.reverse (list.as-pairs bindings)))] + (list.reverse (list.as_pairs bindings)))] (#.Right [state (list (case ?name (#.Some name) (let [name [location.dummy (#.Identifier ["" name])]] diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux index b1b026440..fbe3a4c8a 100644 --- a/stdlib/source/lux/abstract/interval.lux +++ b/stdlib/source/lux/abstract/interval.lux @@ -63,14 +63,14 @@ (let [(^open ".") interval] (= elem)))] - [starts-with? bottom] - [ends-with? top] + [starts_with? bottom] + [ends_with? top] ) (def: #export (borders? interval elem) (All [a] (-> (Interval a) a Bit)) - (or (starts-with? elem interval) - (ends-with? elem interval))) + (or (starts_with? elem interval) + (ends_with? elem interval))) (def: #export (union left right) (All [a] (-> (Interval a) (Interval a) (Interval a))) @@ -125,15 +125,15 @@ (or (meets? reference sample) (meets? sample reference))) -(template [ ] +(template [ ] [(def: #export ( reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) (let [(^open ",\.") reference] - (and (,\= (\ reference ) - (\ sample )) + (and (,\= (\ reference ) + (\ sample )) ( ,\&order - (\ reference ) - (\ sample )))))] + (\ reference ) + (\ sample )))))] [starts? ,\bottom order.<= ,\top] [finishes? ,\top order.>= ,\bottom] diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux index 1d7c67401..900d5cca4 100644 --- a/stdlib/source/lux/abstract/monad.lux +++ b/stdlib/source/lux/abstract/monad.lux @@ -33,11 +33,11 @@ #.Nil xs)) -(def: (as-pairs xs) +(def: (as_pairs xs) (All [a] (-> (List a) (List [a a]))) (case xs (#.Cons x1 (#.Cons x2 xs')) - (#.Cons [x1 x2] (as-pairs xs')) + (#.Cons [x1 x2] (as_pairs xs')) _ #.Nil)) @@ -70,7 +70,7 @@ #.None)) (#.Some [?name monad bindings body]) (if (|> bindings list\size .int ("lux i64 %" +2) ("lux i64 =" +0)) - (let [[module short] (name-of ..do) + (let [[module short] (name_of ..do) gensym (: (-> Text Code) (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) g!_ (gensym "_") @@ -87,7 +87,7 @@ (` (|> (~ value) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))) (~ g!join))) )))) body - (reverse (as-pairs bindings)))] + (reverse (as_pairs bindings)))] (#.Right [state (list (case ?name (#.Some name) (let [name [location.dummy (#.Identifier ["" name])]] diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux index 4e6f51942..0b79a230e 100644 --- a/stdlib/source/lux/abstract/monad/indexed.lux +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -39,27 +39,27 @@ (s.tuple (p.some binding))) binding)) -(def: (pair-list [binding value]) +(def: (pair_list [binding value]) (All [a] (-> [a a] (List a))) (list binding value)) -(def: named-monad +(def: named_monad (Parser [(Maybe Text) Code]) (p.either (s.record (p.and (\ p.monad map (|>> #.Some) - s.local-identifier) + s.local_identifier) s.any)) (\ p.monad map (|>> [#.None]) s.any))) -(syntax: #export (do {[?name monad] ..named-monad} +(syntax: #export (do {[?name monad] ..named_monad} {context (s.tuple (p.some context))} expression) - (meta.with-gensyms [g!_ g!bind] + (meta.with_gensyms [g!_ g!bind] (let [body (list\fold (function (_ context next) (case context (#Let bindings) (` (let [(~+ (|> bindings - (list\map pair-list) + (list\map pair_list) list.concat))] (~ next))) @@ -72,7 +72,7 @@ (list.reverse context))] (wrap (list (case ?name (#.Some name) - (let [name (code.local-identifier name)] + (let [name (code.local_identifier name)] (` (let [(~ name) (~ monad) {#..wrap (~' wrap) #..bind (~ g!bind)} (~ name)] diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 2791cce92..de3d5a10d 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -13,7 +13,7 @@ ["i" int] ["r" rev] ["f" frac]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:) @@ -33,7 +33,7 @@ (def: aliases^ (Parser (List Alias)) - (|> (<>.and .local-identifier .any) + (|> (<>.and .local_identifier .any) <>.some .record (<>.default (list)))) @@ -49,7 +49,7 @@ (<>.and (|> bottom^ (<>\map (|>> #.Some))) (<>\wrap (list))))) -(def: (stack-fold tops bottom) +(def: (stack_fold tops bottom) (-> (List Code) Code Code) (list\fold (function (_ top bottom) (` [(~ bottom) (~ top)])) @@ -65,34 +65,34 @@ (wrap singleton) _ - (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line - (|> expansion (list\map %.code) (text.join-with " "))))))) + (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new_line + (|> expansion (list\map %.code) (text.join_with " "))))))) (syntax: #export (=> {aliases aliases^} {inputs stack^} {outputs stack^}) - (let [de-alias (function (_ aliased) + (let [de_alias (function (_ aliased) (list\fold (function (_ [from to] pre) - (code.replace (code.local-identifier from) to pre)) + (code.replace (code.local_identifier from) to pre)) aliased aliases))] (case [(|> inputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`)))) (|> outputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`))))] [(#.Some bottomI) (#.Some bottomO)] (monad.do meta.monad - [inputC (singleton (meta.expand-all (stack-fold (get@ #top inputs) bottomI))) - outputC (singleton (meta.expand-all (stack-fold (get@ #top outputs) bottomO)))] - (wrap (list (` (-> (~ (de-alias inputC)) - (~ (de-alias outputC))))))) + [inputC (singleton (meta.expand_all (stack_fold (get@ #top inputs) bottomI))) + outputC (singleton (meta.expand_all (stack_fold (get@ #top outputs) bottomO)))] + (wrap (list (` (-> (~ (de_alias inputC)) + (~ (de_alias outputC))))))) [?bottomI ?bottomO] - (with-gensyms [g!stack] + (with_gensyms [g!stack] (monad.do meta.monad - [inputC (singleton (meta.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) - outputC (singleton (meta.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] + [inputC (singleton (meta.expand_all (stack_fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) + outputC (singleton (meta.expand_all (stack_fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] - (-> (~ (de-alias inputC)) - (~ (de-alias outputC)))))))))))) + (-> (~ (de_alias inputC)) + (~ (de_alias outputC)))))))))))) (def: begin! Any []) @@ -106,24 +106,24 @@ (syntax: #export (word: {export |export|.parser} - {name .local-identifier} - {annotations (<>.default cs.empty-annotations csr.annotations)} + {name .local_identifier} + {annotations (<>.default cs.empty_annotations csr.annotations)} type {commands (<>.some .any)}) - (wrap (list (` (def: (~+ (|export|.write export)) (~ (code.local-identifier name)) + (wrap (list (` (def: (~+ (|export|.write export)) (~ (code.local_identifier name)) (~ (csw.annotations annotations)) (~ type) (|>> (~+ commands))))))) (syntax: #export (apply {arity (|> .nat (<>.filter (n.> 0)))}) - (with-gensyms [g! g!func g!stack g!output] + (with_gensyms [g! g!func g!stack g!output] (monad.do {! meta.monad} [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq !))] (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] (-> (-> (~+ g!inputs) (~ g!output)) (=> [(~+ g!inputs)] [(~ g!output)]))) (function ((~ g!) (~ g!func)) - (function ((~ g!) (~ (stack-fold g!inputs g!stack))) + (function ((~ g!) (~ (stack_fold g!inputs g!stack))) [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) (def: #export apply/1 (apply 1)) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 66ea24cd8..6355a43b7 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -25,7 +25,7 @@ ["csr" reader] ["csw" writer] ["|.|" export]]]] - ["." meta (#+ with-gensyms monad) + ["." meta (#+ with_gensyms monad) ["." annotation]] [type (#+ :share) ["." abstract (#+ abstract: :representation :abstraction)]]] @@ -37,10 +37,10 @@ (exception: #export poisoned) (exception: #export dead) -(with-expansions - [ (as-is (-> s (Actor s) (Promise (Try s)))) - (as-is [Text s (List )]) - (as-is (Rec Mailbox +(with_expansions + [ (as_is (-> s (Actor s) (Promise (Try s)))) + (as_is [Text s (List )]) + (as_is (Rec Mailbox [(Promise [ Mailbox]) (Resolver [ Mailbox])]))] @@ -73,29 +73,29 @@ (type: #export (Behavior o s) {#.doc "An actor's behavior when mail is received and when a fatal error occurs."} - {#on-init (-> o s) - #on-mail (-> (Mail s) s (Actor s) (Promise (Try s))) - #on-stop (-> Text s (Promise Any))}) + {#on_init (-> o s) + #on_mail (-> (Mail s) s (Actor s) (Promise (Try s))) + #on_stop (-> Text s (Promise Any))}) (def: #export (spawn! behavior init) {#.doc "Given a behavior and initial state, spawns an actor and returns it."} (All [o s] (-> (Behavior o s) o (IO (Actor s)))) - (io (let [[on-init on-mail on-stop] behavior + (io (let [[on_init on_mail on_stop] behavior self (:share [o s] {(Behavior o s) behavior} {(Actor s) (:abstraction {#obituary (promise.promise []) #mailbox (atom (promise.promise []))})}) - process (loop [state (on-init init) + process (loop [state (on_init init) [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] (do {! promise.monad} [[head tail] |mailbox| - ?state' (on-mail head state self)] + ?state' (on_mail head state self)] (case ?state' (#try.Failure error) (do ! - [_ (on-stop error state)] + [_ (on_stop error state)] (let [[_ resolve] (get@ #obituary (:representation self))] (exec (io.run (do io.monad @@ -195,19 +195,19 @@ ) ) -(def: (default-on-mail mail state self) +(def: (default_on_mail mail state self) (All [s] (-> (Mail s) s (Actor s) (Promise (Try s)))) (mail state self)) -(def: (default-on-stop cause state) +(def: (default_on_stop cause state) (All [s] (-> Text s (Promise Any))) (promise\wrap [])) (def: #export default (All [s] (Behavior s s)) - {#on-init function.identity - #on-mail ..default-on-mail - #on-stop ..default-on-stop}) + {#on_init function.identity + #on_mail ..default_on_mail + #on_stop ..default_on_stop}) (def: #export (poison! actor) {#.doc (doc "Kills the actor by sending mail that will kill it upon processing," @@ -217,64 +217,64 @@ (promise.resolved (exception.throw ..poisoned []))) actor)) -(def: actor-decl^ +(def: actor_decl^ (Parser [Text (List Text)]) - (<>.either (.form (<>.and .local-identifier (<>.some .local-identifier))) - (<>.and .local-identifier (\ <>.monad wrap (list))))) + (<>.either (.form (<>.and .local_identifier (<>.some .local_identifier))) + (<>.and .local_identifier (\ <>.monad wrap (list))))) -(type: On-MailC +(type: On_MailC [[Text Text Text] Code]) -(type: On-StopC +(type: On_StopC [[Text Text] Code]) (type: BehaviorC - [(Maybe On-MailC) (Maybe On-StopC) (List Code)]) + [(Maybe On_MailC) (Maybe On_StopC) (List Code)]) (def: argument (Parser Text) - .local-identifier) + .local_identifier) (def: behavior^ (Parser BehaviorC) - (let [on-mail-args ($_ <>.and ..argument ..argument ..argument) - on-stop-args ($_ <>.and ..argument ..argument)] + (let [on_mail_args ($_ <>.and ..argument ..argument ..argument) + on_stop_args ($_ <>.and ..argument ..argument)] ($_ <>.and - (<>.maybe (.form (<>.and (.form (<>.after (.this! (' on-mail)) on-mail-args)) + (<>.maybe (.form (<>.and (.form (<>.after (.this! (' on_mail)) on_mail_args)) .any))) - (<>.maybe (.form (<>.and (.form (<>.after (.this! (' on-stop)) on-stop-args)) + (<>.maybe (.form (<>.and (.form (<>.after (.this! (' on_stop)) on_stop_args)) .any))) (<>.some .any)))) -(def: (on-mail g!_ ?on-mail) - (-> Code (Maybe On-MailC) Code) - (case ?on-mail +(def: (on_mail g!_ ?on_mail) + (-> Code (Maybe On_MailC) Code) + (case ?on_mail #.None - (` (~! ..default-on-mail)) + (` (~! ..default_on_mail)) (#.Some [[mailN stateN selfN] bodyC]) (` (function ((~ g!_) - (~ (code.local-identifier mailN)) - (~ (code.local-identifier stateN)) - (~ (code.local-identifier selfN))) + (~ (code.local_identifier mailN)) + (~ (code.local_identifier stateN)) + (~ (code.local_identifier selfN))) (~ bodyC))))) -(def: (on-stop g!_ ?on-stop) - (-> Code (Maybe On-StopC) Code) - (case ?on-stop +(def: (on_stop g!_ ?on_stop) + (-> Code (Maybe On_StopC) Code) + (case ?on_stop #.None - (` (~! ..default-on-stop)) + (` (~! ..default_on_stop)) (#.Some [[causeN stateN] bodyC]) (` (function ((~ g!_) - (~ (code.local-identifier causeN)) - (~ (code.local-identifier stateN))) + (~ (code.local_identifier causeN)) + (~ (code.local_identifier stateN))) (~ bodyC))))) -(with-expansions [ (as-is (actor: #export (Stack a) +(with_expansions [ (as_is (actor: #export (Stack a) (List a) - ((on-mail mail state self) + ((on_mail mail state self) (do (try.with promise.monad) [#let [_ (log! "BEFORE")] output (mail state self) @@ -288,7 +288,7 @@ (actor: #export Counter Nat - ((on-stop cause state) + ((on_stop cause state) (\ promise.monad wrap (log! (if (exception.match? ..poisoned cause) (format "Counter was poisoned: " (%.nat state)) @@ -302,45 +302,45 @@ (promise.resolved (#try.Success [state state])))))] (syntax: #export (actor: {export |export|.parser} - {[name vars] actor-decl^} - {annotations (<>.default cs.empty-annotations csr.annotations)} - state-type - {[?on-mail ?on-stop messages] behavior^}) + {[name vars] actor_decl^} + {annotations (<>.default cs.empty_annotations csr.annotations)} + state_type + {[?on_mail ?on_stop messages] behavior^}) {#.doc (doc "Defines an actor, with its behavior and internal state." - "Messages for the actor must be defined after the on-mail and on-stop handlers." + "Messages for the actor must be defined after the on_mail and on_stop handlers." )} - (with-gensyms [g!_] + (with_gensyms [g!_] (do meta.monad - [g!type (meta.gensym (format name "-abstract-type")) - #let [g!actor (code.local-identifier name) - g!vars (list\map code.local-identifier vars)]] + [g!type (meta.gensym (format name "_abstract_type")) + #let [g!actor (code.local_identifier name) + g!vars (list\map code.local_identifier vars)]] (wrap (list (` ((~! abstract:) (~+ (|export|.write export)) ((~ g!type) (~+ g!vars)) - (~ state-type) + (~ state_type) (def: (~+ (|export|.write export)) (~ g!actor) (All [(~+ g!vars)] - (..Behavior (~ state-type) ((~ g!type) (~+ g!vars)))) - {#..on-init (|>> ((~! abstract.:abstraction) (~ g!type))) - #..on-mail (~ (..on-mail g!_ ?on-mail)) - #..on-stop (~ (..on-stop g!_ ?on-stop))}) + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) + #..on_mail (~ (..on_mail g!_ ?on_mail)) + #..on_stop (~ (..on_stop g!_ ?on_stop))}) (~+ messages)))))))) - (syntax: #export (actor {[state-type init] (.record (<>.and .any .any))} - {[?on-mail ?on-stop messages] behavior^}) - (with-gensyms [g!_] - (wrap (list (` (: ((~! io.IO) (..Actor (~ state-type))) - (..spawn! (: (..Behavior (~ state-type) (~ state-type)) - {#..on-init (|>>) - #..on-mail (~ (..on-mail g!_ ?on-mail)) - #..on-stop (~ (..on-stop g!_ ?on-stop))}) - (: (~ state-type) + (syntax: #export (actor {[state_type init] (.record (<>.and .any .any))} + {[?on_mail ?on_stop messages] behavior^}) + (with_gensyms [g!_] + (wrap (list (` (: ((~! io.IO) (..Actor (~ state_type))) + (..spawn! (: (..Behavior (~ state_type) (~ state_type)) + {#..on_init (|>>) + #..on_mail (~ (..on_mail g!_ ?on_mail)) + #..on_stop (~ (..on_stop g!_ ?on_stop))}) + (: (~ state_type) (~ init))))))))) (type: Signature {#vars (List Text) #name Text - #inputs (List cs.Typed-Input) + #inputs (List cs.Typed_Input) #state Text #self Text #output Code}) @@ -348,22 +348,22 @@ (def: signature^ (Parser Signature) (.form ($_ <>.and - (<>.default (list) (.tuple (<>.some .local-identifier))) - .local-identifier - (<>.some csr.typed-input) - .local-identifier - .local-identifier + (<>.default (list) (.tuple (<>.some .local_identifier))) + .local_identifier + (<>.some csr.typed_input) + .local_identifier + .local_identifier .any))) (def: reference^ (Parser [Name (List Text)]) - (<>.either (.form (<>.and .identifier (<>.some .local-identifier))) + (<>.either (.form (<>.and .identifier (<>.some .local_identifier))) (<>.and .identifier (\ <>.monad wrap (list))))) (syntax: #export (message: {export |export|.parser} {signature signature^} - {annotations (<>.default cs.empty-annotations csr.annotations)} + {annotations (<>.default cs.empty_annotations csr.annotations)} body) {#.doc (doc "A message can access the actor's state through the state parameter." "A message can also access the actor itself through the self parameter." @@ -371,30 +371,30 @@ "A message may succeed or fail (in case of failure, the actor dies)." )} - (with-gensyms [g!_ g!return] + (with_gensyms [g!_ g!return] (do meta.monad - [actor-scope abstract.current - #let [g!type (code.local-identifier (get@ #abstract.name actor-scope)) - g!message (code.local-identifier (get@ #name signature)) - g!actor-vars (get@ #abstract.type-vars actor-scope) - g!all-vars (|> (get@ #vars signature) (list\map code.local-identifier) (list\compose g!actor-vars)) + [actor_scope abstract.current + #let [g!type (code.local_identifier (get@ #abstract.name actor_scope)) + g!message (code.local_identifier (get@ #name signature)) + g!actor_vars (get@ #abstract.type_vars actor_scope) + g!all_vars (|> (get@ #vars signature) (list\map code.local_identifier) (list\compose g!actor_vars)) g!inputsC (|> (get@ #inputs signature) (list\map product.left)) g!inputsT (|> (get@ #inputs signature) (list\map product.right)) - g!state (|> signature (get@ #state) code.local-identifier) - g!self (|> signature (get@ #self) code.local-identifier)]] + g!state (|> signature (get@ #state) code.local_identifier) + g!self (|> signature (get@ #self) code.local_identifier)]] (wrap (list (` (def: (~+ (|export|.write export)) ((~ g!message) (~+ g!inputsC)) (~ (csw.annotations annotations)) - (All [(~+ g!all-vars)] + (All [(~+ g!all_vars)] (-> (~+ g!inputsT) - (..Message (~ (get@ #abstract.abstraction actor-scope)) + (..Message (~ (get@ #abstract.abstraction actor_scope)) (~ (get@ #output signature))))) (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (:coerce (~ (get@ #abstract.representation actor-scope)) + (let [(~ g!state) (:coerce (~ (get@ #abstract.representation actor_scope)) (~ g!state))] (|> (~ body) - (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor-scope)) + (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) (~ (get@ #output signature))]))) - (:coerce ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor-scope)) + (:coerce ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) (~ (get@ #output signature))])))))))) )))))) @@ -416,6 +416,6 @@ (if continue? (do ! [outcome (..mail! (action event stop) actor)] - (wrap (try.to-maybe outcome))) + (wrap (try.to_maybe outcome))) (wrap #.None)))) channel))) diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index 04517cc3e..3920c0214 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -13,15 +13,15 @@ [type abstract]]) -(with-expansions [ (as-is (host.import: (java/util/concurrent/atomic/AtomicReference a) +(with_expansions [ (as_is (host.import: (java/util/concurrent/atomic/AtomicReference a) ["#::." (new [a]) (get [] a) (compareAndSet [a a] boolean)]))] - (for {@.old - @.jvm } - - (as-is))) + (for {@.old + @.jvm } + + (as_is))) (abstract: #export (Atom a) (for {@.old @@ -60,7 +60,7 @@ ("js array read" 0 (:representation atom)) }))) - (def: #export (compare-and-swap current new atom) + (def: #export (compare_and_swap current new atom) {#.doc (doc "Only mutates an atom if you can present its current value." "That guarantees that atom was not updated since you last read from it.")} (All [a] (-> a a (Atom a) (IO Bit))) @@ -87,7 +87,7 @@ (do io.monad [old (read atom) #let [new (f old)] - swapped? (compare-and-swap old new atom)] + swapped? (compare_and_swap old new atom)] (if swapped? (wrap new) (recur []))))) diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index aea0b082a..0c5303f46 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -22,7 +22,7 @@ {#.doc "An asynchronous channel to distribute values."} (Promise (Maybe [a (Channel a)]))) -(exception: #export channel-is-already-closed) +(exception: #export channel_is_already_closed) (signature: #export (Sink a) (: (IO (Try Any)) @@ -49,7 +49,7 @@ [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink. - (wrap (exception.throw ..channel-is-already-closed [])) + (wrap (exception.throw ..channel_is_already_closed [])) ## Someone else fed the sink while I was closing it. (recur []))))))) @@ -57,7 +57,7 @@ (loop [_ []] (do {! io.monad} [current (atom.read sink) - #let [[next resolve-next] (:share [a] + #let [[next resolve_next] (:share [a] {(promise.Resolver (Maybe [a (Channel a)])) current} {[(Promise (Maybe [a (Channel a)])) @@ -67,14 +67,14 @@ (if fed? ## I fed the sink. (do ! - [_ (atom.compare-and-swap current resolve-next sink)] + [_ (atom.compare_and_swap current resolve_next sink)] (wrap (exception.return []))) ## Someone else interacted with the sink. (do ! [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink while I was feeding it. - (wrap (exception.throw ..channel-is-already-closed [])) + (wrap (exception.throw ..channel_is_already_closed [])) ## Someone else fed the sink. (recur [])))))))))) @@ -99,11 +99,11 @@ (def: (apply ff fa) (do promise.monad - [cons-f ff - cons-a fa] - (case [cons-f cons-a] - [(#.Some [head-f tail-f]) (#.Some [head-a tail-a])] - (wrap (#.Some [(head-f head-a) (apply tail-f tail-a)])) + [cons_f ff + cons_a fa] + (case [cons_f cons_a] + [(#.Some [head_f tail_f]) (#.Some [head_a tail_a])] + (wrap (#.Some [(head_f head_a) (apply tail_f tail_a)])) _ (wrap #.None))))) @@ -181,7 +181,7 @@ #.None (wrap #.None)))) -(def: #export (from-promise promise) +(def: #export (from_promise promise) (All [a] (-> (Promise a) (Channel a))) (promise\map (function (_ value) (#.Some [value ..empty])) @@ -219,7 +219,7 @@ [init' (f head init)] (wrap (#.Some [init (folds f init' tail)])))))) -(def: #export (poll milli-seconds action) +(def: #export (poll milli_seconds action) (All [a] (-> Nat (IO a) [(Channel a) (Sink a)])) (let [[output sink] (channel [])] @@ -227,12 +227,12 @@ (do io.monad [value action _ (\ sink feed value)] - (promise.await recur (promise.wait milli-seconds))))) + (promise.await recur (promise.wait milli_seconds))))) [output sink]))) -(def: #export (periodic milli-seconds) +(def: #export (periodic milli_seconds) (-> Nat [(Channel Any) (Sink Any)]) - (..poll milli-seconds (io []))) + (..poll milli_seconds (io []))) (def: #export (iterate f init) (All [s o] (-> (-> s (Promise (Maybe [s o]))) s (Channel o))) @@ -282,7 +282,7 @@ #.None (wrap #.Nil)))) -(def: #export (sequential milli-seconds values) +(def: #export (sequential milli_seconds values) (All [a] (-> Nat (List a) (Channel a))) (case values #.Nil @@ -290,5 +290,5 @@ (#.Cons head tail) (promise.resolved (#.Some [head (do promise.monad - [_ (promise.wait milli-seconds)] - (sequential milli-seconds tail))])))) + [_ (promise.wait milli_seconds)] + (sequential milli_seconds tail))])))) diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index e4835b8d8..96822700d 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -38,7 +38,7 @@ #.None (do ! [#let [new [(#.Some value) #.None]] - succeeded? (atom.compare-and-swap old new promise)] + succeeded? (atom.compare_and_swap old new promise)] (if succeeded? (do ! [_ (monad.map ! (function (_ f) (f value)) @@ -72,7 +72,7 @@ #.None (let [new [_value (#.Cons f _observers)]] - (if (io.run (atom.compare-and-swap old new promise)) + (if (io.run (atom.compare_and_swap old new promise)) (io.io []) (await f (:abstraction promise))))))) ) @@ -134,7 +134,7 @@ {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) (let [[a|b resolve] (..promise [])] - (with-expansions + (with_expansions [ (template [ ] [(io.run (await (|>> resolve) ))] @@ -155,7 +155,7 @@ [right])) left||right)))) -(def: #export (schedule millis-delay computation) +(def: #export (schedule millis_delay computation) {#.doc (doc "Runs an I/O computation on its own thread (after a specified delay)." "Returns a Promise that will eventually host its result.")} (All [a] (-> Nat (IO a) (Promise a))) @@ -163,7 +163,7 @@ (exec (|> (do io.monad [value computation] (resolve value)) - (thread.schedule millis-delay) + (thread.schedule millis_delay) io.run) !out))) @@ -173,17 +173,17 @@ (All [a] (-> (IO a) (Promise a))) (schedule 0)) -(def: #export (delay time-millis value) +(def: #export (delay time_millis value) {#.doc "Delivers a value after a certain period has passed."} (All [a] (-> Nat a (Promise a))) - (schedule time-millis (io value))) + (schedule time_millis (io value))) -(def: #export (wait time-millis) +(def: #export (wait time_millis) {#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."} (-> Nat (Promise Any)) - (delay time-millis [])) + (delay time_millis [])) -(def: #export (time-out time-millis promise) +(def: #export (time_out time_millis promise) {#.doc "Wait for a promise to be resolved within the specified amount of milliseconds."} (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) - (..or (wait time-millis) promise)) + (..or (wait time_millis) promise)) diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index a405b7b3e..9e6ff9b29 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -22,25 +22,25 @@ ["." promise (#+ Promise Resolver)]]) (type: State - {#max-positions Nat - #open-positions Int - #waiting-list (Queue (Resolver Any))}) + {#max_positions Nat + #open_positions Int + #waiting_list (Queue (Resolver Any))}) (abstract: #export Semaphore (Atom State) {#.doc "A tool for controlling access to resources by multiple concurrent processes."} - (def: most-positions-possible + (def: most_positions_possible (.nat (\ i.interval top))) - (def: #export (semaphore initial-open-positions) + (def: #export (semaphore initial_open_positions) (-> Nat Semaphore) - (let [max-positions (n.min initial-open-positions - ..most-positions-possible)] - (:abstraction (atom.atom {#max-positions max-positions - #open-positions (.int max-positions) - #waiting-list queue.empty})))) + (let [max_positions (n.min initial_open_positions + ..most_positions_possible)] + (:abstraction (atom.atom {#max_positions max_positions + #open_positions (.int max_positions) + #waiting_list queue.empty})))) (def: #export (wait semaphore) (Ex [k] (-> Semaphore (Promise Any))) @@ -52,13 +52,13 @@ (do io.monad [state (atom.read semaphore) #let [[ready? state'] (: [Bit State] - (if (i.> +0 (get@ #open-positions state)) + (if (i.> +0 (get@ #open_positions state)) [true (|> state - (update@ #open-positions dec))] + (update@ #open_positions dec))] [false (|> state - (update@ #open-positions dec) - (update@ #waiting-list (queue.push sink)))]))] - success? (atom.compare-and-swap state state' semaphore)] + (update@ #open_positions dec) + (update@ #waiting_list (queue.push sink)))]))] + success? (atom.compare_and_swap state state' semaphore)] (if success? (if ready? (sink []) @@ -66,9 +66,9 @@ (recur []))))) signal))) - (exception: #export (semaphore-is-maxed-out {max-positions Nat}) + (exception: #export (semaphore_is_maxed_out {max_positions Nat}) (exception.report - ["Max Positions" (%.nat max-positions)])) + ["Max Positions" (%.nat max_positions)])) (def: #export (signal semaphore) (Ex [k] (-> Semaphore (Promise (Try Int)))) @@ -77,29 +77,29 @@ (loop [_ []] (do {! io.monad} [state (atom.read semaphore) - #let [[?sink state' maxed-out?] (: [(Maybe (Resolver Any)) State Bit] - (case (queue.peek (get@ #waiting-list state)) + #let [[?sink state' maxed_out?] (: [(Maybe (Resolver Any)) State Bit] + (case (queue.peek (get@ #waiting_list state)) #.None - (if (n.= (get@ #max-positions state) - (.nat (get@ #open-positions state))) + (if (n.= (get@ #max_positions state) + (.nat (get@ #open_positions state))) [#.None state true] [#.None - (update@ #open-positions inc state) + (update@ #open_positions inc state) false]) (#.Some head) [(#.Some head) (|> state - (update@ #open-positions inc) - (update@ #waiting-list queue.pop)) + (update@ #open_positions inc) + (update@ #waiting_list queue.pop)) false]))]] - (if maxed-out? - (wrap (exception.throw ..semaphore-is-maxed-out [(get@ #max-positions state)])) + (if maxed_out? + (wrap (exception.throw ..semaphore_is_maxed_out [(get@ #max_positions state)])) (do ! - [#let [open-positions (get@ #open-positions state')] - success? (atom.compare-and-swap state state' semaphore)] + [#let [open_positions (get@ #open_positions state')] + success? (atom.compare_and_swap state state' semaphore)] (if success? (do ! [_ (case ?sink @@ -108,7 +108,7 @@ (#.Some sink) (sink []))] - (wrap (#try.Success open-positions))) + (wrap (#try.Success open_positions))) (recur []))))))))) ) @@ -144,8 +144,8 @@ (abstract: #export Barrier {#limit Limit #count (Atom Nat) - #start-turnstile Semaphore - #end-turnstile Semaphore} + #start_turnstile Semaphore + #end_turnstile Semaphore} {#.doc "A barrier that blocks all processes from proceeding until a given number of processes are parked at the barrier."} @@ -153,10 +153,10 @@ (-> Limit Barrier) (:abstraction {#limit limit #count (atom.atom 0) - #start-turnstile (semaphore 0) - #end-turnstile (semaphore 0)})) + #start_turnstile (semaphore 0) + #end_turnstile (semaphore 0)})) - (def: (un-block times turnstile) + (def: (un_block times turnstile) (-> Nat Semaphore (Promise Any)) (loop [step 0] (if (n.< times step) @@ -169,16 +169,16 @@ [(def: ( (^:representation barrier)) (-> Barrier (Promise Any)) (do promise.monad - [#let [limit (refinement.un-refine (get@ #limit barrier)) + [#let [limit (refinement.un_refine (get@ #limit barrier)) goal count (io.run (atom.update (get@ #count barrier))) reached? (n.= goal count)]] (if reached? - (un-block limit (get@ barrier)) + (un_block limit (get@ barrier)) (wait (get@ barrier)))))] - [start inc limit #start-turnstile] - [end dec 0 #end-turnstile] + [start inc limit #start_turnstile] + [end dec 0 #end_turnstile] ) (def: #export (block barrier) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 523aa5567..7fd916fdb 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -36,7 +36,7 @@ (All [a] (-> (Var a) a)) (|>> :representation atom.read io.run product.left)) - (def: (un-follow sink var) + (def: (un_follow sink var) (All [a] (-> (Sink a) (Var a) (IO Any))) (do io.monad [_ (atom.update (function (_ [value observers]) @@ -44,26 +44,26 @@ (:representation var))] (wrap []))) - (def: (write! new-value var) + (def: (write! new_value var) (All [a] (-> a (Var a) (IO Any))) (do {! io.monad} [#let [var' (:representation var)] - (^@ old [old-value observers]) (atom.read var') - succeeded? (atom.compare-and-swap old [new-value observers] var')] + (^@ old [old_value observers]) (atom.read var') + succeeded? (atom.compare_and_swap old [new_value observers] var')] (if succeeded? (do ! [_ (monad.map ! (function (_ sink) (do ! - [result (\ sink feed new-value)] + [result (\ sink feed new_value)] (case result (#try.Success _) (wrap []) (#try.Failure _) - (un-follow sink var)))) + (un_follow sink var)))) observers)] (wrap [])) - (write! new-value var)))) + (write! new_value var)))) (def: #export (follow target) {#.doc "Creates a channel that will receive all changes to the value of the given var."} @@ -76,19 +76,19 @@ (wrap [channel sink]))) ) -(type: (Tx-Frame a) +(type: (Tx_Frame a) {#var (Var a) #original a #current a}) (type: Tx - (List (Ex [a] (Tx-Frame a)))) + (List (Ex [a] (Tx_Frame a)))) (type: #export (STM a) {#.doc "A computation which updates a transaction and produces a value."} (-> Tx [Tx a])) -(def: (find-var-value var tx) +(def: (find_var_value var tx) (All [a] (-> (Var a) Tx (Maybe a))) (|> tx (list.find (function (_ [_var _original _current]) @@ -102,7 +102,7 @@ (def: #export (read var) (All [a] (-> (Var a) (STM a))) (function (_ tx) - (case (find-var-value var tx) + (case (find_var_value var tx) (#.Some value) [tx value] @@ -111,7 +111,7 @@ [(#.Cons [var value value] tx) value])))) -(def: (update-tx-value var value tx) +(def: (update_tx_value var value tx) (All [a] (-> (Var a) a Tx Tx)) (case tx #.Nil @@ -127,15 +127,15 @@ (#.Cons {#var _var #original _original #current _current} - (update-tx-value var value tx'))))) + (update_tx_value var value tx'))))) (def: #export (write value var) {#.doc "Writes value to var."} (All [a] (-> a (Var a) (STM Any))) (function (_ tx) - (case (find-var-value var tx) + (case (find_var_value var tx) (#.Some _) - [(update-tx-value var value tx) + [(update_tx_value var value tx) []] #.None @@ -184,40 +184,40 @@ _ (..write a' var)] (wrap [a a']))) -(def: (can-commit? tx) +(def: (can_commit? tx) (-> Tx Bit) (list.every? (function (_ [_var _original _current]) (is? _original (..read! _var))) tx)) -(def: (commit-var! [_var _original _current]) - (-> (Ex [a] (Tx-Frame a)) (IO Any)) +(def: (commit_var! [_var _original _current]) + (-> (Ex [a] (Tx_Frame a)) (IO Any)) (if (is? _original _current) (io []) (..write! _current _var))) -(def: fresh-tx Tx (list)) +(def: fresh_tx Tx (list)) (type: (Commit a) [(STM a) (Promise a) (Resolver a)]) -(def: pending-commits +(def: pending_commits (Atom (Rec Commits [(Promise [(Ex [a] (Commit a)) Commits]) (Resolver [(Ex [a] (Commit a)) Commits])])) (atom (promise.promise []))) -(def: commit-processor-flag +(def: commit_processor_flag (Atom Bit) (atom #0)) -(def: (issue-commit commit) +(def: (issue_commit commit) (All [a] (-> (Commit a) (IO Any))) (let [entry [commit (promise.promise [])]] (do {! io.monad} - [|commits|&resolve (atom.read pending-commits)] + [|commits|&resolve (atom.read pending_commits)] (loop [[|commits| resolve] |commits|&resolve] (do ! [|commits| (promise.poll |commits|)] @@ -226,48 +226,48 @@ (do io.monad [resolved? (resolve entry)] (if resolved? - (atom.write (product.right entry) pending-commits) + (atom.write (product.right entry) pending_commits) (recur |commits|&resolve))) (#.Some [head tail]) (recur tail))))))) -(def: (process-commit commit) +(def: (process_commit commit) (All [a] (-> (Commit a) (IO Any))) - (let [[stm-proc output resolve] commit - [finished-tx value] (stm-proc fresh-tx)] - (if (can-commit? finished-tx) + (let [[stm_proc output resolve] commit + [finished_tx value] (stm_proc fresh_tx)] + (if (can_commit? finished_tx) (do {! io.monad} - [_ (monad.map ! commit-var! finished-tx)] + [_ (monad.map ! commit_var! finished_tx)] (resolve value)) - (issue-commit commit)))) + (issue_commit commit)))) -(def: init-processor! +(def: init_processor! (IO Any) (do {! io.monad} - [flag (atom.read commit-processor-flag)] + [flag (atom.read commit_processor_flag)] (if flag (wrap []) (do ! - [was-first? (atom.compare-and-swap flag #1 commit-processor-flag)] - (if was-first? + [was_first? (atom.compare_and_swap flag #1 commit_processor_flag)] + (if was_first? (do ! - [[promise resolve] (atom.read pending-commits)] + [[promise resolve] (atom.read pending_commits)] (promise.await (function (recur [head [tail _resolve]]) (do ! - [_ (process-commit head)] + [_ (process_commit head)] (promise.await recur tail))) promise)) (wrap []))) ))) -(def: #export (commit stm-proc) +(def: #export (commit stm_proc) {#.doc (doc "Commits a transaction and returns its result (asynchronously)." "Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first." "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} (All [a] (-> (STM a) (Promise a))) (let [[output resolver] (promise.promise [])] (exec (io.run (do io.monad - [_ init-processor!] - (issue-commit [stm-proc output resolver]))) + [_ init_processor!] + (issue_commit [stm_proc output resolver]))) output))) diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index 10ec17815..8bdd2b9c9 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -15,7 +15,7 @@ [// ["." atom (#+ Atom)]]) -(with-expansions [ (as-is (host.import: java/lang/Object) +(with_expansions [ (as_is (host.import: java/lang/Object) (host.import: java/lang/Runtime ["#::." @@ -38,11 +38,11 @@ ["#::." (new [int]) (schedule [java/lang/Runnable long java/util/concurrent/TimeUnit] #io (java/util/concurrent/ScheduledFuture java/lang/Object))]))] - (for {@.old (as-is ) - @.jvm (as-is ) + (for {@.old (as_is ) + @.jvm (as_is ) @.js - (as-is (host.import: (setTimeout [host.Function host.Number] #io Any)))} + (as_is (host.import: (setTimeout [host.Function host.Number] #io Any)))} ## Default (type: Thread @@ -53,7 +53,7 @@ (def: #export parallelism Nat - (with-expansions [ (|> (java/lang/Runtime::getRuntime) + (with_expansions [ (|> (java/lang/Runtime::getRuntime) (java/lang/Runtime::availableProcessors) .nat)] (for {@.old @@ -62,30 +62,30 @@ ## Default 1))) -(with-expansions [ (as-is (def: runner +(with_expansions [ (as_is (def: runner java/util/concurrent/ScheduledThreadPoolExecutor (java/util/concurrent/ScheduledThreadPoolExecutor::new (.int ..parallelism))))] (for {@.old @.jvm @.js - (as-is)} + (as_is)} ## Default (def: runner (Atom (List Thread)) (atom.atom (list))))) -(def: #export (schedule milli-seconds action) +(def: #export (schedule milli_seconds action) (-> Nat (IO Any) (IO Any)) (for {@.old (let [runnable (host.object [] [java/lang/Runnable] [] (java/lang/Runnable [] (run self) void (io.run action)))] - (case milli-seconds + (case milli_seconds 0 (java/util/concurrent/Executor::execute runnable runner) - _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) java/util/concurrent/TimeUnit::MILLISECONDS + _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS runner))) @.jvm @@ -93,34 +93,34 @@ [] (java/lang/Runnable [] (run self) void (io.run action)))] - (case milli-seconds + (case milli_seconds 0 (java/util/concurrent/Executor::execute runnable runner) - _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) java/util/concurrent/TimeUnit::MILLISECONDS + _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS runner))) @.js (..setTimeout [(host.closure [] (io.run action)) - (n.frac milli-seconds)])} + (n.frac milli_seconds)])} ## Default (do io.monad [_ (atom.update (|>> (#.Cons {#creation (.nat ("lux io current-time")) - #delay milli-seconds + #delay milli_seconds #action action})) ..runner)] (wrap [])))) (for {@.old - (as-is) + (as_is) @.jvm - (as-is) + (as_is) @.js - (as-is)} + (as_is)} ## Default - (as-is (exception: #export cannot-continue-running-threads) + (as_is (exception: #export cannot_continue_running_threads) (def: #export (run! _) (-> Any (IO Any)) @@ -139,11 +139,11 @@ (n.+ (get@ #delay thread)) (n.<= now))) threads)] - swapped? (atom.compare-and-swap threads pending ..runner)] + swapped? (atom.compare_and_swap threads pending ..runner)] (if swapped? (do ! [_ (monad.map ! (get@ #action) ready)] (run! [])) - (error! (ex.construct ..cannot-continue-running-threads [])))) + (error! (ex.construct ..cannot_continue_running_threads [])))) ))) )) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index ca5a4d183..df79b2c2d 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -8,7 +8,7 @@ ["." function] [parser ["s" code]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]]) @@ -39,8 +39,8 @@ (syntax: #export (pending expr) {#.doc (doc "Turns any expression into a function that is pending a continuation." - (pending (some-function some-input)))} - (with-gensyms [g!_ g!k] + (pending (some_function some_input)))} + (with_gensyms [g!_ g!k] (wrap (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) (def: #export (reset scope) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 71bb9ca90..9d7b7acca 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -31,7 +31,7 @@ (def: #export (match? exception error) (All [e] (-> (Exception e) Text Bit)) - (text.starts-with? (get@ #label exception) error)) + (text.starts_with? (get@ #label exception) error)) (def: #export (catch exception then try) {#.doc (doc "If a particular exception is detected on a possibly-erroneous value, handle it." @@ -45,14 +45,14 @@ (#//.Failure error) (let [reference (get@ #label exception)] - (if (text.starts-with? reference error) + (if (text.starts_with? reference error) (#//.Success (|> error (text.clip (text.size reference) (text.size error)) maybe.assume then)) (#//.Failure error))))) -(def: #export (otherwise to-do try) +(def: #export (otherwise to_do try) {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} (All [a] (-> (-> Text a) (Try a) a)) @@ -61,7 +61,7 @@ output (#//.Failure error) - (to-do error))) + (to_do error))) (def: #export (return value) {#.doc "A way to lift normal values into the error-handling context."} @@ -85,57 +85,57 @@ (..throw exception message))) (syntax: #export (exception: {export |export|.parser} - {t-vars (p.default (list) (s.tuple scr.type-variables))} - {[name inputs] (p.either (p.and s.local-identifier (wrap (list))) - (s.form (p.and s.local-identifier (p.some scr.typed-input))))} + {t_vars (p.default (list) (s.tuple scr.type_variables))} + {[name inputs] (p.either (p.and s.local_identifier (wrap (list))) + (s.form (p.and s.local_identifier (p.some scr.typed_input))))} {body (p.maybe s.any)}) {#.doc (doc "Define a new exception type." "It mostly just serves as a way to tag error messages for later catching." "" "Simple case:" - (exception: #export some-exception) + (exception: #export some_exception) "" "Complex case:" - (exception: #export [optional type variables] (some-exception {optional Text} {arguments Int}) - optional-body))} - (meta.with-gensyms [g!descriptor] + (exception: #export [optional type variables] (some_exception {optional Text} {arguments Int}) + optional_body))} + (meta.with_gensyms [g!descriptor] (do meta.monad - [current-module meta.current-module-name - #let [descriptor ($_ text\compose "{" current-module "." name "}" text.new-line) - g!self (code.local-identifier name)]] + [current_module meta.current_module_name + #let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line) + g!self (code.local_identifier name)]] (wrap (list (` (def: (~+ (|export|.write export)) (~ g!self) - (All [(~+ (scw.type-variables t-vars))] - (..Exception [(~+ (list\map (get@ #sc.input-type) inputs))])) + (All [(~+ (scw.type_variables t_vars))] + (..Exception [(~+ (list\map (get@ #sc.input_type) inputs))])) (let [(~ g!descriptor) (~ (code.text descriptor))] {#..label (~ g!descriptor) - #..constructor (function ((~ g!self) [(~+ (list\map (get@ #sc.input-binding) inputs))]) + #..constructor (function ((~ g!self) [(~+ (list\map (get@ #sc.input_binding) inputs))]) ((~! text\compose) (~ g!descriptor) (~ (maybe.default (' "") body))))}))))) ))) (def: (report' entries) (-> (List [Text Text]) Text) - (let [header-separator ": " - largest-header-size (list\fold (function (_ [header _] max) + (let [header_separator ": " + largest_header_size (list\fold (function (_ [header _] max) (n.max (text.size header) max)) 0 entries) - on-new-line (|> " " - (list.repeat (n.+ (text.size header-separator) - largest-header-size)) - (text.join-with "") - (text\compose text.new-line))] + on_new_line (|> " " + (list.repeat (n.+ (text.size header_separator) + largest_header_size)) + (text.join_with "") + (text\compose text.new_line))] (|> entries (list\map (function (_ [header message]) (let [padding (|> " " (list.repeat (n.- (text.size header) - largest-header-size)) - (text.join-with ""))] + largest_header_size)) + (text.join_with ""))] (|> message - (text.replace-all text.new-line on-new-line) - ($_ text\compose padding header header-separator))))) - (text.join-with text.new-line)))) + (text.replace_all text.new_line on_new_line) + ($_ text\compose padding header header_separator))))) + (text.join_with text.new_line)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) (wrap (list (` ((~! report') (list (~+ (|> entries @@ -152,11 +152,11 @@ report')) (def: separator - (let [gap ($_ "lux text concat" text.new-line text.new-line) - horizontal-line (|> "-" (list.repeat 64) (text.join-with ""))] + (let [gap ($_ "lux text concat" text.new_line text.new_line) + horizontal_line (|> "-" (list.repeat 64) (text.join_with ""))] ($_ "lux text concat" gap - horizontal-line + horizontal_line gap))) (def: (decorate prelude error) diff --git a/stdlib/source/lux/control/function/contract.lux b/stdlib/source/lux/control/function/contract.lux index 9333846fe..02ff4ddf8 100644 --- a/stdlib/source/lux/control/function/contract.lux +++ b/stdlib/source/lux/control/function/contract.lux @@ -7,7 +7,7 @@ ["i" int]] [text ["%" format (#+ format)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]]) @@ -17,8 +17,8 @@ (exception.report ["Condition" (%.code condition)]))] - [pre-condition-failed] - [post-condition-failed] + [pre_condition_failed] + [post_condition_failed] ) (def: (assert! message test) @@ -33,7 +33,7 @@ "Otherwise, an error is raised." (pre (i.= +4 (i.+ +2 +2)) (foo +123 +456 +789)))} - (wrap (list (` (exec ((~! ..assert!) (~ (code.text (exception.construct ..pre-condition-failed test))) + (wrap (list (` (exec ((~! ..assert!) (~ (code.text (exception.construct ..pre_condition_failed test))) (~ test)) (~ expr)))))) @@ -44,8 +44,8 @@ "Otherwise, an error is raised." (post i.even? (i.+ +2 +2)))} - (with-gensyms [g!output] + (with_gensyms [g!output] (wrap (list (` (let [(~ g!output) (~ expr)] - (exec ((~! ..assert!) (~ (code.text (exception.construct ..post-condition-failed test))) + (exec ((~! ..assert!) (~ (code.text (exception.construct ..post_condition_failed test))) ((~ test) (~ g!output))) (~ g!output)))))))) diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux index 679e534c3..ff6b8d304 100644 --- a/stdlib/source/lux/control/io.lux +++ b/stdlib/source/lux/control/io.lux @@ -9,7 +9,7 @@ ["s" code]]] [type abstract] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." template]]]) @@ -24,7 +24,7 @@ (|>> :abstraction)) (template: (!io computation) - (:abstraction (template.with-locals [g!func g!arg] + (:abstraction (template.with_locals [g!func g!arg] (function (g!func g!arg) computation)))) @@ -38,7 +38,7 @@ (io (exec (log! msg) "Some value...")))} - (with-gensyms [g!func g!arg] + (with_gensyms [g!func g!arg] (wrap (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) (~ computation)))))))) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 1cb4e2298..8f896cf39 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -163,7 +163,7 @@ (wrap (#.Cons x xs))) (\ ..monad wrap (list)))) -(def: #export (at-least n p) +(def: #export (at_least n p) {#.doc "Parse at least N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (do ..monad @@ -171,7 +171,7 @@ extra (some p)] (wrap (list\compose min extra)))) -(def: #export (at-most n p) +(def: #export (at_most n p) {#.doc "Parse at most N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (if (n.> 0 n) @@ -182,7 +182,7 @@ (#try.Success [input' x]) (run (do ..monad - [xs (at-most (dec n) p)] + [xs (at_most (dec n) p)] (wrap (#.Cons x xs))) input') )) @@ -192,11 +192,11 @@ {#.doc "Parse between N and M times."} (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) (do ..monad - [min-xs (exactly from p) - max-xs (at-most (n.- from to) p)] - (wrap (\ list.monad join (list min-xs max-xs))))) + [min_xs (exactly from p) + max_xs (at_most (n.- from to) p)] + (wrap (\ list.monad join (list min_xs max_xs))))) -(def: #export (sep-by sep p) +(def: #export (sep_by sep p) {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) (do {! ..monad} @@ -315,8 +315,8 @@ (#try.Failure error) (#try.Failure error) - (#try.Success [input' to-decode]) - (case (\ codec decode to-decode) + (#try.Success [input' to_decode]) + (case (\ codec decode to_decode) (#try.Failure error) (#try.Failure error) diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux index d62dca0e8..6a7a1c407 100644 --- a/stdlib/source/lux/control/parser/analysis.lux +++ b/stdlib/source/lux/control/parser/analysis.lux @@ -26,19 +26,19 @@ ["/" analysis (#+ Variant Tuple Environment Analysis)]]]]]] ["." //]) -(def: (remaining-inputs asts) +(def: (remaining_inputs asts) (-> (List Analysis) Text) - (format text.new-line "Remaining input: " + (format text.new_line "Remaining input: " (|> asts (list\map /.%analysis) (list.interpose " ") - (text.join-with "")))) + (text.join_with "")))) -(exception: #export (cannot-parse {input (List Analysis)}) +(exception: #export (cannot_parse {input (List Analysis)}) (exception.report ["Input" (exception.enumerate /.%analysis input)])) -(exception: #export (unconsumed-input {input (List Analysis)}) +(exception: #export (unconsumed_input {input (List Analysis)}) (exception.report ["Input" (exception.enumerate /.%analysis input)])) @@ -55,14 +55,14 @@ (#try.Success value) (#try.Success [unconsumed _]) - (exception.throw ..unconsumed-input unconsumed))) + (exception.throw ..unconsumed_input unconsumed))) (def: #export any (Parser Analysis) (function (_ input) (case input #.Nil - (exception.throw ..cannot-parse input) + (exception.throw ..cannot_parse input) (#.Cons [head tail]) (#try.Success [tail head])))) @@ -74,7 +74,7 @@ (case tokens #.Nil (#try.Success [tokens []]) _ (#try.Failure (format "Expected list of tokens to be empty!" - (remaining-inputs tokens)))))) + (remaining_inputs tokens)))))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -93,7 +93,7 @@ (#try.Success [input' x]) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) (def: #export ( expected) (-> (Parser Any)) @@ -102,10 +102,10 @@ (^ (list& ( actual) input')) (if (\ = expected actual) (#try.Success [input' []]) - (exception.throw ..cannot-parse input)) + (exception.throw ..cannot_parse input)) _ - (exception.throw ..cannot-parse input))))] + (exception.throw ..cannot_parse input))))] [bit bit! /.bit Bit bit.equivalence] [nat nat! /.nat Nat nat.equivalence] @@ -128,4 +128,4 @@ (#try.Success [tail output])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 03bcc9eba..32750d535 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -28,10 +28,10 @@ (type: #export Parser (//.Parser [Offset Binary])) -(exception: #export (binary-was-not-fully-read {binary-length Nat} {bytes-read Nat}) +(exception: #export (binary_was_not_fully_read {binary_length Nat} {bytes_read Nat}) (exception.report - ["Binary length" (%.nat binary-length)] - ["Bytes read" (%.nat bytes-read)])) + ["Binary length" (%.nat binary_length)] + ["Bytes read" (%.nat bytes_read)])) (def: #export (run parser input) (All [a] (-> (Parser a) Binary (Try a))) @@ -43,7 +43,7 @@ (let [length (/.size input)] (if (n.= end length) (#try.Success output) - (exception.throw ..binary-was-not-fully-read [length end]))))) + (exception.throw ..binary_was_not_fully_read [length end]))))) (def: #export end? (Parser Bit) @@ -94,9 +94,9 @@ (def: #export frac (Parser Frac) - (//\map frac.from-bits ..bits/64)) + (//\map frac.from_bits ..bits/64)) -(exception: #export (invalid-tag {range Nat} {byte Nat}) +(exception: #export (invalid_tag {range Nat} {byte Nat}) (exception.report ["Tag range" (%.nat range)] ["Tag value" (%.nat byte)])) @@ -109,7 +109,7 @@ (^template [ ] [ (\ ! map (|>> ) )]) ((~~ (template.splice +))) - _ (//.lift (exception.throw ..invalid-tag [(~~ (template.count +)) flag])))))) + _ (//.lift (exception.throw ..invalid_tag [(~~ (template.count +)) flag])))))) (def: #export (or left right) (All [l r] (-> (Parser l) (Parser r) (Parser (| l r)))) @@ -126,7 +126,7 @@ (Parser Any) (//\wrap [])) -(exception: #export (not-a-bit {value Nat}) +(exception: #export (not_a_bit {value Nat}) (exception.report ["Expected values" "either 0 or 1"] ["Actual value" (%.nat value)])) @@ -139,7 +139,7 @@ (case value 0 (wrap #0) 1 (wrap #1) - _ (//.lift (exception.throw ..not-a-bit [value]))))) + _ (//.lift (exception.throw ..not_a_bit [value]))))) (def: #export (segment size) (-> Nat (Parser Binary)) @@ -214,14 +214,14 @@ (|>> (//.and value) (..or ..any)))) -(exception: #export set-elements-are-not-unique) +(exception: #export set_elements_are_not_unique) (def: #export (set hash value) (All [a] (-> (Hash a) (Parser a) (Parser (Set a)))) (do //.monad [raw (..list value) - #let [output (set.from-list hash raw)] - _ (//.assert (exception.construct ..set-elements-are-not-unique []) + #let [output (set.from_list hash raw)] + _ (//.assert (exception.construct ..set_elements_are_not_unique []) (n.= (list.size raw) (set.size output)))] (wrap output))) diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux index de654eb24..7df6e448e 100644 --- a/stdlib/source/lux/control/parser/cli.lux +++ b/stdlib/source/lux/control/parser/cli.lux @@ -10,7 +10,7 @@ ["." list ("#\." monoid monad)]] ["." text ("#\." equivalence) ["%" format (#+ format)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]] @@ -34,7 +34,7 @@ (#try.Success output) _ - (#try.Failure (format "Remaining CLI inputs: " (text.join-with " " remaining)))) + (#try.Failure (format "Remaining CLI inputs: " (text.join_with " " remaining)))) (#try.Failure try) (#try.Failure try))) @@ -83,10 +83,10 @@ #.Nil (#try.Failure try) - (#.Cons to-omit immediate') + (#.Cons to_omit immediate') (do try.monad [[remaining output] (recur immediate')] - (wrap [(#.Cons to-omit remaining) + (wrap [(#.Cons to_omit remaining) output]))))))) (def: #export end @@ -95,7 +95,7 @@ (function (_ inputs) (case inputs #.Nil (#try.Success [inputs []]) - _ (#try.Failure (format "Unknown parameters: " (text.join-with " " inputs)))))) + _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs)))))) (def: #export (named name value) (All [a] (-> Text (Parser a) (Parser a))) @@ -109,27 +109,27 @@ (//.after (//.either (..this short) (..this long))) ..somewhere)) -(type: Program-Args +(type: Program_Args (#Raw Text) (#Parsed (List [Code Code]))) -(def: program-args^ - (s.Parser Program-Args) - (//.or s.local-identifier +(def: program_args^ + (s.Parser Program_Args) + (//.or s.local_identifier (s.tuple (//.some (//.either (do //.monad - [name s.local-identifier] + [name s.local_identifier] (wrap [(code.identifier ["" name]) (` any)])) (s.record (//.and s.any s.any))))))) (syntax: #export (program: - {args program-args^} + {args program_args^} body) {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." - (program: all-args + (program: all_args (do io.monad - [foo init-program - bar (do-something all-args)] + [foo init_program + bar (do_something all_args)] (wrap []))) (program: [name] @@ -137,10 +137,10 @@ (program: [{config config^}] (do io.monad - [data (init-program config)] - (do-something data))))} - (with-gensyms [g!program g!args g!_ g!output g!message] - (let [initialization+event-loop + [data (init_program config)] + (do_something data))))} + (with_gensyms [g!program g!args g!_ g!output g!message] + (let [initialization+event_loop (` ((~! do) (~! io.monad) [(~ g!output) (~ body) (~+ (for {@.old @@ -158,7 +158,7 @@ (#Raw args) (wrap (list (` ("lux def program" (.function ((~ g!program) (~ (code.identifier ["" args]))) - (~ initialization+event-loop)))))) + (~ initialization+event_loop)))))) (#Parsed args) (wrap (list (` ("lux def program" @@ -169,7 +169,7 @@ (list\map (function (_ [binding parser]) (list binding parser))) list\join))] - ((~' wrap) (~ initialization+event-loop)))) + ((~' wrap) (~ initialization+event_loop)))) (~ g!args)) (#.Right [(~ g!_) (~ g!output)]) (~ g!output) diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux index 9dc99e49a..82f5fbca8 100644 --- a/stdlib/source/lux/control/parser/code.lux +++ b/stdlib/source/lux/control/parser/code.lux @@ -19,20 +19,20 @@ ["." code ("#\." equivalence)]]] ["." //]) -(def: (join-pairs pairs) +(def: (join_pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs #.Nil #.Nil - (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) + (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs')))) (type: #export Parser {#.doc "A Lux syntax parser."} (//.Parser (List Code))) -(def: (remaining-inputs asts) +(def: (remaining_inputs asts) (-> (List Code) Text) - ($_ text\compose text.new-line "Remaining input: " - (|> asts (list\map code.format) (list.interpose " ") (text.join-with "")))) + ($_ text\compose text.new_line "Remaining input: " + (|> asts (list\map code.format) (list.interpose " ") (text.join_with "")))) (def: #export any {#.doc "Just returns the next input without applying any logic."} @@ -46,7 +46,7 @@ (#try.Success [tokens' t])))) (template [ ] - [(with-expansions [ (as-is (#try.Failure ($_ text\compose "Cannot parse " (remaining-inputs tokens))))] + [(with_expansions [ (as_is (#try.Failure ($_ text\compose "Cannot parse " (remaining_inputs tokens))))] (def: #export {#.doc (code.text ($_ text\compose "Parses the next " " input."))} (Parser ) @@ -89,13 +89,13 @@ (if (code\= ast token) (#try.Success [tokens' []]) (#try.Failure ($_ text\compose "Expected a " (code.format ast) " but instead got " (code.format token) - (remaining-inputs tokens)))) + (remaining_inputs tokens)))) _ (#try.Failure "There are no tokens to parse!")))) (template [ ] - [(with-expansions [ (as-is (#try.Failure ($_ text\compose "Cannot parse " (remaining-inputs tokens))))] + [(with_expansions [ (as_is (#try.Failure ($_ text\compose "Cannot parse " (remaining_inputs tokens))))] (def: #export {#.doc (code.text ($_ text\compose "Parse a local " " (a " " that has no module prefix)."))} (Parser Text) @@ -119,8 +119,8 @@ _ ))))] - [local-identifier local-identifier! #.Identifier text.equivalence "local identifier"] - [ local-tag local-tag! #.Tag text.equivalence "local tag"] + [local_identifier local_identifier! #.Identifier text.equivalence "local identifier"] + [ local_tag local_tag! #.Tag text.equivalence "local tag"] ) (template [ ] @@ -133,10 +133,10 @@ (#.Cons [[_ ( members)] tokens']) (case (p members) (#try.Success [#.Nil x]) (#try.Success [tokens' x]) - _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " (remaining-inputs tokens)))) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " (remaining_inputs tokens)))) _ - (#try.Failure ($_ text\compose "Cannot parse " (remaining-inputs tokens))))))] + (#try.Failure ($_ text\compose "Cannot parse " (remaining_inputs tokens))))))] [ form #.Form "form"] [tuple #.Tuple "tuple"] @@ -149,12 +149,12 @@ (function (_ tokens) (case tokens (#.Cons [[_ (#.Record pairs)] tokens']) - (case (p (join-pairs pairs)) + (case (p (join_pairs pairs)) (#try.Success [#.Nil x]) (#try.Success [tokens' x]) - _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining-inputs tokens)))) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining_inputs tokens)))) _ - (#try.Failure ($_ text\compose "Cannot parse record" (remaining-inputs tokens)))))) + (#try.Failure ($_ text\compose "Cannot parse record" (remaining_inputs tokens)))))) (def: #export end! {#.doc "Ensures there are no more inputs."} @@ -162,7 +162,7 @@ (function (_ tokens) (case tokens #.Nil (#try.Success [tokens []]) - _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining_inputs tokens)))))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -186,7 +186,7 @@ _ (#try.Failure (text\compose "Unconsumed inputs: " (|> (list\map code.format unconsumed) - (text.join-with ", "))))))) + (text.join_with ", "))))))) (def: #export (local inputs syntax) {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux index a7cf8fa9f..9035d41fe 100644 --- a/stdlib/source/lux/control/parser/json.lux +++ b/stdlib/source/lux/control/parser/json.lux @@ -24,11 +24,11 @@ {#.doc "JSON parser."} (//.Parser (List JSON) a)) -(exception: #export (unconsumed-input {input (List JSON)}) +(exception: #export (unconsumed_input {input (List JSON)}) (exception.report ["Input" (exception.enumerate /.format input)])) -(exception: #export empty-input) +(exception: #export empty_input) (def: #export (run parser json) (All [a] (-> (Parser a) JSON (Try a))) @@ -39,7 +39,7 @@ (#try.Success output) _ - (exception.throw ..unconsumed-input remainder)) + (exception.throw ..unconsumed_input remainder)) (#try.Failure error) (#try.Failure error))) @@ -50,12 +50,12 @@ (<| (function (_ inputs)) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (#try.Success [tail head])))) -(exception: #export (unexpected-value {value JSON}) +(exception: #export (unexpected_value {value JSON}) (exception.report ["Value" (/.format value)])) @@ -70,7 +70,7 @@ (wrap value) _ - (//.fail (exception.construct ..unexpected-value [head])))))] + (//.fail (exception.construct ..unexpected_value [head])))))] [null /.Null #/.Null "null"] [boolean /.Boolean #/.Boolean "boolean"] @@ -78,7 +78,7 @@ [string /.String #/.String "string"] ) -(exception: #export [a] (value-mismatch {reference JSON} {sample JSON}) +(exception: #export [a] (value_mismatch {reference JSON} {sample JSON}) (exception.report ["Reference" (/.format reference)] ["Sample" (/.format sample)])) @@ -94,7 +94,7 @@ (wrap (\ = test value)) _ - (//.fail (exception.construct ..unexpected-value [head]))))) + (//.fail (exception.construct ..unexpected_value [head]))))) (def: #export ( test) {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " "."))} @@ -105,10 +105,10 @@ ( value) (if (\ = test value) (wrap []) - (//.fail (exception.construct ..value-mismatch [( test) ( value)]))) + (//.fail (exception.construct ..value_mismatch [( test) ( value)]))) _ - (//.fail (exception.construct ..unexpected-value [head])))))] + (//.fail (exception.construct ..unexpected_value [head])))))] [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"] [number? number! /.Number frac.equivalence #/.Number "number"] @@ -127,7 +127,7 @@ [head ..any] (case head (#/.Array values) - (case (//.run parser (row.to-list values)) + (case (//.run parser (row.to_list values)) (#try.Failure error) (//.fail error) @@ -137,10 +137,10 @@ (wrap output) _ - (//.fail (exception.construct ..unconsumed-input remainder)))) + (//.fail (exception.construct ..unconsumed_input remainder)))) _ - (//.fail (exception.construct ..unexpected-value [head]))))) + (//.fail (exception.construct ..unexpected_value [head]))))) (def: #export (object parser) {#.doc "Parses a JSON object. Use this with the 'field' combinator."} @@ -164,24 +164,24 @@ (wrap output) _ - (//.fail (exception.construct ..unconsumed-input remainder)))) + (//.fail (exception.construct ..unconsumed_input remainder)))) _ - (//.fail (exception.construct ..unexpected-value [head]))))) + (//.fail (exception.construct ..unexpected_value [head]))))) -(def: #export (field field-name parser) +(def: #export (field field_name parser) {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} (All [a] (-> Text (Parser a) (Parser a))) (function (recur inputs) (case inputs (^ (list& (#/.String key) value inputs')) - (if (text\= key field-name) + (if (text\= key field_name) (case (//.run parser (list value)) (#try.Success [#.Nil output]) (#try.Success [inputs' output]) (#try.Success [inputs'' _]) - (exception.throw ..unconsumed-input inputs'') + (exception.throw ..unconsumed_input inputs'') (#try.Failure error) (#try.Failure error)) @@ -191,10 +191,10 @@ output]))) #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) _ - (exception.throw ..unconsumed-input inputs)))) + (exception.throw ..unconsumed_input inputs)))) (def: #export dictionary {#.doc "Parses a dictionary-like JSON object."} @@ -202,4 +202,4 @@ (|>> (//.and ..string) //.some ..object - (//\map (dictionary.from-list text.hash)))) + (//\map (dictionary.from_list text.hash)))) diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux index e5b0bda2a..ad376d059 100644 --- a/stdlib/source/lux/control/parser/synthesis.lux +++ b/stdlib/source/lux/control/parser/synthesis.lux @@ -30,24 +30,24 @@ Type (type (List Synthesis))) -(exception: #export (cannot-parse {input ..Input}) +(exception: #export (cannot_parse {input ..Input}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (unconsumed-input {input ..Input}) +(exception: #export (unconsumed_input {input ..Input}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (expected-empty-input {input ..Input}) +(exception: #export (expected_empty_input {input ..Input}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (wrong-arity {expected Arity} {actual Arity}) +(exception: #export (wrong_arity {expected Arity} {actual Arity}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) -(exception: #export empty-input) +(exception: #export empty_input) (type: #export Parser (//.Parser ..Input)) @@ -62,14 +62,14 @@ (#try.Success value) (#try.Success [unconsumed _]) - (exception.throw ..unconsumed-input unconsumed))) + (exception.throw ..unconsumed_input unconsumed))) (def: #export any (Parser Synthesis) (.function (_ input) (case input #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons [head tail]) (#try.Success [tail head])))) @@ -80,7 +80,7 @@ (.function (_ tokens) (case tokens #.Nil (#try.Success [tokens []]) - _ (exception.throw ..expected-empty-input [tokens])))) + _ (exception.throw ..expected_empty_input [tokens])))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -99,7 +99,7 @@ (#try.Success [input' x]) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) (def: #export ( expected) (-> (Parser Any)) @@ -108,10 +108,10 @@ (^ (list& ( actual) input')) (if (\ = expected actual) (#try.Success [input' []]) - (exception.throw ..cannot-parse input)) + (exception.throw ..cannot_parse input)) _ - (exception.throw ..cannot-parse input))))] + (exception.throw ..cannot_parse input))))] [bit bit! /.bit Bit bit.equivalence] [i64 i64! /.i64 (I64 Any) i64.equivalence] @@ -132,7 +132,7 @@ (#try.Success [tail output])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) (def: #export (function expected parser) (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) @@ -143,20 +143,20 @@ (do try.monad [output (..run parser (list body))] (#try.Success [tail [environment output]])) - (exception.throw ..wrong-arity [expected actual])) + (exception.throw ..wrong_arity [expected actual])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) -(def: #export (loop init-parsers iteration-parser) +(def: #export (loop init_parsers iteration_parser) (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b]))) (.function (_ input) (case input (^ (list& (/.loop/scope [start inits iteration]) tail)) (do try.monad - [inits (..run init-parsers inits) - iteration (..run iteration-parser (list iteration))] + [inits (..run init_parsers inits) + iteration (..run iteration_parser (list iteration))] (#try.Success [tail [start inits iteration]])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux index ebcf3c53a..919de78c4 100644 --- a/stdlib/source/lux/control/parser/text.lux +++ b/stdlib/source/lux/control/parser/text.lux @@ -19,7 +19,7 @@ (type: #export Offset Nat) -(def: start-offset Offset 0) +(def: start_offset Offset 0) (type: #export Parser (//.Parser [Offset Text])) @@ -32,37 +32,37 @@ (-> Offset Text Text) (|> tape (/.split offset) maybe.assume product.right)) -(exception: #export (unconsumed-input {offset Offset} {tape Text}) +(exception: #export (unconsumed_input {offset Offset} {tape Text}) (exception.report ["Offset" (n\encode offset)] ["Input size" (n\encode (/.size tape))] ["Remaining input" (remaining offset tape)])) -(exception: #export (expected-to-fail {offset Offset} {tape Text}) +(exception: #export (expected_to_fail {offset Offset} {tape Text}) (exception.report ["Offset" (n\encode offset)] ["Input" (remaining offset tape)])) -(exception: #export cannot-parse) -(exception: #export cannot-slice) +(exception: #export cannot_parse) +(exception: #export cannot_slice) (def: #export (run parser input) (All [a] (-> (Parser a) Text (Try a))) - (case (parser [start-offset input]) + (case (parser [start_offset input]) (#try.Failure msg) (#try.Failure msg) - (#try.Success [[end-offset _] output]) - (if (n.= end-offset (/.size input)) + (#try.Success [[end_offset _] output]) + (if (n.= end_offset (/.size input)) (#try.Success output) - (exception.throw ..unconsumed-input [end-offset input])))) + (exception.throw ..unconsumed_input [end_offset input])))) (def: #export offset (Parser Offset) (function (_ (^@ input [offset tape])) (#try.Success [input offset]))) -(def: (with-slices parser) +(def: (with_slices parser) (-> (Parser (List Slice)) (Parser Slice)) (do //.monad [offset ..offset @@ -80,10 +80,10 @@ (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (#try.Success [[("lux i64 +" 1 offset) tape] (/.from-code output)]) + (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)]) _ - (exception.throw ..cannot-parse [])))) + (exception.throw ..cannot_parse [])))) (def: #export any! {#.doc "Just returns the next character without applying any logic."} @@ -96,7 +96,7 @@ #distance 1}]) _ - (exception.throw ..cannot-slice [])))) + (exception.throw ..cannot_slice [])))) (template [ ] [(def: #export ( p) @@ -108,13 +108,13 @@ ( input) _ - (exception.throw ..expected-to-fail input))))] + (exception.throw ..expected_to_fail input))))] [not Text ..any] [not! Slice ..any!] ) -(exception: #export (cannot-match {reference Text}) +(exception: #export (cannot_match {reference Text}) (exception.report ["Reference" (/.encode reference)])) @@ -122,15 +122,15 @@ {#.doc "Lex a text if it matches the given sample."} (-> Text (Parser Any)) (function (_ [offset tape]) - (case (/.index-of' reference offset tape) + (case (/.index_of' reference offset tape) (#.Some where) (if (n.= offset where) (#try.Success [[("lux i64 +" (/.size reference) offset) tape] []]) - (exception.throw ..cannot-match [reference])) + (exception.throw ..cannot_match [reference])) _ - (exception.throw ..cannot-match [reference])))) + (exception.throw ..cannot_match [reference])))) (def: #export end! {#.doc "Ensure the parser's input is empty."} @@ -138,7 +138,7 @@ (function (_ (^@ input [offset tape])) (if (n.= offset (/.size tape)) (#try.Success [input []]) - (exception.throw ..unconsumed-input input)))) + (exception.throw ..unconsumed_input input)))) (def: #export peek {#.doc "Lex the next character (without consuming it from the input)."} @@ -146,12 +146,12 @@ (function (_ (^@ input [offset tape])) (case (/.nth offset tape) (#.Some output) - (#try.Success [input (/.from-code output)]) + (#try.Success [input (/.from_code output)]) _ - (exception.throw ..cannot-parse [])))) + (exception.throw ..cannot_parse [])))) -(def: #export get-input +(def: #export get_input {#.doc "Get all of the remaining input (without consuming it)."} (Parser Text) (function (_ (^@ input [offset tape])) @@ -163,7 +163,7 @@ (do //.monad [char any #let [char' (maybe.assume (/.nth 0 char))] - _ (//.assert ($_ /\compose "Character is not within range: " (/.from-code bottom) "-" (/.from-code top)) + _ (//.assert ($_ /\compose "Character is not within range: " (/.from_code bottom) "-" (/.from_code top)) (.and (n.>= bottom char') (n.<= top char')))] (wrap char))) @@ -185,7 +185,7 @@ (Parser Text) (//.either lower upper)) -(def: #export alpha-num +(def: #export alpha_num {#.doc "Only lex alphanumeric characters."} (Parser Text) (//.either alpha decimal)) @@ -202,39 +202,39 @@ [(exception: #export ( {options Text} {character Char}) (exception.report ["Options" (/.encode options)] - ["Character" (/.encode (/.from-code character))]))] + ["Character" (/.encode (/.from_code character))]))] - [character-should-be] - [character-should-not-be] + [character_should_be] + [character_should_not_be] ) -(template [ ] +(template [ ] [(def: #export ( options) - {#.doc (code.text ($_ /\compose "Only lex characters that are" " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Only lex characters that are" " part of a piece of text."))} (-> Text (Parser Text)) (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (let [output' (/.from-code output)] + (let [output' (/.from_code output)] (if ( (/.contains? output' options)) (#try.Success [[("lux i64 +" 1 offset) tape] output']) (exception.throw [options output]))) _ - (exception.throw ..cannot-parse []))))] + (exception.throw ..cannot_parse []))))] - [one-of |> ..character-should-be ""] - [none-of .not ..character-should-not-be " not"] + [one_of |> ..character_should_be ""] + [none_of .not ..character_should_not_be " not"] ) -(template [ ] +(template [ ] [(def: #export ( options) - {#.doc (code.text ($_ /\compose "Only lex characters that are" " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Only lex characters that are" " part of a piece of text."))} (-> Text (Parser Slice)) (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (let [output' (/.from-code output)] + (let [output' (/.from_code output)] (if ( (/.contains? output' options)) (#try.Success [[("lux i64 +" 1 offset) tape] {#basis offset @@ -242,15 +242,15 @@ (exception.throw [options output]))) _ - (exception.throw ..cannot-slice []))))] + (exception.throw ..cannot_slice []))))] - [one-of! |> ..character-should-be ""] - [none-of! .not ..character-should-not-be " not"] + [one_of! |> ..character_should_be ""] + [none_of! .not ..character_should_not_be " not"] ) -(exception: #export (character-does-not-satisfy-predicate {character Char}) +(exception: #export (character_does_not_satisfy_predicate {character Char}) (exception.report - ["Character" (/.encode (/.from-code character))])) + ["Character" (/.encode (/.from_code character))])) (def: #export (satisfies p) {#.doc "Only lex characters that satisfy a predicate."} @@ -259,11 +259,11 @@ (case (/.nth offset tape) (#.Some output) (if (p output) - (#try.Success [[("lux i64 +" 1 offset) tape] (/.from-code output)]) - (exception.throw ..character-does-not-satisfy-predicate [output])) + (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)]) + (exception.throw ..character_does_not_satisfy_predicate [output])) _ - (exception.throw ..cannot-parse [])))) + (exception.throw ..cannot_parse [])))) (def: #export space {#.doc "Only lex white-space."} @@ -284,9 +284,9 @@ [right::basis right::distance] right] (wrap [left::basis ("lux i64 +" left::distance right::distance)]))) -(template [ ] +(template [ ] [(def: #export ( parser) - {#.doc (code.text ($_ /\compose "Lex " " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Lex " " characters as a single continuous text."))} (-> (Parser Text) (Parser Text)) (|> parser (\ //.monad map /.concat)))] @@ -294,36 +294,36 @@ [many //.many "many"] ) -(template [ ] +(template [ ] [(def: #export ( parser) - {#.doc (code.text ($_ /\compose "Lex " " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Lex " " characters as a single continuous text."))} (-> (Parser Slice) (Parser Slice)) - (with-slices ( parser)))] + (with_slices ( parser)))] [some! //.some "some"] [many! //.many "many"] ) -(template [ ] +(template [ ] [(def: #export ( amount parser) - {#.doc (code.text ($_ /\compose "Lex " " N characters."))} + {#.doc (code.text ($_ /\compose "Lex " " N characters."))} (-> Nat (Parser Text) (Parser Text)) (|> parser ( amount) (\ //.monad map /.concat)))] [exactly //.exactly "exactly"] - [at-most //.at-most "at most"] - [at-least //.at-least "at least"] + [at_most //.at_most "at most"] + [at_least //.at_least "at least"] ) -(template [ ] +(template [ ] [(def: #export ( amount parser) - {#.doc (code.text ($_ /\compose "Lex " " N characters."))} + {#.doc (code.text ($_ /\compose "Lex " " N characters."))} (-> Nat (Parser Slice) (Parser Slice)) - (with-slices ( amount parser)))] + (with_slices ( amount parser)))] [exactly! //.exactly "exactly"] - [at-most! //.at-most "at most"] - [at-least! //.at-least "at least"] + [at_most! //.at_most "at most"] + [at_least! //.at_least "at least"] ) (def: #export (between from to parser) @@ -334,7 +334,7 @@ (def: #export (between! from to parser) {#.doc "Lex between N and M characters."} (-> Nat Nat (Parser Slice) (Parser Slice)) - (with-slices (//.between from to parser))) + (with_slices (//.between from to parser))) (def: #export (enclosed [start end] parser) (All [a] (-> [Text Text] (Parser a) (Parser a))) @@ -342,16 +342,16 @@ (//.before (this end)) (//.after (this start)))) -(def: #export (local local-input parser) +(def: #export (local local_input parser) {#.doc "Run a parser with the given input, instead of the real one."} (All [a] (-> Text (Parser a) (Parser a))) - (function (_ real-input) - (case (..run parser local-input) + (function (_ real_input) + (case (..run parser local_input) (#try.Failure error) (#try.Failure error) (#try.Success value) - (#try.Success [real-input value])))) + (#try.Success [real_input value])))) (def: #export (slice parser) (-> (Parser Slice) (Parser Text)) @@ -363,7 +363,7 @@ (#try.Success [input output]) #.None - (exception.throw ..cannot-slice []))))) + (exception.throw ..cannot_slice []))))) (def: #export (embed structured text) (All [s a] diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index 8ed5004fe..32329abbe 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -25,16 +25,16 @@ (exception.report ["Type" (%.type type)]))] - [not-existential] - [not-recursive] - [not-named] - [not-parameter] - [unknown-parameter] - [not-function] - [not-application] - [not-polymorphic] - [not-variant] - [not-tuple] + [not_existential] + [not_recursive] + [not_named] + [not_parameter] + [unknown_parameter] + [not_function] + [not_application] + [not_polymorphic] + [not_variant] + [not_tuple] ) (template [] @@ -43,17 +43,17 @@ ["Expected" (%.type expected)] ["Actual" (%.type actual)]))] - [types-do-not-match] - [wrong-parameter] + [types_do_not_match] + [wrong_parameter] ) -(exception: #export empty-input) +(exception: #export empty_input) -(exception: #export (unconsumed-input {remaining (List Type)}) +(exception: #export (unconsumed_input {remaining (List Type)}) (exception.report ["Types" (|> remaining - (list\map (|>> %.type (format text.new-line "* "))) - (text.join-with ""))])) + (list\map (|>> %.type (format text.new_line "* "))) + (text.join_with ""))])) (type: #export Env (Dictionary Nat [Type Code])) @@ -77,7 +77,7 @@ (#try.Success output) _ - (exception.throw ..unconsumed-input remaining)))) + (exception.throw ..unconsumed_input remaining)))) (def: #export (run poly type) (All [a] (-> (Parser a) Type (Try a))) @@ -88,7 +88,7 @@ (.function (_ [env inputs]) (#try.Success [[env inputs] env]))) -(def: (with-env temp poly) +(def: (with_env temp poly) (All [a] (-> Env (Parser a) (Parser a))) (.function (_ [env inputs]) (case (//.run poly [temp inputs]) @@ -103,7 +103,7 @@ (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons headT tail) (#try.Success [[env inputs] headT])))) @@ -113,32 +113,32 @@ (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons headT tail) (#try.Success [[env tail] headT])))) (def: #export (local types poly) (All [a] (-> (List Type) (Parser a) (Parser a))) - (.function (_ [env pass-through]) + (.function (_ [env pass_through]) (case (run' env poly types) (#try.Failure error) (#try.Failure error) (#try.Success output) - (#try.Success [[env pass-through] output])))) + (#try.Success [[env pass_through] output])))) (def: (label idx) (-> Nat Code) - (code.local-identifier ($_ text\compose "label" text.tab (n\encode idx)))) + (code.local_identifier ($_ text\compose "label" text.tab (n\encode idx)))) -(def: #export (with-extension type poly) +(def: #export (with_extension type poly) (All [a] (-> Type (Parser a) (Parser [Code a]))) (.function (_ [env inputs]) - (let [current-id (dictionary.size env) - g!var (label current-id)] + (let [current_id (dictionary.size env) + g!var (label current_id)] (case (//.run poly - [(dictionary.put current-id [type g!var] env) + [(dictionary.put current_id [type g!var] env) inputs]) (#try.Failure error) (#try.Failure error) @@ -151,78 +151,78 @@ (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT ..any] - (let [members ( (type.un-name headT))] + (let [members ( (type.un_name headT))] (if (n.> 1 (list.size members)) (local members poly) (//.fail (exception.construct headT))))))] - [variant type.flatten-variant #.Sum ..not-variant] - [tuple type.flatten-tuple #.Product ..not-tuple] + [variant type.flatten_variant #.Sum ..not_variant] + [tuple type.flatten_tuple #.Product ..not_tuple] ) (def: polymorphic' (Parser [Nat Type]) (do //.monad [headT any - #let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]] - (if (n.= 0 num-arg) - (//.fail (exception.construct ..not-polymorphic headT)) - (wrap [num-arg bodyT])))) + #let [[num_arg bodyT] (type.flatten_univ_q (type.un_name headT))]] + (if (n.= 0 num_arg) + (//.fail (exception.construct ..not_polymorphic headT)) + (wrap [num_arg bodyT])))) (def: #export (polymorphic poly) (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) (do {! //.monad} [headT any funcI (\ ! map dictionary.size ..env) - [num-args non-poly] (local (list headT) ..polymorphic') + [num_args non_poly] (local (list headT) ..polymorphic') env ..env #let [funcL (label funcI) - [all-varsL env'] (loop [current-arg 0 + [all_varsL env'] (loop [current_arg 0 env' env - all-varsL (: (List Code) (list))] - (if (n.< num-args current-arg) - (if (n.= 0 current-arg) + all_varsL (: (List Code) (list))] + (if (n.< num_args current_arg) + (if (n.= 0 current_arg) (let [varL (label (inc funcI))] - (recur (inc current-arg) + (recur (inc current_arg) (|> env' (dictionary.put funcI [headT funcL]) (dictionary.put (inc funcI) [(#.Parameter (inc funcI)) varL])) - (#.Cons varL all-varsL))) - (let [partialI (|> current-arg (n.* 2) (n.+ funcI)) - partial-varI (inc partialI) - partial-varL (label partial-varI) - partialC (` ((~ funcL) (~+ (|> (list.indices num-args) + (#.Cons varL all_varsL))) + (let [partialI (|> current_arg (n.* 2) (n.+ funcI)) + partial_varI (inc partialI) + partial_varL (label partial_varI) + partialC (` ((~ funcL) (~+ (|> (list.indices num_args) (list\map (|>> (n.* 2) inc (n.+ funcI) label)) list.reverse))))] - (recur (inc current-arg) + (recur (inc current_arg) (|> env' (dictionary.put partialI [.Nothing partialC]) - (dictionary.put partial-varI [(#.Parameter partial-varI) partial-varL])) - (#.Cons partial-varL all-varsL)))) - [all-varsL env']))]] - (<| (with-env env') - (local (list non-poly)) + (dictionary.put partial_varI [(#.Parameter partial_varI) partial_varL])) + (#.Cons partial_varL all_varsL)))) + [all_varsL env']))]] + (<| (with_env env') + (local (list non_poly)) (do ! [output poly] - (wrap [funcL all-varsL output]))))) + (wrap [funcL all_varsL output]))))) -(def: #export (function in-poly out-poly) +(def: #export (function in_poly out_poly) (All [i o] (-> (Parser i) (Parser o) (Parser [i o]))) (do //.monad [headT any - #let [[inputsT outputT] (type.flatten-function (type.un-name headT))]] + #let [[inputsT outputT] (type.flatten_function (type.un_name headT))]] (if (n.> 0 (list.size inputsT)) - (//.and (local inputsT in-poly) - (local (list outputT) out-poly)) - (//.fail (exception.construct ..not-function headT))))) + (//.and (local inputsT in_poly) + (local (list outputT) out_poly)) + (//.fail (exception.construct ..not_function headT))))) (def: #export (apply poly) (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT any - #let [[funcT paramsT] (type.flatten-application (type.un-name headT))]] + #let [[funcT paramsT] (type.flatten_application (type.un_name headT))]] (if (n.= 0 (list.size paramsT)) - (//.fail (exception.construct ..not-application headT)) + (//.fail (exception.construct ..not_application headT)) (..local (#.Cons funcT paramsT) poly)))) (template [ ] @@ -232,19 +232,19 @@ [actual any] (if ( expected actual) (wrap []) - (//.fail (exception.construct ..types-do-not-match [expected actual])))))] + (//.fail (exception.construct ..types_do_not_match [expected actual])))))] [exactly type\=] [sub check.checks?] [super (function.flip check.checks?)] ) -(def: #export (adjusted-idx env idx) +(def: #export (adjusted_idx env idx) (-> Env Nat Nat) - (let [env-level (n./ 2 (dictionary.size env)) - parameter-level (n./ 2 idx) - parameter-idx (n.% 2 idx)] - (|> env-level dec (n.- parameter-level) (n.* 2) (n.+ parameter-idx)))) + (let [env_level (n./ 2 (dictionary.size env)) + parameter_level (n./ 2 idx) + parameter_idx (n.% 2 idx)] + (|> env_level dec (n.- parameter_level) (n.* 2) (n.+ parameter_idx)))) (def: #export parameter (Parser Code) @@ -253,15 +253,15 @@ headT any] (case headT (#.Parameter idx) - (case (dictionary.get (adjusted-idx env idx) env) - (#.Some [poly-type poly-code]) - (wrap poly-code) + (case (dictionary.get (adjusted_idx env idx) env) + (#.Some [poly_type poly_code]) + (wrap poly_code) #.None - (//.fail (exception.construct ..unknown-parameter headT))) + (//.fail (exception.construct ..unknown_parameter headT))) _ - (//.fail (exception.construct ..not-parameter headT))))) + (//.fail (exception.construct ..not_parameter headT))))) (def: #export (parameter! id) (-> Nat (Parser Any)) @@ -270,23 +270,23 @@ headT any] (case headT (#.Parameter idx) - (if (n.= id (adjusted-idx env idx)) + (if (n.= id (adjusted_idx env idx)) (wrap []) - (//.fail (exception.construct ..wrong-parameter [(#.Parameter id) headT]))) + (//.fail (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) _ - (//.fail (exception.construct ..not-parameter headT))))) + (//.fail (exception.construct ..not_parameter headT))))) (def: #export existential (Parser Nat) (do //.monad [headT any] (case headT - (#.Ex ex-id) - (wrap ex-id) + (#.Ex ex_id) + (wrap ex_id) _ - (//.fail (exception.construct ..not-existential headT))))) + (//.fail (exception.construct ..not_existential headT))))) (def: #export named (Parser [Name Type]) @@ -297,7 +297,7 @@ (wrap [name anonymousT]) _ - (//.fail (exception.construct ..not-named inputT))))) + (//.fail (exception.construct ..not_named inputT))))) (template: (|nothing|) (#.Named ["lux" "Nothing"] @@ -308,33 +308,33 @@ (All [a] (-> (Parser a) (Parser [Code a]))) (do {! //.monad} [headT any] - (case (type.un-name headT) + (case (type.un_name headT) (^ (#.Apply (|nothing|) (#.UnivQ _ headT'))) (do ! [[recT _ output] (|> poly - (with-extension .Nothing) - (with-extension headT) + (with_extension .Nothing) + (with_extension headT) (local (list headT')))] (wrap [recT output])) _ - (//.fail (exception.construct ..not-recursive headT))))) + (//.fail (exception.construct ..not_recursive headT))))) -(def: #export recursive-self +(def: #export recursive_self (Parser Code) (do //.monad [env ..env headT any] - (case (type.un-name headT) - (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT-idx))) - (n.= 0 (adjusted-idx env funcT-idx)) - [(dictionary.get 0 env) (#.Some [self-type self-call])]) - (wrap self-call) + (case (type.un_name headT) + (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT_idx))) + (n.= 0 (adjusted_idx env funcT_idx)) + [(dictionary.get 0 env) (#.Some [self_type self_call])]) + (wrap self_call) _ - (//.fail (exception.construct ..not-recursive headT))))) + (//.fail (exception.construct ..not_recursive headT))))) -(def: #export recursive-call +(def: #export recursive_call (Parser Code) (do {! //.monad} [env ..env diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux index bc8c6ad93..3b9732ae5 100644 --- a/stdlib/source/lux/control/parser/xml.lux +++ b/stdlib/source/lux/control/parser/xml.lux @@ -19,20 +19,20 @@ (type: #export (Parser a) (//.Parser (List XML) a)) -(exception: #export empty-input) -(exception: #export unexpected-input) +(exception: #export empty_input) +(exception: #export unexpected_input) -(exception: #export (wrong-tag {expected Tag} {actual Tag}) +(exception: #export (wrong_tag {expected Tag} {actual Tag}) (exception.report ["Expected" (%.text (/.tag expected))] ["Actual" (%.text (/.tag actual))])) -(exception: #export (unknown-attribute {expected Attribute} {available (List Attribute)}) +(exception: #export (unknown_attribute {expected Attribute} {available (List Attribute)}) (exception.report ["Expected" (%.text (/.attribute expected))] ["Available" (exception.enumerate (|>> /.attribute %.text) available)])) -(exception: #export (unconsumed-inputs {inputs (List XML)}) +(exception: #export (unconsumed_inputs {inputs (List XML)}) (exception.report ["Inputs" (exception.enumerate (\ /.codec encode) inputs)])) @@ -41,7 +41,7 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (case head @@ -49,36 +49,36 @@ (#try.Success [tail value]) (#/.Node _) - (exception.throw ..unexpected-input []))))) + (exception.throw ..unexpected_input []))))) (def: #export (node expected) (-> Tag (Parser Any)) (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node actual _attributes _children) (if (name\= expected actual) (#try.Success [docs []]) - (exception.throw ..wrong-tag [expected actual])))))) + (exception.throw ..wrong_tag [expected actual])))))) (def: #export tag (Parser Tag) (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node tag _attributes _children) (#try.Success [docs tag]))))) @@ -88,17 +88,17 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node tag attributes children) (case (dictionary.get name attributes) #.None - (exception.throw ..unknown-attribute [name (dictionary.keys attributes)]) + (exception.throw ..unknown_attribute [name (dictionary.keys attributes)]) (#.Some value) (#try.Success [docs value])))))) @@ -109,7 +109,7 @@ (#try.Success [remaining output]) (if (list.empty? remaining) (#try.Success output) - (exception.throw ..unconsumed-inputs remaining)) + (exception.throw ..unconsumed_inputs remaining)) (#try.Failure error) (#try.Failure error))) @@ -119,12 +119,12 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node _tag _attributes children) (do try.monad @@ -136,7 +136,7 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (#try.Success [tail []])))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index bba7317a9..4c98b5f3f 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -13,7 +13,7 @@ ["i" int]] [collection ["." list ("#\." fold monad)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]]) @@ -57,7 +57,7 @@ (cond> [i.even?] [(i.* +2)] [i.odd?] [(i.* +3)] [(new> -1 [])])))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] (cond (~+ (do list.monad [[test then] branches] @@ -83,7 +83,7 @@ (|> +1 (loop> [(i.< +10)] [inc])))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (loop [(~ g!temp) (~ prev)] (if (|> (~ g!temp) (~+ test)) ((~' recur) (|> (~ g!temp) (~+ then))) @@ -99,16 +99,16 @@ [(i.* +3)] [(i.+ +4)] [inc])))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (case (list.reverse steps) - (^ (list& last-step prev-steps)) - (let [step-bindings (do list.monad - [step (list.reverse prev-steps)] + (^ (list& last_step prev_steps)) + (let [step_bindings (do list.monad + [step (list.reverse prev_steps)] (list g!temp (` (|> (~ g!temp) (~+ step)))))] (wrap (list (` ((~! do) (~ monad) [(~' #let) [(~ g!temp) (~ prev)] - (~+ step-bindings)] - (|> (~ g!temp) (~+ last-step))))))) + (~+ step_bindings)] + (|> (~ g!temp) (~+ last_step))))))) _ (wrap (list prev))))) @@ -120,7 +120,7 @@ (|> +5 (exec> [.nat %n log!]) (i.* +10)))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] (exec (|> (~ g!temp) (~+ body)) (~ g!temp)))))))) @@ -134,7 +134,7 @@ [dec (i./ +2)] [Int/encode])) "Will become: [+50 +2 '+5']")} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] [(~+ (list\map (function (_ body) (` (|> (~ g!temp) (~+ body)))) paths))])))))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 54f6c9fae..f707a748e 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -24,13 +24,13 @@ (def: separator Text - (format text.new-line - "-----------------------------------------" text.new-line - "-----------------------------------------" text.new-line - "-----------------------------------------" text.new-line - text.new-line)) + (format text.new_line + "-----------------------------------------" text.new_line + "-----------------------------------------" text.new_line + "-----------------------------------------" text.new_line + text.new_line)) -(exception: #export [a] (clean-up-error {error Text} +(exception: #export [a] (clean_up_error {error Text} {output (Try a)}) (format error (case output @@ -41,14 +41,14 @@ (format separator error|output)))) -(def: (combine-outcomes clean-up output) +(def: (combine_outcomes clean_up output) (All [a] (-> (Try Any) (Try a) (Try a))) - (case clean-up + (case clean_up (#try.Success _) output (#try.Failure error) - (exception.throw ..clean-up-error [error output]))) + (exception.throw ..clean_up_error [error output]))) (def: #export (run monad computation) (All [! a] @@ -58,7 +58,7 @@ [[cleaners output] (computation [[] (list)]) results (monad.map ! (function (_ cleaner) (cleaner [])) cleaners)] - (wrap (list\fold combine-outcomes output results)))) + (wrap (list\fold combine_outcomes output results)))) (def: #export (acquire monad cleaner value) (All [! a] (-> (Monad !) (-> a (! (Try Any))) a diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux index 8092fb6a2..aeda22262 100644 --- a/stdlib/source/lux/control/remember.lux +++ b/stdlib/source/lux/control/remember.lux @@ -19,7 +19,7 @@ ["." code] [syntax (#+ syntax:)]]]) -(exception: #export (must-remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)}) +(exception: #export (must_remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)}) (exception.report ["Deadline" (%.date deadline)] ["Today" (%.date today)] @@ -34,7 +34,7 @@ (def: deadline (Parser Date) ($_ <>.either - (<>\map (|>> instant.from-millis instant.date) + (<>\map (|>> instant.from_millis instant.date) .int) (do <>.monad [raw .text] @@ -55,7 +55,7 @@ #.None (list))) - (meta.fail (exception.construct ..must-remember [deadline today message focus]))))) + (meta.fail (exception.construct ..must_remember [deadline today message focus]))))) (template [ ] [(syntax: #export ( {deadline ..deadline} {message .text} {focus (<>.maybe .any)}) @@ -68,6 +68,6 @@ #.None (list))))))))] - [to-do "TODO"] - [fix-me "FIXME"] + [to_do "TODO"] + [fix_me "FIXME"] ) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 2a4e5427b..8d1ef44ad 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -46,18 +46,18 @@ (syntax: #export (capability: {export |export|.parser} {declaration reader.declaration} {annotations (<>.maybe reader.annotations)} - {[forge input output] (.form ($_ <>.and .local-identifier .any .any))}) + {[forge input output] (.form ($_ <>.and .local_identifier .any .any))}) (do {! meta.monad} - [this-module meta.current-module-name + [this_module meta.current_module_name #let [[name vars] declaration] g!brand (\ ! map (|>> %.code code.text) - (meta.gensym (format (%.name [this-module name])))) + (meta.gensym (format (%.name [this_module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (|export|.write export)) (~ (writer.declaration declaration)) (~ capability))) - (` (def: (~ (code.local-identifier forge)) - (All [(~+ (list\map code.local-identifier vars))] + (` (def: (~ (code.local_identifier forge)) + (All [(~+ (list\map code.local_identifier vars))] (-> (-> (~ input) (~ output)) (~ capability))) (~! ..forge))) diff --git a/stdlib/source/lux/control/security/policy.lux b/stdlib/source/lux/control/security/policy.lux index fac867520..56b8d6b11 100644 --- a/stdlib/source/lux/control/security/policy.lux +++ b/stdlib/source/lux/control/security/policy.lux @@ -12,23 +12,23 @@ (abstract: #export (Policy brand value label) value - (capability: #export (Can-Upgrade brand label value) + (capability: #export (Can_Upgrade brand label value) {#.doc (doc "Represents the capacity to 'upgrade' a value.")} - (can-upgrade value (Policy brand value label))) + (can_upgrade value (Policy brand value label))) - (capability: #export (Can-Downgrade brand label value) + (capability: #export (Can_Downgrade brand label value) {#.doc (doc "Represents the capacity to 'downgrade' a value.")} - (can-downgrade (Policy brand value label) value)) + (can_downgrade (Policy brand value label) value)) (type: #export (Privilege brand label) {#.doc (doc "Represents the privilege to both 'upgrade' and 'downgrade' a value.")} - {#can-upgrade (Can-Upgrade brand label) - #can-downgrade (Can-Downgrade brand label)}) + {#can_upgrade (Can_Upgrade brand label) + #can_downgrade (Can_Downgrade brand label)}) (def: privilege Privilege - {#can-upgrade (..can-upgrade (|>> :abstraction)) - #can-downgrade (..can-downgrade (|>> :representation))}) + {#can_upgrade (..can_upgrade (|>> :abstraction)) + #can_downgrade (..can_downgrade (|>> :representation))}) (type: #export (Delegation brand from to) {#.doc (doc "Represents the act of delegating policy capacities.")} @@ -39,7 +39,7 @@ (def: #export (delegation downgrade upgrade) {#.doc (doc "Delegating policy capacities.")} (All [brand from to] - (-> (Can-Downgrade brand from) (Can-Upgrade brand to) + (-> (Can_Downgrade brand from) (Can_Upgrade brand to) (Delegation brand from to))) (|>> (!.use downgrade) (!.use upgrade))) @@ -48,7 +48,7 @@ (-> (Privilege brand label) (scope label))) - (def: #export (with-policy context) + (def: #export (with_policy context) (All [brand scope] (Ex [label] (-> (Context brand scope label) @@ -85,10 +85,10 @@ Any (type: #export (Policy )) - (type: #export (Can-Upgrade )) - (type: #export (Can-Downgrade )) + (type: #export (Can_Upgrade )) + (type: #export (Can_Downgrade )) )] - [Privacy Private Can-Conceal Can-Reveal] - [Safety Safe Can-Trust Can-Distrust] + [Privacy Private Can_Conceal Can_Reveal] + [Safety Safe Can_Trust Can_Distrust] ) diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux index 94a01b0f7..3cc00bf0a 100644 --- a/stdlib/source/lux/control/try.lux +++ b/stdlib/source/lux/control/try.lux @@ -112,7 +112,7 @@ (#Failure message) (error! message))) -(def: #export (to-maybe try) +(def: #export (to_maybe try) (All [a] (-> (Try a) (Maybe a))) (case try (#Success value) @@ -121,14 +121,14 @@ (#Failure message) #.None)) -(def: #export (from-maybe maybe) +(def: #export (from_maybe maybe) (All [a] (-> (Maybe a) (Try a))) (case maybe (#.Some value) (#Success value) #.None - (#Failure (("lux in-module" "lux" .name\encode) (name-of ..from-maybe))))) + (#Failure (("lux in-module" "lux" .name\encode) (name_of ..from_maybe))))) (macro: #export (default tokens compiler) {#.doc (doc "Allows you to provide a default value that will be used" diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index 12c50328b..a9c2de090 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -20,7 +20,7 @@ [collection ["." array]]]]) -(exception: #export (index-out-of-bounds {size Nat} {index Nat}) +(exception: #export (index_out_of_bounds {size Nat} {index Nat}) (exception.report ["Size" (%.nat size)] ["Index" (%.nat index)])) @@ -32,11 +32,11 @@ ["From" (%.nat from)] ["To" (%.nat to)]))] - [slice-out-of-bounds] - [inverted-slice] + [slice_out_of_bounds] + [inverted_slice] ) -(with-expansions [ (as-is (type: #export Binary (host.type [byte])) +(with_expansions [ (as_is (type: #export Binary (host.type [byte])) (host.import: java/lang/Object) @@ -49,29 +49,29 @@ (#static copyOfRange [[byte] int int] [byte]) (#static equals [[byte] [byte]] boolean)]) - (def: byte-mask + (def: byte_mask I64 - (|> i64.bits-per-byte i64.mask .i64)) + (|> i64.bits_per_byte i64.mask .i64)) (def: i64 (-> (primitive "java.lang.Byte") I64) - (|>> host.byte-to-long (:coerce I64) (i64.and ..byte-mask))) + (|>> host.byte_to_long (:coerce I64) (i64.and ..byte_mask))) (def: byte (-> (I64 Any) (primitive "java.lang.Byte")) (for {@.old - (|>> .int host.long-to-byte) + (|>> .int host.long_to_byte) @.jvm - (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)})))] + (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))] (for {@.old - (as-is ) + (as_is ) @.jvm - (as-is ) + (as_is ) @.js - (as-is (host.import: ArrayBuffer + (as_is (host.import: ArrayBuffer (new [host.Number])) (host.import: Uint8Array @@ -83,20 +83,20 @@ (template: (!size binary) (for {@.old - (host.array-length binary) + (host.array_length binary) @.jvm - (host.array-length binary) + (host.array_length binary) @.js (f.nat (Uint8Array::length binary))})) (template: (!read idx binary) (for {@.old - (..i64 (host.array-read idx binary)) + (..i64 (host.array_read idx binary)) @.jvm - (..i64 (host.array-read idx binary)) + (..i64 (host.array_read idx binary)) @.js (|> binary @@ -108,10 +108,10 @@ (template: (!write idx value binary) (for {@.old - (host.array-write idx (..byte value) binary) + (host.array_write idx (..byte value) binary) @.jvm - (host.array-write idx (..byte value) binary) + (host.array_write idx (..byte value) binary) @.js (|> binary @@ -148,39 +148,39 @@ (-> Nat Binary (Try I64)) (if (n.< (..!size binary) idx) (#try.Success (!read idx binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/16 idx binary) (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 1 idx)) (#try.Success ($_ i64.or - (i64.left-shift 8 (!read idx binary)) + (i64.left_shift 8 (!read idx binary)) (!read (n.+ 1 idx) binary))) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/32 idx binary) (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 3 idx)) (#try.Success ($_ i64.or - (i64.left-shift 24 (!read idx binary)) - (i64.left-shift 16 (!read (n.+ 1 idx) binary)) - (i64.left-shift 8 (!read (n.+ 2 idx) binary)) + (i64.left_shift 24 (!read idx binary)) + (i64.left_shift 16 (!read (n.+ 1 idx) binary)) + (i64.left_shift 8 (!read (n.+ 2 idx) binary)) (!read (n.+ 3 idx) binary))) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/64 idx binary) (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 7 idx)) (#try.Success ($_ i64.or - (i64.left-shift 56 (!read idx binary)) - (i64.left-shift 48 (!read (n.+ 1 idx) binary)) - (i64.left-shift 40 (!read (n.+ 2 idx) binary)) - (i64.left-shift 32 (!read (n.+ 3 idx) binary)) - (i64.left-shift 24 (!read (n.+ 4 idx) binary)) - (i64.left-shift 16 (!read (n.+ 5 idx) binary)) - (i64.left-shift 8 (!read (n.+ 6 idx) binary)) + (i64.left_shift 56 (!read idx binary)) + (i64.left_shift 48 (!read (n.+ 1 idx) binary)) + (i64.left_shift 40 (!read (n.+ 2 idx) binary)) + (i64.left_shift 32 (!read (n.+ 3 idx) binary)) + (i64.left_shift 24 (!read (n.+ 4 idx) binary)) + (i64.left_shift 16 (!read (n.+ 5 idx) binary)) + (i64.left_shift 8 (!read (n.+ 6 idx) binary)) (!read (n.+ 7 idx) binary))) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/8 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) @@ -188,42 +188,42 @@ (exec (|> binary (!write idx value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/16 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 1 idx)) (exec (|> binary - (!write idx (i64.logic-right-shift 8 value)) + (!write idx (i64.logic_right_shift 8 value)) (!write (n.+ 1 idx) value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/32 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 3 idx)) (exec (|> binary - (!write idx (i64.logic-right-shift 24 value)) - (!write (n.+ 1 idx) (i64.logic-right-shift 16 value)) - (!write (n.+ 2 idx) (i64.logic-right-shift 8 value)) + (!write idx (i64.logic_right_shift 24 value)) + (!write (n.+ 1 idx) (i64.logic_right_shift 16 value)) + (!write (n.+ 2 idx) (i64.logic_right_shift 8 value)) (!write (n.+ 3 idx) value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/64 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 7 idx)) (exec (|> binary - (!write idx (i64.logic-right-shift 56 value)) - (!write (n.+ 1 idx) (i64.logic-right-shift 48 value)) - (!write (n.+ 2 idx) (i64.logic-right-shift 40 value)) - (!write (n.+ 3 idx) (i64.logic-right-shift 32 value)) - (!write (n.+ 4 idx) (i64.logic-right-shift 24 value)) - (!write (n.+ 5 idx) (i64.logic-right-shift 16 value)) - (!write (n.+ 6 idx) (i64.logic-right-shift 8 value)) + (!write idx (i64.logic_right_shift 56 value)) + (!write (n.+ 1 idx) (i64.logic_right_shift 48 value)) + (!write (n.+ 2 idx) (i64.logic_right_shift 40 value)) + (!write (n.+ 3 idx) (i64.logic_right_shift 32 value)) + (!write (n.+ 4 idx) (i64.logic_right_shift 24 value)) + (!write (n.+ 5 idx) (i64.logic_right_shift 16 value)) + (!write (n.+ 6 idx) (i64.logic_right_shift 8 value)) (!write (n.+ 7 idx) value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (structure: #export equivalence (Equivalence Binary) @@ -245,43 +245,43 @@ true))))))) (for {@.old - (as-is) + (as_is) @.jvm - (as-is)} + (as_is)} ## Default - (exception: #export (cannot-copy-bytes {bytes Nat} - {source-input Nat} - {target-output Nat}) + (exception: #export (cannot_copy_bytes {bytes Nat} + {source_input Nat} + {target_output Nat}) (exception.report ["Bytes" (%.nat bytes)] - ["Source input space" (%.nat source-input)] - ["Target output space" (%.nat target-output)]))) + ["Source input space" (%.nat source_input)] + ["Target output space" (%.nat target_output)]))) -(def: #export (copy bytes source-offset source target-offset target) +(def: #export (copy bytes source_offset source target_offset target) (-> Nat Nat Binary Nat Binary (Try Binary)) - (with-expansions [ (as-is (do try.monad - [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] + (with_expansions [ (as_is (do try.monad + [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] (wrap target)))] (for {@.old - + @.jvm - } + } ## Default - (let [source-input (n.- source-offset (!size source)) - target-output (n.- target-offset (!size target))] - (if (n.<= source-input bytes) + (let [source_input (n.- source_offset (!size source)) + target_output (n.- target_offset (!size target))] + (if (n.<= source_input bytes) (loop [idx 0] (if (n.< bytes idx) - (exec (!write (n.+ target-offset idx) - (!read (n.+ source-offset idx) source) + (exec (!write (n.+ target_offset idx) + (!read (n.+ source_offset idx) source) target) (recur (inc idx))) (#try.Success target))) - (exception.throw ..cannot-copy-bytes [bytes source-input target-output])))))) + (exception.throw ..cannot_copy_bytes [bytes source_input target_output])))))) (def: #export (slice from to binary) (-> Nat Nat Binary (Try Binary)) @@ -289,18 +289,18 @@ (if (n.<= to from) (if (and (n.< size from) (n.< size to)) - (with-expansions [ (as-is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] + (with_expansions [ (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] (for {@.old - + @.jvm - } + } ## Default - (let [how-many (n.- from to)] - (..copy how-many from binary 0 (..create how-many))))) - (exception.throw ..slice-out-of-bounds [size from to])) - (exception.throw ..inverted-slice [size from to])))) + (let [how_many (n._ from to)] + (..copy how_many from binary 0 (..create how_many))))) + (exception.throw ..slice_out_of_bounds [size from to])) + (exception.throw ..inverted_slice [size from to])))) (def: #export (drop from binary) (-> Nat Binary Binary) diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index 630b8351f..705654ca0 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -15,22 +15,22 @@ [collection ["." list ("#\." fold)]]]]) -(def: #export type-name "#Array") +(def: #export type_name "#Array") (type: #export (Array a) {#.doc "Mutable arrays."} - (#.Primitive ..type-name (#.Cons a #.Nil))) + (#.Primitive ..type_name (#.Cons a #.Nil))) -(with-expansions [ (primitive "java.lang.Long") - (primitive "java.lang.Object") - (type (Array ))] +(with_expansions [ (primitive "java.lang.Long") + (primitive "java.lang.Object") + (type (Array ))] (for {@.jvm (template: (!int value) (|> value - (:coerce ) + (:coerce ) "jvm object cast" "jvm conversion long-to-int"))} - (as-is)) + (as_is)) (def: #export (new size) (All [a] (-> Nat (Array a))) @@ -41,7 +41,7 @@ (|> size !int "jvm array new object" - (: ) + (: ) :assume) @.js @@ -54,11 +54,11 @@ @.jvm (|> array - (:coerce ) + (:coerce ) "jvm array length object" "jvm conversion int-to-long" "jvm object cast" - (: ) + (: ) (:coerce Nat)) @.js @@ -76,7 +76,7 @@ @.jvm (let [value (|> array - (:coerce ) + (:coerce ) ("jvm array read object" (!int index)))] (if ("jvm object null?" value) #.None @@ -97,8 +97,8 @@ @.jvm (|> array - (:coerce ) - ("jvm array write object" (!int index) (:coerce value)) + (:coerce ) + ("jvm array write object" (!int index) (:coerce value)) :assume) @.js @@ -112,7 +112,7 @@ (write! index (:assume ("jvm object null")) array) @.jvm - (write! index (:assume (: ("jvm object null"))) array) + (write! index (:assume (: ("jvm object null"))) array) @.js ("js array delete" index array)}) @@ -146,20 +146,20 @@ (|> array (read index) (maybe.default default) transform) array)) -(def: #export (copy! length src-start src-array dest-start dest-array) +(def: #export (copy! length src_start src_array dest_start dest_array) (All [a] (-> Nat Nat (Array a) Nat (Array a) (Array a))) (if (n.= 0 length) - dest-array + dest_array (list\fold (function (_ offset target) - (case (read (n.+ offset src-start) src-array) + (case (read (n.+ offset src_start) src_array) #.None target (#.Some value) - (write! (n.+ offset dest-start) value target))) - dest-array + (write! (n.+ offset dest_start) value target))) + dest_array (list.indices length)))) (def: #export (occupancy array) @@ -198,9 +198,9 @@ (def: #export (find p xs) (All [a] (-> (Predicate a) (Array a) (Maybe a))) - (let [arr-size (size xs)] + (let [arr_size (size xs)] (loop [idx 0] - (if (n.< arr-size idx) + (if (n.< arr_size idx) (case (read idx xs) #.None (recur (inc idx)) @@ -215,9 +215,9 @@ {#.doc "Just like 'find', but with access to the index of each value."} (All [a] (-> (-> Nat a Bit) (Array a) (Maybe [Nat a]))) - (let [arr-size (size xs)] + (let [arr_size (size xs)] (loop [idx 0] - (if (n.< arr-size idx) + (if (n.< arr_size idx) (case (read idx xs) #.None (recur (inc idx)) @@ -230,7 +230,7 @@ (def: #export (clone xs) (All [a] (-> (Array a) (Array a))) - (let [arr-size (size xs)] + (let [arr_size (size xs)] (list\fold (function (_ idx ys) (case (read idx xs) #.None @@ -238,10 +238,10 @@ (#.Some x) (write! idx x ys))) - (new arr-size) - (list.indices arr-size)))) + (new arr_size) + (list.indices arr_size)))) -(def: #export (from-list xs) +(def: #export (from_list xs) (All [a] (-> (List a) (Array a))) (product.right (list\fold (function (_ x [idx arr]) [(inc idx) (write! idx x arr)]) @@ -250,7 +250,7 @@ (def: underflow Nat (dec 0)) -(def: #export (to-list array) +(def: #export (to_list array) (All [a] (-> (Array a) (List a))) (loop [idx (dec (size array)) output #.Nil] @@ -264,7 +264,7 @@ #.None output))))) -(def: #export (to-list' default array) +(def: #export (to_list' default array) (All [a] (-> a (Array a) (List a))) (loop [idx (dec (size array)) output #.Nil] @@ -311,9 +311,9 @@ (Functor Array) (def: (map f ma) - (let [arr-size (size ma)] - (if (n.= 0 arr-size) - (new arr-size) + (let [arr_size (size ma)] + (if (n.= 0 arr_size) + (new arr_size) (list\fold (function (_ idx mb) (case (read idx ma) #.None @@ -321,25 +321,25 @@ (#.Some x) (write! idx (f x) mb))) - (new arr-size) - (list.indices arr-size)) + (new arr_size) + (list.indices arr_size)) )))) (structure: #export fold (Fold Array) (def: (fold f init xs) - (let [arr-size (size xs)] - (loop [so-far init + (let [arr_size (size xs)] + (loop [so_far init idx 0] - (if (n.< arr-size idx) + (if (n.< arr_size idx) (case (read idx xs) #.None - (recur so-far (inc idx)) + (recur so_far (inc idx)) (#.Some value) - (recur (f value so-far) (inc idx))) - so-far))))) + (recur (f value so_far) (inc idx))) + so_far))))) (template [ ] [(def: #export ( predicate array) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index 8ca61b453..46f299e31 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -39,7 +39,7 @@ Nat) ## A hash-code derived from a key during tree-traversal. -(type: Hash-Code +(type: Hash_Code Nat) ## Represents the nesting level of a leaf or node, when looking-it-up @@ -47,8 +47,8 @@ ## Changes in levels are done by right-shifting the hashes of keys by ## the appropriate multiple of the branching-exponent. ## A shift of 0 means root level. -## A shift of (* branching-exponent 1) means level 2. -## A shift of (* branching-exponent N) means level N+1. +## A shift of (* branching_exponent 1) means level 2. +## A shift of (* branching_exponent N) means level N+1. (type: Level Nat) @@ -59,7 +59,7 @@ (#Base BitMap (Array (Either (Node k v) [k v]))) - (#Collisions Hash-Code (Array [k v]))) + (#Collisions Hash_Code (Array [k v]))) ## #Hierarchy nodes are meant to point down only to lower-level nodes. (type: (Hierarchy k v) @@ -81,7 +81,7 @@ ## Which is the same as 0000 0000 0000 0000 0000 0000 0000 0000. ## Or 0x00000000. ## Which is 32 zeroes, since the branching factor is 32. -(def: clean-bitmap +(def: clean_bitmap BitMap 0) @@ -94,47 +94,47 @@ ## factor). ## The initial shifting level, though, is 0 (which corresponds to the ## shift in the shallowest node on the tree, which is the root node). -(def: root-level +(def: root_level Level 0) ## The exponent to which 2 must be elevated, to reach the branching ## factor of the data-structure. -(def: branching-exponent +(def: branching_exponent Nat 5) ## The threshold on which #Hierarchy nodes are demoted to #Base nodes, ## which is 1/4 of the branching factor (or a left-shift 2). -(def: demotion-threshold +(def: demotion_threshold Nat - (i64.left-shift (n.- 2 branching-exponent) 1)) + (i64.left_shift (n.- 2 branching_exponent) 1)) ## The threshold on which #Base nodes are promoted to #Hierarchy nodes, ## which is 1/2 of the branching factor (or a left-shift 1). -(def: promotion-threshold +(def: promotion_threshold Nat - (i64.left-shift (n.- 1 branching-exponent) 1)) + (i64.left_shift (n.- 1 branching_exponent) 1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). -(def: hierarchy-nodes-size +(def: hierarchy_nodes_size Nat - (i64.left-shift branching-exponent 1)) + (i64.left_shift branching_exponent 1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty Node - (#Base clean-bitmap (array.new 0))) + (#Base clean_bitmap (array.new 0))) ## Expands a copy of the array, to have 1 extra slot, which is used ## for storing the value. -(def: (insert! idx value old-array) +(def: (insert! idx value old_array) (All [a] (-> Index a (Array a) (Array a))) - (let [old-size (array.size old-array)] - (|> (array.new (inc old-size)) - (array.copy! idx 0 old-array 0) + (let [old_size (array.size old_array)] + (|> (array.new (inc old_size)) + (array.copy! idx 0 old_array 0) (array.write! idx value) - (array.copy! (n.- idx old-size) idx old-array (inc idx))))) + (array.copy! (n.- idx old_size) idx old_array (inc idx))))) ## Creates a copy of an array with an index set to a particular value. (def: (update! idx value array) @@ -149,74 +149,74 @@ ## Shrinks a copy of the array by removing the space at index. (def: (remove! idx array) (All [a] (-> Index (Array a) (Array a))) - (let [new-size (dec (array.size array))] - (|> (array.new new-size) + (let [new_size (dec (array.size array))] + (|> (array.new new_size) (array.copy! idx 0 array 0) - (array.copy! (n.- idx new-size) (inc idx) array idx)))) + (array.copy! (n.- idx new_size) (inc idx) array idx)))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. -(def: level-up +(def: level_up (-> Level Level) - (n.+ branching-exponent)) + (n.+ branching_exponent)) -(def: hierarchy-mask BitMap (dec hierarchy-nodes-size)) +(def: hierarchy_mask BitMap (dec hierarchy_nodes_size)) ## Gets the branching-factor sized section of the hash corresponding ## to a particular level, and uses that as an index into the array. -(def: (level-index level hash) - (-> Level Hash-Code Index) - (i64.and hierarchy-mask - (i64.logic-right-shift level hash))) +(def: (level_index level hash) + (-> Level Hash_Code Index) + (i64.and hierarchy_mask + (i64.logic_right_shift level hash))) ## A mechanism to go from indices to bit-positions. -(def: (->bit-position index) +(def: (->bit_position index) (-> Index BitPosition) - (i64.left-shift index 1)) + (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))) +(def: (bit_position level hash) + (-> Level Hash_Code BitPosition) + (->bit_position (level_index level hash))) -(def: (bit-position-is-set? bit bitmap) +(def: (bit_position_is_set? bit bitmap) (-> BitPosition BitMap Bit) - (not (n.= clean-bitmap (i64.and bit bitmap)))) + (not (n.= clean_bitmap (i64.and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. -(def: only-bit-position? +(def: only_bit_position? (-> BitPosition BitMap Bit) n.=) -(def: (set-bit-position bit bitmap) +(def: (set_bit_position bit bitmap) (-> BitPosition BitMap BitMap) (i64.or bit bitmap)) -(def: unset-bit-position +(def: unset_bit_position (-> BitPosition BitMap BitMap) i64.xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. -(def: bitmap-size +(def: bitmap_size (-> BitMap Nat) i64.count) ## A mask that, for a given bit position, only allows all the 1s prior ## to it, which would indicate the bitmap-size (and, thus, index) ## associated with it. -(def: bit-position-mask +(def: bit_position_mask (-> BitPosition BitMap) dec) ## The index on the base array, based on it's bit-position. -(def: (base-index bit-position bitmap) +(def: (base_index bit_position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (i64.and (bit-position-mask bit-position) + (bitmap_size (i64.and (bit_position_mask bit_position) bitmap))) ## Produces the index of a KV-pair within a #Collisions node. -(def: (collision-index Hash key colls) +(def: (collision_index Hash key colls) (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index))) (\ maybe.monad map product.left (array.find+ (function (_ idx [key' val']) @@ -225,51 +225,51 @@ ## When #Hierarchy nodes grow too small, they're demoted to #Base ## nodes to save space. -(def: (demote-hierarchy except-idx [h-size h-array]) +(def: (demote_hierarchy except_idx [h_size h_array]) (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)])) - (product.right (list\fold (function (_ idx [insertion-idx node]) + (product.right (list\fold (function (_ idx [insertion_idx node]) (let [[bitmap base] node] - (case (array.read idx h-array) - #.None [insertion-idx node] - (#.Some sub-node) (if (n.= except-idx idx) - [insertion-idx node] - [(inc insertion-idx) - [(set-bit-position (->bit-position idx) bitmap) - (array.write! insertion-idx (#.Left sub-node) base)]]) + (case (array.read idx h_array) + #.None [insertion_idx node] + (#.Some sub_node) (if (n.= except_idx idx) + [insertion_idx node] + [(inc insertion_idx) + [(set_bit_position (->bit_position idx) bitmap) + (array.write! insertion_idx (#.Left sub_node) base)]]) ))) - [0 [clean-bitmap - (array.new (dec h-size))]] - (list.indices (array.size h-array))))) + [0 [clean_bitmap + (array.new (dec h_size))]] + (list.indices (array.size h_array))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to ## add some depth to the tree and help keep it's balance. -(def: hierarchy-indices (List Index) (list.indices hierarchy-nodes-size)) +(def: hierarchy_indices (List Index) (list.indices hierarchy_nodes_size)) -(def: (promote-base put' Hash level bitmap base) +(def: (promote_base put' Hash level bitmap base) (All [k v] - (-> (-> Level Hash-Code k v (Hash k) (Node k v) (Node k v)) + (-> (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v)) (Hash k) Level 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) + (product.right (list\fold (function (_ hierarchy_idx (^@ default [base_idx h_array])) + (if (bit_position_is_set? (->bit_position hierarchy_idx) bitmap) - [(inc base-idx) - (case (array.read base-idx base) - (#.Some (#.Left sub-node)) - (array.write! hierarchy-idx sub-node h-array) + [(inc base_idx) + (case (array.read base_idx base) + (#.Some (#.Left sub_node)) + (array.write! hierarchy_idx sub_node h_array) (#.Some (#.Right [key' val'])) - (array.write! hierarchy-idx - (put' (level-up level) (\ Hash hash key') key' val' Hash empty) - h-array) + (array.write! hierarchy_idx + (put' (level_up level) (\ Hash hash key') key' val' Hash empty) + h_array) #.None (undefined))] default)) [0 - (array.new hierarchy-nodes-size)] - hierarchy-indices))) + (array.new hierarchy_nodes_size)] + hierarchy_indices))) ## All empty nodes look the same (a #Base node with clean bitmap is ## used). @@ -277,44 +277,44 @@ (def: (empty?' node) (All [k v] (-> (Node k v) Bit)) (`` (case node - (#Base (~~ (static ..clean-bitmap)) _) + (#Base (~~ (static ..clean_bitmap)) _) #1 _ #0))) (def: (put' level hash key val Hash node) - (All [k v] (-> Level Hash-Code k v (Hash k) (Node k v) (Node k v))) + (All [k v] (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v))) (case node ## For #Hierarchy nodes, I check whether I can add the element to ## a sub-node. If impossible, I introduced a new singleton sub-node. (#Hierarchy _size hierarchy) - (let [idx (level-index level hash) - [_size' sub-node] (case (array.read idx hierarchy) - (#.Some sub-node) - [_size sub-node] + (let [idx (level_index level hash) + [_size' sub_node] (case (array.read idx hierarchy) + (#.Some sub_node) + [_size sub_node] _ [(inc _size) empty])] (#Hierarchy _size' - (update! idx (put' (level-up level) hash key val Hash sub-node) + (update! idx (put' (level_up level) hash key val Hash sub_node) hierarchy))) ## For #Base nodes, I check if the corresponding BitPosition has ## already been used. (#Base bitmap base) - (let [bit (bit-position level hash)] - (if (bit-position-is-set? bit bitmap) + (let [bit (bit_position level hash)] + (if (bit_position_is_set? bit bitmap) ## If so... - (let [idx (base-index bit bitmap)] + (let [idx (base_index bit bitmap)] (case (array.read idx base) #.None (undefined) ## If it's being used by a node, I add the KV to it. - (#.Some (#.Left sub-node)) - (let [sub-node' (put' (level-up level) hash key val Hash sub-node)] - (#Base bitmap (update! idx (#.Left sub-node') base))) + (#.Some (#.Left sub_node)) + (let [sub_node' (put' (level_up level) hash key val Hash sub_node)] + (#Base bitmap (update! idx (#.Left sub_node') base))) ## Otherwise, if it's being used by a KV, I compare the keys. (#.Some (#.Right key' val')) @@ -337,117 +337,117 @@ ## #Base nodes, so I ## add both KV-pairs ## to the empty one. - (let [next-level (level-up level)] + (let [next_level (level_up level)] (|> empty - (put' next-level hash' key' val' Hash) - (put' next-level hash key val Hash)))))) + (put' next_level hash' key' val' Hash) + (put' next_level hash key val Hash)))))) base))))) ## However, if the BitPosition has not been used yet, I check ## whether this #Base node is ready for a promotion. - (let [base-count (bitmap-size bitmap)] - (if (n.>= ..promotion-threshold base-count) + (let [base_count (bitmap_size bitmap)] + (if (n.>= ..promotion_threshold base_count) ## If so, I promote it to a #Hierarchy node, and add the new ## KV-pair as a singleton node to it. - (#Hierarchy (inc base-count) - (|> (promote-base put' Hash level bitmap base) - (array.write! (level-index level hash) - (put' (level-up level) hash key val Hash empty)))) + (#Hierarchy (inc base_count) + (|> (promote_base put' Hash level bitmap base) + (array.write! (level_index level hash) + (put' (level_up level) hash key val Hash empty)))) ## Otherwise, I just resize the #Base node to accommodate the ## new KV-pair. - (#Base (set-bit-position bit bitmap) - (insert! (base-index bit bitmap) (#.Right [key val]) base)))))) + (#Base (set_bit_position bit bitmap) + (insert! (base_index bit bitmap) (#.Right [key val]) base)))))) ## For #Collisions nodes, I compare the hashes. (#Collisions _hash _colls) (if (n.= hash _hash) ## If they're equal, that means the new KV contributes to the ## collisions. - (case (collision-index Hash key _colls) + (case (collision_index Hash key _colls) ## If the key was already present in the collisions-list, it's ## value gets updated. - (#.Some coll-idx) - (#Collisions _hash (update! coll-idx [key val] _colls)) + (#.Some coll_idx) + (#Collisions _hash (update! coll_idx [key val] _colls)) ## Otherwise, the KV-pair is added to the collisions-list. #.None (#Collisions _hash (insert! (array.size _colls) [key val] _colls))) ## If the hashes are not equal, I create a new #Base node that ## contains the old #Collisions node, plus the new KV-pair. - (|> (#Base (bit-position level _hash) + (|> (#Base (bit_position level _hash) (|> (array.new 1) (array.write! 0 (#.Left node)))) (put' level hash key val Hash))) )) (def: (remove' level hash key Hash node) - (All [k v] (-> Level Hash-Code k (Hash k) (Node k v) (Node k v))) + (All [k v] (-> Level Hash_Code k (Hash k) (Node k v) (Node k v))) (case node ## For #Hierarchy nodes, find out if there's a valid sub-node for ## the Hash-Code. - (#Hierarchy h-size h-array) - (let [idx (level-index level hash)] - (case (array.read idx h-array) + (#Hierarchy h_size h_array) + (let [idx (level_index level hash)] + (case (array.read idx h_array) ## If not, there's nothing to remove. #.None node ## But if there is, try to remove the key from the sub-node. - (#.Some sub-node) - (let [sub-node' (remove' (level-up level) hash key Hash sub-node)] + (#.Some sub_node) + (let [sub_node' (remove' (level_up level) hash key Hash sub_node)] ## Then check if a removal was actually done. - (if (is? sub-node sub-node') + (if (is? sub_node sub_node') ## If not, then there's nothing to change here either. node - ## But if the sub-removal yielded an empty sub-node... - (if (empty?' sub-node') + ## But if the sub_removal yielded an empty sub_node... + (if (empty?' sub_node') ## Check if it's due time for a demotion. - (if (n.<= demotion-threshold h-size) + (if (n.<= demotion_threshold h_size) ## If so, perform it. - (#Base (demote-hierarchy idx [h-size h-array])) + (#Base (demote_hierarchy idx [h_size h_array])) ## Otherwise, just clear the space. - (#Hierarchy (dec h-size) (vacant! idx h-array))) - ## But if the sub-removal yielded a non-empty node, then + (#Hierarchy (dec h_size) (vacant! idx h_array))) + ## But if the sub_removal yielded a non_empty node, then ## just update the hiearchy branch. - (#Hierarchy h-size (update! idx sub-node' h-array))))))) + (#Hierarchy h_size (update! idx sub_node' h_array))))))) ## For #Base nodes, check whether the BitPosition is set. (#Base bitmap base) - (let [bit (bit-position level hash)] - (if (bit-position-is-set? bit bitmap) - (let [idx (base-index bit bitmap)] + (let [bit (bit_position level hash)] + (if (bit_position_is_set? bit bitmap) + (let [idx (base_index bit bitmap)] (case (array.read idx base) #.None (undefined) - ## If set, check if it's a sub-node, and remove the KV + ## If set, check if it's a sub_node, and remove the KV ## from it. - (#.Some (#.Left sub-node)) - (let [sub-node' (remove' (level-up level) hash key Hash sub-node)] + (#.Some (#.Left sub_node)) + (let [sub_node' (remove' (level_up level) hash key Hash sub_node)] ## Verify that it was removed. - (if (is? sub-node sub-node') + (if (is? sub_node sub_node') ## If not, there's also nothing to change here. node ## But if it came out empty... - (if (empty?' sub-node') + (if (empty?' sub_node') ### ... figure out whether that's the only position left. - (if (only-bit-position? bit bitmap) + (if (only_bit_position? bit bitmap) ## If so, removing it leaves this node empty too. empty ## But if not, then just unset the position and ## remove the node. - (#Base (unset-bit-position bit bitmap) + (#Base (unset_bit_position bit bitmap) (remove! idx base))) ## But, if it did not come out empty, then the ## position is kept, and the node gets updated. (#Base bitmap - (update! idx (#.Left sub-node') base))))) + (update! idx (#.Left sub_node') base))))) ## If, however, there was a KV-pair instead of a sub-node. (#.Some (#.Right [key' val'])) ## Check if the keys match. (if (\ Hash = key key') ## If so, remove the KV-pair and unset the BitPosition. - (#Base (unset-bit-position bit bitmap) + (#Base (unset_bit_position bit bitmap) (remove! idx base)) ## Otherwise, there's nothing to remove. node))) @@ -456,7 +456,7 @@ ## For #Collisions nodes, It need to find out if the key already existst. (#Collisions _hash _colls) - (case (collision-index Hash key _colls) + (case (collision_index Hash key _colls) ## If not, then there's nothing to remove. #.None node @@ -472,24 +472,24 @@ )) (def: (get' level hash key Hash node) - (All [k v] (-> Level Hash-Code k (Hash k) (Node k v) (Maybe v))) + (All [k v] (-> Level Hash_Code k (Hash k) (Node k v) (Maybe v))) (case node ## For #Hierarchy nodes, just look-up the key on its children. (#Hierarchy _size hierarchy) - (case (array.read (level-index level hash) hierarchy) + (case (array.read (level_index level hash) hierarchy) #.None #.None - (#.Some sub-node) (get' (level-up level) hash key Hash sub-node)) + (#.Some sub_node) (get' (level_up level) hash key Hash sub_node)) ## For #Base nodes, check the leaves, and recursively check the branches. (#Base bitmap base) - (let [bit (bit-position level hash)] - (if (bit-position-is-set? bit bitmap) - (case (array.read (base-index bit bitmap) base) + (let [bit (bit_position level hash)] + (if (bit_position_is_set? bit bitmap) + (case (array.read (base_index bit bitmap) base) #.None (undefined) - (#.Some (#.Left sub-node)) - (get' (level-up level) hash key Hash sub-node) + (#.Some (#.Left sub_node)) + (get' (level_up level) hash key Hash sub_node) (#.Some (#.Right [key' val'])) (if (\ Hash = key key') @@ -511,9 +511,9 @@ (array\fold n.+ 0 (array\map size' hierarchy)) (#Base _ base) - (array\fold n.+ 0 (array\map (function (_ sub-node') - (case sub-node' - (#.Left sub-node) (size' sub-node) + (array\fold n.+ 0 (array\map (function (_ sub_node') + (case sub_node' + (#.Left sub_node) (size' sub_node) (#.Right _) 1)) base)) @@ -525,15 +525,15 @@ (All [k v] (-> (Node k v) (List [k v]))) (case node (#Hierarchy _size hierarchy) - (array\fold (function (_ sub-node tail) (list\compose (entries' sub-node) tail)) + (array\fold (function (_ sub_node tail) (list\compose (entries' sub_node) tail)) #.Nil hierarchy) (#Base bitmap base) (array\fold (function (_ branch tail) (case branch - (#.Left sub-node) - (list\compose (entries' sub-node) tail) + (#.Left sub_node) + (list\compose (entries' sub_node) tail) (#.Right [key' val']) (#.Cons [key' val'] tail))) @@ -550,7 +550,7 @@ {#hash (Hash k) #root (Node k v)}) -(def: #export key-hash +(def: #export key_hash (All [k v] (-> (Dictionary k v) (Hash k))) (get@ #..hash)) @@ -562,17 +562,17 @@ (def: #export (put key val dict) (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) (let [[Hash node] dict] - [Hash (put' root-level (\ Hash hash key) key val Hash node)])) + [Hash (put' root_level (\ Hash hash key) key val Hash node)])) (def: #export (remove key dict) (All [k v] (-> k (Dictionary k v) (Dictionary k v))) (let [[Hash node] dict] - [Hash (remove' root-level (\ Hash hash key) key Hash node)])) + [Hash (remove' root_level (\ Hash hash key) key Hash node)])) (def: #export (get key dict) (All [k v] (-> k (Dictionary k v) (Maybe v))) (let [[Hash node] dict] - (get' root-level (\ Hash hash key) key Hash node))) + (get' root_level (\ Hash hash key) key Hash node))) (def: #export (key? dict key) (All [k v] (-> (Dictionary k v) k Bit)) @@ -580,14 +580,14 @@ #.None #0 (#.Some _) #1)) -(exception: #export key-already-exists) +(exception: #export key_already_exists) -(def: #export (try-put key val dict) +(def: #export (try_put key val dict) {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v)))) (case (get key dict) #.None (#try.Success (put key val dict)) - (#.Some _) (exception.throw ..key-already-exists []))) + (#.Some _) (exception.throw ..key_already_exists []))) (def: #export (update key f dict) {#.doc "Transforms the value located at key (if available), using the given function."} @@ -620,16 +620,16 @@ (All [k v] (-> (Dictionary k v) (List [k v]))) (entries' (product.right dict))) -(def: #export (from-list Hash kvs) +(def: #export (from_list Hash kvs) (All [k v] (-> (Hash k) (List [k v]) (Dictionary k v))) (list\fold (function (_ [k v] dict) (put k v dict)) (new Hash) kvs)) -(template [ ] +(template [ ] [(def: #export ( dict) - (All [k v] (-> (Dictionary k v) (List ))) + (All [k v] (-> (Dictionary k v) (List ))) (|> dict entries (list\map )))] [keys k product.left] @@ -644,7 +644,7 @@ dict1 (entries dict2))) -(def: #export (merge-with f dict2 dict1) +(def: #export (merge_with f dict2 dict1) {#.doc (doc "Merges 2 dictionaries." "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")} (All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) @@ -658,25 +658,25 @@ dict1 (entries dict2))) -(def: #export (re-bind from-key to-key dict) +(def: #export (re_bind from_key to_key dict) (All [k v] (-> k k (Dictionary k v) (Dictionary k v))) - (case (get from-key dict) + (case (get from_key dict) #.None dict (#.Some val) (|> dict - (remove from-key) - (put to-key val)))) + (remove from_key) + (put to_key val)))) (def: #export (select keys dict) {#.doc "Creates a sub-set of the given dict, with only the specified keys."} (All [k v] (-> (List k) (Dictionary k v) (Dictionary k v))) (let [[Hash _] dict] - (list\fold (function (_ key new-dict) + (list\fold (function (_ key new_dict) (case (get key dict) - #.None new-dict - (#.Some val) (put key val new-dict))) + #.None new_dict + (#.Some val) (put key val new_dict))) (new Hash) keys))) diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux index 49886a459..6907bfdc5 100644 --- a/stdlib/source/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux @@ -14,7 +14,7 @@ [macro ["." code]]]) -(def: error-message +(def: error_message "Invariant violation") (type: Color @@ -62,13 +62,13 @@ #.None (#.Some node) - (let [node-key (get@ #key node)] - (cond (\ dict = node-key key) - ## (_\= node-key key) + (let [node_key (get@ #key node)] + (cond (\ dict = node_key key) + ## (_\= node_key key) (#.Some (get@ #value node)) - (\ dict < node-key key) - ## (_\< node-key key) + (\ dict < node_key key) + ## (_\< node_key key) (recur (get@ #left node)) ## (_\> (get@ #key node) key) @@ -87,11 +87,11 @@ #0 (#.Some node) - (let [node-key (get@ #key node)] - (or (\ dict = node-key key) - ## (_\= node-key key) - (if (\ dict < node-key key) - ## (_\< node-key key) + (let [node_key (get@ #key node)] + (or (\ dict = node_key key) + ## (_\= node_key key) + (if (\ dict < node_key key) + ## (_\< node_key key) (recur (get@ #left node)) (recur (get@ #right node))))))))) @@ -130,25 +130,25 @@ (All [k v] (-> (Dictionary k v) Bit)) (|>> ..size (n.= 0))) -(template [ ] +(template [ ] [(def: ( self) (All [k v] (-> (Node k v) (Node k v))) (case (get@ #color self) - - (set@ #color self) + + (set@ #color self) - - + + ))] [blacken #Red #Black self] - [redden #Black #Red (error! error-message)] + [redden #Black #Red (error! error_message)] ) -(def: (balance-left-add parent self) +(def: (balance_left_add parent self) (All [k v] (-> (Node k v) (Node k v) (Node k v))) - (with-expansions - [ (as-is (black (get@ #key parent) + (with_expansions + [ (as_is (black (get@ #key parent) (get@ #value parent) (#.Some self) (get@ #right parent)))] @@ -181,16 +181,16 @@ (get@ #right parent)))) _ - )) + )) #Black - + ))) -(def: (balance-right-add parent self) +(def: (balance_right_add parent self) (All [k v] (-> (Node k v) (Node k v) (Node k v))) - (with-expansions - [ (as-is (black (get@ #key parent) + (with_expansions + [ (as_is (black (get@ #key parent) (get@ #value parent) (get@ #left parent) (#.Some self)))] @@ -223,30 +223,30 @@ (get@ #right self)))) _ - )) + )) #Black - + ))) -(def: (add-left addition center) +(def: (add_left addition center) (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red (red (get@ #key center) (get@ #value center) (#.Some addition) (get@ #right center)) #Black - (balance-left-add center addition) + (balance_left_add center addition) )) -(def: (add-right addition center) +(def: (add_right addition center) (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red (red (get@ #key center) (get@ #value center) (get@ #left center) (#.Some addition)) #Black - (balance-right-add center addition) + (balance_right_add center addition) )) (def: #export (put key value dict) @@ -261,15 +261,15 @@ (let [reference (get@ #key root)] (`` (cond (~~ (template [ ] [( reference key) - (let [side-root (get@ root) - outcome (recur side-root)] - (if (is? side-root outcome) + (let [side_root (get@ root) + outcome (recur side_root)] + (if (is? side_root outcome) ?root (#.Some ( (maybe.assume outcome) root))))] - [_\< #left add-left] - [(order.> (get@ #&order dict)) #right add-right] + [_\< #left add_left] + [(order.> (get@ #&order dict)) #right add_right] )) ## (_\= reference key) @@ -278,7 +278,7 @@ ))] (set@ #root root' dict))) -(def: (left-balance key value ?left ?right) +(def: (left_balance 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) @@ -307,7 +307,7 @@ _ (black key value ?left ?right))) -(def: (right-balance key value ?left ?right) +(def: (right_balance 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) @@ -334,7 +334,7 @@ _ (black key value ?left ?right))) -(def: (balance-left-remove key value ?left ?right) +(def: (balance_left_remove 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) @@ -345,7 +345,7 @@ (case ?right (^multi (#.Some right) [(get@ #color right) #Black]) - (right-balance key value ?left (#.Some (redden right))) + (right_balance key value ?left (#.Some (redden right))) (^multi (#.Some right) [(get@ #color right) #Red] @@ -354,16 +354,16 @@ (red (get@ #key right>>left) (get@ #value right>>left) (#.Some (black key value ?left (get@ #left right>>left))) - (#.Some (right-balance (get@ #key right) + (#.Some (right_balance (get@ #key right) (get@ #value right) (get@ #right right>>left) (\ maybe.functor map redden (get@ #right right))))) _ - (error! error-message)) + (error! error_message)) )) -(def: (balance-right-remove key value ?left ?right) +(def: (balance_right_remove 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) @@ -374,7 +374,7 @@ (case ?left (^multi (#.Some left) [(get@ #color left) #Black]) - (left-balance key value (#.Some (redden left)) ?right) + (left_balance key value (#.Some (redden left)) ?right) (^multi (#.Some left) [(get@ #color left) #Red] @@ -382,14 +382,14 @@ [(get@ #color left>>right) #Black]) (red (get@ #key left>>right) (get@ #value left>>right) - (#.Some (left-balance (get@ #key left) + (#.Some (left_balance (get@ #key left) (get@ #value left) (\ maybe.functor map redden (get@ #left left)) (get@ #left left>>right))) (#.Some (black key value (get@ #right left>>right) ?right))) _ - (error! error-message) + (error! error_message) ))) (def: (prepend ?left ?right) @@ -459,7 +459,7 @@ (get@ #right right))))) #Black - (wrap (balance-left-remove (get@ #key left) + (wrap (balance_left_remove (get@ #key left) (get@ #value left) (get@ #left left) (#.Some (black (get@ #key right) @@ -481,38 +481,38 @@ [#.None #0] (#.Some root) - (let [root-key (get@ #key root) - root-val (get@ #value root)] - (if (_\= root-key key) + (let [root_key (get@ #key root) + root_val (get@ #value root)] + (if (_\= root_key key) [(prepend (get@ #left root) (get@ #right root)) #1] - (let [go-left? (_\< root-key key)] - (case (recur (if go-left? + (let [go_left? (_\< root_key key)] + (case (recur (if go_left? (get@ #left root) (get@ #right root))) [#.None #0] [#.None #0] - [side-outcome _] - (if go-left? + [side_outcome _] + (if go_left? (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 (balance_left_remove root_key root_val side_outcome (get@ #right root))) #0] _ - [(#.Some (red root-key root-val side-outcome (get@ #right root))) + [(#.Some (red root_key root_val side_outcome (get@ #right root))) #0]) (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 (balance_right_remove root_key root_val (get@ #left root) side_outcome)) #0] _ - [(#.Some (red root-key root-val (get@ #left root) side-outcome)) + [(#.Some (red root_key root_val (get@ #left root) side_outcome)) #0]) ))) )) @@ -536,7 +536,7 @@ #.None dict)) -(def: #export (from-list Order list) +(def: #export (from_list Order list) (All [k v] (-> (Order k) (List [k v]) (Dictionary k v))) (list\fold (function (_ [key value] dict) (put key value dict)) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 62e8a417d..108c4a509 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -73,13 +73,13 @@ [(#.Cons head in) out] [in (#.Cons head out)])))) -(def: #export (as-pairs xs) +(def: #export (as_pairs xs) {#.doc (doc "Cut the list into pairs of 2." "Caveat emptor: If the list has an uneven number of elements, the last one will be skipped.")} (All [a] (-> (List a) (List [a a]))) (case xs (^ (list& x1 x2 xs')) - (#.Cons [x1 x2] (as-pairs xs')) + (#.Cons [x1 x2] (as_pairs xs')) _ #.Nil)) @@ -114,8 +114,8 @@ )))] - [take-while (#.Cons x (take-while predicate xs')) #.Nil] - [drop-while (drop-while predicate xs') xs] + [take_while (#.Cons x (take_while predicate xs')) #.Nil] + [drop_while (drop_while predicate xs') xs] ) (def: #export (split n xs) @@ -131,7 +131,7 @@ [(#.Cons x tail) rest])) [#.Nil xs])) -(def: (split-with' predicate ys xs) +(def: (split_with' predicate ys xs) (All [a] (-> (Predicate a) (List a) (List a) [(List a) (List a)])) (case xs @@ -140,14 +140,14 @@ (#.Cons x xs') (if (predicate x) - (split-with' predicate (#.Cons x ys) xs') + (split_with' predicate (#.Cons x ys) xs') [ys xs]))) -(def: #export (split-with predicate xs) +(def: #export (split_with predicate xs) {#.doc "Segment the list by using a predicate to tell when to cut."} (All [a] (-> (Predicate a) (List a) [(List a) (List a)])) - (let [[ys' xs'] (split-with' predicate #.Nil xs)] + (let [[ys' xs'] (split_with' predicate #.Nil xs)] [(reverse ys') xs'])) (def: #export (chunk n xs) @@ -452,15 +452,15 @@ (def: #export zip/3 (zip 3)) ((zip 3) xs ys zs))} (case tokens - (^ (list [_ (#.Nat num-lists)])) - (if (n.> 0 num-lists) + (^ (list [_ (#.Nat num_lists)])) + (if (n.> 0 num_lists) (let [(^open ".") ..functor - indices (..indices num-lists) - type-vars (: (List Code) (map (|>> nat@encode identifier$) indices)) - zip-type (` (All [(~+ type-vars)] + indices (..indices num_lists) + type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) + zip_type (` (All [(~+ type_vars)] (-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) - type-vars)) - (List [(~+ type-vars)])))) + type_vars)) + (List [(~+ type_vars)])))) vars+lists (|> indices (map inc) (map (function (_ idx) @@ -471,13 +471,13 @@ vars+lists))]) g!step (identifier$ "0step0") g!blank (identifier$ "0,0") - list-vars (map product.right vars+lists) - code (` (: (~ zip-type) - (function ((~ g!step) (~+ list-vars)) - (case [(~+ list-vars)] + list_vars (map product.right vars+lists) + code (` (: (~ zip_type) + (function ((~ g!step) (~+ list_vars)) + (case [(~+ list_vars)] (~ pattern) (#.Cons [(~+ (map product.left vars+lists))] - ((~ g!step) (~+ list-vars))) + ((~ g!step) (~+ list_vars))) (~ g!blank) #.Nil))))] @@ -490,24 +490,24 @@ (def: #export zip/2 (zip 2)) (def: #export zip/3 (zip 3)) -(macro: #export (zip-with tokens state) +(macro: #export (zip_with tokens state) {#.doc (doc "Create list zippers with the specified number of input lists." - (def: #export zip-with/2 (zip-with 2)) - (def: #export zip-with/3 (zip-with 3)) - ((zip-with 2) + xs ys))} + (def: #export zip_with/2 (zip_with 2)) + (def: #export zip_with/3 (zip_with 3)) + ((zip_with 2) + xs ys))} (case tokens - (^ (list [_ (#.Nat num-lists)])) - (if (n.> 0 num-lists) + (^ (list [_ (#.Nat num_lists)])) + (if (n.> 0 num_lists) (let [(^open ".") ..functor - indices (..indices num-lists) - g!return-type (identifier$ "0return-type0") + indices (..indices num_lists) + g!return_type (identifier$ "0return_type0") g!func (identifier$ "0func0") - type-vars (: (List Code) (map (|>> nat@encode identifier$) indices)) - zip-type (` (All [(~+ type-vars) (~ g!return-type)] - (-> (-> (~+ type-vars) (~ g!return-type)) + type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) + zip_type (` (All [(~+ type_vars) (~ g!return_type)] + (-> (-> (~+ type_vars) (~ g!return_type)) (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) - type-vars)) - (List (~ g!return-type))))) + type_vars)) + (List (~ g!return_type))))) vars+lists (|> indices (map inc) (map (function (_ idx) @@ -518,24 +518,24 @@ vars+lists))]) g!step (identifier$ "0step0") g!blank (identifier$ "0,0") - list-vars (map product.right vars+lists) - code (` (: (~ zip-type) - (function ((~ g!step) (~ g!func) (~+ list-vars)) - (case [(~+ list-vars)] + list_vars (map product.right vars+lists) + code (` (: (~ zip_type) + (function ((~ g!step) (~ g!func) (~+ list_vars)) + (case [(~+ list_vars)] (~ pattern) (#.Cons ((~ g!func) (~+ (map product.left vars+lists))) - ((~ g!step) (~ g!func) (~+ list-vars))) + ((~ g!step) (~ g!func) (~+ list_vars))) (~ g!blank) #.Nil))))] (#.Right [state (list code)])) - (#.Left "Cannot zip-with 0 lists.")) + (#.Left "Cannot zip_with 0 lists.")) _ - (#.Left "Wrong syntax for zip-with"))) + (#.Left "Wrong syntax for zip_with"))) -(def: #export zip-with/2 (zip-with 2)) -(def: #export zip-with/3 (zip-with 3)) +(def: #export zip_with/2 (zip_with 2)) +(def: #export zip_with/3 (zip_with 3)) (def: #export (last xs) (All [a] (-> (List a) (Maybe a))) diff --git a/stdlib/source/lux/data/collection/queue.lux b/stdlib/source/lux/data/collection/queue.lux index 2d8712b82..b7b7f56e2 100644 --- a/stdlib/source/lux/data/collection/queue.lux +++ b/stdlib/source/lux/data/collection/queue.lux @@ -18,12 +18,12 @@ {#front (list) #rear (list)}) -(def: #export (from-list entries) +(def: #export (from_list entries) (All [a] (-> (List a) (Queue a))) {#front entries #rear (list)}) -(def: #export (to-list queue) +(def: #export (to_list queue) (All [a] (-> (Queue a) (List a))) (let [(^slots [#front #rear]) queue] (list\compose front (list.reverse rear)))) @@ -80,8 +80,8 @@ (def: (= reference subject) (\ (list.equivalence super) = - (..to-list reference) - (..to-list subject)))) + (..to_list reference) + (..to_list subject)))) (structure: #export functor (Functor Queue) diff --git a/stdlib/source/lux/data/collection/queue/priority.lux b/stdlib/source/lux/data/collection/queue/priority.lux index 4c559e331..6904497d2 100644 --- a/stdlib/source/lux/data/collection/queue/priority.lux +++ b/stdlib/source/lux/data/collection/queue/priority.lux @@ -10,7 +10,7 @@ [collection ["." tree #_ ["#" finger (#+ Tree)]]]] - [type (#+ :by-example) + [type (#+ :by_example) [abstract (#+ abstract: :abstraction :representation)]]]) (type: #export Priority @@ -23,7 +23,7 @@ (tree.builder n.maximum)) (def: :@: - (:by-example [@] + (:by_example [@] {(tree.Builder @ Priority) ..builder} @)) @@ -78,16 +78,16 @@ (:abstraction (do maybe.monad [tree (:representation queue) - #let [highest-priority (tree.tag tree)]] + #let [highest_priority (tree.tag tree)]] (loop [node tree] (case (tree.root node) (0 #0 reference) - (if (n.= highest-priority (tree.tag node)) + (if (n.= highest_priority (tree.tag node)) #.None (#.Some node)) (0 #1 left right) - (if (n.= highest-priority (tree.tag left)) + (if (n.= highest_priority (tree.tag left)) (case (recur left) #.None (#.Some right) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index 9bc47be18..bcfd297a2 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -23,7 +23,7 @@ [collection ["." list ("#\." fold functor monoid)] ["." array (#+ Array) ("#\." functor fold)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]]) @@ -39,143 +39,143 @@ (type: Index Nat) -(def: branching-exponent +(def: branching_exponent Nat 5) -(def: root-level +(def: root_level Level 0) (template [ ] [(def: (-> Level Level) - ( branching-exponent))] + ( branching_exponent))] - [level-up n.+] - [level-down n.-] + [level_up n.+] + [level_down n.-] ) -(def: full-node-size +(def: full_node_size Nat - (i64.left-shift branching-exponent 1)) + (i64.left_shift branching_exponent 1)) -(def: branch-idx-mask +(def: branch_idx_mask Nat - (dec full-node-size)) + (dec full_node_size)) -(def: branch-idx +(def: branch_idx (-> Index Index) - (i64.and branch-idx-mask)) + (i64.and branch_idx_mask)) -(def: (new-hierarchy _) +(def: (new_hierarchy _) (All [a] (-> Any (Hierarchy a))) - (array.new full-node-size)) + (array.new full_node_size)) -(def: (tail-off row-size) +(def: (tail_off row_size) (-> Nat Nat) - (if (n.< full-node-size row-size) + (if (n.< full_node_size row_size) 0 - (|> (dec row-size) - (i64.logic-right-shift branching-exponent) - (i64.left-shift branching-exponent)))) + (|> (dec row_size) + (i64.logic_right_shift branching_exponent) + (i64.left_shift branching_exponent)))) -(def: (new-path level tail) +(def: (new_path level tail) (All [a] (-> Level (Base a) (Node a))) (if (n.= 0 level) (#Base tail) - (|> (new-hierarchy []) - (array.write! 0 (new-path (level-down level) tail)) + (|> (new_hierarchy []) + (array.write! 0 (new_path (level_down level) tail)) #Hierarchy))) -(def: (new-tail singleton) +(def: (new_tail singleton) (All [a] (-> a (Base a))) (|> (array.new 1) (array.write! 0 singleton))) -(def: (push-tail size level tail parent) +(def: (push_tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (i64.logic-right-shift level (dec size))) + (let [sub_idx (branch_idx (i64.logic_right_shift level (dec size))) ## If we're currently on a bottom node - sub-node (if (n.= branching-exponent level) + sub_node (if (n.= branching_exponent level) ## Just add the tail to it (#Base tail) ## Otherwise, check whether there's a vacant spot - (case (array.read sub-idx parent) + (case (array.read sub_idx parent) ## If so, set the path to the tail #.None - (new-path (level-down level) tail) - ## If not, push the tail onto the sub-node. - (#.Some (#Hierarchy sub-node)) - (#Hierarchy (push-tail size (level-down level) tail sub-node)) + (new_path (level_down level) tail) + ## If not, push the tail onto the sub_node. + (#.Some (#Hierarchy sub_node)) + (#Hierarchy (push_tail size (level_down level) tail sub_node)) _ (undefined)) )] (|> (array.clone parent) - (array.write! sub-idx sub-node)))) + (array.write! sub_idx sub_node)))) -(def: (expand-tail val tail) +(def: (expand_tail val tail) (All [a] (-> a (Base a) (Base a))) - (let [tail-size (array.size tail)] - (|> (array.new (inc tail-size)) - (array.copy! tail-size 0 tail 0) - (array.write! tail-size val)))) + (let [tail_size (array.size tail)] + (|> (array.new (inc tail_size)) + (array.copy! tail_size 0 tail 0) + (array.write! tail_size val)))) (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (i64.logic-right-shift level idx))] - (case (array.read sub-idx hierarchy) - (#.Some (#Hierarchy sub-node)) + (let [sub_idx (branch_idx (i64.logic_right_shift level idx))] + (case (array.read sub_idx hierarchy) + (#.Some (#Hierarchy sub_node)) (|> (array.clone hierarchy) - (array.write! sub-idx (#Hierarchy (put' (level-down level) idx val sub-node)))) + (array.write! sub_idx (#Hierarchy (put' (level_down level) idx val sub_node)))) (^multi (#.Some (#Base base)) - (n.= 0 (level-down level))) + (n.= 0 (level_down level))) (|> (array.clone hierarchy) - (array.write! sub-idx (|> (array.clone base) - (array.write! (branch-idx idx) val) + (array.write! sub_idx (|> (array.clone base) + (array.write! (branch_idx idx) val) #Base))) _ (undefined)))) -(def: (pop-tail size level hierarchy) +(def: (pop_tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (i64.logic-right-shift level (n.- 2 size)))] - (cond (n.= 0 sub-idx) + (let [sub_idx (branch_idx (i64.logic_right_shift level (n.- 2 size)))] + (cond (n.= 0 sub_idx) #.None - (n.> branching-exponent level) + (n.> branching_exponent level) (do maybe.monad - [base|hierarchy (array.read sub-idx hierarchy) + [base|hierarchy (array.read sub_idx hierarchy) sub (case base|hierarchy (#Hierarchy sub) - (pop-tail size (level-down level) sub) + (pop_tail size (level_down level) sub) (#Base _) (undefined))] (|> (array.clone hierarchy) - (array.write! sub-idx (#Hierarchy sub)) + (array.write! sub_idx (#Hierarchy sub)) #.Some)) ## Else... (|> (array.clone hierarchy) - (array.delete! sub-idx) + (array.delete! sub_idx) #.Some) ))) -(def: (to-list' node) +(def: (to_list' node) (All [a] (-> (Node a) (List a))) (case node (#Base base) - (array.to-list base) + (array.to_list base) (#Hierarchy hierarchy) (|> hierarchy - array.to-list + array.to_list list.reverse - (list\fold (function (_ sub acc) (list\compose (to-list' sub) acc)) + (list\fold (function (_ sub acc) (list\compose (to_list' sub) acc)) #.Nil)))) (type: #export (Row a) @@ -186,9 +186,9 @@ (def: #export empty Row - {#level (level-up root-level) + {#level (level_up root_level) #size 0 - #root (array.new full-node-size) + #root (array.new full_node_size) #tail (array.new 0)}) (def: #export (size row) @@ -198,94 +198,94 @@ (def: #export (add val row) (All [a] (-> a (Row a) (Row a))) ## Check if there is room in the tail. - (let [row-size (get@ #size row)] - (if (|> row-size (n.- (tail-off row-size)) (n.< full-node-size)) + (let [row_size (get@ #size row)] + (if (|> row_size (n.- (tail_off row_size)) (n.< full_node_size)) ## If so, append to it. (|> row (update@ #size inc) - (update@ #tail (expand-tail val))) + (update@ #tail (expand_tail val))) ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n.> (i64.left-shift (get@ #level row) 1) - (i64.logic-right-shift branching-exponent row-size)) + (|> (if (n.> (i64.left_shift (get@ #level row) 1) + (i64.logic_right_shift branching_exponent row_size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> row (set@ #root (|> (for {@.old (: (Hierarchy ($ 0)) - (new-hierarchy []))} - (new-hierarchy [])) + (new_hierarchy []))} + (new_hierarchy [])) (array.write! 0 (#Hierarchy (get@ #root row))) - (array.write! 1 (new-path (get@ #level row) (get@ #tail row))))) - (update@ #level level-up)) + (array.write! 1 (new_path (get@ #level row) (get@ #tail row))))) + (update@ #level level_up)) ## Otherwise, just push the current tail onto the root. (|> row - (update@ #root (push-tail row-size (get@ #level row) (get@ #tail row))))) + (update@ #root (push_tail row_size (get@ #level row) (get@ #tail row))))) ## Finally, update the size of the row and grow a new ## tail with the new element as it's sole member. (update@ #size inc) - (set@ #tail (new-tail val))) + (set@ #tail (new_tail val))) ))) -(exception: incorrect-row-structure) +(exception: incorrect_row_structure) -(exception: #export [a] (index-out-of-bounds {row (Row a)} {index Nat}) +(exception: #export [a] (index_out_of_bounds {row (Row a)} {index Nat}) (exception.report ["Size" (\ n.decimal encode (get@ #size row))] ["Index" (\ n.decimal encode index)])) -(exception: base-was-not-found) +(exception: base_was_not_found) -(def: #export (within-bounds? row idx) +(def: #export (within_bounds? row idx) (All [a] (-> (Row a) Nat Bit)) (n.< (get@ #size row) idx)) -(def: (base-for idx row) +(def: (base_for idx row) (All [a] (-> Index (Row a) (Try (Base a)))) - (if (within-bounds? row idx) - (if (n.>= (tail-off (get@ #size row)) idx) + (if (within_bounds? row idx) + (if (n.>= (tail_off (get@ #size row)) idx) (#try.Success (get@ #tail row)) (loop [level (get@ #level row) hierarchy (get@ #root row)] - (case [(n.> branching-exponent level) - (array.read (branch-idx (i64.logic-right-shift level idx)) hierarchy)] + (case [(n.> branching_exponent level) + (array.read (branch_idx (i64.logic_right_shift level idx)) hierarchy)] [#1 (#.Some (#Hierarchy sub))] - (recur (level-down level) sub) + (recur (level_down level) sub) [#0 (#.Some (#Base base))] (#try.Success base) [_ #.None] - (exception.throw ..base-was-not-found []) + (exception.throw ..base_was_not_found []) _ - (exception.throw ..incorrect-row-structure [])))) - (exception.throw ..index-out-of-bounds [row idx]))) + (exception.throw ..incorrect_row_structure [])))) + (exception.throw ..index_out_of_bounds [row idx]))) (def: #export (nth idx row) (All [a] (-> Nat (Row a) (Try a))) (do try.monad - [base (base-for idx row)] - (case (array.read (branch-idx idx) base) + [base (base_for idx row)] + (case (array.read (branch_idx idx) base) (#.Some value) (#try.Success value) #.None - (exception.throw ..incorrect-row-structure [])))) + (exception.throw ..incorrect_row_structure [])))) (def: #export (put idx val row) (All [a] (-> Nat a (Row a) (Try (Row a)))) - (let [row-size (get@ #size row)] - (if (within-bounds? row idx) - (#try.Success (if (n.>= (tail-off row-size) idx) + (let [row_size (get@ #size row)] + (if (within_bounds? row idx) + (#try.Success (if (n.>= (tail_off row_size) idx) (update@ #tail (for {@.old (: (-> (Base ($ 0)) (Base ($ 0))) - (|>> array.clone (array.write! (branch-idx idx) val)))} - (|>> array.clone (array.write! (branch-idx idx) val))) + (|>> array.clone (array.write! (branch_idx idx) val)))} + (|>> array.clone (array.write! (branch_idx idx) val))) row) (update@ #root (put' (get@ #level row) idx val) row))) - (exception.throw ..index-out-of-bounds [row idx])))) + (exception.throw ..index_out_of_bounds [row idx])))) (def: #export (update idx f row) (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) @@ -302,25 +302,25 @@ 1 empty - row-size - (if (|> row-size (n.- (tail-off row-size)) (n.> 1)) - (let [old-tail (get@ #tail row) - new-tail-size (dec (array.size old-tail))] + row_size + (if (|> row_size (n.- (tail_off row_size)) (n.> 1)) + (let [old_tail (get@ #tail row) + new_tail_size (dec (array.size old_tail))] (|> row (update@ #size dec) - (set@ #tail (|> (array.new new-tail-size) - (array.copy! new-tail-size 0 old-tail 0))))) + (set@ #tail (|> (array.new new_tail_size) + (array.copy! new_tail_size 0 old_tail 0))))) (maybe.assume (do maybe.monad - [new-tail (base-for (n.- 2 row-size) row) - #let [[level' root'] (let [init-level (get@ #level row)] - (loop [level init-level - root (maybe.default (new-hierarchy []) - (pop-tail row-size init-level (get@ #root row)))] - (if (n.> branching-exponent level) + [new_tail (base_for (n.- 2 row_size) row) + #let [[level' root'] (let [init_level (get@ #level row)] + (loop [level init_level + root (maybe.default (new_hierarchy []) + (pop_tail row_size init_level (get@ #root row)))] + (if (n.> branching_exponent level) (case [(array.read 1 root) (array.read 0 root)] - [#.None (#.Some (#Hierarchy sub-node))] - (recur (level-down level) sub-node) + [#.None (#.Some (#Hierarchy sub_node))] + (recur (level_down level) sub_node) ## [#.None (#.Some (#Base _))] ## (undefined) @@ -332,21 +332,21 @@ (update@ #size dec) (set@ #level level') (set@ #root root') - (set@ #tail new-tail)))))) + (set@ #tail new_tail)))))) )) -(def: #export (to-list row) +(def: #export (to_list row) (All [a] (-> (Row a) (List a))) - (list\compose (to-list' (#Hierarchy (get@ #root row))) - (to-list' (#Base (get@ #tail row))))) + (list\compose (to_list' (#Hierarchy (get@ #root row))) + (to_list' (#Base (get@ #tail row))))) -(def: #export from-list +(def: #export from_list (All [a] (-> (List a) (Row a))) (list\fold ..add ..empty)) (def: #export (member? a/Equivalence row val) (All [a] (-> (Equivalence a) (Row a) a Bit)) - (list.member? a/Equivalence (to-list row) val)) + (list.member? a/Equivalence (to_list row) val)) (def: #export empty? (All [a] (-> (Row a) Bit)) @@ -355,9 +355,9 @@ (syntax: #export (row {elems (p.some s.any)}) {#.doc (doc "Row literals." (row +10 +20 +30 +40))} - (wrap (list (` (..from-list (list (~+ elems))))))) + (wrap (list (` (..from_list (list (~+ elems))))))) -(structure: (node-equivalence Equivalence) +(structure: (node_equivalence Equivalence) (All [a] (-> (Equivalence a) (Equivalence (Node a)))) (def: (= v1 v2) @@ -366,7 +366,7 @@ (\ (array.equivalence Equivalence) = b1 b2) [(#Hierarchy h1) (#Hierarchy h2)] - (\ (array.equivalence (node-equivalence Equivalence)) = h1 h2) + (\ (array.equivalence (node_equivalence Equivalence)) = h1 h2) _ #0))) @@ -376,13 +376,13 @@ (def: (= v1 v2) (and (n.= (get@ #size v1) (get@ #size v2)) - (let [(^open "node\.") (node-equivalence Equivalence)] + (let [(^open "node\.") (node_equivalence Equivalence)] (and (node\= (#Base (get@ #tail v1)) (#Base (get@ #tail v2))) (node\= (#Hierarchy (get@ #root v1)) (#Hierarchy (get@ #root v2)))))))) -(structure: node-fold +(structure: node_fold (Fold Node) (def: (fold f init xs) @@ -399,7 +399,7 @@ (Fold Row) (def: (fold f init xs) - (let [(^open ".") node-fold] + (let [(^open ".") node_fold] (fold f (fold f init @@ -412,9 +412,9 @@ (def: identity ..empty) (def: (compose xs ys) - (list\fold add xs (..to-list ys)))) + (list\fold add xs (..to_list ys)))) -(structure: node-functor +(structure: node_functor (Functor Node) (def: (map f xs) @@ -431,7 +431,7 @@ (def: (map f xs) {#level (get@ #level xs) #size (get@ #size xs) - #root (|> xs (get@ #root) (array\map (\ node-functor map f))) + #root (|> xs (get@ #root) (array\map (\ node_functor map f))) #tail (|> xs (get@ #tail) (array\map f))})) (structure: #export apply @@ -461,7 +461,7 @@ (def: #export reverse (All [a] (-> (Row a) (Row a))) - (|>> ..to-list list.reverse (list\fold add ..empty))) + (|>> ..to_list list.reverse (list\fold add ..empty))) (template [ ] [(def: #export diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index e76355fe1..ddb508c39 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -7,7 +7,7 @@ ["//" continuation (#+ Cont)] ["<>" parser ["<.>" code (#+ Parser)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]] @@ -65,33 +65,33 @@ 0 head _ (nth (dec idx) tail)))) -(template [ ] +(template [ ] [(def: #export ( pred xs) (All [a] - (-> (Sequence a) (List a))) + (-> (Sequence a) (List a))) (let [[x xs'] (//.run xs)] - (if - (list& x ( xs')) + (if + (list& x ( xs')) (list)))) (def: #export ( pred xs) (All [a] - (-> (Sequence a) (Sequence a))) + (-> (Sequence a) (Sequence a))) (let [[x xs'] (//.run xs)] - (if - ( xs') + (if + ( xs') xs))) (def: #export ( pred xs) (All [a] - (-> (Sequence a) [(List a) (Sequence a)])) + (-> (Sequence a) [(List a) (Sequence a)])) (let [[x xs'] (//.run xs)] - (if - (let [[tail next] ( xs')] + (if + (let [[tail next] ( xs')] [(#.Cons [x tail]) next]) [(list) xs])))] - [take-while drop-while split-while (-> a Bit) (pred x) pred] + [take_while drop_while split_while (-> a Bit) (pred x) pred] [take drop split Nat (n.> 0 pred) (dec pred)] ) @@ -139,9 +139,9 @@ {branches (<>.some .any)}) {#.doc (doc "Allows destructuring of sequences in pattern-matching expressions." "Caveat emptor: Only use it for destructuring, and not for testing values within the sequences." - (let [(^sequence& x y z _tail) (some-sequence-func +1 +2 +3)] + (let [(^sequence& x y z _tail) (some_sequence_func +1 +2 +3)] (func x y z)))} - (with-gensyms [g!sequence] + (with_gensyms [g!sequence] (let [body+ (` (let [(~+ (list\join (list\map (function (_ pattern) (list (` [(~ pattern) (~ g!sequence)]) (` ((~! //.run) (~ g!sequence))))) diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux index b47c5761d..67e241b78 100644 --- a/stdlib/source/lux/data/collection/set.lux +++ b/stdlib/source/lux/data/collection/set.lux @@ -15,9 +15,9 @@ (type: #export (Set a) (Dictionary a Any)) -(def: #export member-hash +(def: #export member_hash (All [a] (-> (Set a) (Hash a))) - //.key-hash) + //.key_hash) (def: #export new (All [a] (-> (Hash a) (Set a))) @@ -39,7 +39,7 @@ (All [a] (-> (Set a) a Bit)) //.key?) -(def: #export to-list +(def: #export to_list (All [a] (-> (Set a) (List a))) //.keys) @@ -49,7 +49,7 @@ (def: #export (difference sub base) (All [a] (-> (Set a) (Set a) (Set a))) - (list\fold ..remove base (..to-list sub))) + (list\fold ..remove base (..to_list sub))) (def: #export (intersection filter base) (All [a] (-> (Set a) (Set a) (Set a))) @@ -63,7 +63,7 @@ (and (n.= (..size reference) (..size sample)) (list.every? (..member? reference) - (..to-list sample))))) + (..to_list sample))))) (structure: #export hash (All [a] (Hash (Set a))) @@ -73,7 +73,7 @@ (def: (hash (^@ set [hash _])) (list\fold (function (_ elem acc) (n.+ (\ hash hash elem) acc)) 0 - (..to-list set)))) + (..to_list set)))) (structure: #export (monoid hash) (All [a] (-> (Hash a) (Monoid (Set a)))) @@ -85,13 +85,13 @@ (All [a] (-> (Set a) Bit)) (|>> ..size (n.= 0))) -(def: #export (from-list hash elements) +(def: #export (from_list hash elements) (All [a] (-> (Hash a) (List a) (Set a))) (list\fold ..add (..new hash) elements)) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bit)) - (list.every? (..member? super) (..to-list sub))) + (list.every? (..member? super) (..to_list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bit)) diff --git a/stdlib/source/lux/data/collection/set/multi.lux b/stdlib/source/lux/data/collection/set/multi.lux index 7e4c0f7fe..727cf2d8d 100644 --- a/stdlib/source/lux/data/collection/set/multi.lux +++ b/stdlib/source/lux/data/collection/set/multi.lux @@ -55,7 +55,7 @@ (All [a] (-> (Set a) a Nat)) (|> set :representation (dictionary.get elem) (maybe.default 0))) - (def: #export to-list + (def: #export to_list (All [a] (-> (Set a) (List a))) (|>> :representation dictionary.entries @@ -66,7 +66,7 @@ (template [ ] [(def: #export ( parameter subject) (All [a] (-> (Set a) (Set a) (Set a))) - (:abstraction (dictionary.merge-with (:representation parameter) (:representation subject))))] + (:abstraction (dictionary.merge_with (:representation parameter) (:representation subject))))] [union n.max] [sum n.+] @@ -79,7 +79,7 @@ multiplicity) elem output)) - (..new (dictionary.key-hash subject)) + (..new (dictionary.key_hash subject)) (dictionary.entries subject))) (def: #export (difference parameter subject) @@ -106,7 +106,7 @@ (let [(^@ set [hash _]) (:representation set)] (|> set dictionary.keys - (//.from-list hash)))) + (//.from_list hash)))) (structure: #export equivalence (All [a] (Equivalence (Set a))) @@ -142,14 +142,14 @@ (All [a] (-> (Set a) Bit)) (|>> ..size (n.= 0))) -(def: #export (from-list hash subject) +(def: #export (from_list hash subject) (All [a] (-> (Hash a) (List a) (Set a))) (list\fold (..add 1) (..new hash) subject)) -(def: #export (from-set subject) +(def: #export (from_set subject) (All [a] (-> (//.Set a) (Set a))) - (..from-list (//.member-hash subject) - (//.to-list subject))) + (..from_list (//.member_hash subject) + (//.to_list subject))) (def: #export super? (All [a] (-> (Set a) (Set a) Bit)) diff --git a/stdlib/source/lux/data/collection/set/ordered.lux b/stdlib/source/lux/data/collection/set/ordered.lux index 68449daa3..71183d2e4 100644 --- a/stdlib/source/lux/data/collection/set/ordered.lux +++ b/stdlib/source/lux/data/collection/set/ordered.lux @@ -41,42 +41,42 @@ (All [a] (-> a (Set a) (Set a))) (|> set :representation (/.remove elem) :abstraction)) - (def: #export to-list + (def: #export to_list (All [a] (-> (Set a) (List a))) (|>> :representation /.keys)) - (def: #export (from-list &order list) + (def: #export (from_list &order list) (All [a] (-> (Order a) (List a) (Set a))) (list\fold add (..new &order) list)) (def: #export (union left right) (All [a] (-> (Set a) (Set a) (Set a))) - (list\fold ..add right (..to-list left))) + (list\fold ..add right (..to_list left))) (def: #export (intersection left right) (All [a] (-> (Set a) (Set a) (Set a))) - (|> (..to-list right) + (|> (..to_list right) (list.filter (..member? left)) - (..from-list (get@ #/.&order (:representation right))))) + (..from_list (get@ #/.&order (:representation right))))) (def: #export (difference param subject) (All [a] (-> (Set a) (Set a) (Set a))) - (|> (..to-list subject) + (|> (..to_list subject) (list.filter (|>> (..member? param) not)) - (..from-list (get@ #/.&order (:representation subject))))) + (..from_list (get@ #/.&order (:representation subject))))) (structure: #export equivalence (All [a] (Equivalence (Set a))) (def: (= reference sample) (\ (list.equivalence (\ (:representation reference) &equivalence)) - = (..to-list reference) (..to-list sample)))) + = (..to_list reference) (..to_list sample)))) ) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bit)) (|> sub - ..to-list + ..to_list (list.every? (..member? super)))) (def: #export (super? sub super) diff --git a/stdlib/source/lux/data/collection/tree/finger.lux b/stdlib/source/lux/data/collection/tree/finger.lux index c18ff7251..96f7af432 100644 --- a/stdlib/source/lux/data/collection/tree/finger.lux +++ b/stdlib/source/lux/data/collection/tree/finger.lux @@ -6,7 +6,7 @@ [data [collection ["." list ("#\." monoid)]]] - [type (#+ :by-example) + [type (#+ :by_example) [abstract (#+ abstract: :abstraction :representation)]]]) (abstract: #export (Tree @ t v) @@ -90,10 +90,10 @@ (#.Some value) (0 #1 [left right]) - (let [shifted-tag (tag//compose _tag (..tag left))] - (if (predicate shifted-tag) + (let [shifted_tag (tag//compose _tag (..tag left))] + (if (predicate shifted_tag) (recur _tag (get@ #root (:representation left))) - (recur shifted-tag (get@ #root (:representation right)))))))) + (recur shifted_tag (get@ #root (:representation right)))))))) #.None))) ) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 2ce752cfd..82d421715 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -20,15 +20,15 @@ (def: rgb 256) (def: top (dec rgb)) -(def: rgb-factor (|> top .int int.frac)) +(def: rgb_factor (|> top .int int.frac)) -(def: scale-down +(def: scale_down (-> Nat Frac) - (|>> .int int.frac (f./ rgb-factor))) + (|>> .int int.frac (f./ rgb_factor))) -(def: scale-up +(def: scale_up (-> Frac Nat) - (|>> (f.* rgb-factor) f.int .nat)) + (|>> (f.* rgb_factor) f.int .nat)) (type: #export RGB {#red Nat @@ -50,13 +50,13 @@ (abstract: #export Color RGB - (def: #export (from-rgb [red green blue]) + (def: #export (from_rgb [red green blue]) (-> RGB Color) (:abstraction {#red (n.% ..rgb red) #green (n.% ..rgb green) #blue (n.% ..rgb blue)})) - (def: #export to-rgb + (def: #export to_rgb (-> Color RGB) (|>> :representation)) @@ -78,17 +78,17 @@ (def: (hash value) (let [[r g b] (:representation value)] ($_ i64.or - (i64.left-shift 16 r) - (i64.left-shift 8 g) + (i64.left_shift 16 r) + (i64.left_shift 8 g) b)))) (def: #export black - (..from-rgb {#red 0 + (..from_rgb {#red 0 #green 0 #blue 0})) (def: #export white - (..from-rgb {#red ..top + (..from_rgb {#red ..top #green ..top #blue ..top})) @@ -128,12 +128,12 @@ #blue (n.min lB rB)})))) ) -(def: #export (to-hsl color) +(def: #export (to_hsl color) (-> Color HSL) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) luminance (|> (f.+ max min) (f./ +2.0))] @@ -163,7 +163,7 @@ saturation luminance])))) -(def: (hue-to-rgb p q t) +(def: (hue_to_rgb p q t) (-> Frac Frac Frac Frac) (let [t (cond (f.< +0.0 t) (f.+ +1.0 t) (f.> +1.0 t) (f.- +1.0 t) @@ -182,12 +182,12 @@ ## else p))) -(def: #export (from-hsl [hue saturation luminance]) +(def: #export (from_hsl [hue saturation luminance]) (-> HSL Color) (if (f.= +0.0 saturation) ## Achromatic - (let [intensity (scale-up luminance)] - (from-rgb {#red intensity + (let [intensity (scale_up luminance)] + (from_rgb {#red intensity #green intensity #blue intensity})) ## Chromatic @@ -196,16 +196,16 @@ (|> luminance (f.+ saturation) (f.- (f.* saturation luminance)))) p (|> luminance (f.* +2.0) (f.- q)) third (|> +1.0 (f./ +3.0))] - (from-rgb {#red (scale-up (|> hue (f.+ third) (hue-to-rgb p q))) - #green (scale-up (|> hue (hue-to-rgb p q))) - #blue (scale-up (|> hue (f.- third) (hue-to-rgb p q)))})))) + (from_rgb {#red (scale_up (|> hue (f.+ third) (hue_to_rgb p q))) + #green (scale_up (|> hue (hue_to_rgb p q))) + #blue (scale_up (|> hue (f.- third) (hue_to_rgb p q)))})))) -(def: #export (to-hsb color) +(def: #export (to_hsb color) (-> Color HSB) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) brightness max @@ -232,7 +232,7 @@ saturation brightness])))) -(def: #export (from-hsb [hue saturation brightness]) +(def: #export (from_hsb [hue saturation brightness]) (-> HSB Color) (let [hue (|> hue (f.* +6.0)) i (math.floor hue) @@ -245,16 +245,16 @@ red (case mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) green (case mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) blue (case mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] - (from-rgb {#red (scale-up red) - #green (scale-up green) - #blue (scale-up blue)}))) + (from_rgb {#red (scale_up red) + #green (scale_up green) + #blue (scale_up blue)}))) -(def: #export (to-cmyk color) +(def: #export (to_cmyk color) (-> Color CMYK) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) key (|> +1.0 (f.- ($_ f.max red green blue))) f (if (f.< +1.0 key) (|> +1.0 (f./ (|> +1.0 (f.- key)))) @@ -267,10 +267,10 @@ #yellow yellow #key key})) -(def: #export (from-cmyk [cyan magenta yellow key]) +(def: #export (from_cmyk [cyan magenta yellow key]) (-> CMYK Color) (if (f.= +1.0 key) - (from-rgb {#red 0 + (from_rgb {#red 0 #green 0 #blue 0}) (let [red (|> (|> +1.0 (f.- cyan)) @@ -279,9 +279,9 @@ (f.* (|> +1.0 (f.- key)))) blue (|> (|> +1.0 (f.- yellow)) (f.* (|> +1.0 (f.- key))))] - (from-rgb {#red (scale-up red) - #green (scale-up green) - #blue (scale-up blue)})))) + (from_rgb {#red (scale_up red) + #green (scale_up green) + #blue (scale_up blue)})))) (def: (normalize ratio) (-> Frac Frac) @@ -304,9 +304,9 @@ (f.+ (|> end .int int.frac (f.* dE))) f.int .nat))) - [redS greenS blueS] (to-rgb start) - [redE greenE blueE] (to-rgb end)] - (from-rgb {#red (interpolate' redE redS) + [redS greenS blueS] (to_rgb start) + [redE greenE blueE] (to_rgb end)] + (from_rgb {#red (interpolate' redE redS) #green (interpolate' greenE greenS) #blue (interpolate' blueE blueS)}))) @@ -322,53 +322,53 @@ (template [ ] [(def: #export ( ratio color) (-> Frac Color Color) - (let [[hue saturation luminance] (to-hsl color)] - (from-hsl [hue + (let [[hue saturation luminance] (to_hsl color)] + (from_hsl [hue (|> saturation (f.* (|> +1.0 ( (..normalize ratio)))) (f.min +1.0)) luminance])))] [saturate f.+] - [de-saturate f.-] + [de_saturate f.-] ) -(def: #export (gray-scale color) +(def: #export (gray_scale color) (-> Color Color) - (let [[_ _ luminance] (to-hsl color)] - (from-hsl [+0.0 + (let [[_ _ luminance] (to_hsl color)] + (from_hsl [+0.0 +0.0 luminance]))) (template [ <1> <2>] [(def: #export ( color) (-> Color [Color Color Color]) - (let [[hue saturation luminance] (to-hsl color)] + (let [[hue saturation luminance] (to_hsl color)] [color - (from-hsl [(|> hue (f.+ <1>) ..normalize) + (from_hsl [(|> hue (f.+ <1>) ..normalize) saturation luminance]) - (from-hsl [(|> hue (f.+ <2>) ..normalize) + (from_hsl [(|> hue (f.+ <2>) ..normalize) saturation luminance])]))] [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] - [split-complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] + [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] ) (template [ <1> <2> <3>] [(def: #export ( color) (-> Color [Color Color Color Color]) - (let [[hue saturation luminance] (to-hsb color)] + (let [[hue saturation luminance] (to_hsb color)] [color - (from-hsb [(|> hue (f.+ <1>) ..normalize) + (from_hsb [(|> hue (f.+ <1>) ..normalize) saturation luminance]) - (from-hsb [(|> hue (f.+ <2>) ..normalize) + (from_hsb [(|> hue (f.+ <2>) ..normalize) saturation luminance]) - (from-hsb [(|> hue (f.+ <3>) ..normalize) + (from_hsb [(|> hue (f.+ <3>) ..normalize) saturation luminance])]))] @@ -384,17 +384,17 @@ (def: #export (analogous spread variations color) (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to-hsb color) + (let [[hue saturation brightness] (to_hsb color) spread (..normalize spread)] (list\map (function (_ idx) - (from-hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) + (from_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) saturation brightness])) (list.indices variations)))) (def: #export (monochromatic spread variations color) (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to-hsb color) + (let [[hue saturation brightness] (to_hsb color) spread (..normalize spread)] (|> (list.indices variations) (list\map (|>> inc .int int.frac @@ -402,7 +402,7 @@ (f.+ brightness) ..normalize [hue saturation] - from-hsb))))) + from_hsb))))) (type: #export Alpha Rev) diff --git a/stdlib/source/lux/data/color/named.lux b/stdlib/source/lux/data/color/named.lux index 09e021727..39c762081 100644 --- a/stdlib/source/lux/data/color/named.lux +++ b/stdlib/source/lux/data/color/named.lux @@ -7,140 +7,140 @@ (template [ ] [(def: #export Color - (//.from-rgb {#//.red (hex ) + (//.from_rgb {#//.red (hex ) #//.green (hex ) #//.blue (hex )}))] - ["F0" "F8" "FF" alice-blue] - ["FA" "EB" "D7" antique-white] + ["F0" "F8" "FF" alice_blue] + ["FA" "EB" "D7" antique_white] ["00" "FF" "FF" aqua] ["7F" "FF" "D4" aquamarine] ["F0" "FF" "FF" azure] ["F5" "F5" "DC" beige] ["FF" "E4" "C4" bisque] ["00" "00" "00" black] - ["FF" "EB" "CD" blanched-almond] + ["FF" "EB" "CD" blanched_almond] ["00" "00" "FF" blue] - ["8A" "2B" "E2" blue-violet] + ["8A" "2B" "E2" blue_violet] ["A5" "2A" "2A" brown] - ["DE" "B8" "87" burly-wood] - ["5F" "9E" "A0" cadet-blue] + ["DE" "B8" "87" burly_wood] + ["5F" "9E" "A0" cadet_blue] ["7F" "FF" "00" chartreuse] ["D2" "69" "1E" chocolate] ["FF" "7F" "50" coral] - ["64" "95" "ED" cornflower-blue] + ["64" "95" "ED" cornflower_blue] ["FF" "F8" "DC" cornsilk] ["DC" "14" "3C" crimson] ["00" "FF" "FF" cyan] - ["00" "00" "8B" dark-blue] - ["00" "8B" "8B" dark-cyan] - ["B8" "86" "0B" dark-goldenrod] - ["A9" "A9" "A9" dark-gray] - ["00" "64" "00" dark-green] - ["BD" "B7" "6B" dark-khaki] - ["8B" "00" "8B" dark-magenta] - ["55" "6B" "2F" dark-olive-green] - ["FF" "8C" "00" dark-orange] - ["99" "32" "CC" dark-orchid] - ["8B" "00" "00" dark-red] - ["E9" "96" "7A" dark-salmon] - ["8F" "BC" "8F" dark-sea-green] - ["48" "3D" "8B" dark-slate-blue] - ["2F" "4F" "4F" dark-slate-gray] - ["00" "CE" "D1" dark-turquoise] - ["94" "00" "D3" dark-violet] - ["FF" "14" "93" deep-pink] - ["00" "BF" "FF" deep-sky-blue] - ["69" "69" "69" dim-gray] - ["1E" "90" "FF" dodger-blue] - ["B2" "22" "22" fire-brick] - ["FF" "FA" "F0" floral-white] - ["22" "8B" "22" forest-green] + ["00" "00" "8B" dark_blue] + ["00" "8B" "8B" dark_cyan] + ["B8" "86" "0B" dark_goldenrod] + ["A9" "A9" "A9" dark_gray] + ["00" "64" "00" dark_green] + ["BD" "B7" "6B" dark_khaki] + ["8B" "00" "8B" dark_magenta] + ["55" "6B" "2F" dark_olive_green] + ["FF" "8C" "00" dark_orange] + ["99" "32" "CC" dark_orchid] + ["8B" "00" "00" dark_red] + ["E9" "96" "7A" dark_salmon] + ["8F" "BC" "8F" dark_sea_green] + ["48" "3D" "8B" dark_slate_blue] + ["2F" "4F" "4F" dark_slate_gray] + ["00" "CE" "D1" dark_turquoise] + ["94" "00" "D3" dark_violet] + ["FF" "14" "93" deep_pink] + ["00" "BF" "FF" deep_sky_blue] + ["69" "69" "69" dim_gray] + ["1E" "90" "FF" dodger_blue] + ["B2" "22" "22" fire_brick] + ["FF" "FA" "F0" floral_white] + ["22" "8B" "22" forest_green] ["FF" "00" "FF" fuchsia] ["DC" "DC" "DC" gainsboro] - ["F8" "F8" "FF" ghost-white] + ["F8" "F8" "FF" ghost_white] ["FF" "D7" "00" gold] ["DA" "A5" "20" goldenrod] ["80" "80" "80" gray] ["00" "80" "00" green] - ["AD" "FF" "2F" green-yellow] - ["F0" "FF" "F0" honey-dew] - ["FF" "69" "B4" hot-pink] - ["CD" "5C" "5C" indian-red] + ["AD" "FF" "2F" green_yellow] + ["F0" "FF" "F0" honey_dew] + ["FF" "69" "B4" hot_pink] + ["CD" "5C" "5C" indian_red] ["4B" "00" "82" indigo] ["FF" "FF" "F0" ivory] ["F0" "E6" "8C" khaki] ["E6" "E6" "FA" lavender] - ["FF" "F0" "F5" lavender-blush] - ["7C" "FC" "00" lawn-green] - ["FF" "FA" "CD" lemon-chiffon] - ["AD" "D8" "E6" light-blue] - ["F0" "80" "80" light-coral] - ["E0" "FF" "FF" light-cyan] - ["FA" "FA" "D2" light-goldenrod-yellow] - ["D3" "D3" "D3" light-gray] - ["90" "EE" "90" light-green] - ["FF" "B6" "C1" light-pink] - ["FF" "A0" "7A" light-salmon] - ["20" "B2" "AA" light-sea-green] - ["87" "CE" "FA" light-sky-blue] - ["77" "88" "99" light-slate-gray] - ["B0" "C4" "DE" light-steel-blue] - ["FF" "FF" "E0" light-yellow] + ["FF" "F0" "F5" lavender_blush] + ["7C" "FC" "00" lawn_green] + ["FF" "FA" "CD" lemon_chiffon] + ["AD" "D8" "E6" light_blue] + ["F0" "80" "80" light_coral] + ["E0" "FF" "FF" light_cyan] + ["FA" "FA" "D2" light_goldenrod_yellow] + ["D3" "D3" "D3" light_gray] + ["90" "EE" "90" light_green] + ["FF" "B6" "C1" light_pink] + ["FF" "A0" "7A" light_salmon] + ["20" "B2" "AA" light_sea_green] + ["87" "CE" "FA" light_sky_blue] + ["77" "88" "99" light_slate_gray] + ["B0" "C4" "DE" light_steel_blue] + ["FF" "FF" "E0" light_yellow] ["00" "FF" "00" lime] - ["32" "CD" "32" lime-green] + ["32" "CD" "32" lime_green] ["FA" "F0" "E6" linen] ["FF" "00" "FF" magenta] ["80" "00" "00" maroon] - ["66" "CD" "AA" medium-aquamarine] - ["00" "00" "CD" medium-blue] - ["BA" "55" "D3" medium-orchid] - ["93" "70" "DB" medium-purple] - ["3C" "B3" "71" medium-sea-green] - ["7B" "68" "EE" medium-slate-blue] - ["00" "FA" "9A" medium-spring-green] - ["48" "D1" "CC" medium-turquoise] - ["C7" "15" "85" medium-violet-red] - ["19" "19" "70" midnight-blue] - ["F5" "FF" "FA" mint-cream] - ["FF" "E4" "E1" misty-rose] + ["66" "CD" "AA" medium_aquamarine] + ["00" "00" "CD" medium_blue] + ["BA" "55" "D3" medium_orchid] + ["93" "70" "DB" medium_purple] + ["3C" "B3" "71" medium_sea_green] + ["7B" "68" "EE" medium_slate_blue] + ["00" "FA" "9A" medium_spring_green] + ["48" "D1" "CC" medium_turquoise] + ["C7" "15" "85" medium_violet_red] + ["19" "19" "70" midnight_blue] + ["F5" "FF" "FA" mint_cream] + ["FF" "E4" "E1" misty_rose] ["FF" "E4" "B5" moccasin] - ["FF" "DE" "AD" navajo-white] + ["FF" "DE" "AD" navajo_white] ["00" "00" "80" navy] - ["FD" "F5" "E6" old-lace] + ["FD" "F5" "E6" old_lace] ["80" "80" "00" olive] - ["6B" "8E" "23" olive-drab] + ["6B" "8E" "23" olive_drab] ["FF" "A5" "00" orange] - ["FF" "45" "00" orange-red] + ["FF" "45" "00" orange_red] ["DA" "70" "D6" orchid] - ["EE" "E8" "AA" pale-goldenrod] - ["98" "FB" "98" pale-green] - ["AF" "EE" "EE" pale-turquoise] - ["DB" "70" "93" pale-violet-red] - ["FF" "EF" "D5" papaya-whip] - ["FF" "DA" "B9" peach-puff] + ["EE" "E8" "AA" pale_goldenrod] + ["98" "FB" "98" pale_green] + ["AF" "EE" "EE" pale_turquoise] + ["DB" "70" "93" pale_violet_red] + ["FF" "EF" "D5" papaya_whip] + ["FF" "DA" "B9" peach_puff] ["CD" "85" "3F" peru] ["FF" "C0" "CB" pink] ["DD" "A0" "DD" plum] - ["B0" "E0" "E6" powder-blue] + ["B0" "E0" "E6" powder_blue] ["80" "00" "80" purple] - ["66" "33" "99" rebecca-purple] + ["66" "33" "99" rebecca_purple] ["FF" "00" "00" red] - ["BC" "8F" "8F" rosy-brown] - ["41" "69" "E1" royal-blue] - ["8B" "45" "13" saddle-brown] + ["BC" "8F" "8F" rosy_brown] + ["41" "69" "E1" royal_blue] + ["8B" "45" "13" saddle_brown] ["FA" "80" "72" salmon] - ["F4" "A4" "60" sandy-brown] - ["2E" "8B" "57" sea-green] - ["FF" "F5" "EE" sea-shell] + ["F4" "A4" "60" sandy_brown] + ["2E" "8B" "57" sea_green] + ["FF" "F5" "EE" sea_shell] ["A0" "52" "2D" sienna] ["C0" "C0" "C0" silver] - ["87" "CE" "EB" sky-blue] - ["6A" "5A" "CD" slate-blue] - ["70" "80" "90" slate-gray] + ["87" "CE" "EB" sky_blue] + ["6A" "5A" "CD" slate_blue] + ["70" "80" "90" slate_gray] ["FF" "FA" "FA" snow] - ["00" "FF" "7F" spring-green] - ["46" "82" "B4" steel-blue] + ["00" "FF" "7F" spring_green] + ["46" "82" "B4" steel_blue] ["D2" "B4" "8C" tan] ["00" "80" "80" teal] ["D8" "BF" "D8" thistle] @@ -149,7 +149,7 @@ ["EE" "82" "EE" violet] ["F5" "DE" "B3" wheat] ["FF" "FF" "FF" white] - ["F5" "F5" "F5" white-smoke] + ["F5" "F5" "F5" white_smoke] ["FF" "FF" "00" yellow] - ["9A" "CD" "32" yellow-green] + ["9A" "CD" "32" yellow_green] ) diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index d32829e88..078331963 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -29,7 +29,7 @@ (def: mask (-> Size (I64 Any)) - (|>> (n.* i64.bits-per-byte) i64.mask)) + (|>> (n.* i64.bits_per_byte) i64.mask)) (type: #export Mutation (-> [Offset Binary] [Offset Binary])) @@ -37,7 +37,7 @@ (type: #export Specification [Size Mutation]) -(def: #export no-op +(def: #export no_op Specification [0 function.identity]) @@ -49,7 +49,7 @@ (Monoid Specification) (def: identity - ..no-op) + ..no_op) (def: (compose [sizeL mutL] [sizeR mutR]) [(n.+ sizeL sizeR) @@ -109,7 +109,7 @@ (def: #export any (Writer Any) - (function.constant ..no-op)) + (function.constant ..no_op)) (def: #export bit (Writer Bit) @@ -125,7 +125,7 @@ (def: #export frac (Writer Frac) - (|>> frac.to-bits ..bits/64)) + (|>> frac.to_bits ..bits/64)) (def: #export (segment size) (-> Nat (Writer Binary)) @@ -178,12 +178,12 @@ [(def: #export ( valueW) (All [v] (-> (Writer v) (Writer (Row v)))) (function (_ value) - (let [original-count (row.size value) - capped-count (i64.and (..mask ) - original-count) - value (if (n.= original-count capped-count) + (let [original_count (row.size value) + capped_count (i64.and (..mask ) + original_count) + value (if (n.= original_count capped_count) value - (|> value row.to-list (list.take capped-count) row.from-list)) + (|> value row.to_list (list.take capped_count) row.from_list)) (^open "specification\.") ..monoid [size mutation] (|> value (row\map valueW) @@ -195,7 +195,7 @@ (function (_ [offset binary]) (try.assume (do try.monad - [_ ( offset capped-count binary)] + [_ ( offset capped_count binary)] (wrap (mutation [(n.+ offset) binary])))))])))] [row/8 /.size/8 binary.write/8] @@ -216,7 +216,7 @@ (def: #export (set value) (All [a] (-> (Writer a) (Writer (Set a)))) - (|>> set.to-list (..list value))) + (|>> set.to_list (..list value))) (def: #export name (Writer Name) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 04b7a51d1..0ac868859 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,7 +1,7 @@ (.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." "For more information, please see: http://www.json.org/")} [lux #* - ["." meta (#+ monad with-gensyms)] + ["." meta (#+ monad with_gensyms)] [abstract [equivalence (#+ Equivalence)] [codec (#+ Codec)] @@ -61,7 +61,7 @@ (def: #export object (-> (List [String JSON]) JSON) - (|>> (dictionary.from-list text.hash) #..Object)) + (|>> (dictionary.from_list text.hash) #..Object)) (syntax: #export (json token) {#.doc (doc "A simple way to produce JSON literals." @@ -75,9 +75,9 @@ (let [(^open ".") ..monad wrapper (function (_ x) (` (..json (~ x))))] (case token - (^template [ ] - [[_ ( value)] - (wrap (list (` (: JSON ( (~ ( value)))))))]) + (^template [ ] + [[_ ( value)] + (wrap (list (` (: JSON ( (~ ( value)))))))]) ([#.Bit code.bit #..Boolean] [#.Frac code.frac #..Number] [#.Text code.text #..String]) @@ -93,13 +93,13 @@ [pairs' (monad.map ! (function (_ [slot value]) (case slot - [_ (#.Text key-name)] - (wrap (` [(~ (code.text key-name)) (~ (wrapper value))])) + [_ (#.Text key_name)] + (wrap (` [(~ (code.text key_name)) (~ (wrapper value))])) _ (meta.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#..Object ((~! dictionary.from-list) + (wrap (list (` (: JSON (#..Object ((~! dictionary.from_list) (~! text.hash) (list (~+ pairs'))))))))) @@ -155,11 +155,11 @@ (#try.Failure error) (#try.Failure error)))] - [get-boolean #Boolean Boolean "booleans"] - [get-number #Number Number "numbers"] - [get-string #String String "strings"] - [get-array #Array Array "arrays"] - [get-object #Object Object "objects"] + [get_boolean #Boolean Boolean "booleans"] + [get_number #Number Number "numbers"] + [get_string #String String "strings"] + [get_array #Array Array "arrays"] + [get_object #Object Object "objects"] ) (structure: #export equivalence @@ -206,17 +206,17 @@ ############################################################ ############################################################ -(def: (format-null _) +(def: (format_null _) (-> Null Text) "null") -(def: format-boolean +(def: format_boolean (-> Boolean Text) (|>> (case> #0 "false" #1 "true"))) -(def: format-number +(def: format_number (-> Number Text) (|>> (case> (^or +0.0 -0.0) "0.0" @@ -226,12 +226,12 @@ (|> raw (text.split 1) maybe.assume product.right)))))) (def: escape "\") -(def: escaped-dq (text\compose ..escape text.double-quote)) +(def: escaped_dq (text\compose ..escape text.double_quote)) -(def: format-string +(def: format_string (-> String Text) - (|>> (text.replace-all text.double-quote ..escaped-dq) - (text.enclose [text.double-quote text.double-quote]))) + (|>> (text.replace_all text.double_quote ..escaped_dq) + (text.enclose [text.double_quote text.double_quote]))) (template [ ] [(def: @@ -239,36 +239,36 @@ )] ["," separator] - [":" entry-separator] + [":" entry_separator] - ["[" open-array] - ["]" close-array] + ["[" open_array] + ["]" close_array] - ["{" open-object] - ["}" close-object] + ["{" open_object] + ["}" close_object] ) -(def: (format-array format) +(def: (format_array format) (-> (-> JSON Text) (-> Array Text)) (|>> (row\map format) - row.to-list - (text.join-with ..separator) - (text.enclose [..open-array ..close-array]))) + row.to_list + (text.join_with ..separator) + (text.enclose [..open_array ..close_array]))) -(def: (format-kv format [key value]) +(def: (format_kv format [key value]) (-> (-> JSON Text) (-> [String JSON] Text)) ($_ text\compose - (..format-string key) - ..entry-separator + (..format_string key) + ..entry_separator (format value) )) -(def: (format-object format) +(def: (format_object format) (-> (-> JSON Text) (-> Object Text)) (|>> dictionary.entries - (list\map (..format-kv format)) - (text.join-with ..separator) - (text.enclose [..open-object ..close-object]))) + (list\map (..format_kv format)) + (text.join_with ..separator) + (text.enclose [..open_object ..close_object]))) (def: #export (format json) (-> JSON Text) @@ -276,30 +276,30 @@ (^template [ ] [( value) ( value)]) - ([#Null ..format-null] - [#Boolean ..format-boolean] - [#Number ..format-number] - [#String ..format-string] - [#Array (..format-array format)] - [#Object (..format-object format)]) + ([#Null ..format_null] + [#Boolean ..format_boolean] + [#Number ..format_number] + [#String ..format_string] + [#Array (..format_array format)] + [#Object (..format_object format)]) )) ############################################################ ############################################################ ############################################################ -(def: parse-space +(def: parse_space (Parser Text) (.some .space)) -(def: parse-separator +(def: parse_separator (Parser [Text Any Text]) ($_ <>.and - ..parse-space + ..parse_space (.this ..separator) - ..parse-space)) + ..parse_space)) -(def: parse-null +(def: parse_null (Parser Null) (do <>.monad [_ (.this "null")] @@ -312,17 +312,17 @@ [_ (.this )] (wrap )))] - [parse-true "true" #1] - [parse-false "false" #0] + [parse_true "true" #1] + [parse_false "false" #0] ) -(def: parse-boolean +(def: parse_boolean (Parser Boolean) ($_ <>.either - ..parse-true - ..parse-false)) + ..parse_true + ..parse_false)) -(def: parse-number +(def: parse_number (Parser Number) (do {! <>.monad} [signed? (<>.parses? (.this "-")) @@ -333,7 +333,7 @@ (.many .decimal))) exp (<>.default "" (do ! - [mark (.one-of "eE") + [mark (.one_of "eE") signed?' (<>.parses? (.this "-")) offset (.many .decimal)] (wrap ($_ text\compose mark (if signed?' "-" "") offset))))] @@ -344,77 +344,77 @@ (#try.Success value) (wrap value)))) -(def: parse-escaped +(def: parse_escaped (Parser Text) ($_ <>.either (<>.after (.this "\t") (<>\wrap text.tab)) (<>.after (.this "\b") - (<>\wrap text.back-space)) + (<>\wrap text.back_space)) (<>.after (.this "\n") - (<>\wrap text.new-line)) + (<>\wrap text.new_line)) (<>.after (.this "\r") - (<>\wrap text.carriage-return)) + (<>\wrap text.carriage_return)) (<>.after (.this "\f") - (<>\wrap text.form-feed)) - (<>.after (.this (text\compose "\" text.double-quote)) - (<>\wrap text.double-quote)) + (<>\wrap text.form_feed)) + (<>.after (.this (text\compose "\" text.double_quote)) + (<>\wrap text.double_quote)) (<>.after (.this "\\") (<>\wrap "\")))) -(def: parse-string +(def: parse_string (Parser String) - (<| (.enclosed [text.double-quote text.double-quote]) + (<| (.enclosed [text.double_quote text.double_quote]) (loop [_ []]) (do {! <>.monad} - [chars (.some (.none-of (text\compose "\" text.double-quote))) + [chars (.some (.none_of (text\compose "\" text.double_quote))) stop .peek]) (if (text\= "\" stop) (do ! - [escaped parse-escaped - next-chars (recur [])] - (wrap ($_ text\compose chars escaped next-chars))) + [escaped parse_escaped + next_chars (recur [])] + (wrap ($_ text\compose chars escaped next_chars))) (wrap chars)))) -(def: (parse-kv parse-json) +(def: (parse_kv parse_json) (-> (Parser JSON) (Parser [String JSON])) (do <>.monad - [key ..parse-string - _ ..parse-space - _ (.this ..entry-separator) - _ ..parse-space - value parse-json] + [key ..parse_string + _ ..parse_space + _ (.this ..entry_separator) + _ ..parse_space + value parse_json] (wrap [key value]))) -(template [ ] - [(def: ( parse-json) +(template [ ] + [(def: ( parse_json) (-> (Parser JSON) (Parser )) (do <>.monad [_ (.this ) - _ parse-space - elems (<>.sep-by ..parse-separator ) - _ parse-space + _ parse_space + elems (<>.sep_by ..parse_separator ) + _ parse_space _ (.this )] (wrap ( elems))))] - [parse-array Array ..open-array ..close-array parse-json row.from-list] - [parse-object Object ..open-object ..close-object (parse-kv parse-json) (dictionary.from-list text.hash)] + [parse_array Array ..open_array ..close_array parse_json row.from_list] + [parse_object Object ..open_object ..close_object (parse_kv parse_json) (dictionary.from_list text.hash)] ) -(def: parse-json +(def: parse_json (Parser JSON) (<>.rec - (function (_ parse-json) + (function (_ parse_json) ($_ <>.or - parse-null - parse-boolean - parse-number - parse-string - (parse-array parse-json) - (parse-object parse-json))))) + parse_null + parse_boolean + parse_number + parse_string + (parse_array parse_json) + (parse_object parse_json))))) (structure: #export codec (Codec Text JSON) (def: encode ..format) - (def: decode (.run parse-json))) + (def: decode (.run parse_json))) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 0b55a77a2..16b801676 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -32,29 +32,29 @@ (type: Size Nat) -(def: octal-size Size 8) +(def: octal_size Size 8) -(def: (octal-padding max-size number) +(def: (octal_padding max_size number) (-> Size Text Text) - (let [padding-size (n.- (text.size number) - max-size) + (let [padding_size (n.- (text.size number) + max_size) padding (|> "0" - (list.repeat padding-size) - (text.join-with ""))] + (list.repeat padding_size) + (text.join_with ""))] (format padding number))) (def: blank " ") (def: null text.null) -(def: small-size Size 6) -(def: big-size Size 11) +(def: small_size Size 6) +(def: big_size Size 11) (template [ ] [(def: #export Nat - (|> ..octal-size + (|> ..octal_size (list.repeat ) (list\fold n.* 1) inc)) @@ -80,13 +80,13 @@ (def: (Writer ) (let [suffix - padded-size (n.+ (text.size suffix) )] + padded_size (n.+ (text.size suffix) )] (|>> :representation (\ n.octal encode) - (..octal-padding ) + (..octal_padding ) (text.suffix suffix) (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) (def: (-> Nat ) @@ -94,53 +94,53 @@ :abstraction)) )] - [not-a-small-number small-limit ..small-size - Small small from-small - small-writer (format ..blank ..null) - coerce-small] - [not-a-big-number big-limit ..big-size - Big big from-big - big-writer ..blank - coerce-big] + [not_a_small_number small_limit ..small_size + Small small from_small + small_writer (format ..blank ..null) + coerce_small] + [not_a_big_number big_limit ..big_size + Big big from_big + big_writer ..blank + coerce_big] ) -(exception: #export (wrong-character {expected Char} {actual Char}) +(exception: #export (wrong_character {expected Char} {actual Char}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) -(def: verify-small-suffix +(def: verify_small_suffix (Parser Any) (do <>.monad - [pre-end .bits/8 + [pre_end .bits/8 end .bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assert (exception.construct ..wrong-character [expected pre-end]) - (n.= expected pre-end))) + (<>.assert (exception.construct ..wrong_character [expected pre_end]) + (n.= expected pre_end))) _ (let [expected (`` (char (~~ (static ..null))))] - (<>.assert (exception.construct ..wrong-character [expected end]) + (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end)))] (wrap []))) -(def: small-parser +(def: small_parser (Parser Small) (do <>.monad - [digits (.segment ..small-size) + [digits (.segment ..small_size) digits (<>.lift (\ encoding.utf8 decode digits)) - _ ..verify-small-suffix] + _ ..verify_small_suffix] (<>.lift (do {! try.monad} [value (\ n.octal decode digits)] (..small value))))) -(def: big-parser +(def: big_parser (Parser Big) (do <>.monad - [digits (.segment ..big-size) + [digits (.segment ..big_size) digits (<>.lift (\ encoding.utf8 decode digits)) end .bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assert (exception.construct ..wrong-character [expected end]) + (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end)))] (<>.lift (do {! try.monad} @@ -150,58 +150,58 @@ (abstract: Checksum Text - (def: from-checksum + (def: from_checksum (-> Checksum Text) (|>> :representation)) - (def: dummy-checksum + (def: dummy_checksum Checksum (:abstraction " ")) - (def: checksum-suffix + (def: checksum_suffix (format ..blank ..null)) (def: checksum (-> Binary Nat) (binary.fold n.+ 0)) - (def: checksum-checksum - (|> ..dummy-checksum + (def: checksum_checksum + (|> ..dummy_checksum :representation (\ encoding.utf8 encode) ..checksum)) - (def: checksum-code + (def: checksum_code (-> Binary Checksum) (|>> ..checksum - ..coerce-small - ..from-small + ..coerce_small + ..from_small (\ n.octal encode) - (..octal-padding ..small-size) - (text.suffix ..checksum-suffix) + (..octal_padding ..small_size) + (text.suffix ..checksum_suffix) :abstraction)) - (def: checksum-writer + (def: checksum_writer (Writer Checksum) - (let [padded-size (n.+ (text.size ..checksum-suffix) - ..small-size)] + (let [padded_size (n.+ (text.size ..checksum_suffix) + ..small_size)] (|>> :representation (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) - (def: checksum-parser + (def: checksum_parser (Parser [Nat Checksum]) (do <>.monad - [ascii (.segment ..small-size) + [ascii (.segment ..small_size) digits (<>.lift (\ encoding.utf8 decode ascii)) - _ ..verify-small-suffix + _ ..verify_small_suffix value (<>.lift (\ n.octal decode digits))] (wrap [value - (:abstraction (format digits ..checksum-suffix))]))) + (:abstraction (format digits ..checksum_suffix))]))) ) -(def: last-ascii +(def: last_ascii Char (number.hex "007F")) @@ -210,17 +210,17 @@ (|>> (\ encoding.utf8 encode) (binary.fold (function (_ char verdict) (.and verdict - (n.<= ..last-ascii char))) + (n.<= ..last_ascii char))) true))) -(exception: #export (not-ascii {text Text}) +(exception: #export (not_ascii {text Text}) (exception.report ["Text" (%.text text)])) -(def: #export name-size Size 31) -(def: #export path-size Size 99) +(def: #export name_size Size 31) +(def: #export path_size Size 99) -(def: (un-pad string) +(def: (un_pad string) (-> Binary (Try Binary)) (case (binary.size string) 0 (#try.Success string) @@ -228,8 +228,8 @@ (case end 0 (#try.Success (\ encoding.utf8 encode "")) _ (do try.monad - [last-char (binary.read/8 end string)] - (`` (case (.nat last-char) + [last_char (binary.read/8 end string)] + (`` (case (.nat last_char) (^ (char (~~ (static ..null)))) (recur (dec end)) @@ -252,7 +252,7 @@ (if (|> value (\ encoding.utf8 encode) binary.size (n.<= )) (#try.Success (:abstraction value)) (exception.throw [value])) - (exception.throw ..not-ascii [value]))) + (exception.throw ..not_ascii [value]))) (def: #export (-> ) @@ -261,11 +261,11 @@ (def: (Writer ) (let [suffix ..null - padded-size (n.+ (text.size suffix) )] + padded_size (n.+ (text.size suffix) )] (|>> :representation (text.suffix suffix) (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) (def: (Parser ) @@ -273,11 +273,11 @@ [string (.segment ) end .bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assert (exception.construct ..wrong-character [expected end]) + _ (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end))] (<>.lift (do {! try.monad} - [ascii (..un-pad string) + [ascii (..un_pad string) text (\ encoding.utf8 decode ascii)] ( text))))) @@ -286,114 +286,114 @@ (try.assume ( ""))) )] - [Name Text ..name-size name-is-too-long name from-name name-writer name-parser anonymous] - [Path file.Path ..path-size path-is-too-long path from-path path-writer path-parser no-path] + [Name Text ..name_size name_is_too_long name from_name name_writer name_parser anonymous] + [Path file.Path ..path_size path_is_too_long path from_path path_writer path_parser no_path] ) -(def: magic-size Size 7) +(def: magic_size Size 7) (abstract: Magic Text (def: ustar (:abstraction "ustar ")) - (def: from-magic + (def: from_magic (-> Magic Text) (|>> :representation)) - (def: magic-writer + (def: magic_writer (Writer Magic) - (let [padded-size (n.+ (text.size ..null) - ..magic-size)] + (let [padded_size (n.+ (text.size ..null) + ..magic_size)] (|>> :representation (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) - (def: magic-parser + (def: magic_parser (Parser Magic) (do <>.monad - [string (.segment ..magic-size) + [string (.segment ..magic_size) end .bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assert (exception.construct ..wrong-character [expected end]) + _ (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end))] (<>.lift (\ try.monad map (|>> :abstraction) (\ encoding.utf8 decode string))))) ) -(def: block-size Size 512) +(def: block_size Size 512) -(def: owner-id-size ..small-size) +(def: owner_id_size ..small_size) -(def: blank-size Size (text.size ..blank)) -(def: null-size Size (text.size ..null)) -(def: mode-size Size ..small-size) -(def: content-size Size ..big-size) -(def: modification-time-size Size ..big-size) -(def: checksum-size Size ..small-size) -(def: link-flag-size Size 1) -(def: device-size Size ..small-size) +(def: blank_size Size (text.size ..blank)) +(def: null_size Size (text.size ..null)) +(def: mode_size Size ..small_size) +(def: content_size Size ..big_size) +(def: modification_time_size Size ..big_size) +(def: checksum_size Size ..small_size) +(def: link_flag_size Size 1) +(def: device_size Size ..small_size) -(def: small-number +(def: small_number (-> Size Size) - (|>> ($_ n.+ ..blank-size ..null-size))) + (|>> ($_ n.+ ..blank_size ..null_size))) -(def: big-number +(def: big_number (-> Size Size) - (|>> ($_ n.+ ..blank-size))) + (|>> ($_ n.+ ..blank_size))) (def: string (-> Size Size) - (|>> ($_ n.+ ..null-size))) + (|>> ($_ n.+ ..null_size))) -(def: header-size +(def: header_size ($_ n.+ ## name - (..string ..path-size) + (..string ..path_size) ## mode - (..small-number ..mode-size) + (..small_number ..mode_size) ## uid - (..small-number ..owner-id-size) + (..small_number ..owner_id_size) ## gid - (..small-number ..owner-id-size) + (..small_number ..owner_id_size) ## size - (..big-number ..content-size) + (..big_number ..content_size) ## mtime - (..big-number ..modification-time-size) + (..big_number ..modification_time_size) ## chksum - (..small-number ..checksum-size) + (..small_number ..checksum_size) ## linkflag - ..link-flag-size + ..link_flag_size ## linkname - (..string ..path-size) + (..string ..path_size) ## magic - (..string ..magic-size) + (..string ..magic_size) ## uname - (..string ..name-size) + (..string ..name_size) ## gname - (..string ..name-size) + (..string ..name_size) ## devmajor - (..small-number ..device-size) + (..small_number ..device_size) ## devminor - (..small-number ..device-size))) + (..small_number ..device_size))) -(abstract: Link-Flag +(abstract: Link_Flag Char - (def: link-flag - (-> Link-Flag Char) + (def: link_flag + (-> Link_Flag Char) (|>> :representation)) - (def: link-flag-writer - (Writer Link-Flag) + (def: link_flag_writer + (Writer Link_Flag) (|>> :representation format.bits/8)) - (with-expansions [ (as-is [0 old-normal] + (with_expansions [ (as_is [0 old_normal] [(char "0") normal] [(char "1") link] - [(char "2") symbolic-link] + [(char "2") symbolic_link] [(char "3") character] [(char "4") block] [(char "5") directory] @@ -401,29 +401,29 @@ [(char "7") contiguous])] (template [ ] [(def: - Link-Flag + Link_Flag (:abstraction ))] ) - (exception: #export (invalid-link-flag {value Nat}) + (exception: #export (invalid_link_flag {value Nat}) (exception.report ["Value" (%.nat value)])) - (def: link-flag-parser - (Parser Link-Flag) + (def: link_flag_parser + (Parser Link_Flag) (do <>.monad [linkflag .bits/8] (case (.nat linkflag) - (^template [ ] + (^template [ ] [(^ ) - (wrap )]) + (wrap )]) () _ (<>.lift - (exception.throw ..invalid-link-flag [(.nat linkflag)])))))) + (exception.throw ..invalid_link_flag [(.nat linkflag)])))))) ) (abstract: #export Mode @@ -439,34 +439,34 @@ (i64.or (:representation left) (:representation right)))) - (def: mode-writer + (def: mode_writer (Writer Mode) (|>> :representation ..small try.assume - ..small-writer)) + ..small_writer)) - (exception: #export (invalid-mode {value Nat}) + (exception: #export (invalid_mode {value Nat}) (exception.report ["Value" (%.nat value)])) - (with-expansions [ (as-is ["0000" none] + (with_expansions [ (as_is ["0000" none] - ["0001" execute-by-other] - ["0002" write-by-other] - ["0004" read-by-other] + ["0001" execute_by_other] + ["0002" write_by_other] + ["0004" read_by_other] - ["0010" execute-by-group] - ["0020" write-by-group] - ["0040" read-by-group] + ["0010" execute_by_group] + ["0020" write_by_group] + ["0040" read_by_group] - ["0100" execute-by-owner] - ["0200" write-by-owner] - ["0400" read-by-owner] + ["0100" execute_by_owner] + ["0200" write_by_owner] + ["0400" read_by_owner] - ["1000" save-text] - ["2000" set-group-id-on-execution] - ["4000" set-user-id-on-execution])] + ["1000" save_text] + ["2000" set_group_id_on_execution] + ["4000" set_user_id_on_execution])] (template [ ] [(def: #export Mode @@ -475,43 +475,43 @@ ) - (def: maximum-mode + (def: maximum_mode Mode ($_ and ..none - ..execute-by-other - ..write-by-other - ..read-by-other + ..execute_by_other + ..write_by_other + ..read_by_other - ..execute-by-group - ..write-by-group - ..read-by-group + ..execute_by_group + ..write_by_group + ..read_by_group - ..execute-by-owner - ..write-by-owner - ..read-by-owner + ..execute_by_owner + ..write_by_owner + ..read_by_owner - ..save-text - ..set-group-id-on-execution - ..set-user-id-on-execution + ..save_text + ..set_group_id_on_execution + ..set_user_id_on_execution )) - (def: mode-parser + (def: mode_parser (Parser Mode) (do {! <>.monad} - [value (\ ! map ..from-small ..small-parser)] - (if (n.<= (:representation ..maximum-mode) + [value (\ ! map ..from_small ..small_parser)] + (if (n.<= (:representation ..maximum_mode) value) (wrap (:abstraction value)) (<>.lift - (exception.throw ..invalid-mode [value])))))) + (exception.throw ..invalid_mode [value])))))) ) -(def: maximum-content-size +(def: maximum_content_size Nat - (|> ..octal-size - (list.repeat ..content-size) + (|> ..octal_size + (list.repeat ..content_size) (list\fold n.* 1))) (abstract: #export Content @@ -523,7 +523,7 @@ [size (..big (binary.size content))] (wrap (:abstraction [size content])))) - (def: from-content + (def: from_content (-> Content [Big Binary]) (|>> :representation)) @@ -535,9 +535,9 @@ (type: #export ID Small) -(def: #export no-id +(def: #export no_id ID - (..coerce-small 0)) + (..coerce_small 0)) (type: #export Owner {#name Name @@ -551,20 +551,20 @@ [Path Instant Mode Ownership Content]) (type: #export Normal File) -(type: #export Symbolic-Link Path) +(type: #export Symbolic_Link Path) (type: #export Directory Path) (type: #export Contiguous File) (type: #export Entry (#Normal ..Normal) - (#Symbolic-Link ..Symbolic-Link) + (#Symbolic_Link ..Symbolic_Link) (#Directory ..Directory) (#Contiguous ..Contiguous)) (type: #export Device Small) -(def: no-device +(def: no_device Device (try.assume (..small 0))) @@ -573,163 +573,163 @@ (def: (blocks size) (-> Big Nat) - (n.+ (n./ ..block-size - (..from-big size)) - (case (n.% ..block-size (..from-big size)) + (n.+ (n./ ..block_size + (..from_big size)) + (case (n.% ..block_size (..from_big size)) 0 0 _ 1))) -(def: rounded-content-size +(def: rounded_content_size (-> Big Nat) (|>> ..blocks - (n.* ..block-size))) + (n.* ..block_size))) (type: Header {#path Path #mode Mode - #user-id ID - #group-id ID + #user_id ID + #group_id ID #size Big - #modification-time Big + #modification_time Big #checksum Checksum - #link-flag Link-Flag - #link-name Path + #link_flag Link_Flag + #link_name Path #magic Magic - #user-name Name - #group-name Name - #major-device Device - #minor-device Device}) + #user_name Name + #group_name Name + #major_device Device + #minor_device Device}) -(def: header-writer' +(def: header_writer' (Writer Header) ($_ format.and - ..path-writer - ..mode-writer - ..small-writer - ..small-writer - ..big-writer - ..big-writer - ..checksum-writer - ..link-flag-writer - ..path-writer - ..magic-writer - ..name-writer - ..name-writer - ..small-writer - ..small-writer + ..path_writer + ..mode_writer + ..small_writer + ..small_writer + ..big_writer + ..big_writer + ..checksum_writer + ..link_flag_writer + ..path_writer + ..magic_writer + ..name_writer + ..name_writer + ..small_writer + ..small_writer )) -(def: (header-writer header) +(def: (header_writer header) (Writer Header) (let [checksum (|> header - (set@ #checksum ..dummy-checksum) - (format.run ..header-writer') - ..checksum-code)] + (set@ #checksum ..dummy_checksum) + (format.run ..header_writer') + ..checksum_code)] (|> header (set@ #checksum checksum) - (format.run ..header-writer') - (format.segment ..block-size)))) + (format.run ..header_writer') + (format.segment ..block_size)))) -(def: modification-time +(def: modification_time (-> Instant Big) (|>> instant.relative (duration.query duration.second) .nat - ..coerce-big)) + ..coerce_big)) -(def: (file-writer link-flag) - (-> Link-Flag (Writer File)) - (function (_ [path modification-time mode ownership content]) - (let [[size content] (..from-content content) +(def: (file_writer link_flag) + (-> Link_Flag (Writer File)) + (function (_ [path modification_time mode ownership content]) + (let [[size content] (..from_content content) writer ($_ format.and - ..header-writer - (format.segment (..rounded-content-size size)))] + ..header_writer + (format.segment (..rounded_content_size size)))] (writer [{#path path #mode mode - #user-id (get@ [#user #id] ownership) - #group-id (get@ [#group #id] ownership) + #user_id (get@ [#user #id] ownership) + #group_id (get@ [#group #id] ownership) #size size - #modification-time (..modification-time modification-time) - #checksum ..dummy-checksum - #link-flag link-flag - #link-name ..no-path + #modification_time (..modification_time modification_time) + #checksum ..dummy_checksum + #link_flag link_flag + #link_name ..no_path #magic ..ustar - #user-name (get@ [#user #name] ownership) - #group-name (get@ [#group #name] ownership) - #major-device ..no-device - #minor-device ..no-device} + #user_name (get@ [#user #name] ownership) + #group_name (get@ [#group #name] ownership) + #major_device ..no_device + #minor_device ..no_device} content])))) -(def: normal-file-writer +(def: normal_file_writer (Writer File) - (..file-writer ..normal)) + (..file_writer ..normal)) -(def: contiguous-file-writer +(def: contiguous_file_writer (Writer File) - (..file-writer ..contiguous)) + (..file_writer ..contiguous)) -(def: (symbolic-link-writer path) +(def: (symbolic_link_writer path) (Writer Path) - (..header-writer - {#path ..no-path + (..header_writer + {#path ..no_path #mode ..none - #user-id ..no-id - #group-id ..no-id - #size (..coerce-big 0) - #modification-time (..coerce-big 0) - #checksum ..dummy-checksum - #link-flag ..symbolic-link - #link-name path + #user_id ..no_id + #group_id ..no_id + #size (..coerce_big 0) + #modification_time (..coerce_big 0) + #checksum ..dummy_checksum + #link_flag ..symbolic_link + #link_name path #magic ..ustar - #user-name ..anonymous - #group-name ..anonymous - #major-device ..no-device - #minor-device ..no-device})) + #user_name ..anonymous + #group_name ..anonymous + #major_device ..no_device + #minor_device ..no_device})) -(def: (directory-writer path) +(def: (directory_writer path) (Writer Path) - (..header-writer + (..header_writer {#path path #mode ..none - #user-id ..no-id - #group-id ..no-id - #size (..coerce-big 0) - #modification-time (..coerce-big 0) - #checksum ..dummy-checksum - #link-flag ..directory - #link-name ..no-path + #user_id ..no_id + #group_id ..no_id + #size (..coerce_big 0) + #modification_time (..coerce_big 0) + #checksum ..dummy_checksum + #link_flag ..directory + #link_name ..no_path #magic ..ustar - #user-name ..anonymous - #group-name ..anonymous - #major-device ..no-device - #minor-device ..no-device})) + #user_name ..anonymous + #group_name ..anonymous + #major_device ..no_device + #minor_device ..no_device})) -(def: entry-writer +(def: entry_writer (Writer Entry) - (|>> (case> (#Normal value) (..normal-file-writer value) - (#Symbolic-Link value) (..symbolic-link-writer value) - (#Directory value) (..directory-writer value) - (#Contiguous value) (..contiguous-file-writer value)))) + (|>> (case> (#Normal value) (..normal_file_writer value) + (#Symbolic_Link value) (..symbolic_link_writer value) + (#Directory value) (..directory_writer value) + (#Contiguous value) (..contiguous_file_writer value)))) -(def: end-of-archive-size Size (n.* 2 ..block-size)) +(def: end_of_archive_size Size (n.* 2 ..block_size)) (def: #export writer (Writer Tar) - (let [end-of-archive (binary.create ..end-of-archive-size)] + (let [end_of_archive (binary.create ..end_of_archive_size)] (function (_ tar) (format\compose (row\fold (function (_ next total) - (format\compose total (..entry-writer next))) + (format\compose total (..entry_writer next))) format\identity tar) - (format.segment ..end-of-archive-size end-of-archive))))) + (format.segment ..end_of_archive_size end_of_archive))))) -(exception: #export (wrong-checksum {expected Nat} {actual Nat}) +(exception: #export (wrong_checksum {expected Nat} {actual Nat}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) -(def: header-padding-size - (n.- header-size block-size)) +(def: header_padding_size + (n.- header_size block_size)) ## When the checksum gets originally calculated, the assumption is that all the characters in the checksum field ## of the header will be spaces. @@ -737,132 +737,132 @@ ## an incorrect result, as the contents of the checksum field would be an actual checksum, instead of just spaces. ## To correct for this, it is necessary to calculate the checksum of just the checksum field, subtract that, and then ## add-in the checksum of the spaces. -(def: (expected-checksum checksum header) +(def: (expected_checksum checksum header) (-> Checksum Binary Nat) (let [|checksum| (|> checksum - ..from-checksum + ..from_checksum (\ encoding.utf8 encode) ..checksum)] (|> (..checksum header) (n.- |checksum|) - (n.+ ..checksum-checksum)))) + (n.+ ..checksum_checksum)))) -(def: header-parser +(def: header_parser (Parser Header) (do <>.monad - [binary-header (<>.speculative (.segment block-size)) - path ..path-parser - mode ..mode-parser - user-id ..small-parser - group-id ..small-parser - size ..big-parser - modification-time ..big-parser - [actual checksum-code] ..checksum-parser - _ (let [expected (expected-checksum checksum-code binary-header)] + [binary_header (<>.speculative (.segment block_size)) + path ..path_parser + mode ..mode_parser + user_id ..small_parser + group_id ..small_parser + size ..big_parser + modification_time ..big_parser + [actual checksum_code] ..checksum_parser + _ (let [expected (expected_checksum checksum_code binary_header)] (<>.lift - (exception.assert ..wrong-checksum [expected actual] + (exception.assert ..wrong_checksum [expected actual] (n.= expected actual)))) - link-flag ..link-flag-parser - link-name ..path-parser - magic ..magic-parser - user-name ..name-parser - group-name ..name-parser - major-device ..small-parser - minor-device ..small-parser - _ (.segment ..header-padding-size)] + link_flag ..link_flag_parser + link_name ..path_parser + magic ..magic_parser + user_name ..name_parser + group_name ..name_parser + major_device ..small_parser + minor_device ..small_parser + _ (.segment ..header_padding_size)] (wrap {#path path #mode mode - #user-id user-id - #group-id group-id + #user_id user_id + #group_id group_id #size size - #modification-time modification-time - #checksum checksum-code - #link-flag link-flag - #link-name link-name + #modification_time modification_time + #checksum checksum_code + #link_flag link_flag + #link_name link_name #magic magic - #user-name user-name - #group-name group-name - #major-device major-device - #minor-device minor-device}))) + #user_name user_name + #group_name group_name + #major_device major_device + #minor_device minor_device}))) -(exception: #export (wrong-link-flag {expected Link-Flag} {actual Link-Flag}) +(exception: #export (wrong_link_flag {expected Link_Flag} {actual Link_Flag}) (exception.report - ["Expected" (%.nat (..link-flag expected))] - ["Actual" (%.nat (..link-flag actual))])) + ["Expected" (%.nat (..link_flag expected))] + ["Actual" (%.nat (..link_flag actual))])) -(def: (file-parser expected) - (-> Link-Flag (Parser File)) +(def: (file_parser expected) + (-> Link_Flag (Parser File)) (do <>.monad - [header ..header-parser - _ (<>.assert (exception.construct ..wrong-link-flag [expected (get@ #link-flag header)]) - (is? expected (get@ #link-flag header))) + [header ..header_parser + _ (<>.assert (exception.construct ..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)] - content (.segment (..from-big size)) + rounded_size (..rounded_content_size size)] + content (.segment (..from_big size)) content (<>.lift (..content content)) - _ (.segment (n.- (..from-big size) rounded-size))] + _ (.segment (n.- (..from_big size) rounded_size))] (wrap [(get@ #path header) (|> header - (get@ #modification-time) - ..from-big + (get@ #modification_time) + ..from_big .int - duration.from-millis - (duration.scale-up (|> duration.second duration.to-millis .nat)) + duration.from_millis + (duration.scale_up (|> duration.second duration.to_millis .nat)) instant.absolute) (get@ #mode header) - {#user {#name (get@ #user-name header) - #id (get@ #user-id header)} - #group {#name (get@ #group-name header) - #id (get@ #group-id header)}} + {#user {#name (get@ #user_name header) + #id (get@ #user_id header)} + #group {#name (get@ #group_name header) + #id (get@ #group_id header)}} content]))) -(def: (file-name-parser expected extractor) - (-> Link-Flag (-> Header Path) (Parser Path)) +(def: (file_name_parser expected extractor) + (-> Link_Flag (-> Header Path) (Parser Path)) (do <>.monad - [header ..header-parser + [header ..header_parser _ (<>.lift - (exception.assert ..wrong-link-flag [expected (get@ #link-flag header)] - (n.= (..link-flag expected) - (..link-flag (get@ #link-flag header)))))] + (exception.assert ..wrong_link_flag [expected (get@ #link_flag header)] + (n.= (..link_flag expected) + (..link_flag (get@ #link_flag header)))))] (wrap (extractor header)))) -(def: entry-parser +(def: entry_parser (Parser Entry) ($_ <>.either (\ <>.monad map (|>> #..Normal) - (<>.either (..file-parser ..normal) - (..file-parser ..old-normal))) - (\ <>.monad map (|>> #..Symbolic-Link) - (..file-name-parser ..symbolic-link (get@ #link-name))) + (<>.either (..file_parser ..normal) + (..file_parser ..old_normal))) + (\ <>.monad map (|>> #..Symbolic_Link) + (..file_name_parser ..symbolic_link (get@ #link_name))) (\ <>.monad map (|>> #..Directory) - (..file-name-parser ..directory (get@ #path))) + (..file_name_parser ..directory (get@ #path))) (\ <>.monad map (|>> #..Contiguous) - (..file-parser ..contiguous)))) + (..file_parser ..contiguous)))) ## It's safe to implement the parser this way because the range of values for Nat is 2^64 ## Whereas the maximum possible value for the checksum of a 512 block is (256 × 512) = 131,072 -(def: end-of-archive-block-parser +(def: end_of_archive_block_parser (Parser Any) (do <>.monad - [block (.segment ..block-size)] + [block (.segment ..block_size)] (let [actual (..checksum block)] (<>.lift - (exception.assert ..wrong-checksum [0 actual] + (exception.assert ..wrong_checksum [0 actual] (n.= 0 actual)))))) -(exception: #export invalid-end-of-archive) +(exception: #export invalid_end_of_archive) -(def: end-of-archive-parser +(def: end_of_archive_parser (Parser Any) (do <>.monad - [_ (<>.at-most 2 end-of-archive-block-parser) + [_ (<>.at_most 2 end_of_archive_block_parser) done? .end?] (<>.lift - (exception.assert ..invalid-end-of-archive [] + (exception.assert ..invalid_end_of_archive [] done?)))) (def: #export parser (Parser Tar) - (|> (<>.some entry-parser) - (\ <>.monad map row.from-list) - (<>.before ..end-of-archive-parser))) + (|> (<>.some entry_parser) + (\ <>.monad map row.from_list) + (<>.before ..end_of_archive_parser))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 4f79fb4c9..8c040d828 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -36,20 +36,20 @@ (#Text Text) (#Node Tag Attrs (List XML))) -(def: namespace-separator +(def: namespace_separator ":") -(def: xml-standard-escape-char^ +(def: xml_standard_escape_char^ (Parser Text) ($_ <>.either (<>.after (.this "<") (<>\wrap "<")) (<>.after (.this ">") (<>\wrap ">")) (<>.after (.this "&") (<>\wrap "&")) (<>.after (.this "'") (<>\wrap "'")) - (<>.after (.this """) (<>\wrap text.double-quote)) + (<>.after (.this """) (<>\wrap text.double_quote)) )) -(def: xml-unicode-escape-char^ +(def: xml_unicode_escape_char^ (Parser Text) (|> (do <>.monad [hex? (<>.maybe (.this "x")) @@ -59,74 +59,74 @@ (#.Some _) (<>.codec int.decimal (.many .hexadecimal)))] - (wrap (|> code .nat text.from-code))) + (wrap (|> code .nat text.from_code))) (<>.before (.this ";")) (<>.after (.this "&#")))) -(def: xml-escape-char^ +(def: xml_escape_char^ (Parser Text) - (<>.either xml-standard-escape-char^ - xml-unicode-escape-char^)) + (<>.either xml_standard_escape_char^ + xml_unicode_escape_char^)) -(def: xml-char^ +(def: xml_char^ (Parser Text) - (<>.either (.none-of ($_ text\compose "<>&'" text.double-quote)) - xml-escape-char^)) + (<>.either (.none_of ($_ text\compose "<>&'" text.double_quote)) + xml_escape_char^)) -(def: xml-identifier +(def: xml_identifier (Parser Text) (do <>.monad - [head (<>.either (.one-of "_") + [head (<>.either (.one_of "_") .alpha) - tail (.some (<>.either (.one-of "_.-") - .alpha-num))] + tail (.some (<>.either (.one_of "_.-") + .alpha_num))] (wrap ($_ text\compose head tail)))) -(def: namespaced-symbol^ +(def: namespaced_symbol^ (Parser Name) (do <>.monad - [first-part xml-identifier - ?second-part (<| <>.maybe (<>.after (.this ..namespace-separator)) xml-identifier)] - (case ?second-part + [first_part xml_identifier + ?second_part (<| <>.maybe (<>.after (.this ..namespace_separator)) xml_identifier)] + (case ?second_part #.None - (wrap ["" first-part]) + (wrap ["" first_part]) - (#.Some second-part) - (wrap [first-part second-part])))) + (#.Some second_part) + (wrap [first_part second_part])))) -(def: tag^ namespaced-symbol^) -(def: attr-name^ namespaced-symbol^) +(def: tag^ namespaced_symbol^) +(def: attr_name^ namespaced_symbol^) (def: spaced^ (All [a] (-> (Parser a) (Parser a))) - (let [white-space^ (<>.some .space)] - (|>> (<>.before white-space^) - (<>.after white-space^)))) + (let [white_space^ (<>.some .space)] + (|>> (<>.before white_space^) + (<>.after white_space^)))) -(def: attr-value^ +(def: attr_value^ (Parser Text) - (let [value^ (.some xml-char^)] - (<>.either (.enclosed [text.double-quote text.double-quote] value^) + (let [value^ (.some xml_char^)] + (<>.either (.enclosed [text.double_quote text.double_quote] value^) (.enclosed ["'" "'"] value^)))) (def: attrs^ (Parser Attrs) - (<| (\ <>.monad map (dictionary.from-list name.hash)) + (<| (\ <>.monad map (dictionary.from_list name.hash)) <>.some - (<>.and (spaced^ attr-name^)) + (<>.and (spaced^ attr_name^)) (<>.after (.this "=")) - (spaced^ attr-value^))) + (spaced^ attr_value^))) -(def: (close-tag^ expected) +(def: (close_tag^ expected) (-> Tag (Parser [])) (do <>.monad [actual (|> tag^ spaced^ (<>.after (.this "/")) (.enclosed ["<" ">"]))] - (<>.assert ($_ text\compose "Close tag does not match open tag." text.new-line - "Expected: " (name\encode expected) text.new-line - " Actual: " (name\encode actual) text.new-line) + (<>.assert ($_ text\compose "Close tag does not match open tag." text.new_line + "Expected: " (name\encode expected) text.new_line + " Actual: " (name\encode actual) text.new_line) (name\= expected actual)))) (def: comment^ @@ -136,7 +136,7 @@ (.enclosed ["<--" "-->"]) spaced^)) -(def: xml-header^ +(def: xml_header^ (Parser Attrs) (|> (spaced^ attrs^) (<>.before (.this "?>")) @@ -154,12 +154,12 @@ (def: text^ (Parser XML) (|> (<>.either cdata^ - (..spaced^ (.many xml-char^))) + (..spaced^ (.many xml_char^))) (<>\map (|>> #Text)))) (def: null^ (Parser Any) - (.this (text.from-code 0))) + (.this (text.from_code 0))) (def: xml^ (Parser XML) @@ -171,60 +171,60 @@ [_ (.this "<") tag (spaced^ tag^) attrs (spaced^ attrs^) - #let [no-children^ (do <>.monad + #let [no_children^ (do <>.monad [_ (.this "/>")] (wrap (#Node tag attrs (list)))) - with-children^ (do <>.monad + with_children^ (do <>.monad [_ (.this ">") children (<>.some node^) - _ (close-tag^ tag)] + _ (close_tag^ tag)] (wrap (#Node tag attrs children)))]] - (<>.either no-children^ - with-children^)))))) + (<>.either no_children^ + with_children^)))))) ## This is put outside of the call to "rec" because comments ## cannot be located inside of XML nodes. ## This way, the comments can only be before or after the main document. (<>.before (<>.some comment^)) (<>.before (<>.some ..null^)) (<>.after (<>.some comment^)) - (<>.after (<>.maybe xml-header^)))) + (<>.after (<>.maybe xml_header^)))) (def: read (-> Text (Try XML)) (.run xml^)) -(def: (sanitize-value input) +(def: (sanitize_value input) (-> Text Text) (|> input - (text.replace-all "&" "&") - (text.replace-all "<" "<") - (text.replace-all ">" ">") - (text.replace-all "'" "'") - (text.replace-all text.double-quote """))) + (text.replace_all "&" "&") + (text.replace_all "<" "<") + (text.replace_all ">" ">") + (text.replace_all "'" "'") + (text.replace_all text.double_quote """))) (def: #export (tag [namespace name]) (-> Tag Text) (case namespace "" name - _ ($_ text\compose namespace ..namespace-separator name))) + _ ($_ text\compose namespace ..namespace_separator name))) (def: #export attribute (-> Attribute Text) ..tag) -(def: (write-attrs attrs) +(def: (write_attrs attrs) (-> Attrs Text) (|> attrs dictionary.entries (list\map (function (_ [key value]) - ($_ text\compose (..attribute key) "=" text.double-quote (sanitize-value value) text.double-quote))) - (text.join-with " "))) + ($_ text\compose (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) + (text.join_with " "))) -(def: xml-header +(def: xml_header Text (let [quote (: (-> Text Text) (function (_ value) - ($_ text\compose text.double-quote value text.double-quote)))] + ($_ text\compose text.double_quote value text.double_quote)))] ($_ text\compose " XML Text) ($_ text\compose - ..xml-header text.new-line + ..xml_header text.new_line (loop [prefix "" input input] (case input (#Text value) - (sanitize-value value) + (sanitize_value value) - (^ (#Node xml-tag xml-attrs (list (#Text value)))) - (let [tag (..tag xml-tag) - attrs (if (dictionary.empty? xml-attrs) + (^ (#Node xml_tag xml_attrs (list (#Text value)))) + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) "" - ($_ text\compose " " (..write-attrs xml-attrs)))] + ($_ text\compose " " (..write_attrs xml_attrs)))] ($_ text\compose prefix "<" tag attrs ">" - (sanitize-value value) + (sanitize_value value) "")) - (#Node xml-tag xml-attrs xml-children) - (let [tag (..tag xml-tag) - attrs (if (dictionary.empty? xml-attrs) + (#Node xml_tag xml_attrs xml_children) + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) "" - ($_ text\compose " " (..write-attrs xml-attrs)))] - (if (list.empty? xml-children) + ($_ text\compose " " (..write_attrs xml_attrs)))] + (if (list.empty? xml_children) ($_ text\compose prefix "<" tag attrs "/>") ($_ text\compose prefix "<" tag attrs ">" - (|> xml-children - (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new-line))) - (text.join-with "")) - text.new-line prefix ""))))) + (|> xml_children + (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new_line))) + (text.join_with "")) + text.new_line prefix ""))))) )) (structure: #export codec diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 87be68d66..d92050e90 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -11,7 +11,7 @@ ["s" code]] [concurrency ["." atom]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)]] [type @@ -30,15 +30,15 @@ _ (let [value (generator [])] - (exec (io.run (atom.compare-and-swap _ (#.Some value) cache)) + (exec (io.run (atom.compare_and_swap _ (#.Some value) cache)) value))))))) - (def: #export (thaw l-value) + (def: #export (thaw l_value) (All [a] (-> (Lazy a) a)) - ((:representation l-value) []))) + ((:representation l_value) []))) (syntax: #export (freeze expr) - (with-gensyms [g!_] + (with_gensyms [g!_] (wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr)))))))) (structure: #export (equivalence (^open "_\.")) diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux index c9a32cf6a..697987a16 100644 --- a/stdlib/source/lux/data/name.lux +++ b/stdlib/source/lux/data/name.lux @@ -38,18 +38,21 @@ (\ text.order < shortP shortS) (\ text.order < moduleP moduleS)))) +(def: separator + ".") + (structure: #export codec (Codec Text Name) (def: (encode [module short]) (case module "" short - _ ($_ text\compose module "." short))) + _ ($_ text\compose module ..separator short))) (def: (decode input) (if (text\= "" input) (#.Left (text\compose "Invalid format for Name: " input)) - (case (text.split-all-with "." input) + (case (text.split_all_with ..separator input) (^ (list short)) (#.Right ["" short]) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4ac7ed07b..dd7dba194 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,9 +12,9 @@ ["#." rev] ["#." frac]]) -(macro: (encoding-doc tokens state) +(macro: (encoding_doc tokens state) (case tokens - (^ (list [location (#.Text encoding)] example-1 example-2)) + (^ (list [location (#.Text encoding)] example_1 example_2)) (let [encoding ($_ "lux text concat" "Given syntax for a " encoding @@ -22,13 +22,13 @@ commas "Allows for the presence of commas among the digits." description [location (#.Text ($_ "lux text concat" encoding " " commas))]] (#try.Success [state (list (` (doc (~ description) - (~ example-1) - (~ example-2))))])) + (~ example_1) + (~ example_2))))])) _ - (#try.Failure "Wrong syntax for 'encoding-doc'."))) + (#try.Failure "Wrong syntax for 'encoding_doc'."))) -(def: (comma-prefixed? number) +(def: (comma_prefixed? number) (-> Text Bit) (case ("lux text index" 0 "," number) (#.Some 0) @@ -37,18 +37,18 @@ _ #0)) -(def: clean-commas +(def: clean_commas (-> Text Text) - (text.replace-all "," "")) + (text.replace_all "," "")) (template [ ] [(macro: #export ( tokens state) {#.doc } (case tokens (#.Cons [meta (#.Text repr')] #.Nil) - (if (comma-prefixed? repr') + (if (comma_prefixed? repr') (#try.Failure ) - (let [repr (clean-commas repr')] + (let [repr (clean_commas repr')] (case (\ decode repr) (#try.Success value) (#try.Success [state (list [meta (#.Nat value)])]) @@ -73,11 +73,11 @@ [bin /nat.binary /int.binary /rev.binary /frac.binary "Invalid binary syntax." - (encoding-doc "binary" (bin "11001001") (bin "11,00,10,01"))] + (encoding_doc "binary" (bin "11001001") (bin "11,00,10,01"))] [oct /nat.octal /int.octal /rev.octal /frac.octal "Invalid octal syntax." - (encoding-doc "octal" (oct "615243") (oct "615,243"))] + (encoding_doc "octal" (oct "615243") (oct "615,243"))] [hex /nat.hex /int.hex /rev.hex /frac.hex "Invalid hexadecimal syntax." - (encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))] + (encoding_doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))] ) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 306815880..500b9870a 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -45,9 +45,9 @@ (def: #export zero (..complex +0.0 +0.0)) -(def: #export (not-a-number? complex) - (or (f.not-a-number? (get@ #real complex)) - (f.not-a-number? (get@ #imaginary complex)))) +(def: #export (not_a_number? complex) + (or (f.not_a_number? (get@ #real complex)) + (f.not_a_number? (get@ #imaginary complex)))) (def: #export (= param input) (-> Complex Complex Bit) @@ -203,9 +203,9 @@ (def: #export (exp subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r-exp (math.exp real)] - {#real (f.* r-exp (math.cos imaginary)) - #imaginary (f.* r-exp (math.sin imaginary))})) + r_exp (math.exp real)] + {#real (f.* r_exp (math.cos imaginary)) + #imaginary (f.* r_exp (math.sin imaginary))})) (def: #export (log subject) (-> Complex Complex) @@ -222,7 +222,7 @@ [pow' Frac ..*'] ) -(def: (copy-sign sign magnitude) +(def: (copy_sign sign magnitude) (-> Frac Frac Frac) (f.* (f.signum sign) magnitude)) @@ -235,7 +235,7 @@ imaginary)} {#real (f./ (f.* +2.0 t) (f.abs imaginary)) - #imaginary (f.* t (..copy-sign imaginary +1.0))}))) + #imaginary (f.* t (..copy_sign imaginary +1.0))}))) (def: (root/2-1z input) (-> Complex Complex) @@ -287,27 +287,27 @@ (-> Nat Complex (List Complex)) (if (n.= 0 nth) (list) - (let [r-nth (|> nth .int int.frac) - nth-root-of-abs (|> input ..abs (math.pow (f./ r-nth +1.0))) - nth-phi (|> input ..argument (f./ r-nth)) - slice (|> math.pi (f.* +2.0) (f./ r-nth))] + (let [r_nth (|> nth .int int.frac) + nth_root_of_abs (|> input ..abs (math.pow (f./ r_nth +1.0))) + nth_phi (|> input ..argument (f./ r_nth)) + slice (|> math.pi (f.* +2.0) (f./ r_nth))] (|> (list.indices nth) (list\map (function (_ nth') (let [inner (|> nth' .int int.frac (f.* slice) - (f.+ nth-phi)) - real (f.* nth-root-of-abs + (f.+ nth_phi)) + real (f.* nth_root_of_abs (math.cos inner)) - imaginary (f.* nth-root-of-abs + imaginary (f.* nth_root_of_abs (math.sin inner))] {#real real #imaginary imaginary}))))))) -(def: #export (within? margin-of-error standard value) +(def: #export (within? margin_of_error standard value) (-> Frac Complex Complex Bit) - (and (f.within? margin-of-error + (and (f.within? margin_of_error (get@ #..real standard) (get@ #..real value)) - (f.within? margin-of-error + (f.within? margin_of_error (get@ #..imaginary standard) (get@ #..imaginary value)))) diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index e4f26154c..3e1fadc2e 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -92,8 +92,8 @@ ## else +1.0)) -(def: min-exponent -1022) -(def: max-exponent (//int.frac +1023)) +(def: min_exponent -1022) +(def: max_exponent (//int.frac +1023)) (template [ ] [(def: #export ( left right) @@ -115,21 +115,21 @@ (-> Frac Int) (|>> "lux f64 i64")) -(def: mantissa-size Nat 52) -(def: exponent-size Nat 11) +(def: mantissa_size Nat 52) +(def: exponent_size Nat 11) -(def: frac-denominator +(def: frac_denominator (|> -1 - ("lux i64 logical-right-shift" ..exponent-size) + ("lux i64 logical-right-shift" ..exponent_size) "lux i64 f64")) (def: #export rev (-> Frac Rev) (|>> ..abs (..% +1.0) - (..* ..frac-denominator) + (..* ..frac_denominator) "lux f64 i64" - ("lux i64 left-shift" ..exponent-size))) + ("lux i64 left-shift" ..exponent_size))) (structure: #export equivalence (Equivalence Frac) @@ -144,13 +144,13 @@ (def: #export smallest Frac - (math.pow (//int.frac (//int.- (.int ..mantissa-size) ..min-exponent)) + (math.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) +2.0)) (def: #export biggest Frac - (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa-size 0)) +2.0) - f2^+1023 (math.pow ..max-exponent +2.0)] + (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) + f2^+1023 (math.pow ..max_exponent +2.0)] (|> +2.0 (..- f2^-52) (..* f2^+1023)))) @@ -174,21 +174,21 @@ Frac (../ +0.0 ))] - [not-a-number +0.0 "Not a number."] - [positive-infinity +1.0 "Positive infinity."] - [negative-infinity -1.0 "Negative infinity."] + [not_a_number +0.0 "Not a number."] + [positive_infinity +1.0 "Positive infinity."] + [negative_infinity -1.0 "Negative infinity."] ) -(def: #export (not-a-number? number) +(def: #export (not_a_number? number) {#.doc "Tests whether a frac is actually not-a-number."} (-> Frac Bit) (not (..= number number))) (def: #export (number? value) (-> Frac Bit) - (not (or (..not-a-number? value) - (..= ..positive-infinity value) - (..= ..negative-infinity value)))) + (not (or (..not_a_number? value) + (..= ..positive_infinity value) + (..= ..negative_infinity value)))) (structure: #export decimal (Codec Text Frac) @@ -196,7 +196,7 @@ (def: (encode x) (case x -0.0 (let [output ("lux f64 encode" x)] - (if (text.starts-with? "-" output) + (if (text.starts_with? "-" output) output ("lux text concat" "+" output))) _ (if (..< +0.0 x) @@ -216,103 +216,103 @@ (|>> math.log (../ (math.log +2.0)))) -(def: double-bias Nat 1023) +(def: double_bias Nat 1023) -(def: exponent-mask (//i64.mask ..exponent-size)) +(def: exponent_mask (//i64.mask ..exponent_size)) -(def: exponent-offset ..mantissa-size) -(def: sign-offset (//nat.+ ..exponent-size ..exponent-offset)) +(def: exponent_offset ..mantissa_size) +(def: sign_offset (//nat.+ ..exponent_size ..exponent_offset)) (template [ ] [(def: (|> (\ //nat.hex decode) try.assume ))] - [.i64 "FFF8000000000000" not-a-number-bits] - [.i64 "7FF0000000000000" positive-infinity-bits] - [.i64 "FFF0000000000000" negative-infinity-bits] - [.i64 "0000000000000000" positive-zero-bits] - [.i64 "8000000000000000" negative-zero-bits] - [.nat "7FF" special-exponent-bits] + [.i64 "FFF8000000000000" not_a_number_bits] + [.i64 "7FF0000000000000" positive_infinity_bits] + [.i64 "FFF0000000000000" negative_infinity_bits] + [.i64 "0000000000000000" positive_zero_bits] + [.i64 "8000000000000000" negative_zero_bits] + [.nat "7FF" special_exponent_bits] ) -(def: smallest-exponent +(def: smallest_exponent (..log/2 ..smallest)) -(def: #export (to-bits input) +(def: #export (to_bits input) (-> Frac I64) - (.i64 (cond (..not-a-number? input) - ..not-a-number-bits + (.i64 (cond (..not_a_number? input) + ..not_a_number_bits - (..= positive-infinity input) - ..positive-infinity-bits + (..= positive_infinity input) + ..positive_infinity_bits - (..= negative-infinity input) - ..negative-infinity-bits + (..= negative_infinity input) + ..negative_infinity_bits (..= +0.0 input) (let [reciprocal (../ input +1.0)] - (if (..= positive-infinity reciprocal) + (if (..= positive_infinity reciprocal) ## Positive zero - ..positive-zero-bits + ..positive_zero_bits ## Negative zero - ..negative-zero-bits)) + ..negative_zero_bits)) ## else - (let [sign-bit (if (..< -0.0 input) + (let [sign_bit (if (..< -0.0 input) 1 0) input (..abs input) exponent (|> input ..log/2 math.floor - (..min ..max-exponent)) - min-gap (..- (//int.frac ..min-exponent) exponent) - power (|> (//nat.frac ..mantissa-size) - (..+ (..min +0.0 min-gap)) + (..min ..max_exponent)) + min_gap (..- (//int.frac ..min_exponent) exponent) + power (|> (//nat.frac ..mantissa_size) + (..+ (..min +0.0 min_gap)) (..- exponent)) - max-gap (..- ..max-exponent power) + max_gap (..- ..max_exponent power) mantissa (|> input - (..* (math.pow (..min ..max-exponent power) +2.0)) - (..* (if (..> +0.0 max-gap) - (math.pow max-gap +2.0) + (..* (math.pow (..min ..max_exponent power) +2.0)) + (..* (if (..> +0.0 max_gap) + (math.pow max_gap +2.0) +1.0))) - exponent-bits (|> (if (..< +0.0 min-gap) + exponent_bits (|> (if (..< +0.0 min_gap) (|> (..int exponent) - (//int.- (..int min-gap)) + (//int.- (..int min_gap)) dec) (..int exponent)) - (//int.+ (.int ..double-bias)) - (//i64.and ..exponent-mask)) - mantissa-bits (..int mantissa)] + (//int.+ (.int ..double_bias)) + (//i64.and ..exponent_mask)) + mantissa_bits (..int mantissa)] ($_ //i64.or - (//i64.left-shift ..sign-offset sign-bit) - (//i64.left-shift ..exponent-offset exponent-bits) - (//i64.clear ..mantissa-size mantissa-bits))) + (//i64.left_shift ..sign_offset sign_bit) + (//i64.left_shift ..exponent_offset exponent_bits) + (//i64.clear ..mantissa_size mantissa_bits))) ))) (template [ ] [(def: (-> (I64 Any) I64) - (let [mask (|> 1 (//i64.left-shift ) dec (//i64.left-shift ))] - (|>> (//i64.and mask) (//i64.logic-right-shift ) .i64)))] + (let [mask (|> 1 (//i64.left_shift ) dec (//i64.left_shift ))] + (|>> (//i64.and mask) (//i64.logic_right_shift ) .i64)))] - [mantissa ..mantissa-size 0] - [exponent ..exponent-size ..mantissa-size] - [sign 1 ..sign-offset] + [mantissa ..mantissa_size 0] + [exponent ..exponent_size ..mantissa_size] + [sign 1 ..sign_offset] ) -(def: #export (from-bits input) +(def: #export (from_bits input) (-> I64 Frac) (case [(: Nat (..exponent input)) (: Nat (..mantissa input)) (: Nat (..sign input))] - (^ [(static ..special-exponent-bits) 0 0]) - ..positive-infinity + (^ [(static ..special_exponent_bits) 0 0]) + ..positive_infinity - (^ [(static ..special-exponent-bits) 0 1]) - ..negative-infinity + (^ [(static ..special_exponent_bits) 0 1]) + ..negative_infinity - (^ [(static ..special-exponent-bits) _ _]) - ..not-a-number + (^ [(static ..special_exponent_bits) _ _]) + ..not_a_number ## Positive zero [0 0 0] +0.0 @@ -323,23 +323,23 @@ (let [sign (if (//nat.= 0 S) +1.0 -1.0) - [mantissa power] (if (//nat.< ..mantissa-size E) + [mantissa power] (if (//nat.< ..mantissa_size E) [(if (//nat.= 0 E) M - (//i64.set ..mantissa-size M)) + (//i64.set ..mantissa_size M)) (|> E - (//nat.- ..double-bias) + (//nat.- ..double_bias) .int - (//int.max ..min-exponent) - (//int.- (.int ..mantissa-size)))] - [(//i64.set ..mantissa-size M) - (|> E (//nat.- ..double-bias) (//nat.- ..mantissa-size) .int)]) + (//int.max ..min_exponent) + (//int.- (.int ..mantissa_size)))] + [(//i64.set ..mantissa_size M) + (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)]) exponent (math.pow (//int.frac power) +2.0)] (|> (//nat.frac mantissa) (..* exponent) (..* sign))))) -(def: (split-exponent codec representation) +(def: (split_exponent codec representation) (-> (Codec Text Nat) Text (Try [Text Int])) (case [("lux text index" 0 "e+" representation) ("lux text index" 0 "E+" representation) @@ -349,14 +349,14 @@ [ (do try.monad [exponent (|> representation - ("lux text clip" (//nat.+ 2 split-index) ("lux text size" representation)) + ("lux text clip" (//nat.+ 2 split_index) ("lux text size" representation)) (\ codec decode))] - (wrap [("lux text clip" 0 split-index representation) + (wrap [("lux text clip" 0 split_index representation) (//int.* (.int exponent))]))]) - ([+1 (^or [(#.Some split-index) #.None #.None #.None] - [#.None (#.Some split-index) #.None #.None])] - [-1 (^or [#.None #.None (#.Some split-index) #.None] - [#.None #.None #.None (#.Some split-index)])]) + ([+1 (^or [(#.Some split_index) #.None #.None #.None] + [#.None (#.Some split_index) #.None #.None])] + [-1 (^or [#.None #.None (#.Some split_index) #.None] + [#.None #.None #.None (#.Some split_index)])]) _ (#try.Success [representation +0]))) @@ -366,9 +366,9 @@ (Codec Text Frac) (def: (encode value) - (let [bits (..to-bits value) + (let [bits (..to_bits value) mantissa (..mantissa bits) - exponent (//int.- (.int ..double-bias) (..exponent bits)) + exponent (//int.- (.int ..double_bias) (..exponent bits)) sign (..sign bits)] ($_ "lux text concat" (case (.nat sign) @@ -380,18 +380,18 @@ (\ encode exponent)))) (def: (decode representation) - (let [negative? (text.starts-with? "-" representation) - positive? (text.starts-with? "+" representation)] + (let [negative? (text.starts_with? "-" representation) + positive? (text.starts_with? "+" representation)] (if (or negative? positive?) (do {! try.monad} - [[mantissa exponent] (..split-exponent representation) + [[mantissa exponent] (..split_exponent representation) [whole decimal] (case ("lux text index" 0 "." mantissa) - (#.Some split-index) + (#.Some split_index) (do ! [decimal (|> mantissa - ("lux text clip" (inc split-index) ("lux text size" mantissa)) + ("lux text clip" (inc split_index) ("lux text size" mantissa)) (\ decode))] - (wrap [("lux text clip" 0 split-index mantissa) + (wrap [("lux text clip" 0 split_index mantissa) decimal])) #.None @@ -401,11 +401,11 @@ 0 whole _ ("lux text concat" whole (\ encode decimal)))) #let [sign (if negative? 1 0)]] - (wrap (..from-bits + (wrap (..from_bits ($_ //i64.or - (//i64.left-shift ..sign-offset (.i64 sign)) - (//i64.left-shift ..mantissa-size (.i64 (//int.+ (.int ..double-bias) exponent))) - (//i64.clear ..mantissa-size (.i64 mantissa)))))) + (//i64.left_shift ..sign_offset (.i64 sign)) + (//i64.left_shift ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) + (//i64.clear ..mantissa_size (.i64 mantissa)))))) (#try.Failure ("lux text concat" representation))))))] [binary //nat.binary //int.binary "Invalid binary syntax: "] @@ -417,14 +417,14 @@ (Hash Frac) (def: &equivalence ..equivalence) - (def: hash ..to-bits)) + (def: hash ..to_bits)) -(def: #export (within? margin-of-error standard value) +(def: #export (within? margin_of_error standard value) (-> Frac Frac Frac Bit) (|> value (..- standard) ..abs - (..< margin-of-error))) + (..< margin_of_error))) (def: #export (mod divisor dividend) (All [m] (-> Frac Frac Frac)) diff --git a/stdlib/source/lux/data/number/i16.lux b/stdlib/source/lux/data/number/i16.lux index 4ca313730..9168b5925 100644 --- a/stdlib/source/lux/data/number/i16.lux +++ b/stdlib/source/lux/data/number/i16.lux @@ -4,13 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] [// ["." i64 (#+ Sub)]]) (def: sub (maybe.assume (i64.sub 16))) -(def: #export I16 (:by-example [size] +(def: #export I16 (:by_example [size] {(Sub size) ..sub} (I64 size))) diff --git a/stdlib/source/lux/data/number/i32.lux b/stdlib/source/lux/data/number/i32.lux index 35391519b..3a1811b81 100644 --- a/stdlib/source/lux/data/number/i32.lux +++ b/stdlib/source/lux/data/number/i32.lux @@ -4,13 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] [// ["." i64 (#+ Sub)]]) (def: sub (maybe.assume (i64.sub 32))) -(def: #export I32 (:by-example [size] +(def: #export I32 (:by_example [size] {(Sub size) ..sub} (I64 size))) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index ea4b1987f..71bb8ef2b 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -10,30 +10,30 @@ [number ["n" nat]]]]) -(def: #export bits-per-byte +(def: #export bits_per_byte 8) -(def: #export bytes-per-i64 +(def: #export bytes_per_i64 8) (def: #export width Nat - (n.* ..bits-per-byte - ..bytes-per-i64)) + (n.* ..bits_per_byte + ..bytes_per_i64)) -(template [ ] +(template [ ] [(def: #export ( parameter subject) {#.doc } - (All [s] (-> (I64 s) (I64 s))) + (All [s] (-> (I64 s) (I64 s))) ( parameter subject))] [(I64 Any) or "lux i64 or" "Bitwise or."] [(I64 Any) xor "lux i64 xor" "Bitwise xor."] [(I64 Any) and "lux i64 and" "Bitwise and."] - [Nat left-shift "lux i64 left-shift" "Bitwise left-shift."] - [Nat logic-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] - [Nat arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] + [Nat left_shift "lux i64 left-shift" "Bitwise left-shift."] + [Nat logic_right_shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] + [Nat arithmetic_right_shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] ) (def: #export not @@ -52,37 +52,37 @@ Mask (..not ..false)) -(def: #export (mask amount-of-bits) +(def: #export (mask amount_of_bits) (-> Nat Mask) - (case amount-of-bits + (case amount_of_bits 0 ..false bits (case (n.% ..width bits) 0 ..true - bits (|> 1 .i64 (..left-shift (n.% ..width bits)) .dec)))) + bits (|> 1 .i64 (..left_shift (n.% ..width bits)) .dec)))) (def: #export (bit position) (-> Nat Mask) - (|> 1 .i64 (..left-shift (n.% ..width position)))) + (|> 1 .i64 (..left_shift (n.% ..width position)))) (def: #export sign Mask (..bit (dec ..width))) -(def: (add-shift shift value) +(def: (add_shift shift value) (-> Nat Nat Nat) - (|> value (logic-right-shift shift) (n.+ value))) + (|> value (logic_right_shift shift) (n.+ value))) (def: #export (count subject) {#.doc "Count the number of 1s in a bit-map."} (-> (I64 Any) Nat) - (let [count' (n.- (|> subject (logic-right-shift 1) (..and 6148914691236517205) i64) + (let [count' (n.- (|> subject (logic_right_shift 1) (..and 6148914691236517205) i64) (i64 subject))] (|> count' - (logic-right-shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count')) - (add-shift 4) (..and 1085102592571150095) - (add-shift 8) - (add-shift 16) - (add-shift 32) + (logic_right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count')) + (add_shift 4) (..and 1085102592571150095) + (add_shift 8) + (add_shift 16) + (add_shift 32) (..and 127)))) (def: #export (clear idx input) @@ -111,18 +111,18 @@ (template [
] [(def: #export ( distance input) (All [s] (-> Nat (I64 s) (I64 s))) - (let [backwards-distance (n.- (n.% width distance) width)] + (let [backwards_distance (n.- (n.% width distance) width)] (|> input - ( backwards-distance) + ( backwards_distance) (..or (
distance input)))))] - [rotate-left left-shift logic-right-shift] - [rotate-right logic-right-shift left-shift] + [rotate_left left_shift logic_right_shift] + [rotate_right logic_right_shift left_shift] ) (def: #export (region size offset) (-> Nat Nat Mask) - (..left-shift offset (..mask size))) + (..left_shift offset (..mask size))) (structure: #export equivalence (All [a] (Equivalence (I64 a))) @@ -152,10 +152,10 @@ [(def: (All [a] (-> (I64 a) (I64 a))) (let [high (try.assume (\ n.binary decode )) - low (..rotate-right high)] + low (..rotate_right high)] (function (_ value) - (..or (..logic-right-shift (..and high value)) - (..left-shift (..and low value))))))] + (..or (..logic_right_shift (..and high value)) + (..left_shift (..and low value))))))] [swap/32 32 "1111111111111111111111111111111100000000000000000000000000000000"] [swap/16 16 "1111111111111111000000000000000011111111111111110000000000000000"] @@ -188,19 +188,19 @@ (Ex [size] (-> Nat (Maybe (Sub size)))) (if (.and (n.> 0 width) (n.< ..width width)) - (let [sign-shift (n.- width ..width) + (let [sign_shift (n.- width ..width) sign (..bit (dec width)) mantissa (..mask (dec width)) - co-mantissa (..xor (.i64 -1) mantissa)] + co_mantissa (..xor (.i64 -1) mantissa)] (#.Some (: Sub (structure (def: &equivalence ..equivalence) (def: width width) (def: (narrow value) - (..or (|> value (..and ..sign) (..logic-right-shift sign-shift)) + (..or (|> value (..and ..sign) (..logic_right_shift sign_shift)) (|> value (..and mantissa)))) (def: (widen value) (.i64 (case (.nat (..and sign value)) 0 value - _ (..or co-mantissa value)))))))) + _ (..or co_mantissa value)))))))) #.None)) diff --git a/stdlib/source/lux/data/number/i8.lux b/stdlib/source/lux/data/number/i8.lux index 49b9cca95..bea35ff22 100644 --- a/stdlib/source/lux/data/number/i8.lux +++ b/stdlib/source/lux/data/number/i8.lux @@ -4,13 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] [// ["." i64 (#+ Sub)]]) (def: sub (maybe.assume (i64.sub 8))) -(def: #export I8 (:by-example [size] +(def: #export I8 (:by_example [size] {(Sub size) ..sub} (I64 size))) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index ea942bde5..8d24d729d 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -169,12 +169,12 @@ (def: &enum ..enum) (def: top ## +9,223,372,036,854,775,807 - (let [half (//i64.left-shift 62 +1)] + (let [half (//i64.left_shift 62 +1)] (+ half (dec half)))) (def: bottom ## -9,223,372,036,854,775,808 - (//i64.left-shift 63 +1))) + (//i64.left_shift 63 +1))) (template [ ] [(structure: #export @@ -202,18 +202,18 @@ (|> value .nat (\ encode) ("lux text concat" ..+sign)))) (def: (decode repr) - (let [input-size ("lux text size" repr)] - (if (//nat.> 1 input-size) + (let [input_size ("lux text size" repr)] + (if (//nat.> 1 input_size) (case ("lux text clip" 0 1 repr) (^ (static ..+sign)) (|> repr - ("lux text clip" 1 input-size) + ("lux text clip" 1 input_size) (\ decode) (\ try.functor map .int)) (^ (static ..-sign)) (|> repr - ("lux text clip" 1 input-size) + ("lux text clip" 1 input_size) (\ decode) (\ try.functor map (|>> dec .int ..negate dec))) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 0d67bd3d6..943e10a87 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -139,7 +139,7 @@ ($_ text\compose (n\encode numerator) ..separator (n\encode denominator))) (def: (decode input) - (case (text.split-with ..separator input) + (case (text.split_with ..separator input) (#.Some [num denom]) (do try.monad [numerator (n\decode num) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index cc3dce828..36436bf99 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -22,7 +22,7 @@ (template [ ] [(def: #export Rev - (.rev (//i64.left-shift (//nat.- //i64.width) 1)))] + (.rev (//i64.left_shift (//nat.- //i64.width) 1)))] [01 /2] [02 /4] @@ -117,40 +117,40 @@ ..high ("lux i64 +" top)))) -(def: even-one (//i64.rotate-right 1 1)) -(def: odd-one (dec 0)) +(def: even_one (//i64.rotate_right 1 1)) +(def: odd_one (dec 0)) -(def: (even-reciprocal numerator) +(def: (even_reciprocal numerator) (-> Nat Nat) - (//nat./ (//i64.logic-right-shift 1 numerator) - ..even-one)) + (//nat./ (//i64.logic_right_shift 1 numerator) + ..even_one)) -(def: (odd-reciprocal numerator) +(def: (odd_reciprocal numerator) (-> Nat Nat) - (//nat./ numerator ..odd-one)) + (//nat./ numerator ..odd_one)) -(with-expansions [ 1] +(with_expansions [ 1] (def: #export (reciprocal numerator) {#.doc "Rev(olution) reciprocal of a Nat(ural)."} (-> Nat Rev) - (.rev (case (: Nat ("lux i64 and" numerator)) - 0 (..even-reciprocal numerator) - _ (..odd-reciprocal numerator)))) + (.rev (case (: Nat ("lux i64 and" numerator)) + 0 (..even_reciprocal numerator) + _ (..odd_reciprocal numerator)))) (def: #export (/ param subject) {#.doc "Rev(olution) division."} (-> Rev Rev Rev) (if ("lux i64 =" +0 param) (error! "Cannot divide Rev by zero!") - (let [reciprocal (case (: Nat ("lux i64 and" param)) - 0 (..even-reciprocal (.nat param)) - _ (..odd-reciprocal (.nat param)))] + (let [reciprocal (case (: Nat ("lux i64 and" param)) + 0 (..even_reciprocal (.nat param)) + _ (..odd_reciprocal (.nat param)))] (.rev (//nat.* reciprocal (.nat subject))))))) -(template [ ] +(template [ ] [(def: #export ( param subject) {#.doc } - (-> Rev Rev ) + (-> Rev Rev ) ( ( (.nat param) (.nat subject))))] [//nat.% % .rev Rev "Rev(olution) remainder."] @@ -176,12 +176,12 @@ (|>> ("lux i64 logical-right-shift" 11) "lux i64 f64")) -(def: frac-denominator +(def: frac_denominator (..mantissa -1)) (def: #export frac (-> Rev Frac) - (|>> ..mantissa ("lux f64 /" ..frac-denominator))) + (|>> ..mantissa ("lux f64 /" ..frac_denominator))) (structure: #export equivalence (Equivalence Rev) @@ -226,47 +226,47 @@ [minimum ..min top] ) -(def: (de-prefix input) +(def: (de_prefix input) (-> Text Text) ("lux text clip" 1 ("lux text size" input) input)) -(template [ ] - [(with-expansions [ (as-is (#try.Failure ("lux text concat" repr)))] +(template [ ] + [(with_expansions [ (as_is (#try.Failure ("lux text concat" repr)))] (structure: #export (Codec Text Rev) (def: (encode value) - (let [raw-output (\ encode (.nat value)) - max-num-chars (//nat.+ (//nat./ //i64.width) - (case (//nat.% //i64.width) + (let [raw_output (\ encode (.nat value)) + max_num_chars (//nat.+ (//nat./ //i64.width) + (case (//nat.% //i64.width) 0 0 _ 1)) - raw-size ("lux text size" raw-output) - zero-padding (loop [zeroes-left (//nat.- raw-size max-num-chars) + raw_size ("lux text size" raw_output) + zero_padding (loop [zeroes_left (//nat.- raw_size max_num_chars) output ""] - (if (//nat.= 0 zeroes-left) + (if (//nat.= 0 zeroes_left) output - (recur (dec zeroes-left) + (recur (dec zeroes_left) ("lux text concat" "0" output))))] - (|> raw-output - ("lux text concat" zero-padding) + (|> raw_output + ("lux text concat" zero_padding) ("lux text concat" ".")))) (def: (decode repr) - (let [repr-size ("lux text size" repr)] - (if (//nat.> 1 repr-size) + (let [repr_size ("lux text size" repr)] + (if (//nat.> 1 repr_size) (case ("lux text char" 0 repr) (^ (char ".")) - (case (\ decode (de-prefix repr)) + (case (\ decode (de_prefix repr)) (#try.Success output) (#try.Success (.rev output)) _ - ) + ) _ - ) - )))))] + ) + )))))] [binary //nat.binary 1 "Invalid binary syntax: "] [octal //nat.octal 3 "Invalid octal syntax: "] @@ -301,7 +301,7 @@ (-> Text Text Text) ("lux text concat" left right)) -(def: (digits::times-5! idx output) +(def: (digits::times_5! idx output) (-> Nat Digits Digits) (loop [idx idx carry 0 @@ -322,25 +322,25 @@ (digits::put power 1))] (if (//int.>= +0 (.int times)) (recur (dec times) - (digits::times-5! power output)) + (digits::times_5! power output)) output))) (def: (digits::format digits) (-> Digits Text) (loop [idx (dec //i64.width) - all-zeroes? true + all_zeroes? true output ""] (if (//int.>= +0 (.int idx)) (let [digit (digits::get idx digits)] (if (and (//nat.= 0 digit) - all-zeroes?) + all_zeroes?) (recur (dec idx) true output) (recur (dec idx) false ("lux text concat" (\ //nat.decimal encode digit) output)))) - (if all-zeroes? + (if all_zeroes? "0" output)))) @@ -359,7 +359,7 @@ (digits::put idx (//nat.% 10 raw) output))) output))) -(def: (text-to-digits input) +(def: (text_to_digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] (if (//nat.<= //i64.width length) @@ -416,12 +416,12 @@ ".0" input - (let [last-idx (dec //i64.width)] - (loop [idx last-idx + (let [last_idx (dec //i64.width)] + (loop [idx last_idx digits (digits::new [])] (if (//int.>= +0 (.int idx)) (if (//i64.set? idx input) - (let [digits' (digits::+ (digits::power (//nat.- idx last-idx)) + (let [digits' (digits::+ (digits::power (//nat.- idx last_idx)) digits)] (recur (dec idx) digits')) @@ -437,10 +437,10 @@ _ false) - within-limits? (//nat.<= (inc //i64.width) + within_limits? (//nat.<= (inc //i64.width) ("lux text size" input))] - (if (and dotted? within-limits?) - (case (text-to-digits (de-prefix input)) + (if (and dotted? within_limits?) + (case (text_to_digits (de_prefix input)) (#.Some digits) (loop [digits digits idx 0 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 042919c24..2997c388b 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -21,26 +21,26 @@ ## TODO: Instead of ints, chars should be produced fron nats. ## (The JVM specifies chars as 16-bit unsigned integers) -(def: #export from-code +(def: #export from_code (-> Char Text) (|>> (:coerce Int) "lux i64 char")) (template [ ] - [(def: #export (from-code )) + [(def: #export (from_code )) (def: #export )] [00 \0 null] [07 \a alarm] - [08 \b back-space] + [08 \b back_space] [09 \t tab] - [10 \n new-line] - [11 \v vertical-tab] - [12 \f form-feed] - [13 \r carriage-return] - [34 \'' double-quote] + [10 \n new_line] + [11 \v vertical_tab] + [12 \f form_feed] + [13 \r carriage_return] + [34 \'' double_quote] ) -(def: #export line-feed ..new-line) +(def: #export line_feed ..new_line) (def: #export (size x) (-> Text Nat) @@ -52,53 +52,53 @@ (#.Some ("lux text char" idx input)) #.None)) -(def: #export (index-of' pattern from input) +(def: #export (index_of' pattern from input) (-> Text Nat Text (Maybe Nat)) ("lux text index" from pattern input)) -(def: #export (index-of pattern input) +(def: #export (index_of pattern input) (-> Text Text (Maybe Nat)) ("lux text index" 0 pattern input)) -(def: (last-index-of'' part since text) +(def: (last_index_of'' part since text) (-> Text Nat Text (Maybe Nat)) (case ("lux text index" (inc since) part text) #.None (#.Some since) (#.Some since') - (last-index-of'' part since' text))) + (last_index_of'' part since' text))) -(def: #export (last-index-of' part from text) +(def: #export (last_index_of' part from text) (-> Text Nat Text (Maybe Nat)) (case ("lux text index" from part text) (#.Some since) - (last-index-of'' part since text) + (last_index_of'' part since text) #.None #.None)) -(def: #export (last-index-of part text) +(def: #export (last_index_of part text) (-> Text Text (Maybe Nat)) (case ("lux text index" 0 part text) (#.Some since) - (last-index-of'' part since text) + (last_index_of'' part since text) #.None #.None)) -(def: #export (starts-with? prefix x) +(def: #export (starts_with? prefix x) (-> Text Text Bit) - (case (index-of prefix x) + (case (index_of prefix x) (#.Some 0) true _ false)) -(def: #export (ends-with? postfix x) +(def: #export (ends_with? postfix x) (-> Text Text Bit) - (case (last-index-of postfix x) + (case (last_index_of postfix x) (#.Some n) (n.= (size x) (n.+ (size postfix) n)) @@ -108,8 +108,8 @@ (def: #export (encloses? boundary value) (-> Text Text Bit) - (and (starts-with? boundary value) - (ends-with? boundary value))) + (and (starts_with? boundary value) + (ends_with? boundary value))) (def: #export (contains? sub text) (-> Text Text Bit) @@ -143,35 +143,35 @@ _ #.None)) -(def: #export (split-with token sample) +(def: #export (split_with token sample) (-> Text Text (Maybe [Text Text])) (do maybe.monad - [index (index-of token sample) + [index (index_of token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] (wrap [pre post]))) -(def: #export (split-all-with token sample) +(def: #export (split_all_with token sample) (-> Text Text (List Text)) - (case (..split-with token sample) + (case (..split_with token sample) (#.Some [pre post]) - (#.Cons pre (split-all-with token post)) + (#.Cons pre (split_all_with token post)) #.None (#.Cons sample #.Nil))) -(def: #export (replace-once pattern replacement template) +(def: #export (replace_once pattern replacement template) (-> Text Text Text Text) (<| (maybe.default template) (do maybe.monad - [[pre post] (split-with pattern template)] + [[pre post] (split_with pattern template)] (wrap ($_ "lux text concat" pre replacement post))))) -(def: #export (replace-all pattern replacement template) +(def: #export (replace_all pattern replacement template) (-> Text Text Text Text) - (case (..split-with pattern template) + (case (..split_with pattern template) (#.Some [pre post]) - ($_ "lux text concat" pre replacement (replace-all pattern replacement post)) + ($_ "lux text concat" pre replacement (replace_all pattern replacement post)) #.None template)) @@ -226,7 +226,7 @@ (if (n.< length idx) (recur (inc idx) (|> hash - (i64.left-shift 5) + (i64.left_shift 5) (n.- hash) (n.+ ("lux text char" idx input)))) hash)))))) @@ -236,7 +236,7 @@ (let [(^open ".") ..monoid] (|>> list.reverse (list\fold compose identity)))) -(def: #export (join-with sep texts) +(def: #export (join_with sep texts) (-> Text (List Text) Text) (|> texts (list.interpose sep) concat)) @@ -266,7 +266,7 @@ (def: #export encode (-> Text Text) - (..enclose' ..double-quote)) + (..enclose' ..double_quote)) (def: #export space Text @@ -275,19 +275,19 @@ (def: #export (space? char) {#.doc "Checks whether the character is white-space."} (-> Char Bit) - (with-expansions [ (template [] + (with_expansions [ (template [] [(^ (char (~~ (static ))))] [..tab] - [..vertical-tab] + [..vertical_tab] [..space] - [..new-line] - [..carriage-return] - [..form-feed] + [..new_line] + [..carriage_return] + [..form_feed] )] - (`` (case char - (^or ) - true + (`` (case char + (^or ) + true - _ - false)))) + _ + false)))) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 397501cd2..13316dcc5 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -16,7 +16,7 @@ abstract]] ["." //]) -(with-expansions [ (as-is (import: java/lang/CharSequence) +(with_expansions [ (as_is (import: java/lang/CharSequence) (import: java/lang/Appendable ["#::." @@ -31,8 +31,8 @@ ["#::." (new [int]) (toString [] java/lang/String)]))] - (`` (for {@.old (as-is ) - @.jvm (as-is )}))) + (`` (for {@.old (as_is ) + @.jvm (as_is )}))) (`` (abstract: #export Buffer (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] @@ -44,7 +44,7 @@ (def: #export empty Buffer - (:abstraction (with-expansions [ [0 function.identity]] + (:abstraction (with_expansions [ [0 function.identity]] (for {@.old @.jvm } ## default @@ -52,7 +52,7 @@ (def: #export (append chunk buffer) (-> Text Buffer Buffer) - (with-expansions [ (let [[capacity transform] (:representation buffer) + (with_expansions [ (let [[capacity transform] (:representation buffer) append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) (function (_ chunk builder) (exec (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) @@ -67,7 +67,7 @@ (def: #export size (-> Buffer Nat) - (with-expansions [ (|>> :representation product.left)] + (with_expansions [ (|>> :representation product.left)] (for {@.old @.jvm } ## default @@ -78,7 +78,7 @@ (def: #export (text buffer) (-> Buffer Text) - (with-expansions [ (let [[capacity transform] (:representation buffer)] + (with_expansions [ (let [[capacity transform] (:representation buffer)] (|> (java/lang/StringBuilder::new (.int capacity)) transform java/lang/StringBuilder::toString))] diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 32793f515..df1714484 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -21,147 +21,147 @@ [ascii "ASCII"] - [ibm-37 "IBM037"] - [ibm-273 "IBM273"] - [ibm-277 "IBM277"] - [ibm-278 "IBM278"] - [ibm-280 "IBM280"] - [ibm-284 "IBM284"] - [ibm-285 "IBM285"] - [ibm-290 "IBM290"] - [ibm-297 "IBM297"] - [ibm-300 "IBM300"] - [ibm-420 "IBM420"] - [ibm-424 "IBM424"] - [ibm-437 "IBM437"] - [ibm-500 "IBM500"] - [ibm-737 "IBM737"] - [ibm-775 "IBM775"] - [ibm-833 "IBM833"] - [ibm-834 "IBM834"] - [ibm-838 "IBM-Thai"] - [ibm-850 "IBM850"] - [ibm-852 "IBM852"] - [ibm-855 "IBM855"] - [ibm-856 "IBM856"] - [ibm-857 "IBM857"] - [ibm-858 "IBM00858"] - [ibm-860 "IBM860"] - [ibm-861 "IBM861"] - [ibm-862 "IBM862"] - [ibm-863 "IBM863"] - [ibm-864 "IBM864"] - [ibm-865 "IBM865"] - [ibm-866 "IBM866"] - [ibm-868 "IBM868"] - [ibm-869 "IBM869"] - [ibm-870 "IBM870"] - [ibm-871 "IBM871"] - [ibm-874 "IBM874"] - [ibm-875 "IBM875"] - [ibm-918 "IBM918"] - [ibm-921 "IBM921"] - [ibm-922 "IBM922"] - [ibm-930 "IBM930"] - [ibm-933 "IBM933"] - [ibm-935 "IBM935"] - [ibm-937 "IBM937"] - [ibm-939 "IBM939"] - [ibm-942 "IBM942"] - [ibm-942c "IBM942C"] - [ibm-943 "IBM943"] - [ibm-943c "IBM943C"] - [ibm-948 "IBM948"] - [ibm-949 "IBM949"] - [ibm-949c "IBM949C"] - [ibm-950 "IBM950"] - [ibm-964 "IBM964"] - [ibm-970 "IBM970"] - [ibm-1006 "IBM1006"] - [ibm-1025 "IBM1025"] - [ibm-1026 "IBM1026"] - [ibm-1046 "IBM1046"] - [ibm-1047 "IBM1047"] - [ibm-1097 "IBM1097"] - [ibm-1098 "IBM1098"] - [ibm-1112 "IBM1112"] - [ibm-1122 "IBM1122"] - [ibm-1123 "IBM1123"] - [ibm-1124 "IBM1124"] - [ibm-1140 "IBM01140"] - [ibm-1141 "IBM01141"] - [ibm-1142 "IBM01142"] - [ibm-1143 "IBM01143"] - [ibm-1144 "IBM01144"] - [ibm-1145 "IBM01145"] - [ibm-1146 "IBM01146"] - [ibm-1147 "IBM01147"] - [ibm-1148 "IBM01148"] - [ibm-1149 "IBM01149"] - [ibm-1166 "IBM1166"] - [ibm-1364 "IBM1364"] - [ibm-1381 "IBM1381"] - [ibm-1383 "IBM1383"] - [ibm-33722 "IBM33722"] + [ibm_37 "IBM037"] + [ibm_273 "IBM273"] + [ibm_277 "IBM277"] + [ibm_278 "IBM278"] + [ibm_280 "IBM280"] + [ibm_284 "IBM284"] + [ibm_285 "IBM285"] + [ibm_290 "IBM290"] + [ibm_297 "IBM297"] + [ibm_300 "IBM300"] + [ibm_420 "IBM420"] + [ibm_424 "IBM424"] + [ibm_437 "IBM437"] + [ibm_500 "IBM500"] + [ibm_737 "IBM737"] + [ibm_775 "IBM775"] + [ibm_833 "IBM833"] + [ibm_834 "IBM834"] + [ibm_838 "IBM-Thai"] + [ibm_850 "IBM850"] + [ibm_852 "IBM852"] + [ibm_855 "IBM855"] + [ibm_856 "IBM856"] + [ibm_857 "IBM857"] + [ibm_858 "IBM00858"] + [ibm_860 "IBM860"] + [ibm_861 "IBM861"] + [ibm_862 "IBM862"] + [ibm_863 "IBM863"] + [ibm_864 "IBM864"] + [ibm_865 "IBM865"] + [ibm_866 "IBM866"] + [ibm_868 "IBM868"] + [ibm_869 "IBM869"] + [ibm_870 "IBM870"] + [ibm_871 "IBM871"] + [ibm_874 "IBM874"] + [ibm_875 "IBM875"] + [ibm_918 "IBM918"] + [ibm_921 "IBM921"] + [ibm_922 "IBM922"] + [ibm_930 "IBM930"] + [ibm_933 "IBM933"] + [ibm_935 "IBM935"] + [ibm_937 "IBM937"] + [ibm_939 "IBM939"] + [ibm_942 "IBM942"] + [ibm_942c "IBM942C"] + [ibm_943 "IBM943"] + [ibm_943c "IBM943C"] + [ibm_948 "IBM948"] + [ibm_949 "IBM949"] + [ibm_949c "IBM949C"] + [ibm_950 "IBM950"] + [ibm_964 "IBM964"] + [ibm_970 "IBM970"] + [ibm_1006 "IBM1006"] + [ibm_1025 "IBM1025"] + [ibm_1026 "IBM1026"] + [ibm_1046 "IBM1046"] + [ibm_1047 "IBM1047"] + [ibm_1097 "IBM1097"] + [ibm_1098 "IBM1098"] + [ibm_1112 "IBM1112"] + [ibm_1122 "IBM1122"] + [ibm_1123 "IBM1123"] + [ibm_1124 "IBM1124"] + [ibm_1140 "IBM01140"] + [ibm_1141 "IBM01141"] + [ibm_1142 "IBM01142"] + [ibm_1143 "IBM01143"] + [ibm_1144 "IBM01144"] + [ibm_1145 "IBM01145"] + [ibm_1146 "IBM01146"] + [ibm_1147 "IBM01147"] + [ibm_1148 "IBM01148"] + [ibm_1149 "IBM01149"] + [ibm_1166 "IBM1166"] + [ibm_1364 "IBM1364"] + [ibm_1381 "IBM1381"] + [ibm_1383 "IBM1383"] + [ibm_33722 "IBM33722"] - [iso-2022-cn "ISO-2022-CN"] - [iso2022-cn-cns "ISO2022-CN-CNS"] - [iso2022-cn-gb "ISO2022-CN-GB"] - [iso-2022-jp "ISO-2022-JP"] - [iso-2022-jp-2 "ISO-2022-JP-2"] - [iso-2022-kr "ISO-2022-KR"] - [iso-8859-1 "ISO-8859-1"] - [iso-8859-2 "ISO-8859-2"] - [iso-8859-3 "ISO-8859-3"] - [iso-8859-4 "ISO-8859-4"] - [iso-8859-5 "ISO-8859-5"] - [iso-8859-6 "ISO-8859-6"] - [iso-8859-7 "ISO-8859-7"] - [iso-8859-8 "ISO-8859-8"] - [iso-8859-9 "ISO-8859-9"] - [iso-8859-11 "iso-8859-11"] - [iso-8859-13 "ISO-8859-13"] - [iso-8859-15 "ISO-8859-15"] - - [mac-arabic "MacArabic"] - [mac-central-europe "MacCentralEurope"] - [mac-croatian "MacCroatian"] - [mac-cyrillic "MacCyrillic"] - [mac-dingbat "MacDingbat"] - [mac-greek "MacGreek"] - [mac-hebrew "MacHebrew"] - [mac-iceland "MacIceland"] - [mac-roman "MacRoman"] - [mac-romania "MacRomania"] - [mac-symbol "MacSymbol"] - [mac-thai "MacThai"] - [mac-turkish "MacTurkish"] - [mac-ukraine "MacUkraine"] + [iso_2022_cn "ISO-2022-CN"] + [iso2022_cn_cns "ISO2022-CN-CNS"] + [iso2022_cn_gb "ISO2022-CN-GB"] + [iso_2022_jp "ISO-2022-JP"] + [iso_2022_jp_2 "ISO-2022-JP-2"] + [iso_2022_kr "ISO-2022-KR"] + [iso_8859_1 "ISO-8859-1"] + [iso_8859_2 "ISO-8859-2"] + [iso_8859_3 "ISO-8859-3"] + [iso_8859_4 "ISO-8859-4"] + [iso_8859_5 "ISO-8859-5"] + [iso_8859_6 "ISO-8859-6"] + [iso_8859_7 "ISO-8859-7"] + [iso_8859_8 "ISO-8859-8"] + [iso_8859_9 "ISO-8859-9"] + [iso_8859_11 "iso-8859-11"] + [iso_8859_13 "ISO-8859-13"] + [iso_8859_15 "ISO-8859-15"] + + [mac_arabic "MacArabic"] + [mac_central_europe "MacCentralEurope"] + [mac_croatian "MacCroatian"] + [mac_cyrillic "MacCyrillic"] + [mac_dingbat "MacDingbat"] + [mac_greek "MacGreek"] + [mac_hebrew "MacHebrew"] + [mac_iceland "MacIceland"] + [mac_roman "MacRoman"] + [mac_romania "MacRomania"] + [mac_symbol "MacSymbol"] + [mac_thai "MacThai"] + [mac_turkish "MacTurkish"] + [mac_ukraine "MacUkraine"] - [utf-8 "UTF-8"] - [utf-16 "UTF-16"] - [utf-32 "UTF-32"] - - [windows-31j "windows-31j"] - [windows-874 "windows-874"] - [windows-949 "windows-949"] - [windows-950 "windows-950"] - [windows-1250 "windows-1250"] - [windows-1252 "windows-1252"] - [windows-1251 "windows-1251"] - [windows-1253 "windows-1253"] - [windows-1254 "windows-1254"] - [windows-1255 "windows-1255"] - [windows-1256 "windows-1256"] - [windows-1257 "windows-1257"] - [windows-1258 "windows-1258"] - [windows-iso2022jp "windows-iso2022jp"] - [windows-50220 "windows-50220"] - [windows-50221 "windows-50221"] + [utf_8 "UTF-8"] + [utf_16 "UTF-16"] + [utf_32 "UTF-32"] + + [windows_31j "windows-31j"] + [windows_874 "windows-874"] + [windows_949 "windows-949"] + [windows_950 "windows-950"] + [windows_1250 "windows-1250"] + [windows_1252 "windows-1252"] + [windows_1251 "windows-1251"] + [windows_1253 "windows-1253"] + [windows_1254 "windows-1254"] + [windows_1255 "windows-1255"] + [windows_1256 "windows-1256"] + [windows_1257 "windows-1257"] + [windows_1258 "windows-1258"] + [windows_iso2022jp "windows-iso2022jp"] + [windows_50220 "windows-50220"] + [windows_50221 "windows-50221"] - [cesu-8 "CESU-8"] - [koi8-r "KOI8-R"] - [koi8-u "KOI8-U"] + [cesu_8 "CESU-8"] + [koi8_r "KOI8-R"] + [koi8_u "KOI8-U"] ) (def: #export name @@ -169,18 +169,18 @@ (|>> :representation)) ) -(with-expansions [ (as-is (host.import: java/lang/String +(with_expansions [ (as_is (host.import: java/lang/String ["#::." (new [[byte] java/lang/String]) (getBytes [java/lang/String] [byte])]))] (for {@.old - (as-is ) + (as_is ) @.jvm - (as-is ) + (as_is ) @.js - (as-is (host.import: Uint8Array) + (as_is (host.import: Uint8Array) ## On Node (host.import: Buffer @@ -197,59 +197,59 @@ (new [host.String]) (decode [Uint8Array] host.String)))})) -(def: (to-utf8 value) +(def: (to_utf8 value) (-> Text Binary) (for {@.old - (java/lang/String::getBytes (..name ..utf-8) + (java/lang/String::getBytes (..name ..utf_8) ## The coercion below may seem ## gratuitous, but removing it ## causes a grave compilation problem. (:coerce java/lang/String value)) @.jvm - (java/lang/String::getBytes (..name ..utf-8) value) + (java/lang/String::getBytes (..name ..utf_8) value) @.js - (cond host.on-nashorn? + (cond host.on_nashorn? (:coerce Binary ("js object do" "getBytes" value ["utf8"])) - host.on-node-js? + host.on_node_js? (|> (Buffer::from|encode [value "utf8"]) ## This coercion is valid as per NodeJS's documentation: ## https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays (:coerce Uint8Array)) ## On the browser - (|> (TextEncoder::new [(..name ..utf-8)]) + (|> (TextEncoder::new [(..name ..utf_8)]) (TextEncoder::encode [value])) )})) -(def: (from-utf8 value) +(def: (from_utf8 value) (-> Binary (Try Text)) (for {@.old - (#try.Success (java/lang/String::new value (..name ..utf-8))) + (#try.Success (java/lang/String::new value (..name ..utf_8))) @.jvm - (#try.Success (java/lang/String::new value (..name ..utf-8))) + (#try.Success (java/lang/String::new value (..name ..utf_8))) @.js - (cond host.on-nashorn? + (cond host.on_nashorn? (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) (:coerce Text) #try.Success) - host.on-node-js? + host.on_node_js? (|> (Buffer::from|decode [value]) (Buffer::toString ["utf8"]) #try.Success) ## On the browser - (|> (TextDecoder::new [(..name ..utf-8)]) + (|> (TextDecoder::new [(..name ..utf_8)]) (TextDecoder::decode [value]) #try.Success))})) (structure: #export utf8 (Codec Binary Text) - (def: encode ..to-utf8) - (def: decode ..from-utf8)) + (def: encode ..to_utf8) + (def: decode ..from_utf8)) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index a8fca807a..fb00b4cad 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -106,11 +106,11 @@ (def: #export (mod modular) (All [m] (Format (modular.Mod m))) - (let [[modulus _] (modular.un-modular modular)] + (let [[modulus _] (modular.un_modular modular)] (\ (modular.codec modulus) encode modular))) (def: #export (list formatter) (All [a] (-> (Format a) (Format (List a)))) (|>> (list\map (|>> formatter (format " "))) - (text.join-with "") + (text.join_with "") (text.enclose ["(list" ")"]))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index bd2d8133a..050e55475 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -14,24 +14,24 @@ ["n" nat ("#\." decimal)]] [collection ["." list ("#\." fold monad)]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]] ["." // ["%" format (#+ format)]]) -(def: regex-char^ +(def: regex_char^ (Parser Text) - (.none-of "\.|&()[]{}")) + (.none_of "\.|&()[]{}")) -(def: escaped-char^ +(def: escaped_char^ (Parser Text) (do <>.monad [? (<>.parses? (.this "\"))] (if ? .any - regex-char^))) + regex_char^))) (def: (refine^ refinement^ base^) (All [a] (-> (Parser a) (Parser Text) (Parser Text))) @@ -42,82 +42,82 @@ (def: word^ (Parser Text) - (<>.either .alpha-num - (.one-of "_"))) + (<>.either .alpha_num + (.one_of "_"))) (def: (copy reference) (-> Text (Parser Text)) (<>.after (.this reference) (<>\wrap reference))) -(def: (join-text^ part^) +(def: (join_text^ part^) (-> (Parser (List Text)) (Parser Text)) (do <>.monad [parts part^] - (wrap (//.join-with "" parts)))) + (wrap (//.join_with "" parts)))) -(def: name-char^ +(def: name_char^ (Parser Text) - (.none-of (format "[]{}()s#.<>" //.double-quote))) + (.none_of (format "[]{}()s#.<>" //.double_quote))) -(def: name-part^ +(def: name_part^ (Parser Text) (do <>.monad [head (refine^ (.not .decimal) - name-char^) - tail (.some name-char^)] + name_char^) + tail (.some name_char^)] (wrap (format head tail)))) -(def: (name^ current-module) +(def: (name^ current_module) (-> Text (Parser Name)) ($_ <>.either - (<>.and (<>\wrap current-module) (<>.after (.this "..") name-part^)) - (<>.and name-part^ (<>.after (.this ".") name-part^)) - (<>.and (<>\wrap "lux") (<>.after (.this ".") name-part^)) - (<>.and (<>\wrap "") name-part^))) + (<>.and (<>\wrap current_module) (<>.after (.this "..") name_part^)) + (<>.and name_part^ (<>.after (.this ".") name_part^)) + (<>.and (<>\wrap "lux") (<>.after (.this ".") name_part^)) + (<>.and (<>\wrap "") name_part^))) -(def: (re-var^ current-module) +(def: (re_var^ current_module) (-> Text (Parser Code)) (do <>.monad - [name (.enclosed ["\@<" ">"] (name^ current-module))] + [name (.enclosed ["\@<" ">"] (name^ current_module))] (wrap (` (: (Parser Text) (~ (code.identifier name))))))) -(def: re-range^ +(def: re_range^ (Parser Code) (do {! <>.monad} - [from (|> regex-char^ (\ ! map (|>> (//.nth 0) maybe.assume))) + [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume))) _ (.this "-") - to (|> regex-char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] + to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] (wrap (` (.range (~ (code.nat from)) (~ (code.nat to))))))) -(def: re-char^ +(def: re_char^ (Parser Code) (do <>.monad - [char escaped-char^] + [char escaped_char^] (wrap (` ((~! ..copy) (~ (code.text char))))))) -(def: re-options^ +(def: re_options^ (Parser Code) (do <>.monad - [options (.many escaped-char^)] - (wrap (` (.one-of (~ (code.text options))))))) + [options (.many escaped_char^)] + (wrap (` (.one_of (~ (code.text options))))))) -(def: re-user-class^' +(def: re_user_class^' (Parser Code) (do <>.monad [negate? (<>.maybe (.this "^")) parts (<>.many ($_ <>.either - re-range^ - re-options^))] + re_range^ + re_options^))] (wrap (case negate? (#.Some _) (` (.not ($_ <>.either (~+ parts)))) #.None (` ($_ <>.either (~+ parts))))))) -(def: re-user-class^ +(def: re_user_class^ (Parser Code) (do <>.monad [_ (wrap []) - init re-user-class^' - rest (<>.some (<>.after (.this "&&") (.enclosed ["[" "]"] re-user-class^')))] + init re_user_class^' + rest (<>.some (<>.after (.this "&&") (.enclosed ["[" "]"] re_user_class^')))] (wrap (list\fold (function (_ refinement base) (` ((~! refine^) (~ refinement) (~ base)))) init @@ -125,7 +125,7 @@ (def: blank^ (Parser Text) - (.one-of (format " " //.tab))) + (.one_of (format " " //.tab))) (def: ascii^ (Parser Text) @@ -134,23 +134,23 @@ (def: control^ (Parser Text) (<>.either (.range (hex "0") (hex "1F")) - (.one-of (//.from-code (hex "7F"))))) + (.one_of (//.from_code (hex "7F"))))) (def: punct^ (Parser Text) - (.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" - //.double-quote))) + (.one_of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" + //.double_quote))) (def: graph^ (Parser Text) - (<>.either punct^ .alpha-num)) + (<>.either punct^ .alpha_num)) (def: print^ (Parser Text) (<>.either graph^ - (.one-of (//.from-code (hex "20"))))) + (.one_of (//.from_code (hex "20"))))) -(def: re-system-class^ +(def: re_system_class^ (Parser Code) (do <>.monad [] @@ -167,7 +167,7 @@ (<>.after (.this "\p{Upper}") (wrap (` .upper))) (<>.after (.this "\p{Alpha}") (wrap (` .alpha))) (<>.after (.this "\p{Digit}") (wrap (` .decimal))) - (<>.after (.this "\p{Alnum}") (wrap (` .alpha-num))) + (<>.after (.this "\p{Alnum}") (wrap (` .alpha_num))) (<>.after (.this "\p{Space}") (wrap (` .space))) (<>.after (.this "\p{HexDigit}") (wrap (` .hexadecimal))) (<>.after (.this "\p{OctDigit}") (wrap (` .octal))) @@ -179,17 +179,17 @@ (<>.after (.this "\p{Print}") (wrap (` (~! print^)))) ))) -(def: re-class^ +(def: re_class^ (Parser Code) - (<>.either re-system-class^ - (.enclosed ["[" "]"] re-user-class^))) + (<>.either re_system_class^ + (.enclosed ["[" "]"] re_user_class^))) (def: number^ (Parser Nat) (|> (.many .decimal) (<>.codec n.decimal))) -(def: re-back-reference^ +(def: re_back_reference^ (Parser Code) (<>.either (do <>.monad [_ (.this "\") @@ -197,102 +197,102 @@ (wrap (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)])))))) (do <>.monad [_ (.this "\k<") - captured-name name-part^ + captured_name name_part^ _ (.this ">")] - (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name])))))))) + (wrap (` ((~! ..copy) (~ (code.identifier ["" captured_name])))))))) -(def: (re-simple^ current-module) +(def: (re_simple^ current_module) (-> Text (Parser Code)) ($_ <>.either - re-class^ - (re-var^ current-module) - re-back-reference^ - re-char^ + re_class^ + (re_var^ current_module) + re_back_reference^ + re_char^ )) -(def: (re-simple-quantified^ current-module) +(def: (re_simple_quantified^ current_module) (-> Text (Parser Code)) (do <>.monad - [base (re-simple^ current-module) - quantifier (.one-of "?*+")] + [base (re_simple^ current_module) + quantifier (.one_of "?*+")] (case quantifier "?" (wrap (` (<>.default "" (~ base)))) "*" - (wrap (` ((~! join-text^) (<>.some (~ base))))) + (wrap (` ((~! join_text^) (<>.some (~ base))))) ## "+" _ - (wrap (` ((~! join-text^) (<>.many (~ base))))) + (wrap (` ((~! join_text^) (<>.many (~ base))))) ))) -(def: (re-counted-quantified^ current-module) +(def: (re_counted_quantified^ current_module) (-> Text (Parser Code)) (do {! <>.monad} - [base (re-simple^ current-module)] + [base (re_simple^ current_module)] (.enclosed ["{" "}"] ($_ <>.either (do ! [[from to] (<>.and number^ (<>.after (.this ",") number^))] - (wrap (` ((~! join-text^) (<>.between (~ (code.nat from)) + (wrap (` ((~! join_text^) (<>.between (~ (code.nat from)) (~ (code.nat to)) (~ base)))))) (do ! [limit (<>.after (.this ",") number^)] - (wrap (` ((~! join-text^) (<>.at-most (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base)))))) (do ! [limit (<>.before (.this ",") number^)] - (wrap (` ((~! join-text^) (<>.at-least (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base)))))) (do ! [limit number^] - (wrap (` ((~! join-text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) + (wrap (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) -(def: (re-quantified^ current-module) +(def: (re_quantified^ current_module) (-> Text (Parser Code)) - (<>.either (re-simple-quantified^ current-module) - (re-counted-quantified^ current-module))) + (<>.either (re_simple_quantified^ current_module) + (re_counted_quantified^ current_module))) -(def: (re-complex^ current-module) +(def: (re_complex^ current_module) (-> Text (Parser Code)) ($_ <>.either - (re-quantified^ current-module) - (re-simple^ current-module))) + (re_quantified^ current_module) + (re_simple^ current_module))) -(type: Re-Group - #Non-Capturing +(type: Re_Group + #Non_Capturing (#Capturing [(Maybe Text) Nat])) -(def: (re-sequential^ capturing? re-scoped^ current-module) +(def: (re_sequential^ capturing? re_scoped^ current_module) (-> Bit - (-> Text (Parser [Re-Group Code])) + (-> Text (Parser [Re_Group Code])) Text (Parser [Nat Code])) (do <>.monad - [parts (<>.many (<>.or (re-complex^ current-module) - (re-scoped^ current-module))) + [parts (<>.many (<>.or (re_complex^ current_module) + (re_scoped^ current_module))) #let [g!total (code.identifier ["" "0total"]) g!temp (code.identifier ["" "0temp"]) - [_ names steps] (list\fold (: (-> (Either Code [Re-Group Code]) + [_ names steps] (list\fold (: (-> (Either Code [Re_Group Code]) [Nat (List Code) (List (List Code))] [Nat (List Code) (List (List Code))]) (function (_ part [idx names steps]) (case part - (^or (#.Left complex) (#.Right [#Non-Capturing complex])) + (^or (#.Left complex) (#.Right [#Non_Capturing complex])) [idx names (list& (list g!temp complex (' #let) (` [(~ g!total) (\ (~! //.monoid) (~' compose) (~ g!total) (~ g!temp))])) steps)] - (#.Right [(#Capturing [?name num-captures]) scoped]) + (#.Right [(#Capturing [?name num_captures]) scoped]) (let [[idx! name!] (case ?name (#.Some _name) [idx (code.identifier ["" _name])] #.None [(inc idx) (code.identifier ["" (n\encode idx)])]) - access (if (n.> 0 num-captures) + access (if (n.> 0 num_captures) (` ((~! product.left) (~ name!))) name!)] [idx! @@ -348,19 +348,19 @@ (#try.Failure error) (#try.Failure error))))) -(def: (prep-alternative [num-captures alt]) +(def: (prep_alternative [num_captures alt]) (-> [Nat Code] Code) - (if (n.> 0 num-captures) + (if (n.> 0 num_captures) alt (` ((~! unflatten^) (~ alt))))) -(def: (re-alternative^ capturing? re-scoped^ current-module) +(def: (re_alternative^ capturing? re_scoped^ current_module) (-> Bit - (-> Text (Parser [Re-Group Code])) + (-> Text (Parser [Re_Group Code])) Text (Parser [Nat Code])) (do <>.monad - [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] + [#let [sub^ (re_sequential^ capturing? re_scoped^ current_module)] head sub^ tail (<>.some (<>.after (.this "|") sub^))] (if (list.empty? tail) @@ -369,36 +369,36 @@ (` ($_ ((~ (if capturing? (` (~! |||^)) (` (~! |||_^))))) - (~ (prep-alternative head)) - (~+ (list\map prep-alternative tail))))])))) + (~ (prep_alternative head)) + (~+ (list\map prep_alternative tail))))])))) -(def: (re-scoped^ current-module) - (-> Text (Parser [Re-Group Code])) +(def: (re_scoped^ current_module) + (-> Text (Parser [Re_Group Code])) ($_ <>.either (do <>.monad [_ (.this "(?:") - [_ scoped] (re-alternative^ #0 re-scoped^ current-module) + [_ scoped] (re_alternative^ #0 re_scoped^ current_module) _ (.this ")")] - (wrap [#Non-Capturing scoped])) + (wrap [#Non_Capturing scoped])) (do <>.monad - [complex (re-complex^ current-module)] - (wrap [#Non-Capturing complex])) + [complex (re_complex^ current_module)] + (wrap [#Non_Capturing complex])) (do <>.monad [_ (.this "(?<") - captured-name name-part^ + captured_name name_part^ _ (.this ">") - [num-captures pattern] (re-alternative^ #1 re-scoped^ current-module) + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (.this ")")] - (wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern])) + (wrap [(#Capturing [(#.Some captured_name) num_captures]) pattern])) (do <>.monad [_ (.this "(") - [num-captures pattern] (re-alternative^ #1 re-scoped^ current-module) + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (.this ")")] - (wrap [(#Capturing [#.None num-captures]) pattern])))) + (wrap [(#Capturing [#.None num_captures]) pattern])))) -(def: (regex^ current-module) +(def: (regex^ current_module) (-> Text (Parser Code)) - (\ <>.monad map product.right (re-alternative^ #1 re-scoped^ current-module))) + (\ <>.monad map product.right (re_alternative^ #1 re_scoped^ current_module))) (syntax: #export (regex {pattern .text}) {#.doc (doc "Create lexers using regular-expression syntax." @@ -460,11 +460,11 @@ (regex "a(.)(.)|b(.)(.)") )} (do meta.monad - [current-module meta.current-module-name] - (case (.run (regex^ current-module) + [current_module meta.current_module_name] + (case (.run (regex^ current_module) pattern) (#try.Failure error) - (meta.fail (format "Error while parsing regular-expression:" //.new-line + (meta.fail (format "Error while parsing regular-expression:" //.new_line error)) (#try.Success regex) @@ -475,19 +475,19 @@ body {branches (<>.many .any)}) {#.doc (doc "Allows you to test text against regular expressions." - (case some-text + (case some_text (^regex "(\d{3})-(\d{3})-(\d{4})" - [_ country-code area-code place-code]) - do-some-thing-when-number + [_ country_code area_code place_code]) + do_some_thing_when_number (^regex "\w+") - do-some-thing-when-word + do_some_thing_when_word _ - do-something-else))} - (with-gensyms [g!temp] - (wrap (list& (` (^multi (~ g!temp) - [((~! .run) (..regex (~ (code.text pattern))) (~ g!temp)) - (#try.Success (~ (maybe.default g!temp bindings)))])) - body - branches)))) + do_something_else))} + (with_gensyms [g!temp] + (wrap (list& (` (^multi (~ g!temp) + [((~! .run) (..regex (~ (code.text pattern))) (~ g!temp)) + (#try.Success (~ (maybe.default g!temp bindings)))])) + body + branches)))) diff --git a/stdlib/source/lux/data/text/unicode/block.lux b/stdlib/source/lux/data/text/unicode/block.lux index a4844258a..7e81ff850 100644 --- a/stdlib/source/lux/data/text/unicode/block.lux +++ b/stdlib/source/lux/data/text/unicode/block.lux @@ -67,23 +67,23 @@ (def: &equivalence ..equivalence) (def: (hash value) - (i64.or (i64.left-shift 32 (..start value)) + (i64.or (i64.left_shift 32 (..start value)) (..end value)))) (template [ ] [(def: #export Block (..block (hex ) (hex )))] ## Normal blocks - [basic-latin "0000" "007F"] - [latin-1-supplement "00A0" "00FF"] - [latin-extended-a "0100" "017F"] - [latin-extended-b "0180" "024F"] - [ipa-extensions "0250" "02AF"] - [spacing-modifier-letters "02B0" "02FF"] - [combining-diacritical-marks "0300" "036F"] - [greek-and-coptic "0370" "03FF"] + [basic_latin "0000" "007F"] + [latin_1_supplement "00A0" "00FF"] + [latin_extended_a "0100" "017F"] + [latin_extended_b "0180" "024F"] + [ipa_extensions "0250" "02AF"] + [spacing_modifier_letters "02B0" "02FF"] + [combining_diacritical_marks "0300" "036F"] + [greek_and_coptic "0370" "03FF"] [cyrillic "0400" "04FF"] - [cyrillic-supplementary "0500" "052F"] + [cyrillic_supplementary "0500" "052F"] [armenian "0530" "058F"] [hebrew "0590" "05FF"] [arabic "0600" "06FF"] @@ -104,10 +104,10 @@ [tibetan "0F00" "0FFF"] [myanmar "1000" "109F"] [georgian "10A0" "10FF"] - [hangul-jamo "1100" "11FF"] + [hangul_jamo "1100" "11FF"] [ethiopic "1200" "137F"] [cherokee "13A0" "13FF"] - [unified-canadian-aboriginal-syllabics "1400" "167F"] + [unified_canadian_aboriginal_syllabics "1400" "167F"] [ogham "1680" "169F"] [runic "16A0" "16FF"] [tagalog "1700" "171F"] @@ -117,88 +117,88 @@ [khmer "1780" "17FF"] [mongolian "1800" "18AF"] [limbu "1900" "194F"] - [tai-le "1950" "197F"] - [khmer-symbols "19E0" "19FF"] - [phonetic-extensions "1D00" "1D7F"] - [latin-extended-additional "1E00" "1EFF"] - [greek-extended "1F00" "1FFF"] - [general-punctuation "2000" "206F"] - [superscripts-and-subscripts "2070" "209F"] - [currency-symbols "20A0" "20CF"] - [combining-diacritical-marks-for-symbols "20D0" "20FF"] - [letterlike-symbols "2100" "214F"] - [number-forms "2150" "218F"] + [tai_le "1950" "197F"] + [khmer_symbols "19E0" "19FF"] + [phonetic_extensions "1D00" "1D7F"] + [latin_extended_additional "1E00" "1EFF"] + [greek_extended "1F00" "1FFF"] + [general_punctuation "2000" "206F"] + [superscripts_and_subscripts "2070" "209F"] + [currency_symbols "20A0" "20CF"] + [combining_diacritical_marks_for_symbols "20D0" "20FF"] + [letterlike_symbols "2100" "214F"] + [number_forms "2150" "218F"] [arrows "2190" "21FF"] - [mathematical-operators "2200" "22FF"] - [miscellaneous-technical "2300" "23FF"] - [control-pictures "2400" "243F"] - [optical-character-recognition "2440" "245F"] - [enclosed-alphanumerics "2460" "24FF"] - [box-drawing "2500" "257F"] - [block-elements "2580" "259F"] - [geometric-shapes "25A0" "25FF"] - [miscellaneous-symbols "2600" "26FF"] + [mathematical_operators "2200" "22FF"] + [miscellaneous_technical "2300" "23FF"] + [control_pictures "2400" "243F"] + [optical_character_recognition "2440" "245F"] + [enclosed_alphanumerics "2460" "24FF"] + [box_drawing "2500" "257F"] + [block_elements "2580" "259F"] + [geometric_shapes "25A0" "25FF"] + [miscellaneous_symbols "2600" "26FF"] [dingbats "2700" "27BF"] - [miscellaneous-mathematical-symbols-a "27C0" "27EF"] - [supplemental-arrows-a "27F0" "27FF"] - [braille-patterns "2800" "28FF"] - [supplemental-arrows-b "2900" "297F"] - [miscellaneous-mathematical-symbols-b "2980" "29FF"] - [supplemental-mathematical-operators "2A00" "2AFF"] - [miscellaneous-symbols-and-arrows "2B00" "2BFF"] - [cjk-radicals-supplement "2E80" "2EFF"] - [kangxi-radicals "2F00" "2FDF"] - [ideographic-description-characters "2FF0" "2FFF"] - [cjk-symbols-and-punctuation "3000" "303F"] + [miscellaneous_mathematical_symbols_a "27C0" "27EF"] + [supplemental_arrows_a "27F0" "27FF"] + [braille_patterns "2800" "28FF"] + [supplemental_arrows_b "2900" "297F"] + [miscellaneous_mathematical_symbols_b "2980" "29FF"] + [supplemental_mathematical_operators "2A00" "2AFF"] + [miscellaneous_symbols_and_arrows "2B00" "2BFF"] + [cjk_radicals_supplement "2E80" "2EFF"] + [kangxi_radicals "2F00" "2FDF"] + [ideographic_description_characters "2FF0" "2FFF"] + [cjk_symbols_and_punctuation "3000" "303F"] [hiragana "3040" "309F"] [katakana "30A0" "30FF"] [bopomofo "3100" "312F"] - [hangul-compatibility-jamo "3130" "318F"] + [hangul_compatibility_jamo "3130" "318F"] [kanbun "3190" "319F"] - [bopomofo-extended "31A0" "31BF"] - [katakana-phonetic-extensions "31F0" "31FF"] - [enclosed-cjk-letters-and-months "3200" "32FF"] - [cjk-compatibility "3300" "33FF"] - [cjk-unified-ideographs-extension-a "3400" "4DBF"] - [yijing-hexagram-symbols "4DC0" "4DFF"] - [cjk-unified-ideographs "4E00" "9FFF"] - [yi-syllables "A000" "A48F"] - [yi-radicals "A490" "A4CF"] - [hangul-syllables "AC00" "D7AF"] - [high-surrogates "D800" "DB7F"] - [high-private-use-surrogates "DB80" "DBFF"] - [low-surrogates "DC00" "DFFF"] - [private-use-area "E000" "F8FF"] - [cjk-compatibility-ideographs "F900" "FAFF"] - [alphabetic-presentation-forms "FB00" "FB4F"] - [arabic-presentation-forms-a "FB50" "FDFF"] - [variation-selectors "FE00" "FE0F"] - [combining-half-marks "FE20" "FE2F"] - [cjk-compatibility-forms "FE30" "FE4F"] - [small-form-variants "FE50" "FE6F"] - [arabic-presentation-forms-b "FE70" "FEFF"] - [halfwidth-and-fullwidth-forms "FF00" "FFEF"] + [bopomofo_extended "31A0" "31BF"] + [katakana_phonetic_extensions "31F0" "31FF"] + [enclosed_cjk_letters_and_months "3200" "32FF"] + [cjk_compatibility "3300" "33FF"] + [cjk_unified_ideographs_extension_a "3400" "4DBF"] + [yijing_hexagram_symbols "4DC0" "4DFF"] + [cjk_unified_ideographs "4E00" "9FFF"] + [yi_syllables "A000" "A48F"] + [yi_radicals "A490" "A4CF"] + [hangul_syllables "AC00" "D7AF"] + [high_surrogates "D800" "DB7F"] + [high_private_use_surrogates "DB80" "DBFF"] + [low_surrogates "DC00" "DFFF"] + [private_use_area "E000" "F8FF"] + [cjk_compatibility_ideographs "F900" "FAFF"] + [alphabetic_presentation_forms "FB00" "FB4F"] + [arabic_presentation_forms_a "FB50" "FDFF"] + [variation_selectors "FE00" "FE0F"] + [combining_half_marks "FE20" "FE2F"] + [cjk_compatibility_forms "FE30" "FE4F"] + [small_form_variants "FE50" "FE6F"] + [arabic_presentation_forms_b "FE70" "FEFF"] + [halfwidth_and_fullwidth_forms "FF00" "FFEF"] [specials "FFF0" "FFFF"] - ## [linear-b-syllabary "10000" "1007F"] - ## [linear-b-ideograms "10080" "100FF"] - ## [aegean-numbers "10100" "1013F"] - ## [old-italic "10300" "1032F"] + ## [linear_b_syllabary "10000" "1007F"] + ## [linear_b_ideograms "10080" "100FF"] + ## [aegean_numbers "10100" "1013F"] + ## [old_italic "10300" "1032F"] ## [gothic "10330" "1034F"] ## [ugaritic "10380" "1039F"] ## [deseret "10400" "1044F"] ## [shavian "10450" "1047F"] ## [osmanya "10480" "104AF"] - ## [cypriot-syllabary "10800" "1083F"] - ## [byzantine-musical-symbols "1D000" "1D0FF"] - ## [musical-symbols "1D100" "1D1FF"] - ## [tai-xuan-jing-symbols "1D300" "1D35F"] - ## [mathematical-alphanumeric-symbols "1D400" "1D7FF"] - ## [cjk-unified-ideographs-extension-b "20000" "2A6DF"] - ## [cjk-compatibility-ideographs-supplement "2F800" "2FA1F"] + ## [cypriot_syllabary "10800" "1083F"] + ## [byzantine_musical_symbols "1D000" "1D0FF"] + ## [musical_symbols "1D100" "1D1FF"] + ## [tai_xuan_jing_symbols "1D300" "1D35F"] + ## [mathematical_alphanumeric_symbols "1D400" "1D7FF"] + ## [cjk_unified_ideographs_extension_b "20000" "2A6DF"] + ## [cjk_compatibility_ideographs_supplement "2F800" "2FA1F"] ## [tags "E0000" "E007F"] ## Specialized blocks - [basic-latin/decimal "0030" "0039"] - [basic-latin/upper-alpha "0041" "005A"] - [basic-latin/lower-alpha "0061" "007A"] + [basic_latin/decimal "0030" "0039"] + [basic_latin/upper_alpha "0041" "005A"] + [basic_latin/lower_alpha "0061" "007A"] ) diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux index 8d350a28b..55d7941ca 100644 --- a/stdlib/source/lux/data/text/unicode/set.lux +++ b/stdlib/source/lux/data/text/unicode/set.lux @@ -8,7 +8,7 @@ ["." set ("#\." equivalence)] ["." tree #_ ["#" finger (#+ Tree)]]]] - [type (#+ :by-example) + [type (#+ :by_example) abstract]] ["." / #_ ["/#" // #_ @@ -19,7 +19,7 @@ (tree.builder //block.monoid)) (def: :@: - (:by-example [@] + (:by_example [@] {(tree.Builder @ Block) ..builder} @)) @@ -45,16 +45,16 @@ (def: #export character Set - (..set [//block.basic-latin - (list //block.latin-1-supplement - //block.latin-extended-a - //block.latin-extended-b - //block.ipa-extensions - //block.spacing-modifier-letters - //block.combining-diacritical-marks - //block.greek-and-coptic + (..set [//block.basic_latin + (list //block.latin_1_supplement + //block.latin_extended_a + //block.latin_extended_b + //block.ipa_extensions + //block.spacing_modifier_letters + //block.combining_diacritical_marks + //block.greek_and_coptic //block.cyrillic - //block.cyrillic-supplementary + //block.cyrillic_supplementary //block.armenian //block.hebrew //block.arabic @@ -75,10 +75,10 @@ //block.tibetan //block.myanmar //block.georgian - //block.hangul-jamo + //block.hangul_jamo //block.ethiopic //block.cherokee - //block.unified-canadian-aboriginal-syllabics + //block.unified_canadian_aboriginal_syllabics //block.ogham //block.runic //block.tagalog @@ -88,89 +88,89 @@ //block.khmer //block.mongolian //block.limbu - //block.tai-le - //block.khmer-symbols - //block.phonetic-extensions - //block.latin-extended-additional - //block.greek-extended - //block.general-punctuation - //block.superscripts-and-subscripts - //block.currency-symbols - //block.combining-diacritical-marks-for-symbols - //block.letterlike-symbols - //block.number-forms + //block.tai_le + //block.khmer_symbols + //block.phonetic_extensions + //block.latin_extended_additional + //block.greek_extended + //block.general_punctuation + //block.superscripts_and_subscripts + //block.currency_symbols + //block.combining_diacritical_marks_for_symbols + //block.letterlike_symbols + //block.number_forms //block.arrows - //block.mathematical-operators - //block.miscellaneous-technical - //block.control-pictures - //block.optical-character-recognition - //block.enclosed-alphanumerics - //block.box-drawing - - //block.block-elements - //block.geometric-shapes - //block.miscellaneous-symbols + //block.mathematical_operators + //block.miscellaneous_technical + //block.control_pictures + //block.optical_character_recognition + //block.enclosed_alphanumerics + //block.box_drawing + + //block.block_elements + //block.geometric_shapes + //block.miscellaneous_symbols //block.dingbats - //block.miscellaneous-mathematical-symbols-a - //block.supplemental-arrows-a - //block.braille-patterns - //block.supplemental-arrows-b - //block.miscellaneous-mathematical-symbols-b - //block.supplemental-mathematical-operators - //block.miscellaneous-symbols-and-arrows - //block.cjk-radicals-supplement - //block.kangxi-radicals - //block.ideographic-description-characters - //block.cjk-symbols-and-punctuation + //block.miscellaneous_mathematical_symbols_a + //block.supplemental_arrows_a + //block.braille_patterns + //block.supplemental_arrows_b + //block.miscellaneous_mathematical_symbols_b + //block.supplemental_mathematical_operators + //block.miscellaneous_symbols_and_arrows + //block.cjk_radicals_supplement + //block.kangxi_radicals + //block.ideographic_description_characters + //block.cjk_symbols_and_punctuation //block.hiragana //block.katakana //block.bopomofo - //block.hangul-compatibility-jamo + //block.hangul_compatibility_jamo //block.kanbun - //block.bopomofo-extended - //block.katakana-phonetic-extensions - //block.enclosed-cjk-letters-and-months - //block.cjk-compatibility - //block.cjk-unified-ideographs-extension-a - //block.yijing-hexagram-symbols - //block.cjk-unified-ideographs - //block.yi-syllables - //block.yi-radicals - //block.hangul-syllables + //block.bopomofo_extended + //block.katakana_phonetic_extensions + //block.enclosed_cjk_letters_and_months + //block.cjk_compatibility + //block.cjk_unified_ideographs_extension_a + //block.yijing_hexagram_symbols + //block.cjk_unified_ideographs + //block.yi_syllables + //block.yi_radicals + //block.hangul_syllables )])) - (def: #export non-character + (def: #export non_character Set - (..set [//block.high-surrogates - (list //block.high-private-use-surrogates - //block.low-surrogates - //block.private-use-area - //block.cjk-compatibility-ideographs - //block.alphabetic-presentation-forms - //block.arabic-presentation-forms-a - //block.variation-selectors - //block.combining-half-marks - //block.cjk-compatibility-forms - //block.small-form-variants - //block.arabic-presentation-forms-b - //block.halfwidth-and-fullwidth-forms + (..set [//block.high_surrogates + (list //block.high_private_use_surrogates + //block.low_surrogates + //block.private_use_area + //block.cjk_compatibility_ideographs + //block.alphabetic_presentation_forms + //block.arabic_presentation_forms_a + //block.variation_selectors + //block.combining_half_marks + //block.cjk_compatibility_forms + //block.small_form_variants + //block.arabic_presentation_forms_b + //block.halfwidth_and_fullwidth_forms //block.specials - ## //block.linear-b-syllabary - ## //block.linear-b-ideograms - ## //block.aegean-numbers - ## //block.old-italic + ## //block.linear_b_syllabary + ## //block.linear_b_ideograms + ## //block.aegean_numbers + ## //block.old_italic ## //block.gothic ## //block.ugaritic ## //block.deseret ## //block.shavian ## //block.osmanya - ## //block.cypriot-syllabary - ## //block.byzantine-musical-symbols - ## //block.musical-symbols - ## //block.tai-xuan-jing-symbols - ## //block.mathematical-alphanumeric-symbols - ## //block.cjk-unified-ideographs-extension-b - ## //block.cjk-compatibility-ideographs-supplement + ## //block.cypriot_syllabary + ## //block.byzantine_musical_symbols + ## //block.musical_symbols + ## //block.tai_xuan_jing_symbols + ## //block.mathematical_alphanumeric_symbols + ## //block.cjk_unified_ideographs_extension_b + ## //block.cjk_compatibility_ideographs_supplement ## //block.tags )])) @@ -178,7 +178,7 @@ Set ($_ ..compose ..character - ..non-character + ..non_character )) (def: #export (range set) @@ -204,17 +204,17 @@ (Equivalence Set) (def: (= reference subject) - (set\= (set.from-list //block.hash (tree.tags (:representation reference))) - (set.from-list //block.hash (tree.tags (:representation subject)))))) + (set\= (set.from_list //block.hash (tree.tags (:representation reference))) + (set.from_list //block.hash (tree.tags (:representation subject)))))) ) (template [ ] [(def: #export (..set ))] - [ascii [//block.basic-latin (list)]] - [ascii/alpha [//block.basic-latin/upper-alpha (list //block.basic-latin/lower-alpha)]] - [ascii/alpha-num [//block.basic-latin/upper-alpha (list //block.basic-latin/lower-alpha //block.basic-latin/decimal)]] - [ascii/upper-alpha [//block.basic-latin/upper-alpha (list)]] - [ascii/lower-alpha [//block.basic-latin/lower-alpha (list)]] + [ascii [//block.basic_latin (list)]] + [ascii/alpha [//block.basic_latin/upper_alpha (list //block.basic_latin/lower_alpha)]] + [ascii/alpha_num [//block.basic_latin/upper_alpha (list //block.basic_latin/lower_alpha //block.basic_latin/decimal)]] + [ascii/upper_alpha [//block.basic_latin/upper_alpha (list)]] + [ascii/lower_alpha [//block.basic_latin/lower_alpha (list)]] ) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 847cc9225..c537148c8 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -31,7 +31,7 @@ ["." syntax (#+ syntax:)] ["." code]]]) -(with-expansions [ (as-is (import: java/lang/String) +(with_expansions [ (as_is (import: java/lang/String) (import: (java/lang/Class a) ["#::." @@ -57,30 +57,30 @@ (longValue [] long) (doubleValue [] double)]))] (for {@.old - (as-is ) + (as_is ) @.jvm - (as-is ) + (as_is ) @.js - (as-is (import: JSON + (as_is (import: JSON (#static stringify [.Any] host.String)) (import: Array (#static isArray [.Any] host.Boolean)))})) (def: Inspector (-> Any Text)) -(def: (inspect-tuple inspect) +(def: (inspect_tuple inspect) (-> Inspector Inspector) (|>> (:coerce (array.Array Any)) - array.to-list + array.to_list (list\map inspect) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"]))) (def: #export (inspect value) Inspector - (with-expansions [ (let [object (:coerce java/lang/Object value)] + (with_expansions [ (let [object (:coerce java/lang/Object value)] (`` (<| (~~ (template [ ] [(case (host.check object) (#.Some value) @@ -112,7 +112,7 @@ (text.enclose ["(" ")"]))) _ - (inspect-tuple inspect value))) + (inspect_tuple inspect value))) #.None) (java/lang/Object::toString object))))] (for {@.old @@ -122,9 +122,9 @@ @.js - (case (host.type-of value) - (^template [ ] - [ + (case (host.type_of value) + (^template [ ] + [ (`` (|> value (~~ (template.splice ))))]) (["boolean" [(:coerce .Bit) %.bit]] ["string" [(:coerce .Text) %.text]] @@ -132,15 +132,15 @@ ["undefined" [JSON::stringify]]) "object" - (let [variant-tag ("js object get" "_lux_tag" value) - variant-flag ("js object get" "_lux_flag" value) - variant-value ("js object get" "_lux_value" value)] - (cond (not (or ("js object undefined?" variant-tag) - ("js object undefined?" variant-flag) - ("js object undefined?" variant-value))) - (|> (format (JSON::stringify variant-tag) - " " (%.bit (not ("js object null?" variant-flag))) - " " (inspect variant-value)) + (let [variant_tag ("js object get" "_lux_tag" value) + variant_flag ("js object get" "_lux_flag" value) + variant_value ("js object get" "_lux_value" value)] + (cond (not (or ("js object undefined?" variant_tag) + ("js object undefined?" variant_flag) + ("js object undefined?" variant_value))) + (|> (format (JSON::stringify variant_tag) + " " (%.bit (not ("js object null?" variant_flag))) + " " (inspect variant_value)) (text.enclose ["(" ")"])) (not (or ("js object undefined?" ("js object get" "_lux_low" value)) @@ -148,7 +148,7 @@ (|> value (:coerce .Int) %.int) (Array::isArray value) - (inspect-tuple inspect value) + (inspect_tuple inspect value) ## else (JSON::stringify value))) @@ -157,13 +157,13 @@ (undefined)) }))) -(exception: #export (cannot-represent-value {type Type}) +(exception: #export (cannot_represent_value {type Type}) (exception.report ["Type" (%.type type)])) (type: Representation (-> Any Text)) -(def: primitive-representation +(def: primitive_representation (Parser Representation) (`` ($_ <>.either (do <>.monad @@ -182,7 +182,7 @@ [Frac %.frac] [Text %.text]))))) -(def: (special-representation representation) +(def: (special_representation representation) (-> (Parser Representation) (Parser Representation)) (`` ($_ <>.either (~~ (template [ ] @@ -213,12 +213,12 @@ (#.Some elemV) (format "(#.Some " (elemR elemV) ")")))))))) -(def: (variant-representation representation) +(def: (variant_representation representation) (-> (Parser Representation) (Parser Representation)) (do <>.monad [membersR+ (.variant (<>.many representation))] (wrap (function (_ variantV) - (let [[lefts right? sub-repr] (loop [lefts 0 + (let [[lefts right? sub_repr] (loop [lefts 0 representations membersR+ variantV variantV] (case representations @@ -237,14 +237,14 @@ _ (undefined)))] - (format "(" (%.nat lefts) " " (%.bit right?) " " sub-repr ")")))))) + (format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")")))))) -(def: (tuple-representation representation) +(def: (tuple_representation representation) (-> (Parser Representation) (Parser Representation)) (do <>.monad [membersR+ (.tuple (<>.many representation))] (wrap (function (_ tupleV) - (let [tuple-body (loop [representations membersR+ + (let [tuple_body (loop [representations membersR+ tupleV tupleV] (case representations #.Nil @@ -256,17 +256,17 @@ (#.Cons headR tailR) (let [[leftV rightV] (:coerce [Any Any] tupleV)] (format (headR leftV) " " (recur tailR rightV)))))] - (format "[" tuple-body "]")))))) + (format "[" tuple_body "]")))))) (def: representation (Parser Representation) (<>.rec (function (_ representation) ($_ <>.either - primitive-representation - (special-representation representation) - (variant-representation representation) - (tuple-representation representation) + primitive_representation + (special_representation representation) + (variant_representation representation) + (tuple_representation representation) (do <>.monad [[funcT inputsT+] (.apply (<>.and .any (<>.many .any)))] @@ -291,7 +291,7 @@ (#try.Success (representation value)) (#try.Failure _) - (exception.throw ..cannot-represent-value type))) + (exception.throw ..cannot_represent_value type))) (syntax: #export (private {definition .identifier}) (let [[module _] definition] diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux index a295d83e8..85bd050c0 100644 --- a/stdlib/source/lux/extension.lux +++ b/stdlib/source/lux/extension.lux @@ -11,7 +11,7 @@ ["." product] [collection ["." list ("#\." functor)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]] @@ -26,13 +26,13 @@ (def: (simple default) (-> Code (Parser Input)) ($_ <>.and - .local-identifier + .local_identifier (<>\wrap default))) (def: complex (Parser Input) (.record ($_ <>.and - .local-identifier + .local_identifier .any))) (def: (input default) @@ -51,9 +51,9 @@ (-> Code (Parser Declaration)) (.form ($_ <>.and .any - .local-identifier - .local-identifier - .local-identifier + .local_identifier + .local_identifier + .local_identifier (<>.some (..input default))))) (template [ ] @@ -66,15 +66,15 @@ parsers (` (.$_ (~+ parsers)))) - g!name (code.local-identifier extension) - g!phase (code.local-identifier phase) - g!archive (code.local-identifier archive)] - (with-gensyms [g!handler g!inputs g!error] + g!name (code.local_identifier extension) + g!phase (code.local_identifier phase) + g!archive (code.local_identifier archive)] + (with_gensyms [g!handler g!inputs g!error] (wrap (list (` ( (~ name) (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) (.case ((~! ) (~ g!parser) (~ g!inputs)) (#.Right [(~+ (list\map (|>> product.left - code.local-identifier) + code.local_identifier) inputs))]) (~ body) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 4f8ce6736..8386da339 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -26,7 +26,7 @@ [syntax (#+ syntax:)] ["." code] ["." template]] - ["." meta (#+ with-gensyms) + ["." meta (#+ with_gensyms) ["." annotation]] [target [jvm @@ -82,13 +82,13 @@ [char reflection.char] ) -(def: (get-static-field class field) +(def: (get_static_field class field) (-> Text Text Code) (` ("jvm member get static" (~ (code.text class)) (~ (code.text field))))) -(def: (get-virtual-field class field object) +(def: (get_virtual_field class field object) (-> Text Text Code Code) (` ("jvm member get virtual" (~ (code.text class)) @@ -105,7 +105,7 @@ [type.float box.float] [type.double box.double] [type.char box.char]) - (dictionary.from-list type.hash))) + (dictionary.from_list type.hash))) (template [
 ]
   [(def: ( unboxed boxed raw)
@@ -132,41 +132,41 @@
          "jvm object cast"
          (: )))]
 
-  [byte-to-long    "jvm conversion byte-to-long"    ..Byte      ..Long]
+  [byte_to_long    "jvm conversion byte-to-long"    ..Byte      ..Long]
 
-  [short-to-long   "jvm conversion short-to-long"   ..Short     ..Long]
+  [short_to_long   "jvm conversion short-to-long"   ..Short     ..Long]
   
-  [double-to-int   "jvm conversion double-to-int"   ..Double    ..Integer]
-  [double-to-long  "jvm conversion double-to-long"  ..Double    ..Long]
-  [double-to-float "jvm conversion double-to-float" ..Double    ..Float]
+  [double_to_int   "jvm conversion double-to-int"   ..Double    ..Integer]
+  [double_to_long  "jvm conversion double-to-long"  ..Double    ..Long]
+  [double_to_float "jvm conversion double-to-float" ..Double    ..Float]
 
-  [float-to-int    "jvm conversion float-to-int"    ..Float     ..Integer]
-  [float-to-long   "jvm conversion float-to-long"   ..Float     ..Long]
-  [float-to-double "jvm conversion float-to-double" ..Float     ..Double]
+  [float_to_int    "jvm conversion float-to-int"    ..Float     ..Integer]
+  [float_to_long   "jvm conversion float-to-long"   ..Float     ..Long]
+  [float_to_double "jvm conversion float-to-double" ..Float     ..Double]
   
-  [int-to-byte     "jvm conversion int-to-byte"     ..Integer   ..Byte]
-  [int-to-short    "jvm conversion int-to-short"    ..Integer   ..Short]
-  [int-to-long     "jvm conversion int-to-long"     ..Integer   ..Long]
-  [int-to-float    "jvm conversion int-to-float"    ..Integer   ..Float]
-  [int-to-double   "jvm conversion int-to-double"   ..Integer   ..Double]
-  [int-to-char     "jvm conversion int-to-char"     ..Integer   ..Character]
-
-  [long-to-byte    "jvm conversion long-to-byte"    ..Long      ..Byte]
-  [long-to-short   "jvm conversion long-to-short"   ..Long      ..Short]
-  [long-to-int     "jvm conversion long-to-int"     ..Long      ..Integer]
-  [long-to-float   "jvm conversion long-to-float"   ..Long      ..Float]
-  [long-to-double  "jvm conversion long-to-double"  ..Long      ..Double]
-
-  [char-to-byte    "jvm conversion char-to-byte"    ..Character ..Byte]
-  [char-to-short   "jvm conversion char-to-short"   ..Character ..Short]
-  [char-to-int     "jvm conversion char-to-int"     ..Character ..Integer]
-  [char-to-long    "jvm conversion char-to-long"    ..Character ..Long]
+  [int_to_byte     "jvm conversion int-to-byte"     ..Integer   ..Byte]
+  [int_to_short    "jvm conversion int-to-short"    ..Integer   ..Short]
+  [int_to_long     "jvm conversion int-to-long"     ..Integer   ..Long]
+  [int_to_float    "jvm conversion int-to-float"    ..Integer   ..Float]
+  [int_to_double   "jvm conversion int-to-double"   ..Integer   ..Double]
+  [int_to_char     "jvm conversion int-to-char"     ..Integer   ..Character]
+
+  [long_to_byte    "jvm conversion long-to-byte"    ..Long      ..Byte]
+  [long_to_short   "jvm conversion long-to-short"   ..Long      ..Short]
+  [long_to_int     "jvm conversion long-to-int"     ..Long      ..Integer]
+  [long_to_float   "jvm conversion long-to-float"   ..Long      ..Float]
+  [long_to_double  "jvm conversion long-to-double"  ..Long      ..Double]
+
+  [char_to_byte    "jvm conversion char-to-byte"    ..Character ..Byte]
+  [char_to_short   "jvm conversion char-to-short"   ..Character ..Short]
+  [char_to_int     "jvm conversion char-to-int"     ..Character ..Integer]
+  [char_to_long    "jvm conversion char-to-long"    ..Character ..Long]
   )
 
-(def: constructor-method-name "")
-(def: member-separator "::")
+(def: constructor_method_name "")
+(def: member_separator "::")
 
-(type: Primitive-Mode
+(type: Primitive_Mode
   #ManualPrM
   #AutoPrM)
 
@@ -186,36 +186,36 @@
   #AbstractIM
   #DefaultIM)
 
-(type: Class-Kind
+(type: Class_Kind
   #Class
   #Interface)
 
 (type: StackFrame (primitive "java/lang/StackTraceElement"))
 (type: StackTrace (array.Array StackFrame))
 
-(type: Annotation-Parameter
+(type: Annotation_Parameter
   [Text Code])
 
 (type: Annotation
-  {#ann-name   Text
-   #ann-params (List Annotation-Parameter)})
+  {#ann_name   Text
+   #ann_params (List Annotation_Parameter)})
 
-(type: Member-Declaration
-  {#member-name Text
-   #member-privacy Privacy
-   #member-anns (List Annotation)})
+(type: Member_Declaration
+  {#member_name Text
+   #member_privacy Privacy
+   #member_anns (List Annotation)})
 
 (type: FieldDecl
   (#ConstantField (Type Value) Code)
   (#VariableField StateModifier (Type Value)))
 
 (type: MethodDecl
-  {#method-tvars  (List (Type Var))
-   #method-inputs (List (Type Value))
-   #method-output (Type Return)
-   #method-exs    (List (Type Class))})
+  {#method_tvars  (List (Type Var))
+   #method_inputs (List (Type Value))
+   #method_output (Type Return)
+   #method_exs    (List (Type Class))})
 
-(type: Method-Definition
+(type: Method_Definition
   (#ConstructorMethod [Bit
                        (List (Type Var))
                        Text
@@ -254,47 +254,47 @@
                   (Type Return)
                   (List (Type Class))]))
 
-(type: Partial-Call
-  {#pc-method Name
-   #pc-args   (List Code)})
+(type: Partial_Call
+  {#pc_method Name
+   #pc_args   (List Code)})
 
 (type: ImportMethodKind
   #StaticIMK
   #VirtualIMK)
 
 (type: ImportMethodCommons
-  {#import-member-mode   Primitive-Mode
-   #import-member-alias  Text
-   #import-member-kind   ImportMethodKind
-   #import-member-tvars  (List (Type Var))
-   #import-member-args   (List [Bit (Type Value)])
-   #import-member-maybe? Bit
-   #import-member-try?   Bit
-   #import-member-io?    Bit})
+  {#import_member_mode   Primitive_Mode
+   #import_member_alias  Text
+   #import_member_kind   ImportMethodKind
+   #import_member_tvars  (List (Type Var))
+   #import_member_args   (List [Bit (Type Value)])
+   #import_member_maybe? Bit
+   #import_member_try?   Bit
+   #import_member_io?    Bit})
 
 (type: ImportConstructorDecl
   {})
 
 (type: ImportMethodDecl
-  {#import-method-name    Text
-   #import-method-return  (Type Return)})
+  {#import_method_name    Text
+   #import_method_return  (Type Return)})
 
 (type: ImportFieldDecl
-  {#import-field-mode    Primitive-Mode
-   #import-field-name    Text
-   #import-field-static? Bit
-   #import-field-maybe?  Bit
-   #import-field-setter? Bit
-   #import-field-type    (Type Value)})
-
-(type: Import-Member-Declaration
+  {#import_field_mode    Primitive_Mode
+   #import_field_name    Text
+   #import_field_static? Bit
+   #import_field_maybe?  Bit
+   #import_field_setter? Bit
+   #import_field_type    (Type Value)})
+
+(type: Import_Member_Declaration
   (#EnumDecl        (List Text))
   (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl])
   (#MethodDecl      [ImportMethodCommons ImportMethodDecl])
   (#FieldAccessDecl ImportFieldDecl))
 
-(def: (primitive-type mode type)
-  (-> Primitive-Mode (Type Primitive) Code)
+(def: (primitive_type mode type)
+  (-> Primitive_Mode (Type Primitive) Code)
   (case mode
     #ManualPrM
     (cond (\ type.equivalence = type.boolean type) (` ..Boolean)
@@ -328,7 +328,7 @@
           ## else
           (undefined))))
 
-(def: (parameter-type type)
+(def: (parameter_type type)
   (-> (Type Parameter) Code)
   (`` (<| (~~ (template [  ]
                 [(case ( type)
@@ -340,16 +340,16 @@
                 [parser.var? name (code.identifier ["" name])]
                 [parser.wildcard? _ (` .Any)]
                 [parser.lower? _ (` .Any)]
-                [parser.upper? limit (parameter-type limit)]
+                [parser.upper? limit (parameter_type limit)]
                 [parser.class? [name parameters]
                  (` (.primitive (~ (code.text name))
-                                [(~+ (list\map parameter-type parameters))]))]))
+                                [(~+ (list\map parameter_type parameters))]))]))
           ## else
           (undefined)
           )))
 
-(def: (value-type mode type)
-  (-> Primitive-Mode (Type Value) Code)
+(def: (value_type mode type)
+  (-> Primitive_Mode (Type Value) Code)
   (`` (<| (~~ (template [  ]
                 [(case ( type)
                    (#.Some )
@@ -357,57 +357,57 @@
 
                    #.None)]
 
-                [parser.parameter? type (parameter-type type)]
-                [parser.primitive? type (primitive-type mode type)]
+                [parser.parameter? type (parameter_type type)]
+                [parser.primitive? type (primitive_type mode type)]
                 [parser.array? elementT (case (parser.primitive? elementT)
                                           (#.Some elementT)
                                           (` (#.Primitive (~ (code.text (..reflection (type.array elementT)))) #.Nil))
                                           
                                           #.None
-                                          (` (#.Primitive (~ (code.text array.type-name))
-                                                          (#.Cons (~ (value-type mode elementT)) #.Nil))))]))
+                                          (` (#.Primitive (~ (code.text array.type_name))
+                                                          (#.Cons (~ (value_type mode elementT)) #.Nil))))]))
           (undefined)
           )))
 
-(def: declaration-type$
+(def: declaration_type$
   (-> (Type Declaration) Code)
   (|>> ..signature code.text))
 
-(def: (make-get-const-parser class-name field-name)
+(def: (make_get_const_parser class_name field_name)
   (-> Text Text (Parser Code))
   (do <>.monad
-    [#let [dotted-name (format "::" field-name)]
-     _ (.this! (code.identifier ["" dotted-name]))]
-    (wrap (get-static-field class-name field-name))))
+    [#let [dotted_name (format "::" field_name)]
+     _ (.this! (code.identifier ["" dotted_name]))]
+    (wrap (get_static_field class_name field_name))))
 
-(def: (make-get-var-parser class-name field-name)
+(def: (make_get_var_parser class_name field_name)
   (-> Text Text (Parser Code))
   (do <>.monad
-    [#let [dotted-name (format "::" field-name)]
-     _ (.this! (code.identifier ["" dotted-name]))]
-    (wrap (get-virtual-field class-name field-name (' _jvm_this)))))
+    [#let [dotted_name (format "::" field_name)]
+     _ (.this! (code.identifier ["" dotted_name]))]
+    (wrap (get_virtual_field class_name field_name (' _jvm_this)))))
 
-(def: (make-put-var-parser class-name field-name)
+(def: (make_put_var_parser class_name field_name)
   (-> Text Text (Parser Code))
   (do <>.monad
-    [#let [dotted-name (format "::" field-name)]
+    [#let [dotted_name (format "::" field_name)]
      [_ _ value] (: (Parser [Any Any Code])
-                    (.form ($_ <>.and (.this! (' :=)) (.this! (code.identifier ["" dotted-name])) .any)))]
-    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))
+                    (.form ($_ <>.and (.this! (' :=)) (.this! (code.identifier ["" dotted_name])) .any)))]
+    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value))))))
 
-(def: (pre-walk-replace f input)
+(def: (pre_walk_replace f input)
   (-> (-> Code Code) Code Code)
   (case (f input)
     (^template []
       [[meta ( parts)]
-       [meta ( (list\map (pre-walk-replace f) parts))]])
+       [meta ( (list\map (pre_walk_replace f) parts))]])
     ([#.Form]
      [#.Tuple])
     
     [meta (#.Record pairs)]
     [meta (#.Record (list\map (: (-> [Code Code] [Code Code])
                                  (function (_ [key val])
-                                   [(pre-walk-replace f key) (pre-walk-replace f val)]))
+                                   [(pre_walk_replace f key) (pre_walk_replace f val)]))
                               pairs))]
     
     ast'
@@ -423,81 +423,81 @@
     ast
     ))
 
-(def: (field->parser class-name [[field-name _ _] field])
-  (-> Text [Member-Declaration FieldDecl] (Parser Code))
+(def: (field->parser class_name [[field_name _ _] field])
+  (-> Text [Member_Declaration FieldDecl] (Parser Code))
   (case field
     (#ConstantField _)
-    (make-get-const-parser class-name field-name)
+    (make_get_const_parser class_name field_name)
     
     (#VariableField _)
-    (<>.either (make-get-var-parser class-name field-name)
-               (make-put-var-parser class-name field-name))))
+    (<>.either (make_get_var_parser class_name field_name)
+               (make_put_var_parser class_name field_name))))
 
-(def: (decorate-input [class value])
+(def: (decorate_input [class value])
   (-> [(Type Value) Code] Code)
   (` [(~ (code.text (..signature class))) (~ value)]))
 
-(def: (make-constructor-parser class-name arguments)
+(def: (make_constructor_parser class_name arguments)
   (-> Text (List Argument) (Parser Code))
   (do <>.monad
     [args (: (Parser (List Code))
              (.form (<>.after (.this! (' ::new!))
                                  (.tuple (<>.exactly (list.size arguments) .any)))))]
-    (wrap (` ("jvm member invoke constructor" (~ (code.text class-name))
+    (wrap (` ("jvm member invoke constructor" (~ (code.text class_name))
               (~+ (|> args
                       (list.zip/2 (list\map product.right arguments))
-                      (list\map ..decorate-input))))))))
+                      (list\map ..decorate_input))))))))
 
-(def: (make-static-method-parser class-name method-name arguments)
+(def: (make_static_method_parser class_name method_name arguments)
   (-> Text Text (List Argument) (Parser Code))
   (do <>.monad
-    [#let [dotted-name (format "::" method-name "!")]
+    [#let [dotted_name (format "::" method_name "!")]
      args (: (Parser (List Code))
-             (.form (<>.after (.this! (code.identifier ["" dotted-name]))
+             (.form (<>.after (.this! (code.identifier ["" dotted_name]))
                                  (.tuple (<>.exactly (list.size arguments) .any)))))]
-    (wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name))
+    (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name))
               (~+ (|> args
                       (list.zip/2 (list\map product.right arguments))
-                      (list\map ..decorate-input))))))))
+                      (list\map ..decorate_input))))))))
 
-(template [ ]
-  [(def: ( class-name method-name arguments)
+(template [ ]
+  [(def: ( class_name method_name arguments)
      (-> Text Text (List Argument) (Parser Code))
      (do <>.monad
-       [#let [dotted-name (format "::" method-name "!")]
+       [#let [dotted_name (format "::" method_name "!")]
         args (: (Parser (List Code))
-                (.form (<>.after (.this! (code.identifier ["" dotted-name]))
+                (.form (<>.after (.this! (code.identifier ["" dotted_name]))
                                     (.tuple (<>.exactly (list.size arguments) .any)))))]
-       (wrap (` ( (~ (code.text class-name)) (~ (code.text method-name))
+       (wrap (` ( (~ (code.text class_name)) (~ (code.text method_name))
                           (~' _jvm_this)
                           (~+ (|> args
                                   (list.zip/2 (list\map product.right arguments))
-                                  (list\map ..decorate-input))))))))]
+                                  (list\map ..decorate_input))))))))]
 
-  [make-special-method-parser "jvm member invoke special"]
-  [make-virtual-method-parser "jvm member invoke virtual"]
+  [make_special_method_parser "jvm member invoke special"]
+  [make_virtual_method_parser "jvm member invoke virtual"]
   )
 
-(def: (method->parser class-name [[method-name _ _] meth-def])
-  (-> Text [Member-Declaration Method-Definition] (Parser Code))
-  (case meth-def
-    (#ConstructorMethod strict? type-vars self-name args constructor-args return-expr exs)
-    (make-constructor-parser class-name args)
+(def: (method->parser class_name [[method_name _ _] meth_def])
+  (-> Text [Member_Declaration Method_Definition] (Parser Code))
+  (case meth_def
+    (#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs)
+    (make_constructor_parser class_name args)
     
-    (#StaticMethod strict? type-vars args return-type return-expr exs)
-    (make-static-method-parser class-name method-name args)
+    (#StaticMethod strict? type_vars args return_type return_expr exs)
+    (make_static_method_parser class_name method_name args)
     
-    (^or (#VirtualMethod final? strict? type-vars self-name args return-type return-expr exs)
-         (#OverridenMethod strict? owner-class type-vars self-name args return-type return-expr exs))
-    (make-special-method-parser class-name method-name args)
+    (^or (#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs)
+         (#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs))
+    (make_special_method_parser class_name method_name args)
 
-    (#AbstractMethod type-vars args return-type exs)
-    (make-virtual-method-parser class-name method-name args)
+    (#AbstractMethod type_vars args return_type exs)
+    (make_virtual_method_parser class_name method_name args)
 
-    (#NativeMethod type-vars args return-type exs)
-    (make-virtual-method-parser class-name method-name args)))
+    (#NativeMethod type_vars args return_type exs)
+    (make_virtual_method_parser class_name method_name args)))
 
-(def: privacy-modifier^
+(def: privacy_modifier^
   (Parser Privacy)
   (let [(^open ".") <>.monad]
     ($_ <>.or
@@ -506,7 +506,7 @@
         (.this! (' #protected))
         (wrap []))))
 
-(def: inheritance-modifier^
+(def: inheritance_modifier^
   (Parser InheritanceModifier)
   (let [(^open ".") <>.monad]
     ($_ <>.or
@@ -514,62 +514,62 @@
         (.this! (' #abstract))
         (wrap []))))
 
-(exception: #export (class-names-cannot-contain-periods {name Text})
+(exception: #export (class_names_cannot_contain_periods {name Text})
   (exception.report
    ["Name" (%.text name)]))
 
-(exception: #export (class-name-cannot-be-a-type-variable {name Text}
-                                                          {type-vars (List (Type Var))})
+(exception: #export (class_name_cannot_be_a_type_variable {name Text}
+                                                          {type_vars (List (Type Var))})
   (exception.report
    ["Name" (%.text name)]
-   ["Type Variables" (exception.enumerate parser.name type-vars)]))
+   ["Type Variables" (exception.enumerate parser.name type_vars)]))
 
 (def: (assert exception payload test)
   (All [e] (-> (Exception e) e Bit (Parser Any)))
   (<>.assert (exception.construct exception payload)
              test))
 
-(def: (assert-valid-class-name type-vars name)
+(def: (assert_valid_class_name type_vars name)
   (-> (List (Type Var)) External (Parser Any))
   (do <>.monad
-    [_ (..assert ..class-names-cannot-contain-periods [name]
-                 (not (text.contains? name.external-separator name)))]
-    (..assert ..class-name-cannot-be-a-type-variable [name type-vars]
+    [_ (..assert ..class_names_cannot_contain_periods [name]
+                 (not (text.contains? name.external_separator name)))]
+    (..assert ..class_name_cannot_be_a_type_variable [name type_vars]
               (not (list.member? text.equivalence
-                                 (list\map parser.name type-vars)
+                                 (list\map parser.name type_vars)
                                  name)))))
 
-(def: (valid-class-name type-vars)
+(def: (valid_class_name type_vars)
   (-> (List (Type Var)) (Parser External))
   (do <>.monad
-    [name .local-identifier
-     _ (assert-valid-class-name type-vars name)]
+    [name .local_identifier
+     _ (assert_valid_class_name type_vars name)]
     (wrap name)))
 
-(def: (class^' parameter^ type-vars)
+(def: (class^' parameter^ type_vars)
   (-> (-> (List (Type Var)) (Parser (Type Parameter)))
       (-> (List (Type Var)) (Parser (Type Class))))
   (do <>.monad
     [[name parameters] (: (Parser [External (List (Type Parameter))])
                           ($_ <>.either
-                              (<>.and (valid-class-name type-vars)
+                              (<>.and (valid_class_name type_vars)
                                       (<>\wrap (list)))
-                              (.form (<>.and .local-identifier
-                                                (<>.some (parameter^ type-vars))))))]
+                              (.form (<>.and .local_identifier
+                                                (<>.some (parameter^ type_vars))))))]
     (wrap (type.class (name.sanitize name) parameters))))
 
-(exception: #export (unexpected-type-variable {name Text}
-                                              {type-vars (List (Type Var))})
+(exception: #export (unexpected_type_variable {name Text}
+                                              {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.enumerate parser.name type_vars)]))
 
-(def: (variable^ type-vars)
+(def: (variable^ type_vars)
   (-> (List (Type Var)) (Parser (Type Parameter)))
   (do <>.monad
-    [name .local-identifier
-     _ (..assert ..unexpected-type-variable [name type-vars]
-                 (list.member? text.equivalence (list\map parser.name type-vars) name))]
+    [name .local_identifier
+     _ (..assert ..unexpected_type_variable [name type_vars]
+                 (list.member? text.equivalence (list\map parser.name type_vars) name))]
     (wrap (type.var name))))
 
 (def: wildcard^
@@ -590,13 +590,13 @@
   [lower^ > type.lower]
   )
 
-(def: (parameter^ type-vars)
+(def: (parameter^ type_vars)
   (-> (List (Type Var)) (Parser (Type Parameter)))
   (<>.rec
    (function (_ recur^)
-     (let [class^ (..class^' parameter^ type-vars)]
+     (let [class^ (..class^' parameter^ type_vars)]
        ($_ <>.either
-           (..variable^ type-vars)
+           (..variable^ type_vars)
            ..wildcard^
            (upper^ class^)
            (lower^ class^)
@@ -629,13 +629,13 @@
   (|>> .tuple
        (\ <>.monad map type.array)))
 
-(def: (type^ type-vars)
+(def: (type^ type_vars)
   (-> (List (Type Var)) (Parser (Type Value)))
   (<>.rec
    (function (_ type^)
      ($_ <>.either
          ..primitive^
-         (..parameter^ type-vars)
+         (..parameter^ type_vars)
          (..array^ type^)
          ))))
 
@@ -645,14 +645,14 @@
     [_ (.identifier! ["" (reflection.reflection reflection.void)])]
     (wrap type.void)))
 
-(def: (return^ type-vars)
+(def: (return^ type_vars)
   (-> (List (Type Var)) (Parser (Type Return)))
   (<>.either ..void^
-             (..type^ type-vars)))
+             (..type^ type_vars)))
 
 (def: var^
   (Parser (Type Var))
-  (\ <>.monad map type.var .local-identifier))
+  (\ <>.monad map type.var .local_identifier))
 
 (def: vars^
   (Parser (List (Type Var)))
@@ -662,28 +662,28 @@
   (Parser (Type Declaration))
   (do <>.monad
     [[name variables] (: (Parser [External (List (Type Var))])
-                         (<>.either (<>.and (valid-class-name (list))
+                         (<>.either (<>.and (valid_class_name (list))
                                             (<>\wrap (list)))
-                                    (.form (<>.and (valid-class-name (list))
+                                    (.form (<>.and (valid_class_name (list))
                                                       (<>.some var^)))
                                     ))]
     (wrap (type.declaration name variables))))
 
-(def: (class^ type-vars)
+(def: (class^ type_vars)
   (-> (List (Type Var)) (Parser (Type Class)))
-  (class^' parameter^ type-vars))
+  (class^' parameter^ type_vars))
 
-(def: annotation-parameters^
-  (Parser (List Annotation-Parameter))
-  (.record (<>.some (<>.and .local-tag .any))))
+(def: annotation_parameters^
+  (Parser (List Annotation_Parameter))
+  (.record (<>.some (<>.and .local_tag .any))))
 
 (def: annotation^
   (Parser Annotation)
   (<>.either (do <>.monad
-               [ann-name .local-identifier]
-               (wrap [ann-name (list)]))
-             (.form (<>.and .local-identifier
-                               annotation-parameters^))))
+               [ann_name .local_identifier]
+               (wrap [ann_name (list)]))
+             (.form (<>.and .local_identifier
+                               annotation_parameters^))))
 
 (def: annotations^'
   (Parser (List Annotation))
@@ -697,199 +697,199 @@
     [anns?? (<>.maybe ..annotations^')]
     (wrap (maybe.default (list) anns??))))
 
-(def: (throws-decl^ type-vars)
+(def: (throws_decl^ type_vars)
   (-> (List (Type Var)) (Parser (List (Type Class))))
   (<| (<>.default (list))
       (do <>.monad
         [_ (.this! (' #throws))]
-        (.tuple (<>.some (..class^ type-vars))))))
+        (.tuple (<>.some (..class^ type_vars))))))
 
-(def: (method-decl^ type-vars)
-  (-> (List (Type Var)) (Parser [Member-Declaration MethodDecl]))
+(def: (method_decl^ type_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl]))
   (.form (do <>.monad
               [tvars (<>.default (list) ..vars^)
-               name .local-identifier
+               name .local_identifier
                anns ..annotations^
-               inputs (.tuple (<>.some (..type^ type-vars)))
-               output (..return^ type-vars)
-               exs (throws-decl^ type-vars)]
-              (wrap [[name #PublicP anns] {#method-tvars tvars
-                                           #method-inputs inputs
-                                           #method-output output
-                                           #method-exs    exs}]))))
-
-(def: state-modifier^
+               inputs (.tuple (<>.some (..type^ type_vars)))
+               output (..return^ type_vars)
+               exs (throws_decl^ type_vars)]
+              (wrap [[name #PublicP anns] {#method_tvars tvars
+                                           #method_inputs inputs
+                                           #method_output output
+                                           #method_exs    exs}]))))
+
+(def: state_modifier^
   (Parser StateModifier)
   ($_ <>.or
       (.this! (' #volatile))
       (.this! (' #final))
       (\ <>.monad wrap [])))
 
-(def: (field-decl^ type-vars)
-  (-> (List (Type Var)) (Parser [Member-Declaration FieldDecl]))
+(def: (field_decl^ type_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl]))
   (<>.either (.form (do <>.monad
                          [_ (.this! (' #const))
-                          name .local-identifier
+                          name .local_identifier
                           anns ..annotations^
-                          type (..type^ type-vars)
+                          type (..type^ type_vars)
                           body .any]
                          (wrap [[name #PublicP anns] (#ConstantField [type body])])))
              (.form (do <>.monad
-                         [pm privacy-modifier^
-                          sm state-modifier^
-                          name .local-identifier
+                         [pm privacy_modifier^
+                          sm state_modifier^
+                          name .local_identifier
                           anns ..annotations^
-                          type (..type^ type-vars)]
+                          type (..type^ type_vars)]
                          (wrap [[name pm anns] (#VariableField [sm type])])))))
 
-(def: (argument^ type-vars)
+(def: (argument^ type_vars)
   (-> (List (Type Var)) (Parser Argument))
-  (.record (<>.and .local-identifier
-                      (..type^ type-vars))))
+  (.record (<>.and .local_identifier
+                      (..type^ type_vars))))
 
-(def: (arguments^ type-vars)
+(def: (arguments^ type_vars)
   (-> (List (Type Var)) (Parser (List Argument)))
-  (<>.some (..argument^ type-vars)))
+  (<>.some (..argument^ type_vars)))
 
-(def: (constructor-arg^ type-vars)
+(def: (constructor_arg^ type_vars)
   (-> (List (Type Var)) (Parser (Typed Code)))
-  (.record (<>.and (..type^ type-vars) .any)))
+  (.record (<>.and (..type^ type_vars) .any)))
 
-(def: (constructor-args^ type-vars)
+(def: (constructor_args^ type_vars)
   (-> (List (Type Var)) (Parser (List (Typed Code))))
-  (.tuple (<>.some (..constructor-arg^ type-vars))))
+  (.tuple (<>.some (..constructor_arg^ type_vars))))
 
-(def: (constructor-method^ class-vars)
-  (List (Type Var)) (Parser [Member-Declaration Method-Definition])
+(def: (constructor_method^ class_vars)
+  (List (Type Var)) (Parser [Member_Declaration Method_Definition])
   (.form (do <>.monad
-              [pm privacy-modifier^
-               strict-fp? (<>.parses? (.this! (' #strict)))
-               method-vars (<>.default (list) ..vars^)
-               #let [total-vars (list\compose class-vars method-vars)]
-               [_ self-name arguments] (.form ($_ <>.and
+              [pm privacy_modifier^
+               strict_fp? (<>.parses? (.this! (' #strict)))
+               method_vars (<>.default (list) ..vars^)
+               #let [total_vars (list\compose class_vars method_vars)]
+               [_ self_name arguments] (.form ($_ <>.and
                                                      (.this! (' new))
-                                                     .local-identifier
-                                                     (..arguments^ total-vars)))
-               constructor-args (..constructor-args^ total-vars)
-               exs (throws-decl^ total-vars)
+                                                     .local_identifier
+                                                     (..arguments^ total_vars)))
+               constructor_args (..constructor_args^ total_vars)
+               exs (throws_decl^ total_vars)
                annotations ..annotations^
                body .any]
-              (wrap [{#member-name constructor-method-name
-                      #member-privacy pm
-                      #member-anns annotations}
-                     (#ConstructorMethod strict-fp? method-vars self-name arguments constructor-args body exs)]))))
+              (wrap [{#member_name constructor_method_name
+                      #member_privacy pm
+                      #member_anns annotations}
+                     (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)]))))
 
-(def: (virtual-method-def^ class-vars)
-  (-> (List (Type Var)) (Parser [Member-Declaration Method-Definition]))
+(def: (virtual_method_def^ class_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
   (.form (do <>.monad
-              [pm privacy-modifier^
-               strict-fp? (<>.parses? (.this! (' #strict)))
+              [pm privacy_modifier^
+               strict_fp? (<>.parses? (.this! (' #strict)))
                final? (<>.parses? (.this! (' #final)))
-               method-vars (<>.default (list) ..vars^)
-               #let [total-vars (list\compose class-vars method-vars)]
-               [name self-name arguments] (.form ($_ <>.and
-                                                        .local-identifier
-                                                        .local-identifier
-                                                        (..arguments^ total-vars)))
-               return-type (..return^ total-vars)
-               exs (throws-decl^ total-vars)
+               method_vars (<>.default (list) ..vars^)
+               #let [total_vars (list\compose class_vars method_vars)]
+               [name self_name arguments] (.form ($_ <>.and
+                                                        .local_identifier
+                                                        .local_identifier
+                                                        (..arguments^ total_vars)))
+               return_type (..return^ total_vars)
+               exs (throws_decl^ total_vars)
                annotations ..annotations^
                body .any]
-              (wrap [{#member-name name
-                      #member-privacy pm
-                      #member-anns annotations}
-                     (#VirtualMethod final? strict-fp? method-vars self-name arguments return-type body exs)]))))
+              (wrap [{#member_name name
+                      #member_privacy pm
+                      #member_anns annotations}
+                     (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)]))))
 
-(def: overriden-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: overriden_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (.form (do <>.monad
-              [strict-fp? (<>.parses? (.this! (' #strict)))
-               owner-class ..declaration^
-               method-vars (<>.default (list) ..vars^)
-               #let [total-vars (list\compose (product.right (parser.declaration owner-class))
-                                              method-vars)]
-               [name self-name arguments] (.form ($_ <>.and
-                                                        .local-identifier
-                                                        .local-identifier
-                                                        (..arguments^ total-vars)))
-               return-type (..return^ total-vars)
-               exs (throws-decl^ total-vars)
+              [strict_fp? (<>.parses? (.this! (' #strict)))
+               owner_class ..declaration^
+               method_vars (<>.default (list) ..vars^)
+               #let [total_vars (list\compose (product.right (parser.declaration owner_class))
+                                              method_vars)]
+               [name self_name arguments] (.form ($_ <>.and
+                                                        .local_identifier
+                                                        .local_identifier
+                                                        (..arguments^ total_vars)))
+               return_type (..return^ total_vars)
+               exs (throws_decl^ total_vars)
                annotations ..annotations^
                body .any]
-              (wrap [{#member-name name
-                      #member-privacy #PublicP
-                      #member-anns annotations}
-                     (#OverridenMethod strict-fp? owner-class method-vars self-name arguments return-type body exs)]))))
+              (wrap [{#member_name name
+                      #member_privacy #PublicP
+                      #member_anns annotations}
+                     (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)]))))
 
-(def: static-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: static_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (.form (do <>.monad
-              [pm privacy-modifier^
-               strict-fp? (<>.parses? (.this! (' #strict)))
+              [pm privacy_modifier^
+               strict_fp? (<>.parses? (.this! (' #strict)))
                _ (.this! (' #static))
-               method-vars (<>.default (list) ..vars^)
-               #let [total-vars method-vars]
-               [name arguments] (.form (<>.and .local-identifier
-                                                  (..arguments^ total-vars)))
-               return-type (..return^ total-vars)
-               exs (throws-decl^ total-vars)
+               method_vars (<>.default (list) ..vars^)
+               #let [total_vars method_vars]
+               [name arguments] (.form (<>.and .local_identifier
+                                                  (..arguments^ total_vars)))
+               return_type (..return^ total_vars)
+               exs (throws_decl^ total_vars)
                annotations ..annotations^
                body .any]
-              (wrap [{#member-name name
-                      #member-privacy pm
-                      #member-anns annotations}
-                     (#StaticMethod strict-fp? method-vars arguments return-type body exs)]))))
+              (wrap [{#member_name name
+                      #member_privacy pm
+                      #member_anns annotations}
+                     (#StaticMethod strict_fp? method_vars arguments return_type body exs)]))))
 
-(def: abstract-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: abstract_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (.form (do <>.monad
-              [pm privacy-modifier^
+              [pm privacy_modifier^
                _ (.this! (' #abstract))
-               method-vars (<>.default (list) ..vars^)
-               #let [total-vars method-vars]
-               [name arguments] (.form (<>.and .local-identifier
-                                                  (..arguments^ total-vars)))
-               return-type (..return^ total-vars)
-               exs (throws-decl^ total-vars)
+               method_vars (<>.default (list) ..vars^)
+               #let [total_vars method_vars]
+               [name arguments] (.form (<>.and .local_identifier
+                                                  (..arguments^ total_vars)))
+               return_type (..return^ total_vars)
+               exs (throws_decl^ total_vars)
                annotations ..annotations^]
-              (wrap [{#member-name name
-                      #member-privacy pm
-                      #member-anns annotations}
-                     (#AbstractMethod method-vars arguments return-type exs)]))))
+              (wrap [{#member_name name
+                      #member_privacy pm
+                      #member_anns annotations}
+                     (#AbstractMethod method_vars arguments return_type exs)]))))
 
-(def: native-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: native_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (.form (do <>.monad
-              [pm privacy-modifier^
+              [pm privacy_modifier^
                _ (.this! (' #native))
-               method-vars (<>.default (list) ..vars^)
-               #let [total-vars method-vars]
-               [name arguments] (.form (<>.and .local-identifier
-                                                  (..arguments^ total-vars)))
-               return-type (..return^ total-vars)
-               exs (throws-decl^ total-vars)
+               method_vars (<>.default (list) ..vars^)
+               #let [total_vars method_vars]
+               [name arguments] (.form (<>.and .local_identifier
+                                                  (..arguments^ total_vars)))
+               return_type (..return^ total_vars)
+               exs (throws_decl^ total_vars)
                annotations ..annotations^]
-              (wrap [{#member-name name
-                      #member-privacy pm
-                      #member-anns annotations}
-                     (#NativeMethod method-vars arguments return-type exs)]))))
+              (wrap [{#member_name name
+                      #member_privacy pm
+                      #member_anns annotations}
+                     (#NativeMethod method_vars arguments return_type exs)]))))
 
-(def: (method-def^ class-vars)
-  (-> (List (Type Var)) (Parser [Member-Declaration Method-Definition]))
+(def: (method_def^ class_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
   ($_ <>.either
-      (..constructor-method^ class-vars)
-      (..virtual-method-def^ class-vars)
-      ..overriden-method-def^
-      ..static-method-def^
-      ..abstract-method-def^
-      ..native-method-def^))
-
-(def: partial-call^
-  (Parser Partial-Call)
+      (..constructor_method^ class_vars)
+      (..virtual_method_def^ class_vars)
+      ..overriden_method_def^
+      ..static_method_def^
+      ..abstract_method_def^
+      ..native_method_def^))
+
+(def: partial_call^
+  (Parser Partial_Call)
   (.form (<>.and .identifier (<>.some .any))))
 
-(def: class-kind^
-  (Parser Class-Kind)
+(def: class_kind^
+  (Parser Class_Kind)
   (<>.either (do <>.monad
                [_ (.this! (' #class))]
                (wrap #Class))
@@ -898,52 +898,52 @@
                (wrap #Interface))
              ))
 
-(def: import-member-alias^
+(def: import_member_alias^
   (Parser (Maybe Text))
   (<>.maybe (do <>.monad
               [_ (.this! (' #as))]
-              .local-identifier)))
+              .local_identifier)))
 
-(def: (import-member-args^ type-vars)
+(def: (import_member_args^ type_vars)
   (-> (List (Type Var)) (Parser (List [Bit (Type Value)])))
   (.tuple (<>.some (<>.and (<>.parses? (.tag! ["" "?"]))
-                              (..type^ type-vars)))))
+                              (..type^ type_vars)))))
 
-(def: import-member-return-flags^
+(def: import_member_return_flags^
   (Parser [Bit Bit Bit])
   ($_ <>.and
       (<>.parses? (.this! (' #io)))
       (<>.parses? (.this! (' #try)))
       (<>.parses? (.this! (' #?)))))
 
-(def: primitive-mode^
-  (Parser Primitive-Mode)
+(def: primitive_mode^
+  (Parser Primitive_Mode)
   (<>.or (.tag! ["" "manual"])
          (.tag! ["" "auto"])))
 
-(def: (import-member-decl^ owner-vars)
-  (-> (List (Type Var)) (Parser Import-Member-Declaration))
+(def: (import_member_decl^ owner_vars)
+  (-> (List (Type Var)) (Parser Import_Member_Declaration))
   ($_ <>.either
       (.form (do <>.monad
                   [_ (.this! (' #enum))
-                   enum-members (<>.some .local-identifier)]
-                  (wrap (#EnumDecl enum-members))))
+                   enum_members (<>.some .local_identifier)]
+                  (wrap (#EnumDecl enum_members))))
       (.form (do <>.monad
                   [tvars (<>.default (list) ..vars^)
                    _ (.identifier! ["" "new"])
-                   ?alias import-member-alias^
-                   #let [total-vars (list\compose owner-vars tvars)]
-                   ?prim-mode (<>.maybe primitive-mode^)
-                   args (..import-member-args^ total-vars)
-                   [io? try? maybe?] import-member-return-flags^]
-                  (wrap (#ConstructorDecl [{#import-member-mode    (maybe.default #AutoPrM ?prim-mode)
-                                            #import-member-alias   (maybe.default "new" ?alias)
-                                            #import-member-kind    #VirtualIMK
-                                            #import-member-tvars   tvars
-                                            #import-member-args    args
-                                            #import-member-maybe?  maybe?
-                                            #import-member-try?    try?
-                                            #import-member-io?     io?}
+                   ?alias import_member_alias^
+                   #let [total_vars (list\compose owner_vars tvars)]
+                   ?prim_mode (<>.maybe primitive_mode^)
+                   args (..import_member_args^ total_vars)
+                   [io? try? maybe?] import_member_return_flags^]
+                  (wrap (#ConstructorDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                            #import_member_alias   (maybe.default "new" ?alias)
+                                            #import_member_kind    #VirtualIMK
+                                            #import_member_tvars   tvars
+                                            #import_member_args    args
+                                            #import_member_maybe?  maybe?
+                                            #import_member_try?    try?
+                                            #import_member_io?     io?}
                                            {}]))
                   ))
       (.form (do <>.monad
@@ -951,39 +951,39 @@
                            (<>.or (.tag! ["" "static"])
                                   (wrap [])))
                    tvars (<>.default (list) ..vars^)
-                   name .local-identifier
-                   ?alias import-member-alias^
-                   #let [total-vars (list\compose owner-vars tvars)]
-                   ?prim-mode (<>.maybe primitive-mode^)
-                   args (..import-member-args^ total-vars)
-                   [io? try? maybe?] import-member-return-flags^
-                   return (..return^ total-vars)]
-                  (wrap (#MethodDecl [{#import-member-mode    (maybe.default #AutoPrM ?prim-mode)
-                                       #import-member-alias   (maybe.default name ?alias)
-                                       #import-member-kind    kind
-                                       #import-member-tvars   tvars
-                                       #import-member-args    args
-                                       #import-member-maybe?  maybe?
-                                       #import-member-try?    try?
-                                       #import-member-io?     io?}
-                                      {#import-method-name    name
-                                       #import-method-return  return}]))))
+                   name .local_identifier
+                   ?alias import_member_alias^
+                   #let [total_vars (list\compose owner_vars tvars)]
+                   ?prim_mode (<>.maybe primitive_mode^)
+                   args (..import_member_args^ total_vars)
+                   [io? try? maybe?] import_member_return_flags^
+                   return (..return^ total_vars)]
+                  (wrap (#MethodDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                       #import_member_alias   (maybe.default name ?alias)
+                                       #import_member_kind    kind
+                                       #import_member_tvars   tvars
+                                       #import_member_args    args
+                                       #import_member_maybe?  maybe?
+                                       #import_member_try?    try?
+                                       #import_member_io?     io?}
+                                      {#import_method_name    name
+                                       #import_method_return  return}]))))
       (.form (do <>.monad
                   [static? (<>.parses? (.this! (' #static)))
-                   name .local-identifier
-                   ?prim-mode (<>.maybe primitive-mode^)
-                   gtype (..type^ owner-vars)
+                   name .local_identifier
+                   ?prim_mode (<>.maybe primitive_mode^)
+                   gtype (..type^ owner_vars)
                    maybe? (<>.parses? (.this! (' #?)))
                    setter? (<>.parses? (.this! (' #!)))]
-                  (wrap (#FieldAccessDecl {#import-field-mode    (maybe.default #AutoPrM ?prim-mode)
-                                           #import-field-name    name
-                                           #import-field-static? static?
-                                           #import-field-maybe?  maybe?
-                                           #import-field-setter? setter?
-                                           #import-field-type    gtype}))))
+                  (wrap (#FieldAccessDecl {#import_field_mode    (maybe.default #AutoPrM ?prim_mode)
+                                           #import_field_name    name
+                                           #import_field_static? static?
+                                           #import_field_maybe?  maybe?
+                                           #import_field_setter? setter?
+                                           #import_field_type    gtype}))))
       ))
 
-(def: (privacy-modifier$ pm)
+(def: (privacy_modifier$ pm)
   (-> Privacy Code)
   (case pm
     #PublicP    (code.text "public")
@@ -991,20 +991,20 @@
     #ProtectedP (code.text "protected")
     #DefaultP   (code.text "default")))
 
-(def: (inheritance-modifier$ im)
+(def: (inheritance_modifier$ im)
   (-> InheritanceModifier Code)
   (case im
     #FinalIM    (code.text "final")
     #AbstractIM (code.text "abstract")
     #DefaultIM  (code.text "default")))
 
-(def: (annotation-parameter$ [name value])
-  (-> Annotation-Parameter Code)
+(def: (annotation_parameter$ [name value])
+  (-> Annotation_Parameter Code)
   (` [(~ (code.text name)) (~ value)]))
 
 (def: (annotation$ [name params])
   (-> Annotation Code)
-  (` ((~ (code.text name)) (~+ (list\map annotation-parameter$ params)))))
+  (` ((~ (code.text name)) (~+ (list\map annotation_parameter$ params)))))
 
 (template [ ]
   [(def: 
@@ -1021,27 +1021,27 @@
 
 (def: var$'
   (-> (Type Var) Code)
-  (|>> ..signature code.local-identifier))
+  (|>> ..signature code.local_identifier))
 
-(def: (method-decl$ [[name pm anns] method-decl])
-  (-> [Member-Declaration MethodDecl] Code)
-  (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl]
+(def: (method_decl$ [[name pm anns] method_decl])
+  (-> [Member_Declaration MethodDecl] Code)
+  (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl]
     (` ((~ (code.text name))
         [(~+ (list\map annotation$ anns))]
-        [(~+ (list\map var$ method-tvars))]
-        [(~+ (list\map class$ method-exs))]
-        [(~+ (list\map value$ method-inputs))]
-        (~ (return$ method-output))))))
+        [(~+ (list\map var$ method_tvars))]
+        [(~+ (list\map class$ method_exs))]
+        [(~+ (list\map value$ method_inputs))]
+        (~ (return$ method_output))))))
 
-(def: (state-modifier$ sm)
+(def: (state_modifier$ sm)
   (-> StateModifier Code)
   (case sm
     #VolatileSM (' "volatile")
     #FinalSM    (' "final")
     #DefaultSM  (' "default")))
 
-(def: (field-decl$ [[name pm anns] field])
-  (-> [Member-Declaration FieldDecl] Code)
+(def: (field_decl$ [[name pm anns] field])
+  (-> [Member_Declaration FieldDecl] Code)
   (case field
     (#ConstantField class value)
     (` ("constant" (~ (code.text name))
@@ -1052,8 +1052,8 @@
 
     (#VariableField sm class)
     (` ("variable" (~ (code.text name))
-        (~ (privacy-modifier$ pm))
-        (~ (state-modifier$ sm))
+        (~ (privacy_modifier$ pm))
+        (~ (state_modifier$ sm))
         [(~+ (list\map annotation$ anns))]
         (~ (value$ class))
         ))
@@ -1063,101 +1063,101 @@
   (-> Argument Code)
   (` [(~ (code.text name)) (~ (value$ type))]))
 
-(def: (constructor-arg$ [class term])
+(def: (constructor_arg$ [class term])
   (-> (Typed Code) Code)
   (` [(~ (value$ class)) (~ term)]))
 
-(def: (method-def$ replacer super-class [[name pm anns] method-def])
-  (-> (-> Code Code) (Type Class) [Member-Declaration Method-Definition] Code)
-  (case method-def
-    (#ConstructorMethod strict-fp? type-vars self-name arguments constructor-args body exs)
+(def: (method_def$ replacer super_class [[name pm anns] method_def])
+  (-> (-> Code Code) (Type Class) [Member_Declaration Method_Definition] Code)
+  (case method_def
+    (#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs)
     (` ("init"
-        (~ (privacy-modifier$ pm))
-        (~ (code.bit strict-fp?))
+        (~ (privacy_modifier$ pm))
+        (~ (code.bit strict_fp?))
         [(~+ (list\map annotation$ anns))]
-        [(~+ (list\map var$ type-vars))]
+        [(~+ (list\map var$ type_vars))]
         [(~+ (list\map class$ exs))]
-        (~ (code.text self-name))
+        (~ (code.text self_name))
         [(~+ (list\map argument$ arguments))]
-        [(~+ (list\map constructor-arg$ constructor-args))]
-        (~ (pre-walk-replace replacer body))
+        [(~+ (list\map constructor_arg$ constructor_args))]
+        (~ (pre_walk_replace replacer body))
         ))
     
-    (#VirtualMethod final? strict-fp? type-vars self-name arguments return-type body exs)
+    (#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs)
     (` ("virtual"
         (~ (code.text name))
-        (~ (privacy-modifier$ pm))
+        (~ (privacy_modifier$ pm))
         (~ (code.bit final?))
-        (~ (code.bit strict-fp?))
+        (~ (code.bit strict_fp?))
         [(~+ (list\map annotation$ anns))]
-        [(~+ (list\map var$ type-vars))]
-        (~ (code.text self-name))
+        [(~+ (list\map var$ type_vars))]
+        (~ (code.text self_name))
         [(~+ (list\map argument$ arguments))]
-        (~ (return$ return-type))
+        (~ (return$ return_type))
         [(~+ (list\map class$ exs))]
-        (~ (pre-walk-replace replacer body))))
+        (~ (pre_walk_replace replacer body))))
     
-    (#OverridenMethod strict-fp? declaration type-vars self-name arguments return-type body exs)
-    (let [super-replacer (parser->replacer (.form (do <>.monad
+    (#OverridenMethod strict_fp? declaration type_vars self_name arguments return_type body exs)
+    (let [super_replacer (parser_>replacer (.form (do <>.monad
                                                        [_ (.this! (' ::super!))
                                                         args (.tuple (<>.exactly (list.size arguments) .any))]
                                                        (wrap (` ("jvm member invoke special"
-                                                                 (~ (code.text (product.left (parser.read-class super-class))))
+                                                                 (~ (code.text (product.left (parser.read_class super_class))))
                                                                  (~ (code.text name))
                                                                  (~' _jvm_this)
                                                                  (~+ (|> args
                                                                          (list.zip/2 (list\map product.right arguments))
-                                                                         (list\map ..decorate-input)))))))))]
+                                                                         (list\map ..decorate_input)))))))))]
       (` ("override"
           (~ (declaration$ declaration))
           (~ (code.text name))
-          (~ (code.bit strict-fp?))
+          (~ (code.bit strict_fp?))
           [(~+ (list\map annotation$ anns))]
-          [(~+ (list\map var$ type-vars))]
-          (~ (code.text self-name))
+          [(~+ (list\map var$ type_vars))]
+          (~ (code.text self_name))
           [(~+ (list\map argument$ arguments))]
-          (~ (return$ return-type))
+          (~ (return$ return_type))
           [(~+ (list\map class$ exs))]
           (~ (|> body
-                 (pre-walk-replace replacer)
-                 (pre-walk-replace super-replacer)))
+                 (pre_walk_replace replacer)
+                 (pre_walk_replace super_replacer)))
           )))
 
-    (#StaticMethod strict-fp? type-vars arguments return-type body exs)
+    (#StaticMethod strict_fp? type_vars arguments return_type body exs)
     (` ("static"
         (~ (code.text name))
-        (~ (privacy-modifier$ pm))
-        (~ (code.bit strict-fp?))
+        (~ (privacy_modifier$ pm))
+        (~ (code.bit strict_fp?))
         [(~+ (list\map annotation$ anns))]
-        [(~+ (list\map var$ type-vars))]
+        [(~+ (list\map var$ type_vars))]
         [(~+ (list\map class$ exs))]
         [(~+ (list\map argument$ arguments))]
-        (~ (return$ return-type))
-        (~ (pre-walk-replace replacer body))))
+        (~ (return$ return_type))
+        (~ (pre_walk_replace replacer body))))
 
-    (#AbstractMethod type-vars arguments return-type exs)
+    (#AbstractMethod type_vars arguments return_type exs)
     (` ("abstract"
         (~ (code.text name))
-        (~ (privacy-modifier$ pm))
+        (~ (privacy_modifier$ pm))
         [(~+ (list\map annotation$ anns))]
-        [(~+ (list\map var$ type-vars))]
+        [(~+ (list\map var$ type_vars))]
         [(~+ (list\map class$ exs))]
         [(~+ (list\map argument$ arguments))]
-        (~ (return$ return-type))))
+        (~ (return$ return_type))))
 
-    (#NativeMethod type-vars arguments return-type exs)
+    (#NativeMethod type_vars arguments return_type exs)
     (` ("native"
         (~ (code.text name))
-        (~ (privacy-modifier$ pm))
+        (~ (privacy_modifier$ pm))
         [(~+ (list\map annotation$ anns))]
-        [(~+ (list\map var$ type-vars))]
+        [(~+ (list\map var$ type_vars))]
         [(~+ (list\map class$ exs))]
         [(~+ (list\map argument$ arguments))]
-        (~ (return$ return-type))))
+        (~ (return$ return_type))))
     ))
 
-(def: (complete-call$ g!obj [method args])
-  (-> Code Partial-Call Code)
+(def: (complete_call$ g!obj [method args])
+  (-> Code Partial_Call Code)
   (` ((~ (code.identifier method)) (~+ args) (~ g!obj))))
 
 (def: $Object
@@ -1166,15 +1166,15 @@
 
 (syntax: #export (class:
                    {#let [! <>.monad]}
-                   {im inheritance-modifier^}
-                   {[full-class-name class-vars] (\ ! map parser.declaration ..declaration^)}
+                   {im inheritance_modifier^}
+                   {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)}
                    {super (<>.default $Object
-                                      (class^ class-vars))}
+                                      (class^ class_vars))}
                    {interfaces (<>.default (list)
-                                           (.tuple (<>.some (class^ class-vars))))}
+                                           (.tuple (<>.some (class^ class_vars))))}
                    {annotations ..annotations^}
-                   {fields (<>.some (..field-decl^ class-vars))}
-                   {methods (<>.some (..method-def^ class-vars))})
+                   {fields (<>.some (..field_decl^ class_vars))}
+                   {methods (<>.some (..method_def^ class_vars))})
   {#.doc (doc "Allows defining JVM classes in Lux code."
               "For example:"
               (class: #final (TestClass A) [Runnable]
@@ -1206,48 +1206,48 @@
               "(::resolve! container [value]) for calling the 'resolve' method."
               )}
   (do meta.monad
-    [current-module meta.current-module-name
-     #let [fully-qualified-class-name (name.qualify current-module full-class-name)
-           field-parsers (list\map (field->parser fully-qualified-class-name) fields)
-           method-parsers (list\map (method->parser fully-qualified-class-name) methods)
-           replacer (parser->replacer (list\fold <>.either
+    [current_module meta.current_module_name
+     #let [fully_qualified_class_name (name.qualify current_module full_class_name)
+           field_parsers (list\map (field_>parser fully_qualified_class_name) fields)
+           method_parsers (list\map (method_>parser fully_qualified_class_name) methods)
+           replacer (parser_>replacer (list\fold <>.either
                                                  (<>.fail "")
-                                                 (list\compose field-parsers method-parsers)))]]
+                                                 (list\compose field_parsers method_parsers)))]]
     (wrap (list (` ("jvm class"
-                    (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars)))
+                    (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars)))
                     (~ (class$ super))
                     [(~+ (list\map class$ interfaces))]
-                    (~ (inheritance-modifier$ im))
+                    (~ (inheritance_modifier$ im))
                     [(~+ (list\map annotation$ annotations))]
-                    [(~+ (list\map field-decl$ fields))]
-                    [(~+ (list\map (method-def$ replacer super) methods))]))))))
+                    [(~+ (list\map field_decl$ fields))]
+                    [(~+ (list\map (method_def$ replacer super) methods))]))))))
 
 (syntax: #export (interface:
                    {#let [! <>.monad]}
-                   {[full-class-name class-vars] (\ ! map parser.declaration ..declaration^)}
+                   {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)}
                    {supers (<>.default (list)
-                                       (.tuple (<>.some (class^ class-vars))))}
+                                       (.tuple (<>.some (class^ class_vars))))}
                    {annotations ..annotations^}
-                   {members (<>.some (..method-decl^ class-vars))})
+                   {members (<>.some (..method_decl^ class_vars))})
   {#.doc (doc "Allows defining JVM interfaces."
               (interface: TestInterface
                 ([] foo [boolean String] void #throws [Exception])))}
   (do meta.monad
-    [current-module meta.current-module-name]
+    [current_module meta.current_module_name]
     (wrap (list (` ("jvm class interface"
-                    (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars)))
+                    (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars)))
                     [(~+ (list\map class$ supers))]
                     [(~+ (list\map annotation$ annotations))]
-                    (~+ (list\map method-decl$ members))))))))
+                    (~+ (list\map method_decl$ members))))))))
 
 (syntax: #export (object
-                   {class-vars ..vars^}
+                   {class_vars ..vars^}
                    {super (<>.default $Object
-                                      (class^ class-vars))}
+                                      (class^ class_vars))}
                    {interfaces (<>.default (list)
-                                           (.tuple (<>.some (class^ class-vars))))}
-                   {constructor-args (..constructor-args^ class-vars)}
-                   {methods (<>.some ..overriden-method-def^)})
+                                           (.tuple (<>.some (class^ class_vars))))}
+                   {constructor_args (..constructor_args^ class_vars)}
+                   {methods (<>.some ..overriden_method_def^)})
   {#.doc (doc "Allows defining anonymous classes."
               "The 1st tuple corresponds to class-level type-variables."
               "The 2nd tuple corresponds to parent interfaces."
@@ -1256,15 +1256,15 @@
               (object [] [Runnable]
                 []
                 (Runnable [] (run self) void
-                          (exec (do-something some-value)
+                          (exec (do_something some_value)
                             [])))
               )}
   (wrap (list (` ("jvm class anonymous"
-                  [(~+ (list\map var$ class-vars))]
+                  [(~+ (list\map var$ class_vars))]
                   (~ (class$ super))
                   [(~+ (list\map class$ interfaces))]
-                  [(~+ (list\map constructor-arg$ constructor-args))]
-                  [(~+ (list\map (method-def$ function.identity super) methods))])))))
+                  [(~+ (list\map constructor_arg$ constructor_args))]
+                  [(~+ (list\map (method_def$ function.identity super) methods))])))))
 
 (syntax: #export (null)
   {#.doc (doc "Null object reference."
@@ -1286,11 +1286,11 @@
                  #.None)
               (= (??? "YOLO")
                  (#.Some "YOLO")))}
-  (with-gensyms [g!temp]
-    (wrap (list (` (let [(~ g!temp) (~ expr)]
-                     (if ("jvm object null?" (~ g!temp))
-                       #.None
-                       (#.Some (~ g!temp)))))))))
+  (with_gensyms [g!temp]
+                (wrap (list (` (let [(~ g!temp) (~ expr)]
+                                 (if ("jvm object null?" (~ g!temp))
+                                   #.None
+                                   (#.Some (~ g!temp)))))))))
 
 (syntax: #export (!!! expr)
   {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
@@ -1299,21 +1299,21 @@
                  (!!! (??? (: java/lang/Thread (null)))))
               (= "foo"
                  (!!! (??? "foo"))))}
-  (with-gensyms [g!value]
-    (wrap (list (` ({(#.Some (~ g!value))
-                     (~ g!value)
+  (with_gensyms [g!value]
+                (wrap (list (` ({(#.Some (~ g!value))
+                                 (~ g!value)
 
-                     #.None
-                     ("jvm object null")}
-                    (~ expr)))))))
+                                 #.None
+                                 ("jvm object null")}
+                                (~ expr)))))))
 
 (syntax: #export (try expression)
-  {#.doc (doc (case (try (risky-computation input))
+  {#.doc (doc (case (try (risky_computation input))
                 (#.Right success)
-                (do-something success)
+                (do_something success)
 
                 (#.Left error)
-                (recover-from-failure error)))}
+                (recover_from_failure error)))}
   (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
 
 (syntax: #export (check {class (..type^ (list))}
@@ -1321,165 +1321,165 @@
   {#.doc (doc "Checks whether an object is an instance of a particular class."
               "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes."
               (case (check String "YOLO")
-                (#.Some value-as-string)
+                (#.Some value_as_string)
                 #.None))}
-  (with-gensyms [g!_ g!unchecked]
-    (let [class-name (..reflection class)
-          class-type (` (.primitive (~ (code.text class-name))))
-          check-type (` (.Maybe (~ class-type)))
-          check-code (` (if ("jvm object instance?" (~ (code.text class-name)) (~ g!unchecked))
-                          (#.Some (.:coerce (~ class-type)
-                                            (~ g!unchecked)))
-                          #.None))]
-      (case unchecked
-        (#.Some unchecked)
-        (wrap (list (` (: (~ check-type)
-                          (let [(~ g!unchecked) (~ unchecked)]
-                            (~ check-code))))))
-
-        #.None
-        (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check-type))
-                          (function ((~ g!_) (~ g!unchecked))
-                            (~ check-code))))))
-        ))))
+  (with_gensyms [g!_ g!unchecked]
+                (let [class_name (..reflection class)
+                      class_type (` (.primitive (~ (code.text class_name))))
+                      check_type (` (.Maybe (~ class_type)))
+                      check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked))
+                                      (#.Some (.:coerce (~ class_type)
+                                                        (~ g!unchecked)))
+                                      #.None))]
+                  (case unchecked
+                    (#.Some unchecked)
+                    (wrap (list (` (: (~ check_type)
+                                      (let [(~ g!unchecked) (~ unchecked)]
+                                        (~ check_code))))))
+
+                    #.None
+                    (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type))
+                                      (function ((~ g!_) (~ g!unchecked))
+                                        (~ check_code))))))
+                    ))))
 
 (syntax: #export (synchronized lock body)
   {#.doc (doc "Evaluates body, while holding a lock on a given object."
-              (synchronized object-to-be-locked
-                (exec (do-something ___)
-                  (do-something-else ___)
-                  (finish-the-computation ___))))}
+              (synchronized object_to_be_locked
+                (exec (do_something ___)
+                  (do_something_else ___)
+                  (finish_the_computation ___))))}
   (wrap (list (` ("jvm object synchronized" (~ lock) (~ body))))))
 
-(syntax: #export (do-to obj {methods (<>.some partial-call^)})
+(syntax: #export (do_to obj {methods (<>.some partial_call^)})
   {#.doc (doc "Call a variety of methods on an object. Then, return the object."
-              (do-to object
-                (ClassName::method1 arg0 arg1 arg2)
-                (ClassName::method2 arg3 arg4 arg5)))}
-  (with-gensyms [g!obj]
-    (wrap (list (` (let [(~ g!obj) (~ obj)]
-                     (exec (~+ (list\map (complete-call$ g!obj) methods))
-                       (~ g!obj))))))))
-
-(def: (class-import$ declaration)
+              (do_to object
+                     (ClassName::method1 arg0 arg1 arg2)
+                     (ClassName::method2 arg3 arg4 arg5)))}
+  (with_gensyms [g!obj]
+                (wrap (list (` (let [(~ g!obj) (~ obj)]
+                                 (exec (~+ (list\map (complete_call$ g!obj) methods))
+                                   (~ g!obj))))))))
+
+(def: (class_import$ declaration)
   (-> (Type Declaration) Code)
-  (let [[full-name params] (parser.declaration declaration)
-        def-name (..internal full-name)
+  (let [[full_name params] (parser.declaration declaration)
+        def_name (..internal full_name)
         params' (list\map ..var$' params)]
-    (` (def: (~ (code.identifier ["" def-name]))
-         {#..jvm-class (~ (code.text (..internal full-name)))}
+    (` (def: (~ (code.identifier ["" def_name]))
+         {#..jvm_class (~ (code.text (..internal full_name)))}
          .Type
          (All [(~+ params')]
-           (primitive (~ (code.text full-name))
+           (primitive (~ (code.text full_name))
                       [(~+ params')]))))))
 
-(def: (member-type-vars class-tvars member)
-  (-> (List (Type Var)) Import-Member-Declaration (List (Type Var)))
+(def: (member_type_vars class_tvars member)
+  (_> (List (Type Var)) Import_Member_Declaration (List (Type Var)))
   (case member
     (#ConstructorDecl [commons _])
-    (list\compose class-tvars (get@ #import-member-tvars commons))
+    (list\compose class_tvars (get@ #import_member_tvars commons))
 
     (#MethodDecl [commons _])
-    (case (get@ #import-member-kind commons)
+    (case (get@ #import_member_kind commons)
       #StaticIMK
-      (get@ #import-member-tvars commons)
+      (get@ #import_member_tvars commons)
 
       _
-      (list\compose class-tvars (get@ #import-member-tvars commons)))
+      (list\compose class_tvars (get@ #import_member_tvars commons)))
 
     _
-    class-tvars))
+    class_tvars))
 
-(def: (member-def-arg-bindings vars member)
-  (-> (List (Type Var)) Import-Member-Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)]))
+(def: (member_def_arg_bindings vars member)
+  (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)]))
   (case member
     (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
-    (let [(^slots [#import-member-tvars #import-member-args]) commons]
+    (let [(^slots [#import_member_tvars #import_member_args]) commons]
       (do {! meta.monad}
-        [arg-inputs (monad.map !
+        [arg_inputs (monad.map !
                                (: (-> [Bit (Type Value)] (Meta [Bit Code]))
                                   (function (_ [maybe? _])
-                                    (with-gensyms [arg-name]
-                                      (wrap [maybe? arg-name]))))
-                               import-member-args)
-         #let [input-jvm-types (list\map product.right import-member-args)
-               arg-types (list\map (: (-> [Bit (Type Value)] Code)
+                                    (with_gensyms [arg_name]
+                                                  (wrap [maybe? arg_name]))))
+                               import_member_args)
+         #let [input_jvm_types (list\map product.right import_member_args)
+               arg_types (list\map (: (-> [Bit (Type Value)] Code)
                                       (function (_ [maybe? arg])
-                                        (let [arg-type (value-type (get@ #import-member-mode commons) arg)]
+                                        (let [arg_type (value_type (get@ #import_member_mode commons) arg)]
                                           (if maybe?
-                                            (` (Maybe (~ arg-type)))
-                                            arg-type))))
-                                   import-member-args)]]
-        (wrap [arg-inputs input-jvm-types arg-types])))
+                                            (` (Maybe (~ arg_type)))
+                                            arg_type))))
+                                   import_member_args)]]
+        (wrap [arg_inputs input_jvm_types arg_types])))
 
     _
     (\ meta.monad wrap [(list) (list) (list)])))
 
-(def: (decorate-return-maybe member never-null? unboxed return-term)
-  (-> Import-Member-Declaration Bit (Type Value) Code Code)
+(def: (decorate_return_maybe member never_null? unboxed return_term)
+  (-> Import_Member_Declaration Bit (Type Value) Code Code)
   (case member
     (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
-    (cond (or never-null?
+    (cond (or never_null?
               (dictionary.key? ..boxes unboxed))
-          return-term
+          return_term
 
-          (get@ #import-member-maybe? commons)
-          (` (??? (~ return-term)))
+          (get@ #import_member_maybe? commons)
+          (` (??? (~ return_term)))
 
           ## else
           (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))]
-            (` (let [(~ g!temp) (~ return-term)]
+            (` (let [(~ g!temp) (~ return_term)]
                  (if (not (..null? (:coerce (primitive "java.lang.Object")
                                             (~ g!temp))))
                    (~ g!temp)
                    (error! "Cannot produce null references from method calls."))))))
 
     _
-    return-term))
+    return_term))
 
-(template [  ]
-  [(def: ( member return-term)
-     (-> Import-Member-Declaration Code Code)
+(template [  ]
+  [(def: ( member return_term)
+     (-> Import_Member_Declaration Code Code)
      (case member
        (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
        (if (get@  commons)
-         
-         return-term)
+         
+         return_term)
 
        _
-       return-term))]
+       return_term))]
 
-  [decorate-return-try #import-member-try? (` (..try (~ return-term)))]
-  [decorate-return-io  #import-member-io?  (` ((~! io.io) (~ return-term)))]
+  [decorate_return_try #import_member_try? (` (..try (~ return_term)))]
+  [decorate_return_io  #import_member_io?  (` ((~! io.io) (~ return_term)))]
   )
 
 (def: $String (type.class "java.lang.String" (list)))
 
 (template [   ]
   [(def: ( mode [unboxed raw])
-     (-> Primitive-Mode [(Type Value) Code] Code)
+     (-> Primitive_Mode [(Type Value) Code] Code)
      (let [[unboxed refined post] (: [(Type Value) Code (List Code)]
                                      (case mode
                                        #ManualPrM
                                        [unboxed raw (list)]
                                        
                                        #AutoPrM
-                                       (with-expansions [' (template.splice )
-                                                          (template [  
 ]
+                                       (with_expansions [' (template.splice )
+                                                          (template [  
 ]
                                                                         [(\ type.equivalence =  unboxed)
-                                                                         (with-expansions [' (template.splice )]
-                                                                           [
-                                                                            (` (.|> (~ raw) (~+ 
)))
-                                                                            (list ')])]
+                                                                         (with_expansions [' (template.splice )]
+                                                                                          [
+                                                                                           (` (.|> (~ raw) (~+ 
)))
+                                                                                           (list ')])]
 
                                                                         ')]
-                                         (cond 
-                                               ## else
-                                               [unboxed
-                                                (if 
-                                                  (` ("jvm object cast" (~ raw)))
-                                                  raw)
-                                                (list)]))))
+                                                        (cond 
+                                                              ## else
+                                                              [unboxed
+                                                               (if 
+                                                                 (` ("jvm object cast" (~ raw)))
+                                                                 raw)
+                                                               (list)]))))
            unboxed/boxed (case (dictionary.get unboxed ..boxes)
                            (#.Some boxed)
                            ( unboxed boxed refined)
@@ -1493,19 +1493,19 @@
          _
          (` (.|> (~ unboxed/boxed) (~+ post))))))]
 
-  [#1 auto-convert-input ..unbox
+  [#1 auto_convert_input ..unbox
    [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []]
-    [type.byte type.byte (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-byte)) []]
-    [type.short type.short (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-short)) []]
-    [type.int type.int (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-int)) []]
+    [type.byte type.byte (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []]
+    [type.short type.short (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []]
+    [type.int type.int (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_int)) []]
     [type.long type.long (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []]
-    [type.float type.float (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double-to-float)) []]
+    [type.float type.float (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double_to_float)) []]
     [type.double type.double (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]
     [..$String ..$String (list (` (.: .Text)) (` (.:coerce (.primitive (~ (code.text (..reflection ..$String))))))) []]
     [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []]
     [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []]
     [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]]]
-  [#0 auto-convert-output ..box
+  [#0 auto_convert_output ..box
    [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]]
     [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
     [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
@@ -1519,167 +1519,167 @@
     [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]]]
   )
 
-(def: (un-quote quoted)
+(def: (un_quote quoted)
   (-> Code Code)
   (` ((~' ~) (~ quoted))))
 
-(def: (jvm-invoke-inputs mode classes inputs)
-  (-> Primitive-Mode (List (Type Value)) (List [Bit Code]) (List Code))
+(def: (jvm_invoke_inputs mode classes inputs)
+  (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code))
   (|> inputs
       (list\map (function (_ [maybe? input])
                   (if maybe?
-                    (` ((~! !!!) (~ (un-quote input))))
-                    (un-quote input))))
+                    (` ((~! !!!) (~ (un_quote input))))
+                    (un_quote input))))
       (list.zip/2 classes)
-      (list\map (auto-convert-input mode))))
+      (list\map (auto_convert_input mode))))
 
-(def: (member-def-interop vars kind class [arg-function-inputs input-jvm-types arg-types] member method-prefix)
-  (-> (List (Type Var)) Class-Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import-Member-Declaration Text (Meta (List Code)))
-  (let [[full-name class-tvars] (parser.declaration class)]
+(def: (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix)
+  (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text (Meta (List Code)))
+  (let [[full_name class_tvars] (parser.declaration class)]
     (case member
-      (#EnumDecl enum-members)
+      (#EnumDecl enum_members)
       (do meta.monad
-        [#let [enum-type (: Code
-                            (case class-tvars
+        [#let [enum_type (: Code
+                            (case class_tvars
                               #.Nil
-                              (` (primitive (~ (code.text full-name))))
+                              (` (primitive (~ (code.text full_name))))
 
                               _
-                              (let [=class-tvars (list\map ..var$' class-tvars)]
-                                (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)]))))))
-               getter-interop (: (-> Text Code)
+                              (let [=class_tvars (list\map ..var$' class_tvars)]
+                                (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)]))))))
+               getter_interop (: (-> Text Code)
                                  (function (_ name)
-                                   (let [getter-name (code.identifier ["" (format method-prefix member-separator name)])]
-                                     (` (def: (~ getter-name)
-                                          (~ enum-type)
-                                          (~ (get-static-field full-name name)))))))]]
-        (wrap (list\map getter-interop enum-members)))
+                                   (let [getter_name (code.identifier ["" (format method_prefix member_separator name)])]
+                                     (` (def: (~ getter_name)
+                                          (~ enum_type)
+                                          (~ (get_static_field full_name name)))))))]]
+        (wrap (list\map getter_interop enum_members)))
       
       (#ConstructorDecl [commons _])
       (do meta.monad
-        [#let [classT (type.class full-name (list))
-               def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
-               jvm-interop (|> [classT
+        [#let [classT (type.class full_name (list))
+               def_name (code.identifier ["" (format method_prefix member_separator (get@ #import_member_alias commons))])
+               jvm_interop (|> [classT
                                 (` ("jvm member invoke constructor"
-                                    [(~+ (list\map ..var$ class-tvars))]
-                                    (~ (code.text full-name))
-                                    [(~+ (list\map ..var$ (get@ #import-member-tvars commons)))]
-                                    (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs)
-                                            (list.zip/2 input-jvm-types)
-                                            (list\map ..decorate-input)))))]
-                               (auto-convert-output (get@ #import-member-mode commons))
-                               (decorate-return-maybe member true classT)
-                               (decorate-return-try member)
-                               (decorate-return-io member))]]
-        (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)))
-                        ((~' wrap) (.list (.` (~ jvm-interop)))))))))
+                                    [(~+ (list\map ..var$ class_tvars))]
+                                    (~ (code.text full_name))
+                                    [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))]
+                                    (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs)
+                                            (list.zip/2 input_jvm_types)
+                                            (list\map ..decorate_input)))))]
+                               (auto_convert_output (get@ #import_member_mode commons))
+                               (decorate_return_maybe member true classT)
+                               (decorate_return_try member)
+                               (decorate_return_io member))]]
+        (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
+                        ((~' wrap) (.list (.` (~ jvm_interop)))))))))
 
       (#MethodDecl [commons method])
-      (with-gensyms [g!obj]
-        (do meta.monad
-          [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
-                 (^slots [#import-member-kind]) commons
-                 (^slots [#import-method-name]) method
-                 [jvm-op object-ast] (: [Text (List Code)]
-                                        (case import-member-kind
-                                          #StaticIMK
-                                          ["jvm member invoke static"
-                                           (list)]
-
-                                          #VirtualIMK
-                                          (case kind
-                                            #Class
-                                            ["jvm member invoke virtual"
-                                             (list g!obj)]
-                                            
-                                            #Interface
-                                            ["jvm member invoke interface"
-                                             (list g!obj)]
-                                            )))
-                 method-return (get@ #import-method-return method)
-                 callC (: Code
-                          (` ((~ (code.text jvm-op))
-                              [(~+ (list\map ..var$ class-tvars))]
-                              (~ (code.text full-name))
-                              (~ (code.text import-method-name))
-                              [(~+ (list\map ..var$ (get@ #import-member-tvars commons)))]
-                              (~+ (|> object-ast
-                                      (list\map ..un-quote)
-                                      (list.zip/2 (list (type.class full-name (list))))
-                                      (list\map (auto-convert-input (get@ #import-member-mode commons)))))
-                              (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs)
-                                      (list.zip/2 input-jvm-types)
-                                      (list\map ..decorate-input))))))
-                 jvm-interop (: Code
-                                (case (type.void? method-return)
-                                  (#.Left method-return)
-                                  (|> [method-return
-                                       callC]
-                                      (auto-convert-output (get@ #import-member-mode commons))
-                                      (decorate-return-maybe member false method-return)
-                                      (decorate-return-try member)
-                                      (decorate-return-io member))
-                                  
-                                  
-                                  (#.Right method-return)
-                                  (|> callC
-                                      (decorate-return-try member)
-                                      (decorate-return-io member))))]]
-          (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)) (~+ object-ast))
-                          ((~' wrap) (.list (.` (~ jvm-interop))))))))))
+      (with_gensyms [g!obj]
+                    (do meta.monad
+                      [#let [def_name (code.identifier ["" (format method_prefix member_separator (get@ #import_member_alias commons))])
+                             (^slots [#import_member_kind]) commons
+                             (^slots [#import_method_name]) method
+                             [jvm_op object_ast] (: [Text (List Code)]
+                                                    (case import_member_kind
+                                                      #StaticIMK
+                                                      ["jvm member invoke static"
+                                                       (list)]
+
+                                                      #VirtualIMK
+                                                      (case kind
+                                                        #Class
+                                                        ["jvm member invoke virtual"
+                                                         (list g!obj)]
+                                                        
+                                                        #Interface
+                                                        ["jvm member invoke interface"
+                                                         (list g!obj)]
+                                                        )))
+                             method_return (get@ #import_method_return method)
+                             callC (: Code
+                                      (` ((~ (code.text jvm_op))
+                                          [(~+ (list\map ..var$ class_tvars))]
+                                          (~ (code.text full_name))
+                                          (~ (code.text import_method_name))
+                                          [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))]
+                                          (~+ (|> object_ast
+                                                  (list\map ..un_quote)
+                                                  (list.zip/2 (list (type.class full_name (list))))
+                                                  (list\map (auto_convert_input (get@ #import_member_mode commons)))))
+                                          (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs)
+                                                  (list.zip/2 input_jvm_types)
+                                                  (list\map ..decorate_input))))))
+                             jvm_interop (: Code
+                                            (case (type.void? method_return)
+                                              (#.Left method_return)
+                                              (|> [method_return
+                                                   callC]
+                                                  (auto_convert_output (get@ #import_member_mode commons))
+                                                  (decorate_return_maybe member false method_return)
+                                                  (decorate_return_try member)
+                                                  (decorate_return_io member))
+                                              
+                                              
+                                              (#.Right method_return)
+                                              (|> callC
+                                                  (decorate_return_try member)
+                                                  (decorate_return_io member))))]]
+                      (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
+                                      ((~' wrap) (.list (.` (~ jvm_interop))))))))))
 
       (#FieldAccessDecl fad)
       (do meta.monad
         [#let [(^open ".") fad
-               getter-name (code.identifier ["" (format method-prefix member-separator import-field-name)])
-               setter-name (code.identifier ["" (format method-prefix member-separator import-field-name "!")])]
-         getter-interop (with-gensyms [g!obj]
-                          (let [getter-call (if import-field-static?
-                                              (` ((~ getter-name)))
-                                              (` ((~ getter-name) (~ g!obj))))
-                                getter-body (<| (auto-convert-output import-field-mode)
-                                                [import-field-type
-                                                 (if import-field-static?
-                                                   (get-static-field full-name import-field-name)
-                                                   (get-virtual-field full-name import-field-name (un-quote g!obj)))])
-                                getter-body (if import-field-maybe?
-                                              (` ((~! ???) (~ getter-body)))
-                                              getter-body)
-                                getter-body (if import-field-setter?
-                                              (` ((~! io.io) (~ getter-body)))
-                                              getter-body)]
-                            (wrap (` ((~! syntax:) (~ getter-call)
-                                      ((~' wrap) (.list (.` (~ getter-body)))))))))
-         setter-interop (: (Meta (List Code))
-                           (if import-field-setter?
-                             (with-gensyms [g!obj g!value]
-                               (let [setter-call (if import-field-static?
-                                                   (` ((~ setter-name) (~ g!value)))
-                                                   (` ((~ setter-name) (~ g!value) (~ g!obj))))
-                                     setter-value (|> [import-field-type (un-quote g!value)]
-                                                      (auto-convert-input import-field-mode))
-                                     setter-value (if import-field-maybe?
-                                                    (` ((~! !!!) (~ setter-value)))
-                                                    setter-value)
-                                     setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield")
-                                                            ":" full-name ":" import-field-name)
-                                     g!obj+ (: (List Code)
-                                               (if import-field-static?
-                                                 (list)
-                                                 (list (un-quote g!obj))))]
-                                 (wrap (list (` ((~! syntax:) (~ setter-call)
-                                                 ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter-command)) (~+ g!obj+) (~ setter-value))))))))))))
+               getter_name (code.identifier ["" (format method_prefix member_separator import_field_name)])
+               setter_name (code.identifier ["" (format method_prefix member_separator import_field_name "!")])]
+         getter_interop (with_gensyms [g!obj]
+                                      (let [getter_call (if import_field_static?
+                                                          (` ((~ getter_name)))
+                                                          (` ((~ getter_name) (~ g!obj))))
+                                            getter_body (<| (auto_convert_output import_field_mode)
+                                                            [import_field_type
+                                                             (if import_field_static?
+                                                               (get_static_field full_name import_field_name)
+                                                               (get_virtual_field full_name import_field_name (un_quote g!obj)))])
+                                            getter_body (if import_field_maybe?
+                                                          (` ((~! ???) (~ getter_body)))
+                                                          getter_body)
+                                            getter_body (if import_field_setter?
+                                                          (` ((~! io.io) (~ getter_body)))
+                                                          getter_body)]
+                                        (wrap (` ((~! syntax:) (~ getter_call)
+                                                  ((~' wrap) (.list (.` (~ getter_body)))))))))
+         setter_interop (: (Meta (List Code))
+                           (if import_field_setter?
+                             (with_gensyms [g!obj g!value]
+                                           (let [setter_call (if import_field_static?
+                                                               (` ((~ setter_name) (~ g!value)))
+                                                               (` ((~ setter_name) (~ g!value) (~ g!obj))))
+                                                 setter_value (|> [import_field_type (un_quote g!value)]
+                                                                  (auto_convert_input import_field_mode))
+                                                 setter_value (if import_field_maybe?
+                                                                (` ((~! !!!) (~ setter_value)))
+                                                                setter_value)
+                                                 setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield")
+                                                                        ":" full_name ":" import_field_name)
+                                                 g!obj+ (: (List Code)
+                                                           (if import_field_static?
+                                                             (list)
+                                                             (list (un_quote g!obj))))]
+                                             (wrap (list (` ((~! syntax:) (~ setter_call)
+                                                             ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
                              (wrap (list))))]
-        (wrap (list& getter-interop setter-interop)))
+        (wrap (list& getter_interop setter_interop)))
       )))
 
-(def: (member-import$ vars kind class member)
-  (-> (List (Type Var)) Class-Kind (Type Declaration) Import-Member-Declaration (Meta (List Code)))
-  (let [[full-name _] (parser.declaration class)
-        method-prefix (..internal full-name)]
+(def: (member_import$ vars kind class member)
+  (-> (List (Type Var)) Class_Kind (Type Declaration) Import_Member_Declaration (Meta (List Code)))
+  (let [[full_name _] (parser.declaration class)
+        method_prefix (..internal full_name)]
     (do meta.monad
-      [=args (member-def-arg-bindings vars member)]
-      (member-def-interop vars kind class =args member method-prefix))))
+      [=args (member_def_arg_bindings vars member)]
+      (member_def_interop vars kind class =args member method_prefix))))
 
 (def: interface?
   (All [a] (-> (primitive "java.lang.Class" [a]) Bit))
@@ -1688,28 +1688,28 @@
        (: ..Boolean)
        (:coerce Bit)))
 
-(def: load-class
+(def: load_class
   (-> External (Try (primitive "java.lang.Class" [Any])))
   (|>> (:coerce (primitive "java.lang.String"))
        ["Ljava/lang/String;"]
        ("jvm member invoke static" [] "java.lang.Class" "forName" [])
        ..try))
 
-(def: (class-kind declaration)
-  (-> (Type Declaration) (Meta Class-Kind))
-  (let [[class-name _] (parser.declaration declaration)]
-    (case (load-class class-name)
+(def: (class_kind declaration)
+  (-> (Type Declaration) (Meta Class_Kind))
+  (let [[class_name _] (parser.declaration declaration)]
+    (case (load_class class_name)
       (#.Right class)
       (\ meta.monad wrap (if (interface? class)
                            #Interface
                            #Class))
 
       (#.Left _)
-      (meta.fail (format "Unknown class: " class-name)))))
+      (meta.fail (format "Unknown class: " class_name)))))
 
 (syntax: #export (import:
                    {declaration ..declaration^}
-                   {members (<>.some (..import-member-decl^ class-type-vars))})
+                   {members (<>.some (..import_member_decl^ class_type_vars))})
   {#.doc (doc "Allows importing JVM classes, and using them as types."
               "Their methods, fields and enum options can also be imported."
               (import: java/lang/Object
@@ -1725,7 +1725,7 @@
               (import: java/lang/String
                 (new [[byte]])
                 (#static valueOf [char] java/lang/String)
-                (#static valueOf #as int-valueOf [int] java/lang/String))
+                (#static valueOf #as int_valueOf [int] java/lang/String))
 
               (import: (java/util/List e)
                 (size [] int)
@@ -1751,14 +1751,14 @@
               
               "Also, the names of the imported members will look like Class::member"
               (java/lang/Object::new [])
-              (java/lang/Object::equals [other-object] my-object)
-              (java/util/List::size [] my-list)
+              (java/lang/Object::equals [other_object] my_object)
+              (java/util/List::size [] my_list)
               java/lang/Character$UnicodeScript::LATIN
               )}
   (do {! meta.monad}
-    [kind (class-kind declaration)
-     =members (monad.map ! (member-import$ class-type-vars kind declaration) members)]
-    (wrap (list& (class-import$ declaration) (list\join =members)))))
+    [kind (class_kind declaration)
+     =members (monad.map ! (member_import$ class_type_vars kind declaration) members)]
+    (wrap (list& (class_import$ declaration) (list\join =members)))))
 
 (syntax: #export (array {type (..type^ (list))}
                         size)
@@ -1769,9 +1769,9 @@
                        (.:coerce (.primitive (~ (code.text box.long))))
                        "jvm object cast"
                        "jvm conversion long-to-int"))]
-    (`` (cond (~~ (template [ ]
+    (`` (cond (~~ (template [ ]
                     [(\ type.equivalence =  type)
-                     (wrap (list (` ( (~ g!size)))))]
+                     (wrap (list (` ( (~ g!size)))))]
 
                     [type.boolean "jvm array new boolean"]
                     [type.byte    "jvm array new byte"]
@@ -1782,116 +1782,116 @@
                     [type.double  "jvm array new double"]
                     [type.char    "jvm array new char"]))
               ## else
-              (wrap (list (` (: (~ (value-type #ManualPrM (type.array type)))
+              (wrap (list (` (: (~ (value_type #ManualPrM (type.array type)))
                                 ("jvm array new object" (~ g!size))))))))))
 
-(exception: #export (cannot-convert-to-jvm-type {type .Type})
+(exception: #export (cannot_convert_to_jvm_type {type .Type})
   (exception.report
    ["Lux Type" (%.type type)]))
 
-(with-expansions [ (as-is (meta.fail (exception.construct ..cannot-convert-to-jvm-type [type])))]
-  (def: (lux-type->jvm-type type)
-    (-> .Type (Meta (Type Value)))
-    (if (lux-type\= Any type)
-      (\ meta.monad wrap $Object)
-      (case type
-        (#.Primitive name params)
-        (`` (cond (~~ (template []
-                        [(text\= (..reflection ) name)
-                         (case params
-                           #.Nil
-                           (\ meta.monad wrap )
-
-                           _
-                           )]
-                        
-                        [type.boolean]
-                        [type.byte]
-                        [type.short]
-                        [type.int]
-                        [type.long]
-                        [type.float]
-                        [type.double]
-                        [type.char]))
-
-                  (~~ (template []
-                        [(text\= (..reflection (type.array )) name)
-                         (case params
-                           #.Nil
-                           (\ meta.monad wrap (type.array ))
-
-                           _
-                           )]
-                        
-                        [type.boolean]
-                        [type.byte]
-                        [type.short]
-                        [type.int]
-                        [type.long]
-                        [type.float]
-                        [type.double]
-                        [type.char]))
-
-                  (text\= array.type-name name)
-                  (case params
-                    (#.Cons elementLT #.Nil)
-                    (\ meta.monad map type.array
-                       (lux-type->jvm-type elementLT))
-
-                    _
-                    )
-
-                  (text.starts-with? descriptor.array-prefix name)
-                  (case params
-                    #.Nil
-                    (let [[_ unprefixed] (maybe.assume (text.split-with descriptor.array-prefix name))]
-                      (\ meta.monad map type.array
-                         (lux-type->jvm-type (#.Primitive unprefixed (list)))))
-
-                    _
-                    )
-
-                  ## else
-                  (\ meta.monad map (type.class name)
-                     (: (Meta (List (Type Parameter)))
-                        (monad.map meta.monad
-                                   (function (_ paramLT)
-                                     (do meta.monad
-                                       [paramJT (lux-type->jvm-type paramLT)]
-                                       (case (parser.parameter? paramJT)
-                                         (#.Some paramJT)
-                                         (wrap paramJT)
-
-                                         #.None
-                                         )))
-                                   params)))))
-
-        (#.Apply A F)
-        (case (lux-type.apply (list A) F)
-          #.None
-          
-
-          (#.Some type')
-          (lux-type->jvm-type type'))
-        
-        (#.Named _ type')
-        (lux-type->jvm-type type')
-
-        _
-        ))))
-
-(syntax: #export (array-length array)
+(with_expansions [ (as_is (meta.fail (exception.construct ..cannot_convert_to_jvm_type [type])))]
+                 (def: (lux_type->jvm_type type)
+                   (-> .Type (Meta (Type Value)))
+                   (if (lux_type\= Any type)
+                     (\ meta.monad wrap $Object)
+                     (case type
+                       (#.Primitive name params)
+                       (`` (cond (~~ (template []
+                                       [(text\= (..reflection ) name)
+                                        (case params
+                                          #.Nil
+                                          (\ meta.monad wrap )
+
+                                          _
+                                          )]
+                                       
+                                       [type.boolean]
+                                       [type.byte]
+                                       [type.short]
+                                       [type.int]
+                                       [type.long]
+                                       [type.float]
+                                       [type.double]
+                                       [type.char]))
+
+                                 (~~ (template []
+                                       [(text\= (..reflection (type.array )) name)
+                                        (case params
+                                          #.Nil
+                                          (\ meta.monad wrap (type.array ))
+
+                                          _
+                                          )]
+                                       
+                                       [type.boolean]
+                                       [type.byte]
+                                       [type.short]
+                                       [type.int]
+                                       [type.long]
+                                       [type.float]
+                                       [type.double]
+                                       [type.char]))
+
+                                 (text\= array.type_name name)
+                                 (case params
+                                   (#.Cons elementLT #.Nil)
+                                   (\ meta.monad map type.array
+                                      (lux_type->jvm_type elementLT))
+
+                                   _
+                                   )
+
+                                 (text.starts_with? descriptor.array_prefix name)
+                                 (case params
+                                   #.Nil
+                                   (let [[_ unprefixed] (maybe.assume (text.split_with descriptor.array_prefix name))]
+                                     (\ meta.monad map type.array
+                                        (lux_type->jvm_type (#.Primitive unprefixed (list)))))
+
+                                   _
+                                   )
+
+                                 ## else
+                                 (\ meta.monad map (type.class name)
+                                    (: (Meta (List (Type Parameter)))
+                                       (monad.map meta.monad
+                                                  (function (_ paramLT)
+                                                    (do meta.monad
+                                                      [paramJT (lux_type->jvm_type paramLT)]
+                                                      (case (parser.parameter? paramJT)
+                                                        (#.Some paramJT)
+                                                        (wrap paramJT)
+
+                                                        #.None
+                                                        )))
+                                                  params)))))
+
+                       (#.Apply A F)
+                       (case (lux_type.apply (list A) F)
+                         #.None
+                         
+
+                         (#.Some type')
+                         (lux_type->jvm_type type'))
+                       
+                       (#.Named _ type')
+                       (lux_type->jvm_type type')
+
+                       _
+                       ))))
+
+(syntax: #export (array_length array)
   {#.doc (doc "Gives the length of an array."
-              (array-length my-array))}
+              (array_length my_array))}
   (case array
-    [_ (#.Identifier array-name)]
+    [_ (#.Identifier array_name)]
     (do meta.monad
-      [array-type (meta.find-type array-name)
-       array-jvm-type (lux-type->jvm-type array-type)
+      [array_type (meta.find_type array_name)
+       array_jvm_type (lux_type->jvm_type array_type)
        #let [g!extension (code.text (`` (cond (~~ (template [ ]
                                                     [(\ type.equivalence =
                                                         (type.array )
-                                                        array-jvm-type)
+                                                        array_jvm_type)
                                                      ]
 
                                                     [type.boolean "jvm array length boolean"]
@@ -1912,18 +1912,18 @@
                           (.:coerce .Nat))))))
 
     _
-    (with-gensyms [g!array]
-      (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-length (~ g!array)))))))))
+    (with_gensyms [g!array]
+                  (wrap (list (` (let [(~ g!array) (~ array)]
+                                   (..array_length (~ g!array)))))))))
 
-(syntax: #export (array-read idx array)
+(syntax: #export (array_read idx array)
   {#.doc (doc "Loads an element from an array."
-              (array-read 10 my-array))}
+              (array_read 10 my_array))}
   (case array
-    [_ (#.Identifier array-name)]
+    [_ (#.Identifier array_name)]
     (do meta.monad
-      [array-type (meta.find-type array-name)
-       array-jvm-type (lux-type->jvm-type array-type)
+      [array_type (meta.find_type array_name)
+       array_jvm_type (lux_type->jvm_type array_type)
        #let [g!idx (` (.|> (~ idx)
                            (.: .Nat)
                            (.:coerce (.primitive (~ (code.text box.long))))
@@ -1932,7 +1932,7 @@
       (`` (cond (~~ (template [  ]
                       [(\ type.equivalence =
                           (type.array )
-                          array-jvm-type)
+                          array_jvm_type)
                        (wrap (list (` (.|> ( (~ g!idx) (~ array))
                                            "jvm object cast"
                                            (.: (.primitive (~ (code.text ))))))))]
@@ -1950,18 +1950,18 @@
                 (wrap (list (` ("jvm array read object" (~ g!idx) (~ array))))))))
 
     _
-    (with-gensyms [g!array]
-      (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-read (~ idx) (~ g!array)))))))))
+    (with_gensyms [g!array]
+                  (wrap (list (` (let [(~ g!array) (~ array)]
+                                   (..array_read (~ idx) (~ g!array)))))))))
 
-(syntax: #export (array-write idx value array)
+(syntax: #export (array_write idx value array)
   {#.doc (doc "Stores an element into an array."
-              (array-write 10 my-object my-array))}
+              (array_write 10 my_object my_array))}
   (case array
-    [_ (#.Identifier array-name)]
+    [_ (#.Identifier array_name)]
     (do meta.monad
-      [array-type (meta.find-type array-name)
-       array-jvm-type (lux-type->jvm-type array-type)
+      [array_type (meta.find_type array_name)
+       array_jvm_type (lux_type->jvm_type array_type)
        #let [g!idx (` (.|> (~ idx)
                            (.: .Nat)
                            (.:coerce (.primitive (~ (code.text box.long))))
@@ -1970,7 +1970,7 @@
       (`` (cond (~~ (template [  ]
                       [(\ type.equivalence =
                           (type.array )
-                          array-jvm-type)
+                          array_jvm_type)
                        (let [g!value (` (.|> (~ value)
                                              (.:coerce (.primitive (~ (code.text ))))
                                              "jvm object cast"))]
@@ -1989,14 +1989,14 @@
                 (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array))))))))
 
     _
-    (with-gensyms [g!array]
-      (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-write (~ idx) (~ value) (~ g!array)))))))))
+    (with_gensyms [g!array]
+                  (wrap (list (` (let [(~ g!array) (~ array)]
+                                   (..array_write (~ idx) (~ value) (~ g!array)))))))))
 
-(syntax: #export (class-for {type (..type^ (list))})
+(syntax: #export (class_for {type (..type^ (list))})
   {#.doc (doc "Loads the class as a java.lang.Class object."
-              (class-for java/lang/String))}
+              (class_for java/lang/String))}
   (wrap (list (` ("jvm object class" (~ (code.text (..reflection type))))))))
 
 (syntax: #export (type {type (..type^ (list))})
-  (wrap (list (value-type #ManualPrM type))))
+  (wrap (list (value_type #ManualPrM type))))
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index 8bc8cbea0..461a99a77 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -23,7 +23,7 @@
    [macro
     ["." code]
     [syntax (#+ syntax:)]]
-   ["." meta (#+ with-gensyms)
+   ["." meta (#+ with_gensyms)
     ["." annotation]]])
 
 (template [   ]
@@ -34,43 +34,43 @@
      (-> (primitive ) (primitive ))
      ( value))]
 
-  [byte-to-long "jvm convert byte-to-long" "java.lang.Byte"      "java.lang.Long"]
+  [byte_to_long "jvm convert byte-to-long" "java.lang.Byte"      "java.lang.Long"]
 
-  [short-to-long "jvm convert short-to-long" "java.lang.Short"     "java.lang.Long"]
+  [short_to_long "jvm convert short-to-long" "java.lang.Short"     "java.lang.Long"]
   
-  [double-to-int "jvm convert double-to-int" "java.lang.Double"    "java.lang.Integer"]
-  [double-to-long "jvm convert double-to-long" "java.lang.Double"    "java.lang.Long"]
-  [double-to-float "jvm convert double-to-float" "java.lang.Double"    "java.lang.Float"]
+  [double_to_int "jvm convert double-to-int" "java.lang.Double"    "java.lang.Integer"]
+  [double_to_long "jvm convert double-to-long" "java.lang.Double"    "java.lang.Long"]
+  [double_to_float "jvm convert double-to-float" "java.lang.Double"    "java.lang.Float"]
 
-  [float-to-int "jvm convert float-to-int" "java.lang.Float"     "java.lang.Integer"]
-  [float-to-long "jvm convert float-to-long" "java.lang.Float"     "java.lang.Long"]
-  [float-to-double "jvm convert float-to-double" "java.lang.Float"     "java.lang.Double"]
+  [float_to_int "jvm convert float-to-int" "java.lang.Float"     "java.lang.Integer"]
+  [float_to_long "jvm convert float-to-long" "java.lang.Float"     "java.lang.Long"]
+  [float_to_double "jvm convert float-to-double" "java.lang.Float"     "java.lang.Double"]
   
-  [int-to-byte "jvm convert int-to-byte" "java.lang.Integer"   "java.lang.Byte"]
-  [int-to-short "jvm convert int-to-short" "java.lang.Integer"   "java.lang.Short"]
-  [int-to-long "jvm convert int-to-long" "java.lang.Integer"   "java.lang.Long"]
-  [int-to-float "jvm convert int-to-float" "java.lang.Integer"   "java.lang.Float"]
-  [int-to-double "jvm convert int-to-double" "java.lang.Integer"   "java.lang.Double"]
-  [int-to-char "jvm convert int-to-char" "java.lang.Integer"   "java.lang.Character"]
-
-  [long-to-byte "jvm convert long-to-byte" "java.lang.Long"      "java.lang.Byte"]
-  [long-to-short "jvm convert long-to-short" "java.lang.Long"      "java.lang.Short"]
-  [long-to-int "jvm convert long-to-int" "java.lang.Long"      "java.lang.Integer"]
-  [long-to-float "jvm convert long-to-float" "java.lang.Long"      "java.lang.Float"]
-  [long-to-double "jvm convert long-to-double" "java.lang.Long"      "java.lang.Double"]
-
-  [char-to-byte "jvm convert char-to-byte" "java.lang.Character" "java.lang.Byte"]
-  [char-to-short "jvm convert char-to-short" "java.lang.Character" "java.lang.Short"]
-  [char-to-int "jvm convert char-to-int" "java.lang.Character" "java.lang.Integer"]
-  [char-to-long "jvm convert char-to-long" "java.lang.Character" "java.lang.Long"]
+  [int_to_byte "jvm convert int-to-byte" "java.lang.Integer"   "java.lang.Byte"]
+  [int_to_short "jvm convert int-to-short" "java.lang.Integer"   "java.lang.Short"]
+  [int_to_long "jvm convert int-to-long" "java.lang.Integer"   "java.lang.Long"]
+  [int_to_float "jvm convert int-to-float" "java.lang.Integer"   "java.lang.Float"]
+  [int_to_double "jvm convert int-to-double" "java.lang.Integer"   "java.lang.Double"]
+  [int_to_char "jvm convert int-to-char" "java.lang.Integer"   "java.lang.Character"]
+
+  [long_to_byte "jvm convert long-to-byte" "java.lang.Long"      "java.lang.Byte"]
+  [long_to_short "jvm convert long-to-short" "java.lang.Long"      "java.lang.Short"]
+  [long_to_int "jvm convert long-to-int" "java.lang.Long"      "java.lang.Integer"]
+  [long_to_float "jvm convert long-to-float" "java.lang.Long"      "java.lang.Float"]
+  [long_to_double "jvm convert long-to-double" "java.lang.Long"      "java.lang.Double"]
+
+  [char_to_byte "jvm convert char-to-byte" "java.lang.Character" "java.lang.Byte"]
+  [char_to_short "jvm convert char-to-short" "java.lang.Character" "java.lang.Short"]
+  [char_to_int "jvm convert char-to-int" "java.lang.Character" "java.lang.Integer"]
+  [char_to_long "jvm convert char-to-long" "java.lang.Character" "java.lang.Long"]
   )
 
 ## [Utils]
-(def: constructor-method-name "")
-(def: member-separator "::")
+(def: constructor_method_name "")
+(def: member_separator "::")
 
 ## Types
-(type: JVM-Code Text)
+(type: JVM_Code Text)
 
 (type: BoundKind
   #UpperBound
@@ -82,10 +82,10 @@
   (#GenericArray GenericType)
   (#GenericWildcard (Maybe [BoundKind GenericType])))
 
-(type: Type-Parameter
+(type: Type_Parameter
   [Text (List GenericType)])
 
-(type: Primitive-Mode
+(type: Primitive_Mode
   #ManualPrM
   #AutoPrM)
 
@@ -105,129 +105,129 @@
   #AbstractIM
   #DefaultIM)
 
-(type: Class-Kind
+(type: Class_Kind
   #Class
   #Interface)
 
-(type: Class-Declaration
-  {#class-name   Text
-   #class-params (List Type-Parameter)})
+(type: Class_Declaration
+  {#class_name   Text
+   #class_params (List Type_Parameter)})
 
 (type: StackFrame (primitive "java/lang/StackTraceElement"))
 (type: StackTrace (Array StackFrame))
 
-(type: Super-Class-Decl
-  {#super-class-name   Text
-   #super-class-params (List GenericType)})
+(type: Super_Class_Decl
+  {#super_class_name   Text
+   #super_class_params (List GenericType)})
 
 (type: AnnotationParam
   [Text Code])
 
 (type: Annotation
-  {#ann-name   Text
-   #ann-params (List AnnotationParam)})
+  {#ann_name   Text
+   #ann_params (List AnnotationParam)})
 
-(type: Member-Declaration
-  {#member-name Text
-   #member-privacy PrivacyModifier
-   #member-anns (List Annotation)})
+(type: Member_Declaration
+  {#member_name Text
+   #member_privacy PrivacyModifier
+   #member_anns (List Annotation)})
 
 (type: FieldDecl
   (#ConstantField GenericType Code)
   (#VariableField StateModifier GenericType))
 
 (type: MethodDecl
-  {#method-tvars  (List Type-Parameter)
-   #method-inputs (List GenericType)
-   #method-output GenericType
-   #method-exs    (List GenericType)})
+  {#method_tvars  (List Type_Parameter)
+   #method_inputs (List GenericType)
+   #method_output GenericType
+   #method_exs    (List GenericType)})
 
 (type: ArgDecl
-  {#arg-name Text
-   #arg-type GenericType})
+  {#arg_name Text
+   #arg_type GenericType})
 
 (type: ConstructorArg
   [GenericType Code])
 
-(type: Method-Definition
+(type: Method_Definition
   (#ConstructorMethod [Bit
-                       (List Type-Parameter)
+                       (List Type_Parameter)
                        (List ArgDecl)
                        (List ConstructorArg)
                        Code
                        (List GenericType)])
   (#VirtualMethod [Bit
                    Bit
-                   (List Type-Parameter)
+                   (List Type_Parameter)
                    Text
                    (List ArgDecl)
                    GenericType
                    Code
                    (List GenericType)])
   (#OverridenMethod [Bit
-                     Class-Declaration
-                     (List Type-Parameter)
+                     Class_Declaration
+                     (List Type_Parameter)
                      Text
                      (List ArgDecl)
                      GenericType
                      Code
                      (List GenericType)])
   (#StaticMethod [Bit
-                  (List Type-Parameter)
+                  (List Type_Parameter)
                   (List ArgDecl)
                   GenericType
                   Code
                   (List GenericType)])
-  (#AbstractMethod [(List Type-Parameter)
+  (#AbstractMethod [(List Type_Parameter)
                     (List ArgDecl)
                     GenericType
                     (List GenericType)])
-  (#NativeMethod [(List Type-Parameter)
+  (#NativeMethod [(List Type_Parameter)
                   (List ArgDecl)
                   GenericType
                   (List GenericType)]))
 
-(type: Partial-Call
-  {#pc-method Name
-   #pc-args   (List Code)})
+(type: Partial_Call
+  {#pc_method Name
+   #pc_args   (List Code)})
 
 (type: ImportMethodKind
   #StaticIMK
   #VirtualIMK)
 
 (type: ImportMethodCommons
-  {#import-member-mode   Primitive-Mode
-   #import-member-alias  Text
-   #import-member-kind   ImportMethodKind
-   #import-member-tvars  (List Type-Parameter)
-   #import-member-args   (List [Bit GenericType])
-   #import-member-maybe? Bit
-   #import-member-try?   Bit
-   #import-member-io?    Bit})
+  {#import_member_mode   Primitive_Mode
+   #import_member_alias  Text
+   #import_member_kind   ImportMethodKind
+   #import_member_tvars  (List Type_Parameter)
+   #import_member_args   (List [Bit GenericType])
+   #import_member_maybe? Bit
+   #import_member_try?   Bit
+   #import_member_io?    Bit})
 
 (type: ImportConstructorDecl
   {})
 
 (type: ImportMethodDecl
-  {#import-method-name    Text
-   #import-method-return  GenericType})
+  {#import_method_name    Text
+   #import_method_return  GenericType})
 
 (type: ImportFieldDecl
-  {#import-field-mode    Primitive-Mode
-   #import-field-name    Text
-   #import-field-static? Bit
-   #import-field-maybe?  Bit
-   #import-field-setter? Bit
-   #import-field-type    GenericType})
-
-(type: Import-Member-Declaration
+  {#import_field_mode    Primitive_Mode
+   #import_field_name    Text
+   #import_field_static? Bit
+   #import_field_maybe?  Bit
+   #import_field_setter? Bit
+   #import_field_type    GenericType})
+
+(type: Import_Member_Declaration
   (#EnumDecl        (List Text))
   (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl])
   (#MethodDecl      [ImportMethodCommons ImportMethodDecl])
   (#FieldAccessDecl ImportFieldDecl))
 
 ## Utils
-(def: (manual-primitive-to-type class)
+(def: (manual_primitive_to_type class)
   (-> Text (Maybe Code))
   (case class
     (^template [ ]
@@ -246,7 +246,7 @@
     _
     #.None))
 
-(def: (auto-primitive-to-type class)
+(def: (auto_primitive_to_type class)
   (-> Text (Maybe Code))
   (case class
     (^template [ ]
@@ -266,82 +266,82 @@
 
 (def: sanitize
   (-> Text Text)
-  (text.replace-all "/" "."))
+  (text.replace_all "/" "."))
 
-(def: (generic-class->type' mode type-params in-array? name+params
+(def: (generic_class->type' mode type_params in_array? name+params
                             class->type')
-  (-> Primitive-Mode (List Type-Parameter) Bit [Text (List GenericType)]
-      (-> Primitive-Mode (List Type-Parameter) Bit GenericType Code)
+  (-> Primitive_Mode (List Type_Parameter) Bit [Text (List GenericType)]
+      (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code)
       Code)
-  (case [name+params mode in-array?]
+  (case [name+params mode in_array?]
     (^multi [[prim #.Nil] #ManualPrM #0]
-            [(manual-primitive-to-type prim) (#.Some output)])
+            [(manual_primitive_to_type prim) (#.Some output)])
     output
 
     (^multi [[prim #.Nil] #AutoPrM #0]
-            [(auto-primitive-to-type prim) (#.Some output)])
+            [(auto_primitive_to_type prim) (#.Some output)])
     output
     
     [[name params] _ _]
     (let [name (sanitize name)
-          =params (list\map (class->type' mode type-params in-array?) params)]
+          =params (list\map (class->type' mode type_params in_array?) params)]
       (` (primitive (~ (code.text name)) [(~+ =params)])))))
 
-(def: (class->type' mode type-params in-array? class)
-  (-> Primitive-Mode (List Type-Parameter) Bit GenericType Code)
+(def: (class->type' mode type_params in_array? class)
+  (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code)
   (case class
     (#GenericTypeVar name)
     (case (list.find (function (_ [pname pbounds])
                        (and (text\= name pname)
                             (not (list.empty? pbounds))))
-                     type-params)
+                     type_params)
       #.None
       (code.identifier ["" name])
 
       (#.Some [pname pbounds])
-      (class->type' mode type-params in-array? (maybe.assume (list.head pbounds))))
+      (class->type' mode type_params in_array? (maybe.assume (list.head pbounds))))
     
     (#GenericClass name+params)
-    (generic-class->type' mode type-params in-array? name+params
+    (generic_class->type' mode type_params in_array? name+params
                           class->type')
 
     (#GenericArray param)
-    (let [=param (class->type' mode type-params #1 param)]
+    (let [=param (class->type' mode type_params #1 param)]
       (` ((~! array.Array) (~ =param))))
 
     (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _])))
     (` .Any)
 
-    (#GenericWildcard (#.Some [#UpperBound upper-bound]))
-    (class->type' mode type-params in-array? upper-bound)
+    (#GenericWildcard (#.Some [#UpperBound upper_bound]))
+    (class->type' mode type_params in_array? upper_bound)
     ))
 
-(def: (class->type mode type-params class)
-  (-> Primitive-Mode (List Type-Parameter) GenericType Code)
-  (class->type' mode type-params #0 class))
+(def: (class->type mode type_params class)
+  (-> Primitive_Mode (List Type_Parameter) GenericType Code)
+  (class->type' mode type_params #0 class))
 
-(def: (type-param-type$ [name bounds])
-  (-> Type-Parameter Code)
+(def: (type_param_type$ [name bounds])
+  (-> Type_Parameter Code)
   (code.identifier ["" name]))
 
-(def: (class-decl-type$ (^slots [#class-name #class-params]))
-  (-> Class-Declaration Code)
-  (let [=params (list\map (: (-> Type-Parameter Code)
+(def: (class_decl_type$ (^slots [#class_name #class_params]))
+  (-> Class_Declaration Code)
+  (let [=params (list\map (: (-> Type_Parameter Code)
                              (function (_ [pname pbounds])
                                (case pbounds
                                  #.Nil
                                  (code.identifier ["" pname])
 
                                  (#.Cons bound1 _)
-                                 (class->type #ManualPrM class-params bound1))))
-                          class-params)]
-    (` (primitive (~ (code.text (sanitize class-name)))
+                                 (class->type #ManualPrM class_params bound1))))
+                          class_params)]
+    (` (primitive (~ (code.text (sanitize class_name)))
                   [(~+ =params)]))))
 
-(def: type-var-class Text "java.lang.Object")
+(def: type_var_class Text "java.lang.Object")
 
-(def: (simple-class$ env class)
-  (-> (List Type-Parameter) GenericType Text)
+(def: (simple_class$ env class)
+  (-> (List Type_Parameter) GenericType Text)
   (case class
     (#GenericTypeVar name)
     (case (list.find (function (_ [pname pbounds])
@@ -349,16 +349,16 @@
                             (not (list.empty? pbounds))))
                      env)
       #.None
-      type-var-class
+      type_var_class
 
       (#.Some [pname pbounds])
-      (simple-class$ env (maybe.assume (list.head pbounds))))
+      (simple_class$ env (maybe.assume (list.head pbounds))))
 
     (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _])))
-    type-var-class
+    type_var_class
     
-    (#GenericWildcard (#.Some [#UpperBound upper-bound]))
-    (simple-class$ env upper-bound)
+    (#GenericWildcard (#.Some [#UpperBound upper_bound]))
+    (simple_class$ env upper_bound)
     
     (#GenericClass name env)
     (sanitize name)
@@ -366,7 +366,7 @@
     (#GenericArray param')
     (case param'
       (#GenericArray param)
-      (format "[" (simple-class$ env param))
+      (format "[" (simple_class$ env param))
       
       (^template [ ]
         [(#GenericClass  #.Nil)
@@ -381,44 +381,44 @@
        ["char"    "[C"])
       
       param
-      (format "[L" (simple-class$ env param) ";"))
+      (format "[L" (simple_class$ env param) ";"))
     ))
 
-(def: (make-get-const-parser class-name field-name)
+(def: (make_get_const_parser class_name field_name)
   (-> Text Text (Parser Code))
   (do p.monad
-    [#let [dotted-name (format "::" field-name)]
-     _ (s.this! (code.identifier ["" dotted-name]))]
-    (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class-name ":" field-name))))))))
+    [#let [dotted_name (format "::" field_name)]
+     _ (s.this! (code.identifier ["" dotted_name]))]
+    (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class_name ":" field_name))))))))
 
-(def: (make-get-var-parser class-name field-name)
+(def: (make_get_var_parser class_name field_name)
   (-> Text Text (Parser Code))
   (do p.monad
-    [#let [dotted-name (format "::" field-name)]
-     _ (s.this! (code.identifier ["" dotted-name]))]
-    (wrap (`' ((~ (code.text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this)))))
+    [#let [dotted_name (format "::" field_name)]
+     _ (s.this! (code.identifier ["" dotted_name]))]
+    (wrap (`' ((~ (code.text (format "jvm getfield" ":" class_name ":" field_name))) _jvm_this)))))
 
-(def: (make-put-var-parser class-name field-name)
+(def: (make_put_var_parser class_name field_name)
   (-> Text Text (Parser Code))
   (do p.monad
-    [#let [dotted-name (format "::" field-name)]
+    [#let [dotted_name (format "::" field_name)]
      [_ _ value] (: (Parser [Any Any Code])
-                    (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))]
-    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))
+                    (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted_name])) s.any)))]
+    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value))))))
 
-(def: (pre-walk-replace f input)
+(def: (pre_walk_replace f input)
   (-> (-> Code Code) Code Code)
   (case (f input)
     (^template []
       [[meta ( parts)]
-       [meta ( (list\map (pre-walk-replace f) parts))]])
+       [meta ( (list\map (pre_walk_replace f) parts))]])
     ([#.Form]
      [#.Tuple])
     
     [meta (#.Record pairs)]
     [meta (#.Record (list\map (: (-> [Code Code] [Code Code])
                                  (function (_ [key val])
-                                   [(pre-walk-replace f key) (pre-walk-replace f val)]))
+                                   [(pre_walk_replace f key) (pre_walk_replace f val)]))
                               pairs))]
     
     ast'
@@ -434,74 +434,74 @@
     ast
     ))
 
-(def: (field->parser class-name [[field-name _ _] field])
-  (-> Text [Member-Declaration FieldDecl] (Parser Code))
+(def: (field->parser class_name [[field_name _ _] field])
+  (-> Text [Member_Declaration FieldDecl] (Parser Code))
   (case field
     (#ConstantField _)
-    (make-get-const-parser class-name field-name)
+    (make_get_const_parser class_name field_name)
     
     (#VariableField _)
-    (p.either (make-get-var-parser class-name field-name)
-              (make-put-var-parser class-name field-name))))
+    (p.either (make_get_var_parser class_name field_name)
+              (make_put_var_parser class_name field_name))))
 
-(def: (make-constructor-parser params class-name arg-decls)
-  (-> (List Type-Parameter) Text (List ArgDecl) (Parser Code))
+(def: (make_constructor_parser params class_name arg_decls)
+  (-> (List Type_Parameter) Text (List ArgDecl) (Parser Code))
   (do p.monad
     [args (: (Parser (List Code))
              (s.form (p.after (s.this! (' ::new!))
-                              (s.tuple (p.exactly (list.size arg-decls) s.any)))))
-     #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]]
-    (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls'))))
+                              (s.tuple (p.exactly (list.size arg_decls) s.any)))))
+     #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]]
+    (wrap (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls'))))
               (~+ args))))))
 
-(def: (make-static-method-parser params class-name method-name arg-decls)
-  (-> (List Type-Parameter) Text Text (List ArgDecl) (Parser Code))
+(def: (make_static_method_parser params class_name method_name arg_decls)
+  (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code))
   (do p.monad
-    [#let [dotted-name (format "::" method-name "!")]
+    [#let [dotted_name (format "::" method_name "!")]
      args (: (Parser (List Code))
-             (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
-                              (s.tuple (p.exactly (list.size arg-decls) s.any)))))
-     #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]]
-    (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
+             (s.form (p.after (s.this! (code.identifier ["" dotted_name]))
+                              (s.tuple (p.exactly (list.size arg_decls) s.any)))))
+     #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]]
+    (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls'))))
                (~+ args))))))
 
-(template [ ]
-  [(def: ( params class-name method-name arg-decls)
-     (-> (List Type-Parameter) Text Text (List ArgDecl) (Parser Code))
+(template [ ]
+  [(def: ( params class_name method_name arg_decls)
+     (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code))
      (do p.monad
-       [#let [dotted-name (format "::" method-name "!")]
+       [#let [dotted_name (format "::" method_name "!")]
         args (: (Parser (List Code))
-                (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
-                                 (s.tuple (p.exactly (list.size arg-decls) s.any)))))
-        #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]]
-       (wrap (`' ((~ (code.text (format  ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
+                (s.form (p.after (s.this! (code.identifier ["" dotted_name]))
+                                 (s.tuple (p.exactly (list.size arg_decls) s.any)))))
+        #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]]
+       (wrap (`' ((~ (code.text (format  ":" class_name ":" method_name ":" (text.join_with "," arg_decls'))))
                   (~' _jvm_this) (~+ args))))))]
 
-  [make-special-method-parser "jvm invokespecial"]
-  [make-virtual-method-parser "jvm invokevirtual"]
+  [make_special_method_parser "jvm invokespecial"]
+  [make_virtual_method_parser "jvm invokevirtual"]
   )
 
-(def: (method->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)
-    (make-constructor-parser params class-name args)
+(def: (method->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)
+    (make_constructor_parser params class_name args)
     
-    (#StaticMethod strict? type-vars args return-type return-expr exs)
-    (make-static-method-parser params class-name method-name args)
+    (#StaticMethod strict? type_vars args return_type return_expr exs)
+    (make_static_method_parser params class_name method_name args)
     
-    (^or (#VirtualMethod final? strict? type-vars self-name args return-type return-expr exs)
-         (#OverridenMethod strict? owner-class type-vars self-name args return-type return-expr exs))
-    (make-special-method-parser params class-name method-name args)
+    (^or (#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs)
+         (#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs))
+    (make_special_method_parser params class_name method_name args)
 
-    (#AbstractMethod type-vars args return-type exs)
-    (make-virtual-method-parser params class-name method-name args)
+    (#AbstractMethod type_vars args return_type exs)
+    (make_virtual_method_parser params class_name method_name args)
 
-    (#NativeMethod type-vars args return-type exs)
-    (make-virtual-method-parser params class-name method-name args)))
+    (#NativeMethod type_vars args return_type exs)
+    (make_virtual_method_parser params class_name method_name args)))
 
 ## Parsers
-(def: privacy-modifier^
+(def: privacy_modifier^
   (Parser PrivacyModifier)
   (let [(^open ".") p.monad]
     ($_ p.or
@@ -510,7 +510,7 @@
         (s.this! (' #protected))
         (wrap []))))
 
-(def: inheritance-modifier^
+(def: inheritance_modifier^
   (Parser InheritanceModifier)
   (let [(^open ".") p.monad]
     ($_ p.or
@@ -518,18 +518,18 @@
         (s.this! (' #abstract))
         (wrap []))))
 
-(def: bound-kind^
+(def: bound_kind^
   (Parser BoundKind)
   (p.or (s.this! (' <))
         (s.this! (' >))))
 
-(def: (assert-no-periods name)
+(def: (assert_no_periods name)
   (-> Text (Parser Any))
   (p.assert "Names in class declarations cannot contain periods."
             (not (text.contains? "." name))))
 
-(def: (generic-type^ type-vars)
-  (-> (List Type-Parameter) (Parser GenericType))
+(def: (generic_type^ type_vars)
+  (-> (List Type_Parameter) (Parser GenericType))
   (p.rec
    (function (_ recur^)
      ($_ p.either
@@ -538,13 +538,13 @@
            (wrap (#GenericWildcard #.None)))
          (s.tuple (do p.monad
                     [_ (s.this! (' ?))
-                     bound-kind bound-kind^
+                     bound_kind bound_kind^
                      bound recur^]
-                    (wrap (#GenericWildcard (#.Some [bound-kind bound])))))
+                    (wrap (#GenericWildcard (#.Some [bound_kind bound])))))
          (do p.monad
-           [name s.local-identifier
-            _ (assert-no-periods name)]
-           (if (list.member? text.equivalence (list\map product.left type-vars) name)
+           [name s.local_identifier
+            _ (assert_no_periods name)]
+           (if (list.member? text.equivalence (list\map product.left type_vars) name)
              (wrap (#GenericTypeVar name))
              (wrap (#GenericClass name (list)))))
          (s.tuple (do p.monad
@@ -565,68 +565,68 @@
                       _
                       (wrap (#GenericArray component)))))
          (s.form (do p.monad
-                   [name s.local-identifier
-                    _ (assert-no-periods name)
+                   [name s.local_identifier
+                    _ (assert_no_periods name)
                     params (p.some recur^)
                     _ (p.assert (format name " cannot be a type-parameter!")
-                                (not (list.member? text.equivalence (list\map product.left type-vars) name)))]
+                                (not (list.member? text.equivalence (list\map product.left type_vars) name)))]
                    (wrap (#GenericClass name params))))
          ))))
 
-(def: type-param^
-  (Parser Type-Parameter)
+(def: type_param^
+  (Parser Type_Parameter)
   (p.either (do p.monad
-              [param-name s.local-identifier]
-              (wrap [param-name (list)]))
+              [param_name s.local_identifier]
+              (wrap [param_name (list)]))
             (s.tuple (do p.monad
-                       [param-name s.local-identifier
+                       [param_name s.local_identifier
                         _ (s.this! (' <))
-                        bounds (p.many (..generic-type^ (list)))]
-                       (wrap [param-name bounds])))))
+                        bounds (p.many (..generic_type^ (list)))]
+                       (wrap [param_name bounds])))))
 
-(def: type-params^
-  (Parser (List Type-Parameter))
-  (|> ..type-param^
+(def: type_params^
+  (Parser (List Type_Parameter))
+  (|> ..type_param^
       p.some
       s.tuple
       (p.default (list))))
 
-(def: class-decl^
-  (Parser Class-Declaration)
+(def: class_decl^
+  (Parser Class_Declaration)
   (p.either (do p.monad
-              [name s.local-identifier
-               _ (assert-no-periods name)]
+              [name s.local_identifier
+               _ (assert_no_periods name)]
               (wrap [name (list)]))
             (s.form (do p.monad
-                      [name s.local-identifier
-                       _ (assert-no-periods name)
-                       params (p.some ..type-param^)]
+                      [name s.local_identifier
+                       _ (assert_no_periods name)
+                       params (p.some ..type_param^)]
                       (wrap [name params])))
             ))
 
-(def: (super-class-decl^ type-vars)
-  (-> (List Type-Parameter) (Parser Super-Class-Decl))
+(def: (super_class_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser Super_Class_Decl))
   (p.either (do p.monad
-              [name s.local-identifier
-               _ (assert-no-periods name)]
+              [name s.local_identifier
+               _ (assert_no_periods name)]
               (wrap [name (list)]))
             (s.form (do p.monad
-                      [name s.local-identifier
-                       _ (assert-no-periods name)
-                       params (p.some (..generic-type^ type-vars))]
+                      [name s.local_identifier
+                       _ (assert_no_periods name)
+                       params (p.some (..generic_type^ type_vars))]
                       (wrap [name params])))))
 
-(def: annotation-params^
+(def: annotation_params^
   (Parser (List AnnotationParam))
-  (s.record (p.some (p.and s.local-tag s.any))))
+  (s.record (p.some (p.and s.local_tag s.any))))
 
 (def: annotation^
   (Parser Annotation)
   (p.either (do p.monad
-              [ann-name s.local-identifier]
-              (wrap [ann-name (list)]))
-            (s.form (p.and s.local-identifier
-                           annotation-params^))))
+              [ann_name s.local_identifier]
+              (wrap [ann_name (list)]))
+            (s.form (p.and s.local_identifier
+                           annotation_params^))))
 
 (def: annotations^'
   (Parser (List Annotation))
@@ -640,207 +640,207 @@
     [anns?? (p.maybe ..annotations^')]
     (wrap (maybe.default (list) anns??))))
 
-(def: (throws-decl'^ type-vars)
-  (-> (List Type-Parameter) (Parser (List GenericType)))
+(def: (throws_decl'^ type_vars)
+  (-> (List Type_Parameter) (Parser (List GenericType)))
   (do p.monad
     [_ (s.this! (' #throws))]
-    (s.tuple (p.some (..generic-type^ type-vars)))))
+    (s.tuple (p.some (..generic_type^ type_vars)))))
 
-(def: (throws-decl^ type-vars)
-  (-> (List Type-Parameter) (Parser (List GenericType)))
+(def: (throws_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser (List GenericType)))
   (do p.monad
-    [exs? (p.maybe (throws-decl'^ type-vars))]
+    [exs? (p.maybe (throws_decl'^ type_vars))]
     (wrap (maybe.default (list) exs?))))
 
-(def: (method-decl^ type-vars)
-  (-> (List Type-Parameter) (Parser [Member-Declaration MethodDecl]))
+(def: (method_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration MethodDecl]))
   (s.form (do p.monad
-            [tvars ..type-params^
-             name s.local-identifier
+            [tvars ..type_params^
+             name s.local_identifier
              anns ..annotations^
-             inputs (s.tuple (p.some (..generic-type^ type-vars)))
-             output (..generic-type^ type-vars)
-             exs (..throws-decl^ type-vars)]
-            (wrap [[name #PublicPM anns] {#method-tvars tvars
-                                          #method-inputs inputs
-                                          #method-output output
-                                          #method-exs    exs}]))))
-
-(def: state-modifier^
+             inputs (s.tuple (p.some (..generic_type^ type_vars)))
+             output (..generic_type^ type_vars)
+             exs (..throws_decl^ type_vars)]
+            (wrap [[name #PublicPM anns] {#method_tvars tvars
+                                          #method_inputs inputs
+                                          #method_output output
+                                          #method_exs    exs}]))))
+
+(def: state_modifier^
   (Parser StateModifier)
   ($_ p.or
       (s.this! (' #volatile))
       (s.this! (' #final))
       (\ p.monad wrap [])))
 
-(def: (field-decl^ type-vars)
-  (-> (List Type-Parameter) (Parser [Member-Declaration FieldDecl]))
+(def: (field_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration FieldDecl]))
   (p.either (s.form (do p.monad
                       [_ (s.this! (' #const))
-                       name s.local-identifier
+                       name s.local_identifier
                        anns ..annotations^
-                       type (..generic-type^ type-vars)
+                       type (..generic_type^ type_vars)
                        body s.any]
                       (wrap [[name #PublicPM anns] (#ConstantField [type body])])))
             (s.form (do p.monad
-                      [pm privacy-modifier^
-                       sm state-modifier^
-                       name s.local-identifier
+                      [pm privacy_modifier^
+                       sm state_modifier^
+                       name s.local_identifier
                        anns ..annotations^
-                       type (..generic-type^ type-vars)]
+                       type (..generic_type^ type_vars)]
                       (wrap [[name pm anns] (#VariableField [sm type])])))))
 
-(def: (arg-decl^ type-vars)
-  (-> (List Type-Parameter) (Parser ArgDecl))
-  (s.record (p.and s.local-identifier
-                   (..generic-type^ type-vars))))
+(def: (arg_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser ArgDecl))
+  (s.record (p.and s.local_identifier
+                   (..generic_type^ type_vars))))
 
-(def: (arg-decls^ type-vars)
-  (-> (List Type-Parameter) (Parser (List ArgDecl)))
-  (p.some (arg-decl^ type-vars)))
+(def: (arg_decls^ type_vars)
+  (-> (List Type_Parameter) (Parser (List ArgDecl)))
+  (p.some (arg_decl^ type_vars)))
 
-(def: (constructor-arg^ type-vars)
-  (-> (List Type-Parameter) (Parser ConstructorArg))
-  (s.record (p.and (..generic-type^ type-vars) s.any)))
+(def: (constructor_arg^ type_vars)
+  (-> (List Type_Parameter) (Parser ConstructorArg))
+  (s.record (p.and (..generic_type^ type_vars) s.any)))
 
-(def: (constructor-args^ type-vars)
-  (-> (List Type-Parameter) (Parser (List ConstructorArg)))
-  (s.tuple (p.some (constructor-arg^ type-vars))))
+(def: (constructor_args^ type_vars)
+  (-> (List Type_Parameter) (Parser (List ConstructorArg)))
+  (s.tuple (p.some (constructor_arg^ type_vars))))
 
-(def: (constructor-method^ class-vars)
-  (-> (List Type-Parameter) (Parser [Member-Declaration Method-Definition]))
+(def: (constructor_method^ class_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition]))
   (s.form (do p.monad
-            [pm privacy-modifier^
-             strict-fp? (p.parses? (s.this! (' #strict)))
-             method-vars ..type-params^
-             #let [total-vars (list\compose class-vars method-vars)]
-             [_ arg-decls] (s.form (p.and (s.this! (' new))
-                                          (..arg-decls^ total-vars)))
-             constructor-args (..constructor-args^ total-vars)
-             exs (..throws-decl^ total-vars)
+            [pm privacy_modifier^
+             strict_fp? (p.parses? (s.this! (' #strict)))
+             method_vars ..type_params^
+             #let [total_vars (list\compose class_vars method_vars)]
+             [_ arg_decls] (s.form (p.and (s.this! (' new))
+                                          (..arg_decls^ total_vars)))
+             constructor_args (..constructor_args^ total_vars)
+             exs (..throws_decl^ total_vars)
              annotations ..annotations^
              body s.any]
-            (wrap [{#member-name constructor-method-name
-                    #member-privacy pm
-                    #member-anns annotations}
-                   (#ConstructorMethod strict-fp? method-vars arg-decls constructor-args body exs)]))))
+            (wrap [{#member_name constructor_method_name
+                    #member_privacy pm
+                    #member_anns annotations}
+                   (#ConstructorMethod strict_fp? method_vars arg_decls constructor_args body exs)]))))
 
-(def: (virtual-method-def^ class-vars)
-  (-> (List Type-Parameter) (Parser [Member-Declaration Method-Definition]))
+(def: (virtual_method_def^ class_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition]))
   (s.form (do p.monad
-            [pm privacy-modifier^
-             strict-fp? (p.parses? (s.this! (' #strict)))
+            [pm privacy_modifier^
+             strict_fp? (p.parses? (s.this! (' #strict)))
              final? (p.parses? (s.this! (' #final)))
-             method-vars ..type-params^
-             #let [total-vars (list\compose class-vars method-vars)]
-             [name this-name arg-decls] (s.form ($_ p.and
-                                                    s.local-identifier
-                                                    s.local-identifier
-                                                    (..arg-decls^ total-vars)))
-             return-type (..generic-type^ total-vars)
-             exs (..throws-decl^ total-vars)
+             method_vars ..type_params^
+             #let [total_vars (list\compose class_vars method_vars)]
+             [name this_name arg_decls] (s.form ($_ p.and
+                                                    s.local_identifier
+                                                    s.local_identifier
+                                                    (..arg_decls^ total_vars)))
+             return_type (..generic_type^ total_vars)
+             exs (..throws_decl^ total_vars)
              annotations ..annotations^
              body s.any]
-            (wrap [{#member-name name
-                    #member-privacy pm
-                    #member-anns annotations}
-                   (#VirtualMethod final? strict-fp?
-                                   method-vars
-                                   this-name arg-decls return-type
+            (wrap [{#member_name name
+                    #member_privacy pm
+                    #member_anns annotations}
+                   (#VirtualMethod final? strict_fp?
+                                   method_vars
+                                   this_name arg_decls return_type
                                    body exs)]))))
 
-(def: overriden-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: overriden_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (s.form (do p.monad
-            [strict-fp? (p.parses? (s.this! (' #strict)))
-             owner-class ..class-decl^
-             method-vars ..type-params^
-             #let [total-vars (list\compose (product.right owner-class) method-vars)]
-             [name this-name arg-decls] (s.form ($_ p.and
-                                                    s.local-identifier
-                                                    s.local-identifier
-                                                    (..arg-decls^ total-vars)))
-             return-type (..generic-type^ total-vars)
-             exs (..throws-decl^ total-vars)
+            [strict_fp? (p.parses? (s.this! (' #strict)))
+             owner_class ..class_decl^
+             method_vars ..type_params^
+             #let [total_vars (list\compose (product.right owner_class) method_vars)]
+             [name this_name arg_decls] (s.form ($_ p.and
+                                                    s.local_identifier
+                                                    s.local_identifier
+                                                    (..arg_decls^ total_vars)))
+             return_type (..generic_type^ total_vars)
+             exs (..throws_decl^ total_vars)
              annotations ..annotations^
              body s.any]
-            (wrap [{#member-name name
-                    #member-privacy #PublicPM
-                    #member-anns annotations}
-                   (#OverridenMethod strict-fp?
-                                     owner-class method-vars
-                                     this-name arg-decls return-type
+            (wrap [{#member_name name
+                    #member_privacy #PublicPM
+                    #member_anns annotations}
+                   (#OverridenMethod strict_fp?
+                                     owner_class method_vars
+                                     this_name arg_decls return_type
                                      body exs)]))))
 
-(def: static-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: static_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (s.form (do p.monad
-            [pm privacy-modifier^
-             strict-fp? (p.parses? (s.this! (' #strict)))
+            [pm privacy_modifier^
+             strict_fp? (p.parses? (s.this! (' #strict)))
              _ (s.this! (' #static))
-             method-vars ..type-params^
-             #let [total-vars method-vars]
-             [name arg-decls] (s.form (p.and s.local-identifier
-                                             (..arg-decls^ total-vars)))
-             return-type (..generic-type^ total-vars)
-             exs (..throws-decl^ total-vars)
+             method_vars ..type_params^
+             #let [total_vars method_vars]
+             [name arg_decls] (s.form (p.and s.local_identifier
+                                             (..arg_decls^ total_vars)))
+             return_type (..generic_type^ total_vars)
+             exs (..throws_decl^ total_vars)
              annotations ..annotations^
              body s.any]
-            (wrap [{#member-name name
-                    #member-privacy pm
-                    #member-anns annotations}
-                   (#StaticMethod strict-fp? method-vars arg-decls return-type body exs)]))))
+            (wrap [{#member_name name
+                    #member_privacy pm
+                    #member_anns annotations}
+                   (#StaticMethod strict_fp? method_vars arg_decls return_type body exs)]))))
 
-(def: abstract-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: abstract_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (s.form (do p.monad
-            [pm privacy-modifier^
+            [pm privacy_modifier^
              _ (s.this! (' #abstract))
-             method-vars ..type-params^
-             #let [total-vars method-vars]
-             [name arg-decls] (s.form (p.and s.local-identifier
-                                             (..arg-decls^ total-vars)))
-             return-type (..generic-type^ total-vars)
-             exs (..throws-decl^ total-vars)
+             method_vars ..type_params^
+             #let [total_vars method_vars]
+             [name arg_decls] (s.form (p.and s.local_identifier
+                                             (..arg_decls^ total_vars)))
+             return_type (..generic_type^ total_vars)
+             exs (..throws_decl^ total_vars)
              annotations ..annotations^]
-            (wrap [{#member-name name
-                    #member-privacy pm
-                    #member-anns annotations}
-                   (#AbstractMethod method-vars arg-decls return-type exs)]))))
+            (wrap [{#member_name name
+                    #member_privacy pm
+                    #member_anns annotations}
+                   (#AbstractMethod method_vars arg_decls return_type exs)]))))
 
-(def: native-method-def^
-  (Parser [Member-Declaration Method-Definition])
+(def: native_method_def^
+  (Parser [Member_Declaration Method_Definition])
   (s.form (do p.monad
-            [pm privacy-modifier^
+            [pm privacy_modifier^
              _ (s.this! (' #native))
-             method-vars ..type-params^
-             #let [total-vars method-vars]
-             [name arg-decls] (s.form (p.and s.local-identifier
-                                             (..arg-decls^ total-vars)))
-             return-type (..generic-type^ total-vars)
-             exs (..throws-decl^ total-vars)
+             method_vars ..type_params^
+             #let [total_vars method_vars]
+             [name arg_decls] (s.form (p.and s.local_identifier
+                                             (..arg_decls^ total_vars)))
+             return_type (..generic_type^ total_vars)
+             exs (..throws_decl^ total_vars)
              annotations ..annotations^]
-            (wrap [{#member-name name
-                    #member-privacy pm
-                    #member-anns annotations}
-                   (#NativeMethod method-vars arg-decls return-type exs)]))))
+            (wrap [{#member_name name
+                    #member_privacy pm
+                    #member_anns annotations}
+                   (#NativeMethod method_vars arg_decls return_type exs)]))))
 
-(def: (method-def^ class-vars)
-  (-> (List Type-Parameter) (Parser [Member-Declaration Method-Definition]))
+(def: (method_def^ class_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition]))
   ($_ p.either
-      (..constructor-method^ class-vars)
-      (..virtual-method-def^ class-vars)
-      ..overriden-method-def^
-      ..static-method-def^
-      ..abstract-method-def^
-      ..native-method-def^))
-
-(def: partial-call^
-  (Parser Partial-Call)
+      (..constructor_method^ class_vars)
+      (..virtual_method_def^ class_vars)
+      ..overriden_method_def^
+      ..static_method_def^
+      ..abstract_method_def^
+      ..native_method_def^))
+
+(def: partial_call^
+  (Parser Partial_Call)
   (s.form (p.and s.identifier (p.some s.any))))
 
-(def: class-kind^
-  (Parser Class-Kind)
+(def: class_kind^
+  (Parser Class_Kind)
   (p.either (do p.monad
               [_ (s.this! (' #class))]
               (wrap #Class))
@@ -849,334 +849,334 @@
               (wrap #Interface))
             ))
 
-(def: import-member-alias^
+(def: import_member_alias^
   (Parser (Maybe Text))
   (p.maybe (do p.monad
              [_ (s.this! (' #as))]
-             s.local-identifier)))
+             s.local_identifier)))
 
-(def: (import-member-args^ type-vars)
-  (-> (List Type-Parameter) (Parser (List [Bit GenericType])))
-  (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (..generic-type^ type-vars)))))
+(def: (import_member_args^ type_vars)
+  (-> (List Type_Parameter) (Parser (List [Bit GenericType])))
+  (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (..generic_type^ type_vars)))))
 
-(def: import-member-return-flags^
+(def: import_member_return_flags^
   (Parser [Bit Bit Bit])
   ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?)))))
 
-(def: primitive-mode^
-  (Parser Primitive-Mode)
+(def: primitive_mode^
+  (Parser Primitive_Mode)
   (p.or (s.this! (' #manual))
         (s.this! (' #auto))))
 
-(def: (import-member-decl^ owner-vars)
-  (-> (List Type-Parameter) (Parser Import-Member-Declaration))
+(def: (import_member_decl^ owner_vars)
+  (-> (List Type_Parameter) (Parser Import_Member_Declaration))
   ($_ p.either
       (s.form (do p.monad
                 [_ (s.this! (' #enum))
-                 enum-members (p.some s.local-identifier)]
-                (wrap (#EnumDecl enum-members))))
+                 enum_members (p.some s.local_identifier)]
+                (wrap (#EnumDecl enum_members))))
       (s.form (do p.monad
-                [tvars ..type-params^
+                [tvars ..type_params^
                  _ (s.this! (' new))
-                 ?alias import-member-alias^
-                 #let [total-vars (list\compose owner-vars tvars)]
-                 ?prim-mode (p.maybe primitive-mode^)
-                 args (..import-member-args^ total-vars)
-                 [io? try? maybe?] import-member-return-flags^]
-                (wrap (#ConstructorDecl [{#import-member-mode    (maybe.default #AutoPrM ?prim-mode)
-                                          #import-member-alias   (maybe.default "new" ?alias)
-                                          #import-member-kind    #VirtualIMK
-                                          #import-member-tvars   tvars
-                                          #import-member-args    args
-                                          #import-member-maybe?  maybe?
-                                          #import-member-try?    try?
-                                          #import-member-io?     io?}
+                 ?alias import_member_alias^
+                 #let [total_vars (list\compose owner_vars tvars)]
+                 ?prim_mode (p.maybe primitive_mode^)
+                 args (..import_member_args^ total_vars)
+                 [io? try? maybe?] import_member_return_flags^]
+                (wrap (#ConstructorDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                          #import_member_alias   (maybe.default "new" ?alias)
+                                          #import_member_kind    #VirtualIMK
+                                          #import_member_tvars   tvars
+                                          #import_member_args    args
+                                          #import_member_maybe?  maybe?
+                                          #import_member_try?    try?
+                                          #import_member_io?     io?}
                                          {}]))
                 ))
       (s.form (do p.monad
                 [kind (: (Parser ImportMethodKind)
                          (p.or (s.this! (' #static))
                                (wrap [])))
-                 tvars ..type-params^
-                 name s.local-identifier
-                 ?alias import-member-alias^
-                 #let [total-vars (list\compose owner-vars tvars)]
-                 ?prim-mode (p.maybe primitive-mode^)
-                 args (..import-member-args^ total-vars)
-                 [io? try? maybe?] import-member-return-flags^
-                 return (..generic-type^ total-vars)]
-                (wrap (#MethodDecl [{#import-member-mode    (maybe.default #AutoPrM ?prim-mode)
-                                     #import-member-alias   (maybe.default name ?alias)
-                                     #import-member-kind    kind
-                                     #import-member-tvars   tvars
-                                     #import-member-args    args
-                                     #import-member-maybe?  maybe?
-                                     #import-member-try?    try?
-                                     #import-member-io?     io?}
-                                    {#import-method-name    name
-                                     #import-method-return  return
+                 tvars ..type_params^
+                 name s.local_identifier
+                 ?alias import_member_alias^
+                 #let [total_vars (list\compose owner_vars tvars)]
+                 ?prim_mode (p.maybe primitive_mode^)
+                 args (..import_member_args^ total_vars)
+                 [io? try? maybe?] import_member_return_flags^
+                 return (..generic_type^ total_vars)]
+                (wrap (#MethodDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                     #import_member_alias   (maybe.default name ?alias)
+                                     #import_member_kind    kind
+                                     #import_member_tvars   tvars
+                                     #import_member_args    args
+                                     #import_member_maybe?  maybe?
+                                     #import_member_try?    try?
+                                     #import_member_io?     io?}
+                                    {#import_method_name    name
+                                     #import_method_return  return
                                      }]))))
       (s.form (do p.monad
                 [static? (p.parses? (s.this! (' #static)))
-                 name s.local-identifier
-                 ?prim-mode (p.maybe primitive-mode^)
-                 gtype (..generic-type^ owner-vars)
+                 name s.local_identifier
+                 ?prim_mode (p.maybe primitive_mode^)
+                 gtype (..generic_type^ owner_vars)
                  maybe? (p.parses? (s.this! (' #?)))
                  setter? (p.parses? (s.this! (' #!)))]
-                (wrap (#FieldAccessDecl {#import-field-mode    (maybe.default #AutoPrM ?prim-mode)
-                                         #import-field-name    name
-                                         #import-field-static? static?
-                                         #import-field-maybe?  maybe?
-                                         #import-field-setter? setter?
-                                         #import-field-type    gtype}))))
+                (wrap (#FieldAccessDecl {#import_field_mode    (maybe.default #AutoPrM ?prim_mode)
+                                         #import_field_name    name
+                                         #import_field_static? static?
+                                         #import_field_maybe?  maybe?
+                                         #import_field_setter? setter?
+                                         #import_field_type    gtype}))))
       ))
 
 (def: bundle
-  (-> (List Type-Parameter) (Parser [Text (List Import-Member-Declaration)]))
-  (|>> ..import-member-decl^
+  (-> (List Type_Parameter) (Parser [Text (List Import_Member_Declaration)]))
+  (|>> ..import_member_decl^
        p.some
        (p.and s.text)
        s.tuple))
 
 ## Generators
-(def: with-parens
-  (-> JVM-Code JVM-Code)
+(def: with_parens
+  (-> JVM_Code JVM_Code)
   (text.enclose ["(" ")"]))
 
-(def: with-brackets
-  (-> JVM-Code JVM-Code)
+(def: with_brackets
+  (-> JVM_Code JVM_Code)
   (text.enclose ["[" "]"]))
 
 (def: spaced
-  (-> (List JVM-Code) JVM-Code)
-  (text.join-with " "))
+  (-> (List JVM_Code) JVM_Code)
+  (text.join_with " "))
 
-(def: (privacy-modifier$ pm)
-  (-> PrivacyModifier JVM-Code)
+(def: (privacy_modifier$ pm)
+  (-> PrivacyModifier JVM_Code)
   (case pm
     #PublicPM    "public"
     #PrivatePM   "private"
     #ProtectedPM "protected"
     #DefaultPM   "default"))
 
-(def: (inheritance-modifier$ im)
-  (-> InheritanceModifier JVM-Code)
+(def: (inheritance_modifier$ im)
+  (-> InheritanceModifier JVM_Code)
   (case im
     #FinalIM    "final"
     #AbstractIM "abstract"
     #DefaultIM  "default"))
 
-(def: (annotation-param$ [name value])
-  (-> AnnotationParam JVM-Code)
+(def: (annotation_param$ [name value])
+  (-> AnnotationParam JVM_Code)
   (format name "=" (code.format value)))
 
 (def: (annotation$ [name params])
-  (-> Annotation JVM-Code)
-  (format "(" name " " "{" (text.join-with text.tab (list\map annotation-param$ params)) "}" ")"))
+  (-> Annotation JVM_Code)
+  (format "(" name " " "{" (text.join_with text.tab (list\map annotation_param$ params)) "}" ")"))
 
-(def: (bound-kind$ kind)
-  (-> BoundKind JVM-Code)
+(def: (bound_kind$ kind)
+  (-> BoundKind JVM_Code)
   (case kind
     #UpperBound "<"
     #LowerBound ">"))
 
-(def: (generic-type$ gtype)
-  (-> GenericType JVM-Code)
+(def: (generic_type$ gtype)
+  (-> GenericType JVM_Code)
   (case gtype
     (#GenericTypeVar name)
     name
 
     (#GenericClass name params)
-    (format "(" (sanitize name) " " (spaced (list\map generic-type$ params)) ")")
+    (format "(" (sanitize name) " " (spaced (list\map generic_type$ params)) ")")
     
     (#GenericArray param)
-    (format "(" array.type-name " " (generic-type$ param) ")")
+    (format "(" array.type_name " " (generic_type$ param) ")")
     
     (#GenericWildcard #.None)
     "?"
 
-    (#GenericWildcard (#.Some [bound-kind bound]))
-    (format (bound-kind$ bound-kind) (generic-type$ bound))))
+    (#GenericWildcard (#.Some [bound_kind bound]))
+    (format (bound_kind$ bound_kind) (generic_type$ bound))))
 
-(def: (type-param$ [name bounds])
-  (-> Type-Parameter JVM-Code)
-  (format "(" name " " (spaced (list\map generic-type$ bounds)) ")"))
+(def: (type_param$ [name bounds])
+  (-> Type_Parameter JVM_Code)
+  (format "(" name " " (spaced (list\map generic_type$ bounds)) ")"))
 
-(def: (class-decl$ (^open "."))
-  (-> Class-Declaration JVM-Code)
-  (format "(" (sanitize class-name) " " (spaced (list\map type-param$ class-params)) ")"))
+(def: (class_decl$ (^open "."))
+  (-> Class_Declaration JVM_Code)
+  (format "(" (sanitize class_name) " " (spaced (list\map type_param$ class_params)) ")"))
 
-(def: (super-class-decl$ (^slots [#super-class-name #super-class-params]))
-  (-> Super-Class-Decl JVM-Code)
-  (format "(" (sanitize super-class-name) " " (spaced (list\map generic-type$ super-class-params)) ")"))
+(def: (super_class_decl$ (^slots [#super_class_name #super_class_params]))
+  (-> Super_Class_Decl JVM_Code)
+  (format "(" (sanitize super_class_name) " " (spaced (list\map generic_type$ super_class_params)) ")"))
 
-(def: (method-decl$ [[name pm anns] method-decl])
-  (-> [Member-Declaration MethodDecl] JVM-Code)
-  (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl]
-    (with-parens
+(def: (method_decl$ [[name pm anns] method_decl])
+  (-> [Member_Declaration MethodDecl] JVM_Code)
+  (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl]
+    (with_parens
       (spaced (list name
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (with-brackets (spaced (list\map type-param$ method-tvars)))
-                    (with-brackets (spaced (list\map generic-type$ method-exs)))
-                    (with-brackets (spaced (list\map generic-type$ method-inputs)))
-                    (generic-type$ method-output))
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ method_tvars)))
+                    (with_brackets (spaced (list\map generic_type$ method_exs)))
+                    (with_brackets (spaced (list\map generic_type$ method_inputs)))
+                    (generic_type$ method_output))
               ))))
 
-(def: (state-modifier$ sm)
-  (-> StateModifier JVM-Code)
+(def: (state_modifier$ sm)
+  (-> StateModifier JVM_Code)
   (case sm
     #VolatileSM "volatile"
     #FinalSM    "final"
     #DefaultSM  "default"))
 
-(def: (field-decl$ [[name pm anns] field])
-  (-> [Member-Declaration FieldDecl] JVM-Code)
+(def: (field_decl$ [[name pm anns] field])
+  (-> [Member_Declaration FieldDecl] JVM_Code)
   (case field
     (#ConstantField class value)
-    (with-parens
+    (with_parens
       (spaced (list "constant" name
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (generic-type$ class)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (generic_type$ class)
                     (code.format value))
               ))
 
     (#VariableField sm class)
-    (with-parens
+    (with_parens
       (spaced (list "variable" name
-                    (privacy-modifier$ pm)
-                    (state-modifier$ sm)
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (generic-type$ class))
+                    (privacy_modifier$ pm)
+                    (state_modifier$ sm)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (generic_type$ class))
               ))
     ))
 
-(def: (arg-decl$ [name type])
-  (-> ArgDecl JVM-Code)
-  (with-parens
-    (spaced (list name (generic-type$ type)))))
-
-(def: (constructor-arg$ [class term])
-  (-> ConstructorArg JVM-Code)
-  (with-brackets
-    (spaced (list (generic-type$ class) (code.format term)))))
-
-(def: (method-def$ replacer super-class [[name pm anns] method-def])
-  (-> (-> Code Code) Super-Class-Decl [Member-Declaration Method-Definition] JVM-Code)
-  (case method-def
-    (#ConstructorMethod strict-fp? type-vars arg-decls constructor-args body exs)
-    (with-parens
+(def: (arg_decl$ [name type])
+  (-> ArgDecl JVM_Code)
+  (with_parens
+    (spaced (list name (generic_type$ type)))))
+
+(def: (constructor_arg$ [class term])
+  (-> ConstructorArg JVM_Code)
+  (with_brackets
+    (spaced (list (generic_type$ class) (code.format term)))))
+
+(def: (method_def$ replacer super_class [[name pm anns] method_def])
+  (-> (-> Code Code) Super_Class_Decl [Member_Declaration Method_Definition] JVM_Code)
+  (case method_def
+    (#ConstructorMethod strict_fp? type_vars arg_decls constructor_args body exs)
+    (with_parens
       (spaced (list "init"
-                    (privacy-modifier$ pm)
-                    (bit\encode strict-fp?)
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (with-brackets (spaced (list\map type-param$ type-vars)))
-                    (with-brackets (spaced (list\map generic-type$ exs)))
-                    (with-brackets (spaced (list\map arg-decl$ arg-decls)))
-                    (with-brackets (spaced (list\map constructor-arg$ constructor-args)))
-                    (code.format (pre-walk-replace replacer body))
+                    (privacy_modifier$ pm)
+                    (bit\encode strict_fp?)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (with_brackets (spaced (list\map constructor_arg$ constructor_args)))
+                    (code.format (pre_walk_replace replacer body))
                     )))
     
-    (#VirtualMethod final? strict-fp? type-vars this-name arg-decls return-type body exs)
-    (with-parens
+    (#VirtualMethod final? strict_fp? type_vars this_name arg_decls return_type body exs)
+    (with_parens
       (spaced (list "virtual"
                     name
-                    (privacy-modifier$ pm)
+                    (privacy_modifier$ pm)
                     (bit\encode final?)
-                    (bit\encode strict-fp?)
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (with-brackets (spaced (list\map type-param$ type-vars)))
-                    (with-brackets (spaced (list\map generic-type$ exs)))
-                    (with-brackets (spaced (list\map arg-decl$ arg-decls)))
-                    (generic-type$ return-type)
-                    (code.format (pre-walk-replace replacer (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)]
+                    (bit\encode strict_fp?)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type)
+                    (code.format (pre_walk_replace replacer (` (let [(~ (code.local_identifier this_name)) (~' _jvm_this)]
                                                                  (~ body))))))))
     
-    (#OverridenMethod strict-fp? class-decl type-vars this-name arg-decls return-type body exs)
-    (let [super-replacer (parser->replacer (s.form (do p.monad
+    (#OverridenMethod strict_fp? class_decl type_vars this_name arg_decls return_type body exs)
+    (let [super_replacer (parser->replacer (s.form (do p.monad
                                                      [_ (s.this! (' ::super!))
-                                                      args (s.tuple (p.exactly (list.size arg-decls) s.any))
-                                                      #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ (list)))
-                                                                                                arg-decls))]]
+                                                      args (s.tuple (p.exactly (list.size arg_decls) s.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)
+                                                                                      ":" (get@ #super_class_name super_class)
                                                                                       ":" name
-                                                                                      ":" (text.join-with "," arg-decls'))))
+                                                                                      ":" (text.join_with "," arg_decls'))))
                                                                 (~' _jvm_this) (~+ args)))))))]
-      (with-parens
+      (with_parens
         (spaced (list "override"
-                      (class-decl$ class-decl)
+                      (class_decl$ class_decl)
                       name
-                      (bit\encode strict-fp?)
-                      (with-brackets (spaced (list\map annotation$ anns)))
-                      (with-brackets (spaced (list\map type-param$ type-vars)))
-                      (with-brackets (spaced (list\map generic-type$ exs)))
-                      (with-brackets (spaced (list\map arg-decl$ arg-decls)))
-                      (generic-type$ return-type)
-                      (|> (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)]
+                      (bit\encode strict_fp?)
+                      (with_brackets (spaced (list\map annotation$ anns)))
+                      (with_brackets (spaced (list\map type_param$ type_vars)))
+                      (with_brackets (spaced (list\map generic_type$ exs)))
+                      (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                      (generic_type$ return_type)
+                      (|> (` (let [(~ (code.local_identifier this_name)) (~' _jvm_this)]
                                (~ body)))
-                          (pre-walk-replace replacer)
-                          (pre-walk-replace super-replacer)
+                          (pre_walk_replace replacer)
+                          (pre_walk_replace super_replacer)
                           (code.format))
                       ))))
 
-    (#StaticMethod strict-fp? type-vars arg-decls return-type body exs)
-    (with-parens
+    (#StaticMethod strict_fp? type_vars arg_decls return_type body exs)
+    (with_parens
       (spaced (list "static"
                     name
-                    (privacy-modifier$ pm)
-                    (bit\encode strict-fp?)
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (with-brackets (spaced (list\map type-param$ type-vars)))
-                    (with-brackets (spaced (list\map generic-type$ exs)))
-                    (with-brackets (spaced (list\map arg-decl$ arg-decls)))
-                    (generic-type$ return-type)
-                    (code.format (pre-walk-replace replacer body)))))
-
-    (#AbstractMethod type-vars arg-decls return-type exs)
-    (with-parens
+                    (privacy_modifier$ pm)
+                    (bit\encode strict_fp?)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type)
+                    (code.format (pre_walk_replace replacer body)))))
+
+    (#AbstractMethod type_vars arg_decls return_type exs)
+    (with_parens
       (spaced (list "abstract"
                     name
-                    (privacy-modifier$ pm)
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (with-brackets (spaced (list\map type-param$ type-vars)))
-                    (with-brackets (spaced (list\map generic-type$ exs)))
-                    (with-brackets (spaced (list\map arg-decl$ arg-decls)))
-                    (generic-type$ return-type))))
-
-    (#NativeMethod type-vars arg-decls return-type exs)
-    (with-parens
+                    (privacy_modifier$ pm)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type))))
+
+    (#NativeMethod type_vars arg_decls return_type exs)
+    (with_parens
       (spaced (list "native"
                     name
-                    (privacy-modifier$ pm)
-                    (with-brackets (spaced (list\map annotation$ anns)))
-                    (with-brackets (spaced (list\map type-param$ type-vars)))
-                    (with-brackets (spaced (list\map generic-type$ exs)))
-                    (with-brackets (spaced (list\map arg-decl$ arg-decls)))
-                    (generic-type$ return-type))))
+                    (privacy_modifier$ pm)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type))))
     ))
 
-(def: (complete-call$ g!obj [method args])
-  (-> Code Partial-Call Code)
+(def: (complete_call$ g!obj [method args])
+  (-> Code Partial_Call Code)
   (` ((~ (code.identifier method)) (~+ args) (~ g!obj))))
 
 ## [Syntax]
-(def: object-super-class
-  Super-Class-Decl
-  {#super-class-name   "java/lang/Object"
-   #super-class-params (list)})
+(def: object_super_class
+  Super_Class_Decl
+  {#super_class_name   "java/lang/Object"
+   #super_class_params (list)})
 
 (syntax: #export (class:
-                   {im inheritance-modifier^}
-                   {class-decl ..class-decl^}
-                   {#let [full-class-name (product.left class-decl)]}
-                   {#let [class-vars (product.right class-decl)]}
-                   {super (p.default object-super-class
-                                     (..super-class-decl^ class-vars))}
+                   {im inheritance_modifier^}
+                   {class_decl ..class_decl^}
+                   {#let [full_class_name (product.left class_decl)]}
+                   {#let [class_vars (product.right class_decl)]}
+                   {super (p.default object_super_class
+                                     (..super_class_decl^ class_vars))}
                    {interfaces (p.default (list)
-                                          (s.tuple (p.some (..super-class-decl^ class-vars))))}
+                                          (s.tuple (p.some (..super_class_decl^ class_vars))))}
                    {annotations ..annotations^}
-                   {fields (p.some (..field-decl^ class-vars))}
-                   {methods (p.some (..method-def^ class-vars))})
+                   {fields (p.some (..field_decl^ class_vars))}
+                   {methods (p.some (..method_def^ class_vars))})
   {#.doc (doc "Allows defining JVM classes in Lux code."
               "For example:"
               (class: #final (TestClass A) [Runnable]
@@ -1208,49 +1208,49 @@
               "(::resolve! container [value]) for calling the 'resolve' method."
               )}
   (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)
+    [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 p.either
                                                  (p.fail "")
-                                                 (list\compose field-parsers method-parsers)))
-           def-code (format "jvm class:"
-                            (spaced (list (class-decl$ class-decl)
-                                          (super-class-decl$ super)
-                                          (with-brackets (spaced (list\map super-class-decl$ interfaces)))
-                                          (inheritance-modifier$ im)
-                                          (with-brackets (spaced (list\map annotation$ annotations)))
-                                          (with-brackets (spaced (list\map field-decl$ fields)))
-                                          (with-brackets (spaced (list\map (method-def$ replacer super) methods))))))]]
-    (wrap (list (` ((~ (code.text def-code))))))))
+                                                 (list\compose field_parsers method_parsers)))
+           def_code (format "jvm class:"
+                            (spaced (list (class_decl$ class_decl)
+                                          (super_class_decl$ super)
+                                          (with_brackets (spaced (list\map super_class_decl$ interfaces)))
+                                          (inheritance_modifier$ im)
+                                          (with_brackets (spaced (list\map annotation$ annotations)))
+                                          (with_brackets (spaced (list\map field_decl$ fields)))
+                                          (with_brackets (spaced (list\map (method_def$ replacer super) methods))))))]]
+    (wrap (list (` ((~ (code.text def_code))))))))
 
 (syntax: #export (interface:
-                   {class-decl ..class-decl^}
-                   {#let [class-vars (product.right class-decl)]}
+                   {class_decl ..class_decl^}
+                   {#let [class_vars (product.right class_decl)]}
                    {supers (p.default (list)
-                                      (s.tuple (p.some (..super-class-decl^ class-vars))))}
+                                      (s.tuple (p.some (..super_class_decl^ class_vars))))}
                    {annotations ..annotations^}
-                   {members (p.some (..method-decl^ class-vars))})
+                   {members (p.some (..method_decl^ class_vars))})
   {#.doc (doc "Allows defining JVM interfaces."
               (interface: TestInterface
                 ([] foo [boolean String] void #throws [Exception])))}
-  (let [def-code (format "jvm interface:"
-                         (spaced (list (class-decl$ class-decl)
-                                       (with-brackets (spaced (list\map super-class-decl$ supers)))
-                                       (with-brackets (spaced (list\map annotation$ annotations)))
-                                       (spaced (list\map method-decl$ members)))))]
-    (wrap (list (` ((~ (code.text def-code))))))
+  (let [def_code (format "jvm interface:"
+                         (spaced (list (class_decl$ class_decl)
+                                       (with_brackets (spaced (list\map super_class_decl$ supers)))
+                                       (with_brackets (spaced (list\map annotation$ annotations)))
+                                       (spaced (list\map method_decl$ members)))))]
+    (wrap (list (` ((~ (code.text def_code))))))
     ))
 
 (syntax: #export (object
-                   {class-vars (s.tuple (p.some ..type-param^))}
-                   {super (p.default object-super-class
-                                     (..super-class-decl^ class-vars))}
+                   {class_vars (s.tuple (p.some ..type_param^))}
+                   {super (p.default object_super_class
+                                     (..super_class_decl^ class_vars))}
                    {interfaces (p.default (list)
-                                          (s.tuple (p.some (..super-class-decl^ class-vars))))}
-                   {constructor-args (..constructor-args^ class-vars)}
-                   {methods (p.some ..overriden-method-def^)})
+                                          (s.tuple (p.some (..super_class_decl^ class_vars))))}
+                   {constructor_args (..constructor_args^ class_vars)}
+                   {methods (p.some ..overriden_method_def^)})
   {#.doc (doc "Allows defining anonymous classes."
               "The 1st tuple corresponds to class-level type-variables."
               "The 2nd tuple corresponds to parent interfaces."
@@ -1259,15 +1259,15 @@
               (object [] [Runnable]
                 []
                 (Runnable [] (run self) void
-                          (exec (do-something some-value)
+                          (exec (do_something some_value)
                             [])))
               )}
-  (let [def-code (format "jvm anon-class:"
-                         (spaced (list (super-class-decl$ super)
-                                       (with-brackets (spaced (list\map super-class-decl$ interfaces)))
-                                       (with-brackets (spaced (list\map constructor-arg$ constructor-args)))
-                                       (with-brackets (spaced (list\map (method-def$ function.identity super) methods))))))]
-    (wrap (list (` ((~ (code.text def-code))))))))
+  (let [def_code (format "jvm anon-class:"
+                         (spaced (list (super_class_decl$ super)
+                                       (with_brackets (spaced (list\map super_class_decl$ interfaces)))
+                                       (with_brackets (spaced (list\map constructor_arg$ constructor_args)))
+                                       (with_brackets (spaced (list\map (method_def$ function.identity super) methods))))))]
+    (wrap (list (` ((~ (code.text def_code))))))))
 
 (syntax: #export (null)
   {#.doc (doc "Null object reference."
@@ -1289,7 +1289,7 @@
                  #.None)
               (= (??? "YOLO")
                  (#.Some "YOLO")))}
-  (with-gensyms [g!temp]
+  (with_gensyms [g!temp]
     (wrap (list (` (let [(~ g!temp) (~ expr)]
                      (if ("jvm object null?" (~ g!temp))
                        #.None
@@ -1302,7 +1302,7 @@
                  (!!! (??? (: java/lang/Thread (null)))))
               (= "foo"
                  (!!! (??? "foo"))))}
-  (with-gensyms [g!value]
+  (with_gensyms [g!value]
     (wrap (list (` ({(#.Some (~ g!value))
                      (~ g!value)
 
@@ -1311,158 +1311,158 @@
                     (~ expr)))))))
 
 (syntax: #export (try expression)
-  {#.doc (doc (case (try (risky-computation input))
+  {#.doc (doc (case (try (risky_computation input))
                 (#.Right success)
-                (do-something success)
+                (do_something success)
 
                 (#.Left error)
-                (recover-from-failure error)))}
+                (recover_from_failure error)))}
   (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
 
-(syntax: #export (check {class (..generic-type^ (list))}
+(syntax: #export (check {class (..generic_type^ (list))}
                         {unchecked (p.maybe s.any)})
   {#.doc (doc "Checks whether an object is an instance of a particular class."
               "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes."
               (case (check String "YOLO")
-                (#.Some value-as-string)
+                (#.Some value_as_string)
                 #.None))}
-  (with-gensyms [g!_ g!unchecked]
-    (let [class-name (simple-class$ (list) class)
-          class-type (` (.primitive (~ (code.text class-name))))
-          check-type (` (.Maybe (~ class-type)))
-          check-code (` (if ((~ (code.text (format "jvm instanceof" ":" class-name))) (~ g!unchecked))
-                          (#.Some (.:coerce (~ class-type)
+  (with_gensyms [g!_ g!unchecked]
+    (let [class_name (simple_class$ (list) class)
+          class_type (` (.primitive (~ (code.text class_name))))
+          check_type (` (.Maybe (~ class_type)))
+          check_code (` (if ((~ (code.text (format "jvm instanceof" ":" class_name))) (~ g!unchecked))
+                          (#.Some (.:coerce (~ class_type)
                                             (~ g!unchecked)))
                           #.None))]
       (case unchecked
         (#.Some unchecked)
-        (wrap (list (` (: (~ check-type)
+        (wrap (list (` (: (~ check_type)
                           (let [(~ g!unchecked) (~ unchecked)]
-                            (~ check-code))))))
+                            (~ check_code))))))
 
         #.None
-        (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check-type))
+        (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type))
                           (function ((~ g!_) (~ g!unchecked))
-                            (~ check-code))))))
+                            (~ check_code))))))
         ))))
 
 (syntax: #export (synchronized lock body)
   {#.doc (doc "Evaluates body, while holding a lock on a given object."
-              (synchronized object-to-be-locked
-                (exec (do-something ___)
-                  (do-something-else ___)
-                  (finish-the-computation ___))))}
+              (synchronized object_to_be_locked
+                (exec (do_something ___)
+                  (do_something_else ___)
+                  (finish_the_computation ___))))}
   (wrap (list (` ("jvm object synchronized" (~ lock) (~ body))))))
 
-(syntax: #export (do-to obj {methods (p.some partial-call^)})
+(syntax: #export (do_to obj {methods (p.some partial_call^)})
   {#.doc (doc "Call a variety of methods on an object. Then, return the object."
-              (do-to object
+              (do_to object
                 (ClassName::method1 arg0 arg1 arg2)
                 (ClassName::method2 arg3 arg4 arg5)))}
-  (with-gensyms [g!obj]
+  (with_gensyms [g!obj]
     (wrap (list (` (let [(~ g!obj) (~ obj)]
-                     (exec (~+ (list\map (complete-call$ g!obj) methods))
+                     (exec (~+ (list\map (complete_call$ g!obj) methods))
                        (~ g!obj))))))))
 
-(def: (class-import$ [full-name params])
-  (-> Class-Declaration Code)
-  (let [params' (list\map (|>> product.left code.local-identifier) params)]
-    (` (def: (~ (code.identifier ["" full-name]))
-         {#..jvm-class (~ (code.text full-name))}
+(def: (class_import$ [full_name params])
+  (-> Class_Declaration Code)
+  (let [params' (list\map (|>> product.left code.local_identifier) params)]
+    (` (def: (~ (code.identifier ["" full_name]))
+         {#..jvm_class (~ (code.text full_name))}
          Type
          (All [(~+ params')]
-           (primitive (~ (code.text (sanitize full-name)))
+           (primitive (~ (code.text (sanitize full_name)))
                       [(~+ params')]))))))
 
-(def: (member-type-vars class-tvars member)
-  (-> (List Type-Parameter) Import-Member-Declaration (List Type-Parameter))
+(def: (member_type_vars class_tvars member)
+  (-> (List Type_Parameter) Import_Member_Declaration (List Type_Parameter))
   (case member
     (#ConstructorDecl [commons _])
-    (list\compose class-tvars (get@ #import-member-tvars commons))
+    (list\compose class_tvars (get@ #import_member_tvars commons))
 
     (#MethodDecl [commons _])
-    (case (get@ #import-member-kind commons)
+    (case (get@ #import_member_kind commons)
       #StaticIMK
-      (get@ #import-member-tvars commons)
+      (get@ #import_member_tvars commons)
 
       _
-      (list\compose class-tvars (get@ #import-member-tvars commons)))
+      (list\compose class_tvars (get@ #import_member_tvars commons)))
 
     _
-    class-tvars))
+    class_tvars))
 
-(def: (member-def-arg-bindings type-params class member)
-  (-> (List Type-Parameter) Class-Declaration Import-Member-Declaration (Meta [(List [Bit Code]) (List Text) (List Code)]))
+(def: (member_def_arg_bindings type_params class member)
+  (-> (List Type_Parameter) Class_Declaration Import_Member_Declaration (Meta [(List [Bit Code]) (List Text) (List Code)]))
   (case member
     (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
-    (let [(^slots [#import-member-tvars #import-member-args]) commons]
+    (let [(^slots [#import_member_tvars #import_member_args]) commons]
       (do {! meta.monad}
-        [arg-inputs (monad.map !
+        [arg_inputs (monad.map !
                                (: (-> [Bit GenericType] (Meta [Bit Code]))
                                   (function (_ [maybe? _])
-                                    (with-gensyms [arg-name]
-                                      (wrap [maybe? arg-name]))))
-                               import-member-args)
-         #let [arg-classes (: (List Text)
-                              (list\map (|>> product.right (simple-class$ (list\compose type-params import-member-tvars)))
-                                        import-member-args))
-               arg-types (list\map (: (-> [Bit GenericType] Code)
+                                    (with_gensyms [arg_name]
+                                      (wrap [maybe? arg_name]))))
+                               import_member_args)
+         #let [arg_classes (: (List Text)
+                              (list\map (|>> product.right (simple_class$ (list\compose type_params import_member_tvars)))
+                                        import_member_args))
+               arg_types (list\map (: (-> [Bit GenericType] Code)
                                       (function (_ [maybe? arg])
-                                        (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)]
+                                        (let [arg_type (class->type (get@ #import_member_mode commons) type_params arg)]
                                           (if maybe?
-                                            (` (Maybe (~ arg-type)))
-                                            arg-type))))
-                                   import-member-args)]]
-        (wrap [arg-inputs arg-classes arg-types])))
+                                            (` (Maybe (~ arg_type)))
+                                            arg_type))))
+                                   import_member_args)]]
+        (wrap [arg_inputs arg_classes arg_types])))
 
     _
     (\ meta.monad wrap [(list) (list) (list)])))
 
-(def: (decorate-return-maybe member return-term)
-  (-> Import-Member-Declaration Code Code)
+(def: (decorate_return_maybe member return_term)
+  (-> Import_Member_Declaration Code Code)
   (case member
     (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
-    (if (get@ #import-member-maybe? commons)
-      (` (??? (~ return-term)))
+    (if (get@ #import_member_maybe? commons)
+      (` (??? (~ return_term)))
       (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))]
-        (` (let [(~ g!temp) (~ return-term)]
+        (` (let [(~ g!temp) (~ return_term)]
              (if (not (..null? (:coerce (primitive "java.lang.Object")
                                         (~ g!temp))))
                (~ g!temp)
                (error! "Cannot produce null references from method calls."))))))
 
     _
-    return-term))
+    return_term))
 
-(template [  ]
-  [(def: ( member return-term)
-     (-> Import-Member-Declaration Code Code)
+(template [  ]
+  [(def: ( member return_term)
+     (-> Import_Member_Declaration Code Code)
      (case member
        (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
        (if (get@  commons)
-         
-         return-term)
+         
+         return_term)
 
        _
-       return-term))]
+       return_term))]
 
-  [decorate-return-try #import-member-try? (` (..try (~ return-term)))]
-  [decorate-return-io  #import-member-io?  (` ((~! io.io) (~ return-term)))]
+  [decorate_return_try #import_member_try? (` (..try (~ return_term)))]
+  [decorate_return_io  #import_member_io?  (` ((~! io.io) (~ return_term)))]
   )
 
-(def: (free-type-param? [name bounds])
-  (-> Type-Parameter Bit)
+(def: (free_type_param? [name bounds])
+  (-> Type_Parameter Bit)
   (case bounds
     #.Nil #1
     _     #0))
 
-(def: (type-param->type-arg [name _])
-  (-> Type-Parameter Code)
+(def: (type_param->type_arg [name _])
+  (-> Type_Parameter Code)
   (code.identifier ["" name]))
 
 (template [    ]
   [(def: ( mode [class expression])
-     (-> Primitive-Mode [Text Code] Code)
+     (-> Primitive_Mode [Text Code] Code)
      (case mode
        #ManualPrM
        expression
@@ -1475,78 +1475,78 @@
          "float" (` ( (~ expression)))
          _       expression)))]
 
-  [auto-convert-input  long-to-byte long-to-short long-to-int double-to-float]
-  [auto-convert-output byte-to-long short-to-long int-to-long float-to-double]
+  [auto_convert_input  long_to_byte long_to_short long_to_int double_to_float]
+  [auto_convert_output byte_to_long short_to_long int_to_long float_to_double]
   )
 
-(def: (un-quote quoted)
+(def: (un_quote quoted)
   (-> Code Code)
   (` ((~' ~) (~ quoted))))
 
-(def: (jvm-extension-inputs mode classes inputs)
-  (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code))
+(def: (jvm_extension_inputs mode classes inputs)
+  (-> Primitive_Mode (List Text) (List [Bit Code]) (List Code))
   (|> inputs
       (list\map (function (_ [maybe? input])
                   (if maybe?
-                    (` ((~! !!!) (~ (un-quote input))))
-                    (un-quote input))))
+                    (` ((~! !!!) (~ (un_quote input))))
+                    (un_quote input))))
       (list.zip/2 classes)
-      (list\map (auto-convert-input mode))))
+      (list\map (auto_convert_input mode))))
 
-(def: (import-name format class member)
+(def: (import_name format class member)
   (-> Text Text Text Text)
   (|> format
-      (text.replace-all "#" class)
-      (text.replace-all "." member)))
-
-(def: (member-def-interop type-params kind class [arg-function-inputs arg-classes arg-types] member method-prefix import-format)
-  (-> (List Type-Parameter) Class-Kind Class-Declaration [(List [Bit Code]) (List Text) (List Code)] Import-Member-Declaration Text Text (Meta (List Code)))
-  (let [[full-name class-tvars] class
-        full-name (sanitize full-name)
-        all-params (|> (member-type-vars class-tvars member)
-                       (list.filter free-type-param?)
-                       (list\map type-param->type-arg))]
+      (text.replace_all "#" class)
+      (text.replace_all "." member)))
+
+(def: (member_def_interop type_params kind class [arg_function_inputs arg_classes arg_types] member method_prefix import_format)
+  (-> (List Type_Parameter) Class_Kind Class_Declaration [(List [Bit Code]) (List Text) (List Code)] Import_Member_Declaration Text Text (Meta (List Code)))
+  (let [[full_name class_tvars] class
+        full_name (sanitize full_name)
+        all_params (|> (member_type_vars class_tvars member)
+                       (list.filter free_type_param?)
+                       (list\map type_param->type_arg))]
     (case member
-      (#EnumDecl enum-members)
+      (#EnumDecl enum_members)
       (do {! meta.monad}
-        [#let [enum-type (: Code
-                            (case class-tvars
+        [#let [enum_type (: Code
+                            (case class_tvars
                               #.Nil
-                              (` (primitive (~ (code.text full-name))))
+                              (` (primitive (~ (code.text full_name))))
 
                               _
-                              (let [=class-tvars (|> class-tvars
-                                                     (list.filter free-type-param?)
-                                                     (list\map type-param->type-arg))]
-                                (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)]))))))
-               getter-interop (: (-> Text Code)
+                              (let [=class_tvars (|> class_tvars
+                                                     (list.filter free_type_param?)
+                                                     (list\map type_param->type_arg))]
+                                (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)]))))))
+               getter_interop (: (-> Text Code)
                                  (function (_ name)
-                                   (let [getter-name (code.identifier ["" (..import-name import-format method-prefix name)])]
-                                     (` (def: (~ getter-name)
-                                          (~ enum-type)
-                                          ((~ (code.text (format "jvm getstatic" ":" full-name ":" name)))))))))]]
-        (wrap (list\map getter-interop enum-members)))
+                                   (let [getter_name (code.identifier ["" (..import_name import_format method_prefix name)])]
+                                     (` (def: (~ getter_name)
+                                          (~ enum_type)
+                                          ((~ (code.text (format "jvm getstatic" ":" full_name ":" name)))))))))]]
+        (wrap (list\map getter_interop enum_members)))
       
       (#ConstructorDecl [commons _])
       (do meta.monad
-        [#let [def-name (code.identifier ["" (..import-name import-format method-prefix (get@ #import-member-alias commons))])
-               jvm-extension (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes)))
-               jvm-interop (|> (` ((~ jvm-extension)
-                                   (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))
-                               (decorate-return-maybe member)
-                               (decorate-return-try member)
-                               (decorate-return-io member))]]
-        (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)))
-                        ((~' wrap) (.list (.` (~ jvm-interop)))))))))
+        [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))])
+               jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.join_with "," arg_classes)))
+               jvm_interop (|> (` ((~ jvm_extension)
+                                   (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))
+                               (decorate_return_maybe member)
+                               (decorate_return_try member)
+                               (decorate_return_io member))]]
+        (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
+                        ((~' wrap) (.list (.` (~ jvm_interop)))))))))
 
       (#MethodDecl [commons method])
-      (with-gensyms [g!obj]
+      (with_gensyms [g!obj]
         (do meta.monad
-          [#let [def-name (code.identifier ["" (..import-name import-format method-prefix (get@ #import-member-alias commons))])
-                 (^slots [#import-member-kind]) commons
-                 (^slots [#import-method-name]) method
-                 [jvm-op object-ast] (: [Text (List Code)]
-                                        (case import-member-kind
+          [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))])
+                 (^slots [#import_member_kind]) commons
+                 (^slots [#import_method_name]) method
+                 [jvm_op object_ast] (: [Text (List Code)]
+                                        (case import_member_kind
                                           #StaticIMK
                                           ["invokestatic"
                                            (list)]
@@ -1561,103 +1561,103 @@
                                             ["invokeinterface"
                                              (list g!obj)]
                                             )))
-                 jvm-extension (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name ":" (text.join-with "," arg-classes)))
-                 jvm-interop (|> [(simple-class$ (list) (get@ #import-method-return method))
-                                  (` ((~ jvm-extension) (~+ (list\map un-quote object-ast))
-                                      (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))]
-                                 (auto-convert-output (get@ #import-member-mode commons))
-                                 (decorate-return-maybe member)
-                                 (decorate-return-try member)
-                                 (decorate-return-io member))]]
-          (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)) (~+ object-ast))
-                          ((~' wrap) (.list (.` (~ jvm-interop))))))))))
+                 jvm_extension (code.text (format "jvm " jvm_op ":" full_name ":" import_method_name ":" (text.join_with "," arg_classes)))
+                 jvm_interop (|> [(simple_class$ (list) (get@ #import_method_return method))
+                                  (` ((~ jvm_extension) (~+ (list\map un_quote object_ast))
+                                      (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))]
+                                 (auto_convert_output (get@ #import_member_mode commons))
+                                 (decorate_return_maybe member)
+                                 (decorate_return_try member)
+                                 (decorate_return_io member))]]
+          (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
+                          ((~' wrap) (.list (.` (~ jvm_interop))))))))))
 
       (#FieldAccessDecl fad)
       (do meta.monad
         [#let [(^open ".") fad
-               base-gtype (class->type import-field-mode type-params import-field-type)
-               classC (class-decl-type$ class)
-               typeC (if import-field-maybe?
-                       (` (Maybe (~ base-gtype)))
-                       base-gtype)
-               tvar-asts (: (List Code)
-                            (|> class-tvars
-                                (list.filter free-type-param?)
-                                (list\map type-param->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]
-                          (let [getter-call (if import-field-static?
-                                              (` ((~ getter-name)))
-                                              (` ((~ getter-name) (~ g!obj))))
-                                getter-body (<| (auto-convert-output import-field-mode)
-                                                [(simple-class$ (list) import-field-type)
-                                                 (if import-field-static?
-                                                   (let [jvm-extension (code.text (format "jvm getstatic" ":" full-name ":" import-field-name))]
-                                                     (` ((~ jvm-extension))))
-                                                   (let [jvm-extension (code.text (format "jvm getfield" ":" full-name ":" import-field-name))]
-                                                     (` ((~ jvm-extension) (~ (un-quote g!obj))))))])
-                                getter-body (if import-field-maybe?
-                                              (` ((~! ???) (~ getter-body)))
-                                              getter-body)
-                                getter-body (if import-field-setter?
-                                              (` ((~! io.io) (~ getter-body)))
-                                              getter-body)]
-                            (wrap (` ((~! syntax:) (~ getter-call)
-                                      ((~' wrap) (.list (.` (~ getter-body)))))))))
-         setter-interop (: (Meta (List Code))
-                           (if import-field-setter?
-                             (with-gensyms [g!obj g!value]
-                               (let [setter-call (if import-field-static?
-                                                   (` ((~ setter-name) (~ g!value)))
-                                                   (` ((~ setter-name) (~ g!value) (~ g!obj))))
-                                     setter-value (auto-convert-input import-field-mode
-                                                                      [(simple-class$ (list) import-field-type) (un-quote g!value)])
-                                     setter-value (if import-field-maybe?
-                                                    (` ((~! !!!) (~ setter-value)))
-                                                    setter-value)
-                                     setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield")
-                                                            ":" full-name ":" import-field-name)
+               base_gtype (class->type import_field_mode type_params import_field_type)
+               classC (class_decl_type$ class)
+               typeC (if import_field_maybe?
+                       (` (Maybe (~ base_gtype)))
+                       base_gtype)
+               tvar_asts (: (List Code)
+                            (|> class_tvars
+                                (list.filter free_type_param?)
+                                (list\map type_param->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]
+                          (let [getter_call (if import_field_static?
+                                              (` ((~ getter_name)))
+                                              (` ((~ getter_name) (~ g!obj))))
+                                getter_body (<| (auto_convert_output import_field_mode)
+                                                [(simple_class$ (list) import_field_type)
+                                                 (if import_field_static?
+                                                   (let [jvm_extension (code.text (format "jvm getstatic" ":" full_name ":" import_field_name))]
+                                                     (` ((~ jvm_extension))))
+                                                   (let [jvm_extension (code.text (format "jvm getfield" ":" full_name ":" import_field_name))]
+                                                     (` ((~ jvm_extension) (~ (un_quote g!obj))))))])
+                                getter_body (if import_field_maybe?
+                                              (` ((~! ???) (~ getter_body)))
+                                              getter_body)
+                                getter_body (if import_field_setter?
+                                              (` ((~! io.io) (~ getter_body)))
+                                              getter_body)]
+                            (wrap (` ((~! syntax:) (~ getter_call)
+                                      ((~' wrap) (.list (.` (~ getter_body)))))))))
+         setter_interop (: (Meta (List Code))
+                           (if import_field_setter?
+                             (with_gensyms [g!obj g!value]
+                               (let [setter_call (if import_field_static?
+                                                   (` ((~ setter_name) (~ g!value)))
+                                                   (` ((~ setter_name) (~ g!value) (~ g!obj))))
+                                     setter_value (auto_convert_input import_field_mode
+                                                                      [(simple_class$ (list) import_field_type) (un_quote g!value)])
+                                     setter_value (if import_field_maybe?
+                                                    (` ((~! !!!) (~ setter_value)))
+                                                    setter_value)
+                                     setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield")
+                                                            ":" full_name ":" import_field_name)
                                      g!obj+ (: (List Code)
-                                               (if import-field-static?
+                                               (if import_field_static?
                                                  (list)
-                                                 (list (un-quote g!obj))))]
-                                 (wrap (list (` ((~! syntax:) (~ setter-call)
-                                                 ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter-command)) (~+ g!obj+) (~ setter-value))))))))))))
+                                                 (list (un_quote g!obj))))]
+                                 (wrap (list (` ((~! syntax:) (~ setter_call)
+                                                 ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
                              (wrap (list))))]
-        (wrap (list& getter-interop setter-interop)))
+        (wrap (list& getter_interop setter_interop)))
       )))
 
-(def: (member-import$ type-params kind class [import-format member])
-  (-> (List Type-Parameter) Class-Kind Class-Declaration [Text Import-Member-Declaration] (Meta (List Code)))
-  (let [[method-prefix _] class]
+(def: (member_import$ type_params kind class [import_format member])
+  (-> (List Type_Parameter) Class_Kind Class_Declaration [Text Import_Member_Declaration] (Meta (List Code)))
+  (let [[method_prefix _] class]
     (do meta.monad
-      [=args (member-def-arg-bindings type-params class member)]
-      (member-def-interop type-params kind class =args member method-prefix import-format))))
+      [=args (member_def_arg_bindings type_params class member)]
+      (member_def_interop type_params kind class =args member method_prefix import_format))))
 
 (def: (interface? class)
   (All [a] (-> (primitive "java.lang.Class" [a]) Bit))
   ("jvm invokevirtual:java.lang.Class:isInterface:" class))
 
-(def: (load-class class-name)
+(def: (load_class class_name)
   (-> Text (Try (primitive "java.lang.Class" [Any])))
-  (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class-name)))
+  (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name)))
 
-(def: (class-kind [class-name _])
-  (-> Class-Declaration (Meta Class-Kind))
-  (let [class-name (sanitize class-name)]
-    (case (load-class class-name)
+(def: (class_kind [class_name _])
+  (-> Class_Declaration (Meta Class_Kind))
+  (let [class_name (sanitize class_name)]
+    (case (load_class class_name)
       (#.Right class)
       (\ meta.monad wrap (if (interface? class)
                            #Interface
                            #Class))
 
       (#.Left _)
-      (meta.fail (format "Unknown class: " class-name)))))
+      (meta.fail (format "Unknown class: " class_name)))))
 
 (syntax: #export (import:
-                   {class-decl ..class-decl^}
-                   {bundles (p.some (..bundle (product.right class-decl)))})
+                   {class_decl ..class_decl^}
+                   {bundles (p.some (..bundle (product.right class_decl)))})
   {#.doc (doc "Allows importing JVM classes, and using them as types."
               "Their methods, fields and enum options can also be imported."
               (import: java/lang/Object
@@ -1675,7 +1675,7 @@
                 ["#::."
                  (new [[byte]])
                  (#static valueOf [char] java/lang/String)
-                 (#static valueOf #as int-valueOf [int] java/lang/String)])
+                 (#static valueOf #as int_valueOf [int] java/lang/String)])
 
               (import: (java/util/List e)
                 ["#::."
@@ -1705,27 +1705,27 @@
               
               "Also, the names of the imported members will look like Class::member"
               (java/lang/Object::new [])
-              (java/lang/Object::equals [other-object] my-object)
-              (java/util/List::size [] my-list)
+              (java/lang/Object::equals [other_object] my_object)
+              (java/util/List::size [] my_list)
               java/lang/Character$UnicodeScript::LATIN
               )}
   (do {! meta.monad}
-    [kind (class-kind class-decl)
+    [kind (class_kind class_decl)
      =members (|> bundles
-                  (list\map (function (_ [import-format members])
-                              (list\map (|>> [import-format]) members)))
+                  (list\map (function (_ [import_format members])
+                              (list\map (|>> [import_format]) members)))
                   list.concat
-                  (monad.map ! (member-import$ (product.right class-decl) kind class-decl)))]
-    (wrap (list& (class-import$ class-decl) (list\join =members)))))
+                  (monad.map ! (member_import$ (product.right class_decl) kind class_decl)))]
+    (wrap (list& (class_import$ class_decl) (list\join =members)))))
 
-(syntax: #export (array {type (..generic-type^ (list))}
+(syntax: #export (array {type (..generic_type^ (list))}
                         size)
   {#.doc (doc "Create an array of the given type, with the given size."
               (array Object 10))}
   (case type
-    (^template [ ]
+    (^template [ ]
       [(^ (#GenericClass  (list)))
-       (wrap (list (` ( (~ size)))))])
+       (wrap (list (` ( (~ size)))))])
     (["boolean" "jvm znewarray"]
      ["byte"    "jvm bnewarray"]
      ["short"   "jvm snewarray"]
@@ -1736,14 +1736,14 @@
      ["char"    "jvm cnewarray"])
 
     _
-    (wrap (list (` ("jvm anewarray" (~ (code.text (generic-type$ type))) (~ size)))))))
+    (wrap (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size)))))))
 
-(syntax: #export (array-length array)
+(syntax: #export (array_length array)
   {#.doc (doc "Gives the length of an array."
-              (array-length my-array))}
+              (array_length my_array))}
   (wrap (list (` ("jvm arraylength" (~ array))))))
 
-(def: (type->class-name type)
+(def: (type->class_name type)
   (-> Type (Meta Text))
   (if (type\= Any type)
     (\ meta.monad wrap "java.lang.Object")
@@ -1757,26 +1757,26 @@
         (meta.fail (format "Cannot apply type: " (type.format F) " to " (type.format A)))
 
         (#.Some type')
-        (type->class-name type'))
+        (type->class_name type'))
       
       (#.Named _ type')
-      (type->class-name type')
+      (type->class_name type')
 
       _
       (meta.fail (format "Cannot convert to JvmType: " (type.format type))))))
 
-(syntax: #export (array-read idx array)
+(syntax: #export (array_read idx array)
   {#.doc (doc "Loads an element from an array."
-              (array-read 10 my-array))}
+              (array_read 10 my_array))}
   (case array
-    [_ (#.Identifier array-name)]
+    [_ (#.Identifier array_name)]
     (do meta.monad
-      [array-type (meta.find-type array-name)
-       array-jvm-type (type->class-name array-type)]
-      (case array-jvm-type
-        (^template [ ]
+      [array_type (meta.find_type array_name)
+       array_jvm_type (type->class_name array_type)]
+      (case array_jvm_type
+        (^template [ ]
           [
-           (wrap (list (` ( (~ array) (~ idx)))))])
+           (wrap (list (` ( (~ array) (~ idx)))))])
         (["[Z" "jvm zaload"]
          ["[B" "jvm baload"]
          ["[S" "jvm saload"]
@@ -1790,22 +1790,22 @@
         (wrap (list (` ("jvm aaload" (~ array) (~ idx)))))))
 
     _
-    (with-gensyms [g!array]
+    (with_gensyms [g!array]
       (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-read (~ idx) (~ g!array)))))))))
+                       (..array_read (~ idx) (~ g!array)))))))))
 
-(syntax: #export (array-write idx value array)
+(syntax: #export (array_write idx value array)
   {#.doc (doc "Stores an element into an array."
-              (array-write 10 my-object my-array))}
+              (array_write 10 my_object my_array))}
   (case array
-    [_ (#.Identifier array-name)]
+    [_ (#.Identifier array_name)]
     (do meta.monad
-      [array-type (meta.find-type array-name)
-       array-jvm-type (type->class-name array-type)]
-      (case array-jvm-type
-        (^template [ ]
+      [array_type (meta.find_type array_name)
+       array_jvm_type (type->class_name array_type)]
+      (case array_jvm_type
+        (^template [ ]
           [
-           (wrap (list (` ( (~ array) (~ idx) (~ value)))))])
+           (wrap (list (` ( (~ array) (~ idx) (~ value)))))])
         (["[Z" "jvm zastore"]
          ["[B" "jvm bastore"]
          ["[S" "jvm sastore"]
@@ -1819,14 +1819,14 @@
         (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value)))))))
 
     _
-    (with-gensyms [g!array]
+    (with_gensyms [g!array]
       (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-write (~ idx) (~ value) (~ g!array)))))))))
+                       (..array_write (~ idx) (~ value) (~ g!array)))))))))
 
-(syntax: #export (class-for {type (..generic-type^ (list))})
+(syntax: #export (class_for {type (..generic_type^ (list))})
   {#.doc (doc "Loads the class as a java.lang.Class object."
-              (class-for java/lang/String))}
-  (wrap (list (` ("jvm object class" (~ (code.text (simple-class$ (list) type))))))))
+              (class_for java/lang/String))}
+  (wrap (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type))))))))
 
-(syntax: #export (type {type (..generic-type^ (list))})
+(syntax: #export (type {type (..generic_type^ (list))})
   (wrap (list (class->type #ManualPrM (list) type))))
diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index b8a6b1ec8..45d29b66d 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -17,17 +17,17 @@
 (abstract: #export Locale
   Text
 
-  (def: territory-separator "_")
-  (def: encoding-separator ".")
+  (def: territory_separator "_")
+  (def: encoding_separator ".")
 
   (def: #export (locale language territory encoding)
     (-> Language (Maybe Territory) (Maybe Encoding) Locale)
     (:abstraction (format (language.code language)
                           (|> territory
-                              (maybe\map (|>> territory.long-code (format ..territory-separator)))
+                              (maybe\map (|>> territory.long_code (format ..territory_separator)))
                               (maybe.default ""))
                           (|> encoding
-                              (maybe\map (|>> encoding.name (format ..encoding-separator)))
+                              (maybe\map (|>> encoding.name (format ..encoding_separator)))
                               (maybe.default "")))))
 
   (def: #export code
diff --git a/stdlib/source/lux/locale/language.lux b/stdlib/source/lux/locale/language.lux
index d26581619..81b9b1ee3 100644
--- a/stdlib/source/lux/locale/language.lux
+++ b/stdlib/source/lux/locale/language.lux
@@ -39,7 +39,7 @@
     ["mis" "uncoded languages" uncoded []]
     ["mul" "multiple languages" multiple []]
     ["und" "undetermined" undetermined []]
-    ["zxx" "no linguistic content; not applicable" not-applicable []]
+    ["zxx" "no linguistic content; not applicable" not_applicable []]
 
     ["aar" "Afar" afar []]
     ["abk" "Abkhazian" abkhazian []]
@@ -47,7 +47,7 @@
     ["ach" "Acoli" acoli []]
     ["ada" "Adangme" adangme []]
     ["ady" "Adyghe; Adygei" adyghe []]
-    ["afa" "Afro-Asiatic languages" afro-asiatic []]
+    ["afa" "Afro-Asiatic languages" afro_asiatic []]
     ["afh" "Afrihili" afrihili []]
     ["afr" "Afrikaans" afrikaans []]
     ["ain" "Ainu" ainu []]
@@ -55,13 +55,13 @@
     ["akk" "Akkadian" akkadian []]
     ["ale" "Aleut" aleut []]
     ["alg" "Algonquian languages" algonquian []]
-    ["alt" "Southern Altai" southern-altai []]
+    ["alt" "Southern Altai" southern_altai []]
     ["amh" "Amharic" amharic []]
-    ["ang" "Old English (ca.450–1100)" old-english []]
+    ["ang" "Old English (ca.450–1100)" old_english []]
     ["anp" "Angika" angika []]
     ["apa" "Apache languages" apache []]
     ["ara" "Arabic" arabic []]
-    ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official-aramaic [[imperial-aramaic]]]
+    ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official_aramaic [[imperial_aramaic]]]
     ["arg" "Aragonese" aragonese []]
     ["arn" "Mapudungun; Mapuche" mapudungun []]
     ["arp" "Arapaho" arapaho []]
@@ -108,8 +108,8 @@
     ["byn" "Blin; Bilin" blin [[bilin]]]
 
     ["cad" "Caddo" caddo []]
-    ["cai" "Central American Indian languages" central-american-indian []]
-    ["car" "Galibi Carib" galibi-carib []]
+    ["cai" "Central American Indian languages" central_american_indian []]
+    ["car" "Galibi Carib" galibi_carib []]
     ["cat" "Catalan; Valencian" catalan [[valencian]]]
     ["cau" "Caucasian languages" caucasian []]
     ["ceb" "Cebuano" cebuano []]
@@ -125,7 +125,7 @@
     ["cho" "Choctaw" choctaw []]
     ["chp" "Chipewyan; Dene Suline" chipewyan []]
     ["chr" "Cherokee" cherokee []]
-    ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church-slavic [[old-slavonic] [church-slavonic] [old-bulgarian] [old-church-slavonic]]]
+    ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church_slavic [[old_slavonic] [church_slavonic] [old_bulgarian] [old_church_slavonic]]]
     ["chv" "Chuvash" chuvash []]
     ["chy" "Cheyenne" cheyenne []]
     ["cmc" "Chamic languages" chamic []]
@@ -133,12 +133,12 @@
     ["cop" "Coptic" coptic []]
     ["cor" "Cornish" cornish []]
     ["cos" "Corsican" corsican []]
-    ["cpe" "Creoles and pidgins, English based" creoles-and-pidgins/english []]
-    ["cpf" "Creoles and pidgins, French-based" creoles-and-pidgins/french []]
-    ["cpp" "Creoles and pidgins, Portuguese-based" creoles-and-pidgins/portuguese []]
+    ["cpe" "Creoles and pidgins, English based" creoles_and_pidgins/english []]
+    ["cpf" "Creoles and pidgins, French-based" creoles_and_pidgins/french []]
+    ["cpp" "Creoles and pidgins, Portuguese-based" creoles_and_pidgins/portuguese []]
     ["cre" "Cree" cree []]
     ["crh" "Crimean Tatar; Crimean Turkish" crimean []]
-    ["crp" "Creoles and pidgins" creoles-and-pidgins []]
+    ["crp" "Creoles and pidgins" creoles_and_pidgins []]
     ["csb" "Kashubian" kashubian []]
     ["cus" "Cushitic languages" cushitic []]
     ["cym" "Welsh" welsh []]
@@ -146,7 +146,7 @@
     ["dak" "Dakota" dakota []]
     ["dan" "Danish" danish []]
     ["dar" "Dargwa" dargwa []]
-    ["day" "Land Dayak languages" land-dayak []]
+    ["day" "Land Dayak languages" land_dayak []]
     ["del" "Delaware" delaware []]
     ["den" "Slave (Athapascan)" slavey []]
     ["deu" "German" german []]
@@ -155,9 +155,9 @@
     ["div" "Divehi; Dhivehi; Maldivian" dhivehi [[maldivian]]]
     ["doi" "Dogri" dogri []]
     ["dra" "Dravidian languages" dravidian []]
-    ["dsb" "Lower Sorbian" lower-sorbian []]
+    ["dsb" "Lower Sorbian" lower_sorbian []]
     ["dua" "Duala" duala []]
-    ["dum" "Middle Dutch (ca. 1050–1350)" middle-dutch []]
+    ["dum" "Middle Dutch (ca. 1050–1350)" middle_dutch []]
     ["dyu" "Dyula" dyula []]
     ["dzo" "Dzongkha" dzongkha []]
 
@@ -167,7 +167,7 @@
     ["ell" "Modern Greek (1453–)" greek []]
     ["elx" "Elamite" elamite []]
     ["eng" "English" english []]
-    ["enm" "Middle English (1100–1500)" middle-english []]
+    ["enm" "Middle English (1100–1500)" middle_english []]
     ["epo" "Esperanto" esperanto []]
     ["est" "Estonian" estonian []]
     ["eus" "Basque" basque []]
@@ -181,14 +181,14 @@
     ["fij" "Fijian" fijian []]
     ["fil" "Filipino; Pilipino" filipino []]
     ["fin" "Finnish" finnish []]
-    ["fiu" "Finno-Ugrian languages" finno-ugrian []]
+    ["fiu" "Finno-Ugrian languages" finno_ugrian []]
     ["fon" "Fon" fon []]
     ["fra" "French" french []]
-    ["frm" "Middle French (ca. 1400–1600)" middle-french []]
-    ["fro" "Old French (ca. 842–1400)" old-french []]
-    ["frr" "Northern Frisian" northern-frisian []]
-    ["frs" "Eastern Frisian" eastern-frisian []]
-    ["fry" "Western Frisian" western-frisian []]
+    ["frm" "Middle French (ca. 1400–1600)" middle_french []]
+    ["fro" "Old French (ca. 842–1400)" old_french []]
+    ["frr" "Northern Frisian" northern_frisian []]
+    ["frs" "Eastern Frisian" eastern_frisian []]
+    ["fry" "Western Frisian" western_frisian []]
     ["ful" "Fulah" fulah []]
     ["fur" "Friulian" friulian []]
 
@@ -202,15 +202,15 @@
     ["gle" "Irish" irish []]
     ["glg" "Galician" galician []]
     ["glv" "Manx" manx []]
-    ["gmh" "Middle High German (ca. 1050–1500)" middle-high-german []]
-    ["goh" "Old High German (ca. 750–1050)" old-high-german []]
+    ["gmh" "Middle High German (ca. 1050–1500)" middle_high_german []]
+    ["goh" "Old High German (ca. 750–1050)" old_high_german []]
     ["gon" "Gondi" gondi []]
     ["gor" "Gorontalo" gorontalo []]
     ["got" "Gothic" gothic []]
     ["grb" "Grebo" grebo []]
-    ["grc" "Ancient Greek (to 1453)" ancient-greek []]
+    ["grc" "Ancient Greek (to 1453)" ancient_greek []]
     ["grn" "Guarani" guarani []]
-    ["gsw" "Swiss German; Alemannic; Alsatian" swiss-german [[alemannic] [alsatian]]]
+    ["gsw" "Swiss German; Alemannic; Alsatian" swiss_german [[alemannic] [alsatian]]]
     ["guj" "Gujarati" gujarati []]
     ["gwi" "Gwich'in" gwich'in []]
 
@@ -225,9 +225,9 @@
     ["hin" "Hindi" hindi []]
     ["hit" "Hittite" hittite []]
     ["hmn" "Hmong; Mong" hmong []]
-    ["hmo" "Hiri Motu" hiri-motu []]
+    ["hmo" "Hiri Motu" hiri_motu []]
     ["hrv" "Croatian" croatian []]
-    ["hsb" "Upper Sorbian" upper-sorbian []]
+    ["hsb" "Upper Sorbian" upper_sorbian []]
     ["hun" "Hungarian" hungarian []]
     ["hup" "Hupa" hupa []]
     ["hye" "Armenian" armenian []]
@@ -235,7 +235,7 @@
     ["iba" "Iban" iban []]
     ["ibo" "Igbo" igbo []]
     ["ido" "Ido" ido []]
-    ["iii" "Sichuan Yi; Nuosu" sichuan-yi [[nuosu]]]
+    ["iii" "Sichuan Yi; Nuosu" sichuan_yi [[nuosu]]]
     ["ijo" "Ijo languages" ijo []]
     ["iku" "Inuktitut" inuktitut []]
     ["ile" "Interlingue; Occidental" interlingue []]
@@ -243,7 +243,7 @@
     ["ina" "Interlingua (International Auxiliary Language Association)" interlingua []]
     ["inc" "Indic languages" indic []]
     ["ind" "Indonesian" indonesian []]
-    ["ine" "Indo-European languages" indo-european []]
+    ["ine" "Indo-European languages" indo_european []]
     ["inh" "Ingush" ingush []]
     ["ipk" "Inupiaq" inupiaq []]
     ["ira" "Iranian languages" iranian []]
@@ -254,10 +254,10 @@
     ["jav" "Javanese" javanese []]
     ["jbo" "Lojban" lojban []]
     ["jpn" "Japanese" japanese []]
-    ["jpr" "Judeo-Persian" judeo-persian []]
-    ["jrb" "Judeo-Arabic" judeo-arabic []]
+    ["jpr" "Judeo-Persian" judeo_persian []]
+    ["jrb" "Judeo-Arabic" judeo_arabic []]
 
-    ["kaa" "Kara-Kalpak" kara-kalpak []]
+    ["kaa" "Kara-Kalpak" kara_kalpak []]
     ["kab" "Kabyle" kabyle []]
     ["kac" "Kachin; Jingpho" kachin [[jingpho]]]
     ["kal" "Kalaallisut; Greenlandic" kalaallisut [[greenlandic]]]
@@ -272,7 +272,7 @@
     ["kbd" "Kabardian" kabardian []]
     ["kha" "Khasi" khasi []]
     ["khi" "Khoisan languages" khoisan []]
-    ["khm" "Central Khmer" central-khmer []]
+    ["khm" "Central Khmer" central_khmer []]
     ["kho" "Khotanese; Sakan" khotanese [[sakan]]]
     ["kik" "Kikuyu; Gikuyu" gikuyu []]
     ["kin" "Kinyarwanda" kinyarwanda []]
@@ -284,7 +284,7 @@
     ["kor" "Korean" korean []]
     ["kos" "Kosraean" kosraean []]
     ["kpe" "Kpelle" kpelle []]
-    ["krc" "Karachay-Balkar" karachay-balkar []]
+    ["krc" "Karachay-Balkar" karachay_balkar []]
     ["krl" "Karelian" karelian []]
     ["kro" "Kru languages" kru []]
     ["kru" "Kurukh" kurukh []]
@@ -306,8 +306,8 @@
     ["lol" "Mongo" mongo []]
     ["loz" "Lozi" lozi []]
     ["ltz" "Luxembourgish; Letzeburgesch" luxembourgish []]
-    ["lua" "Luba-Lulua" luba-lulua []]
-    ["lub" "Luba-Katanga" luba-katanga []]
+    ["lua" "Luba-Lulua" luba_lulua []]
+    ["lub" "Luba-Katanga" luba_katanga []]
     ["lug" "Ganda" ganda []]
     ["lui" "Luiseno" luiseno []]
     ["lun" "Lunda" lunda []]
@@ -327,11 +327,11 @@
     ["mdf" "Moksha" moksha []]
     ["mdr" "Mandar" mandar []]
     ["men" "Mende" mende []]
-    ["mga" "Middle Irish (900–1200)" middle-irish []]
+    ["mga" "Middle Irish (900–1200)" middle_irish []]
     ["mic" "Mi'kmaq; Micmac" mi'kmaq [[micmac]]]
     ["min" "Minangkabau" minangkabau []]
     ["mkd" "Macedonian" macedonian []]
-    ["mkh" "Mon-Khmer languages" mon-khmer []]
+    ["mkh" "Mon-Khmer languages" mon_khmer []]
     ["mlg" "Malagasy" malagasy []]
     ["mlt" "Maltese" maltese []]
     ["mnc" "Manchu" manchu []]
@@ -351,29 +351,29 @@
     ["myv" "Erzya" erzya []]
 
     ["nah" "Nahuatl languages" nahuatl []]
-    ["nai" "North American Indian languages" north-american-indian []]
+    ["nai" "North American Indian languages" north_american_indian []]
     ["nap" "Neapolitan" neapolitan []]
     ["nau" "Nauru" nauru []]
     ["nav" "Navajo; Navaho" navajo []]
-    ["nbl" "South Ndebele" south-ndebele []]
-    ["nde" "North Ndebele" north-ndebele []]
+    ["nbl" "South Ndebele" south_ndebele []]
+    ["nde" "North Ndebele" north_ndebele []]
     ["ndo" "Ndonga" ndonga []]
-    ["nds" "Low German; Low Saxon" low-german []]
+    ["nds" "Low German; Low Saxon" low_german []]
     ["nep" "Nepali" nepali []]
-    ["new" "Nepal Bhasa; Newari" newari [[nepal-bhasa]]]
+    ["new" "Nepal Bhasa; Newari" newari [[nepal_bhasa]]]
     ["nia" "Nias" nias []]
-    ["nic" "Niger-Kordofanian languages" niger-kordofanian []]
+    ["nic" "Niger-Kordofanian languages" niger_kordofanian []]
     ["niu" "Niuean" niuean []]
     ["nld" "Dutch; Flemish" dutch [[flemish]]]
     ["nno" "Norwegian Nynorsk" nynorsk []]
     ["nob" "Norwegian Bokmål" bokmal []]
     ["nog" "Nogai" nogai []]
-    ["non" "Old Norse" old-norse []]
+    ["non" "Old Norse" old_norse []]
     ["nor" "Norwegian" norwegian []]
     ["nqo" "N'Ko" n'ko []]
-    ["nso" "Pedi; Sepedi; Northern Sotho" northern-sotho [[pedi] [sepedi]]]
+    ["nso" "Pedi; Sepedi; Northern Sotho" northern_sotho [[pedi] [sepedi]]]
     ["nub" "Nubian languages" nubian []]
-    ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old-newari [[classical-newari] [classical-nepal-bhasa]]]
+    ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old_newari [[classical_newari] [classical_nepal_bhasa]]]
     ["nya" "Chichewa; Chewa; Nyanja" nyanja [[chichewa] [chewa]]]
     ["nym" "Nyamwezi" nyamwezi []]
     ["nyn" "Nyankole" nyankole []]
@@ -386,7 +386,7 @@
     ["orm" "Oromo" oromo []]
     ["osa" "Osage" osage []]
     ["oss" "Ossetian; Ossetic" ossetic []]
-    ["ota" "Ottoman Turkish (1500–1928)" ottoman-turkish []]
+    ["ota" "Ottoman Turkish (1500–1928)" ottoman_turkish []]
     ["oto" "Otomian languages" otomian []]
 
     ["paa" "Papuan languages" papuan []]
@@ -396,7 +396,7 @@
     ["pan" "Panjabi; Punjabi" punjabi []]
     ["pap" "Papiamento" papiamento []]
     ["pau" "Palauan" palauan []]
-    ["peo" "Old Persian (ca. 600–400 B.C.)" old-persian []]
+    ["peo" "Old Persian (ca. 600–400 B.C.)" old_persian []]
     ["phi" "Philippine languages" philippine []]
     ["phn" "Phoenician" phoenician []]
     ["pli" "Pali" pali []]
@@ -404,28 +404,28 @@
     ["pon" "Pohnpeian" pohnpeian []]
     ["por" "Portuguese" portuguese []]
     ["pra" "Prakrit languages" prakrit []]
-    ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old-provencal []]
+    ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old_provencal []]
     ["pus" "Pushto; Pashto" pashto []]
 
     ["que" "Quechua" quechua []]
 
     ["raj" "Rajasthani" rajasthani []]
     ["rap" "Rapanui" rapanui []]
-    ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook-islands-maori]]]
+    ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook_islands_maori]]]
     ["roa" "Romance languages" romance []]
     ["roh" "Romansh" romansh []]
     ["rom" "Romany" romany []]
     ["ron" "Romanian; Moldavian; Moldovan" romanian [[moldavian] [moldovan]]]
     ["run" "Rundi" rundi []]
-    ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo-romanian]]]
+    ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo_romanian]]]
     ["rus" "Russian" russian []]
 
     ["sad" "Sandawe" sandawe []]
     ["sag" "Sango" sango []]
     ["sah" "Yakut" yakut []]
-    ["sai" "South American Indian (Other)" south-american-indian []]
+    ["sai" "South American Indian (Other)" south_american_indian []]
     ["sal" "Salishan languages" salishan []]
-    ["sam" "Samaritan Aramaic" samaritan-aramaic []]
+    ["sam" "Samaritan Aramaic" samaritan_aramaic []]
     ["san" "Sanskrit" sanskrit []]
     ["sas" "Sasak" sasak []]
     ["sat" "Santali" santali []]
@@ -433,37 +433,37 @@
     ["sco" "Scots" scots []]
     ["sel" "Selkup" selkup []]
     ["sem" "Semitic languages" semitic []]
-    ["sga" "Old Irish (to 900)" old-irish []]
+    ["sga" "Old Irish (to 900)" old_irish []]
     ["sgn" "Sign Languages" sign []]
     ["shn" "Shan" shan []]
     ["sid" "Sidamo" sidamo []]
     ["sin" "Sinhala; Sinhalese" sinhalese []]
     ["sio" "Siouan languages" siouan []]
-    ["sit" "Sino-Tibetan languages" sino-tibetan []]
+    ["sit" "Sino-Tibetan languages" sino_tibetan []]
     ["sla" "Slavic languages" slavic []]
     ["slk" "Slovak" slovak []]
     ["slv" "Slovenian" slovenian []]
-    ["sma" "Southern Sami" southern-sami []]
-    ["sme" "Northern Sami" northern-sami []]
+    ["sma" "Southern Sami" southern_sami []]
+    ["sme" "Northern Sami" northern_sami []]
     ["smi" "Sami languages" sami []]
     ["smj" "Lule Sami" lule []]
     ["smn" "Inari Sami" inari []]
     ["smo" "Samoan" samoan []]
-    ["sms" "Skolt Sami" skolt-sami []]
+    ["sms" "Skolt Sami" skolt_sami []]
     ["sna" "Shona" shona []]
     ["snd" "Sindhi" sindhi []]
     ["snk" "Soninke" soninke []]
     ["sog" "Sogdian" sogdian []]
     ["som" "Somali" somali []]
     ["son" "Songhai languages" songhai []]
-    ["sot" "Southern Sotho" southern-sotho []]
+    ["sot" "Southern Sotho" southern_sotho []]
     ["spa" "Spanish; Castilian" spanish [[castilian]]]
     ["sqi" "Albanian" albanian []]
     ["srd" "Sardinian" sardinian []]
-    ["srn" "Sranan Tongo" sranan-tongo []]
+    ["srn" "Sranan Tongo" sranan_tongo []]
     ["srp" "Serbian" serbian []]
     ["srr" "Serer" serer []]
-    ["ssa" "Nilo-Saharan languages" nilo-saharan []]
+    ["ssa" "Nilo-Saharan languages" nilo_saharan []]
     ["ssw" "Swati" swati []]
     ["suk" "Sukuma" sukuma []]
     ["sun" "Sundanese" sundanese []]
@@ -471,7 +471,7 @@
     ["sux" "Sumerian" sumerian []]
     ["swa" "Swahili" swahili []]
     ["swe" "Swedish" swedish []]
-    ["syc" "Classical Syriac" classical-syriac []]
+    ["syc" "Classical Syriac" classical_syriac []]
     ["syr" "Syriac" syriac []]
 
     ["tah" "Tahitian" tahitian []]
@@ -494,7 +494,7 @@
     ["tmh" "Tamashek" tamashek []]
     ["tog" "Tonga (Nyasa)" tonga []]
     ["ton" "Tonga (Tonga Islands)" tongan []]
-    ["tpi" "Tok Pisin" tok-pisin []]
+    ["tpi" "Tok Pisin" tok_pisin []]
     ["tsi" "Tsimshian" tsimshian []]
     ["tsn" "Tswana" tswana []]
     ["tso" "Tsonga" tsonga []]
@@ -541,7 +541,7 @@
     ["zap" "Zapotec" zapotec []]
     ["zbl" "Blissymbols; Blissymbolics; Bliss" blissymbols []]
     ["zen" "Zenaga" zenaga []]
-    ["zgh" "Standard Moroccan Tamazight" standard-moroccan-tamazight []]
+    ["zgh" "Standard Moroccan Tamazight" standard_moroccan_tamazight []]
     ["zha" "Zhuang; Chuang" zhuang []]
     ["zho" "Chinese" chinese []]
     ["znd" "Zande languages" zande []]
diff --git a/stdlib/source/lux/locale/territory.lux b/stdlib/source/lux/locale/territory.lux
index 76ecdf965..134856659 100644
--- a/stdlib/source/lux/locale/territory.lux
+++ b/stdlib/source/lux/locale/territory.lux
@@ -24,9 +24,9 @@
             (get@ )))]
 
     [name         #name  Text]
-    [short-code   #short Text]
-    [long-code    #long  Text]
-    [numeric-code #code  Nat]
+    [short_code   #short Text]
+    [long_code    #long  Text]
+    [numeric_code #code  Nat]
     )
 
   (template [    
+] @@ -43,10 +43,10 @@ (~~ (template.splice +))))] ["AF" "AFG" 004 "Afghanistan" afghanistan []] - ["AX" "ALA" 248 "Åland Islands" aland-islands []] + ["AX" "ALA" 248 "Åland Islands" aland_islands []] ["AL" "ALB" 008 "Albania" albania []] ["DZ" "DZA" 012 "Algeria" algeria []] - ["AS" "ASM" 016 "American Samoa" american-samoa []] + ["AS" "ASM" 016 "American Samoa" american_samoa []] ["AD" "AND" 020 "Andorra" andorra []] ["AO" "AGO" 024 "Angola" angola []] ["AI" "AIA" 660 "Anguilla" anguilla []] @@ -58,7 +58,7 @@ ["AU" "AUS" 036 "Australia" australia []] ["AT" "AUT" 040 "Austria" austria []] ["AZ" "AZE" 031 "Azerbaijan" azerbaijan []] - ["BS" "BHS" 044 "The Bahamas" the-bahamas []] + ["BS" "BHS" 044 "The Bahamas" the_bahamas []] ["BH" "BHR" 048 "Bahrain" bahrain []] ["BD" "BGD" 050 "Bangladesh" bangladesh []] ["BB" "BRB" 052 "Barbados" barbados []] @@ -69,61 +69,61 @@ ["BM" "BMU" 060 "Bermuda" bermuda []] ["BT" "BTN" 064 "Bhutan" bhutan []] ["BO" "BOL" 068 "Bolivia" bolivia []] - ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint-eustatius] [saba]]] + ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint_eustatius] [saba]]] ["BA" "BIH" 070 "Bosnia and Herzegovina" bosnia [[herzegovina]]] ["BW" "BWA" 072 "Botswana" botswana []] - ["BV" "BVT" 074 "Bouvet Island" bouvet-island []] + ["BV" "BVT" 074 "Bouvet Island" bouvet_island []] ["BR" "BRA" 076 "Brazil" brazil []] - ["IO" "IOT" 086 "British Indian Ocean Territory" british-indian-ocean-territory []] - ["BN" "BRN" 096 "Brunei Darussalam" brunei-darussalam []] + ["IO" "IOT" 086 "British Indian Ocean Territory" british_indian_ocean_territory []] + ["BN" "BRN" 096 "Brunei Darussalam" brunei_darussalam []] ["BG" "BGR" 100 "Bulgaria" bulgaria []] - ["BF" "BFA" 854 "Burkina Faso" burkina-faso []] + ["BF" "BFA" 854 "Burkina Faso" burkina_faso []] ["BI" "BDI" 108 "Burundi" burundi []] - ["CV" "CPV" 132 "Cape Verde" cape-verde []] + ["CV" "CPV" 132 "Cape Verde" cape_verde []] ["KH" "KHM" 116 "Cambodia" cambodia []] ["CM" "CMR" 120 "Cameroon" cameroon []] ["CA" "CAN" 124 "Canada" canada []] - ["KY" "CYM" 136 "Cayman Islands" cayman-islands []] - ["CF" "CAF" 140 "Central African Republic" central-african-republic []] + ["KY" "CYM" 136 "Cayman Islands" cayman_islands []] + ["CF" "CAF" 140 "Central African Republic" central_african_republic []] ["TD" "TCD" 148 "Chad" chad []] ["CL" "CHL" 152 "Chile" chile []] ["CN" "CHN" 156 "China" china []] - ["CX" "CXR" 162 "Christmas Island" christmas-island []] - ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos-islands []] + ["CX" "CXR" 162 "Christmas Island" christmas_island []] + ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos_islands []] ["CO" "COL" 170 "Colombia" colombia []] ["KM" "COM" 174 "Comoros" comoros []] ["CG" "COG" 178 "Congo" congo []] - ["CD" "COD" 180 "Democratic Republic of the Congo" democratic-republic-of-the-congo []] - ["CK" "COK" 184 "Cook Islands" cook-islands []] - ["CR" "CRI" 188 "Costa Rica" costa-rica []] - ["CI" "CIV" 384 "Ivory Coast" ivory-coast []] + ["CD" "COD" 180 "Democratic Republic of the Congo" democratic_republic_of_the_congo []] + ["CK" "COK" 184 "Cook Islands" cook_islands []] + ["CR" "CRI" 188 "Costa Rica" costa_rica []] + ["CI" "CIV" 384 "Ivory Coast" ivory_coast []] ["HR" "HRV" 191 "Croatia" croatia []] ["CU" "CUB" 192 "Cuba" cuba []] ["CW" "CUW" 531 "Curacao" curacao []] ["CY" "CYP" 196 "Cyprus" cyprus []] - ["CZ" "CZE" 203 "Czech Republic" czech-republic []] + ["CZ" "CZE" 203 "Czech Republic" czech_republic []] ["DK" "DNK" 208 "Denmark" denmark []] ["DJ" "DJI" 262 "Djibouti" djibouti []] ["DM" "DMA" 212 "Dominica" dominica []] - ["DO" "DOM" 214 "Dominican Republic" dominican-republic []] + ["DO" "DOM" 214 "Dominican Republic" dominican_republic []] ["EC" "ECU" 218 "Ecuador" ecuador []] ["EG" "EGY" 818 "Egypt" egypt []] - ["SV" "SLV" 222 "El Salvador" el-salvador []] - ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial-guinea []] + ["SV" "SLV" 222 "El Salvador" el_salvador []] + ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial_guinea []] ["ER" "ERI" 232 "Eritrea" eritrea []] ["EE" "EST" 233 "Estonia" estonia []] ["SZ" "SWZ" 748 "Eswatini" eswatini []] ["ET" "ETH" 231 "Ethiopia" ethiopia []] - ["FK" "FLK" 238 "Falkland Islands" falkland-islands []] - ["FO" "FRO" 234 "Faroe Islands" faroe-islands []] + ["FK" "FLK" 238 "Falkland Islands" falkland_islands []] + ["FO" "FRO" 234 "Faroe Islands" faroe_islands []] ["FJ" "FJI" 242 "Fiji" fiji []] ["FI" "FIN" 246 "Finland" finland []] ["FR" "FRA" 250 "France" france []] - ["GF" "GUF" 254 "French Guiana" french-guiana []] - ["PF" "PYF" 258 "French Polynesia" french-polynesia []] - ["TF" "ATF" 260 "French Southern Territories" french-southern-territories []] + ["GF" "GUF" 254 "French Guiana" french_guiana []] + ["PF" "PYF" 258 "French Polynesia" french_polynesia []] + ["TF" "ATF" 260 "French Southern Territories" french_southern_territories []] ["GA" "GAB" 266 "Gabon" gabon []] - ["GM" "GMB" 270 "The Gambia" the-gambia []] + ["GM" "GMB" 270 "The Gambia" the_gambia []] ["GE" "GEO" 268 "Georgia" georgia []] ["DE" "DEU" 276 "Germany" germany []] ["GH" "GHA" 288 "Ghana" ghana []] @@ -136,13 +136,13 @@ ["GT" "GTM" 320 "Guatemala" guatemala []] ["GG" "GGY" 831 "Guernsey" guernsey []] ["GN" "GIN" 324 "Guinea" guinea []] - ["GW" "GNB" 624 "Guinea-Bissau" guinea-bissau []] + ["GW" "GNB" 624 "Guinea-Bissau" guinea_bissau []] ["GY" "GUY" 328 "Guyana" guyana []] ["HT" "HTI" 332 "Haiti" haiti []] - ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard-island [[mcdonald-islands]]] - ["VA" "VAT" 336 "Vatican City" vatican-city []] + ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard_island [[mcdonald_islands]]] + ["VA" "VAT" 336 "Vatican City" vatican_city []] ["HN" "HND" 340 "Honduras" honduras []] - ["HK" "HKG" 344 "Hong Kong" hong-kong []] + ["HK" "HKG" 344 "Hong Kong" hong_kong []] ["HU" "HUN" 348 "Hungary" hungary []] ["IS" "ISL" 352 "Iceland" iceland []] ["IN" "IND" 356 "India" india []] @@ -150,7 +150,7 @@ ["IR" "IRN" 364 "Iran" iran []] ["IQ" "IRQ" 368 "Iraq" iraq []] ["IE" "IRL" 372 "Ireland" ireland []] - ["IM" "IMN" 833 "Isle of Man" isle-of-man []] + ["IM" "IMN" 833 "Isle of Man" isle_of_man []] ["IL" "ISR" 376 "Israel" israel []] ["IT" "ITA" 380 "Italy" italy []] ["JM" "JAM" 388 "Jamaica" jamaica []] @@ -160,8 +160,8 @@ ["KZ" "KAZ" 398 "Kazakhstan" kazakhstan []] ["KE" "KEN" 404 "Kenya" kenya []] ["KI" "KIR" 296 "Kiribati" kiribati []] - ["KP" "PRK" 408 "North Korea" north-korea []] - ["KR" "KOR" 410 "South Korea" south-korea []] + ["KP" "PRK" 408 "North Korea" north_korea []] + ["KR" "KOR" 410 "South Korea" south_korea []] ["KW" "KWT" 414 "Kuwait" kuwait []] ["KG" "KGZ" 417 "Kyrgyzstan" kyrgyzstan []] ["LA" "LAO" 418 "Laos" laos []] @@ -181,7 +181,7 @@ ["MV" "MDV" 462 "Maldives" maldives []] ["ML" "MLI" 466 "Mali" mali []] ["MT" "MLT" 470 "Malta" malta []] - ["MH" "MHL" 584 "Marshall Islands" marshall-islands []] + ["MH" "MHL" 584 "Marshall Islands" marshall_islands []] ["MQ" "MTQ" 474 "Martinique" martinique []] ["MR" "MRT" 478 "Mauritania" mauritania []] ["MU" "MUS" 480 "Mauritius" mauritius []] @@ -200,62 +200,62 @@ ["NR" "NRU" 520 "Nauru" nauru []] ["NP" "NPL" 524 "Nepal" nepal []] ["NL" "NLD" 528 "Netherlands" netherlands []] - ["NC" "NCL" 540 "New Caledonia" new-caledonia []] - ["NZ" "NZL" 554 "New Zealand" new-zealand []] + ["NC" "NCL" 540 "New Caledonia" new_caledonia []] + ["NZ" "NZL" 554 "New Zealand" new_zealand []] ["NI" "NIC" 558 "Nicaragua" nicaragua []] ["NE" "NER" 562 "Niger" niger []] ["NG" "NGA" 566 "Nigeria" nigeria []] ["NU" "NIU" 570 "Niue" niue []] - ["NF" "NFK" 574 "Norfolk Island" norfolk-island []] - ["MP" "MNP" 580 "Northern Mariana Islands" northern-mariana-islands []] + ["NF" "NFK" 574 "Norfolk Island" norfolk_island []] + ["MP" "MNP" 580 "Northern Mariana Islands" northern_mariana_islands []] ["NO" "NOR" 578 "Norway" norway []] ["OM" "OMN" 512 "Oman" oman []] ["PK" "PAK" 586 "Pakistan" pakistan []] ["PW" "PLW" 585 "Palau" palau []] ["PS" "PSE" 275 "Palestine" palestine []] ["PA" "PAN" 591 "Panama" panama []] - ["PG" "PNG" 598 "Papua New Guinea" papua-new-guinea []] + ["PG" "PNG" 598 "Papua New Guinea" papua_new_guinea []] ["PY" "PRY" 600 "Paraguay" paraguay []] ["PE" "PER" 604 "Peru" peru []] ["PH" "PHL" 608 "Philippines" philippines []] - ["PN" "PCN" 612 "Pitcairn Islands" pitcairn-islands []] + ["PN" "PCN" 612 "Pitcairn Islands" pitcairn_islands []] ["PL" "POL" 616 "Poland" poland []] ["PT" "PRT" 620 "Portugal" portugal []] - ["PR" "PRI" 630 "Puerto Rico" puerto-rico []] + ["PR" "PRI" 630 "Puerto Rico" puerto_rico []] ["QA" "QAT" 634 "Qatar" qatar []] ["RE" "REU" 638 "Reunion" reunion []] ["RO" "ROU" 642 "Romania" romania []] ["RU" "RUS" 643 "Russia" russia []] ["RW" "RWA" 646 "Rwanda" rwanda []] - ["BL" "BLM" 652 "Saint Barthélemy" saint-barthelemy []] - ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint-helena [[ascension] [tristan-da-cunha]]] - ["KN" "KNA" 659 "Saint Kitts and Nevis" saint-kitts [[nevis]]] - ["LC" "LCA" 662 "Saint Lucia" saint-lucia []] - ["MF" "MAF" 663 "Saint Martin" saint-martin []] - ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint-pierre [[miquelon]]] - ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint-vincent [[the-grenadines]]] + ["BL" "BLM" 652 "Saint Barthélemy" saint_barthelemy []] + ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint_helena [[ascension] [tristan_da_cunha]]] + ["KN" "KNA" 659 "Saint Kitts and Nevis" saint_kitts [[nevis]]] + ["LC" "LCA" 662 "Saint Lucia" saint_lucia []] + ["MF" "MAF" 663 "Saint Martin" saint_martin []] + ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint_pierre [[miquelon]]] + ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint_vincent [[the_grenadines]]] ["WS" "WSM" 882 "Samoa" samoa []] - ["SM" "SMR" 674 "San Marino" san-marino []] - ["ST" "STP" 678 "Sao Tome and Principe" sao-tome [[principe]]] - ["SA" "SAU" 682 "Saudi Arabia" saudi-arabia []] + ["SM" "SMR" 674 "San Marino" san_marino []] + ["ST" "STP" 678 "Sao Tome and Principe" sao_tome [[principe]]] + ["SA" "SAU" 682 "Saudi Arabia" saudi_arabia []] ["SN" "SEN" 686 "Senegal" senegal []] ["RS" "SRB" 688 "Serbia" serbia []] ["SC" "SYC" 690 "Seychelles" seychelles []] - ["SL" "SLE" 694 "Sierra Leone" sierra-leone []] + ["SL" "SLE" 694 "Sierra Leone" sierra_leone []] ["SG" "SGP" 702 "Singapore" singapore []] - ["SX" "SXM" 534 "Sint Maarten" sint-maarten []] + ["SX" "SXM" 534 "Sint Maarten" sint_maarten []] ["SK" "SVK" 703 "Slovakia" slovakia []] ["SI" "SVN" 705 "Slovenia" slovenia []] - ["SB" "SLB" 090 "Solomon Islands" solomon-islands []] + ["SB" "SLB" 090 "Solomon Islands" solomon_islands []] ["SO" "SOM" 706 "Somalia" somalia []] - ["ZA" "ZAF" 710 "South Africa" south-africa []] - ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south-georgia [[south-sandwich-islands]]] - ["SS" "SSD" 728 "South Sudan" south-sudan []] + ["ZA" "ZAF" 710 "South Africa" south_africa []] + ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south_georgia [[south_sandwich_islands]]] + ["SS" "SSD" 728 "South Sudan" south_sudan []] ["ES" "ESP" 724 "Spain" spain []] - ["LK" "LKA" 144 "Sri Lanka" sri-lanka []] + ["LK" "LKA" 144 "Sri Lanka" sri_lanka []] ["SD" "SDN" 729 "Sudan" sudan []] ["SR" "SUR" 740 "Suriname" suriname []] - ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan-mayen]]] + ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan_mayen]]] ["SE" "SWE" 752 "Sweden" sweden []] ["CH" "CHE" 756 "Switzerland" switzerland []] ["SY" "SYR" 760 "Syria" syria []] @@ -263,7 +263,7 @@ ["TJ" "TJK" 762 "Tajikistan" tajikistan []] ["TZ" "TZA" 834 "Tanzania" tanzania []] ["TH" "THA" 764 "Thailand" thailand []] - ["TL" "TLS" 626 "East Timor" east-timor []] + ["TL" "TLS" 626 "East Timor" east_timor []] ["TG" "TGO" 768 "Togo" togo []] ["TK" "TKL" 772 "Tokelau" tokelau []] ["TO" "TON" 776 "Tonga" tonga []] @@ -271,23 +271,23 @@ ["TN" "TUN" 788 "Tunisia" tunisia []] ["TR" "TUR" 792 "Turkey" turkey []] ["TM" "TKM" 795 "Turkmenistan" turkmenistan []] - ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos-islands]]] + ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos_islands]]] ["TV" "TUV" 798 "Tuvalu" tuvalu []] ["UG" "UGA" 800 "Uganda" uganda []] ["UA" "UKR" 804 "Ukraine" ukraine []] - ["AE" "ARE" 784 "United Arab Emirates" united-arab-emirates []] - ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united-kingdom [[northern-ireland]]] - ["US" "USA" 840 "United States of America" united-states-of-america []] - ["UM" "UMI" 581 "United States Minor Outlying Islands" united-states-minor-outlying-islands []] + ["AE" "ARE" 784 "United Arab Emirates" united_arab_emirates []] + ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united_kingdom [[northern_ireland]]] + ["US" "USA" 840 "United States of America" united_states_of_america []] + ["UM" "UMI" 581 "United States Minor Outlying Islands" united_states_minor_outlying_islands []] ["UY" "URY" 858 "Uruguay" uruguay []] ["UZ" "UZB" 860 "Uzbekistan" uzbekistan []] ["VU" "VUT" 548 "Vanuatu" vanuatu []] ["VE" "VEN" 862 "Venezuela" venezuela []] ["VN" "VNM" 704 "Vietnam" vietnam []] - ["VG" "VGB" 092 "British Virgin Islands" british-virgin-islands []] - ["VI" "VIR" 850 "United States Virgin Islands" united-states-virgin-islands []] + ["VG" "VGB" 092 "British Virgin Islands" british_virgin_islands []] + ["VI" "VIR" 850 "United States Virgin Islands" united_states_virgin_islands []] ["WF" "WLF" 876 "Wallis and Futuna" wallis [[futuna]]] - ["EH" "ESH" 732 "Western Sahara" western-sahara []] + ["EH" "ESH" 732 "Western Sahara" western_sahara []] ["YE" "YEM" 887 "Yemen" yemen []] ["ZM" "ZMB" 894 "Zambia" zambia []] ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index f6fa8d331..f20bc1eab 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -57,8 +57,8 @@ (-> Text Code) [location.dummy ( ["" name])])] - [local-identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."] - [local-tag #.Tag "Produces a local tag (a tag with no module prefix)."]) + [local_identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."] + [local_tag #.Tag "Produces a local tag (a tag with no module prefix)."]) (structure: #export equivalence (Equivalence Code) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 84d4e8873..1475bf2b4 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -15,7 +15,7 @@ [collection ["." list ("#\." fold functor)] ["." dictionary]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:) @@ -26,13 +26,13 @@ ["." type]]) (syntax: #export (poly: {export |export|.parser} - {name s.local-identifier} + {name s.local_identifier} body) - (with-gensyms [g!_ g!type g!output] + (with_gensyms [g!_ g!type g!output] (let [g!name (code.identifier ["" name])] (wrap (.list (` ((~! syntax:) (~+ (|export|.write export)) ((~ g!name) {(~ g!type) (~! s.identifier)}) ((~! do) (~! meta.monad) - [(~ g!type) ((~! meta.find-type-def) (~ g!type))] + [(~ g!type) ((~! meta.find_type_def) (~ g!type))] (case (: (.Either .Text .Code) ((~! .run) ((~! p.rec) (function ((~ g!_) (~ g!name)) @@ -44,50 +44,50 @@ (#.Right (~ g!output)) ((~' wrap) (.list (~ g!output)))))))))))) -(def: (common-poly-name? poly-func) +(def: (common_poly_name? poly_func) (-> Text Bit) - (text.contains? "?" poly-func)) + (text.contains? "?" poly_func)) -(def: (derivation-name poly args) +(def: (derivation_name poly args) (-> Text (List Text) (Maybe Text)) - (if (common-poly-name? poly) - (#.Some (list\fold (text.replace-once "?") poly args)) + (if (common_poly_name? poly) + (#.Some (list\fold (text.replace_once "?") poly args)) #.None)) (syntax: #export (derived: {export |export|.parser} - {?name (p.maybe s.local-identifier)} - {[poly-func poly-args] (s.form (p.and s.identifier (p.many s.identifier)))} - {?custom-impl (p.maybe s.any)}) + {?name (p.maybe s.local_identifier)} + {[poly_func poly_args] (s.form (p.and s.identifier (p.many s.identifier)))} + {?custom_impl (p.maybe s.any)}) (do {! meta.monad} - [poly-args (monad.map ! meta.normalize poly-args) + [poly_args (monad.map ! meta.normalize poly_args) name (case ?name (#.Some name) (wrap name) (^multi #.None - [(derivation-name (product.right poly-func) (list\map product.right poly-args)) - (#.Some derived-name)]) - (wrap derived-name) + [(derivation_name (product.right poly_func) (list\map product.right poly_args)) + (#.Some derived_name)]) + (wrap derived_name) _ (p.fail "derived: was given no explicit name, and cannot generate one from given information.")) - #let [impl (case ?custom-impl - (#.Some custom-impl) - custom-impl + #let [impl (case ?custom_impl + (#.Some custom_impl) + custom_impl #.None - (` ((~ (code.identifier poly-func)) (~+ (list\map code.identifier poly-args)))))]] + (` ((~ (code.identifier poly_func)) (~+ (list\map code.identifier poly_args)))))]] (wrap (.list (` (def: (~+ (|export|.write export)) (~ (code.identifier ["" name])) {#.struct? #1} (~ impl))))))) -(def: #export (to-code env type) +(def: #export (to_code env type) (-> Env Type Code) (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (list (~+ (list\map (to-code env) params))))) + (list (~+ (list\map (to_code env) params))))) (^template [] [( idx) @@ -95,35 +95,35 @@ ([#.Var] [#.Ex]) (#.Parameter idx) - (let [idx (.adjusted-idx env idx)] + (let [idx (.adjusted_idx env idx)] (if (n.= 0 idx) - (|> (dictionary.get idx env) maybe.assume product.left (to-code env)) + (|> (dictionary.get idx env) maybe.assume product.left (to_code env)) (` (.$ (~ (code.nat (dec idx))))))) (#.Apply (#.Named ["lux" "Nothing"] _) (#.Parameter idx)) - (let [idx (.adjusted-idx env idx)] + (let [idx (.adjusted_idx env idx)] (if (n.= 0 idx) - (|> (dictionary.get idx env) maybe.assume product.left (to-code env)) + (|> (dictionary.get idx env) maybe.assume product.left (to_code env)) (undefined))) (^template [] [( left right) - (` ( (~ (to-code env left)) - (~ (to-code env right))))]) + (` ( (~ (to_code env left)) + (~ (to_code env right))))]) ([#.Function] [#.Apply]) (^template [ ] [( left right) - (` ( (~+ (list\map (to-code env) ( type)))))]) - ([| #.Sum type.flatten-variant] - [& #.Product type.flatten-tuple]) + (` ( (~+ (list\map (to_code env) ( type)))))]) + ([| #.Sum type.flatten_variant] + [& #.Product type.flatten_tuple]) - (#.Named name sub-type) + (#.Named name sub_type) (code.identifier name) (^template [] [( scope body) - (` ( (list (~+ (list\map (to-code env) scope))) - (~ (to-code env body))))]) + (` ( (list (~+ (list\map (to_code env) scope))) + (~ (to_code env body))))]) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 3c11a2a43..d5506100c 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -16,11 +16,11 @@ ["." frac]] [collection ["." list ("#\." functor)]]] - ["." meta (#+ with-gensyms)]] + ["." meta (#+ with_gensyms)]] [// ["." code]]) -(def: (self-documenting binding parser) +(def: (self_documenting binding parser) (All [a] (-> Code (Parser a) (Parser a))) (function (_ tokens) (case (parser tokens) @@ -29,32 +29,32 @@ (#try.Failure error) (#try.Failure ($_ text\compose - "Failed to parse: " (code.format binding) text.new-line + "Failed to parse: " (code.format binding) text.new_line error))))) -(def: (join-pairs pairs) +(def: (join_pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs #.Nil #.Nil - (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) + (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs')))) (macro: #export (syntax: tokens) {#.doc (doc "A more advanced way to define macros than 'macro:'." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Meta monad, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." - (syntax: #export (object {#let [imports (class-imports *compiler*)]} - {#let [class-vars (list)]} - {super (opt (super-class-decl^ imports class-vars))} - {interfaces (tuple (some (super-class-decl^ imports class-vars)))} - {constructor-args (constructor-args^ imports class-vars)} - {methods (some (overriden-method-def^ imports))}) - (let [def-code ($_ text\compose "anon-class:" - (spaced (list (super-class-decl$ (maybe.default object-super-class super)) - (with-brackets (spaced (list\map super-class-decl$ interfaces))) - (with-brackets (spaced (list\map constructor-arg$ constructor-args))) - (with-brackets (spaced (list\map (method-def$ id) methods))))))] - (wrap (list (` ((~ (code.text def-code)))))))))} + (syntax: #export (object {#let [imports (class_imports *compiler*)]} + {#let [class_vars (list)]} + {super (opt (super_class_decl^ imports class_vars))} + {interfaces (tuple (some (super_class_decl^ imports class_vars)))} + {constructor_args (constructor_args^ imports class_vars)} + {methods (some (overriden_method_def^ imports))}) + (let [def_code ($_ text\compose "anon-class:" + (spaced (list (super_class_decl$ (maybe.default object_super_class super)) + (with_brackets (spaced (list\map super_class_decl$ interfaces))) + (with_brackets (spaced (list\map constructor_arg$ constructor_args))) + (with_brackets (spaced (list\map (method_def$ id) methods))))))] + (wrap (list (` ((~ (code.text def_code)))))))))} (let [[exported? tokens] (: [Bit (List Code)] (case tokens (^ (list& [_ (#.Tag ["" "export"])] tokens')) @@ -69,15 +69,15 @@ (#.Some name args (` {}) body) (^ (list [_ (#.Form (list& [_ (#.Identifier ["" name])] args))] - meta-data + meta_data body)) - (#.Some name args meta-data body) + (#.Some name args meta_data body) _ #.None))] (case ?parts (#.Some [name args meta body]) - (with-gensyms [g!tokens g!body g!error] + (with_gensyms [g!tokens g!body g!error] (do {! meta.monad} [vars+parsers (monad.map ! (: (-> Code (Meta [Code Code])) @@ -90,37 +90,37 @@ _ (wrap [var - (` ((~! ..self-documenting) (' (~ var)) + (` ((~! ..self_documenting) (' (~ var)) (~ parser)))])) - [_ (#.Identifier var-name)] + [_ (#.Identifier var_name)] (wrap [arg - (` ((~! ..self-documenting) (' (~ arg)) + (` ((~! ..self_documenting) (' (~ arg)) (~! .any)))]) _ (meta.fail "Syntax pattern expects records or identifiers.")))) args) - this-module meta.current-module-name + this_module meta.current_module_name #let [g!state (code.identifier ["" "*compiler*"]) - error-msg (code.text (meta.wrong-syntax-error [this-module name])) - export-ast (: (List Code) + error_msg (code.text (meta.wrong_syntax_error [this_module name])) + export_ast (: (List Code) (if exported? (list (' #export)) (list)))]] - (wrap (list (` (macro: (~+ export-ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) + (wrap (list (` (macro: (~+ export_ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) (~ meta) ({(#.Right (~ g!body)) ((~ g!body) (~ g!state)) (#.Left (~ g!error)) - (#.Left ((~! text.join-with) (~! text.new-line) (list (~ error-msg) (~ g!error))))} + (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))} ((~! .run) (: ((~! .Parser) (Meta (List Code))) ((~! do) (~! <>.monad) - [(~+ (..join-pairs vars+parsers))] + [(~+ (..join_pairs vars+parsers))] ((~' wrap) (~ body)))) (~ g!tokens))))))))) _ - (meta.fail (meta.wrong-syntax-error (name-of ..syntax:)))))) + (meta.fail (meta.wrong_syntax_error (name_of ..syntax:)))))) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 2a1469c2d..c29361ee4 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -3,19 +3,19 @@ [lux #*]) (type: #export Declaration - {#declaration-name Text - #declaration-args (List Text)}) + {#declaration_name Text + #declaration_args (List Text)}) (type: #export Annotations (List [Name Code])) -(def: #export empty-annotations +(def: #export empty_annotations Annotations (list)) -(type: #export Typed-Input - {#input-binding Code - #input-type Code}) +(type: #export Typed_Input + {#input_binding Code + #input_type Code}) -(type: #export Type-Var +(type: #export Type_Var Text) diff --git a/stdlib/source/lux/macro/syntax/common/definition.lux b/stdlib/source/lux/macro/syntax/common/definition.lux index 851fd29b1..eca7eac02 100644 --- a/stdlib/source/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/lux/macro/syntax/common/definition.lux @@ -47,21 +47,21 @@ (def: extension "lux def") -(def: (write-tag [module short]) +(def: (write_tag [module short]) (-> Name Code) (` [(~ (code.text module)) (~ (code.text short))])) -(def: (write-annotations value) +(def: (write_annotations value) (-> Annotations Code) (case value #.Nil (` #.Nil) (#.Cons [name value] tail) - (` (#.Cons [(~ (..write-tag name)) + (` (#.Cons [(~ (..write_tag name)) (~ value)] - (~ (write-annotations tail)))))) + (~ (write_annotations tail)))))) (def: dummy Code @@ -72,29 +72,29 @@ (def: #export (write (^slots [#name #value #anns #export?])) (-> Definition Code) (` ((~ (code.text ..extension)) - (~ (code.local-identifier name)) + (~ (code.local_identifier name)) (~ (case value (#.Left check) (//check.write check) (#.Right value) value)) - [(~ ..dummy) (#.Record (~ (..write-annotations anns)))] + [(~ ..dummy) (#.Record (~ (..write_annotations anns)))] (~ (code.bit export?))))) -(def: tag-parser +(def: tag_parser (Parser Name) (.tuple (<>.and .text .text))) -(def: annotations-parser +(def: annotations_parser (Parser Annotations) (<>.rec (function (_ recur) ($_ <>.or - (.tag! (name-of #.Nil)) + (.tag! (name_of #.Nil)) (.form (do <>.monad - [_ (.tag! (name-of #.Cons)) - [head tail] (<>.and (.tuple (<>.and tag-parser .any)) + [_ (.tag! (name_of #.Cons)) + [head tail] (<>.and (.tuple (<>.and tag_parser .any)) recur)] (wrap [head tail]))) )))) @@ -104,26 +104,26 @@ (-> Lux (Parser Definition)) (do {! <>.monad} [raw .any - me-raw (|> raw - meta.expand-all + me_raw (|> raw + meta.expand_all (meta.run compiler) <>.lift)] - (<| (.local me-raw) + (<| (.local me_raw) .form (<>.after (.text! ..extension)) ($_ <>.and - .local-identifier + .local_identifier (<>.or //check.parser .any) (<| .tuple (<>.after .any) .form (<>.after (.this! (` #.Record))) - ..annotations-parser) + ..annotations_parser) .bit )))) -(exception: #export (lacks-type! {definition Definition}) +(exception: #export (lacks_type! {definition Definition}) (exception.report ["Definition" (%.code (..write definition))])) @@ -137,5 +137,5 @@ (wrap []) (#.Right _) - (<>.lift (exception.throw ..lacks-type! [definition])))] + (<>.lift (exception.throw ..lacks_type! [definition])))] (wrap definition))) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 689e166d0..98e1165a5 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -20,25 +20,25 @@ quux (foo bar baz))} (Parser //.Declaration) - (p.either (p.and s.local-identifier + (p.either (p.and s.local_identifier (p\wrap (list))) - (s.form (p.and s.local-identifier - (p.some s.local-identifier))))) + (s.form (p.and s.local_identifier + (p.some s.local_identifier))))) (def: #export annotations {#.doc "Reader for the common annotations syntax used by def: statements."} (Parser //.Annotations) (s.record (p.some (p.and s.tag s.any)))) -(def: (flat-list^ _) +(def: (flat_list^ _) (-> Any (Parser (List Code))) (p.either (do p.monad - [_ (s.tag! (name-of #.Nil))] + [_ (s.tag! (name_of #.Nil))] (wrap (list))) (s.form (do p.monad - [_ (s.tag! (name-of #.Cons)) + [_ (s.tag! (name_of #.Cons)) [head tail] (s.tuple (p.and s.any s.any)) - tail (s.local (list tail) (flat-list^ []))] + tail (s.local (list tail) (flat_list^ []))] (wrap (#.Cons head tail)))))) (template [ ] @@ -48,34 +48,34 @@ (p.after s.any) s.form (do p.monad - [_ (s.tag! (name-of ))] + [_ (s.tag! (name_of ))] )))] - [tuple-meta^ (List Code) #.Tuple (flat-list^ [])] - [text-meta^ Text #.Text s.text] + [tuple_meta^ (List Code) #.Tuple (flat_list^ [])] + [text_meta^ Text #.Text s.text] ) -(def: (find-definition-args meta-data) +(def: (find_definition_args meta_data) (-> (List [Name Code]) (List Text)) (<| (maybe.default (list)) (: (Maybe (List Text))) - (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta-data) + (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta_data) (^multi (#.Some [_ value]) - [(p.run tuple-meta^ (list value)) + [(p.run tuple_meta^ (list value)) (#.Right [_ args])] - [(p.run (p.some text-meta^) args) + [(p.run (p.some text_meta^) args) (#.Right [_ args])]) (#.Some args) _ #.None))) -(def: #export typed-input +(def: #export typed_input {#.doc "Reader for the common typed-argument syntax used by many macros."} - (Parser //.Typed-Input) + (Parser //.Typed_Input) (s.record (p.and s.any s.any))) -(def: #export type-variables +(def: #export type_variables {#.doc "Reader for the common type var/param used by many macros."} (Parser (List Text)) - (p.some s.local-identifier)) + (p.some s.local_identifier)) diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 8c77cffbc..9e946e139 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -13,20 +13,20 @@ (def: #export (declaration declaration) (-> //.Declaration Code) - (` ((~ (code.local-identifier (get@ #//.declaration-name declaration))) - (~+ (list\map code.local-identifier - (get@ #//.declaration-args declaration)))))) + (` ((~ (code.local_identifier (get@ #//.declaration_name declaration))) + (~+ (list\map code.local_identifier + (get@ #//.declaration_args declaration)))))) (def: #export annotations (-> //.Annotations Code) (|>> (list\map (product.both code.tag function.identity)) code.record)) -(def: #export (typed-input value) - (-> //.Typed-Input Code) - (code.record (list [(get@ #//.input-binding value) - (get@ #//.input-type value)]))) +(def: #export (typed_input value) + (-> //.Typed_Input Code) + (code.record (list [(get@ #//.input_binding value) + (get@ #//.input_type value)]))) -(def: #export type-variables - (-> (List //.Type-Var) (List Code)) - (list\map code.local-identifier)) +(def: #export type_variables + (-> (List //.Type_Var) (List Code)) + (list\map code.local_identifier)) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 12b3d9261..c250a3456 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -26,42 +26,42 @@ (syntax: #export (count {parts (.tuple (<>.some .any))}) (wrap (list (code.nat (list.size parts))))) -(syntax: #export (with-locals {locals (.tuple (<>.some .local-identifier))} +(syntax: #export (with_locals {locals (.tuple (<>.some .local_identifier))} body) (do {! meta.monad} [g!locals (|> locals (list\map meta.gensym) (monad.seq !))] - (wrap (list (` (.with-expansions [(~+ (|> (list.zip/2 locals g!locals) + (wrap (list (` (.with_expansions [(~+ (|> (list.zip/2 locals g!locals) (list\map (function (_ [name identifier]) - (list (code.local-identifier name) (as-is identifier)))) + (list (code.local_identifier name) (as_is identifier)))) list\join))] (~ body))))))) -(def: (name-side module-side? parser) +(def: (name_side module_side? parser) (-> Bit (Parser Name) (Parser Text)) (do <>.monad [[module short] parser] - (wrap (if module-side? + (wrap (if module_side? (case module "" short _ module) short)))) -(def: (snippet module-side?) +(def: (snippet module_side?) (-> Bit (Parser Text)) - (let [full-identifier (..name-side module-side? .identifier) - full-tag (..name-side module-side? .tag)] + (let [full_identifier (..name_side module_side? .identifier) + full_tag (..name_side module_side? .tag)] ($_ <>.either .text - (if module-side? - full-identifier - (<>.either .local-identifier - full-identifier)) - (if module-side? - full-tag - (<>.either .local-tag - full-tag)) + (if module_side? + full_identifier + (<>.either .local_identifier + full_identifier)) + (if module_side? + full_tag + (<>.either .local_tag + full_tag)) (<>\map bit\encode .bit) (<>\map nat\encode .nat) (<>\map int\encode .int) @@ -69,24 +69,24 @@ (<>\map frac\encode .frac) ))) -(def: (part module-side?) +(def: (part module_side?) (-> Bit (Parser (List Text))) - (.tuple (<>.many (..snippet module-side?)))) + (.tuple (<>.many (..snippet module_side?)))) (syntax: #export (text {simple (..part false)}) - (wrap (list (|> simple (text.join-with "") code.text)))) + (wrap (list (|> simple (text.join_with "") code.text)))) (template [ ] [(syntax: #export ( {name (<>.or (<>.and (..part true) (..part false)) (..part false))}) (case name (#.Left [simple complex]) - (wrap (list ( [(text.join-with "" simple) - (text.join-with "" complex)]))) + (wrap (list ( [(text.join_with "" simple) + (text.join_with "" complex)]))) (#.Right simple) - (wrap (list (|> simple (text.join-with "") )))))] + (wrap (list (|> simple (text.join_with "") )))))] - [identifier code.local-identifier code.identifier] - [tag code.local-tag code.tag] + [identifier code.local_identifier code.identifier] + [tag code.local_tag code.tag] ) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 51b9300e9..fac508ca5 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -17,7 +17,7 @@ ) (for {@.old - (as-is (template [ ] + (as_is (template [ ] [(def: #export ( input) (-> Frac Frac) ( input))] @@ -41,7 +41,7 @@ ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) @.jvm - (as-is (template: (!double value) (|> value (:coerce (primitive "java.lang.Double")) "jvm object cast")) + (as_is (template: (!double value) (|> value (:coerce (primitive "java.lang.Double")) "jvm object cast")) (template: (!frac value) (|> value "jvm object cast" (: (primitive "java.lang.Double")) (:coerce Frac))) (template [ ] [(def: #export @@ -75,7 +75,7 @@ !frac))) @.js - (as-is (template [ ] + (as_is (template [ ] [(def: #export (-> Frac Frac) (|>> ("js apply" ("js constant" )) (:coerce Frac)))] diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux index 9e9445538..bd8629525 100644 --- a/stdlib/source/lux/math/infix.lux +++ b/stdlib/source/lux/math/infix.lux @@ -40,29 +40,29 @@ (.tuple ($_ <>.either (do <>.monad [_ (.this! (' #and)) - init-subject infix^ - init-op .any - init-param infix^ + init_subject infix^ + init_op .any + init_param infix^ steps (<>.some (<>.and .any infix^))] (wrap (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]]) [param [(#Binary _subject _op _param) (` and) (#Binary subject op param)]]) - [init-param [init-subject init-op init-param]] + [init_param [init_subject init_op init_param]] steps)))) (do <>.monad - [init-subject infix^ - init-op .any - init-param infix^ + [init_subject infix^ + init_op .any + init_param infix^ steps (<>.some (<>.and .any infix^))] (wrap (list\fold (function (_ [op param] [_subject _op _param]) [(#Binary _subject _op _param) op param]) - [init-subject init-op init-param] + [init_subject init_op init_param] steps))) )) ))) -(def: (to-prefix infix) +(def: (to_prefix infix) (-> Infix Code) (case infix (#Const value) @@ -72,10 +72,10 @@ (code.form parts) (#Unary op subject) - (` ((~ op) (~ (to-prefix subject)))) + (` ((~ op) (~ (to_prefix subject)))) (#Binary left op right) - (` ((~ op) (~ (to-prefix right)) (~ (to-prefix left)))) + (` ((~ op) (~ (to_prefix right)) (~ (to_prefix left)))) )) (syntax: #export (infix {expr infix^}) @@ -91,4 +91,4 @@ "If you want your binary function to work well with it." "Then take the argument to the right (y) as your first argument," "and take the argument to the left (x) as your second argument.")} - (wrap (list (..to-prefix expr)))) + (wrap (list (..to_prefix expr)))) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 59343163e..780fe9898 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -41,16 +41,16 @@ (&.and (membership elem base) (&.not (membership elem sub))))) -(def: #export (from-predicate predicate) +(def: #export (from_predicate predicate) (All [a] (-> (Predicate a) (Fuzzy a))) (function (_ elem) (if (predicate elem) &.true &.false))) -(def: #export (from-set set) +(def: #export (from_set set) (All [a] (-> (Set a) (Fuzzy a))) - (from-predicate (set.member? set))) + (from_predicate (set.member? set))) (def: (ascending from to) (-> Rev Rev (Fuzzy Rev)) @@ -94,12 +94,12 @@ _ (undefined))) -(def: #export (trapezoid bottom middle-bottom middle-top top) +(def: #export (trapezoid bottom middle_bottom middle_top top) (-> Rev Rev Rev Rev (Fuzzy Rev)) - (case (list.sort r.< (list bottom middle-bottom middle-top top)) - (^ (list bottom middle-bottom middle-top top)) - (intersection (ascending bottom middle-bottom) - (descending middle-top top)) + (case (list.sort r.< (list bottom middle_bottom middle_top top)) + (^ (list bottom middle_bottom middle_top top)) + (intersection (ascending bottom middle_bottom) + (descending middle_top top)) _ (undefined))) @@ -112,7 +112,7 @@ (|> membership (r.- treshold) (r.* &.true)) &.false)))) -(def: #export (to-predicate treshold set) +(def: #export (to_predicate treshold set) (All [a] (-> Rev (Fuzzy a) (Predicate a))) (function (_ elem) (r.> treshold (set elem)))) @@ -120,11 +120,11 @@ (type: #export (Fuzzy2 a) (-> a [Rev Rev])) -(def: #export (type-2 lower upper) +(def: #export (type_2 lower upper) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy2 a))) (function (_ elem) - (let [l-rev (lower elem) - u-rev (upper elem)] - [(r.min l-rev - u-rev) - u-rev]))) + (let [l_rev (lower elem) + u_rev (upper elem)] + [(r.min l_rev + u_rev) + u_rev]))) diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index 71e3a57a1..a5777768c 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -34,11 +34,11 @@ (:abstraction {#modulus modulus #remainder (i.mod (/.divisor modulus) value)})) - (def: #export un-modular + (def: #export un_modular (All [m] (-> (Mod m) [(Modulus m) Int])) (|>> :representation)) - (exception: #export [m] (incorrect-modulus {modulus (Modulus m)} + (exception: #export [m] (incorrect_modulus {modulus (Modulus m)} {parsed Int}) (exception.report ["Expected" (i\encode (/.divisor modulus))] @@ -50,7 +50,7 @@ (def: intL (Parser Int) (<>.codec i.decimal - (.and (.one-of "-+") (.many .decimal)))) + (.and (.one_of "-+") (.many .decimal)))) (structure: #export (codec expected) (All [m] (-> (Modulus m) (Codec Text (Mod m)))) @@ -65,11 +65,11 @@ (def: decode (.run (do <>.monad [[remainder _ actual] ($_ <>.and intL (.this ..separator) intL) - _ (<>.assert (exception.construct ..incorrect-modulus [expected actual]) + _ (<>.assert (exception.construct ..incorrect_modulus [expected actual]) (i.= (/.divisor expected) actual))] (wrap (..modular expected remainder)))))) - (exception: #export [rm sm] (unequal-moduli {reference (Modulus rm)} + (exception: #export [rm sm] (unequal_moduli {reference (Modulus rm)} {subject (Modulus sm)}) (exception.report ["Reference" (i\encode (/.divisor reference))] @@ -77,13 +77,13 @@ (def: #export (equalize reference subject) (All [r s] (-> (Mod r) (Mod s) (Try (Mod r)))) - (let [[reference-modulus reference] (:representation reference) - [subject-modulus subject] (:representation subject)] - (if (i.= (/.divisor reference-modulus) - (/.divisor subject-modulus)) - (#try.Success (:abstraction {#modulus reference-modulus + (let [[reference_modulus reference] (:representation reference) + [subject_modulus subject] (:representation subject)] + (if (i.= (/.divisor reference_modulus) + (/.divisor subject_modulus)) + (#try.Success (:abstraction {#modulus reference_modulus #remainder subject})) - (exception.throw ..unequal-moduli [reference-modulus subject-modulus])))) + (exception.throw ..unequal_moduli [reference_modulus subject_modulus])))) (template [ ] [(def: #export ( reference subject) @@ -140,8 +140,8 @@ (All [m] (-> (Mod m) (Maybe (Mod m)))) (let [[modulus value] (:representation modular) [vk mk gcd] (gcd+ value (/.divisor modulus)) - co-prime? (i.= +1 gcd)] - (if co-prime? + co_prime? (i.= +1 gcd)] + (if co_prime? (#.Some (..modular modulus vk)) #.None))) ) diff --git a/stdlib/source/lux/math/modulus.lux b/stdlib/source/lux/math/modulus.lux index d3bb9f6f6..6b38d96ff 100644 --- a/stdlib/source/lux/math/modulus.lux +++ b/stdlib/source/lux/math/modulus.lux @@ -17,7 +17,7 @@ [syntax (#+ syntax:)] ["." code]]]) -(exception: #export zero-cannot-be-a-modulus) +(exception: #export zero_cannot_be_a_modulus) (abstract: #export (Modulus m) Int @@ -28,7 +28,7 @@ (def: #export (modulus value) (Ex [m] (-> Int (Try (Modulus m)))) (if (i.= +0 value) - (exception.throw ..zero-cannot-be-a-modulus []) + (exception.throw ..zero_cannot_be_a_modulus []) (#try.Success (:abstraction value)))) (def: #export divisor diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index aa13297c4..cc0cc1def 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -123,7 +123,7 @@ (let [[prng left] (prng []) [prng right] (prng [])] [prng (|> left - (i64.left-shift 32) + (i64.left_shift 32) ("lux i64 +" right))]))) (template [ ] @@ -138,36 +138,36 @@ (def: #export frac (Random Frac) - (\ ..monad map (|>> .i64 f.from-bits) ..nat)) + (\ ..monad map (|>> .i64 f.from_bits) ..nat)) -(def: #export safe-frac +(def: #export safe_frac (Random Frac) - (let [mantissa-range (.int (i64.left-shift 53 1)) - mantissa-max (i.frac (dec mantissa-range))] + (let [mantissa_range (.int (i64.left_shift 53 1)) + mantissa_max (i.frac (dec mantissa_range))] (\ ..monad map - (|>> (i.% mantissa-range) + (|>> (i.% mantissa_range) i.frac - (f./ mantissa-max)) + (f./ mantissa_max)) ..int))) (def: #export (char set) (-> unicode.Set (Random Char)) (let [[start end] (unicode.range set) size (n.- start end) - in-range (: (-> Char Char) + in_range (: (-> Char Char) (|>> (n.% size) (n.+ start)))] (|> ..nat - (\ ..monad map in-range) + (\ ..monad map in_range) (..filter (unicode.member? set))))) -(def: #export (text char-gen size) +(def: #export (text char_gen size) (-> (Random Char) Nat (Random Text)) (if (n.= 0 size) (\ ..monad wrap "") (do ..monad - [x char-gen - xs (text char-gen (dec size))] - (wrap (text\compose (text.from-code x) xs))))) + [x char_gen + xs (text char_gen (dec size))] + (wrap (text\compose (text.from_code x) xs))))) (template [ ] [(def: #export @@ -177,9 +177,9 @@ [unicode unicode.character] [ascii unicode.ascii] [ascii/alpha unicode.ascii/alpha] - [ascii/alpha-num unicode.ascii/alpha-num] - [ascii/upper-alpha unicode.ascii/upper-alpha] - [ascii/lower-alpha unicode.ascii/lower-alpha] + [ascii/alpha_num unicode.ascii/alpha_num] + [ascii/upper_alpha unicode.ascii/upper_alpha] + [ascii/lower_alpha unicode.ascii/lower_alpha] ) (template [ ] @@ -191,7 +191,7 @@ (wrap ( left right))))] [ratio r.Ratio r.ratio ..nat] - [complex c.Complex c.complex ..safe-frac] + [complex c.Complex c.complex ..safe_frac] ) (def: #export (and left right) @@ -231,23 +231,23 @@ (let [gen' (gen (rec gen))] (gen' state)))) -(def: #export (maybe value-gen) +(def: #export (maybe value_gen) (All [a] (-> (Random a) (Random (Maybe a)))) (do {! ..monad} [some? bit] (if some? (do ! - [value value-gen] + [value value_gen] (wrap (#.Some value))) (wrap #.None)))) (template [ ] - [(def: #export ( size value-gen) + [(def: #export ( size value_gen) (All [a] (-> Nat (Random a) (Random ( a)))) (if (n.> 0 size) (do ..monad - [x value-gen - xs ( (dec size) value-gen)] + [x value_gen + xs ( (dec size) value_gen)] (wrap ( x xs))) (\ ..monad wrap )))] @@ -256,40 +256,40 @@ ) (template [ ] - [(def: #export ( size value-gen) + [(def: #export ( size value_gen) (All [a] (-> Nat (Random a) (Random ( a)))) (do ..monad - [values (list size value-gen)] + [values (list size value_gen)] (wrap (|> values ))))] - [array Array array.from-list] - [queue Queue queue.from-list] + [array Array array.from_list] + [queue Queue queue.from_list] [stack Stack (list\fold stack.push stack.empty)] ) -(def: #export (set Hash size value-gen) +(def: #export (set Hash size value_gen) (All [a] (-> (Hash a) Nat (Random a) (Random (Set a)))) (if (n.> 0 size) (do {! ..monad} - [xs (set Hash (dec size) value-gen)] + [xs (set Hash (dec size) value_gen)] (loop [_ []] (do ! - [x value-gen + [x value_gen #let [xs+ (set.add x xs)]] (if (n.= size (set.size xs+)) (wrap xs+) (recur []))))) (\ ..monad wrap (set.new Hash)))) -(def: #export (dictionary Hash size key-gen value-gen) +(def: #export (dictionary Hash size key_gen value_gen) (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v)))) (if (n.> 0 size) (do {! ..monad} - [kv (dictionary Hash (dec size) key-gen value-gen)] + [kv (dictionary Hash (dec size) key_gen value_gen)] (loop [_ []] (do ! - [k key-gen - v value-gen + [k key_gen + v value_gen #let [kv+ (dictionary.put k v kv)]] (if (n.= size (dictionary.size kv+)) (wrap kv+) @@ -298,7 +298,7 @@ (def: #export instant (Random Instant) - (\ ..monad map instant.from-millis ..int)) + (\ ..monad map instant.from_millis ..int)) (def: #export date (Random Date) @@ -306,7 +306,7 @@ (def: #export duration (Random Duration) - (\ ..monad map duration.from-millis ..int)) + (\ ..monad map duration.from_millis ..int)) (def: #export month (Random Month) @@ -346,42 +346,42 @@ [(recur (update state)) (return state)]))) -(def: #export (pcg-32 [increase seed]) +(def: #export (pcg_32 [increase seed]) {#.doc (doc "An implementation of the PCG32 algorithm." "For more information, please see: http://www.pcg-random.org/")} (-> [(I64 Any) (I64 Any)] PRNG) (let [magic 6364136223846793005] (function (_ _) - [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg-32) - (let [rot (|> seed .i64 (i64.logic-right-shift 59))] + [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg_32) + (let [rot (|> seed .i64 (i64.logic_right_shift 59))] (|> seed - (i64.logic-right-shift 18) + (i64.logic_right_shift 18) (i64.xor seed) - (i64.logic-right-shift 27) - (i64.rotate-right rot) + (i64.logic_right_shift 27) + (i64.rotate_right rot) .i64))]))) -(def: #export (xoroshiro-128+ [s0 s1]) +(def: #export (xoroshiro_128+ [s0 s1]) {#.doc (doc "An implementation of the Xoroshiro128+ algorithm." "For more information, please see: http://xoroshiro.di.unimi.it/")} (-> [(I64 Any) (I64 Any)] PRNG) (function (_ _) [(let [s01 (i64.xor s0 s1)] - (xoroshiro-128+ [(|> s0 - (i64.rotate-left 55) + (xoroshiro_128+ [(|> s0 + (i64.rotate_left 55) (i64.xor s01) - (i64.xor (i64.left-shift 14 s01))) - (i64.rotate-left 36 s01)])) + (i64.xor (i64.left_shift 14 s01))) + (i64.rotate_left 36 s01)])) ("lux i64 +" s0 s1)])) ## https://en.wikipedia.org/wiki/Xorshift#Initialization ## http://xorshift.di.unimi.it/splitmix64.c -(def: #export split-mix-64 +(def: #export split_mix_64 {#.doc (doc "An implementation of the SplitMix64 algorithm.")} (-> Nat PRNG) (let [twist (: (-> Nat Nat Nat) (function (_ shift value) - (i64.xor (i64.logic-right-shift shift value) value))) + (i64.xor (i64.logic_right_shift shift value) value))) mix n.*] (..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15")) (|>> (twist 30) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 8becc186c..95f64650d 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -124,7 +124,7 @@ (function (_ _) (#try.Failure msg))) -(def: #export (find-module name) +(def: #export (find_module name) (-> Text (Meta Module)) (function (_ compiler) (case (get name (get@ #.modules compiler)) @@ -134,23 +134,23 @@ _ (#try.Failure ($_ text\compose "Unknown module: " name))))) -(def: #export current-module-name +(def: #export current_module_name (Meta Text) (function (_ compiler) - (case (get@ #.current-module compiler) - (#.Some current-module) - (#try.Success [compiler current-module]) + (case (get@ #.current_module compiler) + (#.Some current_module) + (#try.Success [compiler current_module]) _ (#try.Failure "No current module.")))) -(def: #export current-module +(def: #export current_module (Meta Module) (do ..monad - [this-module-name current-module-name] - (find-module this-module-name))) + [this_module_name current_module_name] + (find_module this_module_name))) -(def: (macro-type? type) +(def: (macro_type? type) (-> Type Bit) (case type (#.Named ["lux" "Macro"] (#.Primitive "#Macro" #.Nil)) @@ -166,13 +166,13 @@ (case name ["" name] (do ..monad - [module-name current-module-name] - (wrap [module-name name])) + [module_name current_module_name] + (wrap [module_name name])) _ (\ ..monad wrap name))) -(def: (find-macro' modules this-module module name) +(def: (find_macro' modules this_module module name) (-> (List [Text Module]) Text Text Text (Maybe Macro)) (do maybe.monad @@ -182,36 +182,36 @@ (get@ #.definitions) (get name)))] (case definition - (#.Left [r-module r-name]) - (find-macro' modules this-module r-module r-name) + (#.Left [r_module r_name]) + (find_macro' modules this_module r_module r_name) - (#.Right [exported? def-type def-anns def-value]) - (if (macro-type? def-type) - (#.Some (:coerce Macro def-value)) + (#.Right [exported? def_type def_anns def_value]) + (if (macro_type? def_type) + (#.Some (:coerce Macro def_value)) #.None)))) -(def: #export (find-macro full-name) +(def: #export (find_macro full_name) (-> Name (Meta (Maybe Macro))) (do ..monad - [[module name] (normalize full-name)] + [[module name] (normalize full_name)] (: (Meta (Maybe Macro)) (function (_ compiler) - (let [macro (case (..current-module-name compiler) + (let [macro (case (..current_module_name compiler) (#try.Failure error) #.None - (#try.Success [_ this-module]) - (find-macro' (get@ #.modules compiler) this-module module name))] + (#try.Success [_ this_module]) + (find_macro' (get@ #.modules compiler) this_module module name))] (#try.Success [compiler macro])))))) -(def: #export (expand-once syntax) +(def: #export (expand_once syntax) {#.doc (doc "Given code that requires applying a macro, does it once and returns the result." "Otherwise, returns the code as-is.")} (-> Code (Meta (List Code))) (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do ..monad - [?macro (find-macro name)] + [?macro (find_macro name)] (case ?macro (#.Some macro) ((:coerce Macro' macro) args) @@ -229,7 +229,7 @@ (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do ..monad - [?macro (find-macro name)] + [?macro (find_macro name)] (case ?macro (#.Some macro) (do ..monad @@ -243,34 +243,34 @@ _ (\ ..monad wrap (list syntax)))) -(def: #export (expand-all syntax) +(def: #export (expand_all syntax) {#.doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} (-> Code (Meta (List Code))) (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do ..monad - [?macro (find-macro name)] + [?macro (find_macro name)] (case ?macro (#.Some macro) (do ..monad [expansion ((:coerce Macro' macro) args) - expansion' (monad.map ..monad expand-all expansion)] + expansion' (monad.map ..monad expand_all expansion)] (wrap (list\join expansion'))) #.None (do ..monad - [parts' (monad.map ..monad expand-all (list& (code.identifier name) args))] + [parts' (monad.map ..monad expand_all (list& (code.identifier name) args))] (wrap (list (code.form (list\join parts'))))))) [_ (#.Form (#.Cons [harg targs]))] (do ..monad - [harg+ (expand-all harg) - targs+ (monad.map ..monad expand-all targs)] + [harg+ (expand_all harg) + targs+ (monad.map ..monad expand_all targs)] (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+))))))) [_ (#.Tuple members)] (do ..monad - [members' (monad.map ..monad expand-all members)] + [members' (monad.map ..monad expand_all members)] (wrap (list (code.tuple (list\join members'))))) _ @@ -293,7 +293,7 @@ ($_ text\compose "__gensym__" prefix) [""] code.identifier)))) -(def: (get-local-identifier ast) +(def: (get_local_identifier ast) (-> Code (Meta Text)) (case ast [_ (#.Identifier [_ name])] @@ -302,15 +302,15 @@ _ (fail (text\compose "Code is not a local identifier: " (code.format ast))))) -(def: #export wrong-syntax-error +(def: #export wrong_syntax_error (-> Name Text) (|>> name\encode (text\compose "Wrong syntax for "))) -(macro: #export (with-gensyms tokens) +(macro: #export (with_gensyms tokens) {#.doc (doc "Creates new identifiers and offers them to the body expression." (syntax: #export (synchronized lock body) - (with-gensyms [g!lock g!body g!_] + (with_gensyms [g!lock g!body g!_] (wrap (list (` (let [(~ g!lock) (~ lock) (~ g!_) ("jvm monitorenter" (~ g!lock)) (~ g!body) (~ body) @@ -320,18 +320,18 @@ (case tokens (^ (list [_ (#.Tuple identifiers)] body)) (do {! ..monad} - [identifier-names (monad.map ! get-local-identifier identifiers) - #let [identifier-defs (list\join (list\map (: (-> Text (List Code)) + [identifier_names (monad.map ! get_local_identifier identifiers) + #let [identifier_defs (list\join (list\map (: (-> Text (List Code)) (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) - identifier-names))]] + identifier_names))]] (wrap (list (` ((~! do) (~! ..monad) - [(~+ identifier-defs)] + [(~+ identifier_defs)] (~ body)))))) _ - (fail (..wrong-syntax-error (name-of ..with-gensyms))))) + (fail (..wrong_syntax_error (name_of ..with_gensyms))))) -(def: #export (expand-1 token) +(def: #export (expand_1 token) {#.doc "Works just like expand, except that it ensures that the output is a single Code token."} (-> Code (Meta Code)) (do ..monad @@ -343,7 +343,7 @@ _ (fail "Macro expanded to more than 1 element.")))) -(def: #export (module-exists? module) +(def: #export (module_exists? module) (-> Text (Meta Bit)) (function (_ compiler) (#try.Success [compiler (case (get module (get@ #.modules compiler)) @@ -353,14 +353,14 @@ #.None #0)]))) -(def: (try-both f x1 x2) +(def: (try_both f x1 x2) (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) #.None (f x2) (#.Some y) (#.Some y))) -(def: (find-type-var idx bindings) +(def: (find_type_var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #.Nil @@ -369,16 +369,16 @@ (#.Cons [var bound] bindings') (if (n.= idx var) bound - (find-type-var idx bindings')))) + (find_type_var idx bindings')))) -(def: (clean-type type) +(def: (clean_type type) (-> Type (Meta Type)) (case type (#.Var var) (function (_ compiler) (case (|> compiler - (get@ [#.type-context #.var-bindings]) - (find-type-var var)) + (get@ [#.type_context #.var_bindings]) + (find_type_var var)) (^or #.None (#.Some (#.Var _))) (#try.Success [compiler type]) @@ -388,7 +388,7 @@ _ (\ ..monad wrap type))) -(def: #export (find-var-type name) +(def: #export (find_var_type name) {#.doc "Looks-up the type of a local variable somewhere in the environment."} (-> Text (Meta Type)) (function (_ compiler) @@ -401,19 +401,19 @@ (list.any? test (: (List [Text [Type Any]]) (get@ [#.captured #.mappings] env))))) (get@ #.scopes compiler)) - [_ [type _]] (try-both (list.find test) + [_ [type _]] (try_both (list.find test) (: (List [Text [Type Any]]) (get@ [#.locals #.mappings] scope)) (: (List [Text [Type Any]]) (get@ [#.captured #.mappings] scope)))] (wrap type)) - (#.Some var-type) - ((clean-type var-type) compiler) + (#.Some var_type) + ((clean_type var_type) compiler) #.None (#try.Failure ($_ text\compose "Unknown variable: " name)))))) -(def: #export (find-def name) +(def: #export (find_def name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Name (Meta Global)) (do ..monad @@ -421,81 +421,81 @@ (function (_ compiler) (case (: (Maybe Global) (do maybe.monad - [#let [[v-prefix v-name] name] - (^slots [#.definitions]) (get v-prefix (get@ #.modules compiler))] - (get v-name definitions))) + [#let [[v_prefix v_name] name] + (^slots [#.definitions]) (get v_prefix (get@ #.modules compiler))] + (get v_name definitions))) (#.Some definition) (#try.Success [compiler definition]) _ - (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???")) - separator ($_ text\compose text.new-line " ")] + (let [current_module (|> compiler (get@ #.current_module) (maybe.default "???")) + separator ($_ text\compose text.new_line " ")] (#try.Failure ($_ text\compose - "Unknown definition: " (name\encode name) text.new-line - " Current module: " current-module text.new-line - (case (get current-module (get@ #.modules compiler)) - (#.Some this-module) + "Unknown definition: " (name\encode name) text.new_line + " Current module: " current_module text.new_line + (case (get current_module (get@ #.modules compiler)) + (#.Some this_module) ($_ text\compose - " Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line - " Aliases: " (|> this-module (get@ #.module-aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (text.join-with separator)) text.new-line) + " Imports: " (|> this_module (get@ #.imports) (text.join_with separator)) text.new_line + " Aliases: " (|> this_module (get@ #.module_aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (text.join_with separator)) text.new_line) _ "") - " All Known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join-with separator)) text.new-line))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join_with separator)) text.new_line))))))) -(def: #export (find-export name) +(def: #export (find_export name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Definition)) (do ..monad - [definition (..find-def name)] + [definition (..find_def name)] (case definition - (#.Left de-aliased) + (#.Left de_aliased) (fail ($_ text\compose "Aliases are not considered exports: " (name\encode name))) (#.Right definition) - (let [[exported? def-type def-data def-value] definition] + (let [[exported? def_type def_data def_value] definition] (if exported? (wrap definition) (fail ($_ text\compose "Definition is not an export: " (name\encode name)))))))) -(def: #export (find-def-type name) +(def: #export (find_def_type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Type)) (do ..monad - [definition (find-def name)] + [definition (find_def name)] (case definition - (#.Left de-aliased) - (find-def-type de-aliased) + (#.Left de_aliased) + (find_def_type de_aliased) - (#.Right [exported? def-type def-data def-value]) - (clean-type def-type)))) + (#.Right [exported? def_type def_data def_value]) + (clean_type def_type)))) -(def: #export (find-type name) +(def: #export (find_type name) {#.doc "Looks-up the type of either a local variable or a definition."} (-> Name (Meta Type)) (do ..monad [#let [[_ _name] name]] (case name ["" _name] - (either (find-var-type _name) - (find-def-type name)) + (either (find_var_type _name) + (find_def_type name)) _ - (find-def-type name)))) + (find_def_type name)))) -(def: #export (find-type-def name) +(def: #export (find_type_def name) {#.doc "Finds the value of a type definition (such as Int, Any or Lux)."} (-> Name (Meta Type)) (do ..monad - [definition (find-def name)] + [definition (find_def name)] (case definition - (#.Left de-aliased) - (find-type-def de-aliased) + (#.Left de_aliased) + (find_type_def de_aliased) - (#.Right [exported? def-type def-data def-value]) - (wrap (:coerce Type def-value))))) + (#.Right [exported? def_type def_data def_value]) + (wrap (:coerce Type def_value))))) (def: #export (globals module) {#.doc "The entire list of globals in a module (including the non-exported/private ones)."} @@ -514,22 +514,22 @@ (\ ..monad map (list.all (function (_ [name global]) (case global - (#.Left de-aliased) + (#.Left de_aliased) #.None (#.Right definition) (#.Some [name definition])))) (..globals module))) -(def: #export (exports module-name) +(def: #export (exports module_name) {#.doc "All the exported definitions in a module."} (-> Text (Meta (List [Text Definition]))) (do ..monad - [constants (..definitions module-name)] + [constants (..definitions module_name)] (wrap (do list.monad - [[name [exported? def-type def-data def-value]] constants] + [[name [exported? def_type def_data def_value]] constants] (if exported? - (wrap [name [exported? def-type def-data def-value]]) + (wrap [name [exported? def_type def_data def_value]]) (list)))))) (def: #export modules @@ -541,12 +541,12 @@ [compiler] #try.Success))) -(def: #export (tags-of type-name) +(def: #export (tags_of type_name) {#.doc "All the tags associated with a type definition."} (-> Name (Meta (Maybe (List Name)))) (do ..monad - [#let [[module name] type-name] - module (find-module module)] + [#let [[module name] type_name] + module (find_module module)] (case (get name (get@ #.types module)) (#.Some [tags _]) (wrap (#.Some tags)) @@ -560,7 +560,7 @@ (function (_ compiler) (#try.Success [compiler (get@ #.location compiler)]))) -(def: #export expected-type +(def: #export expected_type {#.doc "The expected type of the current expression being analyzed."} (Meta Type) (function (_ compiler) @@ -571,62 +571,62 @@ #.None (#try.Failure "Not expecting any type.")))) -(def: #export (imported-modules module-name) +(def: #export (imported_modules module_name) {#.doc "All the modules imported by a specified module."} (-> Text (Meta (List Text))) (do ..monad - [(^slots [#.imports]) (..find-module module-name)] + [(^slots [#.imports]) (..find_module module_name)] (wrap imports))) -(def: #export (imported-by? import module) +(def: #export (imported_by? import module) (-> Text Text (Meta Bit)) (do ..monad - [(^slots [#.imports]) (..find-module module)] + [(^slots [#.imports]) (..find_module module)] (wrap (list.any? (text\= import) imports)))) (def: #export (imported? import) (-> Text (Meta Bit)) (let [(^open ".") ..monad] - (|> ..current-module-name - (map ..find-module) join + (|> ..current_module_name + (map ..find_module) join (map (|>> (get@ #.imports) (list.any? (text\= import))))))) -(def: #export (resolve-tag tag) +(def: #export (resolve_tag tag) {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} (-> Name (Meta [Nat (List Name) Type])) (do ..monad [#let [[module name] tag] - =module (..find-module module) - this-module-name ..current-module-name + =module (..find_module module) + this_module_name ..current_module_name imported! (..imported? module)] (case (get name (get@ #.tags =module)) - (#.Some [idx tag-list exported? type]) - (if (or (text\= this-module-name module) + (#.Some [idx tag_list exported? type]) + (if (or (text\= this_module_name module) (and imported! exported?)) - (wrap [idx tag-list type]) - (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this-module-name))) + (wrap [idx tag_list type]) + (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name))) _ (..fail ($_ text\compose - "Unknown tag: " (name\encode tag) text.new-line + "Unknown tag: " (name\encode tag) text.new_line " Known tags: " (|> =module (get@ #.tags) - (list\map (|>> product.left [module] name\encode (text.prefix text.new-line))) - (text.join-with "")) + (list\map (|>> product.left [module] name\encode (text.prefix text.new_line))) + (text.join_with "")) ))))) -(def: #export (tag-lists module) +(def: #export (tag_lists module) {#.doc "All the tag-lists defined in a module, with their associated types."} (-> Text (Meta (List [(List Name) Type]))) (do ..monad - [=module (..find-module module) - this-module-name ..current-module-name] + [=module (..find_module module) + this_module_name ..current_module_name] (wrap (|> (get@ #.types =module) - (list.filter (function (_ [type-name [tag-list exported? type]]) + (list.filter (function (_ [type_name [tag_list exported? type]]) (or exported? - (text\= this-module-name module)))) - (list\map (function (_ [type-name [tag-list exported? type]]) - [tag-list type])))))) + (text\= this_module_name module)))) + (list\map (function (_ [type_name [tag_list exported? type]]) + [tag_list type])))))) (def: #export locals {#.doc "All the local variables currently in scope, separated in different scopes."} @@ -643,28 +643,28 @@ [name type]))) scopes)])))) -(def: #export (un-alias def-name) +(def: #export (un_alias def_name) {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Name (Meta Name)) (do ..monad - [constant (..find-def def-name)] + [constant (..find_def def_name)] (wrap (case constant - (#.Left real-def-name) - real-def-name + (#.Left real_def_name) + real_def_name (#.Right _) - def-name)))) + def_name)))) -(def: #export get-compiler +(def: #export get_compiler {#.doc "Obtains the current state of the compiler."} (Meta Lux) (function (_ compiler) (#try.Success [compiler compiler]))) -(def: #export type-context - (Meta Type-Context) +(def: #export type_context + (Meta Type_Context) (function (_ compiler) - (#try.Success [compiler (get@ #.type-context compiler)]))) + (#try.Success [compiler (get@ #.type_context compiler)]))) (template [ ] [(macro: #export ( tokens) @@ -690,7 +690,7 @@ (do ..monad [location ..location output ( token) - #let [_ (log! ($_ text\compose (name\encode (name-of )) " @ " (location.format location))) + #let [_ (log! ($_ text\compose (name\encode (name_of )) " @ " (location.format location))) _ (list\map (|>> code.format log!) output) _ (log! "")]] @@ -699,11 +699,11 @@ output))) #.None - (fail (..wrong-syntax-error (name-of )))))] + (fail (..wrong_syntax_error (name_of )))))] - [log-expand! expand] - [log-expand-all! expand-all] - [log-expand-once! expand-once] + [log_expand! expand] + [log_expand_all! expand_all] + [log_expand_once! expand_once] ) (def: #export (lift result) diff --git a/stdlib/source/lux/meta/annotation.lux b/stdlib/source/lux/meta/annotation.lux index 17fef0c8f..3f0527f74 100644 --- a/stdlib/source/lux/meta/annotation.lux +++ b/stdlib/source/lux/meta/annotation.lux @@ -56,7 +56,7 @@ (def: #export documentation (-> Annotation (Maybe Text)) - (..text (name-of #.doc))) + (..text (name_of #.doc))) (def: #export (flagged? flag) (-> Name Annotation Bit) @@ -65,18 +65,18 @@ (template [ ] [(def: #export (-> Annotation Bit) - (..flagged? (name-of )))] + (..flagged? (name_of )))] [structure? #.struct?] - [recursive-type? #.type-rec?] + [recursive_type? #.type-rec?] [signature? #.sig?] ) -(def: (parse-text input) +(def: (parse_text input) (-> Code (Maybe Text)) (case input - [_ (#.Text actual-value)] - (#.Some actual-value) + [_ (#.Text actual_value)] + (#.Some actual_value) _ #.None)) @@ -86,9 +86,9 @@ (-> Annotation (List Text)) (maybe.default (list) (do {! maybe.monad} - [args (..tuple (name-of ) ann)] - (monad.map ! ..parse-text args))))] + [args (..tuple (name_of ) ann)] + (monad.map ! ..parse_text args))))] - [function-arguments #.func-args] - [type-arguments #.type-args] + [function_arguments #.func-args] + [type_arguments #.type-args] ) diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index 687a6d632..ae3591668 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -20,8 +20,8 @@ (def: nest (-> Text Text) - (|>> (format text.new-line) - (text.replace-all text.new-line (format text.new-line text.tab)))) + (|>> (format text.new_line) + (text.replace_all text.new_line (format text.new_line text.tab)))) (abstract: #export (Code brand) Text @@ -68,13 +68,13 @@ (def: #export (number value) (-> Frac Literal) (:abstraction - (.cond (f.not-a-number? value) + (.cond (f.not_a_number? value) "NaN" - (f.= f.positive-infinity value) + (f.= f.positive_infinity value) "Infinity" - (f.= f.negative-infinity value) + (f.= f.negative_infinity value) "-Infinity" ## else @@ -83,35 +83,35 @@ (def: sanitize (-> Text Text) (`` (|>> (~~ (template [ ] - [(text.replace-all )] + [(text.replace_all )] ["\\" "\"] ["\t" text.tab] - ["\v" text.vertical-tab] + ["\v" text.vertical_tab] ["\0" text.null] - ["\b" text.back-space] - ["\f" text.form-feed] - ["\n" text.new-line] - ["\r" text.carriage-return] - [(format "\" text.double-quote) - text.double-quote] + ["\b" text.back_space] + ["\f" text.form_feed] + ["\n" text.new_line] + ["\r" text.carriage_return] + [(format "\" text.double_quote) + text.double_quote] )) ))) (def: #export string (-> Text Literal) (|>> ..sanitize - (text.enclose [text.double-quote text.double-quote]) + (text.enclose [text.double_quote text.double_quote]) :abstraction)) - (def: argument-separator ", ") - (def: field-separator ": ") - (def: statement-suffix ";") + (def: argument_separator ", ") + (def: field_separator ": ") + (def: statement_suffix ";") (def: #export array (-> (List Expression) Computation) (|>> (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..element :abstraction)) @@ -119,9 +119,9 @@ (-> Text Var) (|>> :abstraction)) - (def: #export (at index array-or-object) + (def: #export (at index array_or_object) (-> Expression Expression Access) - (:abstraction (format (:representation array-or-object) (..element (:representation index))))) + (:abstraction (format (:representation array_or_object) (..element (:representation index))))) (def: #export (the field object) (-> Text Expression Access) @@ -131,7 +131,7 @@ (-> Expression (List Expression) Computation) (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression (format (:representation function)) :abstraction)) @@ -143,27 +143,27 @@ (def: #export object (-> (List [Text Expression]) Computation) (|>> (list\map (.function (_ [key val]) - (format (:representation (..string key)) ..field-separator (:representation val)))) - (text.join-with ..argument-separator) + (format (:representation (..string key)) ..field_separator (:representation val)))) + (text.join_with ..argument_separator) (text.enclose ["{" "}"]) ..expression :abstraction)) (def: #export (, pre post) (-> Expression Expression Computation) - (|> (format (:representation pre) ..argument-separator (:representation post)) + (|> (format (:representation pre) ..argument_separator (:representation post)) ..expression :abstraction)) (def: #export (then pre post) (-> Statement Statement Statement) (:abstraction (format (:representation pre) - text.new-line + text.new_line (:representation post)))) (def: block (-> Statement Text) - (let [close (format text.new-line "}")] + (let [close (format text.new_line "}")] (|>> :representation ..nest (text.enclose ["{" @@ -176,7 +176,7 @@ (format "function " (:representation name) (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression) " ") :abstraction)) @@ -195,7 +195,7 @@ (format "function" (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression) " ") ..expression @@ -220,15 +220,15 @@ [/ "/"] [% "%"] - [left-shift "<<"] - [arithmetic-right-shift ">>"] - [logic-right-shift ">>>"] + [left_shift "<<"] + [arithmetic_right_shift ">>"] + [logic_right_shift ">>>"] [or "||"] [and "&&"] - [bit-xor "^"] - [bit-or "|"] - [bit-and "&"] + [bit_xor "^"] + [bit_or "|"] + [bit_and "&"] ) (template [ ] @@ -237,7 +237,7 @@ (|>> :representation (text.prefix ) ..expression :abstraction))] [not "!"] - [bit-not "~"] + [bit_not "~"] [negate "-"] ) @@ -247,7 +247,7 @@ (-> Computation) (:abstraction (..expression (format ( value) "|0"))))] - [to-i32 Expression :representation] + [to_i32 Expression :representation] [i32 Int %.int] ) @@ -265,7 +265,7 @@ ..expression :abstraction)) - (def: #export type-of + (def: #export type_of (-> Expression Computation) (|>> :representation (format "typeof ") @@ -277,26 +277,26 @@ (|> (format "new " (:representation constructor) (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression)) ..expression :abstraction)) (def: #export statement (-> Expression Statement) - (|>> :representation (text.suffix ..statement-suffix) :abstraction)) + (|>> :representation (text.suffix ..statement_suffix) :abstraction)) - (def: #export use-strict + (def: #export use_strict Statement - (:abstraction (format text.double-quote "use strict" text.double-quote ..statement-suffix))) + (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix))) (def: #export (declare name) (-> Var Statement) - (:abstraction (format "var " (:representation name) ..statement-suffix))) + (:abstraction (format "var " (:representation name) ..statement_suffix))) (def: #export (define name value) (-> Var Expression Statement) - (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement-suffix))) + (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix))) (def: #export (set' name value) (-> Location Expression Expression) @@ -304,15 +304,15 @@ (def: #export (set name value) (-> Location Expression Statement) - (:abstraction (format (:representation name) " = " (:representation value) ..statement-suffix))) + (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix))) (def: #export (throw message) (-> Expression Statement) - (:abstraction (format "throw " (:representation message) ..statement-suffix))) + (:abstraction (format "throw " (:representation message) ..statement_suffix))) (def: #export (return value) (-> Expression Statement) - (:abstraction (format "return " (:representation value) ..statement-suffix))) + (:abstraction (format "return " (:representation value) ..statement_suffix))) (def: #export (delete' value) (-> Location Expression) @@ -320,7 +320,7 @@ (def: #export (delete value) (-> Location Statement) - (:abstraction (format (:representation (delete' value)) ..statement-suffix))) + (:abstraction (format (:representation (delete' value)) ..statement_suffix))) (def: #export (if test then! else!) (-> Expression Statement Statement Statement) @@ -339,10 +339,10 @@ (:abstraction (format "while(" (:representation test) ") " (..block body)))) - (def: #export (do-while test body) + (def: #export (do_while test body) (-> Expression Statement Loop) (:abstraction (format "do " (..block body) - " while(" (:representation test) ")" ..statement-suffix))) + " while(" (:representation test) ")" ..statement_suffix))) (def: #export (try body [exception catch]) (-> Statement [Var Statement] Statement) @@ -355,7 +355,7 @@ (-> Var Expression Expression Expression Statement Loop) (:abstraction (format "for(" (:representation (..define var init)) " " (:representation condition) - ..statement-suffix " " (:representation update) + ..statement_suffix " " (:representation update) ")" (..block iteration)))) @@ -363,21 +363,21 @@ (-> Text Label) (|>> :abstraction)) - (def: #export (with-label label loop) + (def: #export (with_label label loop) (-> Label Loop Statement) (:abstraction (format (:representation label) ": " (:representation loop)))) (template [ <0> <1>] [(def: #export <0> Statement - (:abstraction (format ..statement-suffix))) + (:abstraction (format ..statement_suffix))) (def: #export (<1> label) (-> Label Statement) - (:abstraction (format " " (:representation label) ..statement-suffix)))] + (:abstraction (format " " (:representation label) ..statement_suffix)))] - ["break" break break-at] - ["continue" continue continue-at] + ["break" break break_at] + ["continue" continue continue_at] ) (template [ ] @@ -402,10 +402,10 @@ (list\map (.function (_ [when then]) (format (|> when (list\map (|>> :representation (text.enclose ["case " ":"]))) - (text.join-with text.new-line)) + (text.join_with text.new_line)) (..nest (:representation then))))) - (text.join-with text.new-line)) - text.new-line + (text.join_with text.new_line)) + text.new_line (case default (#.Some default) (format "default:" @@ -435,7 +435,7 @@ (~~ (template.splice +))))] [apply/1 [_0] [Expression] - [[not-a-number? "isNaN"]]] + [[not_a_number? "isNaN"]]] [apply/2 [_0 _1] [Expression Expression] []] diff --git a/stdlib/source/lux/target/jvm.lux b/stdlib/source/lux/target/jvm.lux index 4998f0f05..3cc306cd9 100644 --- a/stdlib/source/lux/target/jvm.lux +++ b/stdlib/source/lux/target/jvm.lux @@ -43,7 +43,7 @@ (#LDC Literal)) -(type: #export Int-Arithmetic +(type: #export Int_Arithmetic #IADD #ISUB #IMUL @@ -51,7 +51,7 @@ #IREM #INEG) -(type: #export Long-Arithmetic +(type: #export Long_Arithmetic #LADD #LSUB #LMUL @@ -59,7 +59,7 @@ #LREM #LNEG) -(type: #export Float-Arithmetic +(type: #export Float_Arithmetic #FADD #FSUB #FMUL @@ -67,7 +67,7 @@ #FREM #FNEG) -(type: #export Double-Arithmetic +(type: #export Double_Arithmetic #DADD #DSUB #DMUL @@ -76,12 +76,12 @@ #DNEG) (type: #export Arithmetic - (#Int-Arithmetic Int-Arithmetic) - (#Long-Arithmetic Long-Arithmetic) - (#Float-Arithmetic Float-Arithmetic) - (#Double-Arithmetic Double-Arithmetic)) + (#Int_Arithmetic Int_Arithmetic) + (#Long_Arithmetic Long_Arithmetic) + (#Float_Arithmetic Float_Arithmetic) + (#Double_Arithmetic Double_Arithmetic)) -(type: #export Int-Bitwise +(type: #export Int_Bitwise #IOR #IXOR #IAND @@ -89,7 +89,7 @@ #ISHR #IUSHR) -(type: #export Long-Bitwise +(type: #export Long_Bitwise #LOR #LXOR #LAND @@ -98,8 +98,8 @@ #LUSHR) (type: #export Bitwise - (#Int-Bitwise Int-Bitwise) - (#Long-Bitwise Long-Bitwise)) + (#Int_Bitwise Int_Bitwise) + (#Long_Bitwise Long_Bitwise)) (type: #export Conversion #I2B @@ -170,33 +170,33 @@ (type: #export Register Nat) -(type: #export Local-Int +(type: #export Local_Int (#ILOAD Register) (#ISTORE Register)) -(type: #export Local-Long +(type: #export Local_Long (#LLOAD Register) (#LSTORE Register)) -(type: #export Local-Float +(type: #export Local_Float (#FLOAD Register) (#FSTORE Register)) -(type: #export Local-Double +(type: #export Local_Double (#DLOAD Register) (#DSTORE Register)) -(type: #export Local-Object +(type: #export Local_Object (#ALOAD Register) (#ASTORE Register)) (type: #export Local - (#Local-Int Local-Int) + (#Local_Int Local_Int) (#IINC Register) - (#Local-Long Local-Long) - (#Local-Float Local-Float) - (#Local-Double Local-Double) - (#Local-Object Local-Object)) + (#Local_Long Local_Long) + (#Local_Float Local_Float) + (#Local_Double Local_Double) + (#Local_Object Local_Object)) (type: #export Stack #DUP diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 68297f17b..0f5c9ddc7 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -28,7 +28,7 @@ #length U4 #info about}) -(def: #export (info-equivalence Equivalence) +(def: #export (info_equivalence Equivalence) (All [about] (-> (Equivalence about) (Equivalence (Info about)))) @@ -37,7 +37,7 @@ //unsigned.equivalence Equivalence)) -(def: (info-writer writer) +(def: (info_writer writer) (All [about] (-> (Writer about) (Writer (Info about)))) @@ -48,7 +48,7 @@ [($_ n.+ nameS lengthS infoS) (|>> nameT lengthT infoT)]))) -(with-expansions [ (as-is (/code.Code Attribute))] +(with_expansions [ (as_is (/code.Code Attribute))] (type: #export #rec Attribute (#Constant (Info (Constant Any))) (#Code (Info ))) @@ -62,10 +62,10 @@ (equivalence.rec (function (_ equivalence) ($_ sum.equivalence - (info-equivalence /constant.equivalence) - (info-equivalence (/code.equivalence equivalence)))))) + (info_equivalence /constant.equivalence) + (info_equivalence (/code.equivalence equivalence)))))) -(def: common-attribute-length +(def: common_attribute_length ($_ n.+ ## u2 attribute_name_index; //unsigned.bytes/2 @@ -78,7 +78,7 @@ (case attribute (^template [] [( [name length info]) - (|> length //unsigned.value (n.+ ..common-attribute-length))]) + (|> length //unsigned.value (n.+ ..common_attribute_length))]) ([#Constant] [#Code]))) ## TODO: Inline ASAP @@ -115,7 +115,7 @@ (Writer Attribute) (case value (#Constant attribute) - ((info-writer /constant.writer) attribute) + ((info_writer /constant.writer) attribute) (#Code attribute) - ((info-writer (/code.writer writer)) attribute))) + ((info_writer (/code.writer writer)) attribute))) diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index 29d027b4d..328214859 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -24,7 +24,7 @@ (type: #export (Code Attribute) {#limit Limit #code Binary - #exception-table (Row Exception) + #exception_table (Row Exception) #attributes (Row Attribute)}) (def: #export (length length code) @@ -41,7 +41,7 @@ ///unsigned.bytes/2 ## exception_table[exception_table_length]; (|> code - (get@ #exception-table) + (get@ #exception_table) row.size (n.* /exception.length)) ## u2 attributes_count; @@ -52,14 +52,14 @@ (row\map length) (row\fold n.+ 0)))) -(def: #export (equivalence attribute-equivalence) +(def: #export (equivalence attribute_equivalence) (All [attribute] (-> (Equivalence attribute) (Equivalence (Code attribute)))) ($_ product.equivalence ///limit.equivalence binary.equivalence (row.equivalence /exception.equivalence) - (row.equivalence attribute-equivalence) + (row.equivalence attribute_equivalence) )) ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 @@ -74,7 +74,7 @@ (binaryF.binary/32 (get@ #code code)) ## u2 exception_table_length; ## exception_table[exception_table_length]; - ((binaryF.row/16 /exception.writer) (get@ #exception-table code)) + ((binaryF.row/16 /exception.writer) (get@ #exception_table code)) ## u2 attributes_count; ## attribute_info attributes[attributes_count]; ((binaryF.row/16 writer) (get@ #attributes code)) diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index af843c6cf..700f3b27e 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -27,8 +27,8 @@ ["." template]]] ["." / #_ ["#." address (#+ Address)] - ["#." jump (#+ Jump Big-Jump)] - ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#\." monoid)] + ["#." jump (#+ Jump Big_Jump)] + ["_" instruction (#+ Primitive_Array_Type Instruction Estimator) ("#\." monoid)] ["#." environment (#+ Environment) [limit ["/." registry (#+ Register Registry)] @@ -54,64 +54,64 @@ (type: #export Resolver (Dictionary Label [Stack (Maybe Address)])) (type: #export Tracker - {#program-counter Address + {#program_counter Address #next Label #known Resolver}) (def: fresh Tracker - {#program-counter /address.start + {#program_counter /address.start #next 0 #known (dictionary.new n.hash)}) (type: #export Relative (-> Resolver (Try [(Row Exception) Instruction]))) -(def: no-exceptions +(def: no_exceptions (Row Exception) row.empty) -(def: relative-identity +(def: relative_identity Relative - (function.constant (#try.Success [..no-exceptions _.empty]))) + (function.constant (#try.Success [..no_exceptions _.empty]))) -(structure: relative-monoid +(structure: relative_monoid (Monoid Relative) - (def: identity ..relative-identity) + (def: identity ..relative_identity) (def: (compose left right) - (cond (is? ..relative-identity left) + (cond (is? ..relative_identity left) right - (is? ..relative-identity right) + (is? ..relative_identity right) left ## else (function (_ resolver) (do try.monad - [[left-exceptions left-instruction] (left resolver) - [right-exceptions right-instruction] (right resolver)] - (wrap [(\ row.monoid compose left-exceptions right-exceptions) - (_\compose left-instruction right-instruction)])))))) + [[left_exceptions left_instruction] (left resolver) + [right_exceptions right_instruction] (right resolver)] + (wrap [(\ row.monoid compose left_exceptions right_exceptions) + (_\compose left_instruction right_instruction)])))))) (type: #export (Bytecode a) (State' Try [Pool Environment Tracker] (Writer Relative a))) -(def: #export new-label +(def: #export new_label (Bytecode Label) (function (_ [pool environment tracker]) (#try.Success [[pool environment (update@ #next inc tracker)] - [..relative-identity + [..relative_identity (get@ #next tracker)]]))) -(exception: #export (label-has-already-been-set {label Label}) +(exception: #export (label_has_already_been_set {label Label}) (exception.report ["Label" (%.nat label)])) -(exception: #export (mismatched-environments {instruction Name} +(exception: #export (mismatched_environments {instruction Name} {label Label} {address Address} {expected Stack} @@ -123,20 +123,20 @@ ["Expected" (/stack.format expected)] ["Actual" (/stack.format actual)])) -(with-expansions [ (as-is (wrap [[pool +(with_expansions [ (as_is (wrap [[pool environment (update@ #known (dictionary.put label [actual (#.Some @here)]) tracker)] - [..relative-identity + [..relative_identity []]]))] - (def: #export (set-label label) + (def: #export (set_label label) (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) - (let [@here (get@ #program-counter tracker)] + (let [@here (get@ #program_counter tracker)] (case (dictionary.get label (get@ #known tracker)) (#.Some [expected (#.Some address)]) - (exception.throw ..label-has-already-been-set [label]) + (exception.throw ..label_has_already_been_set [label]) (#.Some [expected #.None]) (do try.monad @@ -154,7 +154,7 @@ (def: #export monad (Monad Bytecode) (<| (:coerce (Monad Bytecode)) - (writer.with ..relative-monoid) + (writer.with ..relative_monoid) (: (Monad (State' Try [Pool Environment Tracker]))) state.with (: (Monad Try)) @@ -188,11 +188,11 @@ (/environment.consumes consumption) (monad.bind ! (/environment.produces production)) (monad.bind ! (/environment.has registry))) - program-counter' (step estimator (get@ #program-counter tracker))] + program_counter' (step estimator (get@ #program_counter tracker))] (wrap [[pool environment' - (set@ #program-counter program-counter' tracker)] - [(function.constant (wrap [..no-exceptions (bytecode input)])) + (set@ #program_counter program_counter' tracker)] + [(function.constant (wrap [..no_exceptions (bytecode input)])) []]])))) (template [ ] @@ -229,35 +229,35 @@ [nop $0 $0 @_ _.nop] - [aconst-null $0 $1 @_ _.aconst-null] - - [iconst-m1 $0 $1 @_ _.iconst-m1] - [iconst-0 $0 $1 @_ _.iconst-0] - [iconst-1 $0 $1 @_ _.iconst-1] - [iconst-2 $0 $1 @_ _.iconst-2] - [iconst-3 $0 $1 @_ _.iconst-3] - [iconst-4 $0 $1 @_ _.iconst-4] - [iconst-5 $0 $1 @_ _.iconst-5] - - [lconst-0 $0 $2 @_ _.lconst-0] - [lconst-1 $0 $2 @_ _.lconst-1] - - [fconst-0 $0 $1 @_ _.fconst-0] - [fconst-1 $0 $1 @_ _.fconst-1] - [fconst-2 $0 $1 @_ _.fconst-2] + [aconst_null $0 $1 @_ _.aconst_null] + + [iconst_m1 $0 $1 @_ _.iconst_m1] + [iconst_0 $0 $1 @_ _.iconst_0] + [iconst_1 $0 $1 @_ _.iconst_1] + [iconst_2 $0 $1 @_ _.iconst_2] + [iconst_3 $0 $1 @_ _.iconst_3] + [iconst_4 $0 $1 @_ _.iconst_4] + [iconst_5 $0 $1 @_ _.iconst_5] + + [lconst_0 $0 $2 @_ _.lconst_0] + [lconst_1 $0 $2 @_ _.lconst_1] + + [fconst_0 $0 $1 @_ _.fconst_0] + [fconst_1 $0 $1 @_ _.fconst_1] + [fconst_2 $0 $1 @_ _.fconst_2] - [dconst-0 $0 $2 @_ _.dconst-0] - [dconst-1 $0 $2 @_ _.dconst-1] + [dconst_0 $0 $2 @_ _.dconst_0] + [dconst_1 $0 $2 @_ _.dconst_1] [pop $1 $0 @_ _.pop] [pop2 $2 $0 @_ _.pop2] [dup $1 $2 @_ _.dup] - [dup-x1 $2 $3 @_ _.dup-x1] - [dup-x2 $3 $4 @_ _.dup-x2] + [dup_x1 $2 $3 @_ _.dup_x1] + [dup_x2 $3 $4 @_ _.dup_x2] [dup2 $2 $4 @_ _.dup2] - [dup2-x1 $3 $5 @_ _.dup2-x1] - [dup2-x2 $4 $6 @_ _.dup2-x2] + [dup2_x1 $3 $5 @_ _.dup2_x1] + [dup2_x2 $4 $6 @_ _.dup2_x2] [swap $2 $2 @_ _.swap] @@ -270,30 +270,30 @@ [caload $2 $1 @_ _.caload] [saload $2 $1 @_ _.saload] - [iload-0 $0 $1 @0 _.iload-0] - [iload-1 $0 $1 @1 _.iload-1] - [iload-2 $0 $1 @2 _.iload-2] - [iload-3 $0 $1 @3 _.iload-3] + [iload_0 $0 $1 @0 _.iload_0] + [iload_1 $0 $1 @1 _.iload_1] + [iload_2 $0 $1 @2 _.iload_2] + [iload_3 $0 $1 @3 _.iload_3] - [lload-0 $0 $2 @1 _.lload-0] - [lload-1 $0 $2 @2 _.lload-1] - [lload-2 $0 $2 @3 _.lload-2] - [lload-3 $0 $2 @4 _.lload-3] + [lload_0 $0 $2 @1 _.lload_0] + [lload_1 $0 $2 @2 _.lload_1] + [lload_2 $0 $2 @3 _.lload_2] + [lload_3 $0 $2 @4 _.lload_3] - [fload-0 $0 $1 @0 _.fload-0] - [fload-1 $0 $1 @1 _.fload-1] - [fload-2 $0 $1 @2 _.fload-2] - [fload-3 $0 $1 @3 _.fload-3] + [fload_0 $0 $1 @0 _.fload_0] + [fload_1 $0 $1 @1 _.fload_1] + [fload_2 $0 $1 @2 _.fload_2] + [fload_3 $0 $1 @3 _.fload_3] - [dload-0 $0 $2 @1 _.dload-0] - [dload-1 $0 $2 @2 _.dload-1] - [dload-2 $0 $2 @3 _.dload-2] - [dload-3 $0 $2 @4 _.dload-3] + [dload_0 $0 $2 @1 _.dload_0] + [dload_1 $0 $2 @2 _.dload_1] + [dload_2 $0 $2 @3 _.dload_2] + [dload_3 $0 $2 @4 _.dload_3] - [aload-0 $0 $1 @0 _.aload-0] - [aload-1 $0 $1 @1 _.aload-1] - [aload-2 $0 $1 @2 _.aload-2] - [aload-3 $0 $1 @3 _.aload-3] + [aload_0 $0 $1 @0 _.aload_0] + [aload_1 $0 $1 @1 _.aload_1] + [aload_2 $0 $1 @2 _.aload_2] + [aload_3 $0 $1 @3 _.aload_3] [iastore $3 $1 @_ _.iastore] [lastore $4 $1 @_ _.lastore] @@ -304,30 +304,30 @@ [castore $3 $1 @_ _.castore] [sastore $3 $1 @_ _.sastore] - [istore-0 $1 $0 @0 _.istore-0] - [istore-1 $1 $0 @1 _.istore-1] - [istore-2 $1 $0 @2 _.istore-2] - [istore-3 $1 $0 @3 _.istore-3] - - [lstore-0 $2 $0 @1 _.lstore-0] - [lstore-1 $2 $0 @2 _.lstore-1] - [lstore-2 $2 $0 @3 _.lstore-2] - [lstore-3 $2 $0 @4 _.lstore-3] - - [fstore-0 $1 $0 @0 _.fstore-0] - [fstore-1 $1 $0 @1 _.fstore-1] - [fstore-2 $1 $0 @2 _.fstore-2] - [fstore-3 $1 $0 @3 _.fstore-3] - - [dstore-0 $2 $0 @1 _.dstore-0] - [dstore-1 $2 $0 @2 _.dstore-1] - [dstore-2 $2 $0 @3 _.dstore-2] - [dstore-3 $2 $0 @4 _.dstore-3] + [istore_0 $1 $0 @0 _.istore_0] + [istore_1 $1 $0 @1 _.istore_1] + [istore_2 $1 $0 @2 _.istore_2] + [istore_3 $1 $0 @3 _.istore_3] + + [lstore_0 $2 $0 @1 _.lstore_0] + [lstore_1 $2 $0 @2 _.lstore_1] + [lstore_2 $2 $0 @3 _.lstore_2] + [lstore_3 $2 $0 @4 _.lstore_3] + + [fstore_0 $1 $0 @0 _.fstore_0] + [fstore_1 $1 $0 @1 _.fstore_1] + [fstore_2 $1 $0 @2 _.fstore_2] + [fstore_3 $1 $0 @3 _.fstore_3] + + [dstore_0 $2 $0 @1 _.dstore_0] + [dstore_1 $2 $0 @2 _.dstore_1] + [dstore_2 $2 $0 @3 _.dstore_2] + [dstore_3 $2 $0 @4 _.dstore_3] - [astore-0 $1 $0 @0 _.astore-0] - [astore-1 $1 $0 @1 _.astore-1] - [astore-2 $1 $0 @2 _.astore-2] - [astore-3 $1 $0 @3 _.astore-3] + [astore_0 $1 $0 @0 _.astore_0] + [astore_1 $1 $0 @1 _.astore_1] + [astore_2 $1 $0 @2 _.astore_2] + [astore_3 $1 $0 @3 _.astore_3] [iadd $2 $1 @_ _.iadd] [isub $2 $1 @_ _.isub] @@ -410,7 +410,7 @@ (wrap [[pool (/environment.discontinue environment) tracker] - [..relative-identity + [..relative_identity []]])))) (template [ ] @@ -442,7 +442,7 @@ (do try.monad [[pool' output] (resource pool)] (wrap [[pool' environment tracker] - [..relative-identity + [..relative_identity output]])))) (def: #export (string value) @@ -454,7 +454,7 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ _.ldc-w/string [index])))) + (..bytecode $0 $1 @_ _.ldc_w/string [index])))) (import: java/lang/Float ["#::." @@ -464,10 +464,10 @@ ["#::." (#static doubleToRawLongBits #manual [double] int)]) -(template [ ] +(template [ ] [(def: #export ( value) (-> (Bytecode Any)) - (case (|> value ) + (case (|> value ) (^template [ ] [ (..bytecode $0 $1 @_ [])]) @@ -481,18 +481,18 @@ (#try.Failure _) (..bytecode $0 $1 @_ [index])))))] - [int I32 //constant.integer //constant/pool.integer _.ldc-w/integer + [int I32 //constant.integer //constant/pool.integer _.ldc_w/integer (<| .int i32.i64) - ([-1 _.iconst-m1] - [+0 _.iconst-0] - [+1 _.iconst-1] - [+2 _.iconst-2] - [+3 _.iconst-3] - [+4 _.iconst-4] - [+5 _.iconst-5])] + ([-1 _.iconst_m1] + [+0 _.iconst_0] + [+1 _.iconst_1] + [+2 _.iconst_2] + [+3 _.iconst_3] + [+4 _.iconst_4] + [+5 _.iconst_5])] ) -(def: (arbitrary-float value) +(def: (arbitrary_float value) (-> java/lang/Float (Bytecode Any)) (do ..monad [index (..lift (//constant/pool.float (//constant.float value)))] @@ -501,35 +501,35 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ _.ldc-w/float [index])))) + (..bytecode $0 $1 @_ _.ldc_w/float [index])))) -(def: float-bits +(def: float_bits (-> java/lang/Float Int) (|>> java/lang/Float::floatToRawIntBits - host.int-to-long + host.int_to_long (:coerce Int))) -(def: negative-zero-float-bits - (|> -0.0 host.double-to-float ..float-bits)) +(def: negative_zero_float_bits + (|> -0.0 host.double_to_float ..float_bits)) (def: #export (float value) (-> java/lang/Float (Bytecode Any)) - (if (i.= ..negative-zero-float-bits - (..float-bits value)) - (..arbitrary-float value) - (case (|> value host.float-to-double (:coerce Frac)) + (if (i.= ..negative_zero_float_bits + (..float_bits value)) + (..arbitrary_float value) + (case (|> value host.float_to_double (:coerce Frac)) (^template [ ] [ (..bytecode $0 $1 @_ [])]) - ([+0.0 _.fconst-0] - [+1.0 _.fconst-1] - [+2.0 _.fconst-2]) + ([+0.0 _.fconst_0] + [+1.0 _.fconst_1] + [+2.0 _.fconst_2]) - _ (..arbitrary-float value)))) + _ (..arbitrary_float value)))) -(template [ ] +(template [ ] [(def: #export ( value) (-> (Bytecode Any)) - (case (|> value ) + (case (|> value ) (^template [ ] [ (..bytecode $0 $2 @_ [])]) @@ -538,40 +538,40 @@ [index (..lift ( ( value)))] (..bytecode $0 $2 @_ [index]))))] - [long Int //constant.long //constant/pool.long _.ldc2-w/long + [long Int //constant.long //constant/pool.long _.ldc2_w/long (<|) - ([+0 _.lconst-0] - [+1 _.lconst-1])] + ([+0 _.lconst_0] + [+1 _.lconst_1])] ) -(def: (arbitrary-double value) +(def: (arbitrary_double value) (-> java/lang/Double (Bytecode Any)) (do ..monad [index (..lift (//constant/pool.double (//constant.double value)))] - (..bytecode $0 $2 @_ _.ldc2-w/double [index]))) + (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) -(def: double-bits +(def: double_bits (-> java/lang/Double Int) (|>> java/lang/Double::doubleToRawLongBits (:coerce Int))) -(def: negative-zero-double-bits - (..double-bits -0.0)) +(def: negative_zero_double_bits + (..double_bits -0.0)) (def: #export (double value) (-> java/lang/Double (Bytecode Any)) - (if (i.= ..negative-zero-double-bits - (..double-bits value)) - (..arbitrary-double value) + (if (i.= ..negative_zero_double_bits + (..double_bits value)) + (..arbitrary_double value) (case value (^template [ ] [ (..bytecode $0 $2 @_ [])]) - ([+0.0 _.dconst-0] - [+1.0 _.dconst-1]) + ([+0.0 _.dconst_0] + [+1.0 _.dconst_1]) - _ (..arbitrary-double value)))) + _ (..arbitrary_double value)))) -(exception: #export (invalid-register {id Nat}) +(exception: #export (invalid_register {id Nat}) (exception.report ["ID" (%.nat id)])) @@ -582,12 +582,12 @@ (\ ..monad wrap register) (#try.Failure error) - (..throw ..invalid-register [id]))) + (..throw ..invalid_register [id]))) (template [ ] [(def: #export ( local) (-> Nat (Bytecode Any)) - (with-expansions [' (template.splice )] + (with_expansions [' (template.splice )] (`` (case local (~~ (template [ ] [ (..bytecode $0 [])] @@ -598,36 +598,36 @@ (..bytecode $0 ( local) [local]))))))] [/registry.for $1 iload _.iload - [[0 _.iload-0 @0] - [1 _.iload-1 @1] - [2 _.iload-2 @2] - [3 _.iload-3 @3]]] - [/registry.for-wide $2 lload _.lload - [[0 _.lload-0 @1] - [1 _.lload-1 @2] - [2 _.lload-2 @3] - [3 _.lload-3 @4]]] + [[0 _.iload_0 @0] + [1 _.iload_1 @1] + [2 _.iload_2 @2] + [3 _.iload_3 @3]]] + [/registry.for_wide $2 lload _.lload + [[0 _.lload_0 @1] + [1 _.lload_1 @2] + [2 _.lload_2 @3] + [3 _.lload_3 @4]]] [/registry.for $1 fload _.fload - [[0 _.fload-0 @0] - [1 _.fload-1 @1] - [2 _.fload-2 @2] - [3 _.fload-3 @3]]] - [/registry.for-wide $2 dload _.dload - [[0 _.dload-0 @1] - [1 _.dload-1 @2] - [2 _.dload-2 @3] - [3 _.dload-3 @4]]] + [[0 _.fload_0 @0] + [1 _.fload_1 @1] + [2 _.fload_2 @2] + [3 _.fload_3 @3]]] + [/registry.for_wide $2 dload _.dload + [[0 _.dload_0 @1] + [1 _.dload_1 @2] + [2 _.dload_2 @3] + [3 _.dload_3 @4]]] [/registry.for $1 aload _.aload - [[0 _.aload-0 @0] - [1 _.aload-1 @1] - [2 _.aload-2 @2] - [3 _.aload-3 @3]]] + [[0 _.aload_0 @0] + [1 _.aload_1 @1] + [2 _.aload_2 @2] + [3 _.aload_3 @3]]] ) (template [ ] [(def: #export ( local) (-> Nat (Bytecode Any)) - (with-expansions [' (template.splice )] + (with_expansions [' (template.splice )] (`` (case local (~~ (template [ ] [ (..bytecode $0 [])] @@ -638,30 +638,30 @@ (..bytecode $0 ( local) [local]))))))] [/registry.for $1 istore _.istore - [[0 _.istore-0 @0] - [1 _.istore-1 @1] - [2 _.istore-2 @2] - [3 _.istore-3 @3]]] - [/registry.for-wide $2 lstore _.lstore - [[0 _.lstore-0 @1] - [1 _.lstore-1 @2] - [2 _.lstore-2 @3] - [3 _.lstore-3 @4]]] + [[0 _.istore_0 @0] + [1 _.istore_1 @1] + [2 _.istore_2 @2] + [3 _.istore_3 @3]]] + [/registry.for_wide $2 lstore _.lstore + [[0 _.lstore_0 @1] + [1 _.lstore_1 @2] + [2 _.lstore_2 @3] + [3 _.lstore_3 @4]]] [/registry.for $1 fstore _.fstore - [[0 _.fstore-0 @0] - [1 _.fstore-1 @1] - [2 _.fstore-2 @2] - [3 _.fstore-3 @3]]] - [/registry.for-wide $2 dstore _.dstore - [[0 _.dstore-0 @1] - [1 _.dstore-1 @2] - [2 _.dstore-2 @3] - [3 _.dstore-3 @4]]] + [[0 _.fstore_0 @0] + [1 _.fstore_1 @1] + [2 _.fstore_2 @2] + [3 _.fstore_3 @3]]] + [/registry.for_wide $2 dstore _.dstore + [[0 _.dstore_0 @1] + [1 _.dstore_1 @2] + [2 _.dstore_2 @3] + [3 _.dstore_3 @4]]] [/registry.for $1 astore _.astore - [[0 _.astore-0 @0] - [1 _.astore-1 @1] - [2 _.astore-2 @2] - [3 _.astore-3 @3]]] + [[0 _.astore_0 @0] + [1 _.astore_1 @1] + [2 _.astore_2 @2] + [3 _.astore_3 @3]]] ) (template [ ] @@ -669,26 +669,26 @@ (-> (Bytecode Any)) (..bytecode @_ ))] - [$1 $1 newarray _.newarray Primitive-Array-Type] + [$1 $1 newarray _.newarray Primitive_Array_Type] [$0 $1 sipush _.sipush S2] ) -(exception: #export (unknown-label {label Label}) +(exception: #export (unknown_label {label Label}) (exception.report ["Label" (%.nat label)])) -(exception: #export (cannot-do-a-big-jump {label Label} +(exception: #export (cannot_do_a_big_jump {label Label} {@from Address} - {jump Big-Jump}) + {jump Big_Jump}) (exception.report ["Label" (%.nat label)] ["Start" (|> @from /address.value //unsigned.value %.nat)] ["Target" (|> jump //signed.value %.int)])) -(type: Any-Jump (Either Big-Jump Jump)) +(type: Any_Jump (Either Big_Jump Jump)) (def: (jump @from @to) - (-> Address Address (Try Any-Jump)) + (-> Address Address (Try Any_Jump)) (do {! try.monad} [jump (\ ! map //signed.value (/address.jump @from @to))] @@ -701,23 +701,23 @@ (\ ! map (|>> #.Left) (//signed.s4 jump)) (\ ! map (|>> #.Right) (//signed.s2 jump)))))) -(exception: #export (unset-label {label Label}) +(exception: #export (unset_label {label Label}) (exception.report ["Label" (%.nat label)])) -(def: (resolve-label label resolver) +(def: (resolve_label label resolver) (-> Label Resolver (Try [Stack Address])) (case (dictionary.get label resolver) (#.Some [actual (#.Some address)]) (#try.Success [actual address]) (#.Some [actual #.None]) - (exception.throw ..unset-label [label]) + (exception.throw ..unset_label [label]) #.None - (exception.throw ..unknown-label [label]))) + (exception.throw ..unknown_label [label]))) -(def: (acknowledge-label stack label tracker) +(def: (acknowledge_label stack label tracker) (-> Stack Label Tracker Tracker) (case (dictionary.get label (get@ #known tracker)) (#.Some _) @@ -731,30 +731,30 @@ (-> Label (Bytecode Any)) (let [[estimator bytecode] ] (function (_ [pool environment tracker]) - (let [@here (get@ #program-counter tracker)] + (let [@here (get@ #program_counter tracker)] (do try.monad [environment' (|> environment (/environment.consumes )) actual (/environment.stack environment') - program-counter' (step estimator @here)] + program_counter' (step estimator @here)] (wrap (let [@from @here] [[pool environment' (|> tracker - (..acknowledge-label actual label) - (set@ #program-counter program-counter'))] + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] [(function (_ resolver) (do try.monad - [[expected @to] (..resolve-label label resolver) - _ (exception.assert ..mismatched-environments [(name-of ) label @here expected actual] + [[expected @to] (..resolve_label label resolver) + _ (exception.assert ..mismatched_environments [(name_of ) label @here expected actual] (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) - (exception.throw ..cannot-do-a-big-jump [label @from jump]) + (exception.throw ..cannot_do_a_big_jump [label @from jump]) (#.Right jump) - (wrap [..no-exceptions (bytecode jump)])))) + (wrap [..no_exceptions (bytecode jump)])))) []]])))))))] [$1 ifeq _.ifeq] @@ -767,63 +767,63 @@ [$1 ifnull _.ifnull] [$1 ifnonnull _.ifnonnull] - [$2 if-icmpeq _.if-icmpeq] - [$2 if-icmpne _.if-icmpne] - [$2 if-icmplt _.if-icmplt] - [$2 if-icmpge _.if-icmpge] - [$2 if-icmpgt _.if-icmpgt] - [$2 if-icmple _.if-icmple] + [$2 if_icmpeq _.if_icmpeq] + [$2 if_icmpne _.if_icmpne] + [$2 if_icmplt _.if_icmplt] + [$2 if_icmpge _.if_icmpge] + [$2 if_icmpgt _.if_icmpgt] + [$2 if_icmple _.if_icmple] - [$2 if-acmpeq _.if-acmpeq] - [$2 if-acmpne _.if-acmpne] + [$2 if_acmpeq _.if_acmpeq] + [$2 if_acmpne _.if_acmpne] ) -(template [ ] +(template [ ] [(def: #export ( label) (-> Label (Bytecode Any)) (let [[estimator bytecode] ] (function (_ [pool environment tracker]) (do try.monad [actual (/environment.stack environment) - #let [@here (get@ #program-counter tracker)] - program-counter' (step estimator @here)] + #let [@here (get@ #program_counter tracker)] + program_counter' (step estimator @here)] (wrap (let [@from @here] [[pool (/environment.discontinue environment) (|> tracker - (..acknowledge-label actual label) - (set@ #program-counter program-counter'))] + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] [(function (_ resolver) (case (dictionary.get label resolver) (#.Some [expected (#.Some @to)]) (do try.monad - [_ (exception.assert ..mismatched-environments [(name-of ) label @here expected actual] + [_ (exception.assert ..mismatched_environments [(name_of ) label @here expected actual] (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) - + (#.Right jump) - )) + )) (#.Some [expected #.None]) - (exception.throw ..unset-label [label]) + (exception.throw ..unset_label [label]) #.None - (exception.throw ..unknown-label [label]))) + (exception.throw ..unknown_label [label]))) []]]))))))] [goto _.goto - (exception.throw ..cannot-do-a-big-jump [label @from jump]) - (wrap [..no-exceptions (bytecode jump)])] - [goto-w _.goto-w - (wrap [..no-exceptions (bytecode jump)]) - (wrap [..no-exceptions (bytecode (/jump.lift jump))])] + (exception.throw ..cannot_do_a_big_jump [label @from jump]) + (wrap [..no_exceptions (bytecode jump)])] + [goto_w _.goto_w + (wrap [..no_exceptions (bytecode jump)]) + (wrap [..no_exceptions (bytecode (/jump.lift jump))])] ) -(def: (big-jump jump) - (-> Any-Jump Big-Jump) +(def: (big_jump jump) + (-> Any_Jump Big_Jump) (case jump (#.Left big) big @@ -831,9 +831,9 @@ (#.Right small) (/jump.lift small))) -(exception: #export invalid-tableswitch) +(exception: #export invalid_tableswitch) -(def: #export (tableswitch minimum default [at-minimum afterwards]) +(def: #export (tableswitch minimum default [at_minimum afterwards]) (-> S4 Label [Label (List Label)] (Bytecode Any)) (let [[estimator bytecode] _.tableswitch] (function (_ [pool environment tracker]) @@ -841,36 +841,36 @@ [environment' (|> environment (/environment.consumes $1)) actual (/environment.stack environment') - program-counter' (step (estimator (list.size afterwards)) (get@ #program-counter tracker))] - (wrap (let [@from (get@ #program-counter tracker)] + program_counter' (step (estimator (list.size afterwards)) (get@ #program_counter tracker))] + (wrap (let [@from (get@ #program_counter tracker)] [[pool environment' - (|> (list\fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards)) - (set@ #program-counter program-counter'))] + (|> (list\fold (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) + (set@ #program_counter program_counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] (case (do {! maybe.monad} [@default (|> default get (monad.bind ! product.right)) - @at-minimum (|> at-minimum get (monad.bind ! product.right)) + @at_minimum (|> at_minimum get (monad.bind ! product.right)) @afterwards (|> afterwards (monad.map ! get) (monad.bind ! (monad.map ! product.right)))] - (wrap [@default @at-minimum @afterwards])) - (#.Some [@default @at-minimum @afterwards]) + (wrap [@default @at_minimum @afterwards])) + (#.Some [@default @at_minimum @afterwards]) (do {! try.monad} - [>default (\ ! map ..big-jump (..jump @from @default)) - >at-minimum (\ ! map ..big-jump (..jump @from @at-minimum)) - >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big-jump)) + [>default (\ ! map ..big_jump (..jump @from @default)) + >at_minimum (\ ! map ..big_jump (..jump @from @at_minimum)) + >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump)) @afterwards)] - (wrap [..no-exceptions (bytecode minimum >default [>at-minimum >afterwards])])) + (wrap [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) #.None - (exception.throw ..invalid-tableswitch [])))) + (exception.throw ..invalid_tableswitch [])))) []]])))))) -(exception: #export invalid-lookupswitch) +(exception: #export invalid_lookupswitch) (def: #export (lookupswitch default cases) (-> Label (List [S4 Label]) (Bytecode Any)) @@ -884,12 +884,12 @@ [environment' (|> environment (/environment.consumes $1)) actual (/environment.stack environment') - program-counter' (step (estimator (list.size cases)) (get@ #program-counter tracker))] - (wrap (let [@from (get@ #program-counter tracker)] + program_counter' (step (estimator (list.size cases)) (get@ #program_counter tracker))] + (wrap (let [@from (get@ #program_counter tracker)] [[pool environment' - (|> (list\fold (..acknowledge-label actual) tracker (list& default (list\map product.right cases))) - (set@ #program-counter program-counter'))] + (|> (list\fold (..acknowledge_label actual) tracker (list& default (list\map product.right cases))) + (set@ #program_counter program_counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) @@ -902,14 +902,14 @@ (wrap [@default @cases])) (#.Some [@default @cases]) (do {! try.monad} - [>default (\ ! map ..big-jump (..jump @from @default)) + [>default (\ ! map ..big_jump (..jump @from @default)) >cases (|> @cases - (monad.map ! (|>> (..jump @from) (\ ! map ..big-jump))) + (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))) (\ ! map (|>> (list.zip/2 (list\map product.left cases)))))] - (wrap [..no-exceptions (bytecode >default >cases)])) + (wrap [..no_exceptions (bytecode >default >cases)])) #.None - (exception.throw ..invalid-lookupswitch [])))) + (exception.throw ..invalid_lookupswitch [])))) []]])))))) (def: reflection @@ -937,7 +937,7 @@ [register (..register register)] (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))) -(exception: #export (multiarray-cannot-be-zero-dimensional {class (Type Object)}) +(exception: #export (multiarray_cannot_be_zero_dimensional {class (Type Object)}) (exception.report ["Class" (..reflection class)])) (def: #export (multianewarray class dimensions) @@ -945,12 +945,12 @@ (do ..monad [_ (: (Bytecode Any) (case (|> dimensions //unsigned.value) - 0 (..throw ..multiarray-cannot-be-zero-dimensional [class]) + 0 (..throw ..multiarray_cannot_be_zero_dimensional [class]) _ (wrap []))) index (..lift (//constant/pool.class (//name.internal (..reflection class))))] (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) -(def: (type-size type) +(def: (type_size type) (-> (Type Return) Nat) (cond (is? type.void type) 0 @@ -972,11 +972,11 @@ {#//constant/pool.name method #//constant/pool.descriptor (type.descriptor type)}) #let [consumption (|> inputs - (list\map ..type-size) + (list\map ..type_size) (list\fold n.+ (if 0 1)) //unsigned.u1 try.assume) - production (|> output ..type-size //unsigned.u1 try.assume)]] + production (|> output ..type_size //unsigned.u1 try.assume)]] (..bytecode (//unsigned.lift/2 consumption) (//unsigned.lift/2 production) @_ @@ -985,7 +985,7 @@ [#1 invokestatic _.invokestatic //constant/pool.method] [#0 invokevirtual _.invokevirtual //constant/pool.method] [#0 invokespecial _.invokespecial //constant/pool.method] - [#0 invokeinterface _.invokeinterface //constant/pool.interface-method] + [#0 invokeinterface _.invokeinterface //constant/pool.interface_method] ) (template [ <1> <2>] @@ -1007,7 +1007,7 @@ [$2 putfield _.putfield/1 _.putfield/2] ) -(exception: #export (invalid-range-for-try {start Address} {end Address}) +(exception: #export (invalid_range_for_try {start Address} {end Address}) (exception.report ["Start" (|> start /address.value //unsigned.value %.nat)] ["End" (|> end /address.value //unsigned.value %.nat)])) @@ -1020,15 +1020,15 @@ (#try.Success [[pool environment - (..acknowledge-label /stack.catch @handler tracker)] + (..acknowledge_label /stack.catch @handler tracker)] [(function (_ resolver) (do try.monad - [[_ @start] (..resolve-label @start resolver) - [_ @end] (..resolve-label @end resolver) + [[_ @start] (..resolve_label @start resolver) + [_ @end] (..resolve_label @end resolver) _ (if (/address.after? @start @end) (wrap []) - (exception.throw ..invalid-range-for-try [@start @end])) - [_ @handler] (..resolve-label @handler resolver)] + (exception.throw ..invalid_range_for_try [@start @end])) + [_ @handler] (..resolve_label @handler resolver)] (wrap [(row.row {#//exception.start @start #//exception.end @end #//exception.handler @handler diff --git a/stdlib/source/lux/target/jvm/bytecode/address.lux b/stdlib/source/lux/target/jvm/bytecode/address.lux index 9f003db8d..6a16ab5cd 100644 --- a/stdlib/source/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/lux/target/jvm/bytecode/address.lux @@ -15,7 +15,7 @@ [type abstract]] ["." // #_ - [jump (#+ Big-Jump)] + [jump (#+ Big_Jump)] ["/#" // #_ [encoding ["#." unsigned (#+ U2)] @@ -38,15 +38,15 @@ (///unsigned.+/2 distance) (\ try.functor map (|>> :abstraction)))) - (def: with-sign + (def: with_sign (-> Address (Try S4)) (|>> :representation ///unsigned.value .int ///signed.s4)) (def: #export (jump from to) - (-> Address Address (Try Big-Jump)) + (-> Address Address (Try Big_Jump)) (do try.monad - [from (with-sign from) - to (with-sign to)] + [from (with_sign from) + to (with_sign to)] (///signed.-/4 from to))) (def: #export (after? reference subject) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment.lux b/stdlib/source/lux/target/jvm/bytecode/environment.lux index 7d70bdd81..932fe0e28 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment.lux @@ -61,7 +61,7 @@ (-> Environment Environment) (set@ #..stack #.None)) -(exception: #export (mismatched-stacks {expected Stack} +(exception: #export (mismatched_stacks {expected Stack} {actual Stack}) (exception.report ["Expected" (/stack.format expected)] @@ -73,7 +73,7 @@ (#.Some actual) (if (\ /stack.equivalence = expected actual) (#try.Success [actual environment]) - (exception.throw ..mismatched-stacks [expected actual])) + (exception.throw ..mismatched_stacks [expected actual])) #.None (#try.Success [expected (set@ #..stack (#.Some expected) environment)]))) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux index a0b8b67ab..802b99320 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -81,7 +81,7 @@ :abstraction)))] [for ..normal] - [for-wide ..wide] + [for_wide ..wide] ) ) diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index f72314163..91bba4ec3 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -21,7 +21,7 @@ abstract]] ["." // #_ ["#." address (#+ Address)] - ["#." jump (#+ Jump Big-Jump)] + ["#." jump (#+ Jump Big_Jump)] [environment [limit [registry (#+ Register)]]] @@ -52,50 +52,50 @@ (def: #export run (-> Instruction Specification) - (function.apply format.no-op)) + (function.apply format.no_op)) (type: Opcode Nat) (template [ ] [(def: Size (|> ///unsigned.u2 try.assume))] - [opcode-size 1] - [register-size 1] - [byte-size 1] - [index-size 2] - [big-jump-size 4] - [integer-size 4] + [opcode_size 1] + [register_size 1] + [byte_size 1] + [index_size 2] + [big_jump_size 4] + [integer_size 4] ) (def: (nullary' opcode) (-> Opcode Mutation) (function (_ [offset binary]) - [(n.+ (///unsigned.value ..opcode-size) + [(n.+ (///unsigned.value ..opcode_size) offset) (try.assume (binary.write/8 offset opcode binary))])) (def: nullary [Estimator (-> Opcode Instruction)] - [(..fixed ..opcode-size) + [(..fixed ..opcode_size) (function (_ opcode [size mutation]) - [(n.+ (///unsigned.value ..opcode-size) + [(n.+ (///unsigned.value ..opcode_size) size) (|>> mutation ((nullary' opcode)))])]) (template [ ] [(def: Size - (|> ..opcode-size + (|> ..opcode_size (///unsigned.+/2 ) try.assume))] - [size/1 ..register-size] - [size/2 ..index-size] - [size/4 ..big-jump-size] + [size/1 ..register_size] + [size/2 ..index_size] + [size/4 ..big_jump_size] ) (template [ ] - [(with-expansions [ (template.identifier ["'" ])] + [(with_expansions [ (template.identifier ["'" ])] (def: ( opcode input0) (-> Opcode Mutation) (function (_ [offset binary]) @@ -103,7 +103,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary)] - ( (n.+ (///unsigned.value ..opcode-size) offset) + ( (n.+ (///unsigned.value ..opcode_size) offset) ( input0) binary)))])) @@ -117,11 +117,11 @@ [..size/1 unary/1 U1 binary.write/8 ///unsigned.value] [..size/2 unary/2 U2 binary.write/16 ///unsigned.value] [..size/2 jump/2 Jump binary.write/16 ///signed.value] - [..size/4 jump/4 Big-Jump binary.write/32 ///signed.value] + [..size/4 jump/4 Big_Jump binary.write/32 ///signed.value] ) (template [ ] - [(with-expansions [ (template.identifier ["'" ])] + [(with_expansions [ (template.identifier ["'" ])] (def: ( opcode input0) (-> Opcode Mutation) (function (_ [offset binary]) @@ -129,7 +129,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary)] - ( (n.+ (///unsigned.value ..opcode-size) offset) + ( (n.+ (///unsigned.value ..opcode_size) offset) (///signed.value input0) binary)))])) @@ -146,9 +146,9 @@ (def: size/11 Size - (|> ..opcode-size - (///unsigned.+/2 ..register-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..register_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (binary/11' opcode input0 input1) (-> Opcode U1 U1 Mutation) @@ -157,7 +157,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/8 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/8 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary)] (binary.write/8 (n.+ (///unsigned.value ..size/1) offset) @@ -173,9 +173,9 @@ (def: size/21 Size - (|> ..opcode-size - (///unsigned.+/2 ..index-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..index_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (binary/21' opcode input0 input1) (-> Opcode U2 U1 Mutation) @@ -184,7 +184,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/16 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary)] (binary.write/8 (n.+ (///unsigned.value ..size/2) offset) @@ -200,10 +200,10 @@ (def: size/211 Size - (|> ..opcode-size - (///unsigned.+/2 ..index-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..index_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (trinary/211' opcode input0 input1 input2) (-> Opcode U2 U1 U1 Mutation) @@ -212,7 +212,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/16 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary) _ (binary.write/8 (n.+ (///unsigned.value ..size/2) offset) @@ -229,50 +229,50 @@ [(n.+ (///unsigned.value ..size/211) size) (|>> mutation ((trinary/211' opcode input0 input1 input2)))])]) -(abstract: #export Primitive-Array-Type +(abstract: #export Primitive_Array_Type U1 (def: code - (-> Primitive-Array-Type U1) + (-> Primitive_Array_Type U1) (|>> :representation)) (template [ ] [(def: #export (|> ///unsigned.u1 try.assume :abstraction))] - [04 t-boolean] - [05 t-char] - [06 t-float] - [07 t-double] - [08 t-byte] - [09 t-short] - [10 t-int] - [11 t-long] + [04 t_boolean] + [05 t_char] + [06 t_float] + [07 t_double] + [08 t_byte] + [09 t_short] + [10 t_int] + [11 t_long] )) ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 -(with-expansions [ (template [ ] +(with_expansions [ (template [ ] [[ [] []]] - ["01" aconst-null] + ["01" aconst_null] - ["02" iconst-m1] - ["03" iconst-0] - ["04" iconst-1] - ["05" iconst-2] - ["06" iconst-3] - ["07" iconst-4] - ["08" iconst-5] + ["02" iconst_m1] + ["03" iconst_0] + ["04" iconst_1] + ["05" iconst_2] + ["06" iconst_3] + ["07" iconst_4] + ["08" iconst_5] - ["09" lconst-0] - ["0A" lconst-1] + ["09" lconst_0] + ["0A" lconst_1] - ["0B" fconst-0] - ["0C" fconst-1] - ["0D" fconst-2] + ["0B" fconst_0] + ["0C" fconst_1] + ["0D" fconst_2] - ["0E" dconst-0] - ["0F" dconst-1]) - (template [ ] + ["0E" dconst_0] + ["0F" dconst_1]) + (template [ ] [[ [[register Register]] [register]]] ["15" iload] @@ -280,34 +280,34 @@ ["17" fload] ["18" dload] ["19" aload]) - (template [ ] + (template [ ] [[ [] []]] - ["1A" iload-0] - ["1B" iload-1] - ["1C" iload-2] - ["1D" iload-3] + ["1A" iload_0] + ["1B" iload_1] + ["1C" iload_2] + ["1D" iload_3] - ["1E" lload-0] - ["1F" lload-1] - ["20" lload-2] - ["21" lload-3] + ["1E" lload_0] + ["1F" lload_1] + ["20" lload_2] + ["21" lload_3] - ["22" fload-0] - ["23" fload-1] - ["24" fload-2] - ["25" fload-3] + ["22" fload_0] + ["23" fload_1] + ["24" fload_2] + ["25" fload_3] - ["26" dload-0] - ["27" dload-1] - ["28" dload-2] - ["29" dload-3] + ["26" dload_0] + ["27" dload_1] + ["28" dload_2] + ["29" dload_3] - ["2A" aload-0] - ["2B" aload-1] - ["2C" aload-2] - ["2D" aload-3]) - (template [ ] + ["2A" aload_0] + ["2B" aload_1] + ["2C" aload_2] + ["2D" aload_3]) + (template [ ] [[ [[register Register]] [register]]] ["36" istore] @@ -315,34 +315,34 @@ ["38" fstore] ["39" dstore] ["3A" astore]) - (template [ ] + (template [ ] [[ [] []]] - ["3B" istore-0] - ["3C" istore-1] - ["3D" istore-2] - ["3E" istore-3] - - ["3F" lstore-0] - ["40" lstore-1] - ["41" lstore-2] - ["42" lstore-3] - - ["43" fstore-0] - ["44" fstore-1] - ["45" fstore-2] - ["46" fstore-3] - - ["47" dstore-0] - ["48" dstore-1] - ["49" dstore-2] - ["4A" dstore-3] + ["3B" istore_0] + ["3C" istore_1] + ["3D" istore_2] + ["3E" istore_3] + + ["3F" lstore_0] + ["40" lstore_1] + ["41" lstore_2] + ["42" lstore_3] + + ["43" fstore_0] + ["44" fstore_1] + ["45" fstore_2] + ["46" fstore_3] + + ["47" dstore_0] + ["48" dstore_1] + ["49" dstore_2] + ["4A" dstore_3] - ["4B" astore-0] - ["4C" astore-1] - ["4D" astore-2] - ["4E" astore-3]) - (template [ ] + ["4B" astore_0] + ["4C" astore_1] + ["4D" astore_2] + ["4E" astore_3]) + (template [ ] [[ [] []]] ["2E" iaload] @@ -353,7 +353,7 @@ ["33" baload] ["34" caload] ["35" saload]) - (template [ ] + (template [ ] [[ [] []]] ["4f" iastore] @@ -454,15 +454,15 @@ ["9D" ifgt] ["9E" ifle] - ["9F" if-icmpeq] - ["A0" if-icmpne] - ["A1" if-icmplt] - ["A2" if-icmpge] - ["A3" if-icmpgt] - ["A4" if-icmple] + ["9F" if_icmpeq] + ["A0" if_icmpne] + ["A1" if_icmplt] + ["A2" if_icmpge] + ["A3" if_icmpgt] + ["A4" if_icmple] - ["A5" if-acmpeq] - ["A6" if-acmpne] + ["A5" if_acmpeq] + ["A6" if_acmpne] ["A7" goto] ["A8" jsr] @@ -477,23 +477,23 @@ ["B4" getfield/1] ["B4" getfield/2] ["B5" putfield/1] ["B5" putfield/2])] (template [ ] - [(with-expansions [' (template.splice )] - (template [ ] - [(with-expansions [' (template.splice ) - (template [ ] - [] + [(with_expansions [' (template.splice )] + (template [ ] + [(with_expansions [' (template.splice ) + (template [ ] + [] ') - (template [ ] - [] + (template [ ] + [] ')] (def: #export - [Estimator (-> [] Instruction)] + [Estimator (-> [] Instruction)] (let [[estimator '] ] [estimator - (function (_ []) - (`` (' (hex ) (~~ (template.splice )))))])))] + (function (_ []) + (`` (' (hex ) (~~ (template.splice )))))])))] ' ))] @@ -504,16 +504,16 @@ ["57" pop [] []] ["58" pop2 [] []] ["59" dup [] []] - ["5A" dup-x1 [] []] - ["5B" dup-x2 [] []] + ["5A" dup_x1 [] []] + ["5B" dup_x2 [] []] ["5C" dup2 [] []] - ["5D" dup2-x1 [] []] - ["5E" dup2-x2 [] []] + ["5D" dup2_x1 [] []] + ["5E" dup2_x2 [] []] ["5F" swap [] []] - - - - + + + + ["79" lshl [] []] ["7B" lshr [] []] @@ -528,28 +528,28 @@ [..unary/1 [["12" ldc [[index U1]] [index]] - - + + ["A9" ret [[register Register]] [register]] - ["BC" newarray [[type Primitive-Array-Type]] [(..code type)]]]] + ["BC" newarray [[type Primitive_Array_Type]] [(..code type)]]]] [..unary/1' [["10" bipush [[byte S1]] [byte]]]] [..unary/2 - [["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] - ["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.value index)]] - ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.value index)]] - ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.value index)]] - ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.value index)]] + [["13" ldc_w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] + ["13" ldc_w/float [[index (Index ///constant.Float)]] [(///index.value index)]] + ["13" ldc_w/string [[index (Index ///constant.String)]] [(///index.value index)]] + ["14" ldc2_w/long [[index (Index ///constant.Long)]] [(///index.value index)]] + ["14" ldc2_w/double [[index (Index ///constant.Double)]] [(///index.value index)]] ["BB" new [[index (Index Class)]] [(///index.value index)]] ["BD" anewarray [[index (Index Class)]] [(///index.value index)]] ["C0" checkcast [[index (Index Class)]] [(///index.value index)]] ["C1" instanceof [[index (Index Class)]] [(///index.value index)]] - ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] - ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] - ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]]]] + ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]] + ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]] + ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]]]] [..unary/2' [["11" sipush [[short S2]] [short]]]] @@ -558,8 +558,8 @@ []] [..jump/4 - [["C8" goto-w [[jump Big-Jump]] [jump]] - ["C9" jsr-w [[jump Big-Jump]] [jump]]]] + [["C8" goto_w [[jump Big_Jump]] [jump]] + ["C9" jsr_w [[jump Big_Jump]] [jump]]]] [..binary/11 [["84" iinc [[register Register] [byte U1]] [register byte]]]] @@ -568,52 +568,52 @@ [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.value index) count]]]] [..trinary/211 - [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]] + [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]] )) -(def: (switch-padding offset) +(def: (switch_padding offset) (-> Nat Nat) - (let [parameter-start (n.+ (///unsigned.value ..opcode-size) + (let [parameter_start (n.+ (///unsigned.value ..opcode_size) offset)] (n.% 4 - (n.- (n.% 4 parameter-start) + (n.- (n.% 4 parameter_start) 4)))) (def: #export tableswitch [(-> Nat Estimator) - (-> S4 Big-Jump [Big-Jump (List Big-Jump)] Instruction)] + (-> S4 Big_Jump [Big_Jump (List Big_Jump)] Instruction)] (let [estimator (: (-> Nat Estimator) - (function (_ amount-of-afterwards offset) + (function (_ amount_of_afterwards offset) (|> ($_ n.+ - (///unsigned.value ..opcode-size) - (switch-padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big-jump-size) - (///unsigned.value ..integer-size) - (///unsigned.value ..integer-size) - (n.* (///unsigned.value ..big-jump-size) - (inc amount-of-afterwards))) + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (///unsigned.value ..integer_size) + (n.* (///unsigned.value ..big_jump_size) + (inc amount_of_afterwards))) ///unsigned.u2 try.assume)))] [estimator - (function (_ minimum default [at-minimum afterwards]) - (let [amount-of-afterwards (list.size afterwards) - estimator (estimator amount-of-afterwards)] + (function (_ minimum default [at_minimum afterwards]) + (let [amount_of_afterwards (list.size afterwards) + estimator (estimator amount_of_afterwards)] (function (_ [size mutation]) - (let [padding (switch-padding size) - tableswitch-size (try.assume + (let [padding (switch_padding size) + tableswitch_size (try.assume (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) - tableswitch-mutation (: Mutation + tableswitch_mutation (: Mutation (function (_ [offset binary]) - [(n.+ tableswitch-size offset) + [(n.+ tableswitch_size offset) (try.assume (do {! try.monad} - [amount-of-afterwards (|> amount-of-afterwards .int ///signed.s4) - maximum (///signed.+/4 minimum amount-of-afterwards) + [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) + maximum (///signed.+/4 minimum amount_of_afterwards) _ (binary.write/8 offset (hex "AA") binary) - #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] + #let [offset (n.+ (///unsigned.value ..opcode_size) offset)] _ (case padding 3 (do ! [_ (binary.write/8 offset 0 binary)] @@ -623,13 +623,13 @@ _ (wrap binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) - #let [offset (n.+ (///unsigned.value ..big-jump-size) offset)] + #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] _ (binary.write/32 offset (///signed.value minimum) binary) - #let [offset (n.+ (///unsigned.value ..integer-size) offset)] + #let [offset (n.+ (///unsigned.value ..integer_size) offset)] _ (binary.write/32 offset (///signed.value maximum) binary)] - (loop [offset (n.+ (///unsigned.value ..integer-size) offset) - afterwards (: (List Big-Jump) - (#.Cons at-minimum afterwards))] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + afterwards (: (List Big_Jump) + (#.Cons at_minimum afterwards))] (case afterwards #.Nil (wrap binary) @@ -637,45 +637,45 @@ (#.Cons head tail) (do ! [_ (binary.write/32 offset (///signed.value head) binary)] - (recur (n.+ (///unsigned.value ..big-jump-size) offset) + (recur (n.+ (///unsigned.value ..big_jump_size) offset) tail))))))]))] - [(n.+ tableswitch-size + [(n.+ tableswitch_size size) - (|>> mutation tableswitch-mutation)]))))])) + (|>> mutation tableswitch_mutation)]))))])) (def: #export lookupswitch [(-> Nat Estimator) - (-> Big-Jump (List [S4 Big-Jump]) Instruction)] - (let [case-size (n.+ (///unsigned.value ..integer-size) - (///unsigned.value ..big-jump-size)) + (-> Big_Jump (List [S4 Big_Jump]) Instruction)] + (let [case_size (n.+ (///unsigned.value ..integer_size) + (///unsigned.value ..big_jump_size)) estimator (: (-> Nat Estimator) - (function (_ amount-of-cases offset) + (function (_ amount_of_cases offset) (|> ($_ n.+ - (///unsigned.value ..opcode-size) - (switch-padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big-jump-size) - (///unsigned.value ..integer-size) - (n.* amount-of-cases case-size)) + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (n.* amount_of_cases case_size)) ///unsigned.u2 try.assume)))] [estimator (function (_ default cases) - (let [amount-of-cases (list.size cases) - estimator (estimator amount-of-cases)] + (let [amount_of_cases (list.size cases) + estimator (estimator amount_of_cases)] (function (_ [size mutation]) - (let [padding (switch-padding size) - lookupswitch-size (try.assume + (let [padding (switch_padding size) + lookupswitch_size (try.assume (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) - lookupswitch-mutation (: Mutation + lookupswitch_mutation (: Mutation (function (_ [offset binary]) - [(n.+ lookupswitch-size offset) + [(n.+ lookupswitch_size offset) (try.assume (do {! try.monad} [_ (binary.write/8 offset (hex "AB") binary) - #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] + #let [offset (n.+ (///unsigned.value ..opcode_size) offset)] _ (case padding 3 (do ! [_ (binary.write/8 offset 0 binary)] @@ -685,9 +685,9 @@ _ (wrap binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) - #let [offset (n.+ (///unsigned.value ..big-jump-size) offset)] - _ (binary.write/32 offset amount-of-cases binary)] - (loop [offset (n.+ (///unsigned.value ..integer-size) offset) + #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] + _ (binary.write/32 offset amount_of_cases binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) cases cases] (case cases #.Nil @@ -696,12 +696,12 @@ (#.Cons [value jump] tail) (do ! [_ (binary.write/32 offset (///signed.value value) binary) - _ (binary.write/32 (n.+ (///unsigned.value ..integer-size) offset) (///signed.value jump) binary)] - (recur (n.+ case-size offset) + _ (binary.write/32 (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary)] + (recur (n.+ case_size offset) tail))))))]))] - [(n.+ lookupswitch-size + [(n.+ lookupswitch_size size) - (|>> mutation lookupswitch-mutation)]))))])) + (|>> mutation lookupswitch_mutation)]))))])) (structure: #export monoid (Monoid Instruction) diff --git a/stdlib/source/lux/target/jvm/bytecode/jump.lux b/stdlib/source/lux/target/jvm/bytecode/jump.lux index 79ec9fa9b..4670b07ea 100644 --- a/stdlib/source/lux/target/jvm/bytecode/jump.lux +++ b/stdlib/source/lux/target/jvm/bytecode/jump.lux @@ -19,8 +19,8 @@ (Writer Jump) ///signed.writer/2) -(type: #export Big-Jump S4) +(type: #export Big_Jump S4) (def: #export lift - (-> Jump Big-Jump) + (-> Jump Big_Jump) ///signed.lift/4) diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index 27eded008..ad90c3db5 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -28,9 +28,9 @@ (type: #export #rec Class {#magic Magic - #minor-version Minor - #major-version Major - #constant-pool Pool + #minor_version Minor + #major_version Major + #constant_pool Pool #modifier (Modifier Class) #this (Index //constant.Class) #super (Index //constant.Class) @@ -65,7 +65,7 @@ (row.equivalence //method.equivalence) (row.equivalence //attribute.equivalence))) -(def: (install-classes this super interfaces) +(def: (install_classes this super interfaces) (-> Internal Internal (List Internal) (Resource [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))])) (do {! //constant/pool.monad} @@ -93,20 +93,20 @@ [[pool [@this @super @interfaces] =fields =methods] (<| (state.run' //constant/pool.empty) (do //constant/pool.monad - [classes (install-classes this super interfaces) + [classes (install_classes this super interfaces) =fields (monad.seq //constant/pool.monad fields) =methods (monad.seq //constant/pool.monad methods)] (wrap [classes =fields =methods])))] (wrap {#magic //magic.code - #minor-version //version.default-minor - #major-version version - #constant-pool pool + #minor_version //version.default_minor + #major_version version + #constant_pool pool #modifier modifier #this @this #super @super #interfaces @interfaces - #fields (row.from-list =fields) - #methods (row.from-list =methods) + #fields (row.from_list =fields) + #methods (row.from_list =methods) #attributes attributes}))) (def: #export (writer class) @@ -116,9 +116,9 @@ [( (get@ class))] [//magic.writer #magic] - [//version.writer #minor-version] - [//version.writer #major-version] - [//constant/pool.writer #constant-pool] + [//version.writer #minor_version] + [//version.writer #major_version] + [//constant/pool.writer #constant_pool] [//modifier.writer #modifier] [//index.writer #this] [//index.writer #super])) diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index e8f369492..6b953e008 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -34,7 +34,7 @@ (type: #export UTF8 Text) -(def: utf8-writer +(def: utf8_writer (Writer UTF8) binaryF.utf8/16) @@ -49,13 +49,13 @@ (-> (Index UTF8) Class) (|>> :abstraction)) - (def: #export class-equivalence + (def: #export class_equivalence (Equivalence Class) (\ equivalence.functor map ..index //index.equivalence)) - (def: class-writer + (def: class_writer (Writer Class) (|>> :representation //index.writer)) ) @@ -64,7 +64,7 @@ ["#::." (#static floatToRawIntBits #manual [float] int)]) -(structure: #export float-equivalence +(structure: #export float_equivalence (Equivalence java/lang/Float) (def: (= parameter subject) @@ -87,7 +87,7 @@ (All [kind] (-> (Value kind) kind)) (|>> :representation)) - (def: #export (value-equivalence Equivalence) + (def: #export (value_equivalence Equivalence) (All [kind] (-> (Equivalence kind) (Equivalence (Value kind)))) @@ -109,28 +109,28 @@ [string String (Index UTF8)] ) - (template [ ] - [(def: + (template [ ] + [(def: (Writer ) (`` (|>> :representation (~~ (template.splice )) (~~ (template.splice )))))] - [integer-writer Integer [] [binaryF.bits/32]] - [float-writer Float [java/lang/Float::floatToRawIntBits host.int-to-long (:coerce I64)] [i32.i32 binaryF.bits/32]] - [long-writer Long [] [binaryF.bits/64]] - [double-writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] - [string-writer String [] [//index.writer]] + [integer_writer Integer [] [binaryF.bits/32]] + [float_writer Float [java/lang/Float::floatToRawIntBits host.int_to_long (:coerce I64)] [i32.i32 binaryF.bits/32]] + [long_writer Long [] [binaryF.bits/64]] + [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] + [string_writer String [] [//index.writer]] ) ) -(type: #export (Name-And-Type of) +(type: #export (Name_And_Type of) {#name (Index UTF8) #descriptor (Index (Descriptor of))}) (type: #export (Reference of) {#class (Index Class) - #name-and-type (Index (Name-And-Type of))}) + #name_and_type (Index (Name_And_Type of))}) (template [ ] [(def: #export @@ -145,8 +145,8 @@ //index.writer //index.writer))] - [Name-And-Type name-and-type-equivalence name-and-type-writer] - [Reference reference-equivalence reference-writer] + [Name_And_Type name_and_type_equivalence name_and_type_writer] + [Reference reference_equivalence reference_writer] ) (type: #export Constant @@ -159,8 +159,8 @@ (#String String) (#Field (Reference //category.Value)) (#Method (Reference //category.Method)) - (#Interface-Method (Reference //category.Method)) - (#Name-And-Type (Name-And-Type Any))) + (#Interface_Method (Reference //category.Method)) + (#Name_And_Type (Name_And_Type Any))) (def: #export (size constant) (-> Constant Nat) @@ -182,16 +182,16 @@ [[( reference) ( sample)] (\ = reference sample)]) ([#UTF8 text.equivalence] - [#Integer (..value-equivalence i32.equivalence)] - [#Long (..value-equivalence int.equivalence)] - [#Float (..value-equivalence float-equivalence)] - [#Double (..value-equivalence frac.equivalence)] - [#Class ..class-equivalence] - [#String (..value-equivalence //index.equivalence)] - [#Field ..reference-equivalence] - [#Method ..reference-equivalence] - [#Interface-Method ..reference-equivalence] - [#Name-And-Type ..name-and-type-equivalence]) + [#Integer (..value_equivalence i32.equivalence)] + [#Long (..value_equivalence int.equivalence)] + [#Float (..value_equivalence float_equivalence)] + [#Double (..value_equivalence frac.equivalence)] + [#Class ..class_equivalence] + [#String (..value_equivalence //index.equivalence)] + [#Field ..reference_equivalence] + [#Method ..reference_equivalence] + [#Interface_Method ..reference_equivalence] + [#Name_And_Type ..name_and_type_equivalence]) _ false))) @@ -199,40 +199,40 @@ ## ## #UTF8 ## text.equivalence ## ## #Long - ## (..value-equivalence int.equivalence) + ## (..value_equivalence int.equivalence) ## ## #Double - ## (..value-equivalence frac.equivalence) + ## (..value_equivalence frac.equivalence) ## ## #Class - ## ..class-equivalence + ## ..class_equivalence ## ## #String - ## (..value-equivalence //index.equivalence) + ## (..value_equivalence //index.equivalence) ## ## #Field - ## ..reference-equivalence + ## ..reference_equivalence ## ## #Method - ## ..reference-equivalence - ## ## #Interface-Method - ## ..reference-equivalence - ## ## #Name-And-Type - ## ..name-and-type-equivalence + ## ..reference_equivalence + ## ## #Interface_Method + ## ..reference_equivalence + ## ## #Name_And_Type + ## ..name_and_type_equivalence ## ) ) (def: #export writer (Writer Constant) - (with-expansions [ (as-is [#UTF8 /tag.utf8 ..utf8-writer] - [#Integer /tag.integer ..integer-writer] - [#Float /tag.float ..float-writer] - [#Long /tag.long ..long-writer] - [#Double /tag.double ..double-writer] - [#Class /tag.class ..class-writer] - [#String /tag.string ..string-writer] - [#Field /tag.field ..reference-writer] - [#Method /tag.method ..reference-writer] - [#Interface-Method /tag.interface-method ..reference-writer] - [#Name-And-Type /tag.name-and-type ..name-and-type-writer] - ## TODO: Method-Handle - ## TODO: Method-Type - ## TODO: Invoke-Dynamic + (with_expansions [ (as_is [#UTF8 /tag.utf8 ..utf8_writer] + [#Integer /tag.integer ..integer_writer] + [#Float /tag.float ..float_writer] + [#Long /tag.long ..long_writer] + [#Double /tag.double ..double_writer] + [#Class /tag.class ..class_writer] + [#String /tag.string ..string_writer] + [#Field /tag.field ..reference_writer] + [#Method /tag.method ..reference_writer] + [#Interface_Method /tag.interface_method ..reference_writer] + [#Name_And_Type /tag.name_and_type ..name_and_type_writer] + ## TODO: Method_Handle + ## TODO: Method_Type + ## TODO: Invoke_Dynamic )] (function (_ value) (case value diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 2bc141e66..700c6ee85 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -23,7 +23,7 @@ abstract] [macro ["." template]]] - ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name-And-Type Reference) + ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference) [// [encoding ["#." name (#+ Internal External)] @@ -51,7 +51,7 @@ (template: (!add ) (function (_ [current pool]) (let [' ] - (with-expansions [ (as-is (recur (.inc idx)))] + (with_expansions [ (as_is (recur (.inc idx)))] (loop [idx 0] (case (row.nth idx pool) (#try.Success entry) @@ -60,10 +60,10 @@ (if (\ = reference ') (#try.Success [[current pool] index]) - ) + ) _ - ) + ) (#try.Failure _) (let [new ( ')] @@ -89,10 +89,10 @@ (Adder ) (!add value))] - [integer Integer #//.Integer (//.value-equivalence i32.equivalence)] - [float Float #//.Float (//.value-equivalence //.float-equivalence)] - [long Long #//.Long (//.value-equivalence int.equivalence)] - [double Double #//.Double (//.value-equivalence frac.equivalence)] + [integer Integer #//.Integer (//.value_equivalence i32.equivalence)] + [float Float #//.Float (//.value_equivalence //.float_equivalence)] + [long Long #//.Long (//.value_equivalence int.equivalence)] + [double Double #//.Double (//.value_equivalence frac.equivalence)] [utf8 UTF8 #//.UTF8 text.equivalence] ) @@ -101,14 +101,14 @@ (do ..monad [@value (utf8 value) #let [value (//.string @value)]] - (!add #//.String (//.value-equivalence //index.equivalence) value))) + (!add #//.String (//.value_equivalence //index.equivalence) value))) (def: #export (class name) (-> Internal (Resource (Index Class))) (do ..monad [@name (utf8 (//name.read name)) #let [value (//.class @name)]] - (!add #//.Class //.class-equivalence value))) + (!add #//.Class //.class_equivalence value))) (def: #export (descriptor value) (All [kind] @@ -121,25 +121,25 @@ {#name UTF8 #descriptor (Descriptor of)}) -(def: #export (name-and-type [name descriptor]) +(def: #export (name_and_type [name descriptor]) (All [of] - (-> (Member of) (Resource (Index (Name-And-Type of))))) + (-> (Member of) (Resource (Index (Name_And_Type of))))) (do ..monad [@name (utf8 name) @descriptor (..descriptor descriptor)] - (!add #//.Name-And-Type //.name-and-type-equivalence {#//.name @name #//.descriptor @descriptor}))) + (!add #//.Name_And_Type //.name_and_type_equivalence {#//.name @name #//.descriptor @descriptor}))) (template [ ] [(def: #export ( class member) (-> External (Member ) (Resource (Index (Reference )))) (do ..monad [@class (..class (//name.internal class)) - @name-and-type (name-and-type member)] - (!add //.reference-equivalence {#//.class @class #//.name-and-type @name-and-type})))] + @name_and_type (name_and_type member)] + (!add //.reference_equivalence {#//.class @class #//.name_and_type @name_and_type})))] [field #//.Field Value] [method #//.Method Method] - [interface-method #//.Interface-Method Method] + [interface_method #//.Interface_Method Method] ) (def: #export writer diff --git a/stdlib/source/lux/target/jvm/constant/tag.lux b/stdlib/source/lux/target/jvm/constant/tag.lux index fc2311ab9..a35ff3438 100644 --- a/stdlib/source/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/lux/target/jvm/constant/tag.lux @@ -36,11 +36,11 @@ [08 string] [09 field] [10 method] - [11 interface-method] - [12 name-and-type] - [15 method-handle] - [16 method-type] - [18 invoke-dynamic] + [11 interface_method] + [12 name_and_type] + [15 method_handle] + [16 method_type] + [18 invoke_dynamic] ) (def: #export writer diff --git a/stdlib/source/lux/target/jvm/encoding/name.lux b/stdlib/source/lux/target/jvm/encoding/name.lux index 3d0287b26..606c7439c 100644 --- a/stdlib/source/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/lux/target/jvm/encoding/name.lux @@ -6,8 +6,8 @@ [type abstract]]) -(def: #export internal-separator "/") -(def: #export external-separator ".") +(def: #export internal_separator "/") +(def: #export external_separator ".") (type: #export External Text) @@ -16,8 +16,8 @@ (def: #export internal (-> External Internal) - (|>> (text.replace-all ..external-separator - ..internal-separator) + (|>> (text.replace_all ..external_separator + ..internal_separator) :abstraction)) (def: #export read @@ -27,8 +27,8 @@ (def: #export external (-> Internal External) (|>> :representation - (text.replace-all ..internal-separator - ..external-separator)))) + (text.replace_all ..internal_separator + ..external_separator)))) (def: #export sanitize (-> Text External) @@ -36,4 +36,4 @@ (def: #export (qualify package class) (-> Text External External) - (format (..sanitize package) ..external-separator class)) + (format (..sanitize package) ..external_separator class)) diff --git a/stdlib/source/lux/target/jvm/encoding/signed.lux b/stdlib/source/lux/target/jvm/encoding/signed.lux index cef82ae7e..1cc3fe07f 100644 --- a/stdlib/source/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/lux/target/jvm/encoding/signed.lux @@ -39,14 +39,14 @@ (def: (< reference sample) (i.< (:representation reference) (:representation sample)))) - (exception: #export (value-exceeds-the-scope {value Int} + (exception: #export (value_exceeds_the_scope {value Int} {scope Nat}) (exception.report ["Value" (%.int value)] ["Scope (in bytes)" (%.nat scope)])) (template [ <+> <->] - [(with-expansions [ (template.identifier [ "'"])] + [(with_expansions [ (template.identifier [ "'"])] (abstract: #export Any) (type: #export (Signed ))) @@ -54,25 +54,25 @@ (def: #export - (|> (n.* i64.bits-per-byte) dec i64.mask :abstraction)) + (|> (n.* i64.bits_per_byte) dec i64.mask :abstraction)) (def: #export (-> Int (Try )) - (let [positive (|> (n.* i64.bits-per-byte) i64.mask .nat) - negative (|> positive (i64.arithmetic-right-shift 1) i64.not)] + (let [positive (|> (n.* i64.bits_per_byte) i64.mask .nat) + negative (|> positive (i64.arithmetic_right_shift 1) i64.not)] (function (_ value) (if (i.= (if (i.< +0 value) (i64.or negative value) (i64.and positive value)) value) (#try.Success (:abstraction value)) - (exception.throw ..value-exceeds-the-scope [value ]))))) + (exception.throw ..value_exceeds_the_scope [value ]))))) - (template [ ] - [(def: #export ( parameter subject) + (template [ ] + [(def: #export ( parameter subject) (-> (Try )) ( - ( (:representation parameter) + ( (:representation parameter) (:representation subject))))] [<+> i.+] @@ -93,8 +93,8 @@ [lift/4 S2 S4] ) - (template [ ] - [(def: #export + (template [ ] + [(def: #export (Writer ) (|>> :representation ))] diff --git a/stdlib/source/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/lux/target/jvm/encoding/unsigned.lux index 5abc79468..c145dcdab 100644 --- a/stdlib/source/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/lux/target/jvm/encoding/unsigned.lux @@ -40,7 +40,7 @@ (n.< (:representation reference) (:representation sample)))) - (exception: #export (value-exceeds-the-maximum {type Name} + (exception: #export (value_exceeds_the_maximum {type Name} {value Nat} {maximum (Unsigned Any)}) (exception.report @@ -48,7 +48,7 @@ ["Value" (%.nat value)] ["Maximum" (%.nat (:representation maximum))])) - (exception: #export [brand] (subtraction-cannot-yield-negative-value + (exception: #export [brand] (subtraction_cannot_yield_negative_value {type Name} {parameter (Unsigned brand)} {subject (Unsigned brand)}) @@ -58,7 +58,7 @@ ["Subject" (%.nat (:representation subject))])) (template [ <+> <-> ] - [(with-expansions [ (template.identifier [ "'"])] + [(with_expansions [ (template.identifier [ "'"])] (abstract: #export Any) (type: #export (Unsigned ))) @@ -66,13 +66,13 @@ (def: #export - (|> (n.* i64.bits-per-byte) i64.mask :abstraction)) + (|> (n.* i64.bits_per_byte) i64.mask :abstraction)) (def: #export ( value) (-> Nat (Try )) (if (n.<= (:representation ) value) (#try.Success (:abstraction value)) - (exception.throw ..value-exceeds-the-maximum [(name-of ) value ]))) + (exception.throw ..value_exceeds_the_maximum [(name_of ) value ]))) (def: #export (<+> parameter subject) (-> (Try )) @@ -86,7 +86,7 @@ subject' (:representation subject)] (if (n.<= subject' parameter') (#try.Success (:abstraction (n.- parameter' subject'))) - (exception.throw ..subtraction-cannot-yield-negative-value [(name-of ) parameter subject])))) + (exception.throw ..subtraction_cannot_yield_negative_value [(name_of ) parameter subject])))) (def: #export ( left right) (-> ) @@ -107,8 +107,8 @@ [lift/4 U2 U4] ) - (template [ ] - [(def: #export + (template [ ] + [(def: #export (Writer ) (|>> :representation ))] diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index 8f9f47e4f..acda83ca9 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -16,21 +16,21 @@ [collection ["." array] ["." dictionary (#+ Dictionary)]]] - ["." host (#+ import: object do-to)]]) + ["." host (#+ import: object do_to)]]) (type: #export Library (Atom (Dictionary Text Binary))) -(exception: #export (already-stored {class Text}) +(exception: #export (already_stored {class Text}) (exception.report ["Class" class])) -(exception: #export (unknown {class Text} {known-classes (List Text)}) +(exception: #export (unknown {class Text} {known_classes (List Text)}) (exception.report ["Class" class] - ["Known classes" (exception.enumerate (|>>) known-classes)])) + ["Known classes" (exception.enumerate (|>>) known_classes)])) -(exception: #export (cannot-define {class Text} {error Text}) +(exception: #export (cannot_define {class Text} {error Text}) (exception.report ["Class" class] ["Error" error])) @@ -62,46 +62,46 @@ (loadClass [java/lang/String] #io #try (java/lang/Class java/lang/Object))]) -(with-expansions [ (as-is (java/lang/Class java/lang/Object))] +(with_expansions [ (as_is (java/lang/Class java/lang/Object))] (def: java/lang/ClassLoader::defineClass java/lang/reflect/Method (let [signature (|> (host.array 4) - (host.array-write 0 (:coerce - (host.class-for java/lang/String))) - (host.array-write 1 (java/lang/Object::getClass (host.array byte 0))) - (host.array-write 2 (:coerce + (host.array_write 0 (:coerce + (host.class_for java/lang/String))) + (host.array_write 1 (java/lang/Object::getClass (host.array byte 0))) + (host.array_write 2 (:coerce (java/lang/Integer::TYPE))) - (host.array-write 3 (:coerce + (host.array_write 3 (:coerce (java/lang/Integer::TYPE))))] - (do-to (java/lang/Class::getDeclaredMethod "defineClass" + (do_to (java/lang/Class::getDeclaredMethod "defineClass" signature - (host.class-for java/lang/ClassLoader)) + (host.class_for java/lang/ClassLoader)) (java/lang/reflect/AccessibleObject::setAccessible true))))) -(def: #export (define class-name bytecode loader) +(def: #export (define class_name bytecode loader) (-> Text Binary java/lang/ClassLoader (Try java/lang/Object)) - (let [signature (array.from-list (list (:coerce java/lang/Object - class-name) + (let [signature (array.from_list (list (:coerce java/lang/Object + class_name) (:coerce java/lang/Object bytecode) (:coerce java/lang/Object (|> 0 (:coerce (primitive "java.lang.Long")) - host.long-to-int)) + host.long_to_int)) (:coerce java/lang/Object (|> bytecode binary.size (:coerce (primitive "java.lang.Long")) - host.long-to-int))))] + host.long_to_int))))] (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass))) -(def: #export (new-library _) +(def: #export (new_library _) (-> Any Library) (atom.atom (dictionary.new text.hash))) (def: #export (memory library) (-> Library java/lang/ClassLoader) - (with-expansions [ (for {@.old + (with_expansions [ (for {@.old (<|) @.jvm @@ -109,29 +109,29 @@ (<| (object [] java/lang/ClassLoader [] [] - (java/lang/ClassLoader (findClass self {class-name java/lang/String}) + (java/lang/ClassLoader (findClass self {class_name java/lang/String}) (java/lang/Class [? < java/lang/Object]) #throws [java/lang/ClassNotFoundException] - (let [class-name (:coerce Text class-name) + (let [class_name (:coerce Text class_name) classes (|> library atom.read io.run)] - (case (dictionary.get class-name classes) + (case (dictionary.get class_name classes) (#.Some bytecode) - (case (..define class-name bytecode (<| self)) + (case (..define class_name bytecode (<| self)) (#try.Success class) (:assume class) (#try.Failure error) - (error! (exception.construct ..cannot-define [class-name error]))) + (error! (exception.construct ..cannot_define [class_name error]))) #.None - (error! (exception.construct ..unknown [class-name (dictionary.keys classes)]))))))))) + (error! (exception.construct ..unknown [class_name (dictionary.keys classes)]))))))))) (def: #export (store name bytecode library) (-> Text Binary Library (IO (Try Any))) (do {! io.monad} [library' (atom.read library)] (if (dictionary.key? library' name) - (wrap (exception.throw ..already-stored name)) + (wrap (exception.throw ..already_stored name)) (do ! [_ (atom.update (dictionary.put name bytecode) library)] (wrap (#try.Success [])))))) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index d084d26ee..6219a1c1d 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -39,7 +39,7 @@ ["0010" final] ["0020" synchronized] ["0040" bridge] - ["0080" var-args] + ["0080" var_args] ["0100" native] ["0400" abstract] ["0800" strict] @@ -54,7 +54,7 @@ @descriptor (//constant/pool.descriptor (//type.descriptor type)) attributes (|> attributes (monad.seq !) - (\ ! map row.from-list)) + (\ ! map row.from_list)) attributes (case code (#.Some code) (do ! @@ -70,7 +70,7 @@ #let [bytecode (|> instruction //bytecode/instruction.run format.instance)] @code (//attribute.code {#//attribute/code.limit (get@ #//bytecode/environment.limit environment) #//attribute/code.code bytecode - #//attribute/code.exception-table exceptions + #//attribute/code.exception_table exceptions #//attribute/code.attributes (row.row)})] (wrap (row.add @code attributes))) diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index 1434a95a4..6037ab372 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -14,7 +14,7 @@ [".F" binary (#+ Writer)]]] [type abstract] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]] @@ -77,7 +77,7 @@ ) (syntax: #export (modifiers: ofT {options (<>.many .any)}) - (with-gensyms [g!modifier g!code] + (with_gensyms [g!modifier g!code] (wrap (list (` (template [(~ g!code) (~ g!modifier)] [(def: (~' #export) (~ g!modifier) (..Modifier (~ ofT)) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index fbddbac7d..17456f011 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -33,8 +33,8 @@ (type: #export Constraint {#name Text - #super-class (Type Class) - #super-interfaces (List (Type Class))}) + #super_class (Type Class) + #super_interfaces (List (Type Class))}) (template [