From 065e8a4d8122d4616b570496915d2c0e2c78cd6b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 11 Aug 2022 04:15:07 -0400 Subject: Re-named the "case" macro to "when". --- stdlib/source/library/lux.lux | 376 ++++++++-------- stdlib/source/library/lux/abstract/comonad.lux | 16 +- stdlib/source/library/lux/abstract/functor.lux | 2 +- stdlib/source/library/lux/abstract/monad.lux | 28 +- stdlib/source/library/lux/abstract/monad/free.lux | 8 +- .../source/library/lux/abstract/monad/indexed.lux | 6 +- .../source/library/lux/control/concatenative.lux | 10 - .../library/lux/control/concurrency/actor.lux | 12 +- .../library/lux/control/concurrency/async.lux | 6 +- .../source/library/lux/control/concurrency/frp.lux | 26 +- .../library/lux/control/concurrency/semaphore.lux | 2 +- .../source/library/lux/control/concurrency/stm.lux | 10 +- .../library/lux/control/concurrency/thread.lux | 6 +- stdlib/source/library/lux/control/exception.lux | 12 +- .../source/library/lux/control/function/memo.lux | 2 +- .../source/library/lux/control/function/mutual.lux | 4 +- stdlib/source/library/lux/control/lazy.lux | 2 +- stdlib/source/library/lux/control/maybe.lux | 24 +- stdlib/source/library/lux/control/parser.lux | 44 +- stdlib/source/library/lux/control/pipe.lux | 16 +- stdlib/source/library/lux/control/region.lux | 12 +- stdlib/source/library/lux/control/remember.lux | 8 +- stdlib/source/library/lux/control/try.lux | 26 +- stdlib/source/library/lux/data/bit.lux | 4 +- stdlib/source/library/lux/data/collection/bits.lux | 10 +- .../library/lux/data/collection/dictionary.lux | 46 +- .../lux/data/collection/dictionary/ordered.lux | 66 +-- stdlib/source/library/lux/data/collection/list.lux | 96 ++--- .../library/lux/data/collection/list/property.lux | 10 +- .../source/library/lux/data/collection/queue.lux | 4 +- .../library/lux/data/collection/queue/priority.lux | 16 +- .../library/lux/data/collection/sequence.lux | 26 +- .../library/lux/data/collection/set/multi.lux | 6 +- .../source/library/lux/data/collection/stack.lux | 4 +- .../source/library/lux/data/collection/stream.lux | 4 +- .../library/lux/data/collection/tree/finger.lux | 10 +- .../library/lux/data/collection/tree/zipper.lux | 34 +- stdlib/source/library/lux/data/color.lux | 6 +- stdlib/source/library/lux/data/format/css.lux | 4 +- .../source/library/lux/data/format/css/value.lux | 6 +- stdlib/source/library/lux/data/format/html.lux | 20 +- stdlib/source/library/lux/data/format/json.lux | 26 +- stdlib/source/library/lux/data/format/markdown.lux | 4 +- stdlib/source/library/lux/data/format/tar.lux | 12 +- stdlib/source/library/lux/data/format/xml.lux | 10 +- stdlib/source/library/lux/data/sum.lux | 14 +- stdlib/source/library/lux/data/text.lux | 26 +- stdlib/source/library/lux/data/text/escape.lux | 16 +- stdlib/source/library/lux/data/text/regex.lux | 18 +- .../source/library/lux/data/text/unicode/set.lux | 2 +- stdlib/source/library/lux/debug.lux | 36 +- stdlib/source/library/lux/documentation.lux | 48 +-- stdlib/source/library/lux/ffi.jvm.lux | 92 ++-- stdlib/source/library/lux/ffi.lux | 32 +- stdlib/source/library/lux/ffi.old.lux | 84 ++-- stdlib/source/library/lux/ffi.php.lux | 10 +- stdlib/source/library/lux/ffi.scm.lux | 6 +- stdlib/source/library/lux/ffi/export.jvm.lux | 4 +- stdlib/source/library/lux/ffi/export.rb.lux | 4 +- stdlib/source/library/lux/math.lux | 4 +- stdlib/source/library/lux/math/infix.lux | 2 +- stdlib/source/library/lux/math/modular.lux | 2 +- stdlib/source/library/lux/math/number.lux | 6 +- stdlib/source/library/lux/math/number/complex.lux | 2 +- stdlib/source/library/lux/math/number/frac.lux | 14 +- stdlib/source/library/lux/math/number/i16.lux | 2 +- stdlib/source/library/lux/math/number/i32.lux | 2 +- stdlib/source/library/lux/math/number/i64.lux | 6 +- stdlib/source/library/lux/math/number/i8.lux | 2 +- stdlib/source/library/lux/math/number/int.lux | 8 +- stdlib/source/library/lux/math/number/nat.lux | 28 +- stdlib/source/library/lux/math/number/ratio.lux | 4 +- stdlib/source/library/lux/math/number/rev.lux | 18 +- stdlib/source/library/lux/math/random.lux | 4 +- stdlib/source/library/lux/meta.lux | 74 ++-- stdlib/source/library/lux/meta/code.lux | 6 +- .../library/lux/meta/compiler/default/init.lux | 8 +- .../library/lux/meta/compiler/default/platform.lux | 30 +- .../lux/meta/compiler/language/lux/analysis.lux | 26 +- .../compiler/language/lux/analysis/complex.lux | 6 +- .../compiler/language/lux/analysis/coverage.lux | 28 +- .../compiler/language/lux/analysis/inference.lux | 22 +- .../meta/compiler/language/lux/analysis/macro.lux | 4 +- .../meta/compiler/language/lux/analysis/module.lux | 18 +- .../compiler/language/lux/analysis/pattern.lux | 4 +- .../meta/compiler/language/lux/analysis/scope.lux | 20 +- .../meta/compiler/language/lux/analysis/simple.lux | 4 +- .../meta/compiler/language/lux/analysis/type.lux | 6 +- .../lux/meta/compiler/language/lux/generation.lux | 18 +- .../meta/compiler/language/lux/phase/analysis.lux | 20 +- .../compiler/language/lux/phase/analysis/case.lux | 364 ---------------- .../language/lux/phase/analysis/complex.lux | 46 +- .../language/lux/phase/analysis/function.lux | 8 +- .../language/lux/phase/analysis/reference.lux | 8 +- .../compiler/language/lux/phase/analysis/when.lux | 364 ++++++++++++++++ .../compiler/language/lux/phase/declaration.lux | 14 +- .../meta/compiler/language/lux/phase/extension.lux | 12 +- .../language/lux/phase/extension/analysis/jvm.lux | 142 +++---- .../language/lux/phase/extension/analysis/lux.lux | 14 +- .../lux/phase/extension/declaration/jvm.lux | 34 +- .../lux/phase/extension/declaration/lux.lux | 22 +- .../extension/generation/common_lisp/common.lux | 4 +- .../lux/phase/extension/generation/js/common.lux | 16 +- .../lux/phase/extension/generation/js/host.lux | 2 +- .../lux/phase/extension/generation/jvm/common.lux | 2 +- .../lux/phase/extension/generation/jvm/host.lux | 62 +-- .../lux/phase/extension/generation/lua/common.lux | 20 +- .../lux/phase/extension/generation/lua/host.lux | 2 +- .../lux/phase/extension/generation/php/common.lux | 8 +- .../phase/extension/generation/python/common.lux | 16 +- .../lux/phase/extension/generation/python/host.lux | 2 +- .../lux/phase/extension/generation/r/common.lux | 4 +- .../lux/phase/extension/generation/ruby/common.lux | 16 +- .../phase/extension/generation/scheme/common.lux | 4 +- .../language/lux/phase/generation/common_lisp.lux | 12 +- .../lux/phase/generation/common_lisp/case.lux | 263 ------------ .../lux/phase/generation/common_lisp/function.lux | 8 +- .../lux/phase/generation/common_lisp/loop.lux | 10 +- .../lux/phase/generation/common_lisp/runtime.lux | 2 +- .../lux/phase/generation/common_lisp/structure.lux | 2 +- .../lux/phase/generation/common_lisp/when.lux | 263 ++++++++++++ .../language/lux/phase/generation/extension.lux | 2 +- .../compiler/language/lux/phase/generation/js.lux | 16 +- .../language/lux/phase/generation/js/case.lux | 346 --------------- .../language/lux/phase/generation/js/function.lux | 8 +- .../language/lux/phase/generation/js/loop.lux | 12 +- .../language/lux/phase/generation/js/runtime.lux | 2 +- .../language/lux/phase/generation/js/structure.lux | 2 +- .../language/lux/phase/generation/js/when.lux | 346 +++++++++++++++ .../compiler/language/lux/phase/generation/jvm.lux | 18 +- .../language/lux/phase/generation/jvm/case.lux | 327 -------------- .../language/lux/phase/generation/jvm/debug.lux | 2 +- .../language/lux/phase/generation/jvm/function.lux | 4 +- .../phase/generation/jvm/function/method/apply.lux | 2 +- .../language/lux/phase/generation/jvm/host.lux | 8 +- .../language/lux/phase/generation/jvm/loop.lux | 2 +- .../lux/phase/generation/jvm/primitive.lux | 8 +- .../lux/phase/generation/jvm/reference.lux | 4 +- .../language/lux/phase/generation/jvm/runtime.lux | 16 +- .../lux/phase/generation/jvm/structure.lux | 8 +- .../language/lux/phase/generation/jvm/when.lux | 327 ++++++++++++++ .../compiler/language/lux/phase/generation/lua.lux | 16 +- .../language/lux/phase/generation/lua/case.lux | 304 ------------- .../language/lux/phase/generation/lua/function.lux | 8 +- .../language/lux/phase/generation/lua/loop.lux | 14 +- .../language/lux/phase/generation/lua/runtime.lux | 2 +- .../lux/phase/generation/lua/structure.lux | 2 +- .../language/lux/phase/generation/lua/when.lux | 304 +++++++++++++ .../compiler/language/lux/phase/generation/php.lux | 22 +- .../language/lux/phase/generation/php/case.lux | 297 ------------- .../language/lux/phase/generation/php/function.lux | 8 +- .../language/lux/phase/generation/php/loop.lux | 16 +- .../language/lux/phase/generation/php/runtime.lux | 4 +- .../lux/phase/generation/php/structure.lux | 2 +- .../language/lux/phase/generation/php/when.lux | 297 +++++++++++++ .../language/lux/phase/generation/python.lux | 14 +- .../language/lux/phase/generation/python/case.lux | 362 ---------------- .../lux/phase/generation/python/function.lux | 8 +- .../language/lux/phase/generation/python/loop.lux | 18 +- .../lux/phase/generation/python/runtime.lux | 2 +- .../lux/phase/generation/python/structure.lux | 2 +- .../language/lux/phase/generation/python/when.lux | 362 ++++++++++++++++ .../compiler/language/lux/phase/generation/r.lux | 12 +- .../language/lux/phase/generation/r/case.lux | 242 ----------- .../language/lux/phase/generation/r/function.lux | 10 +- .../language/lux/phase/generation/r/loop.lux | 8 +- .../lux/phase/generation/r/procedure/common.lux | 6 +- .../lux/phase/generation/r/procedure/host.lux | 6 +- .../language/lux/phase/generation/r/runtime.lux | 2 +- .../language/lux/phase/generation/r/structure.lux | 2 +- .../language/lux/phase/generation/r/when.lux | 242 +++++++++++ .../language/lux/phase/generation/reference.lux | 4 +- .../language/lux/phase/generation/ruby.lux | 14 +- .../language/lux/phase/generation/ruby/case.lux | 382 ----------------- .../lux/phase/generation/ruby/function.lux | 10 +- .../language/lux/phase/generation/ruby/loop.lux | 12 +- .../language/lux/phase/generation/ruby/runtime.lux | 16 +- .../lux/phase/generation/ruby/structure.lux | 2 +- .../language/lux/phase/generation/ruby/when.lux | 382 +++++++++++++++++ .../language/lux/phase/generation/scheme.lux | 12 +- .../language/lux/phase/generation/scheme/case.lux | 225 ---------- .../lux/phase/generation/scheme/function.lux | 8 +- .../language/lux/phase/generation/scheme/loop.lux | 8 +- .../lux/phase/generation/scheme/runtime.lux | 2 +- .../lux/phase/generation/scheme/structure.lux | 2 +- .../language/lux/phase/generation/scheme/when.lux | 225 ++++++++++ .../meta/compiler/language/lux/phase/synthesis.lux | 14 +- .../compiler/language/lux/phase/synthesis/case.lux | 467 -------------------- .../language/lux/phase/synthesis/function.lux | 42 +- .../compiler/language/lux/phase/synthesis/loop.lux | 22 +- .../language/lux/phase/synthesis/variable.lux | 56 +-- .../compiler/language/lux/phase/synthesis/when.lux | 471 +++++++++++++++++++++ .../lux/meta/compiler/language/lux/program.lux | 2 +- .../lux/meta/compiler/language/lux/syntax.lux | 12 +- .../lux/meta/compiler/language/lux/synthesis.lux | 64 +-- .../compiler/language/lux/synthesis/access.lux | 2 +- .../compiler/language/lux/synthesis/simple.lux | 6 +- .../library/lux/meta/compiler/meta/archive.lux | 18 +- .../compiler/meta/archive/artifact/category.lux | 2 +- .../compiler/meta/archive/module/descriptor.lux | 2 +- .../lux/meta/compiler/meta/archive/registry.lux | 8 +- .../compiler/meta/cache/dependency/artifact.lux | 26 +- .../meta/compiler/meta/cache/dependency/module.lux | 2 +- .../lux/meta/compiler/meta/cache/module.lux | 4 +- .../source/library/lux/meta/compiler/meta/cli.lux | 2 +- .../library/lux/meta/compiler/meta/import.lux | 4 +- .../library/lux/meta/compiler/meta/io/archive.lux | 12 +- .../library/lux/meta/compiler/meta/io/context.lux | 12 +- .../lux/meta/compiler/meta/packager/jvm.lux | 12 +- .../lux/meta/compiler/meta/packager/ruby.lux | 4 +- stdlib/source/library/lux/meta/compiler/phase.lux | 4 +- .../source/library/lux/meta/compiler/reference.lux | 6 +- .../lux/meta/compiler/reference/variable.lux | 8 +- stdlib/source/library/lux/meta/configuration.lux | 4 +- stdlib/source/library/lux/meta/extension.lux | 2 +- stdlib/source/library/lux/meta/location.lux | 2 +- stdlib/source/library/lux/meta/macro.lux | 8 +- stdlib/source/library/lux/meta/macro/context.lux | 8 +- stdlib/source/library/lux/meta/macro/expansion.lux | 18 +- stdlib/source/library/lux/meta/macro/local.lux | 12 +- stdlib/source/library/lux/meta/macro/pattern.lux | 44 +- stdlib/source/library/lux/meta/macro/syntax.lux | 14 +- .../library/lux/meta/macro/syntax/declaration.lux | 2 +- .../library/lux/meta/macro/syntax/definition.lux | 4 +- .../library/lux/meta/macro/syntax/export.lux | 2 +- stdlib/source/library/lux/meta/macro/template.lux | 10 +- stdlib/source/library/lux/meta/static.lux | 2 +- stdlib/source/library/lux/meta/symbol.lux | 4 +- .../source/library/lux/meta/target/common_lisp.lux | 6 +- stdlib/source/library/lux/meta/target/js.lux | 6 +- .../library/lux/meta/target/jvm/attribute.lux | 4 +- .../library/lux/meta/target/jvm/bytecode.lux | 60 +-- .../lux/meta/target/jvm/bytecode/environment.lux | 4 +- .../lux/meta/target/jvm/bytecode/instruction.lux | 8 +- .../source/library/lux/meta/target/jvm/class.lux | 4 +- .../library/lux/meta/target/jvm/constant.lux | 6 +- .../library/lux/meta/target/jvm/constant/pool.lux | 12 +- .../source/library/lux/meta/target/jvm/field.lux | 2 +- .../source/library/lux/meta/target/jvm/loader.lux | 4 +- .../source/library/lux/meta/target/jvm/method.lux | 4 +- .../library/lux/meta/target/jvm/reflection.lux | 34 +- .../library/lux/meta/target/jvm/type/lux.lux | 6 +- .../library/lux/meta/target/jvm/type/signature.lux | 4 +- stdlib/source/library/lux/meta/target/lua.lux | 6 +- stdlib/source/library/lux/meta/target/php.lux | 8 +- stdlib/source/library/lux/meta/target/python.lux | 10 +- stdlib/source/library/lux/meta/target/r.lux | 6 +- stdlib/source/library/lux/meta/target/ruby.lux | 10 +- stdlib/source/library/lux/meta/target/scheme.lux | 12 +- stdlib/source/library/lux/meta/type.lux | 48 +-- stdlib/source/library/lux/meta/type/check.lux | 80 ++-- stdlib/source/library/lux/meta/type/implicit.lux | 38 +- stdlib/source/library/lux/meta/type/poly.lux | 6 +- stdlib/source/library/lux/meta/type/primitive.lux | 2 +- stdlib/source/library/lux/meta/type/quotient.lux | 2 +- stdlib/source/library/lux/meta/type/refinement.lux | 10 +- stdlib/source/library/lux/meta/type/resource.lux | 2 +- stdlib/source/library/lux/meta/version.lux | 2 +- stdlib/source/library/lux/program.lux | 4 +- stdlib/source/library/lux/test/property.lux | 14 +- stdlib/source/library/lux/world/console.lux | 12 +- stdlib/source/library/lux/world/db/jdbc/output.lux | 19 +- stdlib/source/library/lux/world/db/sql.lux | 8 +- stdlib/source/library/lux/world/environment.lux | 20 +- stdlib/source/library/lux/world/file.lux | 70 +-- stdlib/source/library/lux/world/file/watch.lux | 12 +- .../source/library/lux/world/net/http/client.lux | 16 +- .../source/library/lux/world/net/http/cookie.lux | 2 +- .../source/library/lux/world/net/http/header.lux | 2 +- .../source/library/lux/world/net/http/request.lux | 10 +- stdlib/source/library/lux/world/net/http/route.lux | 4 +- stdlib/source/library/lux/world/shell.lux | 8 +- stdlib/source/library/lux/world/time.lux | 2 +- stdlib/source/library/lux/world/time/day.lux | 18 +- stdlib/source/library/lux/world/time/duration.lux | 4 +- stdlib/source/library/lux/world/time/instant.lux | 4 +- stdlib/source/library/lux/world/time/month.lux | 20 +- stdlib/source/library/lux/world/time/year.lux | 4 +- 278 files changed, 5520 insertions(+), 5535 deletions(-) delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/when.lux delete mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/case.lux create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 16fb17d92..84f0ddf14 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -2997,17 +2997,17 @@ (-> Pattern Macro') ("lux type as" Macro' it)) -(def' .private (case_expansion#macro case_expansion pattern body branches) +(def' .private (when_expansion#macro when_expansion pattern body branches) (type_literal (-> (-> (List Code) (Meta (List Code))) Code Code (List Code) (Meta (List Code)))) (do meta#monad [pattern (one_expansion (total_expansion pattern)) pattern (static' #1 pattern) - branches (case_expansion branches)] + branches (when_expansion branches)] (in (list#partial pattern body branches)))) -(def' .private (case_expansion branches) +(def' .private (when_expansion branches) (type_literal (-> (List Code) (Meta (List Code)))) ({{#Item [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] {#Item body @@ -3020,46 +3020,46 @@ (do meta#monad [branches'' ((pattern_macro ("lux type as" Pattern value)) (list#partial (form$ parameters) body branches'))] - (case_expansion branches'')) - (case_expansion#macro case_expansion [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] body branches')) + (when_expansion branches'')) + (when_expansion#macro when_expansion [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] body branches')) {#None} - (case_expansion#macro case_expansion [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] body branches')} + (when_expansion#macro when_expansion [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] body branches')} ?type,value)) {#Item pattern {#Item body branches'}} - (case_expansion#macro case_expansion pattern body branches') + (when_expansion#macro when_expansion pattern body branches') {#End} (meta#in (list)) _ - (failure (all text#composite "'case' expects an even number of tokens: " (|> branches + (failure (all text#composite "'when' expects an even number of tokens: " (|> branches (list#each code#encoded) (list#interposed " ") list#reversed (list#mix text#composite ""))))} branches)) -(def' .public case +(def' .public when Macro (macro (_ tokens) ({{#Item value branches} (do meta#monad - [expansion (case_expansion branches)] + [expansion (when_expansion branches)] (in (list (` ((, (variant$ expansion)) (, value)))))) _ - (failure (..wrong_syntax_error (symbol ..case)))} + (failure (..wrong_syntax_error (symbol ..when)))} tokens))) (def' .private pattern#or Pattern (pattern (macro (_ tokens) - (case tokens + (when tokens (list#partial [_ {#Form patterns}] body branches) - (case patterns + (when patterns {#End} (failure "pattern#or cannot have 0 patterns") @@ -3073,7 +3073,7 @@ (def' .private (symbol? code) (type_literal (-> Code Bit)) - (case code + (when code [_ {#Symbol _}] #1 @@ -3083,9 +3083,9 @@ (def' .public let Macro (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Tuple bindings}] body) - (case (..pairs bindings) + (when (..pairs bindings) {#Some bindings} (|> bindings list#reversed @@ -3094,7 +3094,7 @@ (let' [[l r] lr] (if (symbol? l) (` ({(, l) (, body')} (, r))) - (` (case (, r) (, l) (, body'))))))) + (` (when (, r) (, l) (, body'))))))) body) list meta#in) @@ -3108,8 +3108,8 @@ (def' .public function Macro (macro (_ tokens) - (case (is (Maybe [Text Code (List Code) Code]) - (case tokens + (when (is (Maybe [Text Code (List Code) Code]) + (when tokens (list [_ {#Form (list#partial [_ {#Symbol ["" name]}] head tail)}] body) {#Some name head tail body} @@ -3123,7 +3123,7 @@ (if (symbol? arg) (` ([(, g!name) (, arg)] (, body'))) (` ([(, g!name) (, g!blank)] - (.case (, g!blank) (, arg) (, body'))))))))] + (.when (, g!blank) (, arg) (, body'))))))))] (meta#in (list (nest (..local$ g!name) head (list#mix (nest g!blank) body (list#reversed tail)))))) @@ -3138,7 +3138,7 @@ (def' .private (parsed parser tokens) (type_literal (All (_ a) (-> (Parser a) (List Code) (Maybe a)))) - (case (parser tokens) + (when (parser tokens) {#Some [(list) it]} {#Some it} @@ -3157,12 +3157,12 @@ (-> (Parser l) (Parser r) (Parser (Or l r))))) - (case (leftP tokens) + (when (leftP tokens) {#Some [tokens left]} {#Some [tokens {#Left left}]} _ - (case (rightP tokens) + (when (rightP tokens) {#Some [tokens right]} {#Some [tokens {#Right right}]} @@ -3175,7 +3175,7 @@ (-> (Parser a) (Parser a) (Parser a)))) - (case (leftP tokens) + (when (leftP tokens) {#None} (rightP tokens) @@ -3211,7 +3211,7 @@ (All (_ a) (-> (Parser a) (Parser (List a))))) - (case (itP tokens) + (when (itP tokens) {#Some [tokens head]} (do maybe#monad [it (someP itP tokens) @@ -3238,7 +3238,7 @@ (All (_ a) (-> (Parser a) (Parser (Maybe a))))) - (case (itP tokens) + (when (itP tokens) {#Some [tokens it]} {#Some [tokens {#Some it}]} @@ -3249,7 +3249,7 @@ (type_literal (All (_ a) (-> (Parser a) (Parser a)))) - (case tokens + (when tokens (list#partial [_ {#Tuple input}] tokens') (do maybe#monad [it (parsed itP input)] @@ -3262,7 +3262,7 @@ (type_literal (All (_ a) (-> (Parser a) (Parser a)))) - (case tokens + (when tokens (list#partial [_ {#Form input}] tokens') (do maybe#monad [it (parsed itP input)] @@ -3273,7 +3273,7 @@ (def' .private (bindingP tokens) (type_literal (Parser [Text Code])) - (case tokens + (when tokens (list#partial [_ {#Symbol ["" name]}] value &rest) {#Some [&rest [name value]]} @@ -3282,7 +3282,7 @@ (def' .private (endP tokens) (type_literal (Parser Any)) - (case tokens + (when tokens (list) {#Some [tokens []]} @@ -3291,7 +3291,7 @@ (def' .private (anyP tokens) (type_literal (Parser Code)) - (case tokens + (when tokens (list#partial code tokens') {#Some [tokens' code]} @@ -3300,7 +3300,7 @@ (def' .private (localP tokens) (type_literal (-> (List Code) (Maybe [(List Code) Text]))) - (case tokens + (when tokens (list#partial [_ {#Symbol ["" local]}] tokens') {#Some [tokens' local]} @@ -3309,7 +3309,7 @@ (def' .private (symbolP tokens) (type_literal (-> (List Code) (Maybe [(List Code) Symbol]))) - (case tokens + (when tokens (list#partial [_ {#Symbol it}] tokens') {#Some [tokens' it]} @@ -3319,7 +3319,7 @@ (with_template [ ] [(def' .private ( tokens) (type_literal (-> (List Code) (Maybe (List )))) - (case tokens + (when tokens {#End} {#Some {#End}} @@ -3337,7 +3337,7 @@ (with_template [ ] [(def' .private ( tokens) (type_literal (Parser [Text (List )])) - (case tokens + (when tokens (list#partial [_ {#Form local_declaration}] tokens') (do maybe#monad [% (localP local_declaration) @@ -3357,9 +3357,9 @@ (def' .private (export_policyP tokens) (type_literal (-> (List Code) [(List Code) Code])) - (case tokens + (when tokens (list#partial candidate tokens') - (case candidate + (when candidate [_ {#Bit it}] [tokens' candidate] @@ -3390,7 +3390,7 @@ (def' .private (bodyP tokens) (type_literal (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]]))) - (case tokens + (when tokens ... TB (list#partial type body tokens') {#Some [tokens' [{#Some type} body]]} @@ -3415,16 +3415,16 @@ (def' .public def Macro (macro (_ tokens) - (case (definitionP tokens) + (when (definitionP tokens) {#Some [export_policy name parameters ?type body]} - (let [body (case parameters + (let [body (when parameters {#End} body _ (` (function ((, (..local$ name)) (,* parameters)) (, body)))) - body (case ?type + body (when ?type {#Some type} (` (is (, type) (, body))) @@ -3441,7 +3441,7 @@ (with_template [
] [(def .public (macro (_ tokens) - (case (list#reversed tokens) + (when (list#reversed tokens) (list#partial last init) (meta#in (list (list#mix (is (-> Code Code Code) (function (_ pre post) (` ))) @@ -3464,10 +3464,10 @@ (def maybe#else (macro (_ tokens state) - (case tokens + (when tokens (list else maybe) (let [g!temp (is Code [dummy_location {#Symbol ["" ""]}]) - code (` (case (, maybe) + code (` (when (, maybe) {.#Some (, g!temp)} (, g!temp) @@ -3480,7 +3480,7 @@ (def (text#all_split_by splitter input) (-> Text Text (List Text)) - (case (..index splitter input) + (when (..index splitter input) {#None} (list input) @@ -3496,7 +3496,7 @@ (def (item idx xs) (All (_ a) (-> Nat (List a) (Maybe a))) - (case xs + (when xs {#End} {#None} @@ -3508,7 +3508,7 @@ ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction (def (reduced env type) (-> (List Type) Type Type) - (case type + (when type {#Sum left right} {#Sum (reduced env left) (reduced env right)} @@ -3519,7 +3519,7 @@ {#Apply (reduced env arg) (reduced env func)} {#UnivQ ?local_env ?local_def} - (case ?local_env + (when ?local_env {#End} {#UnivQ env ?local_def} @@ -3527,7 +3527,7 @@ type) {#ExQ ?local_env ?local_def} - (case ?local_env + (when ?local_env {#End} {#ExQ env ?local_def} @@ -3538,7 +3538,7 @@ {#Function (reduced env ?input) (reduced env ?output)} {#Parameter idx} - (case (item idx env) + (when (item idx env) {#Some parameter} parameter @@ -3554,7 +3554,7 @@ (def (applied_type param type_fn) (-> Type Type (Maybe Type)) - (case type_fn + (when type_fn {#UnivQ env body} {#Some (reduced (list#partial type_fn param env) body)} @@ -3574,7 +3574,7 @@ (def (interface_methods type) (-> Type (Maybe (List Type))) - (case type + (when type {#Product _} {#Some (flat_tuple type)} @@ -3605,7 +3605,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (property#value name modules) + (when (property#value name modules) {#Some module} {#Right state module} @@ -3621,7 +3621,7 @@ ..#definitions definitions ..#imports _ ..#module_state _] =module]] - (case (property#value name definitions) + (when (property#value name definitions) {#Some {#Slot [exported type group index]}} (meta#in [index (list#each (function (_ slot) @@ -3635,7 +3635,7 @@ (def (record_slots type) (-> Type (Meta (Maybe [(List Symbol) (List Type)]))) - (case type + (when type {#Apply arg func} (record_slots func) @@ -3653,9 +3653,9 @@ ..#definitions definitions ..#imports _ ..#module_state _] =module]] - (case (property#value name definitions) + (when (property#value name definitions) {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}} - (case (interface_methods _type) + (when (interface_methods _type) {#Some members} (meta#in {#Some [(list#each (function (_ slot) [module slot]) {#Item slots}) @@ -3677,7 +3677,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case expected + (when expected {#Some type} {#Right state type} @@ -3691,7 +3691,7 @@ implementation_type ..expected_type tags+type (record_slots implementation_type) tags (is (Meta (List Symbol)) - (case tags+type + (when tags+type {#Some [tags _]} (meta#in tags) @@ -3707,9 +3707,9 @@ members (monad#each meta#monad (is (-> Code (Meta (List Code))) (function (_ token) - (case token + (when token [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}] - (case (property#value slot_name tag_mappings) + (when (property#value slot_name tag_mappings) {#Some tag} (in (list tag value)) @@ -3723,7 +3723,7 @@ (def (text#interposed separator parts) (-> Text (List Text) Text) - (case parts + (when parts {#End} "" @@ -3742,12 +3742,12 @@ (All (_ a) (-> (-> (List Code) (Maybe [(List Code) a])) (-> (List Code) (Maybe (List a))))) - (case tokens + (when tokens {#Item _} (do maybe#monad [% (itP tokens) .let [[tokens' head] %] - tail (case tokens' + tail (when tokens' {#Item _} (everyP itP tokens') @@ -3758,33 +3758,33 @@ {#End} {#Some (list)})) -(def (caseP tokens) +(def (whenP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) - (case tokens + (when tokens (list#partial [_ {#Variant (list [_ {#Symbol ["" niladic]}])}] tokens') {#Some [tokens' [niladic (` .Any)]]} - (list#partial [_ {#Variant (list#partial [_ {#Symbol ["" polyadic]}] caseT)}] tokens') - {#Some [tokens' [polyadic (` (..Tuple (,* caseT)))]]} + (list#partial [_ {#Variant (list#partial [_ {#Symbol ["" polyadic]}] whenT)}] tokens') + {#Some [tokens' [polyadic (` (..Tuple (,* whenT)))]]} _ {#None})) (def .public Variant (macro (_ tokens) - (case (everyP caseP tokens) - {#Some cases} - (meta#in (list (` (..Union (,* (list#each product#right cases)))) - (variant$ (list#each (function (_ case) - (text$ (product#left case))) - cases)))) + (when (everyP whenP tokens) + {#Some whens} + (meta#in (list (` (..Union (,* (list#each product#right whens)))) + (variant$ (list#each (function (_ when) + (text$ (product#left when))) + whens)))) {#None} (failure (..wrong_syntax_error (symbol ..Variant)))))) (def (slotP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) - (case tokens + (when tokens (list#partial [_ {#Symbol ["" slot]}] type tokens') {#Some [tokens' [slot type]]} @@ -3793,9 +3793,9 @@ (def .public Record (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Tuple record}]) - (case (everyP slotP record) + (when (everyP slotP record) {#Some slots} (meta#in (list (` (..Tuple (,* (list#each product#right slots)))) (tuple$ (list#each (function (_ slot) @@ -3820,7 +3820,7 @@ (def (textP tokens) (-> (List Code) (Maybe [(List Code) Text])) - (case tokens + (when tokens (list#partial [_ {#Text it}] tokens') {#Some [tokens' it]} @@ -3832,9 +3832,9 @@ ({[_ {#Form {#Item [_ {#Symbol declarer}] parameters}}] (do meta#monad [declaration (single_expansion (form$ (list#partial (symbol$ declarer) parameters)))] - (case declaration + (when declaration (list type [_ {#Variant tags}]) - (case (everyP textP tags) + (when (everyP textP tags) {#Some tags} (meta#in [type {#Some {#Left tags}}]) @@ -3842,7 +3842,7 @@ (failure "Improper type-definition syntax")) (list type [_ {#Tuple slots}]) - (case (everyP textP slots) + (when (everyP textP slots) {#Some slots} (meta#in [type {#Some {#Right slots}}]) @@ -3861,7 +3861,7 @@ (def .public type (macro (_ tokens) - (case (typeP tokens) + (when (typeP tokens) {#Some [export_policy name args type_codes]} (do meta#monad [type+labels?? (..type_declaration type_codes) @@ -3869,23 +3869,23 @@ .let' [type_name (local$ name) [type labels??] type+labels?? type' (is (Maybe Code) - (case args + (when args {#End} {#Some type} _ {#Some (` (.All ((, type_name) (,* (list#each local$ args))) (, type)))}))]] - (case type' + (when type' {#Some type''} (let [typeC (` {.#Named [(, (text$ module_name)) (, (text$ name))] (..type_literal (, type''))})] - (meta#in (list (case labels?? + (meta#in (list (when labels?? {#Some labels} (` ("lux def type tagged" (, type_name) (, typeC) - (, (case labels + (, (when labels {#Left tags} (` {(,* (list#each text$ tags))}) @@ -3945,7 +3945,7 @@ (-> Text Text Text Text) ((is (-> Text Text Text) (function (again left right) - (case (..text#split_by pattern right) + (when (..text#split_by pattern right) {#Some [pre post]} (again (all "lux text concat" left pre replacement) post) @@ -3974,20 +3974,20 @@ (def (normal_parallel_path' hierarchy root) (-> Text Text Text) - (case [(text#split_by ..module_separator hierarchy) + (when [(text#split_by ..module_separator hierarchy) (text#split_by ..parallel_hierarchy_sigil root)] [{#Some [_ hierarchy']} {#Some ["" root']}] (normal_parallel_path' hierarchy' root') _ - (case root + (when root "" hierarchy _ (all text#composite root ..module_separator hierarchy)))) (def (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) - (case (text#split_by ..parallel_hierarchy_sigil root) + (when (text#split_by ..parallel_hierarchy_sigil root) {#Some ["" root']} {#Some (normal_parallel_path' hierarchy root')} @@ -3996,7 +3996,7 @@ (def (relative_ups relatives input) (-> Nat Text Nat) - (case ("lux text index" relatives ..module_separator input) + (when ("lux text index" relatives ..module_separator input) {#None} relatives @@ -4007,7 +4007,7 @@ (def (list#after amount list) (All (_ a) (-> Nat (List a) (List a))) - (case [amount list] + (when [amount list] (pattern#or [0 _] [_ {#End}]) list @@ -4017,7 +4017,7 @@ (def (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) - (case (relative_ups 0 module) + (when (relative_ups 0 module) 0 (meta#in (if nested? (all "lux text concat" relative_root ..module_separator module) @@ -4033,7 +4033,7 @@ list#reversed (text#interposed ..module_separator)) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) - output (case ("lux text size" clean) + output (when ("lux text size" clean) 0 prefix _ (all text#composite prefix ..module_separator clean))] (meta#in output)) @@ -4048,17 +4048,17 @@ [imports' (monad#each meta#monad (is (-> Code (Meta (List Importation))) (function (_ token) - (case token + (when token ... Nested [_ {#Tuple (list#partial [_ {#Symbol ["" module_name]}] extra)}] (do meta#monad - [absolute_module_name (case (normal_parallel_path relative_root module_name) + [absolute_module_name (when (normal_parallel_path relative_root module_name) {#Some parallel_path} (in parallel_path) {#None} (..absolute_module_name nested? relative_root module_name)) - extra,referral (case (referrals_parser #0 extra) + extra,referral (when (referrals_parser #0 extra) {#Some extra,referral} (in extra,referral) @@ -4066,7 +4066,7 @@ (failure "")) .let [[extra referral] extra,referral] sub_imports (imports_parser #1 absolute_module_name context extra)] - (in (case referral + (in (when referral {#End} sub_imports @@ -4078,13 +4078,13 @@ [_ {#Tuple (list#partial [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}] (do meta#monad - [absolute_module_name (case (normal_parallel_path relative_root module_name) + [absolute_module_name (when (normal_parallel_path relative_root module_name) {#Some parallel_path} (in parallel_path) {#None} (..absolute_module_name nested? relative_root module_name)) - extra,referral (case (referrals_parser #1 extra) + extra,referral (when (referrals_parser #1 extra) {#Some extra,referral} (in extra,referral) @@ -4093,7 +4093,7 @@ .let [[extra referral] extra,referral] .let [module_alias (..module_alias {#Item module_name context} alias)] sub_imports (imports_parser #1 absolute_module_name {#Item module_alias context} extra)] - (in (case referral + (in (when referral {#End} sub_imports @@ -4115,18 +4115,18 @@ (def (exported_definitions module state) (-> Text (Meta (List Text))) - (let [[current_module modules] (case state + (let [[current_module modules] (when 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 ..#eval _eval] [current_module modules])] - (case (property#value module modules) + (when (property#value module modules) {#Some =module} (let [to_alias (list#each (is (-> [Text Global] (List Text)) (function (_ [name definition]) - (case definition + (when definition {#Alias _} (list) @@ -4152,7 +4152,7 @@ {#None} {#Left (all text#composite "Unknown module: " (text#encoded module) \n - "Current module: " (case current_module + "Current module: " (when current_module {#Some current_module} (text#encoded current_module) @@ -4168,7 +4168,7 @@ (def (list#only p xs) (All (_ a) (-> (-> a Bit) (List a) (List a))) - (case xs + (when xs {#End} (list) @@ -4177,13 +4177,13 @@ {#Item x (list#only p xs')} (list#only p xs')))) -(def (is_member? cases name) +(def (is_member? whens name) (-> (List Text) Text Bit) - (let [output (list#mix (function (_ case prev) + (let [output (list#mix (function (_ when prev) (or prev - (text#= case name))) + (text#= when name))) #0 - cases)] + whens)] output)) (def (test_referrals current_module imported_module all_defs referred_defs) @@ -4202,7 +4202,7 @@ (def .public only (macro (_ tokens) - (case (..parsed (all ..andP + (when (..parsed (all ..andP ..textP ..textP ..textP @@ -4233,7 +4233,7 @@ (def .public except (macro (_ tokens) - (case (..parsed (all ..andP + (when (..parsed (all ..andP ..textP ..textP ..textP @@ -4257,7 +4257,7 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] - (case (property#value expected_module modules) + (when (property#value expected_module modules) {#None} {#None} @@ -4266,12 +4266,12 @@ ..#module_aliases _ ..#imports _ ..#module_state _]} - (case (property#value expected_short definitions) + (when (property#value expected_short definitions) {#None} {#None} {#Some definition} - (case definition + (when definition {#Alias real_name} (definition_type real_name state) @@ -4289,7 +4289,7 @@ (def (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) - (case bindings + (when bindings {#End} {#End} @@ -4306,31 +4306,31 @@ (function (_ compiler) (let [temp (is (Either Text [Lux Type]) (if (text#= "" module) - (case (in_env name compiler) + (when (in_env name compiler) {#Some implementation_type} {#Right [compiler implementation_type]} _ - (case (definition_type [current_module name] compiler) + (when (definition_type [current_module name] compiler) {#Some implementation_type} {#Right [compiler implementation_type]} _ {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})) - (case (definition_type full_name compiler) + (when (definition_type full_name compiler) {#Some implementation_type} {#Right [compiler implementation_type]} _ {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})))] - (case temp + (when temp {#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 _ ..#eval _eval] compiler [..#ex_counter _ ..#var_counter _ ..#var_bindings var_bindings] type_context] - (case (type_variable type_id var_bindings) + (when (type_variable type_id var_bindings) {#None} temp @@ -4343,9 +4343,9 @@ (def (list#all choice items) (All (_ a b) (-> (-> a (Maybe b)) (List a) (List b))) - (case items + (when items {#Item head tail} - (case (choice head) + (when (choice head) {#Some head} {#Item head (list#all choice tail)} @@ -4389,7 +4389,7 @@ next (|> layer (list#each product#right) list#conjoint)]] - (case next + (when next {#End} (in [pattern body]) @@ -4398,19 +4398,19 @@ [.let [sub_value (tuple$ (list#each (|>> product#left symbol$) next))] sub_pattern,sub_body (open_layers alias (list#each product#right next) body) .let [[sub_pattern sub_body] sub_pattern,sub_body]] - (in [pattern (` (case (, sub_value) + (in [pattern (` (when (, sub_value) (, sub_pattern) (, sub_body)))]))))) (def .public open (pattern (macro (_ tokens) - (case tokens + (when tokens (list#partial [_ {#Form (list [_ {#Text alias}])}] body branches) (do meta#monad [g!temp (..generated_symbol "temp")] (in (list#partial g!temp - (` (..case (, g!temp) + (` (..when (, g!temp) (..open (, g!temp) (, (text$ alias))) (, body))) branches))) @@ -4421,7 +4421,7 @@ (do meta#monad [init_type (type_definition name) implementation_evidence (record_slots init_type)] - (case implementation_evidence + (when implementation_evidence {#None} (failure (text#composite "Can only 'open' implementations: " (type#encoded init_type))) @@ -4436,9 +4436,9 @@ (def .public cond (macro (_ tokens) - (case (list#reversed tokens) + (when (list#reversed tokens) (list#partial else branches') - (case (pairs branches') + (when (pairs branches') {#Some branches'} (meta#in (list (list#mix (is (-> [Code Code] Code Code) (function (_ branch else) @@ -4456,7 +4456,7 @@ (def (enumeration' idx xs) (All (_ a) (-> Nat (List a) (List [Nat a]))) - (case xs + (when xs {#Item x xs'} {#Item [idx x] (enumeration' ("lux i64 +" 1 idx) xs')} @@ -4470,7 +4470,7 @@ (def .public the (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Symbol slot'}] record) (do meta#monad [slot (normal slot') @@ -4478,7 +4478,7 @@ .let [[idx tags exported? type] output] g!_ (..generated_symbol "_") g!output (..generated_symbol "")] - (case (interface_methods type) + (when (interface_methods type) {#Some members} (let [pattern (|> (zipped_2 tags (enumeration members)) (list#each (is (-> [Symbol [Nat Type]] (List Code)) @@ -4524,7 +4524,7 @@ g!_))) tuple$) source+ (` ({(, pattern) (, g!output)} (, source)))]] - (case output + (when output {#Some [tags' members']} (do meta#monad [decls' (monad#each meta#monad @@ -4544,7 +4544,7 @@ (do meta#monad [interface (type_definition implementation) output (record_slots interface)] - (case output + (when output {#Some [slots terms]} (do meta#monad [.let [g!implementation (symbol$ implementation)] @@ -4561,7 +4561,7 @@ (def (localized module global) (-> Text Symbol Symbol) - (case global + (when global ["" local] [module local] @@ -4570,7 +4570,7 @@ (def .public use (macro (_ tokens) - (case (..parsed (all ..andP + (when (..parsed (all ..andP (..maybeP (all ..andP ..textP ..textP @@ -4581,13 +4581,13 @@ tokens) {.#Some [current_module,imported_module,import_alias alias implementations]} (let [[current_module imported_module import_alias] - (case current_module,imported_module,import_alias + (when current_module,imported_module,import_alias {#Some [current_module imported_module import_alias]} [current_module imported_module import_alias] {#None} ["" "" ""])] - (case implementations + (when implementations {#Left implementations} (do meta#monad [declarations (|> implementations @@ -4600,7 +4600,7 @@ [pre_defs,implementations (is (Meta [(List Code) (List Code)]) (monad#mix meta#monad (function (_ it [pre_defs implementations]) - (case it + (when it [_ {#Symbol _}] (in [pre_defs {#Item it implementations}]) @@ -4636,7 +4636,7 @@ (def (referrals module_name extra) (-> Text (List Code) (Meta (List Referral))) (do meta#monad - [extra,referral (case (referrals_parser #0 extra) + [extra,referral (when (referrals_parser #0 extra) {#Some extra,referral} (in extra,referral) @@ -4644,7 +4644,7 @@ (failure "")) .let [[extra referral] extra,referral] current_module current_module_name] - (case extra + (when extra {#End} (in referral) @@ -4659,7 +4659,7 @@ (def .public refer (macro (_ tokens) - (case tokens + (when tokens (list#partial [_ {#Text imported_module}] [_ {#Text alias}] options) (do meta#monad [referrals (..referrals imported_module options) @@ -4677,7 +4677,7 @@ (def .public with (macro (_ tokens) - (case (..parsed (..andP ..anyP ..anyP) + (when (..parsed (..andP ..anyP ..anyP) tokens) {.#Some [implementation expression]} (meta#in (list (` (..let [(..open (, (text$ (alias_stand_in 0)))) (, implementation)] @@ -4688,7 +4688,7 @@ (def .public at (macro (_ tokens) - (case tokens + (when tokens (list implementation [_ {#Symbol member}]) (meta#in (list (` (..with (, implementation) (, (symbol$ member)))))) @@ -4700,13 +4700,13 @@ (def .public has (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Symbol slot'}] value record) (do meta#monad [slot (normal slot') output (..type_slot slot) .let [[idx tags exported? type] output]] - (case (interface_methods type) + (when (interface_methods type) {#Some members} (do meta#monad [pattern' (monad#each meta#monad @@ -4738,7 +4738,7 @@ (failure "has can only use records."))) (list [_ {#Tuple slots}] value record) - (case slots + (when slots {#End} (failure (..wrong_syntax_error (symbol ..has))) @@ -4784,13 +4784,13 @@ (def .public revised (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Symbol slot'}] fun record) (do meta#monad [slot (normal slot') output (..type_slot slot) .let [[idx tags exported? type] output]] - (case (interface_methods type) + (when (interface_methods type) {#Some members} (do meta#monad [pattern' (monad#each meta#monad @@ -4822,7 +4822,7 @@ (failure "revised can only use records."))) (list [_ {#Tuple slots}] fun record) - (case slots + (when slots {#End} (failure (..wrong_syntax_error (symbol ..revised))) @@ -4855,12 +4855,12 @@ (def .private with_template#pattern (pattern (macro (_ tokens) - (case tokens + (when tokens (list#partial [_ {#Form (list [_ {#Tuple bindings}] [_ {#Tuple templates}])}] [_ {#Form data}] branches) - (case (is (Maybe (List Code)) + (when (is (Maybe (List Code)) (do maybe#monad [bindings' (monad#each maybe#monad symbol_short bindings) data' (monad#each maybe#monad tuple_list data)] @@ -4896,12 +4896,12 @@ (def (interleaved xs ys) (All (_ a) (-> (List a) (List a) (List a))) - (case xs + (when xs {#End} {#End} {#Item x xs'} - (case ys + (when ys {#End} {#End} @@ -4910,7 +4910,7 @@ (def (type_code type) (-> Type Code) - (case type + (when type {#Primitive name params} (` {.#Primitive (, (text$ name)) (, (untemplated_list (list#each type_code params)))}) @@ -4941,22 +4941,22 @@ (def .public loop (macro (_ tokens) - (let [?params (case tokens + (let [?params (when tokens (list [_ {#Form (list name [_ {#Tuple bindings}])}] body) {#Some [name bindings body]} _ {#None})] - (case ?params + (when ?params {#Some [name bindings body]} - (case (pairs bindings) + (when (pairs bindings) {#Some pairs} (let [vars (list#each product#left pairs) inits (list#each product#right pairs)] (if (every? symbol? inits) (do meta#monad [inits' (is (Meta (List Symbol)) - (case (monad#each maybe#monad symbol_name inits) + (when (monad#each maybe#monad symbol_name inits) {#Some inits'} (meta#in inits') {#None} (failure (..wrong_syntax_error (symbol ..loop))))) init_types (monad#each meta#monad type_definition inits') @@ -4985,7 +4985,7 @@ (def .public with_expansions (let [with_expansions' (is (-> Text (List Code) Code (List Code)) (function (with_expansions' label tokens target) - (case target + (when target (pattern#or [_ {#Bit _}] [_ {#Nat _}] [_ {#Int _}] @@ -5007,7 +5007,7 @@ [#Variant] [#Tuple]))))] (macro (_ tokens) - (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) + (when (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) {#Some [bindings bodies]} (loop (again [bindings bindings map (is (Property_List (List Code)) @@ -5018,10 +5018,10 @@ (list#conjoint (list#each (with_expansions' binding expansion) it))) (list it) map)))] - (case bindings + (when bindings {#Item [var_name expr] &rest} (do meta#monad - [expansion (case (normal expr) + [expansion (when (normal expr) (list expr) (single_expansion expr) @@ -5045,7 +5045,7 @@ (def .public as_expected (macro (_ tokens) - (case tokens + (when tokens (list expr) (do meta#monad [type ..expected_type] @@ -5059,7 +5059,7 @@ (function (_ compiler) {#Right [compiler (the #location compiler)]}))] (macro (_ tokens) - (case tokens + (when tokens {#End} (do meta#monad [location location @@ -5073,7 +5073,7 @@ (def .public type_of (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Symbol var_name}]) (do meta#monad [var_type (type_definition var_name)] @@ -5106,7 +5106,7 @@ (` (`' (, (with_replacements replacement_environment template))))))] (macro (_ tokens) - (case (templateP tokens) + (when (templateP tokens) {#Some [name args input_templates]} (do meta#monad [g!tokens (..generated_symbol "tokens") @@ -5114,7 +5114,7 @@ g!_ (..generated_symbol "_") this_module ..current_module_name] (in (list (` (..macro ((, (local$ name)) (, g!tokens) (, g!compiler)) - (case (, g!tokens) + (when (, g!tokens) (list (,* (list#each local$ args))) {.#Right [(, g!compiler) (list (,* (list#each (instantiated_template (simple_replacement_environment args)) @@ -5143,7 +5143,7 @@ (def .public char (macro (_ tokens compiler) - (case tokens + (when tokens (list [_ {#Text input}]) (if (|> input "lux text size" ("lux i64 =" 1)) (|> input ("lux text char" 0) @@ -5160,7 +5160,7 @@ {#Right [compiler (the [#info #target] compiler)]})) platform_name (is (-> Code (Meta Text)) (function (_ choice) - (case choice + (when choice [_ {#Text platform}] (..meta#in platform) @@ -5169,7 +5169,7 @@ [symbol (..global_symbol symbol) type+value (..definition_value symbol) .let [[type value] type+value]] - (case (anonymous_type type) + (when (anonymous_type type) {#Primitive "#Text" {#End}} (in (as ..Text value)) @@ -5184,9 +5184,9 @@ \n "Must be either a text literal or a symbol."))))) target_pick (is (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (function (target_pick target options default) - (case options + (when options {#End} - (case default + (when default {#None} (failure (all text#composite "No code for target platform: " target)) @@ -5200,7 +5200,7 @@ (meta#in (list pick)) (target_pick target options' default))))))] (macro (_ tokens) - (case (..parsed (..andP (..someP (..andP ..anyP ..anyP)) + (when (..parsed (..andP (..someP (..andP ..anyP ..anyP)) (..maybeP ..anyP)) tokens) {.#Some [options default]} @@ -5214,7 +5214,7 @@ ... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and "parameter" ASAP. (for "{old}" (these (def (scope_type_vars state) (Meta (List Nat)) - (case state + (when state [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions @@ -5223,11 +5223,11 @@ (def .public parameter (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Nat idx}]) (do meta#monad [stvs ..scope_type_vars] - (case (..item idx (list#reversed stvs)) + (when (..item idx (list#reversed stvs)) {#Some var_id} (in (list (` {.#Ex (, (nat$ var_id))}))) @@ -5286,7 +5286,7 @@ (def .public ,, (..immediate_unquote (macro (_ it) - (case it + (when it (list it) (meta#in (list it)) @@ -5305,20 +5305,20 @@ (def (embedded_expansions code) (-> Code (Meta [(List Code) Code])) - (case code + (when code [@ {#Form (list#partial [@symbol {#Symbol original_symbol}] parameters)}] (with_expansions [ (aggregate_embedded_expansions embedded_expansions @ #Form (list#partial [@symbol {#Symbol original_symbol}] parameters))] (do meta#monad [resolved_symbol (..normal original_symbol) ?resolved_symbol (meta#try (..global_symbol resolved_symbol))] - (case ?resolved_symbol + (when ?resolved_symbol {#Left _} {#Right resolved_symbol} (do meta#monad [?type,value (meta#try (..definition_value resolved_symbol))] - (case ?type,value + (when ?type,value {#Left _} @@ -5343,7 +5343,7 @@ (def .public `` (macro (_ tokens) - (case tokens + (when tokens (list raw) (do meta#monad [=raw (..embedded_expansions raw) @@ -5363,7 +5363,7 @@ (def .public try (macro (_ tokens) - (case tokens + (when tokens (list expression) (do meta#monad [g!_ (..generated_symbol "g!_")] @@ -5376,7 +5376,7 @@ (def (methodP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) - (case tokens + (when tokens (list#partial [_ {#Form (list [_ {#Text "lux type check"}] type [_ {#Symbol ["" name]}])}] @@ -5390,7 +5390,7 @@ (macro (_ tokens) (do meta#monad [methods' (monad#each meta#monad complete_expansion tokens)] - (case (everyP methodP (list#conjoint methods')) + (when (everyP methodP (list#conjoint methods')) {#Some methods} (in (list (` (..Tuple (,* (list#each product#right methods)))) (tuple$ (list#each (|>> product#left text$) methods)))) @@ -5406,13 +5406,13 @@ (, (let$ (local$ name) (` {.#Apply (..Primitive "") (, g!self)}) body)))})))] (macro (_ tokens) - (case tokens + (when tokens (list [_ {#Symbol "" name}] body) (do meta#monad [body' (complete_expansion body) g!self (generated_symbol "g!self") g!dummy (generated_symbol "g!dummy")] - (case body' + (when body' (list body' labels) (in (list (recursive_type g!self g!dummy name body') labels)) diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index 15a1e96d3..5cf0679df 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -25,8 +25,8 @@ (def .public be (macro (_ tokens state) - (case (is (Maybe [(Maybe Text) Code (List Code) Code]) - (case tokens + (when (is (Maybe [(Maybe Text) Code (List Code) Code]) + (when tokens (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] comonad)}] [_ {.#Tuple bindings}] body) {.#Some [{.#Some name} comonad bindings body]} @@ -36,7 +36,7 @@ _ {.#None})) {.#Some [?name comonad bindings body]} - (case (list.pairs bindings) + (when (list.pairs bindings) {.#Some bindings} (let [[module short] (symbol ..be) symbol (is (-> Text Code) @@ -48,7 +48,7 @@ (function (_ binding body') (with_expansions [ (` (|> (, value) (, g!disjoint) ((, g!each) (function ((, g!_) (, var)) (, body')))))] (let [[var value] binding] - (case var + (when var [_ {.#Symbol ["" _]}] @@ -59,17 +59,17 @@ ))))) body (list.reversed bindings))] - {.#Right [state (list (case ?name + {.#Right [state (list (when ?name {.#Some name} (let [name [location.dummy {.#Symbol ["" name]}]] - (` (.case (, comonad) + (` (.when (, comonad) (, name) - (.case (, name) + (.when (, name) [(, g!each) (,' out) (, g!disjoint)] (, body'))))) {.#None} - (` (.case (, comonad) + (` (.when (, comonad) [(, g!each) (,' out) (, g!disjoint)] (, body')))))]}) diff --git a/stdlib/source/library/lux/abstract/functor.lux b/stdlib/source/library/lux/abstract/functor.lux index 583be0344..011f9a8d1 100644 --- a/stdlib/source/library/lux/abstract/functor.lux +++ b/stdlib/source/library/lux/abstract/functor.lux @@ -16,7 +16,7 @@ (All (_ F G) (-> (Functor F) (Functor G) (Functor (..Or F G)))) (implementation (def (each f fa|ga) - (case fa|ga + (when fa|ga {.#Left fa} {.#Left (f#each f fa)} diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index 71f981b3e..f2455e3f8 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -9,7 +9,7 @@ (def (list#mix f init xs) (All (_ a b) (-> (-> b a a) a (List b) a)) - (case xs + (when xs {.#End} init @@ -20,7 +20,7 @@ (All (_ a) (-> (List a) Nat)) (loop (again [counter 0 xs xs]) - (case xs + (when xs {.#End} counter @@ -36,7 +36,7 @@ (def (pairs xs) (All (_ a) (-> (List a) (List [a a]))) - (case xs + (when xs {.#Item x1 {.#Item x2 xs'}} {.#Item [x1 x2] (pairs xs')} @@ -56,8 +56,8 @@ (def .public do (macro (_ tokens state) - (case (is (Maybe [(Maybe Text) Code (List Code) Code]) - (case tokens + (when (is (Maybe [(Maybe Text) Code (List Code) Code]) + (when tokens (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] monad)}] [_ {.#Tuple bindings}] body) {.#Some [{.#Some name} monad bindings body]} @@ -78,7 +78,7 @@ (function (_ binding body') (with_expansions [ (` (|> (, value) ((, g!each) (function ((, g!_) (, var)) (, body'))) (, g!conjoint)))] (let [[var value] binding] - (case var + (when var [_ {.#Symbol ["" _]}] @@ -89,17 +89,17 @@ ))))) body (reversed (pairs bindings)))] - {.#Right [state (list (case ?name + {.#Right [state (list (when ?name {.#Some name} (let [name [location.dummy {.#Symbol ["" name]}]] - (` (.case (, monad) + (` (.when (, monad) (, name) - (.case (, name) + (.when (, name) [(, g!each) (,' in) (, g!conjoint)] (, body'))))) {.#None} - (` (.case (, monad) + (` (.when (, monad) [(, g!each) (,' in) (, g!conjoint)] (, body')))))]}) {.#Left "'do' bindings must have an even number of parts."}) @@ -120,7 +120,7 @@ (! (List a)))) (let [(open "!#[0]") monad] (function (again xs) - (case xs + (when xs {.#End} (!#in {.#End}) @@ -136,7 +136,7 @@ (M (List b)))) (let [(open "!#[0]") monad] (function (again xs) - (case xs + (when xs {.#End} (!#in {.#End}) @@ -152,7 +152,7 @@ (! (List a)))) (let [(open "!#[0]") monad] (function (again xs) - (case xs + (when xs {.#End} (!#in {.#End}) @@ -170,7 +170,7 @@ (All (_ M a b) (-> (Monad M) (-> b a (M a)) a (List b) (M a))) - (case xs + (when xs {.#End} (at monad in init) diff --git a/stdlib/source/library/lux/abstract/monad/free.lux b/stdlib/source/library/lux/abstract/monad/free.lux index 257d149b3..f0d5aabf8 100644 --- a/stdlib/source/library/lux/abstract/monad/free.lux +++ b/stdlib/source/library/lux/abstract/monad/free.lux @@ -15,7 +15,7 @@ (All (_ F) (-> (Functor F) (Functor (Free F)))) (implementation (def (each f ea) - (case ea + (when ea {#Pure a} {#Pure (f a)} @@ -29,7 +29,7 @@ (..functor dsl)) (def (on ea ef) - (case [ef ea] + (when [ef ea] [{#Pure f} {#Pure a}] {#Pure (f a)} @@ -51,9 +51,9 @@ {#Pure a}) (def (conjoint efefa) - (case efefa + (when efefa {#Pure efa} - (case efa + (when efa {#Pure a} {#Pure a} diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index c321b7c3d..602d65137 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -41,7 +41,7 @@ (Parser Symbol) (//.do <>.monad [[module short] .symbol - _ (<>.assertion "" (case module "" false _ true))] + _ (<>.assertion "" (when module "" false _ true))] (in [module short]))) (def context @@ -68,7 +68,7 @@ expression .any]) (macro.with_symbols [g!_ g!then] (let [body (list#mix (function (_ context next) - (case context + (when context {#Macro macro parameter} (` ((, (code.symbol macro)) (, parameter) @@ -81,7 +81,7 @@ (, value))))) expression (list.reversed context))] - (in (list (case ?name + (in (list (when ?name {.#Some name} (let [name (code.local name)] (` (let [(, name) (, monad) diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index d82d73232..9113b45d9 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -278,16 +278,6 @@ (function (_ [[stack arg] quote]) [stack (|>> (push arg) quote)])) -(def .public when - (All (_ ,,,) - (type.let [body (=> ,,, ,,,)] - (=> ,,, [Bit body] - ,,,))) - (|>> swap - (push ..call) - (push ..drop) - if)) - (def .public ? (All (_ a) (=> [Bit a a] [a])) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 7d7d7ca93..e1eb5ff68 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -40,7 +40,7 @@ (IO (List a)))) (do [! io.monad] [current (async.value read)] - (case current + (when current {.#Some [head tail]} (at ! each (|>> {.#Item head}) (pending tail)) @@ -76,7 +76,7 @@ (do [! async.monad] [[head tail] |mailbox| ?state' (behavior head state self)] - (case ?state' + (when ?state' {try.#Failure error} (let [[_ resolve] (the #obituary (representation self))] (exec (io.run! @@ -95,7 +95,7 @@ (|> obituary async.value (at io.functor each - (|>> (pipe.case + (|>> (pipe.when {.#None} bit.yes @@ -124,7 +124,7 @@ (loop (again [[|mailbox| resolve] |mailbox|&resolve]) (do ! [|mailbox| (async.value |mailbox|)] - (case |mailbox| + (when |mailbox| {.#None} (do ! [resolved? (resolve entry)] @@ -153,7 +153,7 @@ (function (_ state self) (do [! async.monad] [outcome (message state self)] - (case outcome + (when outcome {try.#Success [state' return]} (exec (io.run! (resolve {try.#Success return})) @@ -169,7 +169,7 @@ (let [[async mail] (..mail message)] (do async.monad [outcome (async.future (..mail! mail actor))] - (case outcome + (when outcome {try.#Success} async diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 2e0193fbb..6a4f582de 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -49,7 +49,7 @@ (let [async (representation async)] (do [! io.monad] [(^.let old [_value _observers]) (atom.read! async)] - (case _value + (when _value {.#Some _} (in false) @@ -84,7 +84,7 @@ (do [! io.monad] [.let [async (representation async)] (^.let old [_value _observers]) (atom.read! async)] - (case _value + (when _value {.#Some value} (f (variance.read value)) @@ -100,7 +100,7 @@ (All (_ r w) (-> (Async' r w) (IO Bit))) (|>> ..value (at io.functor each - (|>> (pipe.case + (|>> (pipe.when {.#None} false diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index 36275bef4..c1b7c9931 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -105,7 +105,7 @@ (do async.monad [item_f ff item_a fa] - (case [item_f item_a] + (when [item_f item_a] [{.#Some [head_f tail_f]} {.#Some [head_a tail_a]}] (in {.#Some [(head_f head_a) (on tail_a tail_f)]}) @@ -136,13 +136,13 @@ (loop (again [mma mma]) (do [! async.monad] [?mma mma] - (case ?mma + (when ?mma {.#Some [ma mma']} (do ! [_ (loop (again [ma ma]) (do ! [?ma ma] - (case ?ma + (when ?ma {.#Some [a ma']} (exec (io.run! (at sink feed a)) @@ -169,9 +169,9 @@ it)]) (do async.monad [item it] - (case item + (when item {.#Some [head tail]} - (case (io.run! (subscriber head)) + (when (io.run! (subscriber head)) {.#Some _} (again tail) @@ -186,7 +186,7 @@ (All (_ a) (-> (-> a Bit) (Channel a) (Channel a))) (do async.monad [item it] - (case item + (when item {.#Some [head tail]} (let [tail' (only pass? tail)] (if (pass? head) @@ -208,7 +208,7 @@ (Async a))) (do [! async.monad] [item it] - (case item + (when item {.#None} (in init) @@ -226,7 +226,7 @@ [init] (do [! async.monad] [item it] - (case item + (when item {.#None} (in {.#None}) @@ -255,7 +255,7 @@ (All (_ s o) (-> (-> s (Async (Maybe [s o]))) s (Channel o))) (do async.monad [?next (f init)] - (in (case ?next + (in (when ?next {.#Some [state output]} {.#Some [output (iterations f state)]} @@ -266,7 +266,7 @@ (All (_ a) (-> (Equivalence a) a (Channel a) (Channel a))) (do async.monad [item it] - (case item + (when item {.#Some [head tail]} (if (at equivalence = previous head) (distinct' equivalence previous tail) @@ -279,7 +279,7 @@ (All (_ a) (-> (Equivalence a) (Channel a) (Channel a))) (do async.monad [item it] - (in (case item + (in (when item {.#Some [head tail]} {.#Some [head (distinct' equivalence head tail)]} @@ -290,7 +290,7 @@ (All (_ a) (-> (Channel a) (Async (List a)))) (do [! async.monad] [item it] - (case item + (when item {.#Some [head tail]} (at ! each (|>> {.#Item head}) (list tail)) @@ -300,7 +300,7 @@ (def .public (sequential milli_seconds values) (All (_ a) (-> Nat (List a) (Channel a))) - (case values + (when values {.#End} ..empty diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index c2fa5c5c1..557f9fca8 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -86,7 +86,7 @@ (if (same? pre post) (in (exception.except ..semaphore_is_maxed_out [(the #max_positions pre)])) (do ! - [_ (case (queue.front (the #waiting_list pre)) + [_ (when (queue.front (the #waiting_list pre)) {.#None} (in true) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index 9762ffa59..280c0dee8 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -55,7 +55,7 @@ [banned (monad.only ! (function (_ sink) (do ! [result (at sink feed (variance.write new_value))] - (in (case result + (in (when result {try.#Success _} false @@ -113,7 +113,7 @@ (def .public (read var) (All (_ r w) (-> (Var' r w) (STM r))) (function (_ tx) - (case (var_value var tx) + (when (var_value var tx) {.#Some value} [tx value] @@ -127,7 +127,7 @@ (def (with_updated_var var value tx) (All (_ r w) (-> (Var' r w) w Tx Tx)) - (case tx + (when tx {.#End} {.#End} @@ -146,7 +146,7 @@ (def .public (write value var) (All (_ r w) (-> w (Var' r w) (STM Any))) (function (_ tx) - (case (var_value var tx) + (when (var_value var tx) {.#Some _} [(with_updated_var var value tx) []] @@ -236,7 +236,7 @@ (loop (again [[|commits| resolve] |commits|&resolve]) (do ! [|commits| (async.value |commits|)] - (case |commits| + (when |commits| {.#None} (do io.monad [resolved? (resolve entry)] diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 957a052d1..25e1d02d8 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -111,7 +111,7 @@ (def (execute! action) (-> (IO Any) Any) - (case (try (io.run! action)) + (when (try (io.run! action)) {try.#Failure error} (exec (debug.log! (all "lux text concat" @@ -128,7 +128,7 @@ [] (java/lang/Runnable [] (run self []) void (..execute! action)))] - (case milli_seconds + (when milli_seconds 0 (java/util/concurrent/Executor::execute runnable runner) _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS runner)))] @@ -176,7 +176,7 @@ (loop (again [_ []]) (do ! [threads (atom.read! ..runner)] - (case threads + (when threads ... And... we're done! {.#End} (in []) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index f311fdb25..834f8afe8 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except except with) + [lux (.except except with when) [abstract [monad (.only do)]] [control @@ -38,7 +38,7 @@ (All (_ e a) (-> (Exception e) (-> Text a) (Try a) (Try a))) - (case try + (.when try {//.#Success output} {//.#Success output} @@ -54,7 +54,7 @@ (def .public (otherwise else try) (All (_ a) (-> (-> Text a) (Try a) a)) - (case try + (.when try {//.#Success output} output @@ -127,7 +127,7 @@ (|> message (text.replaced text.new_line on_new_line) (all text#composite padding header header_separator)))))] - (case entries + (.when entries {.#End} "" @@ -167,9 +167,9 @@ (def .public (with exception message computation) (All (_ e a) (-> (Exception e) e (Try a) (Try a))) - (case computation + (.when computation {//.#Failure error} - {//.#Failure (case error + {//.#Failure (.when error "" (..error exception message) diff --git a/stdlib/source/library/lux/control/function/memo.lux b/stdlib/source/library/lux/control/function/memo.lux index 3328720e2..376e248f9 100644 --- a/stdlib/source/library/lux/control/function/memo.lux +++ b/stdlib/source/library/lux/control/function/memo.lux @@ -25,7 +25,7 @@ (function (_ input) (do [! state.monad] [memory state.get] - (case (dictionary.value input memory) + (when (dictionary.value input memory) {.#Some output} (in output) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 150d0f49f..eab14d2ae 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -52,7 +52,7 @@ (.def .public let (syntax (_ [functions (.tuple (<>.some ..mutual)) body .any]) - (case functions + (when functions {.#End} (in (list body)) @@ -105,7 +105,7 @@ (.def .public def (syntax (_ [functions (<>.many ..definition)]) - (case functions + (when functions {.#End} (in (list)) diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux index 4636f701a..2db5daf4a 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -29,7 +29,7 @@ (is (Maybe a) {.#None})))] (abstraction (function (_ _) - (case (io.run! (atom.read! cache)) + (when (io.run! (atom.read! cache)) {.#Some value} value diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index a3741b3c3..f760d517d 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except list with) + [lux (.except list with when) [abstract [monoid (.only Monoid)] [equivalence (.only Equivalence)] @@ -22,7 +22,7 @@ {.#None}) (def (composite mx my) - (case mx + (.when mx {.#None} my @@ -33,7 +33,7 @@ (Functor Maybe) (implementation (def (each f ma) - (case ma + (.when ma {.#Some a} {.#Some (f a)} @@ -47,7 +47,7 @@ (def functor ..functor) (def (on fa ff) - (case [ff fa] + (.when [ff fa] [{.#Some f} {.#Some a}] {.#Some (f a)} @@ -63,7 +63,7 @@ {.#Some x}) (def (conjoint mma) - (case mma + (.when mma {.#Some mx} mx @@ -75,7 +75,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Maybe a)))) (implementation (def (= mx my) - (case [mx my] + (.when [mx my] [{.#None} {.#None}] true @@ -92,7 +92,7 @@ (..equivalence (at super equivalence))) (def (hash value) - (case value + (.when value {.#None} 1 @@ -113,7 +113,7 @@ (def (conjoint MmMma) (do monad [mMma MmMma] - (case mMma + (.when mMma {.#Some Mma} Mma @@ -127,10 +127,10 @@ (def .public else (macro (_ tokens state) - (case tokens + (.when tokens (.list else maybe) (let [g!temp (is Code [location.dummy {.#Symbol ["" ""]}])] - {.#Right [state (.list (` (.case (, maybe) + {.#Right [state (.list (` (.when (, maybe) {.#Some (, g!temp)} (, g!temp) @@ -147,7 +147,7 @@ (def .public (list value) (All (_ a) (-> (Maybe a) (List a))) - (case value + (.when value {.#Some value} (.list value) @@ -157,7 +157,7 @@ (def .public when (macro (_ tokens state) - (case tokens + (.when tokens (.list test then) {.#Right [state (.list (` (.if (, test) (, then) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index d7cf37138..2330b8606 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -21,7 +21,7 @@ (implementation (def (each f ma) (function (_ input) - (case (ma input) + (when (ma input) {try.#Success [input' a]} {try.#Success [input' (f a)]} @@ -35,9 +35,9 @@ (def (on fa ff) (function (_ input) - (case (ff input) + (when (ff input) {try.#Success [input' f]} - (case (fa input') + (when (fa input') {try.#Success [input'' a]} {try.#Success [input'' (f a)]} @@ -58,7 +58,7 @@ (def (conjoint mma) (function (_ input) - (case (mma input) + (when (mma input) {try.#Success [input' ma]} (ma input') @@ -76,7 +76,7 @@ (All (_ s a) (-> (Parser s a) (Parser s (Maybe a)))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' x]} {try.#Success [input' {.#Some x}]} @@ -99,12 +99,12 @@ (All (_ s a b) (-> (Parser s a) (Parser s b) (Parser s (Or a b)))) (function (_ tokens) - (case (left tokens) + (when (left tokens) {try.#Success [tokens' output]} {try.#Success [tokens' {0 #0 output}]} {try.#Failure _} - (case (right tokens) + (when (right tokens) {try.#Success [tokens' output]} {try.#Success [tokens' {0 #1 output}]} @@ -115,7 +115,7 @@ (All (_ s a) (-> (Parser s a) (Parser s a) (Parser s a))) (function (_ tokens) - (case (this tokens) + (when (this tokens) {try.#Failure _} (that tokens) @@ -126,7 +126,7 @@ (All (_ s a) (-> (Parser s a) (Parser s (List a)))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' head]} (..result (at ..monad each (|>> (list.partial head)) (some parser)) @@ -144,7 +144,7 @@ (def .public (exactly amount parser) (All (_ s a) (-> Nat (Parser s a) (Parser s (List a)))) - (case amount + (when amount 0 (at ..monad in (list)) _ (do [! ..monad] [x parser] @@ -160,10 +160,10 @@ (def .public (at_most amount parser) (All (_ s a) (-> Nat (Parser s a) (Parser s (List a)))) - (case amount + (when amount 0 (at ..monad in (list)) _ (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' x]} (..result (at ..monad each (|>> {.#Item x}) (at_most (-- amount) parser)) @@ -176,7 +176,7 @@ (All (_ s a) (-> Nat Nat (Parser s a) (Parser s (List a)))) (do [! ..monad] [minimum (..exactly minimum parser)] - (case additional + (when additional 0 (in minimum) _ (at ! each (list#composite minimum) (..at_most additional parser))))) @@ -185,7 +185,7 @@ (All (_ s a b) (-> (Parser s b) (Parser s a) (Parser s (List a)))) (do [! ..monad] [?x (..maybe parser)] - (case ?x + (when ?x {.#Some x} (|> parser (..and separator) @@ -198,7 +198,7 @@ (def .public (not parser) (All (_ s a) (-> (Parser s a) (Parser s Any))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Failure msg} {try.#Success [input []]} @@ -213,7 +213,7 @@ (def .public (lifted operation) (All (_ s a) (-> (Try a) (Parser s a))) (function (_ input) - (case operation + (when operation {try.#Success output} {try.#Success [input output]} @@ -223,7 +223,7 @@ (def .public (else value parser) (All (_ s a) (-> a (Parser s a) (Parser s a))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' output]} {try.#Success [input' output]} @@ -263,7 +263,7 @@ (def .public (parses? parser) (All (_ s a) (-> (Parser s a) (Parser s Bit))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' _]} {try.#Success [input' true]} @@ -273,7 +273,7 @@ (def .public (parses parser) (All (_ s a) (-> (Parser s a) (Parser s Any))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' _]} {try.#Success [input' []]} @@ -283,7 +283,7 @@ (def .public (speculative parser) (All (_ s a) (-> (Parser s a) (Parser s a))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' output]} {try.#Success [input output]} @@ -293,9 +293,9 @@ (def .public (codec codec parser) (All (_ s a z) (-> (Codec a z) (Parser s a) (Parser s z))) (function (_ input) - (case (parser input) + (when (parser input) {try.#Success [input' to_decode]} - (case (at codec decoded to_decode) + (when (at codec decoded to_decode) {try.#Success value} {try.#Success [input' value]} diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux index 54b0fca51..2221505af 100644 --- a/stdlib/source/library/lux/control/pipe.lux +++ b/stdlib/source/library/lux/control/pipe.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except let cond if exec case) + [lux (.except let cond if exec when) [abstract ["[0]" monad]] [control @@ -65,14 +65,6 @@ [(,* else)] (, prev))))))) -(def .public when - (syntax (_ [test ..body - then ..body - prev .any]) - (in (list (` (..cond [(,* test)] [(,* then)] - [] - (, prev))))))) - (def .public while (syntax (_ [test ..body then ..body @@ -88,7 +80,7 @@ steps (<>.some ..body) prev .any]) (with_symbols [g!temp] - (.case (list.reversed steps) + (.when (list.reversed steps) (list.partial last_step prev_steps) (.let [step_bindings (monad.do list.monad [step (list.reversed prev_steps)] @@ -117,10 +109,10 @@ [(,* (list#each (function (_ body) (` (|> (, g!temp) (,* body)))) paths))]))))))) -(def .public case +(def .public when (syntax (_ [branches (<>.many (<>.and .any .any)) prev .any]) - (in (list (` (.case (, prev) + (in (list (` (.when (, prev) (,* (|> branches (list#each (function (_ [pattern body]) (list pattern body))) list#conjoint)))))))) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index 1edddc5a0..e752b57a9 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -34,7 +34,7 @@ (exception .public [a] (clean_up_error [error Text output (Try a)]) (format error - (case output + (when output {try.#Success _} "" @@ -44,7 +44,7 @@ (def (clean clean_up output) (All (_ a) (-> (Try Any) (Try a) (Try a))) - (case clean_up + (when clean_up {try.#Success _} output @@ -79,7 +79,7 @@ (function (_ region+cleaners) (at super each (function (_ [cleaners' temp]) - [cleaners' (case temp + [cleaners' (when temp {try.#Success value} {try.#Success (f value)} @@ -100,9 +100,9 @@ (do super [[cleaners ef] (ff [region cleaners]) [cleaners ea] (fa [region cleaners])] - (case ef + (when ef {try.#Success f} - (case ea + (when ea {try.#Success a} (in [cleaners {try.#Success (f a)}]) @@ -128,7 +128,7 @@ (function (_ [region cleaners]) (do super [[cleaners efa] (ffa [region cleaners])] - (case efa + (when efa {try.#Success fa} (fa [region cleaners]) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index b7a91758f..1b3d0c2f0 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -30,7 +30,7 @@ (list ["Deadline" (%.date deadline)] ["Today" (%.date today)] ["Message" message] - ["Code" (case focus + ["Code" (when focus {.#Some focus} (%.code focus) @@ -44,7 +44,7 @@ .int) (do <>.monad [raw .text] - (case (at date.codec decoded raw) + (when (at date.codec decoded raw) {try.#Success date} (in date) @@ -58,7 +58,7 @@ (let [now (io.run! instant.now) today (instant.date now)] (if (date#< deadline today) - (in (case focus + (in (when focus {.#Some focus} (list focus) @@ -73,7 +73,7 @@ focus (<>.maybe .any)]) (in (list (` (..remember (, (code.text (%.date deadline))) (, (code.text (format " " message))) - (,* (case focus + (,* (when focus {.#Some focus} (list focus) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index ca2010ce8..a27c466a6 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except with) + [lux (.except with when) [abstract [apply (.only Apply)] [equivalence (.only Equivalence)] @@ -19,7 +19,7 @@ (Functor Try) (implementation (def (each f ma) - (case ma + (.when ma {#Success datum} {#Success (f datum)} @@ -33,9 +33,9 @@ (def functor ..functor) (def (on fa ff) - (case ff + (.when ff {#Success f} - (case fa + (.when fa {#Success a} {#Success (f a)} @@ -56,7 +56,7 @@ {#Success a}) (def (conjoint mma) - (case mma + (.when mma {#Success ma} ma @@ -79,7 +79,7 @@ (def (conjoint MeMea) (do monad [eMea MeMea] - (case eMea + (.when eMea {#Success Mea} Mea @@ -95,7 +95,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Try a)))) (implementation (def (= reference sample) - (case [reference sample] + (.when [reference sample] [{#Success reference} {#Success sample}] (_#= reference sample) @@ -109,7 +109,7 @@ (def .public (trusted try) (All (_ a) (-> (Try a) a)) - (case try + (.when try {#Success value} value @@ -119,7 +119,7 @@ (def .public (maybe try) (All (_ a) (-> (Try a) (Maybe a))) - (case try + (.when try {#Success value} {.#Some value} @@ -130,7 +130,7 @@ (def .public (of_maybe maybe) (All (_ a) (-> (Maybe a) (Try a))) - (case maybe + (.when maybe {.#Some value} {#Success value} @@ -140,9 +140,9 @@ (def .public else (macro (_ tokens compiler) - (case tokens + (.when tokens (list else try) - {#Success [compiler (list (` (case (, try) + {#Success [compiler (list (` (.when (, try) {..#Success (,' g!temp)} (,' g!temp) @@ -155,7 +155,7 @@ (def .public when (macro (_ tokens state) - (case tokens + (.when tokens (.list test then) (let [code#encoded ("lux in-module" "library/lux" .code#encoded) text$ ("lux in-module" "library/lux" .text$)] diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index dcb0ad6bb..18b53bb1c 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -31,7 +31,7 @@ (def equivalence ..equivalence) (def (hash value) - (case value + (when value #0 2 #1 3)))) @@ -55,7 +55,7 @@ "#0")) (def (decoded input) - (case input + (when input "#1" {.#Right #1} "#0" {.#Right #0} _ {.#Left "Wrong syntax for Bit."})))) diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index b036bb9dc..1e84ee9c4 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -69,7 +69,7 @@ output ..empty]) (let [idx|output (-- size|output)] (if (n.> 0 size|output) - (case (|> (..chunk idx|output input) + (when (|> (..chunk idx|output input) (pipe.cond [(pipe.new (n.= chunk_index idx|output) [])] [( bit_index)] @@ -109,7 +109,7 @@ (def .public (not input) (-> Bits Bits) - (case (array.size input) + (when (array.size input) 0 ..empty @@ -117,7 +117,7 @@ (loop (again [size|output size|output output ..empty]) (let [idx (-- size|output)] - (case (|> input (..chunk idx) i64.not .nat) + (when (|> input (..chunk idx) i64.not .nat) 0 (again (-- size|output) output) @@ -133,7 +133,7 @@ (with_template [ ] [(def .public ( param subject) (-> Bits Bits Bits) - (case (n.max (array.size param) + (when (n.max (array.size param) (array.size subject)) 0 ..empty @@ -143,7 +143,7 @@ output ..empty]) (let [idx (-- size|output)] (if (n.> 0 size|output) - (case (|> (..chunk idx subject) + (when (|> (..chunk idx subject) ( (..chunk idx param)) .nat) 0 diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 99badd2bc..a2e1282d5 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -271,7 +271,7 @@ (if (with_bit_position? (to_bit_position hierarchy_idx) bitmap) [(++ base_idx) - (case (array.item base_idx base) + (when (array.item base_idx base) {.#Left sub_node} (array.has! hierarchy_idx sub_node h_array) @@ -289,7 +289,7 @@ ... So, this test is introduced to detect them. (def (node#empty? node) (All (_ k v) (-> (Node k v) Bit)) - (case node + (when node {#Base ..clean_bitmap _} true @@ -298,7 +298,7 @@ (def (node#has level hash key val key_hash node) (All (_ k v) (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v))) - (case node + (when node ... For #Hierarchy nodes, check whether one can add the element to ... a sub-node. If impossible, introduce a new singleton sub-node. {#Hierarchy _size hierarchy} @@ -317,7 +317,7 @@ (if (with_bit_position? bit bitmap) ... If so... (let [idx (base_index bit bitmap)] - {#Base bitmap (case (array.item idx base) + {#Base bitmap (when (array.item idx base) ... If it's being used by a node, add the KV to it. {.#Left sub_node} (let [sub_node' (node#has (level_up level) hash key val key_hash sub_node)] @@ -371,7 +371,7 @@ (if (n.= hash _hash) ... If they're equal, that means the new KV contributes to the ... collisions. - (case (collision_index key_hash key _colls) + (when (collision_index key_hash key _colls) ... If the key was already present in the collisions-list, its ... value gets updated. {.#Some coll_idx} @@ -390,7 +390,7 @@ (def (node#lacks level hash key key_hash node) (All (_ k v) (-> Level Hash_Code k (Hash k) (Node k v) (Node k v))) - (case node + (when node ... For #Hierarchy nodes, find out if there's a valid sub-node for ... the Hash-Code. {#Hierarchy h_size h_array} @@ -422,7 +422,7 @@ (let [bit (level_bit_position level hash)] (if (with_bit_position? bit bitmap) (let [idx (base_index bit bitmap)] - (case (array.item idx base) + (when (array.item idx base) ... If set, check if it's a sub_node, and remove the KV ... from it. {.#Left sub_node} @@ -460,7 +460,7 @@ ... For #Collisions nodes, It need to find out if the key already existst. {#Collisions _hash _colls} - (case (collision_index key_hash key _colls) + (when (collision_index key_hash key _colls) ... If not, then there's nothing to remove. {.#None} node @@ -477,7 +477,7 @@ (def (node#value level hash key key_hash node) (All (_ k v) (-> Level Hash_Code k (Hash k) (Node k v) (Maybe v))) - (case node + (when node ... For #Hierarchy nodes, just look-up the key on its children. {#Hierarchy _size hierarchy} (let [index (level_index level hash)] @@ -489,7 +489,7 @@ {#Base bitmap base} (let [bit (level_bit_position level hash)] (if (with_bit_position? bit bitmap) - (case (array.item (base_index bit bitmap) base) + (when (array.item (base_index bit bitmap) base) {.#Left sub_node} (node#value (level_up level) hash key key_hash sub_node) @@ -508,7 +508,7 @@ (def (node#size node) (All (_ k v) (-> (Node k v) Nat)) - (case node + (when node {#Hierarchy _size hierarchy} (array.mix (function (_ _ item total) (n.+ item total)) @@ -520,7 +520,7 @@ (n.+ item total)) 0 (array.each (function (_ sub_node') - (case sub_node' + (when sub_node' {.#Left sub_node} (node#size sub_node) {.#Right _} 1)) base)) @@ -531,7 +531,7 @@ (def (node#mix f init node) (All (_ k v a) (-> (-> [k v] a a) a (Node k v) a)) - (case node + (when node {#Hierarchy _size hierarchy} (array.mix (function (_ _ sub_node current) (node#mix f current sub_node)) @@ -540,7 +540,7 @@ {#Base bitmap base} (array.mix (function (_ _ branch current) - (case branch + (when branch {.#Left sub_node} (node#mix f current sub_node) @@ -592,7 +592,7 @@ (def .public (key? dict key) (All (_ k v) (-> (Dictionary k v) k Bit)) - (case (value key dict) + (when (value key dict) {.#None} false @@ -603,13 +603,13 @@ (def .public (has' key val dict) (All (_ k v) (-> k v (Dictionary k v) (Try (Dictionary k v)))) - (case (value key dict) + (when (value key dict) {.#None} {try.#Success (has key val dict)} {.#Some _} (exception.except ..key_already_exists []))) (def .public (revised key f dict) (All (_ k v) (-> k (-> v v) (Dictionary k v) (Dictionary k v))) - (case (value key dict) + (when (value key dict) {.#None} dict @@ -664,7 +664,7 @@ (def .public (composite_with f dict2 dict1) (All (_ k v) (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) (node#mix (function (_ [key val2] dict) - (case (value key dict) + (when (value key dict) {.#None} (has key val2 dict) @@ -675,7 +675,7 @@ (def .public (re_bound from_key to_key dict) (All (_ k v) (-> k k (Dictionary k v) (Dictionary k v))) - (case (value from_key dict) + (when (value from_key dict) {.#None} dict @@ -688,7 +688,7 @@ (All (_ k v) (-> (List k) (Dictionary k v) (Dictionary k v))) (let [[key_hash _] dict] (list#mix (function (_ key new_dict) - (case (value key dict) + (when (value key dict) {.#None} new_dict {.#Some val} (has key val new_dict))) (empty key_hash) @@ -701,7 +701,7 @@ (and (n.= (..size reference) (..size subject)) (list.every? (function (_ [k rv]) - (case (..value k subject) + (when (..value k subject) {.#Some sv} (,#= rv sv) @@ -713,13 +713,13 @@ (All (_ k) (Functor (Node k))) (implementation (def (each f fa) - (case fa + (when fa {#Hierarchy size hierarchy} {#Hierarchy size (array.each (each f) hierarchy)} {#Base bitmap base} {#Base bitmap (array.each (function (_ either) - (case either + (when either {.#Left fa'} {.#Left (each f fa')} diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index 44848eae6..3541cef42 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -64,7 +64,7 @@ (let [... (open "_#[0]") (the #order dict) ] (loop (again [node (the #root dict)]) - (case node + (when node {.#None} {.#None} @@ -89,7 +89,7 @@ (let [... (open "_#[0]") (the #order dict) ] (loop (again [node (the #root dict)]) - (case node + (when node {.#None} false @@ -105,13 +105,13 @@ (with_template [ ] [(def .public ( dict) (All (_ k v) (-> (Dictionary k v) (Maybe v))) - (case (the #root dict) + (when (the #root dict) {.#None} {.#None} {.#Some node} (loop (again [node node]) - (case (the node) + (when (the node) {.#None} {.#Some (the #value node)} @@ -125,7 +125,7 @@ (def .public (size dict) (All (_ k v) (-> (Dictionary k v) Nat)) (loop (again [node (the #root dict)]) - (case node + (when node {.#None} 0 @@ -140,7 +140,7 @@ (with_template [ ] [(def ( self) (All (_ k v) (-> (Node k v) (Node k v))) - (case (the #color self) + (when (the #color self) {} (.has #color {} self) @@ -154,7 +154,7 @@ (def (with_left addition center) (All (_ k v) (-> (Node k v) (Node k v) (Node k v))) - (case (the #color center) + (when (the #color center) {#Red} (red (the #key center) (the #value center) @@ -167,9 +167,9 @@ (the #value center) {.#Some addition} (the #right center)))] - (case (the #color addition) + (when (the #color addition) {#Red} - (case (the #left addition) + (when (the #left addition) (^.multi {.#Some left} [(the #color left) {#Red}]) (red (the #key addition) @@ -181,7 +181,7 @@ (the #right center))}) _ - (case (the #right addition) + (when (the #right addition) (^.multi {.#Some right} [(the #color right) {#Red}]) (red (the #key right) @@ -203,7 +203,7 @@ (def (with_right addition center) (All (_ k v) (-> (Node k v) (Node k v) (Node k v))) - (case (the #color center) + (when (the #color center) {#Red} (red (the #key center) (the #value center) @@ -216,9 +216,9 @@ (the #value center) (the #left center) {.#Some addition}))] - (case (the #color addition) + (when (the #color addition) {#Red} - (case (the #right addition) + (when (the #right addition) (^.multi {.#Some right} [(the #color right) {#Red}]) (red (the #key addition) @@ -230,7 +230,7 @@ {.#Some (blackened right)}) _ - (case (the #left addition) + (when (the #left addition) (^.multi {.#Some left} [(the #color left) {#Red}]) (red (the #key left) @@ -254,7 +254,7 @@ (All (_ k v) (-> k v (Dictionary k v) (Dictionary k v))) (let [(open "_#[0]") (the #order dict) root' (loop (again [?root (the #root dict)]) - (case ?root + (when ?root {.#None} {.#Some (red key value {.#None} {.#None})} @@ -281,7 +281,7 @@ (def (left_balanced key value ?left ?right) (All (_ k v) (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) - (case ?left + (when ?left (^.multi {.#Some left} [(the #color left) {#Red}] [(the #left left) {.#Some left>>left}] @@ -310,7 +310,7 @@ (def (right_balanced key value ?left ?right) (All (_ k v) (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) - (case ?right + (when ?right (^.multi {.#Some right} [(the #color right) {#Red}] [(the #right right) {.#Some right>>right}] @@ -337,13 +337,13 @@ (def (without_left key value ?left ?right) (All (_ k v) (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) - (case ?left + (when ?left (^.multi {.#Some left} [(the #color left) {#Red}]) (red key value {.#Some (blackened left)} ?right) _ - (case ?right + (when ?right (^.multi {.#Some right} [(the #color right) {#Black}]) (right_balanced key value ?left {.#Some (reddened right)}) @@ -366,13 +366,13 @@ (def (without_right key value ?left ?right) (All (_ k v) (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) - (case ?right + (when ?right (^.multi {.#Some right} [(the #color right) {#Red}]) (red key value ?left {.#Some (blackened right)}) _ - (case ?left + (when ?left (^.multi {.#Some left} [(the #color left) {#Black}]) (left_balanced key value {.#Some (reddened left)} ?right) @@ -395,7 +395,7 @@ (def (prepended ?left ?right) (All (_ k v) (-> (Maybe (Node k v)) (Maybe (Node k v)) (Maybe (Node k v)))) - (case [?left ?right] + (when [?left ?right] [{.#None} _] ?right @@ -403,11 +403,11 @@ ?left [{.#Some left} {.#Some right}] - (case [(the #color left) (the #color right)] + (when [(the #color left) (the #color right)] [{#Red} {#Red}] (do maybe.monad [fused (prepended (the #right left) (the #right right))] - (case (the #color fused) + (when (the #color fused) {#Red} (in (red (the #key fused) (the #value fused) @@ -446,7 +446,7 @@ [{#Black} {#Black}] (do maybe.monad [fused (prepended (the #right left) (the #left right))] - (case (the #color fused) + (when (the #color fused) {#Red} (in (red (the #key fused) (the #value fused) @@ -477,7 +477,7 @@ (All (_ k v) (-> k (Dictionary k v) (Dictionary k v))) (let [(open "_#[0]") (the #order dict) [?root found?] (loop (again [?root (the #root dict)]) - (case ?root + (when ?root {.#Some root} (let [root_key (the #key root) root_val (the #value root)] @@ -486,7 +486,7 @@ (the #right root)) true] (let [go_left? (_#< root_key key)] - (case (again (if go_left? + (when (again (if go_left? (the #left root) (the #right root))) [{.#None} .false] @@ -494,7 +494,7 @@ [side_outcome _] (if go_left? - (case (the #left root) + (when (the #left root) (^.multi {.#Some left} [(the #color left) {#Black}]) [{.#Some (without_left root_key root_val side_outcome (the #right root))} @@ -503,7 +503,7 @@ _ [{.#Some (red root_key root_val side_outcome (the #right root))} false]) - (case (the #right root) + (when (the #right root) (^.multi {.#Some right} [(the #color right) {#Black}]) [{.#Some (without_right root_key root_val (the #left root) side_outcome)} @@ -518,7 +518,7 @@ {.#None} [{.#None} false] ))] - (case ?root + (when ?root {.#None} (if found? (.has #root ?root dict) @@ -530,7 +530,7 @@ (def .public (revised key transform dict) (All (_ k v) (-> k (-> v v) (Dictionary k v) (Dictionary k v))) - (case (..value key dict) + (when (..value key dict) {.#Some old} (..has key (transform old) dict) @@ -548,7 +548,7 @@ [(def .public ( dict) (All (_ k v) (-> (Dictionary k v) (List ))) (loop (again [node (the #root dict)]) - (case node + (when node {.#None} (list) @@ -570,7 +570,7 @@ (let [(open "/#[0]") (the #order reference)] (loop (again [entriesR (entries reference) entriesS (entries sample)]) - (case [entriesR entriesS] + (when [entriesR entriesS] [{.#End} {.#End}] true diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 4114acd8e..c2dff94fc 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except revised all only with) + [lux (.except revised all only with when) [abstract [monoid (.only Monoid)] [apply (.only Apply)] @@ -30,7 +30,7 @@ (Mix List) (implementation (def (mix f init xs) - (case xs + (.when xs {.#End} init @@ -39,7 +39,7 @@ (def .public (mixes f init inputs) (All (_ a b) (-> (-> a b b) b (List a) (List b))) - (case inputs + (.when inputs {.#End} (list init) @@ -57,7 +57,7 @@ (def .public (only keep? xs) (All (_ a) (-> (Predicate a) (List a) (List a))) - (case xs + (.when xs {.#End} {.#End} @@ -68,7 +68,7 @@ (def .public (partition satisfies? list) (All (_ a) (-> (Predicate a) (List a) [(List a) (List a)])) - (case list + (.when list {.#End} [{.#End} {.#End}] @@ -85,7 +85,7 @@ (def .public partial (macro (_ tokens state) - (case (reversed tokens) + (.when (reversed tokens) {.#Item tail heads} {.#Right [state (list (..mix (function (_ head tail) (` {.#Item (, head) (, tail)})) @@ -97,9 +97,9 @@ (def .public (pairs xs) (All (_ a) (-> (List a) (Maybe (List [a a])))) - (case xs + (.when xs (partial x1 x2 xs') - (case (pairs xs') + (.when (pairs xs') {.#Some tail} {.#Some (partial [x1 x2] tail)} @@ -117,7 +117,7 @@ (All (_ a) (-> Nat (List a) (List a))) (if (n.> 0 n) - (case xs + (.when xs {.#End} {.#End} @@ -133,7 +133,7 @@ [(def .public ( predicate xs) (All (_ a) (-> (Predicate a) (List a) (List a))) - (case xs + (.when xs {.#End} {.#End} @@ -149,9 +149,9 @@ (def .public (split_at n xs) (All (_ a) (-> Nat (List a) [(List a) (List a)])) - (case n + (.when n 0 [{.#End} xs] - _ (case xs + _ (.when xs {.#End} [{.#End} {.#End}] @@ -162,7 +162,7 @@ (def (split_when' predicate ys xs) (All (_ a) (-> (Predicate a) (List a) (List a) [(List a) (List a)])) - (case xs + (.when xs {.#End} [ys xs] @@ -179,7 +179,7 @@ (def .public (sub size list) (All (_ a) (-> Nat (List a) (List (List a)))) - (case list + (.when list {.#End} {.#End} @@ -190,14 +190,14 @@ (def .public (repeated n x) (All (_ a) (-> Nat a (List a))) - (case n + (.when n 0 {.#End} _ {.#Item x (repeated (-- n) x)})) (def (iterations' f x) (All (_ a) (-> (-> a (Maybe a)) a (List a))) - (case (f x) + (.when (f x) {.#Some x'} {.#Item x (iterations' f x')} @@ -207,7 +207,7 @@ (def .public (iterations f x) (All (_ a) (-> (-> a (Maybe a)) a (List a))) - (case (f x) + (.when (f x) {.#Some x'} {.#Item x (iterations' f x')} @@ -217,12 +217,12 @@ (def .public (one check xs) (All (_ a b) (-> (-> a (Maybe b)) (List a) (Maybe b))) - (case xs + (.when xs {.#End} {.#None} {.#Item x xs'} - (case (check x) + (.when (check x) {.#Some output} {.#Some output} @@ -235,7 +235,7 @@ (for @.js ... TODO: Stop relying on this ASAP. (mix (function (_ head tail) - (case (check head) + (.when (check head) {.#Some head} {.#Item head tail} @@ -243,12 +243,12 @@ tail)) {.#End} (reversed xs)) - (case xs + (.when xs {.#End} {.#End} {.#Item x xs'} - (case (check x) + (.when (check x) {.#Some output} {.#Item output (all check xs')} @@ -267,7 +267,7 @@ (def .public (interposed sep xs) (All (_ a) (-> a (List a) (List a))) - (case xs + (.when xs {.#End} xs @@ -285,7 +285,7 @@ [(def .public ( predicate items) (All (_ a) (-> (Predicate a) (List a) Bit)) - (case items + (.when items {.#End} @@ -300,12 +300,12 @@ (def .public (item i xs) (All (_ a) (-> Nat (List a) (Maybe a))) - (case xs + (.when xs {.#End} {.#None} {.#Item x xs'} - (case i + (.when i 0 {.#Some x} _ (item (-- i) xs')))) @@ -313,7 +313,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (List a)))) (implementation (def (= xs ys) - (case [xs ys] + (.when [xs ys] [{.#End} {.#End}] true @@ -342,7 +342,7 @@ (def identity {.#End}) (def (composite xs ys) - (case xs + (.when xs {.#End} ys @@ -355,7 +355,7 @@ (Functor List) (implementation (def (each f ma) - (case ma + (.when ma {.#End} {.#End} @@ -370,7 +370,7 @@ (def functor ..functor) (def (on fa ff) - (case ff + (.when ff {.#End} {.#End} @@ -392,7 +392,7 @@ (def .public (sorted < xs) (All (_ a) (-> (-> a a Bit) (List a) (List a))) - (case xs + (.when xs {.#End} (list) @@ -410,7 +410,7 @@ (def .public (empty? xs) (All (_ a) (Predicate (List a))) - (case xs + (.when xs {.#End} true @@ -419,7 +419,7 @@ (def .public (member? eq xs x) (All (_ a) (-> (Equivalence a) (List a) a Bit)) - (case xs + (.when xs {.#End} false @@ -430,7 +430,7 @@ (with_template [ ] [(def .public ( xs) (All (_ a) (-> (List a) (Maybe ))) - (case xs + (.when xs {.#End} {.#None} @@ -443,7 +443,7 @@ (def .public (indices size) (All (_ a) (-> Nat (List Nat))) - (case size + (.when size 0 (list) _ (|> size -- (enum.range n.enum 0)))) @@ -455,7 +455,7 @@ (-> Nat Text) (loop (again [input value output ""]) - (let [digit (case (n.% 10 input) + (let [digit (.when (n.% 10 input) 0 "0" 1 "1" 2 "2" @@ -469,13 +469,13 @@ _ (undefined)) output' ("lux text concat" digit output) input' (n./ 10 input)] - (case input' + (.when input' 0 output' _ (again input' output'))))) (def .public zipped (macro (_ tokens state) - (case tokens + (.when tokens (list [_ {.#Nat num_lists}]) (if (n.> 0 num_lists) (let [(open "[0]") ..functor @@ -498,7 +498,7 @@ list_vars (each product.right vars+lists) code (` (is (, zipped_type) (function ((, g!step) (,* list_vars)) - (case [(,* list_vars)] + (.when [(,* list_vars)] (, pattern) {.#Item [(,* (each product.left vars+lists))] ((, g!step) (,* list_vars))} @@ -516,7 +516,7 @@ (def .public zipped_with (macro (_ tokens state) - (case tokens + (.when tokens (list [_ {.#Nat num_lists}]) (if (n.> 0 num_lists) (let [(open "[0]") ..functor @@ -542,7 +542,7 @@ list_vars (each product.right vars+lists) code (` (is (, zipped_type) (function ((, g!step) (, g!func) (,* list_vars)) - (case [(,* list_vars)] + (.when [(,* list_vars)] (, pattern) {.#Item ((, g!func) (,* (each product.left vars+lists))) ((, g!step) (, g!func) (,* list_vars))} @@ -560,7 +560,7 @@ (def .public (last xs) (All (_ a) (-> (List a) (Maybe a))) - (case xs + (.when xs {.#End} {.#None} @@ -572,7 +572,7 @@ (def .public (inits xs) (All (_ a) (-> (List a) (Maybe (List a)))) - (case xs + (.when xs {.#End} {.#None} @@ -580,7 +580,7 @@ {.#Some {.#End}} {.#Item x xs'} - (case (inits xs') + (.when (inits xs') {.#None} (undefined) @@ -620,7 +620,7 @@ (All (_ a) (-> (List a) (List [Nat a]))) (loop (again [idx 0 xs xs]) - (case xs + (.when xs {.#End} {.#End} @@ -629,7 +629,7 @@ (def .public when (macro (_ tokens state) - (case tokens + (.when tokens (list test then) {.#Right [state (.list (` (.if (, test) (, then) @@ -640,11 +640,11 @@ (def .public (revised item revision it) (All (_ a) (-> Nat (-> a a) (List a) (List a))) - (case it + (.when it {.#End} {.#End} {.#Item head tail} - (case item + (.when item 0 {.#Item (revision head) tail} _ (revised (-- item) revision it)))) diff --git a/stdlib/source/library/lux/data/collection/list/property.lux b/stdlib/source/library/lux/data/collection/list/property.lux index a4480dabb..d249a3a4f 100644 --- a/stdlib/source/library/lux/data/collection/list/property.lux +++ b/stdlib/source/library/lux/data/collection/list/property.lux @@ -33,7 +33,7 @@ (def .public (value key properties) (All (_ a) (-> Text (List a) (Maybe a))) - (case properties + (when properties {.#End} {.#None} @@ -53,7 +53,7 @@ (def .public (contains? key properties) (All (_ a) (-> Text (List a) Bit)) - (case (..value key properties) + (when (..value key properties) {.#Some _} true @@ -62,7 +62,7 @@ (def .public (has key val properties) (All (_ a) (-> Text a (List a) (List a))) - (case properties + (when properties {.#End} (list [key val]) @@ -75,7 +75,7 @@ (def .public (revised key f properties) (All (_ a) (-> Text (-> a a) (List a) (List a))) - (case properties + (when properties {.#End} {.#End} @@ -86,7 +86,7 @@ (def .public (lacks key properties) (All (_ a) (-> Text (List a) (List a))) - (case properties + (when properties {.#End} properties diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index 0420c1954..05a5107c3 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -53,7 +53,7 @@ (def .public (next queue) (All (_ a) (-> (Queue a) (Queue a))) - (case (the #front queue) + (when (the #front queue) ... Empty... (.list) queue @@ -71,7 +71,7 @@ (def .public (end val queue) (All (_ a) (-> a (Queue a) (Queue a))) - (case (the #front queue) + (when (the #front queue) {.#End} (has #front (.list val) queue) diff --git a/stdlib/source/library/lux/data/collection/queue/priority.lux b/stdlib/source/library/lux/data/collection/queue/priority.lux index 0d02d0a09..bbd66f362 100644 --- a/stdlib/source/library/lux/data/collection/queue/priority.lux +++ b/stdlib/source/library/lux/data/collection/queue/priority.lux @@ -53,13 +53,13 @@ (def .public (size queue) (All (_ a) (-> (Queue a) Nat)) - (case (representation queue) + (when (representation queue) {.#None} 0 {.#Some tree} (loop (again [node tree]) - (case (tree.root node) + (when (tree.root node) {0 #0 _} 1 @@ -68,13 +68,13 @@ (def .public (member? equivalence queue member) (All (_ a) (-> (Equivalence a) (Queue a) a Bit)) - (case (representation queue) + (when (representation queue) {.#None} false {.#Some tree} (loop (again [node tree]) - (case (tree.root node) + (when (tree.root node) {0 #0 reference} (at equivalence = reference member) @@ -89,7 +89,7 @@ [tree (representation queue) .let [highest_priority (tree.tag tree)]] (loop (again [node tree]) - (case (tree.root node) + (when (tree.root node) {0 #0 reference} (if (n.= highest_priority (tree.tag node)) {.#None} @@ -97,13 +97,13 @@ {0 #1 left right} (if (n.= highest_priority (tree.tag left)) - (case (again left) + (when (again left) {.#None} {.#Some right} {.#Some =left} {.#Some (at ..builder branch =left right)}) - (case (again right) + (when (again right) {.#None} {.#Some left} @@ -114,7 +114,7 @@ (All (_ a) (-> Priority a (Queue a) (Queue a))) (let [addition (at ..builder leaf priority value)] (abstraction - (case (representation queue) + (when (representation queue) {.#None} {.#Some addition} diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 060c5a255..55c782acf 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -118,7 +118,7 @@ (if (array.lacks? sub_idx parent) ... If so, set the path to the tail (..path (level_down level) tail) - (case (array.item sub_idx parent) + (when (array.item sub_idx parent) ... If not, push the tail onto the sub_node. {#Hierarchy sub_node} {#Hierarchy (with_tail size (level_down level) tail sub_node)} @@ -138,7 +138,7 @@ (def (hierarchy#has level idx val hierarchy) (All (_ a) (-> Level Index a (Hierarchy a) (Hierarchy a))) (let [sub_idx (branch_idx (i64.right_shifted level idx))] - (case (array.item sub_idx hierarchy) + (when (array.item sub_idx hierarchy) {#Hierarchy sub_node} (|> (array.clone hierarchy) (array.has! sub_idx {#Hierarchy (hierarchy#has (level_down level) idx val sub_node)})) @@ -165,7 +165,7 @@ (maybe#each (function (_ sub) (|> (array.clone hierarchy) (array.has! sub_idx {#Hierarchy sub}))) - (case (array.item sub_idx hierarchy) + (when (array.item sub_idx hierarchy) {#Hierarchy sub} (without_tail size (level_down level) sub) @@ -180,7 +180,7 @@ (def (node#list node) (All (_ a) (-> (Node a) (List a))) - (case node + (when node {#Base base} (array.list {.#None} base) @@ -264,7 +264,7 @@ (let [index (branch_idx (i64.right_shifted level idx))] (if (array.lacks? index hierarchy) (exception.except ..base_was_not_found []) - (case [(n.> branching_exponent level) + (when [(n.> branching_exponent level) (array.item index hierarchy)] [.true {#Hierarchy sub}] (again (level_down level) sub) @@ -307,7 +307,7 @@ (def .public (prefix sequence) (All (_ a) (-> (Sequence a) (Sequence a))) - (case (the #size sequence) + (when (the #size sequence) 0 empty @@ -332,7 +332,7 @@ (with_expansions [ [level root]] (if (n.> branching_exponent level) (if (array.lacks? 1 root) - (case (array.item 0 root) + (when (array.item 0 root) {#Hierarchy sub_node} (again (level_down level) sub_node) @@ -375,7 +375,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) (implementation (def (= v1 v2) - (case [v1 v2] + (when [v1 v2] [{#Base b1} {#Base b2}] (array.= //#= b1 b2) @@ -400,7 +400,7 @@ (Mix Node) (implementation (def (mix $ init xs) - (case xs + (when xs {#Base base} (array.mix (function (_ _ item output) ($ item output)) init @@ -434,7 +434,7 @@ (Functor Node) (implementation (def (each $ xs) - (case xs + (when xs {#Base base} {#Base (array.each $ base)} @@ -491,7 +491,7 @@ (let [help (is (All (_ a) (-> (Predicate a) (Node a) Bit)) (function (help predicate node) - (case node + (when node {#Base base} ( predicate base) @@ -518,7 +518,7 @@ (def (one|node check items) (All (_ a b) (-> (-> a (Maybe b)) (Node a) (Maybe b))) - (case items + (when items {#Base items} (array.one check items) @@ -528,7 +528,7 @@ (def .public (one check items) (All (_ a b) (-> (-> a (Maybe b)) (Sequence a) (Maybe b))) - (case (let [... TODO: This binding was established to get around a compilation error. Fix and inline! + (when (let [... TODO: This binding was established to get around a compilation error. Fix and inline! check (..one|node check)] (|> items (the #root) diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux index 3b3e2039d..e08756a80 100644 --- a/stdlib/source/library/lux/data/collection/set/multi.lux +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -34,7 +34,7 @@ (def .public (has multiplicity elem set) (All (_ a) (-> Nat a (Set a) (Set a))) - (case multiplicity + (when multiplicity 0 set _ (|> set representation @@ -43,9 +43,9 @@ (def .public (lacks multiplicity elem set) (All (_ a) (-> Nat a (Set a) (Set a))) - (case multiplicity + (when multiplicity 0 set - _ (case (dictionary.value elem (representation set)) + _ (when (dictionary.value elem (representation set)) {.#Some current} (abstraction (if (n.> multiplicity current) diff --git a/stdlib/source/library/lux/data/collection/stack.lux b/stdlib/source/library/lux/data/collection/stack.lux index c53ba235a..c037e1a56 100644 --- a/stdlib/source/library/lux/data/collection/stack.lux +++ b/stdlib/source/library/lux/data/collection/stack.lux @@ -28,7 +28,7 @@ (def .public (value stack) (All (_ a) (-> (Stack a) (Maybe a))) - (case (representation stack) + (when (representation stack) {.#End} {.#None} @@ -37,7 +37,7 @@ (def .public (next stack) (All (_ a) (-> (Stack a) (Maybe [a (Stack a)]))) - (case (representation stack) + (when (representation stack) {.#End} {.#None} diff --git a/stdlib/source/library/lux/data/collection/stream.lux b/stdlib/source/library/lux/data/collection/stream.lux index 3c3a2cb29..bf39422ee 100644 --- a/stdlib/source/library/lux/data/collection/stream.lux +++ b/stdlib/source/library/lux/data/collection/stream.lux @@ -39,7 +39,7 @@ (-> [a (List a)] (Stream a))) (loop (again [head start tail next]) - (//.pending [head (case tail + (//.pending [head (when tail {.#End} (again start next) @@ -59,7 +59,7 @@ (def .public (item idx stream) (All (_ a) (-> Nat (Stream a) a)) (let [[head tail] (//.result stream)] - (case idx + (when idx 0 head _ (item (-- idx) tail)))) diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux index b8a654516..68d7e7157 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -58,7 +58,7 @@ (def .public (value tree) (All (_ @ t v) (-> (Tree @ t v) v)) - (case (the #root (representation tree)) + (when (the #root (representation tree)) {0 #0 value} value @@ -67,7 +67,7 @@ (def .public (tags tree) (All (_ @ t v) (-> (Tree @ t v) (List t))) - (case (the #root (representation tree)) + (when (the #root (representation tree)) {0 #0 value} (list (the #tag (representation tree))) @@ -77,7 +77,7 @@ (def .public (values tree) (All (_ @ t v) (-> (Tree @ t v) (List v))) - (case (the #root (representation tree)) + (when (the #root (representation tree)) {0 #0 value} (list value) @@ -92,7 +92,7 @@ (let [(open "tag//[0]") monoid] (loop (again [_tag tag//identity _node root]) - (case _node + (when _node {0 #0 value} {.#Some value} @@ -106,7 +106,7 @@ (def .public (exists? predicate tree) (All (_ @ t v) (-> (Predicate t) (Tree @ t v) Bit)) - (case (..one predicate tree) + (when (..one predicate tree) {.#Some _} true diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 1e403280e..b06a5c591 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -80,7 +80,7 @@ (def .public (start? zipper) (All (_ a) (-> (Zipper a) Bit)) - (case (the #family zipper) + (when (the #family zipper) {.#None} true @@ -89,7 +89,7 @@ (def .public (down zipper) (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) - (case (..children zipper) + (when (..children zipper) {.#End} {.#None} @@ -120,9 +120,9 @@ (with_template [ ] [(def .public ( zipper) (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) - (case (the #family zipper) + (when (the #family zipper) {.#Some family} - (case (the family) + (when (the family) {.#Item next side'} {.#Some (for @.old [#family {.#Some (|> family @@ -144,12 +144,12 @@ (def .public ( zipper) (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) - (case (the #family zipper) + (when (the #family zipper) {.#None} {.#None} {.#Some family} - (case (list.reversed (the family)) + (when (list.reversed (the family)) {.#End} {.#None} @@ -173,13 +173,13 @@ (def .public (next zipper) (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) - (case (..down zipper) + (when (..down zipper) {.#Some forward} {.#Some forward} {.#None} (loop (again [@ zipper]) - (case (..right @) + (when (..right @) {.#Some forward} {.#Some forward} @@ -190,12 +190,12 @@ (def (bottom zipper) (All (_ a) (-> (Zipper a) (Zipper a))) - (case (..right zipper) + (when (..right zipper) {.#Some forward} (bottom forward) {.#None} - (case (..down zipper) + (when (..down zipper) {.#Some forward} (bottom forward) @@ -204,12 +204,12 @@ (def .public (previous zipper) (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) - (case (..left zipper) + (when (..left zipper) {.#None} (..up zipper) {.#Some backward} - {.#Some (case (..down backward) + {.#Some (when (..down backward) {.#Some then} (..bottom then) @@ -219,13 +219,13 @@ (with_template [ ] [(def .public ( zipper) (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) - (case ( zipper) + (when ( zipper) {.#None} {.#None} {.#Some @} (loop (again [@ @]) - (case ( @) + (when ( @) {.#None} {.#Some @} @@ -238,7 +238,7 @@ (def .public (end? zipper) (All (_ a) (-> (Zipper a) Bit)) - (case (..end zipper) + (when (..end zipper) {.#None} true @@ -261,7 +261,7 @@ (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) (do maybe.monad [family (the #family zipper)] - (case (the #lefts family) + (when (the #lefts family) {.#End} (in (has [#node //.#children] (the #rights family) @@ -277,7 +277,7 @@ (with_template [ ] [(def .public ( value zipper) (All (_ a) (-> a (Zipper a) (Maybe (Zipper a)))) - (case (the #family zipper) + (when (the #family zipper) {.#None} {.#None} diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index bbccf6b7b..61e3d5593 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -249,9 +249,9 @@ t (|> +1.0 (f.- (|> +1.0 (f.- f) (f.* saturation))) (f.* brightness)) v brightness mod (|> i (f.% +6.0) f.int .nat) - 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))] + red (when mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) + green (when mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) + blue (when mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] (of_rgb [#red (..up red) #green (..up green) #blue (..up blue)]))) diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux index 80b0623cd..600068d16 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -55,7 +55,7 @@ (def .public (font font) (-> Font (CSS Special)) - (let [with_unicode (case (the /font.#unicode_range font) + (let [with_unicode (when (the /font.#unicode_range font) {.#Some unicode_range} (let [unicode_range' (format "U+" (at nat.hex encoded (the /font.#start unicode_range)) "-" (at nat.hex encoded (the /font.#end unicode_range)))] @@ -79,7 +79,7 @@ (def .public (import url query) (-> URL (Maybe Query) (CSS Special)) (abstraction (format (format "@import url(" (%.text url) ")") - (case query + (when query {.#Some query} (format " " (/query.query query)) diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index 3845d2cb6..4675c0385 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -918,7 +918,7 @@ (def (with_hint [hint stop]) (-> [(Maybe Hint) Stop] Text) - (case hint + (when hint {.#None} (representation Stop stop) @@ -1073,7 +1073,7 @@ Stop (List/1 [(Maybe Hint) Stop]) (Value Image)) (let [after_extent (format "at " (representation location)) - with_extent (case extent + with_extent (when extent {.#Some extent} (format (..extent extent) " " after_extent) @@ -1155,7 +1155,7 @@ (def .public (font_family options) (-> (List Font) (Value Font)) - (case options + (when options {.#Item _} (|> options (list#each ..font_name) diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index 15d20bb2d..d01f92b22 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -46,7 +46,7 @@ (def (target value) (-> Target Text) - (case value + (when value {#Blank} "_blank" {#Parent} "_parent" {#Self} "_self" @@ -176,7 +176,7 @@ (def .public (base href target) (-> URL (Maybe Target) Meta) (let [partial (list ["href" href]) - full (case target + full (when target {.#Some target} (list.partial ["target" (..target target)] partial) @@ -286,7 +286,7 @@ (def (area attributes shape) (-> Attributes Shape (HTML Any)) - (case shape + (when shape {#Rectangle rectangle} (..rectangle attributes rectangle) @@ -300,7 +300,7 @@ (-> Attributes (List [Attributes Shape]) Image Image) (all ..and for - (case (list#each (product.uncurried ..area) areas) + (when (list#each (product.uncurried ..area) areas) {.#End} (..empty "map" attributes) @@ -348,7 +348,7 @@ [(def .public ( description attributes content) (-> (Maybe Content) Attributes ) (..tag attributes - (case description + (when description {.#Some description} (all ..and (..tag (list) description) @@ -462,7 +462,7 @@ (def .public (description_list attributes descriptions) (-> Attributes (List [Content Element]) Element) - (case (list#each (function (_ [term description]) + (when (list#each (function (_ [term description]) (all ..and (..term term) (..description description))) @@ -524,7 +524,7 @@ (def .public (table attributes caption columns headers rows footer) (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element) (let [head (..table_head (..table_row headers)) - content (case (list#each table_row rows) + content (when (list#each table_row rows) {.#End} head @@ -532,21 +532,21 @@ (..and head (..table_body (list#mix (function.flipped ..and) first rest)))) - content (case footer + content (when footer {.#None} content {.#Some footer} (..and content (..table_foot (..table_row footer)))) - content (case columns + content (when columns {.#None} content {.#Some columns} (..and (..columns_group columns) content)) - content (case caption + content (when caption {.#None} content diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 3dd15f400..a5b036478 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -62,7 +62,7 @@ (def .public null? (Predicate JSON) - (|>> (pipe.case {#Null} true + (|>> (pipe.when {#Null} true _ false))) (def .public object @@ -98,7 +98,7 @@ (def (jsonF token) (-> JSON' Code) - (case token + (when token {#Null' _} (` {..#Null}) @@ -128,7 +128,7 @@ (def .public (fields json) (-> JSON (Try (List String))) - (case json + (when json {#Object obj} {try.#Success (dictionary.keys obj)} @@ -137,9 +137,9 @@ (def .public (field key json) (-> String JSON (Try JSON)) - (case json + (when json {#Object obj} - (case (dictionary.value key obj) + (when (dictionary.value key obj) {.#Some value} {try.#Success value} @@ -151,7 +151,7 @@ (def .public (has key value json) (-> String JSON JSON (Try JSON)) - (case json + (when json {#Object obj} {try.#Success {#Object (dictionary.has key value obj)}} @@ -161,7 +161,7 @@ (with_template [ ] [(def .public ( key json) (-> Text JSON (Try )) - (case (field key json) + (when (field key json) {try.#Success { value}} {try.#Success value} @@ -182,7 +182,7 @@ (Equivalence JSON) (implementation (def (= x y) - (case [x y] + (when [x y] [{#Null} {#Null}] true @@ -209,7 +209,7 @@ (and (n.= (dictionary.size xs) (dictionary.size ys)) (list#mix (function (_ [xk xv] prev) (and prev - (case (dictionary.value xk ys) + (when (dictionary.value xk ys) {.#None} false {.#Some yv} (= xv yv)))) true @@ -228,7 +228,7 @@ (def boolean_format (-> Boolean Text) - (|>> (pipe.case + (|>> (pipe.when .false "false" @@ -237,7 +237,7 @@ (def number_format (-> Number Text) - (|>> (pipe.case + (|>> (pipe.when +0.0 ... OR -0.0 "0.0" @@ -294,7 +294,7 @@ (def .public (format json) (-> JSON Text) - (case json + (when json (^.with_template [ ] [{ value} ( value)]) @@ -359,7 +359,7 @@ signed?' (<>.parses? (.this "-")) offset (.many .decimal)] (in (all text#composite mark (if signed?' "-" "") offset))))] - (case (f#decoded (all text#composite (if signed? "-" "") digits "." decimals exp)) + (when (f#decoded (all text#composite (if signed? "-" "") digits "." decimals exp)) {try.#Failure message} (<>.failure message) diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index 4b8e1a4a2..f6faa4820 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -110,7 +110,7 @@ (|>> list.enumeration (list#each (function (_ [idx [summary detail]]) (format "1. " (representation summary) - (case detail + (when detail {.#Some detail} (|> detail representation @@ -128,7 +128,7 @@ (Markdown Block)) (|>> (list#each (function (_ [summary detail]) (format "* " (representation summary) - (case detail + (when detail {.#Some detail} (|> detail representation diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index aad8579af..360ceeb11 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -236,16 +236,16 @@ (def (un_padded string) (-> Binary Binary) - (case (binary!.size string) + (when (binary!.size string) 0 string size (loop (again [end (-- size)]) - (case end + (when end 0 (at utf8.codec encoded "") _ (let [last_char (binary!.bits_8 end string)] - (`` (case (.nat last_char) + (`` (when (.nat last_char) (char (,, (static ..null))) (again (-- end)) @@ -434,7 +434,7 @@ (Parser Link_Flag) (do <>.monad [it .bits_8] - (case (.nat it) + (when (.nat it) (^.with_template [ ] [ (in )]) @@ -597,7 +597,7 @@ (-> Big Nat) (n.+ (n./ ..block_size (..from_big size)) - (case (n.% ..block_size (..from_big size)) + (when (n.% ..block_size (..from_big size)) 0 0 _ 1))) @@ -729,7 +729,7 @@ (def entry_format (Format Entry) - (|>> (pipe.case + (|>> (pipe.when {#Normal value} (..normal_file_format value) {#Symbolic_Link value} (..symbolic_link_format value) {#Directory value} (..directory_format value) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 3635c56f3..0978967f1 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -62,7 +62,7 @@ (<>.codec int.decimal) .slice .many! - (case hex? + (when hex? {.#None} .decimal! @@ -95,7 +95,7 @@ (do <>.monad [first_part xml_identifier ?second_part (<| <>.maybe (<>.after (.this ..namespace_separator)) xml_identifier)] - (case ?second_part + (when ?second_part {.#None} (in ["" first_part]) @@ -213,7 +213,7 @@ (def .public (tag [namespace name]) (-> Tag Text) - (case namespace + (when namespace "" name _ (all text#composite namespace ..namespace_separator name))) @@ -248,7 +248,7 @@ ..xml_header text.new_line (loop (again [prefix "" input input]) - (case input + (when input {#Text value} (sanitize_value value) @@ -282,7 +282,7 @@ (Equivalence XML) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Text reference/value} {#Text sample/value}] (text#= reference/value sample/value) diff --git a/stdlib/source/library/lux/data/sum.lux b/stdlib/source/library/lux/data/sum.lux index 03e26b25d..0ed2931d1 100644 --- a/stdlib/source/library/lux/data/sum.lux +++ b/stdlib/source/library/lux/data/sum.lux @@ -19,7 +19,7 @@ (-> (-> a c) (-> b c) (-> (Or a b) c))) (function (_ input) - (case input + (when input {0 #0 l} (on_left l) {0 #1 r} (on_right r)))) @@ -28,14 +28,14 @@ (-> (-> l l') (-> r r') (-> (Or l r) (Or l' r')))) (function (_ input) - (case input + (when input {0 #0 l} {0 #0 (on_left l)} {0 #1 r} {0 #1 (on_right r)}))) (with_template [ ] [(def .public ( items) (All (_ a b) (-> (List (Or a b)) (List ))) - (case items + (when items {.#End} {.#End} @@ -51,13 +51,13 @@ (def .public (partition xs) (All (_ a b) (-> (List (Or a b)) [(List a) (List b)])) - (case xs + (when xs {.#End} [{.#End} {.#End}] {.#Item x xs'} (let [[lefts rights] (partition xs')] - (case x + (when x {0 #0 x'} [{.#Item x' lefts} rights] {0 #1 x'} [lefts {.#Item x' rights}])))) @@ -65,7 +65,7 @@ (All (_ l r) (-> (Equivalence l) (Equivalence r) (Equivalence (Or l r)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{.#Left reference} {.#Left sample}] (at left = reference sample) @@ -82,7 +82,7 @@ (..equivalence (at left equivalence) (at right equivalence))) (def (hash value) - (.nat (case value + (.nat (when value {.#Left value} ("lux i64 *" +2 (.int (at left hash value))) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index e9fa52957..8502d1d76 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -71,7 +71,7 @@ output (is (Maybe Nat) {.#None})]) (let [output' ("lux text index" offset part text)] - (case output' + (when output' {.#None} output @@ -80,7 +80,7 @@ (def .public (starts_with? prefix x) (-> Text Text Bit) - (case (index prefix x) + (when (index prefix x) {.#Some 0} true @@ -89,7 +89,7 @@ (def .public (ends_with? postfix x) (-> Text Text Bit) - (case (last_index postfix x) + (when (last_index postfix x) {.#Some n} (n.= (size x) (n.+ (size postfix) n)) @@ -104,7 +104,7 @@ (def .public (contains? sub text) (-> Text Text Bit) - (case ("lux text index" 0 sub text) + (when ("lux text index" 0 sub text) {.#Some _} true @@ -146,7 +146,7 @@ (def .public (split_at at x) (-> Nat Text (Maybe [Text Text])) - (case [(..clip 0 at x) (..clip_since at x)] + (when [(..clip 0 at x) (..clip_since at x)] [{.#Some pre} {.#Some post}] {.#Some [pre post]} @@ -165,7 +165,7 @@ (-> Text Text (List Text)) (loop (again [input sample output (is (List Text) (list))]) - (case (..split_by token input) + (when (..split_by token input) {.#Some [pre post]} (|> output {.#Item pre} @@ -185,9 +185,9 @@ (for @.js (these (def defined? (macro (_ tokens lux) - (case tokens + (when tokens (list it) - {.#Right [lux (list (` (.case ("js type-of" ("js constant" (, it))) + {.#Right [lux (list (` (.when ("js type-of" ("js constant" (, it))) "undefined" .false @@ -198,7 +198,7 @@ {.#Left ""}))) (def if_nashorn (macro (_ tokens lux) - (case tokens + (when tokens (list then else) {.#Right [lux (list (if (and (..defined? "java") (..defined? "java.lang") @@ -215,7 +215,7 @@ (with_expansions [... Inefficient default (loop (again [left "" right template]) - (case (..split_by pattern right) + (when (..split_by pattern right) {.#Some [pre post]} (again (all "lux text concat" left pre replacement) post) @@ -320,13 +320,13 @@ (def .public (interposed separator texts) (-> Text (List Text) Text) - (case separator + (when separator "" (..together texts) _ (|> texts (list.interposed separator) ..together))) (def .public (empty? text) (-> Text Bit) - (case text + (when text "" true _ false)) @@ -347,7 +347,7 @@ [..carriage_return] [..form_feed] )] - (`` (case char + (`` (when char _ diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 85f038d05..2ce6021a6 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -72,7 +72,7 @@ (-> Char Bit) (or (n.< ..ascii_bottom char) (n.> ..ascii_top char) - (case char + (when char (^.with_template [] [ true]) @@ -97,7 +97,7 @@ (-> Char Nat Nat Text Text [Text Text Nat]) (let [code (at n.hex encoded char) replacement (format ..sigil "u" - (case ("lux text size" code) + (when ("lux text size" code) 1 (format "000" code) 2 (format "00" code) 3 (format "0" code) @@ -117,7 +117,7 @@ current text limit ("lux text size" text)]) (if (n.< limit offset) - (case ("lux text char" offset current) + (when ("lux text char" offset current) (^.with_template [ ] [ (let [[previous' current' limit'] (ascii_escaped offset limit previous current)] @@ -180,7 +180,7 @@ (def (unicode_un_escaped offset previous current limit) (-> Nat Text Text Nat (Try [Text Text Nat])) - (case (|> current + (when (|> current ("lux text clip" (n.+ ..ascii_escape_offset offset) ..code_size) (at n.hex decoded)) {try.#Success char} @@ -201,11 +201,11 @@ current text limit ("lux text size" text)]) (if (n.< limit offset) - (case ("lux text char" offset current) + (when ("lux text char" offset current) ..sigil_char (let [@sigil (++ offset)] (if (n.< limit @sigil) - (case ("lux text char" @sigil current) + (when ("lux text char" @sigil current) (^.with_template [ ] [ (let [[previous' current' limit'] (..ascii_un_escaped offset previous current limit)] @@ -235,13 +235,13 @@ _ (again (++ offset) previous current limit)) - {try.#Success (case previous + {try.#Success (when previous "" current _ (format previous current))}))) (def .public literal (syntax (_ [literal .text]) - (case (..un_escaped literal) + (when (..un_escaped literal) {try.#Success un_escaped} (in (list (code.text un_escaped))) diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index d8d094f6e..09dba9073 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -111,7 +111,7 @@ parts (<>.many (all <>.either re_range^ re_options^))] - (in (case negate? + (in (when negate? {.#Some _} (` (.not (all <>.either (,* parts)))) {.#None} (` (all <>.either (,* parts))))))) @@ -219,7 +219,7 @@ (do <>.monad [base (re_simple^ current_module) quantifier (.one_of "?*+")] - (case quantifier + (when quantifier "?" (in (` (<>.else "" (, base)))) @@ -290,7 +290,7 @@ [Nat (List Code) (List (List Code))] [Nat (List Code) (List (List Code))]) (function (_ part [idx names steps]) - (case part + (when part (^.or {.#Left complex} {.#Right [{#Non_Capturing} complex]}) [idx @@ -300,7 +300,7 @@ steps)] {.#Right [{#Capturing [?name num_captures]} scoped]} - (let [[idx! name!] (case ?name + (let [[idx! name!] (when ?name {.#Some _name} [idx (code.symbol ["" _name])] @@ -335,12 +335,12 @@ (def .public (or left right) (All (_ l r) (-> (Parser [Text l]) (Parser [Text r]) (Parser [Text (Or l r)]))) (function (_ input) - (case (left input) + (when (left input) {try.#Success [input' [lt lv]]} {try.#Success [input' [lt {0 #0 lv}]]} {try.#Failure _} - (case (right input) + (when (right input) {try.#Success [input' [rt rv]]} {try.#Success [input' [rt {0 #1 rv}]]} @@ -350,12 +350,12 @@ (def .public (either left right) (All (_ l r) (-> (Parser [Text l]) (Parser [Text r]) (Parser Text))) (function (_ input) - (case (left input) + (when (left input) {try.#Success [input' [lt lv]]} {try.#Success [input' lt]} {try.#Failure _} - (case (right input) + (when (right input) {try.#Success [input' [rt rv]]} {try.#Success [input' rt]} @@ -418,7 +418,7 @@ (syntax (_ [pattern .text]) (do meta.monad [current_module meta.current_module_name] - (case (.result (regex^ current_module) + (when (.result (regex^ current_module) pattern) {try.#Failure error} (meta.failure (format "Error while parsing regular-expression:" //.new_line diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index 13c5d4f47..771fb287f 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -217,7 +217,7 @@ (-> Set Char Bit) (loop (again [tree (representation set)]) (if (//block.within? (tree.tag tree) character) - (case (tree.root tree) + (when (tree.root tree) {0 #0 _} true diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index ad5fa71fb..88df6bc7b 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -148,7 +148,7 @@ Inspector (with_expansions [ (let [object (as java/lang/Object value)] (`` (<| (,, (with_template [ ] - [(case (ffi.as object) + [(when (ffi.as object) {.#Some value} (`` (|> value (,, (template.spliced )))) @@ -159,16 +159,16 @@ [java/lang/Number [java/lang/Number::doubleValue ffi.of_double %.frac]] [java/lang/String [ffi.of_string %.text]] )) - (case (ffi.as [java/lang/Object] object) + (when (ffi.as [java/lang/Object] object) {.#Some value} (let [value (as (array.Array java/lang/Object) value)] - (case (array.item 0 value) + (when (array.item 0 value) (^.multi {.#Some tag} [(ffi.as java/lang/Integer tag) {.#Some tag}] [[(array.item 1 value) (array.item 2 value)] [last? {.#Some choice}]]) - (let [last? (case last? + (let [last? (when last? {.#Some _} #1 {.#None} #0)] (|> (%.format (%.nat (.nat (ffi.of_long (java/lang/Integer::longValue tag)))) @@ -184,7 +184,7 @@ @.jvm @.js - (case (ffi.type_of value) + (when (ffi.type_of value) (^.with_template [ ] [ (`` (|> value (,, (template.spliced ))))]) @@ -219,7 +219,7 @@ (JSON::stringify value)) @.python - (case (..str (..type value)) + (when (..str (..type value)) (^.with_template [ ] [(^.or ) (`` (|> value (,, (template.spliced ))))]) @@ -234,7 +234,7 @@ (^.or "" "") (let [variant (as (array.Array Any) value)] - (case (array.size variant) + (when (array.size variant) 3 (let [variant_tag ("python array read" 0 variant) variant_flag ("python array read" 1 variant) variant_value ("python array read" 2 variant)] @@ -251,7 +251,7 @@ (..str value)) @.lua - (case (..type value) + (when (..type value) (^.with_template [ ] [ (`` (|> value (,, (template.spliced ))))]) @@ -260,7 +260,7 @@ ["nil" [(pipe.new "nil" [])]]) "number" - (case (math::type value) + (when (math::type value) {.#Some "integer"} (|> value (as .Int) %.int) {.#Some "float"} (|> value (as .Frac) %.frac) @@ -324,7 +324,7 @@ (to_s value))))) @.php - (case (..gettype value) + (when (..gettype value) (^.with_template [ ] [ (`` (|> value (,, (template.spliced ))))]) @@ -451,14 +451,14 @@ (let [[lefts right? sub_repr] (loop (again [lefts 0 representations membersR+ variantV variantV]) - (case representations + (when representations {.#Item leftR {.#Item rightR extraR+}} - (case (as (Or Any Any) variantV) + (when (as (Or Any Any) variantV) {.#Left left} [lefts #0 (leftR left)] {.#Right right} - (case extraR+ + (when extraR+ {.#End} [lefts #1 (rightR right)] @@ -476,7 +476,7 @@ (in (function (_ tupleV) (let [tuple_body (loop (again [representations membersR+ tupleV tupleV]) - (case representations + (when representations {.#End} "" @@ -500,7 +500,7 @@ (do <>.monad [[funcT inputsT+] (.applied (<>.and .any (<>.many .any)))] - (case (type.applied inputsT+ funcT) + (when (type.applied inputsT+ funcT) {.#Some outputT} (.local (list outputT) representation) @@ -516,7 +516,7 @@ (def .public (representation type value) (-> Type Any (Try Text)) - (case (.result ..representation_parser type) + (when (.result ..representation_parser type) {try.#Success representation} {try.#Success (representation value)} @@ -576,7 +576,7 @@ list.reversed (dictionary.of_list text.hash))] targets (is (Meta (List Target)) - (case targets + (when targets {.#End} (|> environment dictionary.keys @@ -594,7 +594,7 @@ (exception.report (.list (,* (|> targets (list#each (function (_ [name format]) - (let [format (case format + (let [format (when format {.#None} (` ..inspection) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index c12774068..dc8e85722 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -54,7 +54,7 @@ (def (reference_column code) (-> Code Nat) - (case code + (when code (^.with_template [] [[[_ _ column] { _}] column]) @@ -91,7 +91,7 @@ (def (code_documentation expected_module old_location reference_column example) (-> Text Location Nat Code [Location Text]) - (case example + (when example [new_location {.#Symbol [module short]}] (let [documentation (cond (text#= expected_module module) short @@ -139,7 +139,7 @@ (def (fragment_documentation module fragment) (-> Text Fragment Text) - (case fragment + (when fragment {#Comment comment} (format "... " comment) @@ -176,7 +176,7 @@ (-> [Text (List Text)] Nat Nat Text) (if (type_parameter? id) (let [parameter_id (..parameter_id level id)] - (case (list.item parameter_id type_function_arguments) + (when (list.item parameter_id type_function_arguments) {.#Some found} found @@ -206,7 +206,7 @@ (def (%type' level type_function_name nestable? module type) (-> Nat Text Bit Text Type Text) - (case type + (when type {.#Primitive name params} (|> params (list#each (|>> (%type' level type_function_name false module) @@ -292,9 +292,9 @@ (def (parameterized_type arity type) (-> Nat Type (Maybe Type)) - (case arity + (when arity 0 {.#Some type} - _ (case type + _ (when type {.#UnivQ _env _type} (parameterized_type (-- arity) _type) @@ -303,15 +303,15 @@ (def (type_definition' nestable? level arity type_function_info tags module type) (-> Bit Nat Nat [Text (List Text)] (List Text) Text Type Text) - (case tags + (when tags (list single_tag) (format "(Record" \n " [#" single_tag " " (type_definition' false level arity type_function_info {.#None} module type) "])") _ - (case type + (when type {.#Primitive name params} - (case params + (when params {.#End} (format "(Primitive " (%.text name) ")") @@ -320,7 +320,7 @@ {.#Sum _} (let [members (type.flat_variant type)] - (case tags + (when tags {.#End} (format "(Or " (|> members @@ -332,7 +332,7 @@ (|> members (list.zipped_2 tags) (list#each (function (_ [t_name type]) - (case type + (when type {.#Product _} (let [types (type.flat_tuple type)] (format " {" t_name " " @@ -348,7 +348,7 @@ {.#Product _} (let [members (type.flat_tuple type)] - (case tags + (when tags {.#End} (format "[" (|> members (list#each (type_definition' false level arity type_function_info {.#None} module)) (text.interposed " ")) "]") @@ -382,7 +382,7 @@ (let [[level' body] ( type) args (level_parameters (n.- arity level) level') body_doc (type_definition' nestable? (n.+ level level') arity type_function_info tags module body) - fn_name (case type_function_info + fn_name (when type_function_info [fn_name {.#End}] fn_name _ "_")] (format "(" " " "(" fn_name " " (text.interposed " " args) ")" @@ -427,7 +427,7 @@ (def .public (type_definition module [name parameters] tags type) (-> Text [Text (List Text)] (List Text) Type Text) (let [arity (list.size parameters)] - (case (parameterized_type arity type) + (when (parameterized_type arity type) {.#Some type} (type_definition' true (-- arity) arity [name parameters] tags module type) @@ -447,7 +447,7 @@ (Parser Symbol) (do <>.monad [name .symbol] - (case name + (when name ["" _] (<>.failure (exception.error ..unqualified_symbol [name])) @@ -498,7 +498,7 @@ ... Name (<| (md.heading/3) (, (code.text (%.code (let [g!name (|> name product.right code.local)] - (case parameters + (when parameters {.#End} g!name @@ -534,7 +534,7 @@ (in (list (` (all md.then (,* minimal) ... Description - (,* (case description + (,* (when description {.#Some description} (list (` (<| md.paragraph md.text @@ -543,7 +543,7 @@ {.#None} (list))) ... Examples - (,* (case examples + (,* (when examples {.#End} (list) @@ -574,7 +574,7 @@ (syntax (_ [[name parameters] ..declaration extra (<>.some .any)]) (do meta.monad - [documentation (expansion.single (` ((, (case extra + [documentation (expansion.single (` ((, (when extra (list) (` ..minimal_definition_documentation) @@ -606,7 +606,7 @@ (def coverage_format (-> (List Text) Text) (list#mix (function (_ short aggregate) - (case aggregate + (when aggregate "" short _ (format aggregate ..coverage_separator short))) "")) @@ -641,7 +641,7 @@ (md.heading/1 (the #module module)) ... Description - (case (the #description module) + (when (the #description module) "" md.empty description (<| md.paragraph md.text @@ -656,7 +656,7 @@ ..definitions_documentation) ... Missing documentation - (case (|> definitions + (when (|> definitions (list#mix (function (_ definition missing) (set.lacks (symbol.short (the #global definition)) missing)) _#coverage) @@ -670,7 +670,7 @@ (..listing missing))) ... Un-expected documentation - (case (|> definitions + (when (|> definitions (list.only (|>> (the #global) symbol.short (set.member? _#coverage) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index b244493a6..be31fd27a 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -333,7 +333,7 @@ (def (primitive_type mode type) (-> Primitive_Mode (Type Primitive) Code) - (case mode + (when mode {#ManualPrM} (cond (at jvm.equivalence = jvm.boolean type) (` ..Boolean) (at jvm.equivalence = jvm.byte type) (` ..Byte) @@ -370,7 +370,7 @@ (-> (-> (Type Value) Code) (-> (Type Parameter) Code)) (`` (<| (,, (with_template [ ] - [(case ( type) + [(when ( type) {.#Some } @@ -384,7 +384,7 @@ (` (.Primitive (, (code.text name)) [(,* (list#each (parameter_type value_type) parameters))]))] [parser.array? elementT - (case (parser.primitive? elementT) + (when (parser.primitive? elementT) {.#Some elementT} (` {.#Primitive (, (code.text (..reflection (jvm.array elementT)))) {.#End}}) @@ -397,7 +397,7 @@ (def (value_type mode type) (-> Primitive_Mode (Type Value) Code) (`` (<| (,, (with_template [ ] - [(case ( type) + [(when ( type) {.#Some } @@ -885,7 +885,7 @@ (def (privacy_modifier$ pm) (-> Privacy Code) - (case pm + (when pm {#PublicP} (code.text "public") {#PrivateP} (code.text "private") {#ProtectedP} (code.text "protected") @@ -893,7 +893,7 @@ (def (inheritance_modifier$ im) (-> Inheritance Code) - (case im + (when im {#FinalI} (code.text "final") {#AbstractI} (code.text "abstract") {#DefaultI} (code.text "default"))) @@ -935,14 +935,14 @@ (def (state_modifier$ it) (-> State Code) - (case it + (when it {#VolatileS} (' "volatile") {#FinalS} (' "final") {#DefaultS} (' "default"))) (def (field_decl$ [[name pm anns] field]) (-> [Member_Declaration FieldDecl] Code) - (case field + (when field {#ConstantField class value} (` ("constant" (, (code.text name)) [(,* (list#each annotation$ anns))] @@ -1126,9 +1126,9 @@ (list#each (function (_ [member field]) [(the #member_name member) [member field]])) (dictionary.of_list text.hash))]] - (case (dictionary.value field fields) + (when (dictionary.value field fields) {.#Some [member {#VariableField _ static? :field:}]} - (case [static? this] + (when [static? this] [.true {.#None}] (in (list (` ("jvm member get static" (, (code.text class_name)) @@ -1156,14 +1156,14 @@ (list#each (function (_ [member field]) [(the #member_name member) [member field]])) (dictionary.of_list text.hash))]] - (case (dictionary.value field fields) + (when (dictionary.value field fields) {.#Some [member {#VariableField state static? :field:}]} - (case state + (when state {#FinalS} (meta.failure (exception.error ..cannot_set_field [class_name field])) _ - (case [static? this] + (when [static? this] [.true {.#None}] (in (list (` ("jvm member put static" (, (code.text class_name)) @@ -1210,7 +1210,7 @@ (list#each (function (_ [member virtual]) [(the #member_name member) [member virtual]])) (dictionary.of_list text.hash))]] - (case (dictionary.value method virtuals) + (when (dictionary.value method virtuals) {.#Some [member method]} (let [expected_arguments (list.size (the #method_inputs method)) actual_arguments (list.size inputs)] @@ -1233,7 +1233,7 @@ (def (method_declaration [member definition]) (-> [Member_Declaration Method_Definition] (Maybe [Member_Declaration MethodDecl])) - (case definition + (when definition {#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs} {.#Some [member [#method_tvars type_vars @@ -1247,14 +1247,14 @@ (def (method_def$ fully_qualified_class_name class_vars super_class fields methods [method_declaration method_def]) (-> External (List (Type Var)) (Type Class) (List [Member_Declaration FieldDecl]) (List [Member_Declaration Method_Definition]) [Member_Declaration Method_Definition] (Meta Code)) (let [[name pm anns] method_declaration - virtual_methods (case (list.all ..method_declaration methods) + virtual_methods (when (list.all ..method_declaration methods) {.#End} (list) virtual_methods (list (` (..with_call [(, (declaration$ (jvm.declaration fully_qualified_class_name class_vars))) [(,* (list#each method_decl$$ virtual_methods))]]))))] - (case method_def + (when method_def {#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs} (meta#in (` ("init" (, (privacy_modifier$ pm)) @@ -1426,7 +1426,7 @@ (def .public !!! (syntax (_ [expr .any]) (with_symbols [g!value] - (in (list (` (.case (, expr) + (in (list (` (.when (, expr) {.#Some (, g!value)} (, g!value) @@ -1444,7 +1444,7 @@ {.#Some (.as (, class_type) (, g!unchecked))} {.#None}))] - (case unchecked + (when unchecked {.#Some unchecked} (in (list (` (.is (, check_type) (let [(, g!unchecked) (, unchecked)] @@ -1483,12 +1483,12 @@ (def (member_type_vars class_tvars member) (-> (List (Type Var)) Import_Member_Declaration (List (Type Var))) - (case member + (when member {#ConstructorDecl [commons _]} (list#composite class_tvars (the #import_member_tvars commons)) {#MethodDecl [commons _]} - (case (the #import_member_kind commons) + (when (the #import_member_kind commons) {#StaticIMK} (the #import_member_tvars commons) @@ -1500,7 +1500,7 @@ (def (member_def_arg_bindings vars member) (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)])) - (case member + (when member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) (let [(open "[0]") commons] (do [! meta.monad] @@ -1525,7 +1525,7 @@ (def (with_return_maybe member never_null? unboxed return_term) (-> Import_Member_Declaration Bit (Type Value) Code Code) - (case member + (when member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) (cond (or never_null? (dictionary.key? ..boxes unboxed)) @@ -1548,7 +1548,7 @@ (with_template [ ] [(def ( member return_term) (-> Import_Member_Declaration Code Code) - (case member + (when member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) (if (the commons) @@ -1565,7 +1565,7 @@ [(def ( mode [unboxed raw]) (-> Primitive_Mode [(Type Value) Code] Code) (let [[unboxed refined post] (.is [(Type Value) Code (List Code)] - (case mode + (when mode {#ManualPrM} [unboxed raw (list)] @@ -1586,13 +1586,13 @@ (` ("jvm object cast" (, raw))) raw) (list)])))) - unboxed/boxed (case (dictionary.value unboxed ..boxes) + unboxed/boxed (when (dictionary.value unboxed ..boxes) {.#Some boxed} ( unboxed boxed refined) {.#None} refined)] - (case post + (when post {.#End} unboxed/boxed @@ -1656,12 +1656,12 @@ (def (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix import_format) (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text Text (Meta (List Code))) (let [[full_name class_tvars] (parser.declaration class)] - (case member + (when member {#EnumDecl enum_members} (with_symbols [g!_] (do meta.monad [.let [enum_type (.is Code - (case class_tvars + (when class_tvars {.#End} (` (.Primitive (, (code.text full_name)))) @@ -1704,13 +1704,13 @@ (open "[0]") commons (open "[0]") method [jvm_op object_ast] (.is [Text (List Code)] - (case #import_member_kind + (when #import_member_kind {#StaticIMK} ["jvm member invoke static" (list)] {#VirtualIMK} - (case kind + (when kind {#Class} ["jvm member invoke virtual" (list g!obj)] @@ -1734,7 +1734,7 @@ (list.zipped_2 input_jvm_types) (list#each ..decorate_input)))))) jvm_interop (.is Code - (case (jvm.void? method_return) + (when (jvm.void? method_return) {.#Left method_return} (|> [method_return callC] @@ -1805,7 +1805,7 @@ (` ((,' in) (.list (.` (, getter_body))))))] (list (` (def (, g!name) (syntax ((, g!name) [(, write|read) (, parser)]) - (case (, write|read) + (when (, write|read) (,* write) (,* read)))))))))) ))) @@ -1835,7 +1835,7 @@ (def (class_kind declaration) (-> (Type Declaration) (Meta Class_Kind)) (let [[class_name _] (parser.declaration declaration)] - (case (load_class class_name) + (when (load_class class_name) {.#Right class} (at meta.monad in (if (interface? class) {#Interface} @@ -1890,11 +1890,11 @@ (-> Type_Context .Type (Meta (Type Value))) (if (type#= .Any type) (at meta.monad in $Object) - (case type + (when type {.#Primitive name params} (`` (cond (,, (with_template [] [(text#= (..reflection ) name) - (case params + (when params {.#End} (at meta.monad in ) @@ -1912,7 +1912,7 @@ (,, (with_template [] [(text#= (..reflection (jvm.array )) name) - (case params + (when params {.#End} (at meta.monad in (jvm.array )) @@ -1929,7 +1929,7 @@ [jvm.char])) (text#= array.primitive name) - (case params + (when params {.#Item {.#Apply writeLT {.#Apply readLT _Mutable}} {.#End}} (at meta.monad each jvm.array (lux_type->jvm_type context readLT)) @@ -1938,7 +1938,7 @@ ) (text.starts_with? descriptor.array_prefix name) - (case params + (when params {.#End} (let [[_ unprefixed] (maybe.trusted (text.split_by descriptor.array_prefix name))] (at meta.monad each jvm.array @@ -1954,7 +1954,7 @@ (function (_ paramLT) (do meta.monad [paramJT (lux_type->jvm_type context paramLT)] - (case (parser.parameter? paramJT) + (when (parser.parameter? paramJT) {.#Some paramJT} (in paramJT) @@ -1963,7 +1963,7 @@ params))))) {.#Apply A F} - (case (type.applied (list A) F) + (when (type.applied (list A) F) {.#None} @@ -1974,7 +1974,7 @@ (lux_type->jvm_type context type') {.#Var @it} - (case (check.result context (check.peek @it)) + (when (check.result context (check.peek @it)) {try.#Success {.#Some :it:}} (lux_type->jvm_type context :it:) @@ -1986,7 +1986,7 @@ (def .public length (syntax (_ [array .any]) - (case array + (when array [_ {.#Symbol array_name}] (do meta.monad [array_type (meta.type array_name) @@ -2023,7 +2023,7 @@ (def .public read! (syntax (_ [idx .any array .any]) - (case array + (when array [_ {.#Symbol array_name}] (do meta.monad [array_type (meta.type array_name) @@ -2063,7 +2063,7 @@ (syntax (_ [idx .any value .any array .any]) - (case array + (when array [_ {.#Symbol array_name}] (do meta.monad [array_type (meta.type array_name) @@ -2116,7 +2116,7 @@ (def .public is (syntax (_ [type (..type^ (list)) object .any]) - (case [(parser.array? type) + (when [(parser.array? type) (parser.class? type)] (^.or [{.#Some _} _] [_ {.#Some _}]) (in (list (` (.is (, (..value_type {#ManualPrM} type)) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 92c342750..850ac3b83 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -277,7 +277,7 @@ (def (host_optional it) (-> Optional Code) (.if (.the #optional? it) - (` (.case (, (the #mandatory it)) + (` (.when (, (the #mandatory it)) {.#Some (, g!it')} (, g!it') @@ -371,13 +371,13 @@ :parameters: (the #parameters input) g!parameters (..parameters :parameters:) :output: (the [#anonymous #output] it) - :input:/* (case :parameters: + :input:/* (when :parameters: {.#End} (list (` [])) parameters (list#each ..output_type :parameters:))] - (` (.def ((, g!it) (,* (case g!parameters + (` (.def ((, g!it) (,* (when g!parameters {.#End} (list g!it) _ (list#each (the #mandatory) g!parameters)))) (.All ((, g!it) (,* g!variables)) @@ -407,7 +407,7 @@ (for @.js (these) (def (imported class) (-> Text Code) - (case (text.all_split_by .module_separator class) + (when (text.all_split_by .module_separator class) {.#Item head tail} (list#mix (.function (_ sub super) (` ( (, (code.text sub)) @@ -449,7 +449,7 @@ g!class_variables (list#each code.local class_parameters) g!class (` ((, (code.local (maybe.else class_name alias))) (,* g!class_variables))) :output: [#optional? false #mandatory g!class]] - (` (.def ((, g!it) (,* (case g!parameters + (` (.def ((, g!it) (,* (when g!parameters {.#End} (list g!it) _ (list#each (the #mandatory) g!parameters)))) (.All ((, g!it) (,* g!class_variables) (,* g!input_variables)) @@ -564,13 +564,13 @@ (syntax (_ [host_module (<>.maybe .text) it ..importP]) (let [host_module_import! (is (List Code) - (case host_module + (when host_module {.#Some host_module} (list (` ( (, (code.text host_module))))) {.#None} (list)))] - (case it + (when it {#Global it} (in (list (..global_definition host_module_import! it))) @@ -591,7 +591,7 @@ (..Object (.Primitive (, (code.text (..host_path class_name))) [(,* g!class_variables)])))) (list#each (.function (_ member) - (`` (`` (case member + (`` (`` (when member (,, (for @.lua (,, (these)) @.ruby (,, (these)) (,, (these {#Constructor it} @@ -631,10 +631,10 @@ [head tail] (.tuple (<>.and .local (<>.some .local)))]) (with_symbols [g!_] (let [global (` ("js constant" (, (code.text head))))] - (case tail + (when tail {.#End} (in (list (` (is (.Maybe (, type)) - (case (..type_of (, global)) + (when (..type_of (, global)) "undefined" {.#None} @@ -644,7 +644,7 @@ {.#Item [next tail]} (let [separator "."] (in (list (` (is (.Maybe (, type)) - (case (..type_of (, global)) + (when (..type_of (, global)) "undefined" {.#None} @@ -654,7 +654,7 @@ (def !defined? (template (_ ) - [(.case (..global Any ) + [(.when (..global Any ) {.#None} .false @@ -706,7 +706,7 @@ (.function (_ name phase archive inputs) (.function (_ state) (let [ [name phase archive state]] - (case (.result inputs) + (when (.result inputs) {try.#Failure error} {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) text.\n error)} @@ -720,7 +720,7 @@ (.function (_ name phase archive inputs) (.function (_ state) (let [ [name phase archive state]] - (case inputs + (when inputs @@ -780,7 +780,7 @@ (def (pairs it) (All (_ a) (-> (List a) (List [a a]))) - (case it + (when it (list.partial left right tail) (list.partial [left right] (pairs tail)) @@ -796,7 +796,7 @@ (do [! try.monad] [[state output] (monad.mix ! (.function (_ [key value] [state output]) - (case key + (when key (text_synthesis key) (do try.monad [[state value] (phase archive value state)] diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 2208f9ee4..7444e1d3a 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -284,7 +284,7 @@ ... Utils (def (manual_primitive_type class) (-> Text (Maybe Code)) - (case class + (when class (^.with_template [ ] [ {.#Some (' )}]) @@ -303,7 +303,7 @@ (def (auto_primitive_type class) (-> Text (Maybe Code)) - (case class + (when class (^.with_template [ ] [ {.#Some (' )}]) @@ -328,7 +328,7 @@ (-> Primitive_Mode (List Type_Parameter) Bit [Text (List GenericType)] (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code) Code) - (case [name+params mode in_array?] + (when [name+params mode in_array?] (^.multi [[prim {.#End}] {#ManualPrM} .false] [(manual_primitive_type prim) {.#Some output}]) @@ -346,9 +346,9 @@ (def (class_type' mode type_params in_array? class) (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code) - (case class + (when class {#GenericTypeVar name} - (case (list.example (function (_ [pname pbounds]) + (when (list.example (function (_ [pname pbounds]) (and (text#= name pname) (not (list.empty? pbounds)))) type_params) @@ -386,7 +386,7 @@ (-> Class_Declaration Code) (let [=params (list#each (.is (-> Type_Parameter Code) (function (_ [pname pbounds]) - (case pbounds + (when pbounds {.#End} (code.symbol ["" pname]) @@ -400,9 +400,9 @@ (def (simple_class$ env class) (-> (List Type_Parameter) GenericType Text) - (case class + (when class {#GenericTypeVar name} - (case (list.example (function (_ [pname pbounds]) + (when (list.example (function (_ [pname pbounds]) (and (text#= name pname) (not (list.empty? pbounds)))) env) @@ -423,7 +423,7 @@ (safe name) {#GenericArray param'} - (case param' + (when param' {#GenericArray param} (format "[" (simple_class$ env param)) @@ -467,7 +467,7 @@ (def (pre_walk_replace f input) (-> (-> Code Code) Code Code) - (case (f input) + (when (f input) (^.with_template [] [[meta { parts}] [meta { (list#each (pre_walk_replace f) parts)}]]) @@ -480,7 +480,7 @@ (def (parser_replacer p ast) (-> (Parser Code) (-> Code Code)) - (case (<>.result p (list ast)) + (when (<>.result p (list ast)) {.#Right [{.#End} ast']} ast' @@ -490,7 +490,7 @@ (def (field_parser class_name [[field_name _ _] field]) (-> Text [Member_Declaration FieldDecl] (Parser Code)) - (case field + (when field {#ConstantField _} (get_const_parser class_name field_name) @@ -537,7 +537,7 @@ (def (method_parser params class_name [[method_name _ _] meth_def]) (-> (List Type_Parameter) Text [Member_Declaration Method_Definition] (Parser Code)) - (case meth_def + (when meth_def {#ConstructorMethod strict? type_vars args constructor_args return_expr exs} (constructor_parser params class_name args) @@ -603,7 +603,7 @@ (in {#GenericClass name (list)}))) (.tuple (do <>.monad [component again^] - (case component + (when component (^.with_template [ ] [{#GenericClass {.#End}} (in {#GenericClass (list)})]) @@ -988,7 +988,7 @@ (def (privacy_modifier$ pm) (-> Privacy JVM_Code) - (case pm + (when pm {#PublicP} "public" {#PrivateP} "private" {#ProtectedP} "protected" @@ -996,7 +996,7 @@ (def (inheritance_modifier$ im) (-> Inheritance JVM_Code) - (case im + (when im {#FinalI} "final" {#AbstractI} "abstract" {#DefaultI} "default")) @@ -1011,13 +1011,13 @@ (def (bound_kind$ kind) (-> BoundKind JVM_Code) - (case kind + (when kind {#UpperBound} "<" {#LowerBound} ">")) (def (generic_type$ gtype) (-> GenericType JVM_Code) - (case gtype + (when gtype {#GenericTypeVar name} name @@ -1061,14 +1061,14 @@ (def (state_modifier$ sm) (-> State JVM_Code) - (case sm + (when sm {#VolatileS} "volatile" {#FinalS} "final" {#DefaultS} "default")) (def (field_decl$ [[name pm anns] field]) (-> [Member_Declaration FieldDecl] JVM_Code) - (case field + (when field {#ConstantField class value} (with_parens (spaced (list "constant" name @@ -1099,7 +1099,7 @@ (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 + (when method_def {#ConstructorMethod strict_fp? type_vars arg_decls constructor_args body exs} (with_parens (spaced (list "init" @@ -1280,7 +1280,7 @@ (def .public !!! (syntax (_ [expr .any]) (with_symbols [g!value] - (in (list (` (.case (, expr) + (in (list (` (.when (, expr) {.#Some (, g!value)} (, g!value) @@ -1298,7 +1298,7 @@ {.#Some (.as (, class_type) (, g!unchecked))} {.#None}))] - (case unchecked + (when unchecked {.#Some unchecked} (in (list (` (.is (, check_type) (let [(, g!unchecked) (, unchecked)] @@ -1335,12 +1335,12 @@ (def (member_type_vars class_tvars member) (-> (List Type_Parameter) Import_Member_Declaration (List Type_Parameter)) - (case member + (when member {#ConstructorDecl [commons _]} (list#composite class_tvars (the #import_member_tvars commons)) {#MethodDecl [commons _]} - (case (the #import_member_kind commons) + (when (the #import_member_kind commons) {#StaticIMK} (the #import_member_tvars commons) @@ -1352,7 +1352,7 @@ (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 + (when member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) (let [(open "[0]") commons] (do [! meta.monad] @@ -1379,7 +1379,7 @@ (def (decorate_return_maybe class member return_term) (-> Class_Declaration Import_Member_Declaration Code Code) - (case member + (when member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) (if (the #import_member_maybe? commons) (` (??? (, return_term))) @@ -1398,7 +1398,7 @@ (with_template [ ] [(def ( member return_term) (-> Import_Member_Declaration Code Code) - (case member + (when member (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) (if (the commons) @@ -1413,7 +1413,7 @@ (def (free_type_param? [name bounds]) (-> Type_Parameter Bit) - (case bounds + (when bounds {.#End} true @@ -1427,7 +1427,7 @@ (with_template [ ] [(def ( mode [class expression]) (-> Primitive_Mode [Text Code] Code) - (case mode + (when mode {#ManualPrM} expression @@ -1471,12 +1471,12 @@ all_params (|> (member_type_vars class_tvars member) (list.only free_type_param?) (list#each lux_type_parameter))] - (case member + (when member {#EnumDecl enum_members} (macro.with_symbols [g!_] (do [! meta.monad] [.let [enum_type (.is Code - (case class_tvars + (when class_tvars {.#End} (` (Primitive (, (code.text full_name)))) @@ -1513,13 +1513,13 @@ (open "[0]") commons (open "[0]") method [jvm_op object_ast] (.is [Text (List Code)] - (case #import_member_kind + (when #import_member_kind {#StaticIMK} ["invokestatic" (list)] {#VirtualIMK} - (case kind + (when kind {#Class} ["invokevirtual" (list g!obj)] @@ -1621,7 +1621,7 @@ (def (class_kind [class_name _]) (-> Class_Declaration (Meta Class_Kind)) (let [class_name (..safe class_name)] - (case (..load_class class_name) + (when (..load_class class_name) {try.#Success class} (at meta.monad in (if (interface? class) {#Interface} @@ -1645,7 +1645,7 @@ (def .public array (syntax (_ [type (..generic_type^ (list)) size .any]) - (case type + (when type (^.with_template [ ] [{#GenericClass (list)} (in (list (` ( (, size)))))]) @@ -1669,12 +1669,12 @@ (-> Type (Meta Text)) (if (type#= Any type) (at meta.monad in "java.lang.Object") - (case type + (when type {.#Primitive name params} (at meta.monad in name) {.#Apply A F} - (case (type.applied (list A) F) + (when (type.applied (list A) F) {.#None} (meta.failure (format "Cannot apply type: " (type.format F) " to " (type.format A))) @@ -1690,12 +1690,12 @@ (def .public read! (syntax (_ [idx .any array .any]) - (case array + (when array [_ {.#Symbol array_name}] (do meta.monad [array_type (meta.type array_name) array_jvm_type (type_class_name array_type)] - (case array_jvm_type + (when array_jvm_type (^.with_template [ ] [ (in (list (` ( (, array) (, idx)))))]) @@ -1720,12 +1720,12 @@ (syntax (_ [idx .any value .any array .any]) - (case array + (when array [_ {.#Symbol array_name}] (do meta.monad [array_type (meta.type array_name) array_jvm_type (type_class_name array_type)] - (case array_jvm_type + (when array_jvm_type (^.with_template [ ] [ (in (list (` ( (, array) (, idx) (, value)))))]) diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index d891daf44..1eea0f3a0 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -147,7 +147,7 @@ (def (with_null g!temp [nullable? input]) (-> Code [Bit Code] Code) (if nullable? - (` (case (, input) + (` (when (, input) {.#Some (, g!temp)} (, g!temp) @@ -188,7 +188,7 @@ (def .public try (syntax (_ [expression .any]) - ... {.#doc (example (case (try (risky_computation input)) + ... {.#doc (example (when (try (risky_computation input)) ... {.#Right success} ... (do_something success) @@ -240,7 +240,7 @@ (def .public import (syntax (_ [import ..import]) (with_symbols [g!temp] - (case import + (when import {#Class [class alias format members]} (with_symbols [g!object] (let [qualify (is (-> Text Code) @@ -254,7 +254,7 @@ (in (list.partial (` (type (, g!type) (..Object (Primitive (, (code.text class)))))) (list#each (function (_ member) - (case member + (when member {#Field [static? field alias fieldT]} (let [g!field (qualify (maybe.else field alias))] (if static? @@ -271,7 +271,7 @@ (as (..Object .Any) (, g!object))))))))))) {#Method method} - (case method + (when method {#Static [method alias inputsT io? try? outputT]} (..make_function (qualify (maybe.else method alias)) g!temp diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index b7ed29d92..434926adc 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -119,7 +119,7 @@ (def (with_nil g!temp [nilable? input]) (-> Code [Bit Code] Code) (if nilable? - (` (case (, input) + (` (when (, input) {.#Some (, g!temp)} (, g!temp) @@ -153,7 +153,7 @@ (def .public try (syntax (_ [expression .any]) - ... {.#doc (example (case (try (risky_computation input)) + ... {.#doc (example (when (try (risky_computation input)) ... {.#Right success} ... (do_something success) @@ -205,7 +205,7 @@ (def .public import (syntax (_ [import ..import]) (with_symbols [g!temp] - (case import + (when import {#Function [name alias inputsT io? try? outputT]} (let [imported (` ("scheme constant" (, (code.text name))))] (in (list (..make_function (code.local (maybe.else name alias)) diff --git a/stdlib/source/library/lux/ffi/export.jvm.lux b/stdlib/source/library/lux/ffi/export.jvm.lux index ddd8f9d50..9c16d04a4 100644 --- a/stdlib/source/library/lux/ffi/export.jvm.lux +++ b/stdlib/source/library/lux/ffi/export.jvm.lux @@ -70,7 +70,7 @@ exports (<>.many ..exportP)]) (let [initialization (is (List (API Constant)) (list.all (.function (_ it) - (case it + (when it {#Constant it} {.#Some it} @@ -79,7 +79,7 @@ exports))] (in (list (` (//.class "final" (, (code.local api)) (,* (list#each (.function (_ it) - (case it + (when it {#Constant [name type term]} (` ("public" "final" "static" (, (code.local name)) (, type))) diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 62fa2b691..614cd7b45 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -114,7 +114,7 @@ .let [[:input:/* :output:] (type.flat_function type) code (if global? (/.set (list (/.manual name)) term) - (case :input:/* + (when :input:/* {.#End} (/.function (/.manual name) (list) (/.return term)) @@ -136,7 +136,7 @@ (monad.each ! ..definition))) (at ! conjoint) (at ! each (list#each (function (_ [name term]) - (` ( (,* (case name + (` ( (,* (when name {#Method name} (list (code.bit false) (code.text name)) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 486c7221a..0d470214a 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -47,7 +47,7 @@ (def (composite phase archive <+> last prevs) (-> Phase Archive Code Analysis (List Analysis) (Operation Analysis)) - (case <+> + (when <+> [_ {.#Text $}] (phase#in (list#mix (function (_ left right) {analysis.#Extension $ (list left right)}) @@ -81,7 +81,7 @@ operands) _ (type.inference :it:) :it: (type.check (check.identity (list) $it))] - (case (list.reversed operands) + (when (list.reversed operands) (list single) (in single) diff --git a/stdlib/source/library/lux/math/infix.lux b/stdlib/source/library/lux/math/infix.lux index 6716f43b2..871f9c7f4 100644 --- a/stdlib/source/library/lux/math/infix.lux +++ b/stdlib/source/library/lux/math/infix.lux @@ -58,7 +58,7 @@ (def (prefix infix) (-> Infix Code) - (case infix + (when infix {#Const value} value diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index 87f575f54..3899e9a55 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -134,7 +134,7 @@ (All (_ %) (-> (Mod %) (Maybe (Mod %)))) (let [[modulus value] (representation modular) [[vk mk] gcd] (i.extended_gcd value (//.divisor modulus))] - (case gcd + (when gcd +1 {.#Some (..modular modulus vk)} _ {.#None}))) ) diff --git a/stdlib/source/library/lux/math/number.lux b/stdlib/source/library/lux/math/number.lux index 8e1233bf3..b31167dc9 100644 --- a/stdlib/source/library/lux/math/number.lux +++ b/stdlib/source/library/lux/math/number.lux @@ -21,7 +21,7 @@ (def (separator_prefixed? number) (-> Text Bit) - (case ("lux text index" 0 ..separator number) + (when ("lux text index" 0 ..separator number) {.#Some 0} true @@ -35,12 +35,12 @@ (with_template [ ] [(def .public (macro (_ tokens state) - (case tokens + (when tokens {.#Item [meta {.#Text repr'}] {.#End}} (if (..separator_prefixed? repr') {try.#Failure } (let [repr (..without_separators repr')] - (case (at decoded repr) + (when (at decoded repr) {try.#Success value} {try.#Success [state (list [meta {.#Nat value}])]} diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 8392c9a57..c862a952e 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -288,7 +288,7 @@ (def .public (roots nth input) (-> Nat Complex (List Complex)) - (case nth + (when nth 0 (list) _ (let [r_nth (|> nth .int int.frac) nth_root_of_abs (|> input ..abs (f.pow (f./ r_nth +1.0))) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 05811c9cc..1cbe2d535 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -603,7 +603,7 @@ (Codec Text Frac) (implementation (def (encoded x) - (case x + (when x -0.0 (let [output ("lux f64 encode" x)] (if (text.starts_with? "-" output) output @@ -613,7 +613,7 @@ ("lux text concat" "+" ("lux f64 encode" x))))) (def (decoded input) - (case ("lux f64 decode" input) + (when ("lux f64 decode" input) {.#Some value} {try.#Success value} @@ -715,7 +715,7 @@ (def .public (of_bits it) (-> I64 Frac) - (case [(is Nat (..exponent it)) + (when [(is Nat (..exponent it)) (is Nat (..mantissa it)) (is Nat (..sign it))] [..special_exponent_bits 0 0] @@ -754,7 +754,7 @@ (`` (def (representation_exponent codec representation) (-> (Codec Text Nat) Text (Try [Text Int])) - (case [("lux text index" 0 "e+" representation) + (when [("lux text index" 0 "e+" representation) ("lux text index" 0 "E+" representation) ("lux text index" 0 "e-" representation) ("lux text index" 0 "E-" representation)] @@ -788,7 +788,7 @@ exponent (//int.- (.int ..double_bias) (..exponent bits)) sign (..sign bits)] (all "lux text concat" - (case (.nat sign) + (when (.nat sign) 1 "-" 0 "+" _ (undefined)) @@ -802,7 +802,7 @@ (if (or negative? positive?) (do [! try.monad] [[mantissa exponent] (..representation_exponent representation) - [whole decimal] (case ("lux text index" 0 "." mantissa) + [whole decimal] (when ("lux text index" 0 "." mantissa) {.#Some split_index} (do ! [.let [after_offset (++ split_index) @@ -816,7 +816,7 @@ {.#None} {try.#Failure ("lux text concat" representation)}) .let [whole ("lux text clip" 1 (-- ("lux text size" whole)) whole)] - mantissa (at decoded (case decimal + mantissa (at decoded (when decimal 0 whole _ ("lux text concat" whole (at encoded decimal)))) .let [sign (if negative? 1 0)]] diff --git a/stdlib/source/library/lux/math/number/i16.lux b/stdlib/source/library/lux/math/number/i16.lux index b83bf1f72..53c71f68f 100644 --- a/stdlib/source/library/lux/math/number/i16.lux +++ b/stdlib/source/library/lux/math/number/i16.lux @@ -16,7 +16,7 @@ (def .public I16 Type ... TODO: Switch to the cleaner approach ASAP. - (case (type_of ..sub) + (when (type_of ..sub) {.#Apply :size: :sub:} (type_literal (I64 :size:)) diff --git a/stdlib/source/library/lux/math/number/i32.lux b/stdlib/source/library/lux/math/number/i32.lux index 4423f3098..3d7acc842 100644 --- a/stdlib/source/library/lux/math/number/i32.lux +++ b/stdlib/source/library/lux/math/number/i32.lux @@ -18,7 +18,7 @@ (def .public I32 Type ... TODO: Switch to the cleaner approach ASAP. - (case (type_of ..sub) + (when (type_of ..sub) {.#Apply :size: :sub:} (type_literal (I64 :size:)) diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux index d476bc4ff..9a1077f88 100644 --- a/stdlib/source/library/lux/math/number/i64.lux +++ b/stdlib/source/library/lux/math/number/i64.lux @@ -60,9 +60,9 @@ (def .public (mask amount_of_bits) (-> Nat Mask) - (case amount_of_bits + (when amount_of_bits 0 ..false - bits (case (n.% ..width bits) + bits (when (n.% ..width bits) 0 ..true bits (|> 1 .i64 (..left_shifted (n.% ..width bits)) .--)))) @@ -205,7 +205,7 @@ (..or (|> value (..and ..sign) (..right_shifted sign_shift)) (|> value (..and mantissa)))) (def (wide value) - (.i64 (case (.nat (..and sign value)) + (.i64 (when (.nat (..and sign value)) 0 value _ (..or co_mantissa value))))))}) {.#None})) diff --git a/stdlib/source/library/lux/math/number/i8.lux b/stdlib/source/library/lux/math/number/i8.lux index 49ccad042..d4ac05aaf 100644 --- a/stdlib/source/library/lux/math/number/i8.lux +++ b/stdlib/source/library/lux/math/number/i8.lux @@ -16,7 +16,7 @@ (def .public I8 Type ... TODO: Switch to the cleaner approach ASAP. - (case (type_of ..sub) + (when (type_of ..sub) {.#Apply :size: :sub:} (type_literal (I64 :size:)) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 2dfb5e7b8..c51ed91bd 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -122,7 +122,7 @@ ... https://en.wikipedia.org/wiki/Greatest_common_divisor (def .public (gcd a b) (-> Int Int Int) - (case b + (when b +0 a _ (gcd b (..% b a)))) @@ -136,7 +136,7 @@ (loop (again [x +1 x1 +0 y +0 y1 +1 a1 a b1 b]) - (case b1 + (when b1 +0 [[x y] a1] _ (let [q (/ b1 a1)] (again x1 (- (* q x1) x) @@ -146,7 +146,7 @@ ... https://en.wikipedia.org/wiki/Least_common_multiple (`` (def .public (lcm a b) (-> Int Int Int) - (case [a b] + (when [a b] (,, (with_template [] [ +0] @@ -221,7 +221,7 @@ (def (decoded repr) (let [input_size ("lux text size" repr)] (if (//nat.> 1 input_size) - (case ("lux text clip" 0 1 repr) + (when ("lux text clip" 0 1 repr) ..+sign (|> repr ("lux text clip" 1 (-- input_size)) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index cef20dca2..f5fd924d5 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -111,7 +111,7 @@ (def .public (gcd a b) (-> Nat Nat Nat) - (case b + (when b 0 a _ (gcd b (..% b a)))) @@ -121,7 +121,7 @@ (`` (def .public (lcm a b) (-> Nat Nat Nat) - (case [a b] + (when [a b] (,, (with_template [] [ 0] @@ -184,21 +184,21 @@ (def (binary_character value) (-> Nat Text) - (case value + (when value 0 "0" 1 "1" _ (undefined))) (def (binary_value digit) (-> Nat (Maybe Nat)) - (case digit + (when digit (char "0") {.#Some 0} (char "1") {.#Some 1} _ {.#None})) (def (octal_character value) (-> Nat Text) - (case value + (when value 0 "0" 1 "1" 2 "2" @@ -211,7 +211,7 @@ (def (octal_value digit) (-> Nat (Maybe Nat)) - (case digit + (when digit (char "0") {.#Some 0} (char "1") {.#Some 1} (char "2") {.#Some 2} @@ -224,7 +224,7 @@ (def (decimal_character value) (-> Nat Text) - (case value + (when value 0 "0" 1 "1" 2 "2" @@ -239,7 +239,7 @@ (def (decimal_value digit) (-> Nat (Maybe Nat)) - (case digit + (when digit (char "0") {.#Some 0} (char "1") {.#Some 1} (char "2") {.#Some 2} @@ -254,7 +254,7 @@ (def (hexadecimal_character value) (-> Nat Text) - (case value + (when value 0 "0" 1 "1" 2 "2" @@ -275,7 +275,7 @@ (`` (def (hexadecimal_value digit) (-> Nat (Maybe Nat)) - (case digit + (when digit (,, (with_template [ ] [(char ) {.#Some }] @@ -308,7 +308,7 @@ (let [output' ("lux text concat" ( ("lux i64 and" mask input)) output)] - (case (is Nat ("lux i64 right-shift" input)) + (when (is Nat ("lux i64 right-shift" input)) 0 output' @@ -321,7 +321,7 @@ (loop (again [idx 0 output 0]) (if (..< input_size idx) - (case ( ("lux text char" idx repr)) + (when ( ("lux text char" idx repr)) {.#Some digit_value} (again (++ idx) (|> output @@ -346,7 +346,7 @@ output ""]) (let [digit (decimal_character (..% 10 input)) output' ("lux text concat" digit output)] - (case (../ 10 input) + (when (../ 10 input) 0 output' @@ -360,7 +360,7 @@ (loop (again [idx 0 output 0]) (if (..< input_size idx) - (case (decimal_value ("lux text char" idx repr)) + (when (decimal_value ("lux text char" idx repr)) {.#None} diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index b81667def..2974eae8b 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -30,7 +30,7 @@ (def .public (nat value) (-> Ratio (Maybe Nat)) - (case (the #denominator value) + (when (the #denominator value) 1 {.#Some (the #numerator value)} _ {.#None})) @@ -139,7 +139,7 @@ ..separator (n#encoded _#denominator))) (def (decoded input) - (case (text.split_by ..separator input) + (when (text.split_by ..separator input) {.#Some [num denom]} (do try.monad [numerator (n#decoded num) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 1d164f539..a1b8e14ed 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -127,7 +127,7 @@ (with_expansions [ 1] (def .public (reciprocal numerator) (-> Nat Rev) - (.rev (case (is Nat ("lux i64 and" numerator)) + (.rev (when (is Nat ("lux i64 and" numerator)) 0 (..even_reciprocal numerator) _ (..odd_reciprocal numerator)))) @@ -135,7 +135,7 @@ (-> Rev Rev Rev) (if ("lux i64 =" +0 param) (panic! "Cannot divide Rev by zero!") - (let [reciprocal (case (is Nat ("lux i64 and" param)) + (let [reciprocal (when (is Nat ("lux i64 and" param)) 0 (..even_reciprocal (.nat param)) _ (..odd_reciprocal (.nat param)))] (.rev (//nat.* reciprocal (.nat subject))))))) @@ -230,7 +230,7 @@ (def (encoded value) (let [raw_output (at encoded (.nat value)) max_num_chars (//nat.+ (//nat./ //i64.width) - (case (//nat.% //i64.width) + (when (//nat.% //i64.width) 0 0 _ 1)) raw_size ("lux text size" raw_output) @@ -248,9 +248,9 @@ (def (decoded repr) (let [repr_size ("lux text size" repr)] (if (//nat.> 1 repr_size) - (case ("lux text char" 0 repr) + (when ("lux text char" 0 repr) (char ".") - (case (at decoded (..decimals repr)) + (when (at decoded (..decimals repr)) {try.#Success output} {try.#Success (.rev output)} @@ -359,7 +359,7 @@ (loop (again [idx 0 output (..digits [])]) (if (//nat.< length idx) - (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789") + (when ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789") {.#None} {.#None} @@ -403,7 +403,7 @@ (Codec Text Rev) (implementation (def (encoded input) - (case (.nat input) + (when (.nat input) 0 ".0" @@ -422,7 +422,7 @@ digits))))))) (def (decoded input) - (let [dotted? (case ("lux text index" 0 "." input) + (let [dotted? (when ("lux text index" 0 "." input) {.#Some 0} true @@ -432,7 +432,7 @@ "lux text size" (//nat.<= (++ //i64.width)))] (if (and dotted? within_limits?) - (case (|> input ..decimals ..text_digits) + (when (|> input ..decimals ..text_digits) {.#Some digits} (loop (again [digits digits idx 0 diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index d482c72b3..3d7b33581 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -92,7 +92,7 @@ (-> (-> a (Maybe b)) (Random a) (Random b))) (do ..monad [sample random] - (case (check sample) + (when (check sample) {.#Some output} (in output) @@ -103,7 +103,7 @@ (All (_ t r) (-> (Refiner t r) (Random t) (Random (Refined t r)))) (do ..monad [sample gen] - (case (refiner sample) + (when (refiner sample) {.#Some refined} (in refined) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index c2123fa99..5cb1d3894 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -31,7 +31,7 @@ (implementation (def (each f fa) (function (_ lux) - (case (fa lux) + (when (fa lux) {try.#Success [lux' a]} {try.#Success [lux' (f a)]} @@ -45,9 +45,9 @@ (def (on fa ff) (function (_ lux) - (case (ff lux) + (when (ff lux) {try.#Success [lux' f]} - (case (fa lux') + (when (fa lux') {try.#Success [lux'' a]} {try.#Success [lux'' (f a)]} @@ -68,7 +68,7 @@ (def (conjoint mma) (function (_ lux) - (case (mma lux) + (when (mma lux) {try.#Success [lux' ma]} (ma lux') @@ -81,7 +81,7 @@ (def .public (result lux action) (All (_ a) (-> Lux (Meta a) (Try a))) - (case (action lux) + (when (action lux) {try.#Success [_ output]} {try.#Success output} @@ -91,7 +91,7 @@ (def .public (either left right) (All (_ a) (-> (Meta a) (Meta a) (Meta a))) (function (_ lux) - (case (left lux) + (when (left lux) {try.#Success [lux' output]} {try.#Success [lux' output]} @@ -114,7 +114,7 @@ (def .public (module name) (-> Text (Meta Module)) (function (_ lux) - (case (property.value name (the .#modules lux)) + (when (property.value name (the .#modules lux)) {.#Some module} {try.#Success [lux module]} @@ -124,7 +124,7 @@ (def .public current_module_name (Meta Text) (function (_ lux) - (case (the .#current_module lux) + (when (the .#current_module lux) {.#Some current_module} {try.#Success [lux current_module]} @@ -140,7 +140,7 @@ (def (macro_type? type) (-> Type Bit) - (case type + (when type {.#Named [.prelude "Macro"] {.#Primitive "#Macro" {.#End}}} true @@ -150,7 +150,7 @@ (def .public (normal name) (-> Symbol (Meta Symbol)) - (case name + (when name ["" name] (do ..monad [module_name ..current_module_name] @@ -166,7 +166,7 @@ (is (Meta (Maybe Macro)) (function (_ lux) {try.#Success [lux - (case (..current_module_name lux) + (when (..current_module_name lux) {try.#Success [_ this_module]} (let [modules (the .#modules lux)] (loop (again [module module @@ -178,7 +178,7 @@ (is Module) (the .#definitions) (property.value name)))] - (case definition + (when definition {.#Alias [r_module r_name]} (again r_module r_name) @@ -208,7 +208,7 @@ (def .public (module_exists? module) (-> Text (Meta Bit)) (function (_ lux) - {try.#Success [lux (case (property.value module (the .#modules lux)) + {try.#Success [lux (when (property.value module (the .#modules lux)) {.#Some _} true @@ -218,13 +218,13 @@ (def (on_either f x1 x2) (All (_ a b) (-> (-> a (Maybe b)) a a (Maybe b))) - (case (f x1) + (when (f x1) {.#None} (f x2) {.#Some y} {.#Some y})) (def (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) - (case bindings + (when bindings {.#End} {.#None} @@ -235,10 +235,10 @@ (`` (def (clean_type type) (-> Type (Meta Type)) - (case type + (when type {.#Var var} (function (_ lux) - (case (|> lux + (when (|> lux (the [.#type_context .#var_bindings]) (type_variable var)) (,, (with_template [] @@ -260,7 +260,7 @@ (function (_ lux) (let [test (is (-> [Text [Type Any]] Bit) (|>> product.left (text#= name)))] - (case (do maybe.monad + (when (do maybe.monad [scope (list.example (function (_ env) (or (list.any? test (is (List [Text [Type Any]]) (the [.#locals .#mappings] env))) @@ -301,7 +301,7 @@ [name (..normal name) .let [[normal_module normal_short] name]] (function (_ lux) - (case (is (Maybe Global) + (when (is (Maybe Global) (do maybe.monad [(open "[0]") (|> lux (the .#modules) @@ -319,7 +319,7 @@ {try.#Failure (all text#composite "Unknown definition: " (symbol#encoded name) text.new_line " Current module: " current_module text.new_line - (case (property.value current_module (the .#modules lux)) + (when (property.value current_module (the .#modules lux)) {.#Some this_module} (let [candidates (|> lux (the .#modules) @@ -327,7 +327,7 @@ (|> module (the .#definitions) (list.all (function (_ [def_name global]) - (`` (case global + (`` (when global (,, (with_template [] [ (if (and exported? @@ -370,7 +370,7 @@ (-> Symbol (Meta Definition)) (do ..monad [definition (..definition name)] - (case definition + (when definition {.#Definition definition} (let [[exported? def_type def_value] definition] (if exported? @@ -401,7 +401,7 @@ (-> Symbol (Meta Type)) (do ..monad [definition (definition name)] - (case definition + (when definition {.#Alias de_aliased} (definition_type de_aliased) @@ -423,7 +423,7 @@ (def .public (type name) (-> Symbol (Meta Type)) - (case name + (when name ["" _name] (either (var_type _name) (definition_type name)) @@ -435,7 +435,7 @@ (-> Symbol (Meta Type)) (do ..monad [definition (definition name)] - (case definition + (when definition {.#Alias de_aliased} (type_definition de_aliased) @@ -460,7 +460,7 @@ (def .public (globals module) (-> Text (Meta (List [Text Global]))) (function (_ lux) - (case (property.value module (the .#modules lux)) + (when (property.value module (the .#modules lux)) {.#Some module} {try.#Success [lux (the .#definitions module)]} @@ -471,7 +471,7 @@ (-> Text (Meta (List [Text Definition]))) (at ..monad each (list.all (function (_ [name global]) - (case global + (when global {.#Alias de_aliased} {.#None} @@ -511,9 +511,9 @@ (do ..monad [.let [[module_name name] type_name] module (..module module_name)] - (case (property.value name (the .#definitions module)) + (when (property.value name (the .#definitions module)) {.#Some {.#Type [exported? type labels]}} - (case labels + (when labels (,, (with_template [] [ (in {.#Some (list#each (|>> [module_name]) @@ -533,7 +533,7 @@ (def .public expected_type (Meta Type) (function (_ lux) - (case (the .#expected lux) + (when (the .#expected lux) {.#Some type} {try.#Success [lux type]} @@ -565,7 +565,7 @@ [.let [[module name] label_name] =module (..module module) this_module_name ..current_module_name] - (case (property.value name (the .#definitions =module)) + (when (property.value name (the .#definitions =module)) {.#Some { [exported? type group idx]}} (if (or (text#= this_module_name module) exported?) @@ -586,12 +586,12 @@ [=module (..module module) this_module_name ..current_module_name] (in (list.all (function (_ [short global]) - (case global + (when global {.#Type [exported? type labels]} (if (or exported? (text#= this_module_name module)) {.#Some [(list#each (|>> [module]) - (case labels + (when labels {.#Left tags} {.#Item tags} @@ -607,7 +607,7 @@ (def .public locals (Meta (List (List [Text Type]))) (function (_ lux) - (case (list.inits (the .#scopes lux)) + (when (list.inits (the .#scopes lux)) {.#Some scopes} {try.#Success [lux (list#each (|>> (the [.#locals .#mappings]) @@ -622,7 +622,7 @@ (-> Symbol (Meta Symbol)) (do ..monad [constant (..definition def_name)] - (in (case constant + (in (when constant {.#Alias real_def_name} real_def_name @@ -650,7 +650,7 @@ (def .public (lifted result) (All (_ a) (-> (Try a) (Meta a))) - (case result + (when result {try.#Success output} (at ..monad in output) @@ -667,7 +667,7 @@ (def .public (try computation) (All (_ it) (-> (Meta it) (Meta (Try it)))) (function (_ lux) - (case (computation lux) + (when (computation lux) {try.#Success [lux' output]} {try.#Success [lux' {try.#Success output}]} diff --git a/stdlib/source/library/lux/meta/code.lux b/stdlib/source/library/lux/meta/code.lux index 68d5327b1..0bec080e7 100644 --- a/stdlib/source/library/lux/meta/code.lux +++ b/stdlib/source/library/lux/meta/code.lux @@ -62,7 +62,7 @@ (Equivalence Code) (implementation (def (= x y) - (case [x y] + (when [x y] (,, (with_template [ ] [[[_ { x'}] [_ { y'}]] (at = x' y')] @@ -88,7 +88,7 @@ (`` (def .public (format ast) (-> Code Text) - (case ast + (when ast (,, (with_template [ ] [[_ { value}] (at encoded value)] @@ -125,7 +125,7 @@ (-> Code Code Code Code) (if (at ..equivalence = original ast) substitute - (case ast + (when ast (,, (with_template [] [[location { parts}] [location { (list#each (replaced original substitute) parts)}]] diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index 019edf1c5..7cf349a43 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -103,7 +103,7 @@ (def (read source reader) (-> Source Reader (///analysis.Operation [Source Code])) (function (_ [bundle compiler]) - (case (reader source) + (when (reader source) {.#Left [source' error]} {try.#Failure error} @@ -211,7 +211,7 @@ [reader (///declaration.lifted_analysis (..reader module aliases source))] (function (_ state) - (case (///phase.result' state (..iteration' wrapper archive expander reader source pre_payload)) + (when (///phase.result' state (..iteration' wrapper archive expander reader source pre_payload)) {try.#Success [state source&requirements&buffer]} {try.#Success [state {.#Some source&requirements&buffer}]} @@ -266,14 +266,14 @@ (..iteration wrapper archive expander module source buffer ///syntax.no_aliases))]) (do ! [[state ?source&requirements&temporary_payload] iteration] - (case ?source&requirements&temporary_payload + (when ?source&requirements&temporary_payload {.#None} (do ! [[state [analysis_module [final_buffer final_registry]]] (<| (///phase.result' state) (do [! ///phase.monad] [_ (if (text#= program_module module) - (case program_definition + (when program_definition {.#Some program_definition} (///declaration.lifted_generation (define_program! archive program global program_module program_definition)) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index b0ce99018..12b6c63f1 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -426,7 +426,7 @@ (monad.mix try.monad (function (_ [extension expected] output) (with_expansions [ (dictionary.has extension expected output)] - (case (dictionary.value extension output) + (when (dictionary.value extension output) {.#None} {try.#Success } @@ -519,7 +519,7 @@ (do ! [[_ dependence] (stm.update (..depend importer module) dependence)] (in dependence)))] - (case (..verify_dependencies importer module dependence) + (when (..verify_dependencies importer module dependence) {try.#Failure error} (in [(async.resolved {try.#Failure error}) {.#None}]) @@ -532,13 +532,13 @@ {.#None}]) (do ! [@pending (stm.read pending)] - (case (dictionary.value module @pending) + (when (dictionary.value module @pending) {.#Some [return signal]} (in [return {.#None}]) {.#None} - (case (if (archive.reserved? archive module) + (when (if (archive.reserved? archive module) (do try.monad [@module (archive.id module archive)] (in [@module archive])) @@ -560,14 +560,14 @@ {try.#Failure error} (in [(async#in {try.#Failure error}) {.#None}])))))))))))) - _ (case signal + _ (when signal {.#None} (in []) {.#Some [context @module resolver]} (do ! [result (compile customs importer import! @module context module) - result (case result + result (when result {try.#Failure error} (in result) @@ -652,7 +652,7 @@ (do [! (try.with async.monad)] [] (if (set.empty? duplicates) - (case new_dependencies + (when new_dependencies {.#End} (in [archive (list)]) @@ -672,7 +672,7 @@ (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context Lux_Return)) (do (try.with async.monad) [[archive state/*] (any|after_imports customs import! module duplicates new_dependencies archive)] - (in [archive (case state/* + (in [archive (when state/* {.#End} state @@ -717,9 +717,9 @@ [.let [new_dependencies (the ///.#dependencies compilation) [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] [archive _] (any|after_imports customs import! module duplicates new_dependencies archive)] - (case ((the ///.#process compilation) state archive) + (when ((the ///.#process compilation) state archive) {try.#Success [state more|done]} - (case more|done + (when more|done {.#Left more} (let [continue! (sharing [state document object] (is (///.Compilation state document object) @@ -756,9 +756,9 @@ [.let [new_dependencies (the ///.#dependencies compilation) [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] [archive state] (lux|after_imports customs import! module duplicates new_dependencies [archive state])] - (case (next_compilation module [archive state] compilation) + (when (next_compilation module [archive state] compilation) {try.#Success [state more|done]} - (case more|done + (when more|done {.#Left more} (let [continue! (sharing [] (is @@ -773,7 +773,7 @@ [_ (let [report (..module_compilation_log module state)] (with_expansions [ (in (debug.log! report))] (for @.js (is (Async (Try Any)) - (case console.default + (when console.default {.#None} @@ -820,13 +820,13 @@ (loop (again [customs (for @.old (as (List (///.Custom Fake_State Fake_Document Fake_Object)) all_customs) all_customs)]) - (case customs + (when customs {.#End} ((..lux_compiler import context platform compilation_sources compiler (compiler input)) all_customs importer import! @module [archive lux_state] module) {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail} - (case (custom_compiler input) + (when (custom_compiler input) {try.#Failure _} (again tail) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux index 4a1b68582..7df0d6232 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Tuple Variant Pattern nat int rev case local except) + [lux (.except Tuple Variant Pattern nat int rev when local except) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] @@ -61,7 +61,7 @@ {#Simple Simple} {#Structure (Complex Analysis)} {#Reference Reference} - {#Case Analysis (Match' Analysis)} + {#When Analysis (Match' Analysis)} {#Function (Environment Analysis) Analysis} {#Apply Analysis Analysis} {#Extension (Extension Analysis)}))) @@ -83,7 +83,7 @@ (Equivalence Analysis) (implementation (def (= reference sample) - (.case [reference sample] + (.when [reference sample] [{#Simple reference} {#Simple sample}] (at /simple.equivalence = reference sample) @@ -93,8 +93,8 @@ [{#Reference reference} {#Reference sample}] (at reference.equivalence = reference sample) - [{#Case [reference_analysis reference_match]} - {#Case [sample_analysis sample_match]}] + [{#When [reference_analysis reference_match]} + {#When [sample_analysis sample_match]}] (and (= reference_analysis sample_analysis) (at (list.equivalence (branch_equivalence =)) = {.#Item reference_match} {.#Item sample_match})) @@ -119,7 +119,7 @@ (template ( content) [{ content}]))] - [case ..#Case] + [when ..#When] ) (def .public unit @@ -166,7 +166,7 @@ (loop (again [abstraction analysis inputs (is (List Analysis) (list))]) - (.case abstraction + (.when abstraction {#Apply input next} (again next {.#Item input inputs}) @@ -200,7 +200,7 @@ (def .public (format analysis) (Format Analysis) - (.case analysis + (.when analysis {#Simple it} (/simple.format it) @@ -210,7 +210,7 @@ {#Reference reference} (reference.format reference) - {#Case analysis match} + {#When analysis match} (%.format "({" (|> {.#Item match} (list#each (function (_ [when then]) @@ -259,7 +259,7 @@ (All (_ a) (-> Source (Operation a) (Operation a))) (function (_ [bundle state]) (let [old_source (the .#source state)] - (.case (action [bundle (has .#source source state)]) + (.when (action [bundle (has .#source source state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (has .#source old_source state')] output]} @@ -279,7 +279,7 @@ action (function (_ [bundle state]) (let [old_location (the .#location state)] - (.case (action [bundle (has .#location location state)]) + (.when (action [bundle (has .#location location state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (has .#location old_location state')] output]} @@ -300,7 +300,7 @@ (def .public (of_try it) (All (_ a) (-> (Try a) (Operation a))) (function (_ [bundle state]) - (.case it + (.when it {try.#Failure error} {try.#Failure (located (the .#location state) error)} @@ -320,7 +320,7 @@ (def .public (with_exception exception message action) (All (_ e o) (-> (Exception e) e (Operation o) (Operation o))) (function (_ bundle,state) - (.case (exception.with exception message + (.when (exception.with exception message (action bundle,state)) {try.#Failure error} (let [[bundle state] bundle,state] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux index 0d00367b9..40d90f729 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux @@ -53,7 +53,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Complex a)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Variant [reference_lefts reference_right? reference_value]} {#Variant [sample_lefts sample_right? sample_value]}] (and (n.= reference_lefts sample_lefts) @@ -73,7 +73,7 @@ (..equivalence (at super equivalence))) (def (hash value) - (case value + (when value {#Variant [lefts right? value]} (all n.* 2 (at n.hash hash lefts) @@ -87,7 +87,7 @@ (def .public (format %it it) (All (_ a) (-> (Format a) (Format (Complex a)))) - (case it + (when it {#Variant [lefts right? it]} (%.format "{" (%.nat lefts) " " (%.bit right?) " " (%it it) "}") diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux index 45097d4a5..3403461fb 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux @@ -73,7 +73,7 @@ (def (alternatives coverage) (-> Coverage (List Coverage)) - (case coverage + (when coverage {#Alt left right} (list.partial left (alternatives right)) @@ -84,7 +84,7 @@ (Equivalence Coverage) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Exhaustive} {#Exhaustive}] true @@ -123,7 +123,7 @@ (def .public (format value) (%.Format Coverage) - (case value + (when value {#Bit it} (%.bit it) @@ -165,7 +165,7 @@ (def .public (coverage pattern) (-> Pattern (Try Coverage)) - (case pattern + (when pattern (^.or {//pattern.#Simple {//simple.#Unit}} {//pattern.#Bind _}) {try.#Success {#Exhaustive}} @@ -190,7 +190,7 @@ ... Tuple patterns can be exhaustive if there is exhaustiveness for all of ... their sub-patterns. {//pattern.#Complex {//complex.#Tuple membersP+}} - (case (list.reversed membersP+) + (when (list.reversed membersP+) (^.or (list) (list _)) (exception.except ..invalid_tuple [(list.size membersP+)]) @@ -202,7 +202,7 @@ (function (_ leftP rightC) (do ! [leftC (coverage leftP)] - (case rightC + (when rightC {#Exhaustive} (in leftC) @@ -249,7 +249,7 @@ (def .public (exhaustive? coverage) (-> Coverage Bit) - (case coverage + (when coverage {#Exhaustive} true @@ -269,7 +269,7 @@ ... There are now 2 alternative paths. )] - (case [addition so_far] + (when [addition so_far] ... 2 bit coverages are exhaustive if they complement one another. [{#Bit sideA} {#Bit sideSF}] (if (xor sideA sideSF) @@ -307,7 +307,7 @@ (do [! try.monad] [casesM (monad.mix ! (function (_ [tagA coverageA] casesSF') - (case (dictionary.value tagA casesSF') + (when (dictionary.value tagA casesSF') {.#Some coverageSF} (do ! [coverageM (composite coverageA coverageSF)] @@ -324,7 +324,7 @@ {#Variant (maybe#composite allA allSF) casesM}))))) [{#Seq leftA rightA} {#Seq leftSF rightSF}] - (case [(/#= leftSF leftA) (/#= rightSF rightA)] + (when [(/#= leftSF leftA) (/#= rightSF rightA)] ... Same prefix [.true .false] (do try.monad @@ -374,14 +374,14 @@ (List Coverage)])) (function (_ coverageA possibilitiesSF) (loop (again [altsSF possibilitiesSF]) - (case altsSF + (when altsSF {.#End} (in [{.#None} (list coverageA)]) {.#Item altSF altsSF'} (do ! [altMSF (composite coverageA altSF)] - (case altMSF + (when altMSF {#Alt _} (do ! [[success altsSF+] (again altsSF')] @@ -393,12 +393,12 @@ possibilitiesSF (alternatives so_far)]) (do ! [[addition' possibilitiesSF'] (fuse_once addition possibilitiesSF)] - (case addition' + (when addition' {.#Some addition'} (again addition' possibilitiesSF') {.#None} - (case (list.reversed possibilitiesSF') + (when (list.reversed possibilitiesSF') {.#Item last prevs} (in (list#mix (function (_ left right) {#Alt left right}) last diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux index 5bbf38167..d85a576cd 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/inference.lux @@ -56,7 +56,7 @@ (def .public (quantified @var @parameter :it:) (-> check.Var Nat Type Type) - (case :it: + (when :it: {.#Primitive name co_variant} {.#Primitive name (list#each (quantified @var @parameter) co_variant)} @@ -95,7 +95,7 @@ ... as a function type, this method of inference should work. (def (general' vars archive analyse inferT args) (-> (List check.Var) Archive Phase Type (List Code) (Operation [Type_Context (List check.Var) Type (List Analysis)])) - (case args + (when args {.#End} (do phase.monad [just_before (/type.check check.context) @@ -103,7 +103,7 @@ (in [just_before vars inferT (list)])) {.#Item argC args'} - (case inferT + (when inferT {.#Named name unnamedT} (general' vars archive analyse unnamedT args) @@ -118,7 +118,7 @@ (general' vars archive analyse (maybe.trusted (type.applied (list :ex:) inferT)) args)) {.#Apply inputT transT} - (case (type.applied (list inputT) transT) + (when (type.applied (list inputT) transT) {.#Some outputT} (general' vars archive analyse outputT args) @@ -143,7 +143,7 @@ {.#Var infer_id} (do phase.monad [?inferT' (/type.check (check.peek infer_id))] - (case ?inferT' + (when ?inferT' {.#Some inferT'} (general' vars archive analyse inferT' args) @@ -159,7 +159,7 @@ (do [! phase.monad] [[just_before vars :inference: terms] (general' (list) archive analyse inferT args)] (in [:inference: terms]) - ... (case vars + ... (when vars ... (list) ... (in [:inference: terms]) @@ -170,7 +170,7 @@ ... [quantifications (monad.mix ! (function (_ @var level) ... (do ! ... [:var: (check.try (check.identity vars @var))] - ... (case :var: + ... (when :var: ... {try.#Success _} ... (in level) @@ -191,7 +191,7 @@ (def (with_recursion @self recursion) (-> Nat Type Type Type) (function (again it) - (case it + (when it (^.or {.#Parameter index} {.#Apply {.#Primitive "" {.#End}} {.#Parameter index}}) @@ -227,7 +227,7 @@ (-> (,, (template.spliced )) Type (Operation Type)) (loop (again [depth 0 it complex]) - (case it + (when it {.#Named name it} (again depth it) @@ -239,7 +239,7 @@ [.#ExQ]) {.#Apply parameter abstraction} - (case (type.applied (list parameter) abstraction) + (when (type.applied (list parameter) abstraction) {.#Some it} (again depth it) @@ -266,7 +266,7 @@ (|> it type.flat_variant (list.after lefts) - (pipe.case + (pipe.when {.#Item [head tail]} (let [case (if right? (type.variant tail) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux index cf6ede122..b8bf793ec 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/macro.lux @@ -37,7 +37,7 @@ (function (_ state) (do try.monad [output (expander macro inputs state)] - (case output + (when output {try.#Failure error} ((meta.failure (exception.error ..expansion_failed [name inputs error])) state) @@ -48,7 +48,7 @@ (-> Expander Symbol Macro (List Code) (Meta Code)) (do meta.monad [expansion (..expansion expander name macro inputs)] - (case expansion + (when expansion (list single) (in single) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux index 8284b0301..b7a808dbf 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux @@ -43,7 +43,7 @@ already_existing Global]) (exception.report (list ["Definition" (%.symbol name)] - ["Original" (case already_existing + ["Original" (when already_existing {.#Alias alias} (format "alias " (%.symbol alias)) @@ -63,7 +63,7 @@ state Module_State]) (exception.report (list ["Module" module] - ["Desired state" (case state + ["Desired state" (when state {.#Active} "Active" {.#Compiled} "Compiled" {.#Cached} "Cached")]))) @@ -110,7 +110,7 @@ (|> state (the .#modules) (property.value module) - (pipe.case + (pipe.when {.#Some _} true @@ -126,7 +126,7 @@ [self_name meta.current_module_name self meta.current_module] (function (_ state) - (case (property.value name (the .#definitions self)) + (when (property.value name (the .#definitions self)) {.#None} {try.#Success [(revised .#modules (property.has self_name @@ -164,9 +164,9 @@ (-> Text (Operation Any)) (///extension.lifted (function (_ state) - (case (|> state (the .#modules) (property.value module_name)) + (when (|> state (the .#modules) (property.value module_name)) {.#Some module} - (let [active? (case (the .#module_state module) + (let [active? (when (the .#module_state module) {.#Active} true @@ -188,10 +188,10 @@ (-> Text (Operation Bit)) (///extension.lifted (function (_ state) - (case (|> state (the .#modules) (property.value module_name)) + (when (|> state (the .#modules) (property.value module_name)) {.#Some module} {try.#Success [state - (case (the .#module_state module) + (when (the .#module_state module) {} true @@ -211,7 +211,7 @@ (-> Bit (List Label) Bit Type (Operation Any)) (do [! ///.monad] [self_name (///extension.lifted meta.current_module_name) - [type_module type_name] (case type + [type_module type_name] (when type {.#Named type_name _} (in type_name) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux index daf608222..836c7c30d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/pattern.lux @@ -27,7 +27,7 @@ (Equivalence Pattern) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Simple reference} {#Simple sample}] (at //simple.equivalence = reference sample) @@ -42,7 +42,7 @@ (def .public (format it) (%.Format Pattern) - (case it + (when it {#Simple it} (//simple.format it) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux index 538874881..c7d17b9cb 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux @@ -52,7 +52,7 @@ (-> Text Scope (Maybe [Type Variable])) (loop (again [idx 0 mappings (the [.#captured .#mappings] scope)]) - (case mappings + (when mappings {.#Item [_name [_source_type _source_ref]] mappings'} (if (text#= name _name) {.#Some [_source_type {variable.#Foreign idx}]} @@ -68,7 +68,7 @@ (def (reference name scope) (-> Text Scope (Maybe [Type Variable])) - (case (..local name scope) + (when (..local name scope) {.#Some type} {.#Some type} @@ -82,7 +82,7 @@ (let [[inner outer] (|> state (the .#scopes) (list.split_when (|>> (reference? name))))] - (case outer + (when outer {.#End} {.#Right [state {.#None}]} @@ -111,7 +111,7 @@ (def .public (with_local [name type] action) (All (_ a) (-> [Text Type] (Operation a) (Operation a))) (function (_ [bundle state]) - (case (the .#scopes state) + (when (the .#scopes state) {.#Item head tail} (let [old_mappings (the [.#locals .#mappings] head) new_var_id (the [.#locals .#counter] head) @@ -120,10 +120,10 @@ (|>> (revised .#counter ++) (revised .#mappings (property.has name [type new_var_id])))) head)] - (case (phase.result' [bundle (has .#scopes {.#Item new_head tail} state)] + (when (phase.result' [bundle (has .#scopes {.#Item new_head tail} state)] action) {try.#Success [[bundle' state'] output]} - (case (the .#scopes state') + (when (the .#scopes state') {.#Item head' tail'} (let [scopes' {.#Item (has .#locals (the .#locals head) head') tail'}] @@ -152,7 +152,7 @@ (def .public (reset action) (All (_ a) (-> (Operation a) (Operation a))) (function (_ [bundle state]) - (case (action [bundle (has .#scopes (list ..empty) state)]) + (when (action [bundle (has .#scopes (list ..empty) state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (has .#scopes (the .#scopes state) state')] output]} @@ -163,9 +163,9 @@ (def .public (with action) (All (_ a) (-> (Operation a) (Operation [Scope a]))) (function (_ [bundle state]) - (case (action [bundle (revised .#scopes (|>> {.#Item ..empty}) state)]) + (when (action [bundle (revised .#scopes (|>> {.#Item ..empty}) state)]) {try.#Success [[bundle' state'] output]} - (case (the .#scopes state') + (when (the .#scopes state') {.#Item head tail} {try.#Success [[bundle' (has .#scopes tail state')] [head output]]} @@ -180,7 +180,7 @@ (Operation Register) (extension.lifted (function (_ state) - (case (the .#scopes state) + (when (the .#scopes state) {.#Item top _} {try.#Success [state (the [.#locals .#counter] top)]} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux index 4b092ad00..239bb848c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux @@ -31,7 +31,7 @@ (Equivalence Simple) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Unit} {#Unit}] true @@ -50,7 +50,7 @@ (def .public (format it) (Format Simple) - (case it + (when it {#Unit} "[]" diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux index b534b616a..85f275a67 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux @@ -29,7 +29,7 @@ (def .public (check action) (All (_ a) (-> (Check a) (Operation a))) (function (_ (^.let stateE [bundle state])) - (case (action (the .#type_context state)) + (when (action (the .#type_context state)) {try.#Success [context' output]} {try.#Success [[bundle (has .#type_context context' state)] output]} @@ -42,7 +42,7 @@ (def .public (existential? type) (-> Type Bit) - (case type + (when type {.#Primitive actual {.#End}} (text.starts_with? ..prefix actual) @@ -95,7 +95,7 @@ ... _ (monad.each ! (function (_ @new) ... (do ! ... [:new: (check.try (check.identity new_vars @new))] - ... (case :new: + ... (when :new: ... {try.#Success :new:} ... (in :new:) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux index 2e1252dec..1b9dbb961 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux @@ -125,7 +125,7 @@ (All (_ anchor expression declaration output) ) (function (_ body) (function (_ [bundle state]) - (case (body [bundle (has {.#Some } state)]) + (when (body [bundle (has {.#Some } state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (has (the state) state')] output]} @@ -137,7 +137,7 @@ (All (_ anchor expression declaration) (Operation anchor expression declaration )) (function (_ (^.let stateE [bundle state])) - (case (the state) + (when (the state) {.#Some output} {try.#Success [stateE output]} @@ -206,7 +206,7 @@ (All (_ anchor expression declaration) (-> unit.ID [(Maybe unit.ID) expression] (Operation anchor expression declaration Any))) (function (_ (^.let state+ [bundle state])) - (case (at (the #host state) evaluate label code) + (when (at (the #host state) evaluate label code) {try.#Success output} {try.#Success [state+ output]} @@ -217,7 +217,7 @@ (All (_ anchor expression declaration) (-> declaration (Operation anchor expression declaration Any))) (function (_ (^.let state+ [bundle state])) - (case (at (the #host state) execute code) + (when (at (the #host state) execute code) {try.#Success output} {try.#Success [state+ output]} @@ -228,7 +228,7 @@ (All (_ anchor expression declaration) (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Operation anchor expression declaration [Text Any declaration]))) (function (_ (^.let stateE [bundle state])) - (case (at (the #host state) define context custom code) + (when (at (the #host state) define context custom code) {try.#Success output} {try.#Success [stateE output]} @@ -240,7 +240,7 @@ (-> artifact.ID (Maybe Text) declaration (Operation anchor expression declaration Any))) (do [! phase.monad] [?buffer (extension.read (the #buffer))] - (case ?buffer + (when ?buffer {.#Some buffer} ... TODO: Optimize by no longer checking for overwrites... (if (sequence.any? (|>> product.left (n.= artifact_id)) buffer) @@ -286,7 +286,7 @@ (do try.monad [[_module output registry] (archive.find _module archive)] {try.#Success registry}))] - (case (registry.id _name registry) + (when (registry.id _name registry) {.#None} (exception.except ..unknown_definition [name (registry.definitions registry)]) @@ -305,7 +305,7 @@ (do try.monad [[_module output registry] (archive.find _module archive)] {try.#Success registry}))] - (case (registry.find_definition _name registry) + (when (registry.find_definition _name registry) {.#None} (exception.except ..unknown_definition [name (registry.definitions registry)]) @@ -326,7 +326,7 @@ (All (_ anchor expression declaration) (-> Archive (Operation anchor expression declaration unit.ID))) (function (_ (^.let stateE [bundle state])) - (case (the #context state) + (when (the #context state) {.#None} (exception.except ..no_context []) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux index a65940d6b..9ea79eab0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux @@ -22,7 +22,7 @@ ["[1][0]" simple] ["[1][0]" complex] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" function] ["/[1]" // ["[1][0]" extension] @@ -43,7 +43,7 @@ (def variant_analysis (template (_ analysis archive tag values) ... (-> Phase Archive Symbol (List Code) (Operation Analysis)) - [(case values + [(when values (list value) (/complex.variant analysis tag archive value) @@ -53,19 +53,19 @@ (def sum_analysis (template (_ analysis archive lefts right? values) ... (-> Phase Archive Nat Bit (List Code) (Operation Analysis)) - [(case values + [(when values (list value) (/complex.sum analysis lefts right? archive value) _ (/complex.sum analysis lefts right? archive (code.tuple values)))])) -(def case_analysis +(def when_analysis (template (_ analysis archive input branches code) ... (-> Phase Archive Code (List Code) Code (Operation Analysis)) - [(case (list.pairs branches) + [(when (list.pairs branches) {.#Some branches} - (/case.case analysis branches archive input) + (/when.when analysis branches archive input) {.#None} (//.except ..invalid [code]))])) @@ -76,11 +76,11 @@ [(do [! //.monad] [[functionT functionA] (/type.inferring (analysis archive functionC))] - (case functionA + (when functionA (/.constant def_name) (do ! [?macro (//extension.lifted (meta.macro def_name))] - (case ?macro + (when ?macro {.#Some macro} (do ! [expansion (//extension.lifted (/macro.single_expansion expander def_name macro argsC+))] @@ -99,7 +99,7 @@ ... The location must be set in the state for the sake ... of having useful error messages. (/.with_location location) - (case code + (when code (^.with_template [ ] [[_ { value}] ( value)]) @@ -120,7 +120,7 @@ (..variant_analysis analysis archive tag values) (^.` ({(^.,* branches)} (^., input))) - (..case_analysis analysis archive input branches code) + (..when_analysis analysis archive input branches code) (^.` ([(^., [_ {.#Symbol ["" function_name]}]) (^., [_ {.#Symbol ["" arg_name]}])] (^., body))) (/function.function analysis function_name arg_name archive body) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux deleted file mode 100644 index 6c637184c..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/case.lux +++ /dev/null @@ -1,364 +0,0 @@ -(.require - [library - [lux (.except Pattern case) - [abstract - ["[0]" monad (.only do)]] - [control - ["[0]" maybe] - ["[0]" try] - ["[0]" exception (.only exception)]] - [data - ["[0]" product] - [text - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" mix monoid monad)]]] - [math - [number - ["n" nat]]] - ["[0]" meta (.only) - ["[0]" code] - [macro - ["^" pattern]] - ["[0]" type (.only) - ["[0]" check (.only Check)]]]]] - ["[0]" / - ["/[1]" // - ["[1][0]" complex] - ["/[1]" // - ["[1][0]" extension] - [// - ["/" analysis (.only Analysis Operation Phase) - ["[1][0]" simple] - ["[1][0]" complex] - ["[1][0]" pattern (.only Pattern)] - ["[1][0]" type] - ["[1][0]" scope] - ["[1][0]" coverage (.only Coverage)]] - [/// - ["[1]" phase]]]]]]) - -(exception .public (mismatch [type Type - pattern Code]) - (exception.report - (list ["Type" (%.type type)] - ["Pattern" (%.code pattern)]))) - -(exception .public (sum_has_no_case [case Nat - type Type]) - (exception.report - (list ["Case" (%.nat case)] - ["Type" (%.type type)]))) - -(exception .public (invalid [it Code]) - (exception.report - (list ["Pattern" (%.code it)]))) - -(exception .public (non_tuple [type Type]) - (exception.report - (list ["Type" (%.type type)]))) - -(exception .public (non_exhaustive [input Code - branches (List [Code Code]) - coverage Coverage]) - (exception.report - (list ["Input" (%.code input)] - ["Branches" (%.code (code.tuple (|> branches - (list#each (function (_ [slot value]) - (list slot value))) - list#conjoint)))] - ["Coverage" (/coverage.format coverage)]))) - -(exception .public empty_branches) - -(def (quantified envs baseT) - (-> (List (List Type)) Type Type) - (.case envs - {.#End} - baseT - - {.#Item head tail} - (quantified tail {.#UnivQ head baseT}))) - -... Type-checking on the input value is done during the analysis of a -... "case" expression, to ensure that the patterns being used make -... sense for the type of the input value. -... Sometimes, that input value is complex, by depending on -... type-variables or quantifications. -... This function makes it easier for "case" analysis to properly -... type-check the input with respect to the patterns. -(def .public (tuple :it:) - (-> Type (Check [(List check.Var) Type])) - (loop (again [envs (is (List (List Type)) - (list)) - :it: :it:]) - (.case :it: - {.#Var id} - (do check.monad - [?:it:' (check.peek id)] - (.case ?:it:' - {.#Some :it:'} - (again envs :it:') - - _ - (check.except ..non_tuple :it:))) - - {.#Named name unnamedT} - (again envs unnamedT) - - {.#UnivQ env unquantifiedT} - (again {.#Item env envs} unquantifiedT) - - {.#ExQ _} - (do check.monad - [[@head :head:] check.var - [tail :tuple:] (again envs (maybe.trusted (type.applied (list :head:) :it:)))] - (in [(list.partial @head tail) :tuple:])) - - {.#Apply _} - (do [! check.monad] - [.let [[:abstraction: :parameters:] (type.flat_application :it:)] - :abstraction: (.case :abstraction: - {.#Var @abstraction} - (do ! - [?:abstraction: (check.peek @abstraction)] - (.case ?:abstraction: - {.#Some :abstraction:} - (in :abstraction:) - - _ - (check.except ..non_tuple :it:))) - - _ - (in :abstraction:))] - (.case (type.applied :parameters: :abstraction:) - {.#Some :it:} - (again envs :it:) - - {.#None} - (check.except ..non_tuple :it:))) - - {.#Product _} - (|> :it: - type.flat_tuple - (list#each (..quantified envs)) - type.tuple - [(list)] - (at check.monad in)) - - _ - (at check.monad in [(list) (..quantified envs :it:)])))) - -(def (simple_pattern_analysis type :input: location output next) - (All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) - (/.with_location location - (do ///.monad - [_ (/type.check (check.check :input: type)) - outputA next] - (in [output outputA])))) - -(def (tuple_pattern_analysis pattern_analysis :input: sub_patterns next) - (All (_ a) - (-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])) - Type (List Code) (Operation a) (Operation [Pattern a]))) - (do [! ///.monad] - [[@ex_var+ :input:'] (/type.check (..tuple :input:))] - (.case :input:' - {.#Product _} - (let [matches (loop (again [types (type.flat_tuple :input:') - patterns sub_patterns - output (is (List [Type Code]) - {.#End})]) - (.case [types patterns] - [{.#End} {.#End}] - output - - [{.#Item headT {.#End}} {.#Item headP {.#End}}] - {.#Item [headT headP] output} - - [remainingT {.#Item headP {.#End}}] - {.#Item [(type.tuple remainingT) headP] output} - - [{.#Item headT {.#End}} remainingP] - {.#Item [headT (code.tuple remainingP)] output} - - [{.#Item headT tailT} {.#Item headP tailP}] - (again tailT tailP {.#Item [headT headP] output}) - - _ - (undefined)))] - (do ! - [[memberP+ thenA] (list#mix (is (All (_ a) - (-> [Type Code] (Operation [(List Pattern) a]) - (Operation [(List Pattern) a]))) - (function (_ [memberT memberC] then) - (do ! - [[memberP [memberP+ thenA]] ((as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) - pattern_analysis) - {.#None} memberT memberC then)] - (in [(list.partial memberP memberP+) thenA])))) - (do ! - [nextA next] - (in [(list) nextA])) - matches) - _ (/type.check (monad.each check.monad check.forget! @ex_var+))] - (in [(/pattern.tuple memberP+) - thenA]))) - - _ - (/.except ..mismatch [:input:' (code.tuple sub_patterns)])))) - -... This function handles several concerns at once, but it must be that -... way because those concerns are interleaved when doing -... pattern-matching and they cannot be separated. -... The pattern is analysed in order to get a general feel for what is -... expected of the input value. This, in turn, informs the -... type-checking of the input. -... A kind of "continuation" value is passed around which signifies -... what needs to be done _after_ analysing a pattern. -... In general, this is done to analyse the "body" expression -... associated to a particular pattern _in the context of_ said -... pattern. -... The reason why *context* is important is because patterns may bind -... values to local variables, which may in turn be referenced in the -... body expressions. -... That is why the body must be analysed in the context of the -... pattern, and not separately. -(def (pattern_analysis num_tags :input: pattern next) - (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) - (.case pattern - [location {.#Symbol ["" name]}] - (/.with_location location - (do ///.monad - [outputA (/scope.with_local [name :input:] - next) - idx /scope.next] - (in [{/pattern.#Bind idx} outputA]))) - - (^.with_template [ ] - [[location ] - (simple_pattern_analysis :input: location {/pattern.#Simple } next)]) - ([Bit {.#Bit pattern_value} {/simple.#Bit pattern_value}] - [Nat {.#Nat pattern_value} {/simple.#Nat pattern_value}] - [Int {.#Int pattern_value} {/simple.#Int pattern_value}] - [Rev {.#Rev pattern_value} {/simple.#Rev pattern_value}] - [Frac {.#Frac pattern_value} {/simple.#Frac pattern_value}] - [Text {.#Text pattern_value} {/simple.#Text pattern_value}] - [Any {.#Tuple {.#End}} {/simple.#Unit}]) - - [location {.#Tuple (list singleton)}] - (pattern_analysis {.#None} :input: singleton next) - - [location {.#Tuple sub_patterns}] - (/.with_location location - (do [! ///.monad] - [record (//complex.normal true sub_patterns) - record_size,members,recordT (is (Operation (Maybe [Nat (List Code) Type])) - (.case record - {.#Some record} - (//complex.order true record) - - {.#None} - (in {.#None})))] - (.case record_size,members,recordT - {.#Some [record_size members recordT]} - (do ! - [_ (.case :input: - {.#Var @input} - (/type.check (do check.monad - [? (check.bound? @input)] - (if ? - (in []) - (check.check :input: recordT)))) - - _ - (in []))] - (.case members - (list singleton) - (pattern_analysis {.#None} :input: singleton next) - - _ - (..tuple_pattern_analysis pattern_analysis :input: members next))) - - {.#None} - (..tuple_pattern_analysis pattern_analysis :input: sub_patterns next)))) - - [location {.#Variant (list.partial [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}] - (/.with_location location - (do ///.monad - [[@ex_var+ :input:'] (/type.check (..tuple :input:))] - (.case :input:' - {.#Sum _} - (let [flat_sum (type.flat_variant :input:') - size_sum (list.size flat_sum) - num_cases (maybe.else size_sum num_tags) - idx (/complex.tag right? lefts)] - (.case (list.item idx flat_sum) - (^.multi {.#Some caseT} - (n.< num_cases idx)) - (do ///.monad - [[testP nextA] (if (and (n.> num_cases size_sum) - (n.= (-- num_cases) idx)) - (pattern_analysis {.#None} - (type.variant (list.after (-- num_cases) flat_sum)) - (` [(,* values)]) - next) - (pattern_analysis {.#None} caseT (` [(,* values)]) next)) - _ (/type.check (monad.each check.monad check.forget! @ex_var+))] - (in [(/pattern.variant [lefts right? testP]) - nextA])) - - _ - (/.except ..sum_has_no_case [idx :input:]))) - - {.#UnivQ _} - (do ///.monad - [[ex_id exT] (/type.check check.existential) - it (pattern_analysis num_tags - (maybe.trusted (type.applied (list exT) :input:')) - pattern - next) - _ (/type.check (monad.each check.monad check.forget! @ex_var+))] - (in it)) - - _ - (/.except ..mismatch [:input:' pattern])))) - - [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}] - (/.with_location location - (do ///.monad - [tag (///extension.lifted (meta.normal tag)) - [idx group variantT] (///extension.lifted (meta.tag tag)) - _ (/type.check (check.check :input: variantT)) - .let [[lefts right?] (/complex.choice (list.size group) idx)]] - (pattern_analysis {.#Some (list.size group)} :input: (` {(, (code.nat lefts)) (, (code.bit right?)) (,* values)}) next))) - - _ - (/.except ..invalid [pattern]) - )) - -(def .public (case analyse branches archive inputC) - (-> Phase (List [Code Code]) Phase) - (.case branches - {.#Item [patternH bodyH] branchesT} - (do [! ///.monad] - [[:input: inputA] (<| /type.inferring - (analyse archive inputC)) - outputH (pattern_analysis {.#None} :input: patternH (analyse archive bodyH)) - outputT (monad.each ! - (function (_ [patternT bodyT]) - (pattern_analysis {.#None} :input: patternT (analyse archive bodyT))) - branchesT) - outputHC (|> outputH product.left /coverage.coverage /.of_try) - outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT) - _ (.case (monad.mix try.monad /coverage.composite outputHC outputTC) - {try.#Success coverage} - (///.assertion ..non_exhaustive [inputC branches coverage] - (/coverage.exhaustive? coverage)) - - {try.#Failure error} - (/.failure error))] - (in {/.#Case inputA [outputH outputT]})) - - {.#End} - (/.except ..empty_branches []))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux index ec4a32d05..42d01ad16 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -113,7 +113,7 @@ [expectedT (///extension.lifted meta.expected_type) expectedT' (/type.check (check.clean (list) expectedT))] (/.with_exception ..cannot_analyse_sum [expectedT' lefts right? valueC] - (case expectedT + (when expectedT {.#Sum _} (|> (analyse archive valueC) (at ! each (|>> [lefts right?] /.variant)) @@ -129,7 +129,7 @@ {.#Var id} (do ! [?expectedT' (/type.check (check.peek id))] - (case ?expectedT' + (when ?expectedT' {.#Some expectedT'} (<| (/type.expecting expectedT') (again valueC)) @@ -152,11 +152,11 @@ (again valueC)) {.#Apply inputT funT} - (case funT + (when funT {.#Var funT_id} (do ! [?funT' (/type.check (check.peek funT_id))] - (case ?funT' + (when ?funT' {.#Some funT'} (<| (/type.expecting {.#Apply inputT funT'}) (again valueC)) @@ -165,7 +165,7 @@ (/.except ..invalid_variant_type [expectedT lefts right? valueC]))) _ - (case (type.applied (list inputT) funT) + (when (type.applied (list inputT) funT) {.#Some outputT} (<| (/type.expecting outputT) (again valueC)) @@ -184,7 +184,7 @@ .let [case_size (list.size group) [lefts right?] (/complex.choice case_size idx)] expectedT (///extension.lifted meta.expected_type)] - (case expectedT + (when expectedT {.#Var _} (do ! [inferenceT (/inference.variant lefts right? variantT) @@ -202,7 +202,7 @@ (is (Operation (List Analysis))) (loop (again [membersT+ (type.flat_tuple expectedT) membersC+ members]) - (case [membersT+ membersC+] + (when [membersT+ membersC+] [{.#Item memberT {.#End}} {.#Item memberC {.#End}}] (<| (at ! each (|>> list)) (/type.expecting memberT) @@ -231,7 +231,7 @@ (do [! ///.monad] [expectedT (///extension.lifted meta.expected_type)] (/.with_exception ..cannot_analyse_tuple [expectedT membersC] - (case expectedT + (when expectedT {.#Product _} (..typed_product analyse expectedT archive membersC) @@ -242,7 +242,7 @@ {.#Var id} (do ! [?expectedT' (/type.check (check.peek id))] - (case ?expectedT' + (when ?expectedT' {.#Some expectedT'} (<| (/type.expecting expectedT') (product analyse archive membersC)) @@ -268,11 +268,11 @@ (product analyse archive membersC)) {.#Apply inputT funT} - (case funT + (when funT {.#Var funT_id} (do ! [?funT' (/type.check (check.peek funT_id))] - (case ?funT' + (when ?funT' {.#Some funT'} (<| (/type.expecting {.#Apply inputT funT'}) (product analyse archive membersC)) @@ -281,7 +281,7 @@ (/.except ..invalid_tuple_type [expectedT membersC]))) _ - (case (type.applied (list inputT) funT) + (when (type.applied (list inputT) funT) {.#Some outputT} (<| (/type.expecting outputT) (product analyse archive membersC)) @@ -302,7 +302,7 @@ (loop (again [input record output (is (List [Symbol Code]) {.#End})]) - (case input + (when input (list.partial [_ {.#Symbol ["" slotH]}] valueH tail) (if pattern_matching? (///#in {.#None}) @@ -337,7 +337,7 @@ (do meta.monad [head_k (meta.normal head_k)] (meta.try (meta.slot head_k))))] - (case slotH' + (when slotH' {try.#Success [_ slot_set recordT]} (do ! [.let [size_record (list.size record) @@ -351,7 +351,7 @@ (function (_ [key val] idx->val) (do ! [key (///extension.lifted (meta.normal key))] - (case (dictionary.value key tag->idx) + (when (dictionary.value key tag->idx) {.#Some idx} (if (dictionary.key? idx->val idx) (/.except ..cannot_repeat_slot [key record]) @@ -372,13 +372,13 @@ (def .public (order pattern_matching? record) (-> Bit (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) - (case record + (when record ... empty_record = empty_tuple = unit/any = [] {.#End} (///#in {.#Some [0 (list) .Any]}) {.#Item [head_k head_v] _} - (case head_k + (when head_k ["" head_k'] (if pattern_matching? (///#in {.#None}) @@ -394,7 +394,7 @@ (def .public (record analyse archive members) (-> Phase Archive (List Code) (Operation Analysis)) - (case members + (when members (list) //simple.unit @@ -405,9 +405,9 @@ (do [! ///.monad] [head_k (///extension.lifted (meta.normal pseudo_slot)) slot (///extension.lifted (meta.try (meta.slot head_k)))] - (case slot + (when slot {try.#Success [_ slot_set recordT]} - (case (list.size slot_set) + (when (list.size slot_set) 1 (analyse archive singletonC) _ (..product analyse archive members)) @@ -417,21 +417,21 @@ _ (do [! ///.monad] [?members (..normal false members)] - (case ?members + (when ?members {.#None} (..product analyse archive members) {.#Some slots} (do ! [record_size,membersC,recordT (..order false slots)] - (case record_size,membersC,recordT + (when record_size,membersC,recordT {.#None} (..product analyse archive members) {.#Some [record_size membersC recordT]} (do ! [expectedT (///extension.lifted meta.expected_type)] - (case expectedT + (when expectedT {.#Var _} (do ! [inferenceT (/inference.record record_size recordT) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux index b14ae34cc..7864fd3d5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -59,7 +59,7 @@ [expectedT (///extension.lifted meta.expected_type)] (loop (again [expectedT expectedT]) (/.with_exception ..cannot_analyse [expectedT function_name arg_name body] - (case expectedT + (when expectedT {.#Function :input: :output:} (<| (at ! each (.function (_ [scope bodyA]) {/.#Function (list#each (|>> /.variable) @@ -77,7 +77,7 @@ (again :anonymous:) {.#Apply argT funT} - (case (type.applied (list argT) funT) + (when (type.applied (list argT) funT) {.#Some value} (again value) @@ -97,7 +97,7 @@ {.#Var id} (do ! [?expectedT' (/type.check (check.peek id))] - (case ?expectedT' + (when ?expectedT' {.#Some expectedT'} (again expectedT') @@ -115,7 +115,7 @@ ?:input: (check.try (check.identity (list @output) @input)) ? (check.linked? @input @output) _ (<| (check.check expectedT) - (case ?:input: + (when ?:input: {try.#Success :input:} {.#Function :input: (if ? :input: diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux index cbee3c622..d71fa4ad0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux @@ -45,7 +45,7 @@ (with_expansions [ (in (|> def_name ///reference.constant {/.#Reference}))] (do [! ///.monad] [constant (///extension.lifted (meta.definition def_name))] - (case constant + (when constant {.#Alias real_def_name} (definition quoted_module real_def_name) @@ -91,7 +91,7 @@ (-> Text (Operation (Maybe Analysis))) (do [! ///.monad] [?var (/scope.variable var_name)] - (case ?var + (when ?var {.#Some [actualT ref]} (do ! [_ (/type.inference actualT)] @@ -102,11 +102,11 @@ (def .public (reference quoted_module it) (-> Text Symbol (Operation Analysis)) - (case it + (when it ["" simple_name] (do [! ///.monad] [?var (variable simple_name)] - (case ?var + (when ?var {.#Some varA} (in varA) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux new file mode 100644 index 000000000..ceb60e374 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux @@ -0,0 +1,364 @@ +(.require + [library + [lux (.except Pattern when) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + ["[0]" product] + [text + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" mix monoid monad)]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" code] + [macro + ["^" pattern]] + ["[0]" type (.only) + ["[0]" check (.only Check)]]]]] + ["[0]" / + ["/[1]" // + ["[1][0]" complex] + ["/[1]" // + ["[1][0]" extension] + [// + ["/" analysis (.only Analysis Operation Phase) + ["[1][0]" simple] + ["[1][0]" complex] + ["[1][0]" pattern (.only Pattern)] + ["[1][0]" type] + ["[1][0]" scope] + ["[1][0]" coverage (.only Coverage)]] + [/// + ["[1]" phase]]]]]]) + +(exception .public (mismatch [type Type + pattern Code]) + (exception.report + (list ["Type" (%.type type)] + ["Pattern" (%.code pattern)]))) + +(exception .public (sum_has_no_case [case Nat + type Type]) + (exception.report + (list ["Case" (%.nat case)] + ["Type" (%.type type)]))) + +(exception .public (invalid [it Code]) + (exception.report + (list ["Pattern" (%.code it)]))) + +(exception .public (non_tuple [type Type]) + (exception.report + (list ["Type" (%.type type)]))) + +(exception .public (non_exhaustive [input Code + branches (List [Code Code]) + coverage Coverage]) + (exception.report + (list ["Input" (%.code input)] + ["Branches" (%.code (code.tuple (|> branches + (list#each (function (_ [slot value]) + (list slot value))) + list#conjoint)))] + ["Coverage" (/coverage.format coverage)]))) + +(exception .public empty_branches) + +(def (quantified envs baseT) + (-> (List (List Type)) Type Type) + (.when envs + {.#End} + baseT + + {.#Item head tail} + (quantified tail {.#UnivQ head baseT}))) + +... Type-checking on the input value is done during the analysis of a +... "when" expression, to ensure that the patterns being used make +... sense for the type of the input value. +... Sometimes, that input value is complex, by depending on +... type-variables or quantifications. +... This function makes it easier for "when" analysis to properly +... type-check the input with respect to the patterns. +(def .public (tuple :it:) + (-> Type (Check [(List check.Var) Type])) + (loop (again [envs (is (List (List Type)) + (list)) + :it: :it:]) + (.when :it: + {.#Var id} + (do check.monad + [?:it:' (check.peek id)] + (.when ?:it:' + {.#Some :it:'} + (again envs :it:') + + _ + (check.except ..non_tuple :it:))) + + {.#Named name unnamedT} + (again envs unnamedT) + + {.#UnivQ env unquantifiedT} + (again {.#Item env envs} unquantifiedT) + + {.#ExQ _} + (do check.monad + [[@head :head:] check.var + [tail :tuple:] (again envs (maybe.trusted (type.applied (list :head:) :it:)))] + (in [(list.partial @head tail) :tuple:])) + + {.#Apply _} + (do [! check.monad] + [.let [[:abstraction: :parameters:] (type.flat_application :it:)] + :abstraction: (.when :abstraction: + {.#Var @abstraction} + (do ! + [?:abstraction: (check.peek @abstraction)] + (.when ?:abstraction: + {.#Some :abstraction:} + (in :abstraction:) + + _ + (check.except ..non_tuple :it:))) + + _ + (in :abstraction:))] + (.when (type.applied :parameters: :abstraction:) + {.#Some :it:} + (again envs :it:) + + {.#None} + (check.except ..non_tuple :it:))) + + {.#Product _} + (|> :it: + type.flat_tuple + (list#each (..quantified envs)) + type.tuple + [(list)] + (at check.monad in)) + + _ + (at check.monad in [(list) (..quantified envs :it:)])))) + +(def (simple_pattern_analysis type :input: location output next) + (All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) + (/.with_location location + (do ///.monad + [_ (/type.check (check.check :input: type)) + outputA next] + (in [output outputA])))) + +(def (tuple_pattern_analysis pattern_analysis :input: sub_patterns next) + (All (_ a) + (-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])) + Type (List Code) (Operation a) (Operation [Pattern a]))) + (do [! ///.monad] + [[@ex_var+ :input:'] (/type.check (..tuple :input:))] + (.when :input:' + {.#Product _} + (let [matches (loop (again [types (type.flat_tuple :input:') + patterns sub_patterns + output (is (List [Type Code]) + {.#End})]) + (.when [types patterns] + [{.#End} {.#End}] + output + + [{.#Item headT {.#End}} {.#Item headP {.#End}}] + {.#Item [headT headP] output} + + [remainingT {.#Item headP {.#End}}] + {.#Item [(type.tuple remainingT) headP] output} + + [{.#Item headT {.#End}} remainingP] + {.#Item [headT (code.tuple remainingP)] output} + + [{.#Item headT tailT} {.#Item headP tailP}] + (again tailT tailP {.#Item [headT headP] output}) + + _ + (undefined)))] + (do ! + [[memberP+ thenA] (list#mix (is (All (_ a) + (-> [Type Code] (Operation [(List Pattern) a]) + (Operation [(List Pattern) a]))) + (function (_ [memberT memberC] then) + (do ! + [[memberP [memberP+ thenA]] ((as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + pattern_analysis) + {.#None} memberT memberC then)] + (in [(list.partial memberP memberP+) thenA])))) + (do ! + [nextA next] + (in [(list) nextA])) + matches) + _ (/type.check (monad.each check.monad check.forget! @ex_var+))] + (in [(/pattern.tuple memberP+) + thenA]))) + + _ + (/.except ..mismatch [:input:' (code.tuple sub_patterns)])))) + +... This function handles several concerns at once, but it must be that +... way because those concerns are interleaved when doing +... pattern-matching and they cannot be separated. +... The pattern is analysed in order to get a general feel for what is +... expected of the input value. This, in turn, informs the +... type-checking of the input. +... A kind of "continuation" value is passed around which signifies +... what needs to be done _after_ analysing a pattern. +... In general, this is done to analyse the "body" expression +... associated to a particular pattern _in the context of_ said +... pattern. +... The reason why *context* is important is because patterns may bind +... values to local variables, which may in turn be referenced in the +... body expressions. +... That is why the body must be analysed in the context of the +... pattern, and not separately. +(def (pattern_analysis num_tags :input: pattern next) + (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + (.when pattern + [location {.#Symbol ["" name]}] + (/.with_location location + (do ///.monad + [outputA (/scope.with_local [name :input:] + next) + idx /scope.next] + (in [{/pattern.#Bind idx} outputA]))) + + (^.with_template [ ] + [[location ] + (simple_pattern_analysis :input: location {/pattern.#Simple } next)]) + ([Bit {.#Bit pattern_value} {/simple.#Bit pattern_value}] + [Nat {.#Nat pattern_value} {/simple.#Nat pattern_value}] + [Int {.#Int pattern_value} {/simple.#Int pattern_value}] + [Rev {.#Rev pattern_value} {/simple.#Rev pattern_value}] + [Frac {.#Frac pattern_value} {/simple.#Frac pattern_value}] + [Text {.#Text pattern_value} {/simple.#Text pattern_value}] + [Any {.#Tuple {.#End}} {/simple.#Unit}]) + + [location {.#Tuple (list singleton)}] + (pattern_analysis {.#None} :input: singleton next) + + [location {.#Tuple sub_patterns}] + (/.with_location location + (do [! ///.monad] + [record (//complex.normal true sub_patterns) + record_size,members,recordT (is (Operation (Maybe [Nat (List Code) Type])) + (.when record + {.#Some record} + (//complex.order true record) + + {.#None} + (in {.#None})))] + (.when record_size,members,recordT + {.#Some [record_size members recordT]} + (do ! + [_ (.when :input: + {.#Var @input} + (/type.check (do check.monad + [? (check.bound? @input)] + (if ? + (in []) + (check.check :input: recordT)))) + + _ + (in []))] + (.when members + (list singleton) + (pattern_analysis {.#None} :input: singleton next) + + _ + (..tuple_pattern_analysis pattern_analysis :input: members next))) + + {.#None} + (..tuple_pattern_analysis pattern_analysis :input: sub_patterns next)))) + + [location {.#Variant (list.partial [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}] + (/.with_location location + (do ///.monad + [[@ex_var+ :input:'] (/type.check (..tuple :input:))] + (.when :input:' + {.#Sum _} + (let [flat_sum (type.flat_variant :input:') + size_sum (list.size flat_sum) + num_cases (maybe.else size_sum num_tags) + idx (/complex.tag right? lefts)] + (.when (list.item idx flat_sum) + (^.multi {.#Some caseT} + (n.< num_cases idx)) + (do ///.monad + [[testP nextA] (if (and (n.> num_cases size_sum) + (n.= (-- num_cases) idx)) + (pattern_analysis {.#None} + (type.variant (list.after (-- num_cases) flat_sum)) + (` [(,* values)]) + next) + (pattern_analysis {.#None} caseT (` [(,* values)]) next)) + _ (/type.check (monad.each check.monad check.forget! @ex_var+))] + (in [(/pattern.variant [lefts right? testP]) + nextA])) + + _ + (/.except ..sum_has_no_case [idx :input:]))) + + {.#UnivQ _} + (do ///.monad + [[ex_id exT] (/type.check check.existential) + it (pattern_analysis num_tags + (maybe.trusted (type.applied (list exT) :input:')) + pattern + next) + _ (/type.check (monad.each check.monad check.forget! @ex_var+))] + (in it)) + + _ + (/.except ..mismatch [:input:' pattern])))) + + [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}] + (/.with_location location + (do ///.monad + [tag (///extension.lifted (meta.normal tag)) + [idx group variantT] (///extension.lifted (meta.tag tag)) + _ (/type.check (check.check :input: variantT)) + .let [[lefts right?] (/complex.choice (list.size group) idx)]] + (pattern_analysis {.#Some (list.size group)} :input: (` {(, (code.nat lefts)) (, (code.bit right?)) (,* values)}) next))) + + _ + (/.except ..invalid [pattern]) + )) + +(def .public (when analyse branches archive inputC) + (-> Phase (List [Code Code]) Phase) + (.when branches + {.#Item [patternH bodyH] branchesT} + (do [! ///.monad] + [[:input: inputA] (<| /type.inferring + (analyse archive inputC)) + outputH (pattern_analysis {.#None} :input: patternH (analyse archive bodyH)) + outputT (monad.each ! + (function (_ [patternT bodyT]) + (pattern_analysis {.#None} :input: patternT (analyse archive bodyT))) + branchesT) + outputHC (|> outputH product.left /coverage.coverage /.of_try) + outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT) + _ (.when (monad.mix try.monad /coverage.composite outputHC outputTC) + {try.#Success coverage} + (///.assertion ..non_exhaustive [inputC branches coverage] + (/coverage.exhaustive? coverage)) + + {try.#Failure error} + (/.failure error))] + (in {/.#When inputA [outputH outputT]})) + + {.#End} + (/.except ..empty_branches []))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux index 4fd6f0ed3..cd102ce48 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux @@ -47,7 +47,7 @@ (-> Archive ///analysis.Bundle evaluation.Eval Eval) (function (_ type code lux) - (case (compiler_eval archive type code [bundle lux]) + (when (compiler_eval archive type code [bundle lux]) {try.#Success [[_bundle lux'] value]} {try.#Success [lux' value]} @@ -62,12 +62,12 @@ (loop (again [state state input expansion output /.no_requirements]) - (case input + (when input {.#End} {try.#Success [state output]} {.#Item head tail} - (case (phase archive head state) + (when (phase archive head state) {try.#Success [state' head']} (again state' tail (/.merge_requirements head' output)) @@ -89,7 +89,7 @@ (the [//extension.#state /.#generation /.#phase] state))) extension_eval (as Eval (wrapper (as_expected compiler_eval)))] _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] - (case code + (when code [_ {.#Form (list.partial [_ {.#Text name}] inputs)}] (//extension.apply archive again [name inputs]) @@ -99,11 +99,11 @@ (do ! [macroA (<| (///analysis/type.expecting Macro) (analysis archive macro))] - (case macroA + (when macroA (///analysis.constant macro_name) (do ! [?macro (//extension.lifted (meta.macro macro_name)) - macro (case ?macro + macro (when ?macro {.#Some macro} (in macro) @@ -113,7 +113,7 @@ _ (//.except ..invalid_macro_call code))))] - (case expansion + (when expansion (list.partial referrals) (|> (again archive ) (at ! each (revised /.#referrals (list#composite referrals)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux index 5606f0a5e..0ad49b88e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux @@ -99,7 +99,7 @@ (All (_ s i o) (-> (Extender s i o) Name (Handler s i o) (Operation s i o Any))) (function (_ [bundle state]) - (case (dictionary.has' name (extender handler) bundle) + (when (dictionary.has' name (extender handler) bundle) {try.#Success bundle'} {try.#Success [[bundle' state] []]} @@ -121,7 +121,7 @@ (All (_ s i o) (-> Archive (Phase s i o) (Extension i) (Operation s i o o))) (function (_ (^.let stateE [bundle state])) - (case (dictionary.value name bundle) + (when (dictionary.value name bundle) {.#Some handler} (((handler name phase) archive parameters) stateE) @@ -136,7 +136,7 @@ (function (_ operation) (function (_ [bundle state]) (let [old (get state)] - (case (operation [bundle (set (transform old) state)]) + (when (operation [bundle (set (transform old) state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (set old state')] output]} @@ -149,7 +149,7 @@ (-> (Operation s i o v) (Operation s i o v)))) (function (_ operation) (function (_ [bundle state]) - (case (operation [bundle (transform state)]) + (when (operation [bundle (transform state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' state] output]} @@ -177,7 +177,7 @@ (All (_ s i o v) (-> (//.Operation s v) (Operation s i o v))) (function (_ [bundle state]) - (case (action state) + (when (action state) {try.#Success [state' output]} {try.#Success [[bundle state'] output]} @@ -188,7 +188,7 @@ (All (_ s i o v) (-> (Operation s i o v) (//.Operation s v))) (function (_ state) - (case (it [..empty state]) + (when (it [..empty state]) {try.#Success [[_ state'] output]} {try.#Success [state' output]} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux index e072e7d9d..9b8eabe1b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -395,16 +395,16 @@ (def lux_array_type (template (_ :read: :write:) - [{.#Primitive array.type_name (list {.#Apply :write: {.#Apply :read: _Mutable}})}])) + [{.#Primitive array.primitive (list {.#Apply :write: {.#Apply :read: _Mutable}})}])) (def (jvm_type luxT) (-> .Type (Operation (Type Value))) - (case luxT + (when luxT {.#Named name anonymousT} (jvm_type anonymousT) {.#Apply inputT abstractionT} - (case (type.applied (list inputT) abstractionT) + (when (type.applied (list inputT) abstractionT) {.#Some outputT} (jvm_type outputT) @@ -415,9 +415,9 @@ (phase#each jvm.array (jvm_type elemT)) {.#Primitive class parametersT} - (case (dictionary.value class ..boxes) + (when (dictionary.value class ..boxes) {.#Some [_ primitive_type]} - (case parametersT + (when parametersT {.#End} (phase#in primitive_type) @@ -431,7 +431,7 @@ (function (_ parameterT) (do phase.monad [parameterJT (jvm_type parameterT)] - (case (parser.parameter? parameterJT) + (when (parser.parameter? parameterJT) {.#Some parameterJT} (in parameterJT) @@ -461,7 +461,7 @@ (def (primitive_array_length_handler primitive_type) (-> (Type Primitive) Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list arrayC) (do phase.monad [_ (typeA.inference ..int) @@ -477,7 +477,7 @@ (def array::length::object Handler (function (_ extension_name analyse archive args) - (case args + (when args (list arrayC) (<| typeA.with_var (function (_ [@read :read:])) @@ -499,7 +499,7 @@ (def (new_primitive_array_handler primitive_type) (-> (Type Primitive) Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list lengthC) (do phase.monad [lengthA (<| (typeA.expecting ..int) @@ -514,14 +514,14 @@ (def array::new::object Handler (function (_ extension_name analyse archive args) - (case args + (when args (list lengthC) (do phase.monad [lengthA (<| (typeA.expecting ..int) (analyse archive lengthC)) expectedT (///.lifted meta.expected_type) expectedJT (jvm_array_type expectedT) - elementJT (case (parser.array? expectedJT) + elementJT (when (parser.array? expectedJT) {.#Some elementJT} (in elementJT) @@ -535,7 +535,7 @@ (def (check_parameter objectT) (-> .Type (Operation (Type Parameter))) - (case objectT + (when objectT (lux_array_type elementT _) (/////analysis.except ..non_parameter objectT) @@ -563,7 +563,7 @@ {.#Var @var} (do phase.monad [:var: (typeA.check (check.peek @var))] - (case :var: + (when :var: {.#Some :var:} (check_parameter :var:) @@ -581,7 +581,7 @@ [.#ExQ]) {.#Apply inputT abstractionT} - (case (type.applied (list inputT) abstractionT) + (when (type.applied (list inputT) abstractionT) {.#Some outputT} (check_parameter outputT) @@ -596,7 +596,7 @@ (def (check_jvm objectT) (-> .Type (Operation (Type Value))) - (case objectT + (when objectT {.#Primitive name {.#End}} (`` (cond (,, (with_template [] [(text#= (..reflection ) name) @@ -652,7 +652,7 @@ [.#ExQ]) {.#Apply inputT abstractionT} - (case (type.applied (list inputT) abstractionT) + (when (type.applied (list inputT) abstractionT) {.#Some outputT} (check_jvm outputT) @@ -665,7 +665,7 @@ (with_template [ ] [(def .public ( mapping typeJ) (-> Mapping (Type ) (Operation .Type)) - (case (|> typeJ ..signature (.result ( mapping))) + (when (|> typeJ ..signature (.result ( mapping))) {try.#Success check} (typeA.check check) @@ -698,7 +698,7 @@ (def (read_primitive_array_handler lux_type jvm_type) (-> .Type (Type Primitive) Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list idxC arrayC) (do phase.monad [_ (typeA.inference lux_type) @@ -715,7 +715,7 @@ (def array::read::object Handler (function (_ extension_name analyse archive args) - (case args + (when args (list idxC arrayC) (<| typeA.with_var (function (_ [@read :read:])) @@ -742,7 +742,7 @@ (let [array_type {.#Primitive (|> (jvm.array jvm_type) ..reflection) (list)}] (function (_ extension_name analyse archive args) - (case args + (when args (list idxC valueC arrayC) (do phase.monad [_ (typeA.inference array_type) @@ -762,7 +762,7 @@ (def array::write::object Handler (function (_ extension_name analyse archive args) - (case args + (when args (list idxC valueC arrayC) (<| typeA.with_var (function (_ [@read :read:])) @@ -840,7 +840,7 @@ (def object::null Handler (function (_ extension_name analyse archive args) - (case args + (when args (list) (do phase.monad [expectedT (///.lifted meta.expected_type) @@ -854,7 +854,7 @@ (def object::null? Handler (function (_ extension_name analyse archive args) - (case args + (when args (list objectC) (do phase.monad [_ (typeA.inference .Bit) @@ -869,7 +869,7 @@ (def object::synchronized Handler (function (_ extension_name analyse archive args) - (case args + (when args (list monitorC exprC) (do phase.monad [[monitorT monitorA] (typeA.inferring @@ -884,7 +884,7 @@ (def (object::throw class_loader) (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list exceptionC) (do phase.monad [_ (typeA.inference Nothing) @@ -904,9 +904,9 @@ (def (object::class class_loader) (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list classC) - (case classC + (when classC [_ {.#Text class}] (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -949,7 +949,7 @@ super_class (phase.lifted (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) - (case (java/lang/Class::getGenericSuperclass from_class) + (when (java/lang/Class::getGenericSuperclass from_class) {.#Some super} (list.partial super (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))) @@ -962,7 +962,7 @@ (def (object::cast class_loader) (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list fromC) (do [! phase.monad] [toT (///.lifted meta.expected_type) @@ -1006,7 +1006,7 @@ (do ! [candidate_parents (is (Operation (List [[Text .Type] Bit])) (class_candidate_parents class_loader current_name currentT to_name to_class))] - (case (|> candidate_parents + (when (|> candidate_parents (list.only product.right) (list#each product.left)) {.#Item [next_name nextT] _} @@ -1014,7 +1014,7 @@ {.#End} (in false))))) - (in (case [(type#= java/lang/Object fromT) + (in (when [(type#= java/lang/Object fromT) (parser.array? toJT)] [.true {.#Some _}] true @@ -1154,21 +1154,21 @@ (def (de_aliased aliasing) (-> Aliasing (Type Value) (Type Value)) (function (again it) - (`` (<| (case (parser.var? it) + (`` (<| (when (parser.var? it) {.#Some name} (|> aliasing (dictionary.value name) (maybe#each jvm.var) (maybe.else it)) {.#None}) - (case (parser.class? it) + (when (parser.class? it) {.#Some [name parameters]} (|> parameters (list#each (|>> again (as (Type Parameter)))) (jvm.class name)) {.#None}) (,, (with_template [ ] - [(case ( it) + [(when ( it) {.#Some :sub:} ( (as (Type ) (again :sub:))) {.#None})] @@ -1189,13 +1189,13 @@ .let [modifiers (java/lang/reflect/Method::getModifiers method) correct_class? (java/lang/Class::isAssignableFrom class (java/lang/reflect/Method::getDeclaringClass method)) correct_method? (text#= method_name (java/lang/reflect/Method::getName method)) - same_static? (case method_style + same_static? (when method_style {#Static} (java/lang/reflect/Modifier::isStatic modifiers) _ true) - same_special? (case method_style + same_special? (when method_style {#Special} (not (or (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers class)) (java/lang/reflect/Modifier::isAbstract modifiers))) @@ -1262,7 +1262,7 @@ (def (return_type it) (-> java/lang/reflect/Method (Try (Type Return))) (reflection!.return - (case (java/lang/reflect/Method::getGenericReturnType it) + (when (java/lang/reflect/Method::getGenericReturnType it) {.#Some it} it @@ -1272,7 +1272,7 @@ (def (method_signature method_style method) (-> Method_Style java/lang/reflect/Method (Operation Method_Signature)) (let [owner (java/lang/reflect/Method::getDeclaringClass method) - owner_tvars (case method_style + owner_tvars (when method_style {#Static} (list) @@ -1303,7 +1303,7 @@ (phase#each (monad.each ! (..reflection_type mapping))) phase#conjoint) .let [methodT (<| (type.univ_q (dictionary.size mapping)) - (type.function (case method_style + (type.function (when method_style {#Static} inputsT @@ -1358,7 +1358,7 @@ (with_template [ ] [(def (-> Evaluation (Maybe Method_Signature)) - (|>> (pipe.case + (|>> (pipe.when { output} {.#Some output} @@ -1391,7 +1391,7 @@ (-> (java/lang/Class java/lang/Object) (List (java/lang/Class java/lang/Object))) (let [interfaces (array.list {.#None} (java/lang/Class::getInterfaces it)) - supers (case (java/lang/Class::getSuperclass it) + supers (when (java/lang/Class::getSuperclass it) {.#Some class} (list.partial class interfaces) @@ -1440,7 +1440,7 @@ (|>> {#Pass}) (|>> {#Hint})) (method_signature method_style method)))))))] - (case (list.all pass candidates) + (when (list.all pass candidates) {.#Item method {.#End}} (in method) @@ -1474,7 +1474,7 @@ (|>> {#Pass}) (|>> {#Hint})) (constructor_signature constructor))))))] - (case (list.all pass candidates) + (when (list.all pass candidates) {.#Item constructor {.#End}} (in constructor) @@ -1539,7 +1539,7 @@ _ (phase.assertion ..deprecated_method [class method methodT] (not deprecated?)) [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) - .let [[objectA argsA] (case allA + .let [[objectA argsA] (when allA {.#Item objectA argsA} [objectA argsA] @@ -1564,7 +1564,7 @@ _ (phase.assertion ..deprecated_method [class method methodT] (not deprecated?)) [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) - .let [[objectA argsA] (case allA + .let [[objectA argsA] (when allA {.#Item objectA argsA} [objectA argsA] @@ -1592,7 +1592,7 @@ _ (phase.assertion ..deprecated_method [class_name method methodT] (not deprecated?)) [outputT allA] (inference.general archive analyse methodT (list.partial objectC (list#each product.right argsTC))) - .let [[objectA argsA] (case allA + .let [[objectA argsA] (when allA {.#Item objectA argsA} [objectA argsA] @@ -1790,7 +1790,7 @@ (def .public (visibility_analysis visibility) (-> Visibility Analysis) - (/////analysis.text (case visibility + (/////analysis.text (when visibility {#Public} ..public_tag {#Private} ..private_tag {#Protected} ..protected_tag @@ -1897,13 +1897,13 @@ (def (with_fake_parameter#pattern it) (-> pattern.Pattern pattern.Pattern) - (case it + (when it {pattern.#Simple _} it {pattern.#Complex it} {pattern.#Complex - (case it + (when it {complex.#Variant it} {complex.#Variant (revised complex.#value with_fake_parameter#pattern it)} @@ -1915,13 +1915,13 @@ (def (with_fake_parameter it) (-> Analysis Analysis) - (case it + (when it {/////analysis.#Simple _} it {/////analysis.#Structure it} {/////analysis.#Structure - (case it + (when it {complex.#Variant it} {complex.#Variant (revised complex.#value with_fake_parameter it)} @@ -1930,10 +1930,10 @@ {/////analysis.#Reference it} {/////analysis.#Reference - (case it + (when it {reference.#Variable it} {reference.#Variable - (case it + (when it {variable.#Local it} {variable.#Local (++ it)} @@ -1943,8 +1943,8 @@ {reference.#Constant _} it)} - {/////analysis.#Case value [head tail]} - {/////analysis.#Case (with_fake_parameter value) + {/////analysis.#When value [head tail]} + {/////analysis.#When (with_fake_parameter value) (let [with_fake_parameter (is (-> /////analysis.Branch /////analysis.Branch) (|>> (revised /////analysis.#when with_fake_parameter#pattern) (revised /////analysis.#then with_fake_parameter)))] @@ -1967,13 +1967,13 @@ (-> Nat Analysis Analysis) (<| /////analysis.tuple (list (/////analysis.unit)) - (case arity + (when arity (^.or 0 1) bodyA 2 (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] - {/////analysis.#Case (/////analysis.unit) + {/////analysis.#When (/////analysis.unit) [[/////analysis.#when {pattern.#Bind 2} @@ -1983,7 +1983,7 @@ _ (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] - {/////analysis.#Case (/////analysis.unit) + {/////analysis.#When (/////analysis.unit) [[/////analysis.#when {pattern.#Complex {complex.#Tuple @@ -2044,7 +2044,7 @@ (list#each (|>> /////analysis.variable) (scope.environment scope)) (<| (..hidden_method_body arity) - (case arity + (when arity 0 (with_fake_parameter bodyA) _ bodyA))} )))))) @@ -2148,7 +2148,7 @@ (list#each (|>> /////analysis.variable) (scope.environment scope)) (<| (..hidden_method_body arity) - (case arity + (when arity 0 (with_fake_parameter bodyA) _ bodyA))} )))))) @@ -2274,7 +2274,7 @@ (def (override_mapping mapping supers parent_type) (-> Mapping (List (Type Class)) (Type Class) (Operation (List [Text .Type]))) (let [[parent_name parent_parameters] (parser.read_class parent_type)] - (case (list.one (function (_ super) + (when (list.one (function (_ super) (let [[super_name super_parameters] (parser.read_class super)] (if (text#= parent_name super_name) {.#Some super_parameters} @@ -2353,7 +2353,7 @@ (list#each (|>> /////analysis.variable) (scope.environment scope)) (<| (..hidden_method_body arity) - (case arity + (when arity 0 (with_fake_parameter bodyA) _ bodyA))} )))))) @@ -2397,7 +2397,7 @@ (list.size actual_parameters)))] (in (|> (list.zipped_2 expected_parameters actual_parameters) (list#mix (function (_ [expected actual] mapping) - (case (parser.var? actual) + (when (parser.var? actual) {.#Some actual} (dictionary.has actual expected mapping) @@ -2493,17 +2493,17 @@ (def (field_definition field) (-> Field (Resource field.Field)) - (case field + (when field ... TODO: Handle annotations. {#Constant [name annotations type value]} - (case value + (when value (^.with_template [ ] [[_ { value}] (do pool.monad [constant (`` (|> value (,, (template.spliced )))) attribute (attribute.constant constant)] (field.field ..constant::modifier name true (sequence.sequence attribute)))]) - ([.#Bit jvm.boolean [(pipe.case #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] + ([.#Bit jvm.boolean [(pipe.when #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] [.#Int jvm.byte [.i64 i32.i32 constant.integer pool.integer]] [.#Int jvm.short [.i64 i32.i32 constant.integer pool.integer]] [.#Int jvm.int [.i64 i32.i32 constant.integer pool.integer]] @@ -2525,7 +2525,7 @@ (def method_privacy (-> ffi.Privacy (Modifier method.Method)) - (|>> (pipe.case + (|>> (pipe.when {ffi.#PublicP} method.public {ffi.#PrivateP} method.private {ffi.#ProtectedP} method.protected @@ -2536,7 +2536,7 @@ (def (mock_value valueT) (-> (Type Value) (Bytecode Any)) - (case (jvm.primitive? valueT) + (when (jvm.primitive? valueT) {.#Left classT} _.aconst_null @@ -2555,14 +2555,14 @@ (def (mock_return :return:) (-> (Type Return) (Bytecode Any)) - (case (jvm.void? :return:) + (when (jvm.void? :return:) {.#Right :return:} _.return {.#Left valueT} (all _.composite (mock_value valueT) - (case (jvm.primitive? valueT) + (when (jvm.primitive? valueT) {.#Left classT} _.areturn @@ -2581,7 +2581,7 @@ (def (mock_method super method) (-> (Type Class) (Method_Definition Code) (Resource method.Method)) - (case method + (when method {#Constructor [privacy strict_floating_point? annotations variables exceptions self arguments constructor_arguments body]} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index df5a61fc9..98912da07 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -42,7 +42,7 @@ (-> Text Phase Archive s (Operation Analysis))] Handler)) (function (_ extension_name analyse archive args) - (case (.result syntax args) + (when (.result syntax args) {try.#Success inputs} (handler extension_name analyse archive inputs) @@ -91,7 +91,7 @@ (Parser text.Char) (do <>.monad [raw .text] - (case (text.size raw) + (when (text.size raw) 1 (in (|> raw (text.char 0) maybe.trusted)) _ (<>.failure (exception.error ..char_text_must_be_size_1 [raw]))))) @@ -137,7 +137,7 @@ (def lux::try Handler (function (_ extension_name analyse archive args) - (case args + (when args (list opC) (<| typeA.with_var (function (_ [@var :var:])) @@ -154,7 +154,7 @@ (def lux::in_module Handler (function (_ extension_name analyse archive argsC+) - (case argsC+ + (when argsC+ (list [_ {.#Text module_name}] exprC) (////analysis.with_current_module module_name (analyse archive exprC)) @@ -165,7 +165,7 @@ (def (lux::type::check eval) (-> Eval Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list typeC valueC) (do [! ////.monad] [actualT (at ! each (|>> (as Type)) @@ -180,7 +180,7 @@ (def (lux::type::as eval) (-> Eval Handler) (function (_ extension_name analyse archive args) - (case args + (when args (list typeC valueC) (do [! ////.monad] [actualT (at ! each (|>> (as Type)) @@ -217,7 +217,7 @@ input_type (loop (again [input_name (symbol .Macro')]) (do ! [input_type (///.lifted (meta.definition (symbol .Macro')))] - (case input_type + (when input_type (^.or {.#Definition [exported? def_type def_value]} {.#Type [exported? def_value labels]}) (in (as Type def_value)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux index 16dc3bc08..942f931d8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux @@ -103,7 +103,7 @@ (def method_privacy (-> ffi.Privacy (Modifier method.Method)) - (|>> (pipe.case + (|>> (pipe.when {ffi.#PublicP} method.public {ffi.#PrivateP} method.private {ffi.#ProtectedP} method.protected @@ -227,17 +227,17 @@ (def (field_definition field) (-> Field (Resource field.Field)) - (case field + (when field ... TODO: Handle annotations. {#Constant [name annotations type value]} - (case value + (when value (^.with_template [ ] [[_ { value}] (do pool.monad [constant (`` (|> value (,, (template.spliced )))) attribute (attribute.constant constant)] (field.field ..constant::modifier name true (sequence.sequence attribute)))]) - ([.#Bit type.boolean [(pipe.case #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] + ([.#Bit type.boolean [(pipe.when #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] [.#Int type.byte [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.short [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.int [.i64 i32.i32 constant.integer pool.integer]] @@ -414,7 +414,7 @@ (def (method_argument lux_register argumentT jvm_register) (-> Register (Type Value) Register [Register (Bytecode Any)]) - (case (type.primitive? argumentT) + (when (type.primitive? argumentT) {.#Left argumentT} [(n.+ 1 jvm_register) (if (n.= lux_register jvm_register) @@ -460,7 +460,7 @@ (<| (let [[privacy strict_floating_point? annotations method_tvars exceptions self arguments constructor_argumentsS bodyS] method - bodyS (case (list.size arguments) + bodyS (when (list.size arguments) 0 (host.without_fake_parameter bodyS) _ bodyS)]) (do [! phase.monad] @@ -495,14 +495,14 @@ (def (method_return returnT) (-> (Type Return) (Bytecode Any)) - (case (type.void? returnT) + (when (type.void? returnT) {.#Right returnT} _.return {.#Left returnT} - (case (type.primitive? returnT) + (when (type.primitive? returnT) {.#Left returnT} - (case (type.class? returnT) + (when (type.class? returnT) {.#Some class_name} (all _.composite (_.checkcast returnT) @@ -537,7 +537,7 @@ [.let [[super method_name strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ bodyS] method - bodyS (case (list.size arguments) + bodyS (when (list.size arguments) 0 (host.without_fake_parameter bodyS) _ bodyS)] generate declaration.generation] @@ -564,7 +564,7 @@ [.let [[method_name privacy final? strict_floating_point? annotations method_tvars self arguments returnJ exceptionsJ bodyS] method - bodyS (case (list.size arguments) + bodyS (when (list.size arguments) 0 (host.without_fake_parameter bodyS) _ bodyS)] generate declaration.generation] @@ -627,7 +627,7 @@ (def (method_generation archive super_class method) (-> Archive (Type Class) (Method_Definition Synthesis) (Operation (Resource Method))) - (case method + (when method {#Constructor method} (..constructor_method_generation archive super_class method) @@ -656,7 +656,7 @@ (do phase.monad [methodA (is (Operation Analysis) (declaration.lifted_analysis - (case methodC + (when methodC {#Constructor method} (jvm.analyse_constructor_method analyse archive selfT mapping method) @@ -709,7 +709,7 @@ (def (mock_value valueT) (-> (Type Value) (Bytecode Any)) - (case (type.primitive? valueT) + (when (type.primitive? valueT) {.#Left classT} _.aconst_null @@ -728,14 +728,14 @@ (def (mock_return returnT) (-> (Type Return) (Bytecode Any)) - (case (type.void? returnT) + (when (type.void? returnT) {.#Right returnT} _.return {.#Left valueT} (all _.composite (mock_value valueT) - (case (type.primitive? valueT) + (when (type.primitive? valueT) {.#Left classT} _.areturn @@ -754,7 +754,7 @@ (def (mock_method super method) (-> (Type Class) (Method_Definition Code) (Resource method.Method)) - (case method + (when method {#Constructor [privacy strict_floating_point? annotations variables exceptions self arguments constructor_arguments body]} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 4b93daa97..c917dd6a0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -66,7 +66,7 @@ (Operation anchor expression declaration Requirements))] (Handler anchor expression declaration))) (function (_ extension_name phase archive inputs) - (case (.result syntax inputs) + (when (.result syntax inputs) {try.#Success inputs} (handler extension_name phase archive inputs) @@ -126,7 +126,7 @@ [dependencies (cache/artifact.dependencies archive codeS) [interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generate archive codeS)) - .let [@abstraction (case codeS + .let [@abstraction (when codeS (/////synthesis.function/abstraction [env arity body]) (|> interim_artifacts list.last @@ -152,7 +152,7 @@ [_ code//type codeA] (/////declaration.lifted_analysis (scope.with (typeA.fresh - (case expected + (when expected {.#None} (do ! [[code//type codeA] (typeA.inferring @@ -245,7 +245,7 @@ (def (lux::def expander host_analysis) (-> Expander /////analysis.Bundle Handler) (function (_ extension_name phase archive inputsC+) - (case inputsC+ + (when inputsC+ (list [_ {.#Symbol ["" short_name]}] valueC exported?C) (do phase.monad [current_module (/////declaration.lifted_analysis @@ -288,13 +288,13 @@ [type valueT value] (..definition archive full_name {.#Some .Type} valueC) labels (/////declaration.lifted_analysis (do phase.monad - [.let [[record? labels] (case labels + [.let [[record? labels] (when labels {.#Left tags} [false tags] {.#Right slots} [true slots])] - _ (case labels + _ (when labels {.#End} (moduleA.define short_name {.#Definition [exported? type value]}) @@ -325,7 +325,7 @@ (monad.each ! (function (_ [module alias]) (do ! [_ (moduleA.import module)] - (case alias + (when alias "" (in []) _ (moduleA.alias alias module)))) imports))] @@ -351,7 +351,7 @@ (do phase.monad [current_module (///.lifted meta.current_module_name) constant (///.lifted (meta.definition original))] - (case constant + (when constant {.#Alias de_aliased} (phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased]) @@ -393,7 +393,7 @@ (function (again type) (if (type#= original type) replacement - (case type + (when type {.#Primitive name parameters} {.#Primitive name (list#each again parameters)} @@ -425,7 +425,7 @@ (-> [Type Type Type] Extender (Handler anchor expression declaration))) (function (handler extension_name phase archive inputsC+) - (case inputsC+ + (when inputsC+ (list nameC valueC) (do phase.monad [target_platform (/////declaration.lifted_analysis @@ -433,7 +433,7 @@ [_ _ name] (evaluate! archive Text nameC) [_ handlerV] ( archive (as Text name) (let [raw_type (type_literal )] - (case target_platform + (when target_platform (^.or @.jvm @.js) raw_type diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp/common.lux index 41b1165c9..cda183698 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/common_lisp/common.lux @@ -31,7 +31,7 @@ ["[0]" reference] ["//" common_lisp ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] - ["[1][0]" case]]] + ["[1][0]" when]]] [// ["[0]" generation] ["[0]" synthesis (.only %synthesis) @@ -45,7 +45,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/common.lux index 772660310..d6db61d49 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/common.lux @@ -31,7 +31,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function]]] [// @@ -46,7 +46,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') @@ -101,7 +101,7 @@ (def .public (statement expression archive synthesis) Phase! - (case synthesis + (when synthesis ... TODO: Get rid of this ASAP {synthesis.#Extension "lux syntax char case!" parameters} (do /////.monad @@ -126,17 +126,17 @@ ([synthesis.#Reference] [synthesis.#Extension]) - (synthesis.branch/case case) - (//case.case! statement expression archive case) + (synthesis.branch/when when) + (//when.when! statement expression archive when) (synthesis.branch/exec it) - (//case.exec! statement expression archive it) + (//when.exec! statement expression archive it) (synthesis.branch/let let) - (//case.let! statement expression archive let) + (//when.let! statement expression archive let) (synthesis.branch/if if) - (//case.if! statement expression archive if) + (//when.if! statement expression archive if) (synthesis.loop/scope scope) (//loop.scope! statement expression archive scope) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/host.lux index b15b0ae3f..2f7766332 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/js/host.lux @@ -143,7 +143,7 @@ (in (_.closure g!inputs (all _.then (_.define g!abstraction abstractionG) - (_.return (case (.nat arity) + (_.return (when (.nat arity) 0 (_.apply_1 g!abstraction //runtime.unit) 1 (_.apply g!abstraction g!inputs) _ (_.apply_1 g!abstraction (_.array g!inputs)))))))))])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux index 9520433e1..bc81d188e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -49,7 +49,7 @@ (-> Text Phase Archive s (Operation (Bytecode Any)))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux index ced11c93e..0d7953920 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -372,9 +372,9 @@ (Parser (Type Object)) (do <>.monad [arrayJT (.then parser.array .text)] - (case (parser.array? arrayJT) + (when (parser.array? arrayJT) {.#Some elementJT} - (case (parser.object? elementJT) + (when (parser.object? elementJT) {.#Some elementJT} (in elementJT) @@ -665,7 +665,7 @@ [valueG (generate archive valueS)] (in (all _.composite valueG - (case (parser.object? :unboxed:) + (when (parser.object? :unboxed:) {.#Some :unboxed:} (_.checkcast :unboxed:) @@ -697,7 +697,7 @@ [valueG (generate archive valueS) objectG (generate archive objectS) .let [:class: (type.class class (list)) - putG (case (parser.object? :unboxed:) + putG (when (parser.object? :unboxed:) {.#Some :unboxed:} (all _.composite (_.checkcast :unboxed:) @@ -723,7 +723,7 @@ (-> Phase Archive Input (Operation (Typed (Bytecode Any)))) (do //////.monad [valueG (generate archive valueS)] - (case (type.primitive? valueT) + (when (type.primitive? valueT) {.#Right valueT} (in [valueT valueG]) @@ -734,7 +734,7 @@ (def (prepare_output outputT) (-> (Type Return) (Bytecode Any)) - (case (type.void? outputT) + (when (type.void? outputT) {.#Right outputT} ..unitG @@ -825,7 +825,7 @@ (def .public (hidden_method_body arity body) (-> Nat Synthesis Synthesis) (with_expansions [ (panic! (%.format (%.nat arity) " " (synthesis.%synthesis body)))] - (case [arity body] + (when [arity body] (^.or [0 _] [1 _]) body @@ -833,9 +833,9 @@ [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple (list _ hidden))}}}] hidden - [_ {synthesis.#Control {synthesis.#Branch {synthesis.#Case _ path}}}] + [_ {synthesis.#Control {synthesis.#Branch {synthesis.#When _ path}}}] (loop (again [path (is Path path)]) - (case path + (when path {synthesis.#Seq _ next} (again next) @@ -852,7 +852,7 @@ (-> (-> Synthesis Synthesis) (-> Path Path)) (function (again it) - (case it + (when it (^.or {synthesis.#Pop} {synthesis.#Access _}) it @@ -884,13 +884,13 @@ (def .public (without_fake_parameter it) (-> Synthesis Synthesis) - (case it + (when it {synthesis.#Simple _} it {synthesis.#Structure it} {synthesis.#Structure - (case it + (when it {complex.#Variant it} {complex.#Variant (revised complex.#value without_fake_parameter it)} @@ -899,10 +899,10 @@ {synthesis.#Reference it} {synthesis.#Reference - (case it + (when it {//////reference.#Variable it} {//////reference.#Variable - (case it + (when it {//////variable.#Local it} {//////variable.#Local (-- it)} @@ -914,10 +914,10 @@ {synthesis.#Control it} {synthesis.#Control - (case it + (when it {synthesis.#Branch it} {synthesis.#Branch - (case it + (when it {synthesis.#Exec before after} {synthesis.#Exec (without_fake_parameter before) (without_fake_parameter after)} @@ -936,13 +936,13 @@ {synthesis.#Get members (without_fake_parameter record)} - {synthesis.#Case value path} - {synthesis.#Case (without_fake_parameter value) + {synthesis.#When value path} + {synthesis.#When (without_fake_parameter value) (without_fake_parameter#path without_fake_parameter path)})} {synthesis.#Loop it} {synthesis.#Loop - (case it + (when it {synthesis.#Scope [synthesis.#start start synthesis.#inits inits synthesis.#iteration iteration]} @@ -955,7 +955,7 @@ {synthesis.#Function it} {synthesis.#Function - (case it + (when it {synthesis.#Abstraction [synthesis.#environment environment synthesis.#arity arity synthesis.#body body]} @@ -995,7 +995,7 @@ strict_fp? annotations vars self_name arguments returnT exceptionsT (<| (..hidden_method_body arity) - (case arity + (when arity 0 (without_fake_parameter body) _ body))]])))) @@ -1003,7 +1003,7 @@ (-> (-> Synthesis Synthesis) (-> Path Path)) (function (again path) - (case path + (when path (synthesis.path/then bodyS) (synthesis.path/then (normalize bodyS)) @@ -1039,7 +1039,7 @@ (def (normalize_method_body mapping) (-> Mapping Synthesis Synthesis) (function (again body) - (case body + (when body (^.with_template [] [ body]) @@ -1058,8 +1058,8 @@ (maybe.else var) synthesis.variable) - (synthesis.branch/case [inputS pathS]) - (synthesis.branch/case [(again inputS) (normalize_path again pathS)]) + (synthesis.branch/when [inputS pathS]) + (synthesis.branch/when [(again inputS) (normalize_path again pathS)]) (synthesis.branch/exec [this that]) (synthesis.branch/exec [(again this) (again that)]) @@ -1081,7 +1081,7 @@ (synthesis.function/abstraction [environment arity bodyS]) (synthesis.function/abstraction [(list#each (function (_ captured) - (case captured + (when captured (synthesis.variable var) (|> mapping (dictionary.value captured) @@ -1116,7 +1116,7 @@ inputs! (|> inputsTG list.enumeration (list#each (function (_ [register [type term]]) - (let [then! (case (type.primitive? type) + (let [then! (when (type.primitive? type) {.#Right type} (///value.unwrap type) @@ -1161,14 +1161,14 @@ (def (returnG returnT) (-> (Type Return) (Bytecode Any)) - (case (type.void? returnT) + (when (type.void? returnT) {.#Right returnT} _.return {.#Left returnT} - (case (type.primitive? returnT) + (when (type.primitive? returnT) {.#Left returnT} - (case (type.class? returnT) + (when (type.class? returnT) {.#Some class_name} (all _.composite (_.checkcast returnT) @@ -1221,7 +1221,7 @@ (def (prepare_argument lux_register argumentT jvm_register) (-> Register (Type Value) Register [Register (Bytecode Any)]) - (case (type.primitive? argumentT) + (when (type.primitive? argumentT) {.#Left argumentT} [(n.+ 1 jvm_register) (if (n.= lux_register jvm_register) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/common.lux index 8fdfccda4..80882cbbd 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -34,7 +34,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function]]] [// @@ -50,7 +50,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') @@ -63,7 +63,7 @@ (def .public (statement expression archive synthesis) Phase! - (case synthesis + (when synthesis ... TODO: Get rid of this ASAP {synthesis.#Extension "lux syntax char case!" parameters} (do /////.monad @@ -88,17 +88,17 @@ ([synthesis.#Reference] [synthesis.#Extension]) - (synthesis.branch/case case) - (//case.case! statement expression archive case) + (synthesis.branch/when when) + (//when.when! statement expression archive when) (synthesis.branch/exec it) - (//case.exec! statement expression archive it) + (//when.exec! statement expression archive it) (synthesis.branch/let let) - (//case.let! statement expression archive let) + (//when.let! statement expression archive let) (synthesis.branch/if if) - (//case.if! statement expression archive if) + (//when.if! statement expression archive if) (synthesis.loop/scope scope) (do /////.monad @@ -123,7 +123,7 @@ (function (_ extension_name phase archive [input else conditionals]) (|> conditionals (list#each (function (_ [chars branch]) - {synthesis.#Seq (case chars + {synthesis.#Seq (when chars {.#End} {synthesis.#Pop} @@ -139,7 +139,7 @@ {synthesis.#Alt pre post}) {synthesis.#Then else}) [input] - (//case.case! statement phase archive) + (//when.when! statement phase archive) (at /////.monad each (|>> (as Expression)))))])) (def lux_procs diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/host.lux index 603d2efb2..5072f1488 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/lua/host.lux @@ -180,7 +180,7 @@ (list.repeated (.nat arity) []))] (in (<| (_.closure g!inputs) _.return - (case (.nat arity) + (when (.nat arity) 0 (_.apply (list //runtime.unit) abstractionG) 1 (_.apply g!inputs abstractionG) _ (_.apply (list (_.array g!inputs)) abstractionG))))))])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php/common.lux index 8fcabe6e4..00c99a594 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/php/common.lux @@ -31,7 +31,7 @@ ["[0]" reference] ["//" php ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] - ["[1][0]" case]]] + ["[1][0]" when]]] [// ["[0]" synthesis (.only %synthesis) ["" \\parser (.only Parser)]] @@ -45,7 +45,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') @@ -84,8 +84,8 @@ branchG]))) conditionals)) .let [foreigns (|> conditionals - (list#each (|>> product.right synthesis.path/then //case.dependencies)) - (list.partial (//case.dependencies (synthesis.path/then else))) + (list#each (|>> product.right synthesis.path/then //when.dependencies)) + (list.partial (//when.dependencies (synthesis.path/then else))) list.together (set.of_list _.hash) set.list) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/common.lux index b4a6a8f0c..5bb154a47 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/common.lux @@ -36,7 +36,7 @@ ["[1][0]" structure] ["[1][0]" reference] ["[1][0]" function] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop]]] [// [analysis (.only)] @@ -48,7 +48,7 @@ (def .public (statement expression archive synthesis) Phase! - (case synthesis + (when synthesis ... TODO: Get rid of this ASAP {synthesis.#Extension "lux syntax char case!" parameters} (do /////.monad @@ -73,15 +73,15 @@ ([synthesis.#Reference] [synthesis.#Extension]) - (synthesis.branch/case case) - (//case.case! false statement expression archive case) + (synthesis.branch/when when) + (//when.when! false statement expression archive when) (^.with_template [ ] [( value) ( statement expression archive value)]) - ([synthesis.branch/exec //case.exec!] - [synthesis.branch/let //case.let!] - [synthesis.branch/if //case.if!] + ([synthesis.branch/exec //when.exec!] + [synthesis.branch/let //when.let!] + [synthesis.branch/if //when.if!] [synthesis.loop/scope //loop.scope!] [synthesis.loop/again //loop.again!]) @@ -95,7 +95,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/host.lux index 3354e69db..fde1ab399 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/python/host.lux @@ -140,7 +140,7 @@ g!inputs (monad.each ! (function (_ _) (variable "input")) (list.repeated (.nat arity) []))] (in (_.lambda g!inputs - (case (.nat arity) + (when (.nat arity) 0 (_.apply (list //runtime.unit) abstractionG) 1 (_.apply g!inputs abstractionG) _ (_.apply (list (_.list g!inputs)) abstractionG))))))])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r/common.lux index b2dbae1f3..faab4946a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/r/common.lux @@ -31,7 +31,7 @@ ["[0]" reference] ["//" r ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] - ["[1][0]" case]]] + ["[1][0]" when]]] [// ["[0]" synthesis (.only %synthesis) ["" \\parser (.only Parser)]] @@ -45,7 +45,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby/common.lux index dca8af12f..9c136ef38 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -35,7 +35,7 @@ ["[1][0]" structure] ["[1][0]" reference] ["[1][0]" function] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop]]] [// ["[0]" generation] @@ -50,7 +50,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') @@ -59,7 +59,7 @@ (def .public (statement expression archive synthesis) Phase! - (case synthesis + (when synthesis ... TODO: Get rid of this ASAP {synthesis.#Extension "lux syntax char case!" parameters} (do /////.monad @@ -85,15 +85,15 @@ ([synthesis.#Reference] [synthesis.#Extension]) - (synthesis.branch/case case) - (//case.case! false statement expression archive case) + (synthesis.branch/when when) + (//when.when! false statement expression archive when) (^.with_template [ ] [( value) ( statement expression archive value)]) - ([synthesis.branch/exec //case.exec!] - [synthesis.branch/let //case.let!] - [synthesis.branch/if //case.if!] + ([synthesis.branch/exec //when.exec!] + [synthesis.branch/let //when.let!] + [synthesis.branch/if //when.if!] [synthesis.loop/scope //loop.scope!] [synthesis.loop/again //loop.again!]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme/common.lux index 2b8bbcba8..9eec19a4a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/scheme/common.lux @@ -31,7 +31,7 @@ ["[0]" reference] ["//" scheme ["[1][0]" runtime (.only Operation Phase Handler Bundle Generator)] - ["[1][0]" case]]] + ["[1][0]" when]]] [// ["[0]" generation] ["[0]" synthesis (.only %synthesis) @@ -45,7 +45,7 @@ (-> Text (Generator s))] Handler)) (function (_ extension_name phase archive input) - (case (.result parser input) + (when (.result parser input) {try.#Success input'} (handler extension_name phase archive input') diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp.lux index 1168d5b8b..0f1867ff7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp.lux @@ -11,7 +11,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function] ["/[1]" // @@ -28,7 +28,7 @@ (def .public (generate archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -45,12 +45,12 @@ ( generate archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] - [////synthesis.branch/let /case.let] - [////synthesis.branch/if /case.if] - [////synthesis.branch/get /case.get] + [////synthesis.branch/let /when.let] + [////synthesis.branch/if /when.if] + [////synthesis.branch/get /when.get] [////synthesis.function/apply /function.apply] - [////synthesis.branch/case /case.case] + [////synthesis.branch/when /when.when] [////synthesis.loop/scope /loop.scope] [////synthesis.loop/again /loop.again] [////synthesis.function/abstraction /function.function]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/case.lux deleted file mode 100644 index cd5ef69ad..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/case.lux +++ /dev/null @@ -1,263 +0,0 @@ -(.require - [library - [lux (.except case let if) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix monoid)] - ["[0]" set]]] - [math - [number - ["n" nat]]] - [meta - [macro - ["^" pattern]] - [target - ["_" common_lisp (.only Expression Var/1)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Generator)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - ["[1][0]" synthesis - ["[1]/[0]" case]] - ["/[1]" // - ["[1][0]" synthesis (.only Member Synthesis Path)] - ["[1][0]" generation] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public register - (-> Register Var/1) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register Var/1) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueG (expression archive valueS) - bodyG (expression archive bodyS)] - (in (_.let (list [(..register register) valueG]) - (list bodyG))))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testG (expression archive testS) - thenG (expression archive thenS) - elseG (expression archive elseS)] - (in (_.if testG thenG elseG)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueG (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.case side - (^.with_template [ ] - [( lefts) - ( (_.int (.int lefts)))]) - ([.#Left //runtime.tuple//left] - [.#Right //runtime.tuple//right]))] - (method source))) - valueG - pathP)))) - -(def @savepoint (_.var "lux_pm_savepoint")) -(def @cursor (_.var "lux_pm_cursor")) -(def @temp (_.var "lux_pm_temp")) -(def @variant (_.var "lux_pm_variant")) - -(def (push! value) - (-> (Expression Any) (Expression Any)) - (_.setq @cursor (_.cons/2 [value @cursor]))) - -(def pop! - (Expression Any) - (_.setq @cursor (_.cdr/1 @cursor))) - -(def peek - (Expression Any) - (_.car/1 @cursor)) - -(def save! - (Expression Any) - (_.setq @savepoint (_.cons/2 [@cursor @savepoint]))) - -(def restore! - (List (Expression Any)) - (list (_.setq @cursor (_.car/1 @savepoint)) - (_.setq @savepoint (_.cdr/1 @savepoint)))) - -(def (multi_pop! pops) - (-> Nat (Expression Any)) - (_.setq @cursor (_.nthcdr/2 [(_.int (.int pops)) @cursor]))) - -(with_template [ ] - [(def ( @fail simple? idx next!) - (-> _.Tag Bit Nat (Maybe (Expression Any)) (Expression Any)) - (.let [ (_.eq/2 [@variant @temp])] - (_.let (list [@variant ..peek]) - (list.partial (_.setq @temp (|> idx .int _.int (//runtime.sum//get @variant ))) - (.if simple? - (_.when - (_.go @fail)) - (_.if - (_.go @fail) - (..push! @temp))) - (.case next! - {.#Some next!} - (list next!) - - {.#None} - (list))))))] - - [left_choice _.nil (<|)] - [right_choice (_.string "") ++] - ) - -(def (alternation @otherwise pre! post!) - (-> _.Tag (Expression Any) (Expression Any) (Expression Any)) - (_.tagbody (all list#composite - (list ..save! - pre! - @otherwise) - ..restore! - (list post!)))) - -(def (pattern_matching' expression archive) - (Generator [Var/1 _.Tag _.Tag Path]) - (function (again [$output @done @fail pathP]) - (.case pathP - (/////synthesis.path/then bodyS) - (at ///////phase.monad each - (function (_ outputV) - (_.progn (list (_.setq $output outputV) - (_.go @done)))) - (expression archive bodyS)) - - {/////synthesis.#Pop} - (///////phase#in ..pop!) - - {/////synthesis.#Bind register} - (///////phase#in (_.setq (..register register) ..peek)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again [$output @done @fail thenP]) - else! (.case elseP - {.#Some elseP} - (again [$output @done @fail elseP]) - - {.#None} - (in (_.go @fail)))] - (in (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) - - (^.with_template [ <=>] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (do ! - [then! (again [$output @done @fail then])] - (in [(<=> [(|> match ) - ..peek]) - then!]))) - {.#Item item})] - (in (list#mix (function (_ [when then] else) - (_.if when then else)) - (_.go @fail) - clauses)))]) - ([/////synthesis.#I64_Fork //primitive.i64 _.=/2] - [/////synthesis.#F64_Fork //primitive.f64 _.=/2] - [/////synthesis.#Text_Fork //primitive.text _.string=/2]) - - (^.with_template [ ] - [( idx) - (///////phase#in ( @fail false idx {.#None})) - - ( idx nextP) - (|> nextP - [$output @done @fail] again - (at ///////phase.monad each (|>> {.#Some} ( @fail true idx))))]) - ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] - [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - - (/////synthesis.member/left 0) - (///////phase#in (..push! (_.elt/2 [..peek (_.int +0)]))) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (/////synthesis.!multi_pop nextP) - (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] - (do ///////phase.monad - [next! (again [$output @done @fail nextP'])] - (///////phase#in (_.progn (list (..multi_pop! (n.+ 2 extra_pops)) - next!))))) - - (/////synthesis.path/alt preP postP) - (do [! ///////phase.monad] - [@otherwise (at ! each (|>> %.nat (format "lux_case_otherwise") _.tag) /////generation.next) - pre! (again [$output @done @otherwise preP]) - post! (again [$output @done @fail postP])] - (in (..alternation @otherwise pre! post!))) - - (/////synthesis.path/seq preP postP) - (do ///////phase.monad - [pre! (again [$output @done @fail preP]) - post! (again [$output @done @fail postP])] - (in (_.progn (list pre! post!))))))) - -(def (pattern_matching $output expression archive pathP) - (-> Var/1 (Generator Path)) - (do [! ///////phase.monad] - [@done (at ! each (|>> %.nat (format "lux_case_done") _.tag) /////generation.next) - @fail (at ! each (|>> %.nat (format "lux_case_fail") _.tag) /////generation.next) - pattern_matching! (pattern_matching' expression archive [$output @done @fail pathP])] - (in (_.tagbody - (list pattern_matching! - @fail - (_.error/1 (_.string ////synthesis/case.pattern_matching_error)) - @done))))) - -(def .public (case expression archive [valueS pathP]) - (Generator [Synthesis Path]) - (do [! ///////phase.monad] - [initG (expression archive valueS) - $output (at ! each (|>> %.nat (format "lux_case_output") _.var) /////generation.next) - pattern_matching! (pattern_matching $output expression archive pathP) - .let [storage (|> pathP - ////synthesis/case.storage - (the ////synthesis/case.#bindings) - set.list - (list#each (function (_ register) - [(..register register) - _.nil])))]] - (in (_.let (list.partial [@cursor (_.list/* (list initG))] - [@savepoint (_.list/* (list))] - [@temp _.nil] - [$output _.nil] - storage) - (list pattern_matching! - $output))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/function.lux index 6b6fd617d..5a9e65883 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/function.lux @@ -17,7 +17,7 @@ ["[0]" // ["[1][0]" runtime (.only Operation Phase Generator)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -43,7 +43,7 @@ (def (with_closure inits function_definition) (-> (List (Expression Any)) (Expression Any) (Operation (Expression Any))) - (case inits + (when inits {.#End} (at ///////phase.monad in function_definition) @@ -57,7 +57,7 @@ (_.funcall/+ [(_.function/1 @closure) inits])))))) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def .public (function expression archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) @@ -73,7 +73,7 @@ arityG (|> arity .int _.int) @num_args (_.var "num_args") @self (_.var (///reference.artifact function_name)) - initialize_self! [(//case.register 0) (_.function/1 @self)] + initialize_self! [(//when.register 0) (_.function/1 @self)] initialize! [(|> (list.indices arity) (list#each ..input) _.args) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/loop.lux index ad1f110de..d2dcb8802 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/loop.lux @@ -17,12 +17,12 @@ ["_" common_lisp (.only Expression)]]]]] ["[0]" // [runtime (.only Operation Phase Generator)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["/[1]" // [synthesis - ["[0]" case]] + ["[0]" when]] ["/[1]" // ["[0]"synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -35,7 +35,7 @@ (def .public (scope expression archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -52,7 +52,7 @@ (in (_.let (|> initsG+ list.enumeration (list#each (function (_ [idx init]) - [(|> idx (n.+ start) //case.register) + [(|> idx (n.+ start) //when.register) init])) (list.partial [@output _.nil])) (list (_.tagbody (list @scope @@ -66,7 +66,7 @@ argsO+ (monad.each ! (expression archive) argsS+) .let [bindings (|> argsO+ list.enumeration - (list#each (|>> product.left (n.+ offset) //case.register)) + (list#each (|>> product.left (n.+ offset) //when.register)) _.args)]] (in (_.progn (list (_.multiple_value_setq bindings (_.values/* argsO+)) (_.go tag)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/runtime.lux index 77f1e5cfd..9294d4335 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -110,7 +110,7 @@ (macro.with_symbols [g!_] (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (, (code.text (%.code runtime)))))] - (case declaration + (when declaration {.#Left name} (let [g!name (code.local name) code_nameC (code.local (format "@" name))] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/structure.lux index af4d6023b..c4aabc6f2 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/structure.lux @@ -17,7 +17,7 @@ (def .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/when.lux new file mode 100644 index 000000000..731102b94 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/common_lisp/when.lux @@ -0,0 +1,263 @@ +(.require + [library + [lux (.except when let if) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix monoid)] + ["[0]" set]]] + [math + [number + ["n" nat]]] + [meta + [macro + ["^" pattern]] + [target + ["_" common_lisp (.only Expression Var/1)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Generator)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + ["[1][0]" synthesis + ["[1]/[0]" when]] + ["/[1]" // + ["[1][0]" synthesis (.only Member Synthesis Path)] + ["[1][0]" generation] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public register + (-> Register Var/1) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register Var/1) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueG (expression archive valueS) + bodyG (expression archive bodyS)] + (in (_.let (list [(..register register) valueG]) + (list bodyG))))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testG (expression archive testS) + thenG (expression archive thenS) + elseG (expression archive elseS)] + (in (_.if testG thenG elseG)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueG (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.when side + (^.with_template [ ] + [( lefts) + ( (_.int (.int lefts)))]) + ([.#Left //runtime.tuple//left] + [.#Right //runtime.tuple//right]))] + (method source))) + valueG + pathP)))) + +(def @savepoint (_.var "lux_pm_savepoint")) +(def @cursor (_.var "lux_pm_cursor")) +(def @temp (_.var "lux_pm_temp")) +(def @variant (_.var "lux_pm_variant")) + +(def (push! value) + (-> (Expression Any) (Expression Any)) + (_.setq @cursor (_.cons/2 [value @cursor]))) + +(def pop! + (Expression Any) + (_.setq @cursor (_.cdr/1 @cursor))) + +(def peek + (Expression Any) + (_.car/1 @cursor)) + +(def save! + (Expression Any) + (_.setq @savepoint (_.cons/2 [@cursor @savepoint]))) + +(def restore! + (List (Expression Any)) + (list (_.setq @cursor (_.car/1 @savepoint)) + (_.setq @savepoint (_.cdr/1 @savepoint)))) + +(def (multi_pop! pops) + (-> Nat (Expression Any)) + (_.setq @cursor (_.nthcdr/2 [(_.int (.int pops)) @cursor]))) + +(with_template [ ] + [(def ( @fail simple? idx next!) + (-> _.Tag Bit Nat (Maybe (Expression Any)) (Expression Any)) + (.let [ (_.eq/2 [@variant @temp])] + (_.let (list [@variant ..peek]) + (list.partial (_.setq @temp (|> idx .int _.int (//runtime.sum//get @variant ))) + (.if simple? + (_.when + (_.go @fail)) + (_.if + (_.go @fail) + (..push! @temp))) + (.when next! + {.#Some next!} + (list next!) + + {.#None} + (list))))))] + + [left_choice _.nil (<|)] + [right_choice (_.string "") ++] + ) + +(def (alternation @otherwise pre! post!) + (-> _.Tag (Expression Any) (Expression Any) (Expression Any)) + (_.tagbody (all list#composite + (list ..save! + pre! + @otherwise) + ..restore! + (list post!)))) + +(def (pattern_matching' expression archive) + (Generator [Var/1 _.Tag _.Tag Path]) + (function (again [$output @done @fail pathP]) + (.when pathP + (/////synthesis.path/then bodyS) + (at ///////phase.monad each + (function (_ outputV) + (_.progn (list (_.setq $output outputV) + (_.go @done)))) + (expression archive bodyS)) + + {/////synthesis.#Pop} + (///////phase#in ..pop!) + + {/////synthesis.#Bind register} + (///////phase#in (_.setq (..register register) ..peek)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again [$output @done @fail thenP]) + else! (.when elseP + {.#Some elseP} + (again [$output @done @fail elseP]) + + {.#None} + (in (_.go @fail)))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^.with_template [ <=>] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (do ! + [then! (again [$output @done @fail then])] + (in [(<=> [(|> match ) + ..peek]) + then!]))) + {.#Item item})] + (in (list#mix (function (_ [when then] else) + (_.if when then else)) + (_.go @fail) + clauses)))]) + ([/////synthesis.#I64_Fork //primitive.i64 _.=/2] + [/////synthesis.#F64_Fork //primitive.f64 _.=/2] + [/////synthesis.#Text_Fork //primitive.text _.string=/2]) + + (^.with_template [ ] + [( idx) + (///////phase#in ( @fail false idx {.#None})) + + ( idx nextP) + (|> nextP + [$output @done @fail] again + (at ///////phase.monad each (|>> {.#Some} ( @fail true idx))))]) + ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] + [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + + (/////synthesis.member/left 0) + (///////phase#in (..push! (_.elt/2 [..peek (_.int +0)]))) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (/////synthesis.!multi_pop nextP) + (.let [[extra_pops nextP'] (////synthesis/when.count_pops nextP)] + (do ///////phase.monad + [next! (again [$output @done @fail nextP'])] + (///////phase#in (_.progn (list (..multi_pop! (n.+ 2 extra_pops)) + next!))))) + + (/////synthesis.path/alt preP postP) + (do [! ///////phase.monad] + [@otherwise (at ! each (|>> %.nat (format "lux_when_otherwise") _.tag) /////generation.next) + pre! (again [$output @done @otherwise preP]) + post! (again [$output @done @fail postP])] + (in (..alternation @otherwise pre! post!))) + + (/////synthesis.path/seq preP postP) + (do ///////phase.monad + [pre! (again [$output @done @fail preP]) + post! (again [$output @done @fail postP])] + (in (_.progn (list pre! post!))))))) + +(def (pattern_matching $output expression archive pathP) + (-> Var/1 (Generator Path)) + (do [! ///////phase.monad] + [@done (at ! each (|>> %.nat (format "lux_when_done") _.tag) /////generation.next) + @fail (at ! each (|>> %.nat (format "lux_when_fail") _.tag) /////generation.next) + pattern_matching! (pattern_matching' expression archive [$output @done @fail pathP])] + (in (_.tagbody + (list pattern_matching! + @fail + (_.error/1 (_.string ////synthesis/when.pattern_matching_error)) + @done))))) + +(def .public (when expression archive [valueS pathP]) + (Generator [Synthesis Path]) + (do [! ///////phase.monad] + [initG (expression archive valueS) + $output (at ! each (|>> %.nat (format "lux_when_output") _.var) /////generation.next) + pattern_matching! (pattern_matching $output expression archive pathP) + .let [storage (|> pathP + ////synthesis/when.storage + (the ////synthesis/when.#bindings) + set.list + (list#each (function (_ register) + [(..register register) + _.nil])))]] + (in (_.let (list.partial [@cursor (_.list/* (list initG))] + [@savepoint (_.list/* (list))] + [@temp _.nil] + [$output _.nil] + storage) + (list pattern_matching! + $output))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux index 9d2c7e1db..3566da9bf 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux @@ -39,7 +39,7 @@ (generation.Handler (, g!anchor) (, g!expression) (, g!declaration)))) (function ((, g!_) (, g!extension)) (function ((, g!_) (, g!name) (, g!phase) (, g!archive) (, g!inputs)) - (case (, g!inputs) + (when (, g!inputs) (list (,* g!input+)) (do ///.monad [(,* (|> g!input+ diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js.lux index 864edbf16..009b99257 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js.lux @@ -15,7 +15,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function] ["/[1]" // @@ -37,7 +37,7 @@ (def (expression archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -55,20 +55,20 @@ {synthesis.#Reference value} (//reference.reference /reference.system archive value) - (synthesis.branch/case case) - (/case.case ///extension/common.statement expression archive case) + (synthesis.branch/when when) + (/when.when ///extension/common.statement expression archive when) (synthesis.branch/exec it) - (/case.exec expression archive it) + (/when.exec expression archive it) (synthesis.branch/let let) - (/case.let expression archive let) + (/when.let expression archive let) (synthesis.branch/if if) - (/case.if expression archive if) + (/when.if expression archive if) (synthesis.branch/get get) - (/case.get expression archive get) + (/when.get expression archive get) (synthesis.loop/scope scope) (/loop.scope ///extension/common.statement expression archive scope) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/case.lux deleted file mode 100644 index f8b30c1f9..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/case.lux +++ /dev/null @@ -1,346 +0,0 @@ -(.require - [library - [lux (.except case exec let if) - [abstract - ["[0]" monad (.only do)]] - [control - ["[0]" maybe]] - [data - ["[0]" text] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)]]] - [math - [number - ["n" nat]]] - [meta - [macro - ["^" pattern]] - [target - ["_" js (.only Expression Computation Var Statement)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Phase! Generator Generator!)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - ["[1][0]" synthesis - ["[1]/[0]" case]] - ["/[1]" // - ["[1][0]" synthesis (.only Synthesis Path) - [access - ["[0]" member (.only Member)]]] - ["//[1]" /// - [reference - [variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public register - (-> Register Var) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public (exec expression archive [this that]) - (Generator [Synthesis Synthesis]) - (do ///////phase.monad - [this (expression archive this) - that (expression archive that)] - (in (|> (_.array (list this that)) - (_.at (_.int +1)))))) - -(def .public (exec! statement expression archive [this that]) - (Generator! [Synthesis Synthesis]) - (do ///////phase.monad - [this (expression archive this) - that (statement expression archive that)] - (in (all _.then - (_.statement this) - that)))) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] - ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (_.apply (_.closure (list (..register register)) - (_.return bodyO)) - (list valueO))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Generator! [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (statement expression archive bodyS)] - (in (all _.then - (_.define (..register register) valueO) - bodyO)))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] - (in (_.? testO thenO elseO)))) - -(def .public (if! statement expression archive [testS thenS elseS]) - (Generator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (statement expression archive thenS) - elseO (statement expression archive elseS)] - (in (_.if testO - thenO - elseO)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.if (the member.#right? side) - (//runtime.tuple//right (_.i32 (.int (the member.#lefts side)))) - (//runtime.tuple//left (_.i32 (.int (the member.#lefts side)))))] - (method source))) - valueO - (list.reversed pathP))))) - -(def @savepoint (_.var "lux_pm_cursor_savepoint")) -(def @cursor (_.var "lux_pm_cursor")) -(def @temp (_.var "lux_pm_temp")) - -(def (push_cursor! value) - (-> Expression Statement) - (_.statement (|> @cursor (_.do "push" (list value))))) - -(def peek_and_pop_cursor - Expression - (|> @cursor (_.do "pop" (list)))) - -(def pop_cursor! - Statement - (_.statement ..peek_and_pop_cursor)) - -(def length - (|>> (_.the "length"))) - -(def last_index - (|>> ..length (_.- (_.i32 +1)))) - -(def peek_cursor - Expression - (|> @cursor (_.at (last_index @cursor)))) - -(def save_cursor! - Statement - (.let [cursor (|> @cursor (_.do "slice" (list)))] - (_.statement (|> @savepoint (_.do "push" (list cursor)))))) - -(def restore_cursor! - Statement - (_.set @cursor (|> @savepoint (_.do "pop" (list))))) - -(def fail_pm! _.break) - -(def (multi_pop_cursor! pops) - (-> Nat Statement) - (.let [popsJS (_.i32 (.int pops))] - (_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS)) - popsJS)))))) - -(with_template [ ] - [(def ( simple? idx) - (-> Bit Nat Statement) - (all _.then - (_.set @temp (//runtime.sum//get ..peek_cursor - (|> idx .int _.i32))) - (.if simple? - (_.when (_.= _.null @temp) - ..fail_pm!) - (_.if (_.= _.null @temp) - ..fail_pm! - (push_cursor! @temp)))))] - - [left_choice _.null] - [right_choice //runtime.unit] - ) - -(def (alternation pre! post!) - (-> Statement Statement Statement) - (all _.then - (_.do_while (_.boolean false) - (all _.then - ..save_cursor! - pre!)) - (all _.then - ..restore_cursor! - post!))) - -(def (optimized_pattern_matching again pathP) - (-> (-> Path (Operation Statement)) - (-> Path (Operation (Maybe Statement)))) - (.case pathP - (^.with_template [ ] - [( idx nextP) - (|> nextP - again - (at ///////phase.monad each (|>> (_.then ( true idx)) {.#Some})))]) - ([/////synthesis.simple_left_side ..left_choice] - [/////synthesis.simple_right_side ..right_choice]) - - (/////synthesis.member/left 0) - (///////phase#in {.#Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor))}) - - ... Extra optimization - (/////synthesis.path/seq - (/////synthesis.member/left 0) - (/////synthesis.!bind_top register thenP)) - (do ///////phase.monad - [then! (again thenP)] - (in {.#Some (all _.then - (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) - then!)})) - - ... Extra optimization - (^.with_template [ ] - [(/////synthesis.path/seq - ( lefts) - (/////synthesis.!bind_top register thenP)) - (do ///////phase.monad - [then! (again thenP)] - (in {.#Some (all _.then - (_.define (..register register) ( (_.i32 (.int lefts)) ..peek_cursor)) - then!)}))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (/////synthesis.!bind_top register thenP) - (do ///////phase.monad - [then! (again thenP)] - (in {.#Some (all _.then - (_.define (..register register) ..peek_and_pop_cursor) - then!)})) - - (/////synthesis.!multi_pop nextP) - (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] - (do ///////phase.monad - [next! (again nextP')] - (in {.#Some (all _.then - (multi_pop_cursor! (n.+ 2 extra_pops)) - next!)}))) - - _ - (///////phase#in {.#None}))) - -(def (pattern_matching' statement expression archive) - (-> Phase! Phase Archive - (-> Path (Operation Statement))) - (function (again pathP) - (do ///////phase.monad - [outcome (optimized_pattern_matching again pathP)] - (.case outcome - {.#Some outcome} - (in outcome) - - {.#None} - (.case pathP - {/////synthesis.#Then bodyS} - (statement expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in pop_cursor!) - - {/////synthesis.#Bind register} - (///////phase#in (_.define (..register register) ..peek_cursor)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail_pm!))] - (in (.if when - (_.if ..peek_cursor - then! - else!) - (_.if ..peek_cursor - else! - then!)))) - - {/////synthesis.#I64_Fork item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (do ! - [then! (again then)] - (in [(//runtime.i64::= (//primitive.i64 (.int match)) - ..peek_cursor) - then!]))) - {.#Item item})] - (in (list#mix (function (_ [when then] else) - (_.if when then else)) - ..fail_pm! - clauses))) - - (^.with_template [ ] - [{ item} - (do [! ///////phase.monad] - [cases (monad.each ! (function (_ [match then]) - (at ! each (|>> [(list ( match))]) (again then))) - {.#Item item})] - (in (_.switch ..peek_cursor - cases - {.#Some ..fail_pm!})))]) - ([/////synthesis.#F64_Fork //primitive.f64] - [/////synthesis.#Text_Fork //primitive.text]) - - (^.with_template [ ] - [( idx) - (///////phase#in ( false idx))]) - ([/////synthesis.side/left ..left_choice] - [/////synthesis.side/right ..right_choice]) - - (^.with_template [ ] - [( lefts) - (///////phase#in (push_cursor! ( (_.i32 (.int lefts)) ..peek_cursor)))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (^.with_template [ ] - [( leftP rightP) - (do ///////phase.monad - [left! (again leftP) - right! (again rightP)] - (in ( left! right!)))]) - ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation])))))) - -(def (pattern_matching statement expression archive pathP) - (-> Phase! Phase Archive Path (Operation Statement)) - (do ///////phase.monad - [pattern_matching! (pattern_matching' statement expression archive pathP)] - (in (all _.then - (_.do_while (_.boolean false) - pattern_matching!) - (_.throw (_.string ////synthesis/case.pattern_matching_error)))))) - -(def .public (case! statement expression archive [valueS pathP]) - (Generator! [Synthesis Path]) - (do ///////phase.monad - [stack_init (expression archive valueS) - pattern_matching! (pattern_matching statement expression archive pathP)] - (in (all _.then - (_.declare @temp) - (_.define @cursor (_.array (list stack_init))) - (_.define @savepoint (_.array (list))) - pattern_matching!)))) - -(def .public (case statement expression archive [valueS pathP]) - (-> Phase! (Generator [Synthesis Path])) - (do ///////phase.monad - [pattern_matching! (..case! statement expression archive [valueS pathP])] - (in (_.apply (_.closure (list) pattern_matching!) (list))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/function.lux index 5d5cf5e13..f0bb48d3d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/function.lux @@ -15,7 +15,7 @@ ["[0]" // ["[1][0]" runtime (.only Operation Phase Phase! Generator)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -47,7 +47,7 @@ (def (with_closure @self inits body!) (-> Var (List Expression) Statement [Statement Expression]) - (case inits + (when inits {.#End} [(_.function_definition @self (list) body!) @self] @@ -63,7 +63,7 @@ (_.var "curried")) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def @@arguments (_.var "arguments")) @@ -88,7 +88,7 @@ @self (_.var (///reference.artifact function_name)) apply_poly (.function (_ args func) (|> func (_.do "apply" (list _.null args)))) - initialize_self! (_.define (//case.register 0) @self) + initialize_self! (_.define (//when.register 0) @self) initialize! (list#mix (.function (_ post pre!) (all _.then pre! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux index bac543584..c475281e4 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux @@ -17,7 +17,7 @@ ["_" js (.only Computation Var Expression Statement)]]]]] ["[0]" // [runtime (.only Operation Phase Phase! Generator Generator!)] - ["[1][0]" case] + ["[1][0]" when] ["///[1]" //// [synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -36,12 +36,12 @@ (def (setup $iteration initial? offset bindings body) (-> Var Bit Register (List Expression) Statement Statement) - (case bindings + (when bindings (list) body (list binding) - (let [$binding (//case.register offset)] + (let [$binding (//when.register offset)] (all _.then (if initial? (_.define $binding binding) @@ -53,7 +53,7 @@ (|> bindings list.enumeration (list#each (function (_ [register _]) - (let [variable (//case.register (n.+ offset register))] + (let [variable (//when.register (n.+ offset register))] (if initial? (_.define variable (_.at (_.i32 (.int register)) $iteration)) (_.set variable (_.at (_.i32 (.int register)) $iteration)))))) @@ -63,7 +63,7 @@ (def .public (scope! statement expression archive [start initsS+ bodyS]) (Generator! (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (statement expression archive bodyS) @@ -85,7 +85,7 @@ (def .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux index 437f6624d..73a240682 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux @@ -101,7 +101,7 @@ code .any]) (macro.with_symbols [g!_ runtime] (let [runtime_name (` (_.var (, (code.text (%.code runtime)))))] - (case declaration + (when declaration {.#Left name} (let [g!name (code.local name)] (in (list (` (def .public (, g!name) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/structure.lux index e5a492e37..ee1ae1a03 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/structure.lux @@ -18,7 +18,7 @@ (def .public (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in //runtime.unit) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux new file mode 100644 index 000000000..7487beb55 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux @@ -0,0 +1,346 @@ +(.require + [library + [lux (.except when exec let if) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" maybe]] + [data + ["[0]" text] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + [number + ["n" nat]]] + [meta + [macro + ["^" pattern]] + [target + ["_" js (.only Expression Computation Var Statement)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Phase! Generator Generator!)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + ["[1][0]" synthesis + ["[1]/[0]" when]] + ["/[1]" // + ["[1][0]" synthesis (.only Synthesis Path) + [access + ["[0]" member (.only Member)]]] + ["//[1]" /// + [reference + [variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public register + (-> Register Var) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public (exec expression archive [this that]) + (Generator [Synthesis Synthesis]) + (do ///////phase.monad + [this (expression archive this) + that (expression archive that)] + (in (|> (_.array (list this that)) + (_.at (_.int +1)))))) + +(def .public (exec! statement expression archive [this that]) + (Generator! [Synthesis Synthesis]) + (do ///////phase.monad + [this (expression archive this) + that (statement expression archive that)] + (in (all _.then + (_.statement this) + that)))) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] + ... TODO: Find some way to do 'let' without paying the price of the closure. + (in (_.apply (_.closure (list (..register register)) + (_.return bodyO)) + (list valueO))))) + +(def .public (let! statement expression archive [valueS register bodyS]) + (Generator! [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (statement expression archive bodyS)] + (in (all _.then + (_.define (..register register) valueO) + bodyO)))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (in (_.? testO thenO elseO)))) + +(def .public (if! statement expression archive [testS thenS elseS]) + (Generator! [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (statement expression archive thenS) + elseO (statement expression archive elseS)] + (in (_.if testO + thenO + elseO)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.if (the member.#right? side) + (//runtime.tuple//right (_.i32 (.int (the member.#lefts side)))) + (//runtime.tuple//left (_.i32 (.int (the member.#lefts side)))))] + (method source))) + valueO + (list.reversed pathP))))) + +(def @savepoint (_.var "lux_pm_cursor_savepoint")) +(def @cursor (_.var "lux_pm_cursor")) +(def @temp (_.var "lux_pm_temp")) + +(def (push_cursor! value) + (-> Expression Statement) + (_.statement (|> @cursor (_.do "push" (list value))))) + +(def peek_and_pop_cursor + Expression + (|> @cursor (_.do "pop" (list)))) + +(def pop_cursor! + Statement + (_.statement ..peek_and_pop_cursor)) + +(def length + (|>> (_.the "length"))) + +(def last_index + (|>> ..length (_.- (_.i32 +1)))) + +(def peek_cursor + Expression + (|> @cursor (_.at (last_index @cursor)))) + +(def save_cursor! + Statement + (.let [cursor (|> @cursor (_.do "slice" (list)))] + (_.statement (|> @savepoint (_.do "push" (list cursor)))))) + +(def restore_cursor! + Statement + (_.set @cursor (|> @savepoint (_.do "pop" (list))))) + +(def fail_pm! _.break) + +(def (multi_pop_cursor! pops) + (-> Nat Statement) + (.let [popsJS (_.i32 (.int pops))] + (_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS)) + popsJS)))))) + +(with_template [ ] + [(def ( simple? idx) + (-> Bit Nat Statement) + (all _.then + (_.set @temp (//runtime.sum//get ..peek_cursor + (|> idx .int _.i32))) + (.if simple? + (_.when (_.= _.null @temp) + ..fail_pm!) + (_.if (_.= _.null @temp) + ..fail_pm! + (push_cursor! @temp)))))] + + [left_choice _.null] + [right_choice //runtime.unit] + ) + +(def (alternation pre! post!) + (-> Statement Statement Statement) + (all _.then + (_.do_while (_.boolean false) + (all _.then + ..save_cursor! + pre!)) + (all _.then + ..restore_cursor! + post!))) + +(def (optimized_pattern_matching again pathP) + (-> (-> Path (Operation Statement)) + (-> Path (Operation (Maybe Statement)))) + (.when pathP + (^.with_template [ ] + [( idx nextP) + (|> nextP + again + (at ///////phase.monad each (|>> (_.then ( true idx)) {.#Some})))]) + ([/////synthesis.simple_left_side ..left_choice] + [/////synthesis.simple_right_side ..right_choice]) + + (/////synthesis.member/left 0) + (///////phase#in {.#Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor))}) + + ... Extra optimization + (/////synthesis.path/seq + (/////synthesis.member/left 0) + (/////synthesis.!bind_top register thenP)) + (do ///////phase.monad + [then! (again thenP)] + (in {.#Some (all _.then + (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) + then!)})) + + ... Extra optimization + (^.with_template [ ] + [(/////synthesis.path/seq + ( lefts) + (/////synthesis.!bind_top register thenP)) + (do ///////phase.monad + [then! (again thenP)] + (in {.#Some (all _.then + (_.define (..register register) ( (_.i32 (.int lefts)) ..peek_cursor)) + then!)}))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (/////synthesis.!bind_top register thenP) + (do ///////phase.monad + [then! (again thenP)] + (in {.#Some (all _.then + (_.define (..register register) ..peek_and_pop_cursor) + then!)})) + + (/////synthesis.!multi_pop nextP) + (.let [[extra_pops nextP'] (////synthesis/when.count_pops nextP)] + (do ///////phase.monad + [next! (again nextP')] + (in {.#Some (all _.then + (multi_pop_cursor! (n.+ 2 extra_pops)) + next!)}))) + + _ + (///////phase#in {.#None}))) + +(def (pattern_matching' statement expression archive) + (-> Phase! Phase Archive + (-> Path (Operation Statement))) + (function (again pathP) + (do ///////phase.monad + [outcome (optimized_pattern_matching again pathP)] + (.when outcome + {.#Some outcome} + (in outcome) + + {.#None} + (.when pathP + {/////synthesis.#Then bodyS} + (statement expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in pop_cursor!) + + {/////synthesis.#Bind register} + (///////phase#in (_.define (..register register) ..peek_cursor)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail_pm!))] + (in (.if when + (_.if ..peek_cursor + then! + else!) + (_.if ..peek_cursor + else! + then!)))) + + {/////synthesis.#I64_Fork item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (do ! + [then! (again then)] + (in [(//runtime.i64::= (//primitive.i64 (.int match)) + ..peek_cursor) + then!]))) + {.#Item item})] + (in (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail_pm! + clauses))) + + (^.with_template [ ] + [{ item} + (do [! ///////phase.monad] + [cases (monad.each ! (function (_ [match then]) + (at ! each (|>> [(list ( match))]) (again then))) + {.#Item item})] + (in (_.switch ..peek_cursor + cases + {.#Some ..fail_pm!})))]) + ([/////synthesis.#F64_Fork //primitive.f64] + [/////synthesis.#Text_Fork //primitive.text]) + + (^.with_template [ ] + [( idx) + (///////phase#in ( false idx))]) + ([/////synthesis.side/left ..left_choice] + [/////synthesis.side/right ..right_choice]) + + (^.with_template [ ] + [( lefts) + (///////phase#in (push_cursor! ( (_.i32 (.int lefts)) ..peek_cursor)))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (^.with_template [ ] + [( leftP rightP) + (do ///////phase.monad + [left! (again leftP) + right! (again rightP)] + (in ( left! right!)))]) + ([/////synthesis.path/seq _.then] + [/////synthesis.path/alt ..alternation])))))) + +(def (pattern_matching statement expression archive pathP) + (-> Phase! Phase Archive Path (Operation Statement)) + (do ///////phase.monad + [pattern_matching! (pattern_matching' statement expression archive pathP)] + (in (all _.then + (_.do_while (_.boolean false) + pattern_matching!) + (_.throw (_.string ////synthesis/when.pattern_matching_error)))))) + +(def .public (when! statement expression archive [valueS pathP]) + (Generator! [Synthesis Path]) + (do ///////phase.monad + [stack_init (expression archive valueS) + pattern_matching! (pattern_matching statement expression archive pathP)] + (in (all _.then + (_.declare @temp) + (_.define @cursor (_.array (list stack_init))) + (_.define @savepoint (_.array (list))) + pattern_matching!)))) + +(def .public (when statement expression archive [valueS pathP]) + (-> Phase! (Generator [Synthesis Path])) + (do ///////phase.monad + [pattern_matching! (..when! statement expression archive [valueS pathP])] + (in (_.apply (_.closure (list) pattern_matching!) (list))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux index b1fa42f27..0b9ec3dba 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux @@ -12,7 +12,7 @@ ["[1][0]" structure] ["[1][0]" reference] ["[1][0]" function] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["//[1]" /// ["[1][0]" extension] @@ -24,7 +24,7 @@ (def .public (generate archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (///#in ( value))]) @@ -40,27 +40,27 @@ (/structure.tuple generate archive members) {synthesis.#Reference reference} - (case reference + (when reference {reference.#Variable variable} (/reference.variable archive variable) {reference.#Constant constant} (/reference.constant archive constant)) - (synthesis.branch/case [valueS pathS]) - (/case.case generate archive [valueS pathS]) + (synthesis.branch/when [valueS pathS]) + (/when.when generate archive [valueS pathS]) (synthesis.branch/exec [this that]) - (/case.exec generate archive [this that]) + (/when.exec generate archive [this that]) (synthesis.branch/let [inputS register bodyS]) - (/case.let generate archive [inputS register bodyS]) + (/when.let generate archive [inputS register bodyS]) (synthesis.branch/if [conditionS thenS elseS]) - (/case.if generate archive [conditionS thenS elseS]) + (/when.if generate archive [conditionS thenS elseS]) (synthesis.branch/get [path recordS]) - (/case.get generate archive [path recordS]) + (/when.get generate archive [path recordS]) (synthesis.loop/scope scope) (/loop.scope generate archive scope) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/case.lux deleted file mode 100644 index f5d258fbb..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/case.lux +++ /dev/null @@ -1,327 +0,0 @@ -(.require - [library - [lux (.except Type Label if let exec case int) - [abstract - ["[0]" monad (.only do)]] - [control - ["[0]" function]] - [data - [collection - ["[0]" list (.use "[1]#[0]" mix)]] - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]]] - [math - [number - ["n" nat] - ["[0]" i32]]] - [meta - [macro - ["^" pattern]] - [target - [jvm - ["_" bytecode (.only Label Bytecode) (.use "[1]#[0]" monad) - [environment - [limit - ["[0]" stack]]]] - ["[0]" type (.only Type) - [category (.only Method)]]]]]]] - ["[0]" // - ["[1][0]" type] - ["[1][0]" runtime (.only Operation Phase Generator)] - ["[1][0]" value] - ["[1][0]" structure] - [//// - ["[0]" generation] - ["[0]" synthesis (.only Path Fork Synthesis) - [access - ["[0]" member (.only Member)]]] - [/// - ["[0]" phase (.use "operation#[0]" monad)] - [reference - [variable (.only Register)]]]]]) - -(def (pop_alt stack_depth) - (-> Nat (Bytecode Any)) - (.case stack_depth - 0 (_#in []) - 1 _.pop - 2 _.pop2 - _ ... (n.> 2) - (all _.composite - _.pop2 - (pop_alt (n.- 2 stack_depth))))) - -(def int - (-> (I64 Any) (Bytecode Any)) - (|>> .i64 i32.i32 _.int)) - -(def long - (-> (I64 Any) (Bytecode Any)) - (|>> .int _.long)) - -(def peek - (Bytecode Any) - (all _.composite - _.dup - (//runtime.get //runtime.stack_head))) - -(def pop - (Bytecode Any) - (all _.composite - (//runtime.get //runtime.stack_tail) - (_.checkcast //type.stack))) - -(def (left_projection lefts) - (-> Nat (Bytecode Any)) - (all _.composite - (_.checkcast //type.tuple) - (..int lefts) - (.case lefts - 0 - _.aaload - - lefts - //runtime.left_projection))) - -(def (right_projection lefts) - (-> Nat (Bytecode Any)) - (all _.composite - (_.checkcast //type.tuple) - (..int lefts) - //runtime.right_projection)) - -(def equals@Object - (.let [class (type.class "java.lang.Object" (list)) - method (type.method [(list) (list //type.value) type.boolean (list)])] - (_.invokevirtual class "equals" method))) - -(def (path|bind register) - (-> Register (Operation (Bytecode Any))) - (operation#in (all _.composite - ..peek - (_.astore register)))) - -(def (path|bit_fork again @else [when thenP elseP]) - (-> (-> Path (Operation (Bytecode Any))) - Label [Bit Path (Maybe Path)] - (Operation (Bytecode Any))) - (do phase.monad - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in (_.goto @else))) - .let [if! (.if when _.ifeq _.ifne)]] - (in (do _.monad - [@else _.new_label] - (all _.composite - ..peek - (//value.unwrap type.boolean) - (if! @else) - then! - (_.set_label @else) - else!))))) - -(with_template [ ] - [(def ( again @else cons) - (-> (-> Path (Operation (Bytecode Any))) - Label (Fork Path) - (Operation (Bytecode Any))) - (do [! phase.monad] - [fork! (monad.mix ! (function (_ [test thenP] else!) - (do ! - [then! (again thenP)] - (in (do _.monad - [@else _.new_label] - (all _.composite - - ( test) - - ( @else) - - then! - (_.set_label @else) - else!))))) - (all _.composite - - (_.goto @else)) - {.#Item cons})] - (in (all _.composite - ..peek - - fork!))))] - - [path|i64_fork (I64 Any) (//value.unwrap type.long) _.dup2 _.pop2 ..long _.lcmp _.ifne] - [path|f64_fork Frac (//value.unwrap type.double) _.dup2 _.pop2 _.double _.dcmpl _.ifne] - [path|text_fork Text (at _.monad in []) _.dup _.pop _.string ..equals@Object _.ifeq] - ) - -(def (path' stack_depth @else @end phase archive) - (-> Nat Label Label (Generator Path)) - (function (again path) - (.case path - {synthesis.#Pop} - (operation#in ..pop) - - {synthesis.#Bind register} - (..path|bind register) - - (^.with_template [ ] - [{ it} - ( again @else it)]) - ([synthesis.#Bit_Fork ..path|bit_fork] - [synthesis.#I64_Fork ..path|i64_fork] - [synthesis.#F64_Fork ..path|f64_fork] - [synthesis.#Text_Fork ..path|text_fork]) - - {synthesis.#Then bodyS} - (do phase.monad - [body! (phase archive bodyS)] - (in (all _.composite - (..pop_alt stack_depth) - body! - (_.when_continuous (_.goto @end))))) - - (synthesis.side lefts right?) - (operation#in - (do _.monad - [@success _.new_label] - (all _.composite - ..peek - (_.checkcast //type.variant) - (//structure.lefts lefts) - (//structure.right? right?) - //runtime.case - _.dup - (_.ifnonnull @success) - _.pop - (_.goto @else) - (_.set_label @success) - //runtime.push))) - - (^.with_template [ ] - [( lefts) - (operation#in (all _.composite - ..peek - ( lefts) - //runtime.push)) - - ... Extra optimization - (synthesis.path/seq - ( lefts) - (synthesis.!bind_top register thenP)) - (do phase.monad - [then! (path' stack_depth @else @end phase archive thenP)] - (in (all _.composite - ..peek - ( lefts) - (_.astore register) - then!)))]) - ([synthesis.member/left ..left_projection] - [synthesis.member/right ..right_projection]) - - {synthesis.#Seq leftP rightP} - (do phase.monad - [left! (path' stack_depth @else @end phase archive leftP) - right! (path' stack_depth @else @end phase archive rightP)] - (in (all _.composite - left! - right!))) - - {synthesis.#Alt leftP rightP} - (do phase.monad - [@alt_else //runtime.forge_label - left! (path' (++ stack_depth) @alt_else @end phase archive leftP) - right! (path' stack_depth @else @end phase archive rightP)] - (in (all _.composite - _.dup - left! - (_.set_label @alt_else) - _.pop - right!))) - ))) - -(def (path @end phase archive path) - (-> Label (Generator Path)) - (do phase.monad - [@else //runtime.forge_label - path! (..path' 1 @else @end phase archive path)] - (in (all _.composite - path! - (<| (_.when_acknowledged @else) - (all _.composite - (_.set_label @else) - //runtime.pm_failure - (_.goto @end) - )) - )))) - -(def .public (if phase archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do phase.monad - [test! (phase archive testS) - then! (phase archive thenS) - else! (phase archive elseS)] - (in (do _.monad - [@else _.new_label - @end _.new_label] - (all _.composite - test! - (//value.unwrap type.boolean) - (_.ifeq @else) - then! - (_.when_continuous (_.goto @end)) - (_.set_label @else) - else! - (<| (_.when_acknowledged @end) - (_.set_label @end))))))) - -(def .public (exec phase archive [this that]) - (Generator [Synthesis Synthesis]) - (do phase.monad - [this! (phase archive this) - that! (phase archive that)] - (in (all _.composite - this! - _.pop - that!)))) - -(def .public (let phase archive [inputS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do phase.monad - [input! (phase archive inputS) - body! (phase archive bodyS)] - (in (all _.composite - input! - (_.astore register) - body!)))) - -(def .public (get phase archive [path recordS]) - (Generator [(List Member) Synthesis]) - (do phase.monad - [record! (phase archive recordS)] - (in (list#mix (function (_ step so_far!) - (.let [next! (.if (the member.#right? step) - (..right_projection (the member.#lefts step)) - (..left_projection (the member.#lefts step)))] - (all _.composite - so_far! - next!))) - record! - (list.reversed path))))) - -(def .public (case phase archive [valueS path]) - (Generator [Synthesis Path]) - (do phase.monad - [@end //runtime.forge_label - value! (phase archive valueS) - path! (..path @end phase archive path)] - (in (all _.composite - _.aconst_null - value! - //runtime.push - path! - (<| (_.when_acknowledged @end) - (_.set_label @end)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/debug.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/debug.lux index b983c3b7d..51ae831e0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/debug.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/debug.lux @@ -23,7 +23,7 @@ [file (is (IO (Try (File IO))) (file.get_file io.monad file.default file_path))] (at file over_write bytecode))] - (in (case outcome + (in (when outcome {try.#Success definition} file_path diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux index b150e4536..c6b9dac3a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux @@ -170,12 +170,12 @@ (def .public (apply generate archive [abstractionS inputsS]) (Generator Apply) - (case abstractionS + (when abstractionS (synthesis.constant $abstraction) (do [! phase.monad] [[@definition |abstraction|] (generation.definition archive $abstraction) .let [actual_arity (list.size inputsS)]] - (case |abstraction| + (when |abstraction| {.#Some [_ {.#Some [expected_arity @abstraction]}]} (cond (n.< expected_arity actual_arity) (apply/? generate archive [abstractionS inputsS]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index 74a1dac76..ae502cbee 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -87,7 +87,7 @@ (method.method //.modifier ////runtime.apply::name false (////runtime.apply::type apply_arity) (list) - {.#Some (case num_partials + {.#Some (when num_partials 0 (all _.composite ////reference.this (..inputs ..this_offset apply_arity) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/host.lux index 270fb31ab..973ab7cad 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/host.lux @@ -86,11 +86,11 @@ (def (class_value class_name class) (-> Text (java/lang/Class java/lang/Object) (Try Any)) - (case (java/lang/Class::getField //value.field class) + (when (java/lang/Class::getField //value.field class) {try.#Success field} - (case (java/lang/reflect/Field::get {.#None} field) + (when (java/lang/reflect/Field::get {.#None} field) {try.#Success ?value} - (case ?value + (when ?value {.#Some value} {try.#Success value} @@ -109,7 +109,7 @@ (def (evaluate! library loader eval_class [@it valueG]) (-> Library java/lang/ClassLoader Text [(Maybe unit.ID) (Bytecode Any)] (Try [Any Definition])) (let [bytecode_name (text.replaced class_path_separator .module_separator eval_class) - :value: (case @it + :value: (when @it {.#Some @it} (type.class (//runtime.class_name @it) (list)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux index d7b73995e..495882117 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux @@ -29,7 +29,7 @@ (def (invariant? register changeS) (-> Register Synthesis Bit) - (case changeS + (when changeS (synthesis.variable/local var) (n.= register var) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/primitive.lux index ad5a79db9..5c9677bb7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/primitive.lux @@ -34,7 +34,7 @@ (def .public (i64 value) (-> (I64 Any) (Bytecode Any)) - (case (.int value) + (when (.int value) (^.with_template [ ] [ (do _.monad @@ -58,7 +58,7 @@ [+5 _.iconst_5]) value - (case (signed.s1 value) + (when (signed.s1 value) {try.#Success value} (do _.monad [_ (_.bipush value) @@ -66,7 +66,7 @@ ..wrap_i64) {try.#Failure _} - (case (signed.s2 value) + (when (signed.s2 value) {try.#Success value} (do _.monad [_ (_.sipush value) @@ -91,7 +91,7 @@ (def .public (f64 value) (-> Frac (Bytecode Any)) - (case value + (when value (^.with_template [ ] [ (do _.monad diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/reference.lux index a6f209206..9f4a1c945 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/reference.lux @@ -53,7 +53,7 @@ (def .public (variable archive variable) (-> Archive Variable (Operation (Bytecode Any))) - (case variable + (when variable {variable.#Local variable} (operation#in (_.aload variable)) @@ -65,7 +65,7 @@ (do ////.monad [[@definition |abstraction|] (generation.definition archive name) .let [:definition: (type.class (//runtime.class_name @definition) (list))]] - (in (case |abstraction| + (in (when |abstraction| {.#Some [_ {.#Some [expected_arity @abstraction]}]} (let [:abstraction: (type.class (//runtime.class_name @abstraction) (list))] (_.getstatic :definition: //value.field :abstraction:)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux index 385015373..2a0d2c994 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Type Definition Label case false true try) + [lux (.except Type Definition Label when false true try) [abstract ["[0]" monad (.only do)] ["[0]" enum]] @@ -289,13 +289,13 @@ (..set! ..stack_tail $tail) _.areturn))})) -(def case::name "case") -(def case::type (type.method [(list) (list //type.variant //type.lefts //type.right?) //type.value (list)])) -(def .public case (..procedure ..case::name ..case::type)) +(def when::name "when") +(def when::type (type.method [(list) (list //type.variant //type.lefts //type.right?) //type.value (list)])) +(def .public when (..procedure ..when::name ..when::type)) -(def case::method - (method.method ..modifier ..case::name - .false ..case::type +(def when::method + (method.method ..modifier ..when::name + .false ..when::type (list) {.#Some (do _.monad @@ -560,7 +560,7 @@ ..pm_failure::method ..push::method - ..case::method + ..when::method left_projection::method right_projection::method diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/structure.lux index 54958837b..1dfafd509 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/structure.lux @@ -31,7 +31,7 @@ (def .public (tuple phase archive membersS) (Generator (Tuple Synthesis)) - (case membersS + (when membersS {.#End} (at phase.monad in //runtime.unit) @@ -57,19 +57,19 @@ (def .public (lefts lefts) (-> Nat (Bytecode Any)) - (case lefts + (when lefts 0 _.iconst_0 1 _.iconst_1 2 _.iconst_2 3 _.iconst_3 4 _.iconst_4 5 _.iconst_5 - _ (case (signed.s1 (.int lefts)) + _ (when (signed.s1 (.int lefts)) {try.#Success value} (_.bipush value) {try.#Failure _} - (case (signed.s2 (.int lefts)) + (when (signed.s2 (.int lefts)) {try.#Success value} (_.sipush value) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/when.lux new file mode 100644 index 000000000..767a48216 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/when.lux @@ -0,0 +1,327 @@ +(.require + [library + [lux (.except Type Label if let exec when int) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" function]] + [data + [collection + ["[0]" list (.use "[1]#[0]" mix)]] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + [meta + [macro + ["^" pattern]] + [target + [jvm + ["_" bytecode (.only Label Bytecode) (.use "[1]#[0]" monad) + [environment + [limit + ["[0]" stack]]]] + ["[0]" type (.only Type) + [category (.only Method)]]]]]]] + ["[0]" // + ["[1][0]" type] + ["[1][0]" runtime (.only Operation Phase Generator)] + ["[1][0]" value] + ["[1][0]" structure] + [//// + ["[0]" generation] + ["[0]" synthesis (.only Path Fork Synthesis) + [access + ["[0]" member (.only Member)]]] + [/// + ["[0]" phase (.use "operation#[0]" monad)] + [reference + [variable (.only Register)]]]]]) + +(def (pop_alt stack_depth) + (-> Nat (Bytecode Any)) + (.when stack_depth + 0 (_#in []) + 1 _.pop + 2 _.pop2 + _ ... (n.> 2) + (all _.composite + _.pop2 + (pop_alt (n.- 2 stack_depth))))) + +(def int + (-> (I64 Any) (Bytecode Any)) + (|>> .i64 i32.i32 _.int)) + +(def long + (-> (I64 Any) (Bytecode Any)) + (|>> .int _.long)) + +(def peek + (Bytecode Any) + (all _.composite + _.dup + (//runtime.get //runtime.stack_head))) + +(def pop + (Bytecode Any) + (all _.composite + (//runtime.get //runtime.stack_tail) + (_.checkcast //type.stack))) + +(def (left_projection lefts) + (-> Nat (Bytecode Any)) + (all _.composite + (_.checkcast //type.tuple) + (..int lefts) + (.when lefts + 0 + _.aaload + + lefts + //runtime.left_projection))) + +(def (right_projection lefts) + (-> Nat (Bytecode Any)) + (all _.composite + (_.checkcast //type.tuple) + (..int lefts) + //runtime.right_projection)) + +(def equals@Object + (.let [class (type.class "java.lang.Object" (list)) + method (type.method [(list) (list //type.value) type.boolean (list)])] + (_.invokevirtual class "equals" method))) + +(def (path|bind register) + (-> Register (Operation (Bytecode Any))) + (operation#in (all _.composite + ..peek + (_.astore register)))) + +(def (path|bit_fork again @else [when thenP elseP]) + (-> (-> Path (Operation (Bytecode Any))) + Label [Bit Path (Maybe Path)] + (Operation (Bytecode Any))) + (do phase.monad + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in (_.goto @else))) + .let [if! (.if when _.ifeq _.ifne)]] + (in (do _.monad + [@else _.new_label] + (all _.composite + ..peek + (//value.unwrap type.boolean) + (if! @else) + then! + (_.set_label @else) + else!))))) + +(with_template [ ] + [(def ( again @else cons) + (-> (-> Path (Operation (Bytecode Any))) + Label (Fork Path) + (Operation (Bytecode Any))) + (do [! phase.monad] + [fork! (monad.mix ! (function (_ [test thenP] else!) + (do ! + [then! (again thenP)] + (in (do _.monad + [@else _.new_label] + (all _.composite + + ( test) + + ( @else) + + then! + (_.set_label @else) + else!))))) + (all _.composite + + (_.goto @else)) + {.#Item cons})] + (in (all _.composite + ..peek + + fork!))))] + + [path|i64_fork (I64 Any) (//value.unwrap type.long) _.dup2 _.pop2 ..long _.lcmp _.ifne] + [path|f64_fork Frac (//value.unwrap type.double) _.dup2 _.pop2 _.double _.dcmpl _.ifne] + [path|text_fork Text (at _.monad in []) _.dup _.pop _.string ..equals@Object _.ifeq] + ) + +(def (path' stack_depth @else @end phase archive) + (-> Nat Label Label (Generator Path)) + (function (again path) + (.when path + {synthesis.#Pop} + (operation#in ..pop) + + {synthesis.#Bind register} + (..path|bind register) + + (^.with_template [ ] + [{ it} + ( again @else it)]) + ([synthesis.#Bit_Fork ..path|bit_fork] + [synthesis.#I64_Fork ..path|i64_fork] + [synthesis.#F64_Fork ..path|f64_fork] + [synthesis.#Text_Fork ..path|text_fork]) + + {synthesis.#Then bodyS} + (do phase.monad + [body! (phase archive bodyS)] + (in (all _.composite + (..pop_alt stack_depth) + body! + (_.when_continuous (_.goto @end))))) + + (synthesis.side lefts right?) + (operation#in + (do _.monad + [@success _.new_label] + (all _.composite + ..peek + (_.checkcast //type.variant) + (//structure.lefts lefts) + (//structure.right? right?) + //runtime.when + _.dup + (_.ifnonnull @success) + _.pop + (_.goto @else) + (_.set_label @success) + //runtime.push))) + + (^.with_template [ ] + [( lefts) + (operation#in (all _.composite + ..peek + ( lefts) + //runtime.push)) + + ... Extra optimization + (synthesis.path/seq + ( lefts) + (synthesis.!bind_top register thenP)) + (do phase.monad + [then! (path' stack_depth @else @end phase archive thenP)] + (in (all _.composite + ..peek + ( lefts) + (_.astore register) + then!)))]) + ([synthesis.member/left ..left_projection] + [synthesis.member/right ..right_projection]) + + {synthesis.#Seq leftP rightP} + (do phase.monad + [left! (path' stack_depth @else @end phase archive leftP) + right! (path' stack_depth @else @end phase archive rightP)] + (in (all _.composite + left! + right!))) + + {synthesis.#Alt leftP rightP} + (do phase.monad + [@alt_else //runtime.forge_label + left! (path' (++ stack_depth) @alt_else @end phase archive leftP) + right! (path' stack_depth @else @end phase archive rightP)] + (in (all _.composite + _.dup + left! + (_.set_label @alt_else) + _.pop + right!))) + ))) + +(def (path @end phase archive path) + (-> Label (Generator Path)) + (do phase.monad + [@else //runtime.forge_label + path! (..path' 1 @else @end phase archive path)] + (in (all _.composite + path! + (<| (_.when_acknowledged @else) + (all _.composite + (_.set_label @else) + //runtime.pm_failure + (_.goto @end) + )) + )))) + +(def .public (if phase archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do phase.monad + [test! (phase archive testS) + then! (phase archive thenS) + else! (phase archive elseS)] + (in (do _.monad + [@else _.new_label + @end _.new_label] + (all _.composite + test! + (//value.unwrap type.boolean) + (_.ifeq @else) + then! + (_.when_continuous (_.goto @end)) + (_.set_label @else) + else! + (<| (_.when_acknowledged @end) + (_.set_label @end))))))) + +(def .public (exec phase archive [this that]) + (Generator [Synthesis Synthesis]) + (do phase.monad + [this! (phase archive this) + that! (phase archive that)] + (in (all _.composite + this! + _.pop + that!)))) + +(def .public (let phase archive [inputS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do phase.monad + [input! (phase archive inputS) + body! (phase archive bodyS)] + (in (all _.composite + input! + (_.astore register) + body!)))) + +(def .public (get phase archive [path recordS]) + (Generator [(List Member) Synthesis]) + (do phase.monad + [record! (phase archive recordS)] + (in (list#mix (function (_ step so_far!) + (.let [next! (.if (the member.#right? step) + (..right_projection (the member.#lefts step)) + (..left_projection (the member.#lefts step)))] + (all _.composite + so_far! + next!))) + record! + (list.reversed path))))) + +(def .public (when phase archive [valueS path]) + (Generator [Synthesis Path]) + (do phase.monad + [@end //runtime.forge_label + value! (phase archive valueS) + path! (..path @end phase archive path)] + (in (all _.composite + _.aconst_null + value! + //runtime.push + path! + (<| (_.when_acknowledged @end) + (_.set_label @end)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua.lux index 2e27b6973..08fbc07cf 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua.lux @@ -15,7 +15,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function] ["/[1]" // @@ -37,7 +37,7 @@ (def (expression archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -55,20 +55,20 @@ {synthesis.#Reference value} (//reference.reference /reference.system archive value) - (synthesis.branch/case case) - (/case.case ///extension/common.statement expression archive case) + (synthesis.branch/when when) + (/when.when ///extension/common.statement expression archive when) (synthesis.branch/exec it) - (/case.exec expression archive it) + (/when.exec expression archive it) (synthesis.branch/let let) - (/case.let expression archive let) + (/when.let expression archive let) (synthesis.branch/if if) - (/case.if expression archive if) + (/when.if expression archive if) (synthesis.branch/get get) - (/case.get expression archive get) + (/when.get expression archive get) (synthesis.loop/scope scope) (/loop.scope ///extension/common.statement expression archive scope) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/case.lux deleted file mode 100644 index 5924848e8..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/case.lux +++ /dev/null @@ -1,304 +0,0 @@ -(.require - [library - [lux (.except case exec let if) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set]]] - [meta - [macro - ["^" pattern]] - [target - ["_" lua (.only Expression Var Statement)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Phase! Generator Generator!)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - ["[1][0]" synthesis - ["[1]/[0]" case]] - ["/[1]" // - ["[1][0]" synthesis (.only Synthesis Path) - [access - ["[0]" member (.only Member)]]] - ["[1][0]" generation] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public register - (-> Register Var) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register Var) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (exec expression archive [this that]) - (Generator [Synthesis Synthesis]) - (do ///////phase.monad - [this (expression archive this) - that (expression archive that)] - (in (|> (_.array (list this that)) - (_.item (_.int +2)))))) - -(def .public (exec! statement expression archive [this that]) - (Generator! [Synthesis Synthesis]) - (do [! ///////phase.monad] - [this (expression archive this) - that (statement expression archive that) - $dummy (at ! each _.var (/////generation.symbol "_exec"))] - (in (all _.then - (_.set (list $dummy) this) - that)))) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] - ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (|> bodyO - _.return - (_.closure (list (..register register))) - (_.apply (list valueO)))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Generator! [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (statement expression archive bodyS)] - (in (all _.then - (_.local/1 (..register register) valueO) - bodyO)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.if (the member.#right? side) - (//runtime.tuple//right (_.int (.int (the member.#lefts side)))) - (//runtime.tuple//left (_.int (.int (the member.#lefts side)))))] - (method source))) - valueO - (list.reversed pathP))))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] - (in (|> (_.if testO - (_.return thenO) - (_.return elseO)) - (_.closure (list)) - (_.apply (list)))))) - -(def .public (if! statement expression archive [testS thenS elseS]) - (Generator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (statement expression archive thenS) - elseO (statement expression archive elseS)] - (in (_.if testO - thenO - elseO)))) - -(def @savepoint (_.var "lux_pm_savepoint")) -(def @cursor (_.var "lux_pm_cursor")) -(def @temp (_.var "lux_pm_temp")) - -(def (push! value) - (-> Expression Statement) - (_.statement (|> (_.var "table.insert") (_.apply (list @cursor value))))) - -(def peek_and_pop - Expression - (|> (_.var "table.remove") (_.apply (list @cursor)))) - -(def pop! - Statement - (_.statement ..peek_and_pop)) - -(def peek - Expression - (_.item (_.length @cursor) @cursor)) - -(def save! - Statement - (_.statement (|> (_.var "table.insert") - (_.apply (list @savepoint - (_.apply (list @cursor - (_.int +1) - (_.length @cursor) - (_.int +1) - (_.table (list))) - (_.var "table.move"))))))) - -(def restore! - Statement - (_.set (list @cursor) (|> (_.var "table.remove") (_.apply (list @savepoint))))) - -(def fail! _.break) - -(with_template [ ] - [(def ( simple? idx) - (-> Bit Nat Statement) - (all _.then - (_.set (list @temp) (//runtime.sum//get ..peek - (|> idx .int _.int))) - (.if simple? - (_.when (_.= _.nil @temp) - fail!) - (_.if (_.= _.nil @temp) - fail! - (..push! @temp)))))] - - [left_choice _.nil] - [right_choice //runtime.unit] - ) - -(def (alternation pre! post!) - (-> Statement Statement Statement) - (all _.then - (_.while (_.boolean true) - (all _.then - ..save! - pre!)) - (all _.then - ..restore! - post!))) - -(def (pattern_matching' statement expression archive) - (-> Phase! Phase Archive Path (Operation Statement)) - (function (again pathP) - (.case pathP - {/////synthesis.#Then bodyS} - (statement expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in ..pop!) - - {/////synthesis.#Bind register} - (///////phase#in (_.local/1 (..register register) ..peek)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail!))] - (in (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) - - (^.with_template [ ] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (do ! - [then! (again then)] - (in [(_.= (|> match ) - ..peek) - then!]))) - {.#Item item})] - (in (list#mix (function (_ [when then!] else!) - (_.if when then! else!)) - ..fail! - clauses)))]) - ([/////synthesis.#I64_Fork (<| _.int .int)] - [/////synthesis.#F64_Fork _.float] - [/////synthesis.#Text_Fork _.string]) - - (^.with_template [ ] - [( idx) - (///////phase#in ( false idx)) - - ( idx nextP) - (///////phase#each (_.then ( true idx)) (again nextP))]) - ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] - [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - - (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +1)) ..push!)) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (/////synthesis.!bind_top register thenP) - (do ///////phase.monad - [then! (again thenP)] - (///////phase#in (all _.then - (_.local/1 (..register register) ..peek_and_pop) - then!))) - - (^.with_template [ ] - [( preP postP) - (do ///////phase.monad - [pre! (again preP) - post! (again postP)] - (in ( pre! post!)))]) - ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation])))) - -(def (pattern_matching statement expression archive pathP) - (-> Phase! Phase Archive Path (Operation Statement)) - (do ///////phase.monad - [pattern_matching! (pattern_matching' statement expression archive pathP)] - (in (all _.then - (_.while (_.boolean true) - pattern_matching!) - (_.statement (|> (_.var "error") (_.apply (list (_.string ////synthesis/case.pattern_matching_error))))))))) - -(def .public dependencies - (-> Path (List Var)) - (|>> ////synthesis/case.storage - (the ////synthesis/case.#dependencies) - set.list - (list#each (function (_ variable) - (.case variable - {///////variable.#Local register} - (..register register) - - {///////variable.#Foreign register} - (..capture register)))))) - -(def .public (case! statement expression archive [valueS pathP]) - (Generator! [Synthesis Path]) - (do ///////phase.monad - [stack_init (expression archive valueS) - pattern_matching! (pattern_matching statement expression archive pathP)] - (in (all _.then - (_.local (list @temp)) - (_.local/1 @cursor (_.array (list stack_init))) - (_.local/1 @savepoint (_.array (list))) - pattern_matching!)))) - -(def .public (case statement expression archive [valueS pathP]) - (-> Phase! (Generator [Synthesis Path])) - (|> [valueS pathP] - (..case! statement expression archive) - (at ///////phase.monad each - (|>> (_.closure (list)) - (_.apply (list)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/function.lux index 77f3d2caf..0e7b19de8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/function.lux @@ -15,7 +15,7 @@ ["[0]" // ["[1][0]" runtime (.only Operation Phase Phase! Generator)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -47,7 +47,7 @@ (def (with_closure inits @self @args body!) (-> (List Expression) Var (List Var) Statement [Statement Expression]) - (case inits + (when inits {.#End} [(_.function @self @args body!) @self] @@ -62,7 +62,7 @@ (_.apply inits @self)]))) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def (@scope function_name) (-> unit.ID Label) @@ -84,7 +84,7 @@ @num_args (_.var "num_args") @scope (..@scope function_name) @self (_.var (///reference.artifact function_name)) - initialize_self! (_.local/1 (//case.register 0) @self) + initialize_self! (_.local/1 (//when.register 0) @self) initialize! (list#mix (.function (_ post pre!) (all _.then pre! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/loop.lux index bef9f9893..f3532770a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/loop.lux @@ -18,7 +18,7 @@ ["_" lua (.only Var Expression Label Statement)]]]]] ["[0]" // [runtime (.only Operation Phase Phase! Generator Generator!)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -42,7 +42,7 @@ (-> Bit Register (List Expression) Bit Statement Statement) (let [variables (|> bindings list.enumeration - (list#each (|>> product.left (n.+ offset) //case.register)))] + (list#each (|>> product.left (n.+ offset) //when.register)))] (if as_expression? body (all _.then @@ -55,7 +55,7 @@ ... (Generator! (Scope Synthesis)) (-> Phase! Phase Archive Bit (Scope Synthesis) (Operation [(List Expression) Statement])) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (|> bodyS @@ -77,7 +77,7 @@ (def .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -91,10 +91,10 @@ .let [@loop (_.var (///reference.artifact [artifact_module artifact_id])) locals (|> initsO+ list.enumeration - (list#each (|>> product.left (n.+ start) //case.register))) + (list#each (|>> product.left (n.+ start) //when.register))) [declaration instantiation] (is [Statement Expression] - (case (|> (synthesis.path/then bodyS) - //case.dependencies + (when (|> (synthesis.path/then bodyS) + //when.dependencies (set.of_list _.hash) (set.difference (set.of_list _.hash locals)) set.list) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux index e8ba62726..b365b536e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/runtime.lux @@ -129,7 +129,7 @@ (macro.with_symbols [g!_] (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (, (code.text (%.code runtime)))))] - (case declaration + (when declaration {.#Left name} (macro.with_symbols [g!_] (let [g!name (code.local name)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/structure.lux index e3b0c8c66..c623bd592 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/structure.lux @@ -18,7 +18,7 @@ (def .public (tuple phase archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/when.lux new file mode 100644 index 000000000..7e9e383ca --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/lua/when.lux @@ -0,0 +1,304 @@ +(.require + [library + [lux (.except when exec let if) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set]]] + [meta + [macro + ["^" pattern]] + [target + ["_" lua (.only Expression Var Statement)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Phase! Generator Generator!)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + ["[1][0]" synthesis + ["[1]/[0]" when]] + ["/[1]" // + ["[1][0]" synthesis (.only Synthesis Path) + [access + ["[0]" member (.only Member)]]] + ["[1][0]" generation] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public register + (-> Register Var) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register Var) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (exec expression archive [this that]) + (Generator [Synthesis Synthesis]) + (do ///////phase.monad + [this (expression archive this) + that (expression archive that)] + (in (|> (_.array (list this that)) + (_.item (_.int +2)))))) + +(def .public (exec! statement expression archive [this that]) + (Generator! [Synthesis Synthesis]) + (do [! ///////phase.monad] + [this (expression archive this) + that (statement expression archive that) + $dummy (at ! each _.var (/////generation.symbol "_exec"))] + (in (all _.then + (_.set (list $dummy) this) + that)))) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] + ... TODO: Find some way to do 'let' without paying the price of the closure. + (in (|> bodyO + _.return + (_.closure (list (..register register))) + (_.apply (list valueO)))))) + +(def .public (let! statement expression archive [valueS register bodyS]) + (Generator! [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (statement expression archive bodyS)] + (in (all _.then + (_.local/1 (..register register) valueO) + bodyO)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.if (the member.#right? side) + (//runtime.tuple//right (_.int (.int (the member.#lefts side)))) + (//runtime.tuple//left (_.int (.int (the member.#lefts side)))))] + (method source))) + valueO + (list.reversed pathP))))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (in (|> (_.if testO + (_.return thenO) + (_.return elseO)) + (_.closure (list)) + (_.apply (list)))))) + +(def .public (if! statement expression archive [testS thenS elseS]) + (Generator! [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (statement expression archive thenS) + elseO (statement expression archive elseS)] + (in (_.if testO + thenO + elseO)))) + +(def @savepoint (_.var "lux_pm_savepoint")) +(def @cursor (_.var "lux_pm_cursor")) +(def @temp (_.var "lux_pm_temp")) + +(def (push! value) + (-> Expression Statement) + (_.statement (|> (_.var "table.insert") (_.apply (list @cursor value))))) + +(def peek_and_pop + Expression + (|> (_.var "table.remove") (_.apply (list @cursor)))) + +(def pop! + Statement + (_.statement ..peek_and_pop)) + +(def peek + Expression + (_.item (_.length @cursor) @cursor)) + +(def save! + Statement + (_.statement (|> (_.var "table.insert") + (_.apply (list @savepoint + (_.apply (list @cursor + (_.int +1) + (_.length @cursor) + (_.int +1) + (_.table (list))) + (_.var "table.move"))))))) + +(def restore! + Statement + (_.set (list @cursor) (|> (_.var "table.remove") (_.apply (list @savepoint))))) + +(def fail! _.break) + +(with_template [ ] + [(def ( simple? idx) + (-> Bit Nat Statement) + (all _.then + (_.set (list @temp) (//runtime.sum//get ..peek + (|> idx .int _.int))) + (.if simple? + (_.when (_.= _.nil @temp) + fail!) + (_.if (_.= _.nil @temp) + fail! + (..push! @temp)))))] + + [left_choice _.nil] + [right_choice //runtime.unit] + ) + +(def (alternation pre! post!) + (-> Statement Statement Statement) + (all _.then + (_.while (_.boolean true) + (all _.then + ..save! + pre!)) + (all _.then + ..restore! + post!))) + +(def (pattern_matching' statement expression archive) + (-> Phase! Phase Archive Path (Operation Statement)) + (function (again pathP) + (.when pathP + {/////synthesis.#Then bodyS} + (statement expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in ..pop!) + + {/////synthesis.#Bind register} + (///////phase#in (_.local/1 (..register register) ..peek)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^.with_template [ ] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (do ! + [then! (again then)] + (in [(_.= (|> match ) + ..peek) + then!]))) + {.#Item item})] + (in (list#mix (function (_ [when then!] else!) + (_.if when then! else!)) + ..fail! + clauses)))]) + ([/////synthesis.#I64_Fork (<| _.int .int)] + [/////synthesis.#F64_Fork _.float] + [/////synthesis.#Text_Fork _.string]) + + (^.with_template [ ] + [( idx) + (///////phase#in ( false idx)) + + ( idx nextP) + (///////phase#each (_.then ( true idx)) (again nextP))]) + ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] + [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + + (/////synthesis.member/left 0) + (///////phase#in (|> ..peek (_.item (_.int +1)) ..push!)) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (/////synthesis.!bind_top register thenP) + (do ///////phase.monad + [then! (again thenP)] + (///////phase#in (all _.then + (_.local/1 (..register register) ..peek_and_pop) + then!))) + + (^.with_template [ ] + [( preP postP) + (do ///////phase.monad + [pre! (again preP) + post! (again postP)] + (in ( pre! post!)))]) + ([/////synthesis.path/seq _.then] + [/////synthesis.path/alt ..alternation])))) + +(def (pattern_matching statement expression archive pathP) + (-> Phase! Phase Archive Path (Operation Statement)) + (do ///////phase.monad + [pattern_matching! (pattern_matching' statement expression archive pathP)] + (in (all _.then + (_.while (_.boolean true) + pattern_matching!) + (_.statement (|> (_.var "error") (_.apply (list (_.string ////synthesis/when.pattern_matching_error))))))))) + +(def .public dependencies + (-> Path (List Var)) + (|>> ////synthesis/when.storage + (the ////synthesis/when.#dependencies) + set.list + (list#each (function (_ variable) + (.when variable + {///////variable.#Local register} + (..register register) + + {///////variable.#Foreign register} + (..capture register)))))) + +(def .public (when! statement expression archive [valueS pathP]) + (Generator! [Synthesis Path]) + (do ///////phase.monad + [stack_init (expression archive valueS) + pattern_matching! (pattern_matching statement expression archive pathP)] + (in (all _.then + (_.local (list @temp)) + (_.local/1 @cursor (_.array (list stack_init))) + (_.local/1 @savepoint (_.array (list))) + pattern_matching!)))) + +(def .public (when statement expression archive [valueS pathP]) + (-> Phase! (Generator [Synthesis Path])) + (|> [valueS pathP] + (..when! statement expression archive) + (at ///////phase.monad each + (|>> (_.closure (list)) + (_.apply (list)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php.lux index 293366280..12e2dffd3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php.lux @@ -15,7 +15,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function] ["/[1]" // @@ -32,7 +32,7 @@ (def (statement expression archive synthesis) Phase! - (case synthesis + (when synthesis (^.with_template [] [( value) (//////phase#each _.return (expression archive synthesis))]) @@ -51,14 +51,14 @@ ([////synthesis.#Reference] [////synthesis.#Extension]) - (////synthesis.branch/case case) - (/case.case! statement expression archive case) + (////synthesis.branch/when when) + (/when.when! statement expression archive when) (^.with_template [ ] [( value) ( statement expression archive value)]) - ([////synthesis.branch/let /case.let!] - [////synthesis.branch/if /case.if!] + ([////synthesis.branch/let /when.let!] + [////synthesis.branch/if /when.if!] [////synthesis.loop/scope /loop.scope!] [////synthesis.loop/again /loop.again!]) @@ -70,7 +70,7 @@ (def .public (expression archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -87,15 +87,15 @@ ( expression archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] - [////synthesis.branch/let /case.let] - [////synthesis.branch/if /case.if] - [////synthesis.branch/get /case.get] + [////synthesis.branch/let /when.let] + [////synthesis.branch/if /when.if] + [////synthesis.branch/get /when.get] [////synthesis.function/apply /function.apply]) (^.with_template [ ] [( value) ( statement expression archive value)]) - ([////synthesis.branch/case /case.case] + ([////synthesis.branch/when /when.when] [////synthesis.loop/scope /loop.scope] [////synthesis.function/abstraction /function.function]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/case.lux deleted file mode 100644 index 816b77d0f..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/case.lux +++ /dev/null @@ -1,297 +0,0 @@ -(.require - [library - [lux (.except case let if) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set]]] - [math - [number - ["i" int]]] - [meta - [macro - ["^" pattern]] - [target - ["_" php (.only Expression Var Statement)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Phase! Generator Generator!)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - ["[1][0]" synthesis - ["[1]/[0]" case]] - ["/[1]" // - ["[1][0]" synthesis (.only Member Synthesis Path)] - ["[1][0]" generation] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public register - (-> Register Var) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register Var) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueG (expression archive valueS) - bodyG (expression archive bodyS)] - (in (|> bodyG - (list (_.set (..register register) valueG)) - _.array/* - (_.item (_.int +1)))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Generator! [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - body! (statement expression archive bodyS)] - (in (all _.then - (_.set! (..register register) valueO) - body!)))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testG (expression archive testS) - thenG (expression archive thenS) - elseG (expression archive elseS)] - (in (_.? testG thenG elseG)))) - -(def .public (if! statement expression archive [testS thenS elseS]) - (Generator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [test! (expression archive testS) - then! (statement expression archive thenS) - else! (statement expression archive elseS)] - (in (_.if test! - then! - else!)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueG (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.case side - (^.with_template [ ] - [( lefts) - ( (_.int (.int lefts)))]) - ([.#Left //runtime.tuple//left] - [.#Right //runtime.tuple//right]))] - (method source))) - valueG - (list.reversed pathP))))) - -(def @savepoint (_.var "lux_pm_savepoint")) -(def @cursor (_.var "lux_pm_cursor")) -(def @temp (_.var "lux_pm_temp")) - -(def (push! value) - (-> Expression Statement) - (_.; (_.array_push/2 [@cursor value]))) - -(def peek_and_pop - Expression - (_.array_pop/1 @cursor)) - -(def pop! - Statement - (_.; ..peek_and_pop)) - -(def peek - Expression - (_.item (|> @cursor _.count/1 (_.- (_.int +1))) - @cursor)) - -(def save! - Statement - (.let [cursor (_.array_slice/2 [@cursor (_.int +0)])] - (_.; (_.array_push/2 [@savepoint cursor])))) - -(def restore! - Statement - (_.set! @cursor (_.array_pop/1 @savepoint))) - -(def fail! _.break) - -(def (multi_pop! pops) - (-> Nat Statement) - (_.; (_.array_splice/3 [@cursor - (_.int +0) - (_.int (i.* -1 (.int pops)))]))) - -(with_template [ ] - [(def ( simple? idx) - (-> Bit Nat Statement) - (all _.then - (_.set! @temp (|> idx .int _.int (//runtime.sum//get ..peek ))) - (.if simple? - (_.when (_.is_null/1 @temp) - fail!) - (_.if (_.is_null/1 @temp) - fail! - (..push! @temp)))))] - - [left_choice _.null (<|)] - [right_choice (_.string "") ++] - ) - -(def (alternation pre! post!) - (-> Statement Statement Statement) - (all _.then - (_.do_while (_.bool false) - (all _.then - ..save! - pre!)) - (all _.then - ..restore! - post!))) - -(def (pattern_matching' statement expression archive) - (Generator! Path) - (function (again pathP) - (.case pathP - {/////synthesis.#Then bodyS} - (statement expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in ..pop!) - - {/////synthesis.#Bind register} - (///////phase#in (_.set! (..register register) ..peek)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail!))] - (in (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) - - (^.with_template [ ] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (do ! - [then! (again then)] - (in [(_.=== (|> match ) - ..peek) - then!]))) - {.#Item item})] - (in (_.cond clauses ..fail!)))]) - ([/////synthesis.#I64_Fork //primitive.i64] - [/////synthesis.#F64_Fork //primitive.f64] - [/////synthesis.#Text_Fork //primitive.text]) - - (^.with_template [ ] - [( idx) - (///////phase#in ( false idx)) - - ( idx nextP) - (|> nextP - again - (at ///////phase.monad each (_.then ( true idx))))]) - ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] - [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - - (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (/////synthesis.!bind_top register thenP) - (do ///////phase.monad - [then! (again thenP)] - (///////phase#in (all _.then - (_.set! (..register register) ..peek_and_pop) - then!))) - - ... (/////synthesis.!multi_pop nextP) - ... (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] - ... (do ///////phase.monad - ... [next! (again nextP')] - ... (///////phase#in (all _.then - ... (..multi_pop! (n.+ 2 extra_pops)) - ... next!)))) - - (^.with_template [ ] - [( preP postP) - (do ///////phase.monad - [pre! (again preP) - post! (again postP)] - (in ( pre! post!)))]) - ([/////synthesis.path/seq _.then] - [/////synthesis.path/alt ..alternation])))) - -(def (pattern_matching statement expression archive pathP) - (Generator! Path) - (do ///////phase.monad - [iteration! (pattern_matching' statement expression archive pathP)] - (in (all _.then - (_.do_while (_.bool false) - iteration!) - (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error)))))))) - -(def .public dependencies - (-> Path (List Var)) - (|>> ////synthesis/case.storage - (the ////synthesis/case.#dependencies) - set.list - (list#each (function (_ variable) - (.case variable - {///////variable.#Local register} - (..register register) - - {///////variable.#Foreign register} - (..capture register)))))) - -(def .public (case! statement expression archive [valueS pathP]) - (Generator! [Synthesis Path]) - (do ///////phase.monad - [stack_init (expression archive valueS) - pattern_matching! (pattern_matching statement expression archive pathP)] - (in (all _.then - (_.set! @cursor (_.array/* (list stack_init))) - (_.set! @savepoint (_.array/* (list))) - pattern_matching!)))) - -(def .public (case statement expression archive [valueS pathP]) - (-> Phase! (Generator [Synthesis Path])) - (do [! ///////phase.monad] - [[[case_module case_artifact] case!] (/////generation.with_new_context archive - (case! statement expression archive [valueS pathP])) - .let [@case (_.constant (///reference.artifact [case_module case_artifact])) - @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) - pathP)) - declaration (_.define_function @case (list#each _.parameter @dependencies+) case!)] - _ (/////generation.execute! declaration) - _ (/////generation.save! case_artifact declaration)] - (in (_.apply @dependencies+ @case)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/function.lux index b2ca21671..e4195f3d4 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/function.lux @@ -17,7 +17,7 @@ ["[0]" // ["[1][0]" runtime (.only Operation Phase Phase! Generator)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -42,7 +42,7 @@ (|>> (///reference.foreign //reference.system) as_expected)) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def (@scope function_name) (-> Context Label) @@ -50,7 +50,7 @@ (def (with_closure inits @selfG @selfL body!) (-> (List Expression) Global Var Statement [Statement Expression]) - (case inits + (when inits {.#End} [(all _.then (_.set! @selfL (_.closure (list (_.reference @selfL)) (list) body!)) @@ -84,7 +84,7 @@ @scope (..@scope function_name) @selfG (_.global (///reference.artifact function_name)) @selfL (_.var (///reference.artifact function_name)) - initialize_self! (_.set! (//case.register 0) @selfL) + initialize_self! (_.set! (//when.register 0) @selfL) initialize! (list#mix (.function (_ post pre!) (all _.then pre! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/loop.lux index 5c3682738..b4c3804e8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/loop.lux @@ -18,12 +18,12 @@ ["_" php (.only Var Expression Label Statement)]]]]] ["[0]" // [runtime (.only Operation Phase Phase! Generator Generator!)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["/[1]" // [synthesis - ["[0]" case]] + ["[0]" when]] ["/[1]" // ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -44,14 +44,14 @@ (|> bindings list.enumeration (list#each (function (_ [register value]) - (let [variable (//case.register (n.+ offset register))] + (let [variable (//when.register (n.+ offset register))] (_.set! variable value)))) list.reversed (list#mix _.then body))) (def .public (scope! statement expression archive [start initsS+ bodyS]) (Generator! (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (statement expression archive bodyS) @@ -70,7 +70,7 @@ (def .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -82,15 +82,15 @@ (..scope! statement expression archive [start initsS+ bodyS])) .let [locals (|> initsS+ list.enumeration - (list#each (|>> product.left (n.+ start) //case.register _.parameter))) + (list#each (|>> product.left (n.+ start) //when.register _.parameter))) @loop (_.constant (///reference.artifact [loop_module loop_artifact])) loop_variables (set.of_list _.hash (list#each product.right locals)) referenced_variables (is (-> Synthesis (Set Var)) (|>> synthesis.path/then - //case.dependencies + //when.dependencies (set.of_list _.hash))) [declaration instantiation] (is [Statement Expression] - (case (|> (list#each referenced_variables initsS+) + (when (|> (list#each referenced_variables initsS+) (list#mix set.union (referenced_variables bodyS)) (set.difference loop_variables) set.list) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/runtime.lux index bff0a6cf0..b1d1abe87 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/runtime.lux @@ -96,7 +96,7 @@ (macro.with_symbols [g!_] (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.constant (, (code.text (%.code runtime)))))] - (case declaration + (when declaration {.#Left name} (macro.with_symbols [g!_] (let [g!name (code.local name)] @@ -606,7 +606,7 @@ i64_error (_.string (format "Cannot run program!" text.new_line "Lux/PHP programs require 64-bit PHP builds!"))] (_.when (_.not i64_support?) - (_.throw (_.new (_.constant "Exception") (list i64_error)))))) + (_.throw (_.new (_.constant "Exception") (list i64_error)))))) (def runtime Statement diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/structure.lux index 749ba0f5d..239d34609 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/structure.lux @@ -19,7 +19,7 @@ (def .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/when.lux new file mode 100644 index 000000000..fc703eb8b --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/php/when.lux @@ -0,0 +1,297 @@ +(.require + [library + [lux (.except when let if) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set]]] + [math + [number + ["i" int]]] + [meta + [macro + ["^" pattern]] + [target + ["_" php (.only Expression Var Statement)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Phase! Generator Generator!)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + ["[1][0]" synthesis + ["[1]/[0]" when]] + ["/[1]" // + ["[1][0]" synthesis (.only Member Synthesis Path)] + ["[1][0]" generation] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public register + (-> Register Var) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register Var) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueG (expression archive valueS) + bodyG (expression archive bodyS)] + (in (|> bodyG + (list (_.set (..register register) valueG)) + _.array/* + (_.item (_.int +1)))))) + +(def .public (let! statement expression archive [valueS register bodyS]) + (Generator! [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + body! (statement expression archive bodyS)] + (in (all _.then + (_.set! (..register register) valueO) + body!)))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testG (expression archive testS) + thenG (expression archive thenS) + elseG (expression archive elseS)] + (in (_.? testG thenG elseG)))) + +(def .public (if! statement expression archive [testS thenS elseS]) + (Generator! [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [test! (expression archive testS) + then! (statement expression archive thenS) + else! (statement expression archive elseS)] + (in (_.if test! + then! + else!)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueG (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.when side + (^.with_template [ ] + [( lefts) + ( (_.int (.int lefts)))]) + ([.#Left //runtime.tuple//left] + [.#Right //runtime.tuple//right]))] + (method source))) + valueG + (list.reversed pathP))))) + +(def @savepoint (_.var "lux_pm_savepoint")) +(def @cursor (_.var "lux_pm_cursor")) +(def @temp (_.var "lux_pm_temp")) + +(def (push! value) + (-> Expression Statement) + (_.; (_.array_push/2 [@cursor value]))) + +(def peek_and_pop + Expression + (_.array_pop/1 @cursor)) + +(def pop! + Statement + (_.; ..peek_and_pop)) + +(def peek + Expression + (_.item (|> @cursor _.count/1 (_.- (_.int +1))) + @cursor)) + +(def save! + Statement + (.let [cursor (_.array_slice/2 [@cursor (_.int +0)])] + (_.; (_.array_push/2 [@savepoint cursor])))) + +(def restore! + Statement + (_.set! @cursor (_.array_pop/1 @savepoint))) + +(def fail! _.break) + +(def (multi_pop! pops) + (-> Nat Statement) + (_.; (_.array_splice/3 [@cursor + (_.int +0) + (_.int (i.* -1 (.int pops)))]))) + +(with_template [ ] + [(def ( simple? idx) + (-> Bit Nat Statement) + (all _.then + (_.set! @temp (|> idx .int _.int (//runtime.sum//get ..peek ))) + (.if simple? + (_.when (_.is_null/1 @temp) + fail!) + (_.if (_.is_null/1 @temp) + fail! + (..push! @temp)))))] + + [left_choice _.null (<|)] + [right_choice (_.string "") ++] + ) + +(def (alternation pre! post!) + (-> Statement Statement Statement) + (all _.then + (_.do_while (_.bool false) + (all _.then + ..save! + pre!)) + (all _.then + ..restore! + post!))) + +(def (pattern_matching' statement expression archive) + (Generator! Path) + (function (again pathP) + (.when pathP + {/////synthesis.#Then bodyS} + (statement expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in ..pop!) + + {/////synthesis.#Bind register} + (///////phase#in (_.set! (..register register) ..peek)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^.with_template [ ] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (do ! + [then! (again then)] + (in [(_.=== (|> match ) + ..peek) + then!]))) + {.#Item item})] + (in (_.cond clauses ..fail!)))]) + ([/////synthesis.#I64_Fork //primitive.i64] + [/////synthesis.#F64_Fork //primitive.f64] + [/////synthesis.#Text_Fork //primitive.text]) + + (^.with_template [ ] + [( idx) + (///////phase#in ( false idx)) + + ( idx nextP) + (|> nextP + again + (at ///////phase.monad each (_.then ( true idx))))]) + ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] + [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + + (/////synthesis.member/left 0) + (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (/////synthesis.!bind_top register thenP) + (do ///////phase.monad + [then! (again thenP)] + (///////phase#in (all _.then + (_.set! (..register register) ..peek_and_pop) + then!))) + + ... (/////synthesis.!multi_pop nextP) + ... (.let [[extra_pops nextP'] (////synthesis/when.count_pops nextP)] + ... (do ///////phase.monad + ... [next! (again nextP')] + ... (///////phase#in (all _.then + ... (..multi_pop! (n.+ 2 extra_pops)) + ... next!)))) + + (^.with_template [ ] + [( preP postP) + (do ///////phase.monad + [pre! (again preP) + post! (again postP)] + (in ( pre! post!)))]) + ([/////synthesis.path/seq _.then] + [/////synthesis.path/alt ..alternation])))) + +(def (pattern_matching statement expression archive pathP) + (Generator! Path) + (do ///////phase.monad + [iteration! (pattern_matching' statement expression archive pathP)] + (in (all _.then + (_.do_while (_.bool false) + iteration!) + (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/when.pattern_matching_error)))))))) + +(def .public dependencies + (-> Path (List Var)) + (|>> ////synthesis/when.storage + (the ////synthesis/when.#dependencies) + set.list + (list#each (function (_ variable) + (.when variable + {///////variable.#Local register} + (..register register) + + {///////variable.#Foreign register} + (..capture register)))))) + +(def .public (when! statement expression archive [valueS pathP]) + (Generator! [Synthesis Path]) + (do ///////phase.monad + [stack_init (expression archive valueS) + pattern_matching! (pattern_matching statement expression archive pathP)] + (in (all _.then + (_.set! @cursor (_.array/* (list stack_init))) + (_.set! @savepoint (_.array/* (list))) + pattern_matching!)))) + +(def .public (when statement expression archive [valueS pathP]) + (-> Phase! (Generator [Synthesis Path])) + (do [! ///////phase.monad] + [[[when_module when_artifact] when!] (/////generation.with_new_context archive + (when! statement expression archive [valueS pathP])) + .let [@when (_.constant (///reference.artifact [when_module when_artifact])) + @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) + pathP)) + declaration (_.define_function @when (list#each _.parameter @dependencies+) when!)] + _ (/////generation.execute! declaration) + _ (/////generation.save! when_artifact declaration)] + (in (_.apply @dependencies+ @when)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python.lux index cd48b763b..b2692261f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python.lux @@ -16,7 +16,7 @@ ["[1][0]" structure] ["[1][0]" reference] ["[1][0]" function] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["/[1]" // ["[1][0]" reference] @@ -37,7 +37,7 @@ (def .public (expression archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -52,17 +52,17 @@ ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] - [////synthesis.branch/exec /case.exec] - [////synthesis.branch/let /case.let] - [////synthesis.branch/if /case.if] - [////synthesis.branch/get /case.get] + [////synthesis.branch/exec /when.exec] + [////synthesis.branch/let /when.let] + [////synthesis.branch/if /when.if] + [////synthesis.branch/get /when.get] [////synthesis.function/apply /function.apply]) (^.with_template [ ] [( value) ( ///extension/common.statement expression archive value)]) - ([////synthesis.branch/case /case.case] + ([////synthesis.branch/when /when.when] [////synthesis.loop/scope /loop.scope] [////synthesis.function/abstraction /function.function]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/case.lux deleted file mode 100644 index 090c2587e..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/case.lux +++ /dev/null @@ -1,362 +0,0 @@ -(.require - [library - [lux (.except case exec let if symbol) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set]]] - [math - [number - ["n" nat] - ["i" int]]] - [meta - [macro - ["^" pattern]] - [target - ["_" python (.only Expression SVar Statement)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Generator Phase! Generator!)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - [synthesis - ["[0]" case]] - ["/[1]" // - ["[1][0]" generation] - ["[1][0]" synthesis (.only Synthesis Path) - [access - ["[0]" member (.only Member)]]] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)] - ["[0]" cache - [dependency - ["[1]" artifact]]]]]]]]]) - -(def .public (symbol prefix) - (-> Text (Operation SVar)) - (///////phase#each (|>> %.nat (format prefix) _.var) - /////generation.next)) - -(def .public register - (-> Register SVar) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register SVar) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] - ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (_.apply (list valueO) - (_.lambda (list (..register register)) - bodyO))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Generator! [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (statement expression archive bodyS)] - (in (all _.then - (_.set (list (..register register)) valueO) - bodyO)))) - -(def .public (exec expression archive [pre post]) - (Generator [Synthesis Synthesis]) - (do ///////phase.monad - [pre (expression archive pre) - post (expression archive post)] - (in (_.item (_.int +1) (_.tuple (list pre post)))))) - -(def .public (exec! statement expression archive [pre post]) - (Generator! [Synthesis Synthesis]) - (do ///////phase.monad - [pre (expression archive pre) - post (statement expression archive post)] - (in (all _.then - (_.statement pre) - post)))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] - (in (_.? testO thenO elseO)))) - -(def .public (if! statement expression archive [testS thenS elseS]) - (Generator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [test! (expression archive testS) - then! (statement expression archive thenS) - else! (statement expression archive elseS)] - (in (_.if test! - then! - else!)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.if (the member.#right? side) - //runtime.tuple::right - //runtime.tuple::left)] - (method (_.int (.int (the member.#lefts side))) - source))) - valueO - (list.reversed pathP))))) - -(def @savepoint (_.var "lux_pm_savepoint")) -(def @cursor (_.var "lux_pm_cursor")) -(def @temp (_.var "lux_pm_temp")) - -(def (push! value) - (-> (Expression Any) (Statement Any)) - (_.statement (|> @cursor (_.do "append" (list value))))) - -(def peek_and_pop - (Expression Any) - (|> @cursor (_.do "pop" (list)))) - -(def pop! - (Statement Any) - (_.statement ..peek_and_pop)) - -(def peek - (Expression Any) - (_.item (_.int -1) @cursor)) - -(def save! - (Statement Any) - (.let [cursor (_.slice_from (_.int +0) @cursor)] - (_.statement (|> @savepoint (_.do "append" (list cursor)))))) - -(def restore! - (Statement Any) - (_.set (list @cursor) (|> @savepoint (_.do "pop" (list))))) - -(def fail_pm! _.break) - -(def (multi_pop! pops) - (-> Nat (Statement Any)) - (_.delete (_.slice_from (_.int (i.* -1 (.int pops))) @cursor))) - -(with_template [ ] - [(def ( simple? idx) - (-> Bit Nat (Statement Any)) - (all _.then - (_.set (list @temp) (//runtime.sum::get ..peek - (|> idx .int _.int))) - (.if simple? - (_.when (_.= _.none @temp) - fail_pm!) - (_.if (_.= _.none @temp) - fail_pm! - (..push! @temp)) - )))] - - [left_choice _.none] - [right_choice //runtime.unit] - ) - -(def (with_looping in_closure? g!once body!) - (-> Bit SVar (Statement Any) (Statement Any)) - (.if in_closure? - (_.while (_.bool true) - body! - {.#None}) - (all _.then - (_.set (list g!once) (_.bool true)) - (_.while g!once - (all _.then - (_.set (list g!once) (_.bool false)) - body!) - {.#Some _.continue})))) - -(def (alternation in_closure? g!once pre! post!) - (-> Bit SVar (Statement Any) (Statement Any) (Statement Any)) - (all _.then - (..with_looping in_closure? g!once - (all _.then - ..save! - pre!)) - ..restore! - post!)) - -(def (primitive_pattern_matching again pathP) - (-> (-> Path (Operation (Statement Any))) - (-> Path (Operation (Maybe (Statement Any))))) - (.case pathP - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail_pm!))] - (in {.#Some (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!))})) - - (^.with_template [ ] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (at ! each - (|>> [(_.= (|> match ) - ..peek)]) - (again then))) - {.#Item item})] - (in {.#Some (list#mix (function (_ [when then] else) - (_.if when then else)) - ..fail_pm! - clauses)}))]) - ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] - [/////synthesis.#F64_Fork (<| //primitive.f64)] - [/////synthesis.#Text_Fork (<| //primitive.text)]) - - _ - (at ///////phase.monad in {.#None}))) - -(def (pattern_matching' in_closure? statement expression archive) - (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) - (function (again pathP) - (do [! ///////phase.monad] - [?output (primitive_pattern_matching again pathP)] - (.case ?output - {.#Some output} - (in output) - - {.#None} - (.case pathP - {/////synthesis.#Then bodyS} - (statement expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in ..pop!) - - {/////synthesis.#Bind register} - (///////phase#in (_.set (list (..register register)) ..peek)) - - (^.with_template [ ] - [( idx) - (///////phase#in ( false idx)) - - ( idx nextP) - (|> nextP - again - (///////phase#each (_.then ( true idx))))]) - ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] - [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - - (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple::left] - [/////synthesis.member/right //runtime.tuple::right]) - - (/////synthesis.!bind_top register thenP) - (do ! - [then! (again thenP)] - (///////phase#in (all _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) - - (/////synthesis.!multi_pop nextP) - (.let [[extra_pops nextP'] (case.count_pops nextP)] - (do ! - [next! (again nextP')] - (///////phase#in (all _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) - - (/////synthesis.path/seq preP postP) - (do ! - [pre! (again preP) - post! (again postP)] - (in (_.then pre! post!))) - - (/////synthesis.path/alt preP postP) - (do ! - [pre! (again preP) - post! (again postP) - g!once (..symbol "once")] - (in (..alternation in_closure? g!once pre! post!))) - - _ - (undefined)))))) - -(def (pattern_matching in_closure? statement expression archive pathP) - (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) - (do ///////phase.monad - [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) - g!once (..symbol "once")] - (in (all _.then - (..with_looping in_closure? g!once - pattern_matching!) - (_.raise (_.Exception/1 (_.string case.pattern_matching_error))))))) - -(def .public dependencies - (-> Path (List SVar)) - (|>> case.storage - (the case.#dependencies) - set.list - (list#each (function (_ variable) - (.case variable - {///////variable.#Local register} - (..register register) - - {///////variable.#Foreign register} - (..capture register)))))) - -(def .public (case! in_closure? statement expression archive [valueS pathP]) - (-> Bit (Generator! [Synthesis Path])) - (do ///////phase.monad - [stack_init (expression archive valueS) - pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] - (in (all _.then - (_.set (list @cursor) (_.list (list stack_init))) - (_.set (list @savepoint) (_.list (list))) - pattern_matching! - )))) - -(def .public (case statement expression archive [valueS pathP]) - (-> Phase! (Generator [Synthesis Path])) - (do ///////phase.monad - [dependencies (cache.path_dependencies archive pathP) - [[case_module case_artifact] pattern_matching!] (/////generation.with_new_context - archive - dependencies - (case! true statement expression archive [valueS pathP])) - .let [@case (_.var (///reference.artifact [case_module case_artifact])) - @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) - pathP)) - declaration (_.def @case @dependencies+ - pattern_matching!)] - _ (/////generation.execute! declaration) - _ (/////generation.save! case_artifact {.#None} declaration)] - (in (_.apply @dependencies+ @case)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/function.lux index 1d1021d11..7afc45ccb 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/function.lux @@ -15,7 +15,7 @@ ["[0]" // [runtime (.only Operation Phase Generator Phase! Generator!)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["/[1]" // ["[1][0]" reference] @@ -48,7 +48,7 @@ (def (with_closure function_id @function inits function_definition) (-> artifact.ID SVar (List (Expression Any)) (Statement Any) (Operation (Expression Any))) - (case inits + (when inits {.#End} (do ///////phase.monad [_ (/////generation.execute! function_definition) @@ -68,7 +68,7 @@ (in (_.apply inits @function))))) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) @@ -84,7 +84,7 @@ @self (_.var (///reference.artifact [function_module function_artifact])) apply_poly (.function (_ args func) (_.apply (list (_.splat_poly args)) func)) - initialize_self! (_.set (list (//case.register 0)) @self) + initialize_self! (_.set (list (//when.register 0)) @self) initialize! (list#mix (.function (_ post pre!) (all _.then pre! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/loop.lux index d767eeeeb..16df5397a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/loop.lux @@ -18,12 +18,12 @@ ["_" python (.only Expression SVar Statement)]]]]] ["[0]" // [runtime (.only Operation Phase Generator Phase! Generator!)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["/[1]" // [synthesis - ["[0]" case]] + ["[0]" when]] ["/[1]" // ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -40,7 +40,7 @@ (-> Register (List (Expression Any)) (Statement Any) (Statement Any)) (let [variables (|> bindings list.enumeration - (list#each (|>> product.left (n.+ offset) //case.register)))] + (list#each (|>> product.left (n.+ offset) //when.register)))] (all _.then (_.set variables (_.multi bindings)) body))) @@ -53,7 +53,7 @@ (def .public (scope! statement expression archive [start initsS+ bodyS]) (Generator! (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (statement expression archive bodyS) @@ -70,7 +70,7 @@ (def .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -86,13 +86,13 @@ .let [@loop (_.var (///reference.artifact [loop_module loop_artifact])) locals (|> initsS+ list.enumeration - (list#each (|>> product.left (n.+ start) //case.register))) + (list#each (|>> product.left (n.+ start) //when.register))) actual_loop (<| (_.def @loop locals) ..set_scope body!) [declaration instantiation] (is [(Statement Any) (Expression Any)] - (case (|> (synthesis.path/then bodyS) - //case.dependencies + (when (|> (synthesis.path/then bodyS) + //when.dependencies (set.of_list _.hash) (set.difference (set.of_list _.hash locals)) set.list) @@ -115,7 +115,7 @@ (Generator! (List Synthesis)) (do [! ///////phase.monad] [offset /////generation.anchor - @temp (//case.symbol "lux_again_values") + @temp (//when.symbol "lux_again_values") argsO+ (monad.each ! (expression archive) argsS+) .let [re_binds (|> argsO+ list.enumeration diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/runtime.lux index d045b7d8e..38c5d87e3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/runtime.lux @@ -127,7 +127,7 @@ (.form (<>.and .local (<>.some .local)))) code .any]) - (case declaration + (when declaration {.#Left name} (macro.with_symbols [g!_] (let [nameC (code.local name) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/structure.lux index 428320d23..f89cf244b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/structure.lux @@ -18,7 +18,7 @@ (def .public (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/when.lux new file mode 100644 index 000000000..3666dc9fc --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/python/when.lux @@ -0,0 +1,362 @@ +(.require + [library + [lux (.except when exec let if symbol) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set]]] + [math + [number + ["n" nat] + ["i" int]]] + [meta + [macro + ["^" pattern]] + [target + ["_" python (.only Expression SVar Statement)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Generator Phase! Generator!)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + [synthesis + ["[0]" when]] + ["/[1]" // + ["[1][0]" generation] + ["[1][0]" synthesis (.only Synthesis Path) + [access + ["[0]" member (.only Member)]]] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)] + ["[0]" cache + [dependency + ["[1]" artifact]]]]]]]]]) + +(def .public (symbol prefix) + (-> Text (Operation SVar)) + (///////phase#each (|>> %.nat (format prefix) _.var) + /////generation.next)) + +(def .public register + (-> Register SVar) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register SVar) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] + ... TODO: Find some way to do 'let' without paying the price of the closure. + (in (_.apply (list valueO) + (_.lambda (list (..register register)) + bodyO))))) + +(def .public (let! statement expression archive [valueS register bodyS]) + (Generator! [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (statement expression archive bodyS)] + (in (all _.then + (_.set (list (..register register)) valueO) + bodyO)))) + +(def .public (exec expression archive [pre post]) + (Generator [Synthesis Synthesis]) + (do ///////phase.monad + [pre (expression archive pre) + post (expression archive post)] + (in (_.item (_.int +1) (_.tuple (list pre post)))))) + +(def .public (exec! statement expression archive [pre post]) + (Generator! [Synthesis Synthesis]) + (do ///////phase.monad + [pre (expression archive pre) + post (statement expression archive post)] + (in (all _.then + (_.statement pre) + post)))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (in (_.? testO thenO elseO)))) + +(def .public (if! statement expression archive [testS thenS elseS]) + (Generator! [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [test! (expression archive testS) + then! (statement expression archive thenS) + else! (statement expression archive elseS)] + (in (_.if test! + then! + else!)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.if (the member.#right? side) + //runtime.tuple::right + //runtime.tuple::left)] + (method (_.int (.int (the member.#lefts side))) + source))) + valueO + (list.reversed pathP))))) + +(def @savepoint (_.var "lux_pm_savepoint")) +(def @cursor (_.var "lux_pm_cursor")) +(def @temp (_.var "lux_pm_temp")) + +(def (push! value) + (-> (Expression Any) (Statement Any)) + (_.statement (|> @cursor (_.do "append" (list value))))) + +(def peek_and_pop + (Expression Any) + (|> @cursor (_.do "pop" (list)))) + +(def pop! + (Statement Any) + (_.statement ..peek_and_pop)) + +(def peek + (Expression Any) + (_.item (_.int -1) @cursor)) + +(def save! + (Statement Any) + (.let [cursor (_.slice_from (_.int +0) @cursor)] + (_.statement (|> @savepoint (_.do "append" (list cursor)))))) + +(def restore! + (Statement Any) + (_.set (list @cursor) (|> @savepoint (_.do "pop" (list))))) + +(def fail_pm! _.break) + +(def (multi_pop! pops) + (-> Nat (Statement Any)) + (_.delete (_.slice_from (_.int (i.* -1 (.int pops))) @cursor))) + +(with_template [ ] + [(def ( simple? idx) + (-> Bit Nat (Statement Any)) + (all _.then + (_.set (list @temp) (//runtime.sum::get ..peek + (|> idx .int _.int))) + (.if simple? + (_.when (_.= _.none @temp) + fail_pm!) + (_.if (_.= _.none @temp) + fail_pm! + (..push! @temp)) + )))] + + [left_choice _.none] + [right_choice //runtime.unit] + ) + +(def (with_looping in_closure? g!once body!) + (-> Bit SVar (Statement Any) (Statement Any)) + (.if in_closure? + (_.while (_.bool true) + body! + {.#None}) + (all _.then + (_.set (list g!once) (_.bool true)) + (_.while g!once + (all _.then + (_.set (list g!once) (_.bool false)) + body!) + {.#Some _.continue})))) + +(def (alternation in_closure? g!once pre! post!) + (-> Bit SVar (Statement Any) (Statement Any) (Statement Any)) + (all _.then + (..with_looping in_closure? g!once + (all _.then + ..save! + pre!)) + ..restore! + post!)) + +(def (primitive_pattern_matching again pathP) + (-> (-> Path (Operation (Statement Any))) + (-> Path (Operation (Maybe (Statement Any))))) + (.when pathP + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail_pm!))] + (in {.#Some (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!))})) + + (^.with_template [ ] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (at ! each + (|>> [(_.= (|> match ) + ..peek)]) + (again then))) + {.#Item item})] + (in {.#Some (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail_pm! + clauses)}))]) + ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] + [/////synthesis.#F64_Fork (<| //primitive.f64)] + [/////synthesis.#Text_Fork (<| //primitive.text)]) + + _ + (at ///////phase.monad in {.#None}))) + +(def (pattern_matching' in_closure? statement expression archive) + (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) + (function (again pathP) + (do [! ///////phase.monad] + [?output (primitive_pattern_matching again pathP)] + (.when ?output + {.#Some output} + (in output) + + {.#None} + (.when pathP + {/////synthesis.#Then bodyS} + (statement expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in ..pop!) + + {/////synthesis.#Bind register} + (///////phase#in (_.set (list (..register register)) ..peek)) + + (^.with_template [ ] + [( idx) + (///////phase#in ( false idx)) + + ( idx nextP) + (|> nextP + again + (///////phase#each (_.then ( true idx))))]) + ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] + [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + + (/////synthesis.member/left 0) + (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) + ([/////synthesis.member/left //runtime.tuple::left] + [/////synthesis.member/right //runtime.tuple::right]) + + (/////synthesis.!bind_top register thenP) + (do ! + [then! (again thenP)] + (///////phase#in (all _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) + + (/////synthesis.!multi_pop nextP) + (.let [[extra_pops nextP'] (when.count_pops nextP)] + (do ! + [next! (again nextP')] + (///////phase#in (all _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) + + (/////synthesis.path/seq preP postP) + (do ! + [pre! (again preP) + post! (again postP)] + (in (_.then pre! post!))) + + (/////synthesis.path/alt preP postP) + (do ! + [pre! (again preP) + post! (again postP) + g!once (..symbol "once")] + (in (..alternation in_closure? g!once pre! post!))) + + _ + (undefined)))))) + +(def (pattern_matching in_closure? statement expression archive pathP) + (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) + (do ///////phase.monad + [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) + g!once (..symbol "once")] + (in (all _.then + (..with_looping in_closure? g!once + pattern_matching!) + (_.raise (_.Exception/1 (_.string when.pattern_matching_error))))))) + +(def .public dependencies + (-> Path (List SVar)) + (|>> when.storage + (the when.#dependencies) + set.list + (list#each (function (_ variable) + (.when variable + {///////variable.#Local register} + (..register register) + + {///////variable.#Foreign register} + (..capture register)))))) + +(def .public (when! in_closure? statement expression archive [valueS pathP]) + (-> Bit (Generator! [Synthesis Path])) + (do ///////phase.monad + [stack_init (expression archive valueS) + pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] + (in (all _.then + (_.set (list @cursor) (_.list (list stack_init))) + (_.set (list @savepoint) (_.list (list))) + pattern_matching! + )))) + +(def .public (when statement expression archive [valueS pathP]) + (-> Phase! (Generator [Synthesis Path])) + (do ///////phase.monad + [dependencies (cache.path_dependencies archive pathP) + [[when_module when_artifact] pattern_matching!] (/////generation.with_new_context + archive + dependencies + (when! true statement expression archive [valueS pathP])) + .let [@when (_.var (///reference.artifact [when_module when_artifact])) + @dependencies+ (..dependencies (/////synthesis.path/seq (/////synthesis.path/then valueS) + pathP)) + declaration (_.def @when @dependencies+ + pattern_matching!)] + _ (/////generation.execute! declaration) + _ (/////generation.save! when_artifact {.#None} declaration)] + (in (_.apply @dependencies+ @when)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r.lux index 7741ccce0..cf20229d8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r.lux @@ -13,7 +13,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function] ["/[1]" // @@ -30,7 +30,7 @@ (def .public (generate archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -47,12 +47,12 @@ ( generate archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] - [////synthesis.branch/let /case.let] - [////synthesis.branch/if /case.if] - [////synthesis.branch/get /case.get] + [////synthesis.branch/let /when.let] + [////synthesis.branch/if /when.if] + [////synthesis.branch/get /when.get] [////synthesis.function/apply /function.apply] - [////synthesis.branch/case /case.case] + [////synthesis.branch/when /when.when] [////synthesis.loop/scope /loop.scope] [////synthesis.loop/again /loop.again] [////synthesis.function/abstraction /function.function]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/case.lux deleted file mode 100644 index cc47ed212..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/case.lux +++ /dev/null @@ -1,242 +0,0 @@ -(.require - [library - [lux (.except case let if) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set]]] - [math - [number - ["i" int]]] - [meta - [macro - ["^" pattern] - ["[0]" template]] - [target - ["_" r (.only Expression SVar)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Generator)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - ["[1][0]" synthesis - ["[1]/[0]" case]] - ["/[1]" // - ["[1][0]" synthesis (.only Member Synthesis Path)] - ["[1][0]" generation] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public register - (-> Register SVar) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register SVar) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] - (in (_.block - (all _.then - (_.set! (..register register) valueO) - bodyO))))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] - (in (_.if testO thenO elseO)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.case side - (^.with_template [ ] - [( lefts) - ( (_.int (.int lefts)))]) - ([.#Left //runtime.tuple::left] - [.#Right //runtime.tuple::right]))] - (method source))) - valueO - (list.reversed pathP))))) - -(def $savepoint (_.var "lux_pm_cursor_savepoint")) -(def $cursor (_.var "lux_pm_cursor")) -(def $temp (_.var "lux_pm_temp")) -(def $alt_error (_.var "alt_error")) - -(def top - _.length) - -(def next - (|>> _.length (_.+ (_.int +1)))) - -(def (push! value var) - (-> Expression SVar Expression) - (_.set_item! (next var) value var)) - -(def (pop! var) - (-> SVar Expression) - (_.set_item! (top var) _.null var)) - -(def (push_cursor! value) - (-> Expression Expression) - (push! value $cursor)) - -(def save_cursor! - Expression - (push! (_.slice (_.float +1.0) (_.length $cursor) $cursor) - $savepoint)) - -(def restore_cursor! - Expression - (_.set! $cursor (_.item (top $savepoint) $savepoint))) - -(def peek - Expression - (|> $cursor (_.item (top $cursor)))) - -(def pop_cursor! - Expression - (pop! $cursor)) - -(def error - (_.string (template.with_locals [error] - (template.text [error])))) - -(def fail! - (_.stop ..error)) - -(def (catch handler) - (-> Expression Expression) - (_.function (list $alt_error) - (_.if (|> $alt_error (_.= ..error)) - handler - (_.stop $alt_error)))) - -(def (pattern_matching' expression archive) - (Generator Path) - (function (again pathP) - (.case pathP - {/////synthesis.#Then bodyS} - (expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in ..pop_cursor!) - - {/////synthesis.#Bind register} - (///////phase#in (_.set! (..register register) ..peek)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail!))] - (in (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) - - (^.with_template [ <=>] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (do ! - [then! (again then)] - (in [(<=> (|> match ) - ..peek) - then!]))) - {.#Item item})] - (in (list#mix (function (_ [when then] else) - (_.if when then else)) - ..fail! - clauses)))]) - ([/////synthesis.#I64_Fork //primitive.i64 //runtime.i64::=] - [/////synthesis.#F64_Fork //primitive.f64 _.=] - [/////synthesis.#Text_Fork //primitive.text _.=]) - - (^.with_template [ ] - [( idx) - (///////phase#in (all _.then - (_.set! $temp (|> idx .int _.int (//runtime.sum::get ..peek (//runtime.flag )))) - (_.if (_.= _.null $temp) - ..fail! - (..push_cursor! $temp))))]) - ([/////synthesis.side/left false (<|)] - [/////synthesis.side/right true ++]) - - (/////synthesis.member/left 0) - (///////phase#in (_.item (_.int +1) ..peek)) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push_cursor!))]) - ([/////synthesis.member/left //runtime.tuple::left] - [/////synthesis.member/right //runtime.tuple::right]) - - (/////synthesis.path/seq leftP rightP) - (do ///////phase.monad - [leftO (again leftP) - rightO (again rightP)] - (in (all _.then - leftO - rightO))) - - (/////synthesis.path/alt leftP rightP) - (do [! ///////phase.monad] - [leftO (again leftP) - rightO (again rightP)] - (in (_.try (all _.then - ..save_cursor! - leftO) - {.#None} - {.#Some (..catch (all _.then - ..restore_cursor! - rightO))} - {.#None}))) - ))) - -(def (pattern_matching expression archive pathP) - (Generator Path) - (do ///////phase.monad - [pattern_matching! (pattern_matching' expression archive pathP)] - (in (_.try pattern_matching! - {.#None} - {.#Some (..catch (_.stop (_.string "Invalid expression for pattern-matching.")))} - {.#None})))) - -(def .public (case expression archive [valueS pathP]) - (Generator [Synthesis Path]) - (do [! ///////phase.monad] - [valueO (expression archive valueS)] - (<| (at ! each (|>> (all _.then - (_.set! $cursor (_.list (list valueO))) - (_.set! $savepoint (_.list (list)))) - _.block)) - (pattern_matching expression archive pathP)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/function.lux index 80f8ac48c..bf6d09b19 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/function.lux @@ -17,7 +17,7 @@ ["[0]" // ["[1][0]" runtime (.only Operation Phase Generator)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -42,7 +42,7 @@ (def (with_closure function_id $function inits function_definition) (-> artifact.ID SVar (List Expression) Expression (Operation Expression)) - (case inits + (when inits {.#End} (do ///////phase.monad [_ (/////generation.execute! function_definition) @@ -56,7 +56,7 @@ (_.function (|> inits list.size list.indices - (list#each //case.capture)) + (list#each //when.capture)) (all _.then function_definition $function)))] @@ -69,7 +69,7 @@ (def (input_declaration register) (-> Register Expression) - (_.set! (|> register ++ //case.register) + (_.set! (|> register ++ //when.register) (|> $curried (_.item (|> register ++ .int _.int))))) (def .public (function expression archive [environment arity bodyS]) @@ -94,7 +94,7 @@ (_.set! $num_args (_.length $curried)) (_.cond (list [(|> $num_args (_.= arityO)) (all _.then - (_.set! (//case.register 0) $self) + (_.set! (//when.register 0) $self) (|> arity list.indices (list#each input_declaration) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/loop.lux index 35477e3f7..7a72081e9 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/loop.lux @@ -18,12 +18,12 @@ ["_" r]]]]] ["[0]" // [runtime (.only Operation Phase Generator)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["/[1]" // [synthesis - ["[0]" case]] + ["[0]" when]] ["/[1]" // ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -36,7 +36,7 @@ (def .public (scope expression archive [offset initsS+ bodyS]) (Generator (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -54,7 +54,7 @@ (_.function (|> initsS+ list.size list.indices - (list#each (|>> (n.+ offset) //case.register))) + (list#each (|>> (n.+ offset) //when.register))) bodyO)) (_.apply initsO+ $scope))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/common.lux index a64f95bc9..f57141564 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/common.lux @@ -20,7 +20,7 @@ (host [r (.only Expression)]))) [///] (/// ["[0]T" runtime] - ["[0]T" case] + ["[0]T" when] ["[0]T" function] ["[0]T" loop])) @@ -56,7 +56,7 @@ (def (lux//if [testO thenO elseO]) Trinary - (caseT.translate_if testO thenO elseO)) + (whenT.translate_if testO thenO elseO)) (def (lux//try riskyO) Unary @@ -74,7 +74,7 @@ (-> Text Proc) (function (_ proc_name) (function (_ translate inputsS) - (case (s.result inputsS (all p.and s.nat (s.tuple (p.many s.any)) s.any)) + (when (s.result inputsS (all p.and s.nat (s.tuple (p.many s.any)) s.any)) {e.#Success [offset initsS+ bodyS]} (loopT.translate_loop translate offset initsS+ bodyS) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/host.lux index b5a3fcb3a..1b588bc61 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/procedure/host.lux @@ -24,7 +24,7 @@ ... (def (lua//global proc translate inputs) ... (-> Text @.Proc) -... (case inputs +... (when inputs ... (list [_ {.#Text name}]) ... (do macro.Monad ... [] @@ -35,7 +35,7 @@ ... (def (lua//call proc translate inputs) ... (-> Text @.Proc) -... (case inputs +... (when inputs ... (list.partial functionS argsS+) ... (do [@ macro.Monad] ... [functionO (translate functionS) @@ -55,7 +55,7 @@ ... (def (table//call proc translate inputs) ... (-> Text @.Proc) -... (case inputs +... (when inputs ... (list.partial tableS [_ {.#Text field}] argsS+) ... (do [@ macro.Monad] ... [tableO (translate tableS) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/runtime.lux index c23b725d5..261cba579 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/runtime.lux @@ -99,7 +99,7 @@ (macro.with_symbols [g!_] (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (, (code.text (%.code runtime)))))] - (case declaration + (when declaration {.#Left name} (let [g!name (code.local name)] (in (list (` (def .public (, g!name) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/structure.lux index b381f8d63..77b7a3f62 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/structure.lux @@ -20,7 +20,7 @@ (def .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/when.lux new file mode 100644 index 000000000..0f2a0954c --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/r/when.lux @@ -0,0 +1,242 @@ +(.require + [library + [lux (.except when let if) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set]]] + [math + [number + ["i" int]]] + [meta + [macro + ["^" pattern] + ["[0]" template]] + [target + ["_" r (.only Expression SVar)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Generator)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + ["[1][0]" synthesis + ["[1]/[0]" when]] + ["/[1]" // + ["[1][0]" synthesis (.only Member Synthesis Path)] + ["[1][0]" generation] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public register + (-> Register SVar) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register SVar) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] + (in (_.block + (all _.then + (_.set! (..register register) valueO) + bodyO))))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (in (_.if testO thenO elseO)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.when side + (^.with_template [ ] + [( lefts) + ( (_.int (.int lefts)))]) + ([.#Left //runtime.tuple::left] + [.#Right //runtime.tuple::right]))] + (method source))) + valueO + (list.reversed pathP))))) + +(def $savepoint (_.var "lux_pm_cursor_savepoint")) +(def $cursor (_.var "lux_pm_cursor")) +(def $temp (_.var "lux_pm_temp")) +(def $alt_error (_.var "alt_error")) + +(def top + _.length) + +(def next + (|>> _.length (_.+ (_.int +1)))) + +(def (push! value var) + (-> Expression SVar Expression) + (_.set_item! (next var) value var)) + +(def (pop! var) + (-> SVar Expression) + (_.set_item! (top var) _.null var)) + +(def (push_cursor! value) + (-> Expression Expression) + (push! value $cursor)) + +(def save_cursor! + Expression + (push! (_.slice (_.float +1.0) (_.length $cursor) $cursor) + $savepoint)) + +(def restore_cursor! + Expression + (_.set! $cursor (_.item (top $savepoint) $savepoint))) + +(def peek + Expression + (|> $cursor (_.item (top $cursor)))) + +(def pop_cursor! + Expression + (pop! $cursor)) + +(def error + (_.string (template.with_locals [error] + (template.text [error])))) + +(def fail! + (_.stop ..error)) + +(def (catch handler) + (-> Expression Expression) + (_.function (list $alt_error) + (_.if (|> $alt_error (_.= ..error)) + handler + (_.stop $alt_error)))) + +(def (pattern_matching' expression archive) + (Generator Path) + (function (again pathP) + (.when pathP + {/////synthesis.#Then bodyS} + (expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in ..pop_cursor!) + + {/////synthesis.#Bind register} + (///////phase#in (_.set! (..register register) ..peek)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^.with_template [ <=>] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (do ! + [then! (again then)] + (in [(<=> (|> match ) + ..peek) + then!]))) + {.#Item item})] + (in (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail! + clauses)))]) + ([/////synthesis.#I64_Fork //primitive.i64 //runtime.i64::=] + [/////synthesis.#F64_Fork //primitive.f64 _.=] + [/////synthesis.#Text_Fork //primitive.text _.=]) + + (^.with_template [ ] + [( idx) + (///////phase#in (all _.then + (_.set! $temp (|> idx .int _.int (//runtime.sum::get ..peek (//runtime.flag )))) + (_.if (_.= _.null $temp) + ..fail! + (..push_cursor! $temp))))]) + ([/////synthesis.side/left false (<|)] + [/////synthesis.side/right true ++]) + + (/////synthesis.member/left 0) + (///////phase#in (_.item (_.int +1) ..peek)) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push_cursor!))]) + ([/////synthesis.member/left //runtime.tuple::left] + [/////synthesis.member/right //runtime.tuple::right]) + + (/////synthesis.path/seq leftP rightP) + (do ///////phase.monad + [leftO (again leftP) + rightO (again rightP)] + (in (all _.then + leftO + rightO))) + + (/////synthesis.path/alt leftP rightP) + (do [! ///////phase.monad] + [leftO (again leftP) + rightO (again rightP)] + (in (_.try (all _.then + ..save_cursor! + leftO) + {.#None} + {.#Some (..catch (all _.then + ..restore_cursor! + rightO))} + {.#None}))) + ))) + +(def (pattern_matching expression archive pathP) + (Generator Path) + (do ///////phase.monad + [pattern_matching! (pattern_matching' expression archive pathP)] + (in (_.try pattern_matching! + {.#None} + {.#Some (..catch (_.stop (_.string "Invalid expression for pattern-matching.")))} + {.#None})))) + +(def .public (when expression archive [valueS pathP]) + (Generator [Synthesis Path]) + (do [! ///////phase.monad] + [valueO (expression archive valueS)] + (<| (at ! each (|>> (all _.then + (_.set! $cursor (_.list (list valueO))) + (_.set! $savepoint (_.list (list)))) + _.block)) + (pattern_matching expression archive pathP)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/reference.lux index ef720c4ae..2ec80b679 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/reference.lux @@ -83,7 +83,7 @@ (def .public (variable system variable) (All (_ expression) (-> (System expression) Variable expression)) - (case variable + (when variable {variable.#Local register} (..local system register) @@ -93,7 +93,7 @@ (def .public (reference system archive reference) (All (_ anchor expression declaration) (-> (System expression) Archive Reference (////generation.Operation anchor expression declaration expression))) - (case reference + (when reference {reference.#Constant value} (..constant system archive value) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby.lux index f3e5aed3c..9c2719467 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby.lux @@ -16,7 +16,7 @@ ["[1][0]" structure] ["[1][0]" reference] ["[1][0]" function] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["/[1]" // ["[1][0]" reference] @@ -37,7 +37,7 @@ (def (expression archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -52,17 +52,17 @@ ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] - [////synthesis.branch/exec /case.exec] - [////synthesis.branch/let /case.let] - [////synthesis.branch/if /case.if] - [////synthesis.branch/get /case.get] + [////synthesis.branch/exec /when.exec] + [////synthesis.branch/let /when.let] + [////synthesis.branch/if /when.if] + [////synthesis.branch/get /when.get] [////synthesis.function/apply /function.apply]) (^.with_template [ ] [( value) ( ///extension/common.statement expression archive value)]) - ([////synthesis.branch/case /case.case] + ([////synthesis.branch/when /when.when] [////synthesis.loop/scope /loop.scope] [////synthesis.function/abstraction /function.function]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/case.lux deleted file mode 100644 index 88a7e039e..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/case.lux +++ /dev/null @@ -1,382 +0,0 @@ -(.require - [library - [lux (.except case exec let if symbol) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set]]] - [math - [number - ["n" nat] - ["i" int]]] - [meta - [macro - ["^" pattern]] - [target - ["_" ruby (.only Expression LVar Statement)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Generator Phase! Generator!)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - [synthesis - ["[0]" case]] - ["/[1]" // - ["[1][0]" generation] - ["[1][0]" synthesis (.only Synthesis Path) - [access - ["[0]" member (.only Member)]]] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public (symbol prefix) - (-> Text (Operation LVar)) - (///////phase#each (|>> %.nat (format prefix) _.local) /////generation.next)) - -(def .public register - (-> Register LVar) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register LVar) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (exec expression archive [this that]) - (Generator [Synthesis Synthesis]) - (do ///////phase.monad - [this (expression archive this) - that (expression archive that)] - (in (|> (_.array (list this that)) - (_.item (_.int +1)))))) - -(def .public (exec! statement expression archive [this that]) - (Generator! [Synthesis Synthesis]) - (do ///////phase.monad - [this (expression archive this) - that (statement expression archive that)] - (in (all _.then - (_.statement this) - that - )))) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] - ... TODO: Find some way to do 'let' without paying the price of the closure. - (in (|> bodyO - _.return - [(list (..register register))] (_.lambda {.#None}) - (_.apply_lambda (list valueO)))))) - -(def .public (let! statement expression archive [valueS register bodyS]) - (Generator! [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (statement expression archive bodyS)] - (in (all _.then - (_.set (list (..register register)) valueO) - bodyO)))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] - (in (_.? testO thenO elseO)))) - -(def .public (if! statement expression archive [testS thenS elseS]) - (Generator! [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [test! (expression archive testS) - then! (statement expression archive thenS) - else! (statement expression archive elseS)] - (in (_.if test! - then! - else!)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.if (the member.#right? side) - (//runtime.tuple//right (_.int (.int (the member.#lefts side)))) - (//runtime.tuple//left (_.int (.int (the member.#lefts side)))))] - (method source))) - valueO - (list.reversed pathP))))) - -(def @savepoint (_.local "lux_pm_savepoint")) -(def @cursor (_.local "lux_pm_cursor")) -(def @temp (_.local "lux_pm_temp")) - -(def (push! value) - (-> Expression Statement) - (_.statement (|> @cursor (_.do "push" (list value) {.#None})))) - -(def peek_and_pop - Expression - (|> @cursor (_.do "pop" (list) {.#None}))) - -(def pop! - Statement - (_.statement ..peek_and_pop)) - -(def peek - Expression - (_.item (_.int -1) @cursor)) - -(def save! - Statement - (.let [cursor (_.array_range (_.int +0) (_.int -1) @cursor)] - (_.statement (|> @savepoint (_.do "push" (list cursor) {.#None}))))) - -(def restore! - Statement - (_.set (list @cursor) (|> @savepoint (_.do "pop" (list) {.#None})))) - -(def fail! _.break) - -(def (multi_pop! pops) - (-> Nat Statement) - (_.statement (_.do "slice!" - (list (_.int (i.* -1 (.int pops))) - (_.int (.int pops))) - {.#None} - @cursor))) - -(with_template [ ] - [(def ( simple? idx) - (-> Bit Nat Statement) - (all _.then - (_.set (list @temp) (//runtime.sum//get ..peek - (|> idx .int _.int))) - (.if simple? - (_.when (_.= _.nil @temp) - fail!) - (_.if (_.= _.nil @temp) - fail! - (..push! @temp)))))] - - [left_choice _.nil] - [right_choice //runtime.unit] - ) - -(def (with_looping in_closure? g!once g!continue? body!) - (-> Bit LVar LVar Statement Statement) - (.if in_closure? - (all _.then - (_.while (_.bool true) - body!)) - (all _.then - (_.set (list g!once) (_.bool true)) - (_.set (list g!continue?) (_.bool false)) - (<| (_.while (_.bool true)) - (_.if g!once - (all _.then - (_.set (list g!once) (_.bool false)) - body!) - (all _.then - (_.set (list g!continue?) (_.bool true)) - _.break))) - (_.when g!continue? - _.next)))) - -(def (alternation in_closure? g!once g!continue? pre! post!) - (-> Bit LVar LVar Statement Statement Statement) - (all _.then - (with_looping in_closure? g!once g!continue? - (all _.then - ..save! - pre!)) - ..restore! - post!)) - -(def (primitive_pattern_matching again pathP) - (-> (-> Path (Operation Statement)) - (-> Path (Operation (Maybe Statement)))) - (.case pathP - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail!))] - (in {.#Some (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!))})) - - (^.with_template [ ] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (at ! each - (|>> [(_.= (|> match ) - ..peek)]) - (again then))) - {.#Item item})] - (in {.#Some (list#mix (function (_ [when then] else) - (_.if when then else)) - ..fail! - clauses)}))]) - ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] - [/////synthesis.#F64_Fork (<| //primitive.f64)] - [/////synthesis.#Text_Fork (<| //primitive.text)]) - - _ - (at ///////phase.monad in {.#None}))) - -(def (pattern_matching' in_closure? statement expression archive) - (-> Bit (Generator! Path)) - (function (again pathP) - (do ///////phase.monad - [?output (primitive_pattern_matching again pathP)] - (.case ?output - {.#Some output} - (in output) - - {.#None} - (.case pathP - {/////synthesis.#Then bodyS} - (statement expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in ..pop!) - - {/////synthesis.#Bind register} - (///////phase#in (_.set (list (..register register)) ..peek)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail!))] - (in (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) - - (^.with_template [ ] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (at ! each - (|>> [(_.= (|> match ) - ..peek)]) - (again then))) - {.#Item item})] - (in (list#mix (function (_ [when then] else) - (_.if when then else)) - ..fail! - clauses)))]) - ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] - [/////synthesis.#F64_Fork (<| //primitive.f64)] - [/////synthesis.#Text_Fork (<| //primitive.text)]) - - (^.with_template [ ] - [( idx) - (///////phase#in ( false idx)) - - ( idx nextP) - (|> nextP - again - (///////phase#each (_.then ( true idx))))]) - ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] - [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - - (/////synthesis.member/left 0) - (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (/////synthesis.!bind_top register thenP) - (do ///////phase.monad - [then! (again thenP)] - (///////phase#in (all _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) - - (/////synthesis.!multi_pop nextP) - (.let [[extra_pops nextP'] (case.count_pops nextP)] - (do ///////phase.monad - [next! (again nextP')] - (///////phase#in (all _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) - - (/////synthesis.path/seq preP postP) - (do ///////phase.monad - [pre! (again preP) - post! (again postP)] - (in (all _.then - pre! - post!))) - - (/////synthesis.path/alt preP postP) - (do ///////phase.monad - [pre! (again preP) - post! (again postP) - g!once (..symbol "once") - g!continue? (..symbol "continue")] - (in (..alternation in_closure? g!once g!continue? pre! post!)))))))) - -(def (pattern_matching in_closure? statement expression archive pathP) - (-> Bit (Generator! Path)) - (do ///////phase.monad - [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) - g!once (..symbol "once") - g!continue? (..symbol "continue")] - (in (all _.then - (..with_looping in_closure? g!once g!continue? - pattern_matching!) - (_.statement (_.raise (_.string case.pattern_matching_error))))))) - -(def .public (case! in_closure? statement expression archive [valueS pathP]) - (-> Bit (Generator! [Synthesis Path])) - (do ///////phase.monad - [stack_init (expression archive valueS) - pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] - (in (all _.then - (_.set (list @cursor) (_.array (list stack_init))) - (_.set (list @savepoint) (_.array (list))) - pattern_matching! - )))) - -(def .public (case statement expression archive case) - (-> Phase! (Generator [Synthesis Path])) - (|> case - (case! true statement expression archive) - (at ///////phase.monad each - (|>> [(list)] (_.lambda {.#None}) - (_.apply_lambda (list)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/function.lux index 51cf79c55..fc63bb4fa 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/function.lux @@ -15,7 +15,7 @@ ["[0]" // [runtime (.only Operation Phase Generator Phase! Generator!)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["/[1]" // ["[1][0]" reference] @@ -47,7 +47,7 @@ (def (with_closure inits self function_definition) (-> (List Expression) Text Expression [Statement Expression]) (let [@self (_.global self)] - (case inits + (when inits {.#End} [(_.set (list @self) function_definition) @self] @@ -63,7 +63,7 @@ (_.apply_lambda inits @self)]))) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) @@ -79,13 +79,13 @@ limitO (|> arity -- .int _.int) @num_args (_.local "num_args") @self (is _.Location - (case closureO+ + (when closureO+ {.#End} (_.global function_name) _ (_.local function_name))) - initialize_self! (_.set (list (//case.register 0)) @self) + initialize_self! (_.set (list (//when.register 0)) @self) initialize! (list#mix (.function (_ post pre!) (all _.then pre! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/loop.lux index 1a82b9e18..25feac999 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/loop.lux @@ -18,12 +18,12 @@ ["_" ruby (.only Expression LVar Statement)]]]]] ["[0]" // [runtime (.only Operation Phase Generator Phase! Generator!)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["/[1]" // [synthesis - ["[0]" case]] + ["[0]" when]] ["/[1]" // ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -36,7 +36,7 @@ (-> Register (List Expression) Statement Statement) (let [variables (|> bindings list.enumeration - (list#each (|>> product.left (n.+ offset) //case.register)))] + (list#each (|>> product.left (n.+ offset) //when.register)))] (all _.then (_.set variables (_.multi bindings)) body))) @@ -50,7 +50,7 @@ (def .public (scope! statement expression archive [start initsS+ bodyS]) (Generator! (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (statement expression archive bodyS) @@ -67,7 +67,7 @@ (def .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -84,7 +84,7 @@ (Generator! (List Synthesis)) (do [! ///////phase.monad] [offset /////generation.anchor - @temp (//case.symbol "lux_again_values") + @temp (//when.symbol "lux_again_values") argsO+ (monad.each ! (expression archive) argsS+) .let [re_binds (|> argsO+ list.enumeration diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux index b193b5b84..9cb620e31 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -112,7 +112,7 @@ (do meta.monad [runtime_id meta.seed] (macro.with_symbols [g!_] - (case declaration + (when declaration {.#Left name} (macro.with_symbols [g!_] (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) @@ -599,13 +599,13 @@ Statement (all _.then (_.when ..mruby? - ... We're in mRuby/DragonRuby territory. - (_.statement - (_.do "class_eval" (list) {.#Some [(list (_.local "_")) - (_.statement - (_.alias_method/2 (_.string "remainder") - (_.string "remainder_of_divide")))]} - $Numeric))) + ... We're in mRuby/DragonRuby territory. + (_.statement + (_.do "class_eval" (list) {.#Some [(list (_.local "_")) + (_.statement + (_.alias_method/2 (_.string "remainder") + (_.string "remainder_of_divide")))]} + $Numeric))) runtime//adt runtime//lux runtime//i64 diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/structure.lux index 5947bc8c4..a879af9d3 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/structure.lux @@ -18,7 +18,7 @@ (def .public (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/when.lux new file mode 100644 index 000000000..28599463f --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/ruby/when.lux @@ -0,0 +1,382 @@ +(.require + [library + [lux (.except when exec let if symbol) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set]]] + [math + [number + ["n" nat] + ["i" int]]] + [meta + [macro + ["^" pattern]] + [target + ["_" ruby (.only Expression LVar Statement)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Generator Phase! Generator!)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + [synthesis + ["[0]" when]] + ["/[1]" // + ["[1][0]" generation] + ["[1][0]" synthesis (.only Synthesis Path) + [access + ["[0]" member (.only Member)]]] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public (symbol prefix) + (-> Text (Operation LVar)) + (///////phase#each (|>> %.nat (format prefix) _.local) /////generation.next)) + +(def .public register + (-> Register LVar) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register LVar) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (exec expression archive [this that]) + (Generator [Synthesis Synthesis]) + (do ///////phase.monad + [this (expression archive this) + that (expression archive that)] + (in (|> (_.array (list this that)) + (_.item (_.int +1)))))) + +(def .public (exec! statement expression archive [this that]) + (Generator! [Synthesis Synthesis]) + (do ///////phase.monad + [this (expression archive this) + that (statement expression archive that)] + (in (all _.then + (_.statement this) + that + )))) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] + ... TODO: Find some way to do 'let' without paying the price of the closure. + (in (|> bodyO + _.return + [(list (..register register))] (_.lambda {.#None}) + (_.apply_lambda (list valueO)))))) + +(def .public (let! statement expression archive [valueS register bodyS]) + (Generator! [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (statement expression archive bodyS)] + (in (all _.then + (_.set (list (..register register)) valueO) + bodyO)))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (in (_.? testO thenO elseO)))) + +(def .public (if! statement expression archive [testS thenS elseS]) + (Generator! [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [test! (expression archive testS) + then! (statement expression archive thenS) + else! (statement expression archive elseS)] + (in (_.if test! + then! + else!)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.if (the member.#right? side) + (//runtime.tuple//right (_.int (.int (the member.#lefts side)))) + (//runtime.tuple//left (_.int (.int (the member.#lefts side)))))] + (method source))) + valueO + (list.reversed pathP))))) + +(def @savepoint (_.local "lux_pm_savepoint")) +(def @cursor (_.local "lux_pm_cursor")) +(def @temp (_.local "lux_pm_temp")) + +(def (push! value) + (-> Expression Statement) + (_.statement (|> @cursor (_.do "push" (list value) {.#None})))) + +(def peek_and_pop + Expression + (|> @cursor (_.do "pop" (list) {.#None}))) + +(def pop! + Statement + (_.statement ..peek_and_pop)) + +(def peek + Expression + (_.item (_.int -1) @cursor)) + +(def save! + Statement + (.let [cursor (_.array_range (_.int +0) (_.int -1) @cursor)] + (_.statement (|> @savepoint (_.do "push" (list cursor) {.#None}))))) + +(def restore! + Statement + (_.set (list @cursor) (|> @savepoint (_.do "pop" (list) {.#None})))) + +(def fail! _.break) + +(def (multi_pop! pops) + (-> Nat Statement) + (_.statement (_.do "slice!" + (list (_.int (i.* -1 (.int pops))) + (_.int (.int pops))) + {.#None} + @cursor))) + +(with_template [ ] + [(def ( simple? idx) + (-> Bit Nat Statement) + (all _.then + (_.set (list @temp) (//runtime.sum//get ..peek + (|> idx .int _.int))) + (.if simple? + (_.when (_.= _.nil @temp) + fail!) + (_.if (_.= _.nil @temp) + fail! + (..push! @temp)))))] + + [left_choice _.nil] + [right_choice //runtime.unit] + ) + +(def (with_looping in_closure? g!once g!continue? body!) + (-> Bit LVar LVar Statement Statement) + (.if in_closure? + (all _.then + (_.while (_.bool true) + body!)) + (all _.then + (_.set (list g!once) (_.bool true)) + (_.set (list g!continue?) (_.bool false)) + (<| (_.while (_.bool true)) + (_.if g!once + (all _.then + (_.set (list g!once) (_.bool false)) + body!) + (all _.then + (_.set (list g!continue?) (_.bool true)) + _.break))) + (_.when g!continue? + _.next)))) + +(def (alternation in_closure? g!once g!continue? pre! post!) + (-> Bit LVar LVar Statement Statement Statement) + (all _.then + (with_looping in_closure? g!once g!continue? + (all _.then + ..save! + pre!)) + ..restore! + post!)) + +(def (primitive_pattern_matching again pathP) + (-> (-> Path (Operation Statement)) + (-> Path (Operation (Maybe Statement)))) + (.when pathP + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail!))] + (in {.#Some (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!))})) + + (^.with_template [ ] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (at ! each + (|>> [(_.= (|> match ) + ..peek)]) + (again then))) + {.#Item item})] + (in {.#Some (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail! + clauses)}))]) + ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] + [/////synthesis.#F64_Fork (<| //primitive.f64)] + [/////synthesis.#Text_Fork (<| //primitive.text)]) + + _ + (at ///////phase.monad in {.#None}))) + +(def (pattern_matching' in_closure? statement expression archive) + (-> Bit (Generator! Path)) + (function (again pathP) + (do ///////phase.monad + [?output (primitive_pattern_matching again pathP)] + (.when ?output + {.#Some output} + (in output) + + {.#None} + (.when pathP + {/////synthesis.#Then bodyS} + (statement expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in ..pop!) + + {/////synthesis.#Bind register} + (///////phase#in (_.set (list (..register register)) ..peek)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^.with_template [ ] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (at ! each + (|>> [(_.= (|> match ) + ..peek)]) + (again then))) + {.#Item item})] + (in (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail! + clauses)))]) + ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] + [/////synthesis.#F64_Fork (<| //primitive.f64)] + [/////synthesis.#Text_Fork (<| //primitive.text)]) + + (^.with_template [ ] + [( idx) + (///////phase#in ( false idx)) + + ( idx nextP) + (|> nextP + again + (///////phase#each (_.then ( true idx))))]) + ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] + [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) + + (/////synthesis.member/left 0) + (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (/////synthesis.!bind_top register thenP) + (do ///////phase.monad + [then! (again thenP)] + (///////phase#in (all _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) + + (/////synthesis.!multi_pop nextP) + (.let [[extra_pops nextP'] (when.count_pops nextP)] + (do ///////phase.monad + [next! (again nextP')] + (///////phase#in (all _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) + + (/////synthesis.path/seq preP postP) + (do ///////phase.monad + [pre! (again preP) + post! (again postP)] + (in (all _.then + pre! + post!))) + + (/////synthesis.path/alt preP postP) + (do ///////phase.monad + [pre! (again preP) + post! (again postP) + g!once (..symbol "once") + g!continue? (..symbol "continue")] + (in (..alternation in_closure? g!once g!continue? pre! post!)))))))) + +(def (pattern_matching in_closure? statement expression archive pathP) + (-> Bit (Generator! Path)) + (do ///////phase.monad + [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) + g!once (..symbol "once") + g!continue? (..symbol "continue")] + (in (all _.then + (..with_looping in_closure? g!once g!continue? + pattern_matching!) + (_.statement (_.raise (_.string when.pattern_matching_error))))))) + +(def .public (when! in_closure? statement expression archive [valueS pathP]) + (-> Bit (Generator! [Synthesis Path])) + (do ///////phase.monad + [stack_init (expression archive valueS) + pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] + (in (all _.then + (_.set (list @cursor) (_.array (list stack_init))) + (_.set (list @savepoint) (_.array (list))) + pattern_matching! + )))) + +(def .public (when statement expression archive when) + (-> Phase! (Generator [Synthesis Path])) + (|> when + (when! true statement expression archive) + (at ///////phase.monad each + (|>> [(list)] (_.lambda {.#None}) + (_.apply_lambda (list)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme.lux index cdedd1a3d..e62788463 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme.lux @@ -13,7 +13,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" loop] ["[1][0]" function] ["/[1]" // @@ -30,7 +30,7 @@ (def .public (generate archive synthesis) Phase - (case synthesis + (when synthesis (^.with_template [ ] [( value) (//////phase#in ( value))]) @@ -47,12 +47,12 @@ ( generate archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] - [////synthesis.branch/let /case.let] - [////synthesis.branch/if /case.if] - [////synthesis.branch/get /case.get] + [////synthesis.branch/let /when.let] + [////synthesis.branch/if /when.if] + [////synthesis.branch/get /when.get] [////synthesis.function/apply /function.apply] - [////synthesis.branch/case /case.case] + [////synthesis.branch/when /when.when] [////synthesis.loop/scope /loop.scope] [////synthesis.loop/again /loop.again] [////synthesis.function/abstraction /function.function]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/case.lux deleted file mode 100644 index a1f679836..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/case.lux +++ /dev/null @@ -1,225 +0,0 @@ -(.require - [library - [lux (.except case let if) - [abstract - ["[0]" monad (.only do)]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set]]] - [math - [number - ["i" int]]] - [meta - [macro - ["^" pattern] - ["[0]" template]] - [target - ["_" scheme (.only Expression Computation Var)]]]]] - ["[0]" // - ["[1][0]" runtime (.only Operation Phase Generator)] - ["[1][0]" reference] - ["[1][0]" primitive] - ["/[1]" // - ["[1][0]" reference] - ["/[1]" // - ["[1][0]" synthesis - ["[1]/[0]" case]] - ["/[1]" // - ["[1][0]" synthesis (.only Member Synthesis Path)] - ["[1][0]" generation] - ["//[1]" /// - [reference - ["[1][0]" variable (.only Register)]] - ["[1][0]" phase (.use "[1]#[0]" monad)] - [meta - [archive (.only Archive)]]]]]]]) - -(def .public register - (-> Register Var) - (|>> (///reference.local //reference.system) as_expected)) - -(def .public capture - (-> Register Var) - (|>> (///reference.foreign //reference.system) as_expected)) - -(def .public (let expression archive [valueS register bodyS]) - (Generator [Synthesis Register Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS) - bodyO (expression archive bodyS)] - (in (_.let (list [(..register register) valueO]) - bodyO)))) - -(def .public (if expression archive [testS thenS elseS]) - (Generator [Synthesis Synthesis Synthesis]) - (do ///////phase.monad - [testO (expression archive testS) - thenO (expression archive thenS) - elseO (expression archive elseS)] - (in (_.if testO thenO elseO)))) - -(def .public (get expression archive [pathP valueS]) - (Generator [(List Member) Synthesis]) - (do ///////phase.monad - [valueO (expression archive valueS)] - (in (list#mix (function (_ side source) - (.let [method (.case side - (^.with_template [ ] - [( lefts) - ( (_.int (.int lefts)))]) - ([.#Left //runtime.tuple//left] - [.#Right //runtime.tuple//right]))] - (method source))) - valueO - (list.reversed pathP))))) - -(def @savepoint (_.var "lux_pm_cursor_savepoint")) -(def @cursor (_.var "lux_pm_cursor")) -(def @temp (_.var "lux_pm_temp")) -(def @alt_error (_.var "alt_error")) - -(def (push! value var) - (-> Expression Var Computation) - (_.set! var (_.cons/2 value var))) - -(def (push_cursor! value) - (-> Expression Computation) - (push! value @cursor)) - -(def (pop! var) - (-> Var Computation) - (_.set! var (_.cdr/1 var))) - -(def save_cursor! - Computation - (push! @cursor @savepoint)) - -(def restore_cursor! - Computation - (_.begin (list (_.set! @cursor (_.car/1 @savepoint)) - (_.set! @savepoint (_.cdr/1 @savepoint))))) - -(def peek - Computation - (_.car/1 @cursor)) - -(def pop_cursor! - Computation - (pop! @cursor)) - -(def pm_error - (_.string (template.with_locals [pm_error] - (template.text [pm_error])))) - -(def fail! - (_.raise/1 pm_error)) - -(def (try_pm on_failure happy_path) - (-> Expression Expression Computation) - (_.guard @alt_error - (list [(_.and (list (_.string?/1 @alt_error) - (_.string=?/2 ..pm_error @alt_error))) - on_failure]) - {.#None} - happy_path)) - -(def (pattern_matching' expression archive) - (Generator Path) - (function (again pathP) - (.case pathP - {/////synthesis.#Then bodyS} - (expression archive bodyS) - - {/////synthesis.#Pop} - (///////phase#in pop_cursor!) - - {/////synthesis.#Bind register} - (///////phase#in (_.define_constant (..register register) ..peek)) - - {/////synthesis.#Bit_Fork when thenP elseP} - (do [! ///////phase.monad] - [then! (again thenP) - else! (.case elseP - {.#Some elseP} - (again elseP) - - {.#None} - (in ..fail!))] - (in (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) - - (^.with_template [ <=>] - [{ item} - (do [! ///////phase.monad] - [clauses (monad.each ! (function (_ [match then]) - (do ! - [then! (again then)] - (in [(<=> (|> match ) - ..peek) - then!]))) - {.#Item item})] - (in (list#mix (function (_ [when then] else) - (_.if when then else)) - ..fail! - clauses)))]) - ([/////synthesis.#I64_Fork //primitive.i64 _.=/2] - [/////synthesis.#F64_Fork //primitive.f64 _.=/2] - [/////synthesis.#Text_Fork //primitive.text _.string=?/2]) - - (^.with_template [ ] - [( idx) - (///////phase#in (_.let (list [@temp (|> idx .int _.int (//runtime.sum//get ..peek (_.bool )))]) - (_.if (_.null?/1 @temp) - ..fail! - (push_cursor! @temp))))]) - ([/////synthesis.side/left false (<|)] - [/////synthesis.side/right true ++]) - - (/////synthesis.member/left 0) - (///////phase#in (..push_cursor! (_.vector_ref/2 ..peek (_.int +0)))) - - (^.with_template [ ] - [( lefts) - (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push_cursor!))]) - ([/////synthesis.member/left //runtime.tuple//left] - [/////synthesis.member/right //runtime.tuple//right]) - - (/////synthesis.path/seq leftP rightP) - (do ///////phase.monad - [leftO (again leftP) - rightO (again rightP)] - (in (_.begin (list leftO - rightO)))) - - (/////synthesis.path/alt leftP rightP) - (do [! ///////phase.monad] - [leftO (again leftP) - rightO (again rightP)] - (in (try_pm (_.begin (list restore_cursor! - rightO)) - (_.begin (list save_cursor! - leftO))))) - ))) - -(def (pattern_matching expression archive pathP) - (Generator Path) - (at ///////phase.monad each - (try_pm (_.raise/1 (_.string "Invalid expression for pattern-matching."))) - (pattern_matching' expression archive pathP))) - -(def .public (case expression archive [valueS pathP]) - (Generator [Synthesis Path]) - (do [! ///////phase.monad] - [valueO (expression archive valueS)] - (<| (at ! each (_.let (list [@cursor (_.list/* (list valueO))] - [@savepoint (_.list/* (list))]))) - (pattern_matching expression archive pathP)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/function.lux index cbddbab59..5688d5457 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/function.lux @@ -17,7 +17,7 @@ ["[0]" // ["[1][0]" runtime (.only Operation Phase Generator)] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["//[1]" /// @@ -44,7 +44,7 @@ (def (with_closure inits function_definition) (-> (List Expression) Computation (Operation Computation)) (///////phase#in - (case inits + (when inits {.#End} function_definition @@ -59,7 +59,7 @@ (def @missing (_.var "missing")) (def input - (|>> ++ //case.register)) + (|>> ++ //when.register)) (def .public (function expression archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) @@ -80,7 +80,7 @@ (_.letrec (list [@self (_.lambda [(list) {.#Some @curried}] (_.let (list [@num_args (_.length/1 @curried)]) (<| (_.if (|> @num_args (_.=/2 arityO)) - (<| (_.let (list [(//case.register 0) @self])) + (<| (_.let (list [(//when.register 0) @self])) (_.let_values (list [[(|> (list.indices arity) (list#each ..input)) {.#None}] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/loop.lux index d8cf4511e..451de1c90 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/loop.lux @@ -18,12 +18,12 @@ ["_" scheme]]]]] ["[0]" // [runtime (.only Operation Phase Generator)] - ["[1][0]" case] + ["[1][0]" when] ["/[1]" // ["[1][0]" reference] ["/[1]" // [synthesis - ["[0]" case]] + ["[0]" when]] ["/[1]" // ["[0]" synthesis (.only Scope Synthesis)] ["[1][0]" generation] @@ -39,7 +39,7 @@ (def .public (scope expression archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (case initsS+ + (when initsS+ ... function/false/non-independent loop {.#End} (expression archive bodyS) @@ -52,7 +52,7 @@ (expression archive bodyS))] (in (_.letrec (list [@scope (_.lambda [(|> initsS+ list.enumeration - (list#each (|>> product.left (n.+ start) //case.register))) + (list#each (|>> product.left (n.+ start) //when.register))) {.#None}] bodyO)]) (_.apply initsO+ @scope)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/runtime.lux index 31803cfab..e0eb242ec 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -81,7 +81,7 @@ (macro.with_symbols [g!_] (let [runtime (code.local (///reference.artifact [..module_id runtime_id])) runtime_name (` (_.var (, (code.text (%.code runtime)))))] - (case declaration + (when declaration {.#Left name} (let [g!name (code.local name)] (in (list (` (def .public (, g!name) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/structure.lux index e98aa8ff4..526b833ff 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/structure.lux @@ -20,7 +20,7 @@ (def .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) - (case elemsS+ + (when elemsS+ {.#End} (///////phase#in (//primitive.text /////synthesis.unit)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/when.lux new file mode 100644 index 000000000..b70ccef33 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/scheme/when.lux @@ -0,0 +1,225 @@ +(.require + [library + [lux (.except when let if) + [abstract + ["[0]" monad (.only do)]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set]]] + [math + [number + ["i" int]]] + [meta + [macro + ["^" pattern] + ["[0]" template]] + [target + ["_" scheme (.only Expression Computation Var)]]]]] + ["[0]" // + ["[1][0]" runtime (.only Operation Phase Generator)] + ["[1][0]" reference] + ["[1][0]" primitive] + ["/[1]" // + ["[1][0]" reference] + ["/[1]" // + ["[1][0]" synthesis + ["[1]/[0]" when]] + ["/[1]" // + ["[1][0]" synthesis (.only Member Synthesis Path)] + ["[1][0]" generation] + ["//[1]" /// + [reference + ["[1][0]" variable (.only Register)]] + ["[1][0]" phase (.use "[1]#[0]" monad)] + [meta + [archive (.only Archive)]]]]]]]) + +(def .public register + (-> Register Var) + (|>> (///reference.local //reference.system) as_expected)) + +(def .public capture + (-> Register Var) + (|>> (///reference.foreign //reference.system) as_expected)) + +(def .public (let expression archive [valueS register bodyS]) + (Generator [Synthesis Register Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS) + bodyO (expression archive bodyS)] + (in (_.let (list [(..register register) valueO]) + bodyO)))) + +(def .public (if expression archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do ///////phase.monad + [testO (expression archive testS) + thenO (expression archive thenS) + elseO (expression archive elseS)] + (in (_.if testO thenO elseO)))) + +(def .public (get expression archive [pathP valueS]) + (Generator [(List Member) Synthesis]) + (do ///////phase.monad + [valueO (expression archive valueS)] + (in (list#mix (function (_ side source) + (.let [method (.when side + (^.with_template [ ] + [( lefts) + ( (_.int (.int lefts)))]) + ([.#Left //runtime.tuple//left] + [.#Right //runtime.tuple//right]))] + (method source))) + valueO + (list.reversed pathP))))) + +(def @savepoint (_.var "lux_pm_cursor_savepoint")) +(def @cursor (_.var "lux_pm_cursor")) +(def @temp (_.var "lux_pm_temp")) +(def @alt_error (_.var "alt_error")) + +(def (push! value var) + (-> Expression Var Computation) + (_.set! var (_.cons/2 value var))) + +(def (push_cursor! value) + (-> Expression Computation) + (push! value @cursor)) + +(def (pop! var) + (-> Var Computation) + (_.set! var (_.cdr/1 var))) + +(def save_cursor! + Computation + (push! @cursor @savepoint)) + +(def restore_cursor! + Computation + (_.begin (list (_.set! @cursor (_.car/1 @savepoint)) + (_.set! @savepoint (_.cdr/1 @savepoint))))) + +(def peek + Computation + (_.car/1 @cursor)) + +(def pop_cursor! + Computation + (pop! @cursor)) + +(def pm_error + (_.string (template.with_locals [pm_error] + (template.text [pm_error])))) + +(def fail! + (_.raise/1 pm_error)) + +(def (try_pm on_failure happy_path) + (-> Expression Expression Computation) + (_.guard @alt_error + (list [(_.and (list (_.string?/1 @alt_error) + (_.string=?/2 ..pm_error @alt_error))) + on_failure]) + {.#None} + happy_path)) + +(def (pattern_matching' expression archive) + (Generator Path) + (function (again pathP) + (.when pathP + {/////synthesis.#Then bodyS} + (expression archive bodyS) + + {/////synthesis.#Pop} + (///////phase#in pop_cursor!) + + {/////synthesis.#Bind register} + (///////phase#in (_.define_constant (..register register) ..peek)) + + {/////synthesis.#Bit_Fork when thenP elseP} + (do [! ///////phase.monad] + [then! (again thenP) + else! (.when elseP + {.#Some elseP} + (again elseP) + + {.#None} + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) + + (^.with_template [ <=>] + [{ item} + (do [! ///////phase.monad] + [clauses (monad.each ! (function (_ [match then]) + (do ! + [then! (again then)] + (in [(<=> (|> match ) + ..peek) + then!]))) + {.#Item item})] + (in (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail! + clauses)))]) + ([/////synthesis.#I64_Fork //primitive.i64 _.=/2] + [/////synthesis.#F64_Fork //primitive.f64 _.=/2] + [/////synthesis.#Text_Fork //primitive.text _.string=?/2]) + + (^.with_template [ ] + [( idx) + (///////phase#in (_.let (list [@temp (|> idx .int _.int (//runtime.sum//get ..peek (_.bool )))]) + (_.if (_.null?/1 @temp) + ..fail! + (push_cursor! @temp))))]) + ([/////synthesis.side/left false (<|)] + [/////synthesis.side/right true ++]) + + (/////synthesis.member/left 0) + (///////phase#in (..push_cursor! (_.vector_ref/2 ..peek (_.int +0)))) + + (^.with_template [ ] + [( lefts) + (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push_cursor!))]) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (/////synthesis.path/seq leftP rightP) + (do ///////phase.monad + [leftO (again leftP) + rightO (again rightP)] + (in (_.begin (list leftO + rightO)))) + + (/////synthesis.path/alt leftP rightP) + (do [! ///////phase.monad] + [leftO (again leftP) + rightO (again rightP)] + (in (try_pm (_.begin (list restore_cursor! + rightO)) + (_.begin (list save_cursor! + leftO))))) + ))) + +(def (pattern_matching expression archive pathP) + (Generator Path) + (at ///////phase.monad each + (try_pm (_.raise/1 (_.string "Invalid expression for pattern-matching."))) + (pattern_matching' expression archive pathP))) + +(def .public (when expression archive [valueS pathP]) + (Generator [Synthesis Path]) + (do [! ///////phase.monad] + [valueO (expression archive valueS)] + (<| (at ! each (_.let (list [@cursor (_.list/* (list valueO))] + [@savepoint (_.list/* (list))]))) + (pattern_matching expression archive pathP)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux index b21dbdaae..fba249351 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux @@ -15,7 +15,7 @@ ["^" pattern]]]]] ["[0]" / ["[1][0]" function] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" variable] ["/[1]" // ["[1][0]" extension] @@ -32,7 +32,7 @@ (def (simple analysis) (-> ///simple.Simple /simple.Simple) - (case analysis + (when analysis {///simple.#Unit} {/simple.#Text /.unit} @@ -53,7 +53,7 @@ (def (optimization archive) Phase (function (optimization' analysis) - (case analysis + (when analysis {///analysis.#Simple analysis'} (phase#in {/.#Simple (..simple analysis')}) @@ -62,7 +62,7 @@ {///analysis.#Structure structure} (/.with_currying? false - (case structure + (when structure {///complex.#Variant variant} (do phase.monad [valueS (optimization' (the ///complex.#value variant))] @@ -73,9 +73,9 @@ (monad.each phase.monad optimization') (phase#each (|>> /.tuple))))) - {///analysis.#Case inputA branchesAB+} + {///analysis.#When inputA branchesAB+} (/.with_currying? false - (/case.synthesize optimization branchesAB+ archive inputA)) + (/when.synthesize optimization branchesAB+ archive inputA)) (///analysis.no_op value) (optimization' value) @@ -92,7 +92,7 @@ (function (_ state) (|> (//extension.apply archive optimization [name args]) (phase.result' state) - (pipe.case + (pipe.when {try.#Success output} {try.#Success output} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/case.lux deleted file mode 100644 index d6d6f31ed..000000000 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/case.lux +++ /dev/null @@ -1,467 +0,0 @@ -(.require - [library - [lux (.except Pattern) - [abstract - [equivalence (.only Equivalence)] - ["[0]" monad (.only do)]] - [control - ["[0]" pipe]] - [data - ["[0]" product] - ["[0]" bit (.use "[1]#[0]" equivalence)] - ["[0]" text (.use "[1]#[0]" equivalence)] - [collection - ["[0]" list (.use "[1]#[0]" functor mix monoid)] - ["[0]" set (.only Set)]]] - [math - [number - ["n" nat] - ["[0]" i64] - ["[0]" frac]]] - [meta - [macro - ["^" pattern]]]]] - ["[0]" /// - [// - ["[1][0]" analysis (.only Match Analysis) - ["[2][0]" simple] - ["[2][0]" complex] - ["[2][0]" pattern (.only Pattern)]] - ["/" synthesis (.only Path Synthesis Operation Phase) - ["[1][0]" access (.only) - ["[2][0]" side] - ["[2][0]" member (.only Member)]]] - [/// - ["[1]" phase (.use "[1]#[0]" monad)] - ["[1][0]" reference (.only) - ["[1]/[0]" variable (.only Register Variable)]] - [meta - [archive (.only Archive)]]]]]) - -(def clean_up - (-> Path Path) - (|>> {/.#Seq {/.#Pop}})) - -(def (path' pattern end? thenC) - (-> Pattern Bit (Operation Path) (Operation Path)) - (case pattern - {///pattern.#Simple simple} - (case simple - {///simple.#Unit} - thenC - - {///simple.#Bit when} - (///#each (function (_ then) - {/.#Bit_Fork when then {.#None}}) - thenC) - - (^.with_template [ ] - [{ test} - (///#each (function (_ then) - { [( test) then] (list)}) - thenC)]) - ([///simple.#Nat /.#I64_Fork .i64] - [///simple.#Int /.#I64_Fork .i64] - [///simple.#Rev /.#I64_Fork .i64] - [///simple.#Frac /.#F64_Fork |>] - [///simple.#Text /.#Text_Fork |>])) - - {///pattern.#Bind register} - (<| (at ///.monad each (|>> {/.#Seq {/.#Bind register}})) - /.with_new_local - thenC) - - {///pattern.#Complex {///complex.#Variant [lefts right? value_pattern]}} - (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Side [/side.#lefts lefts - /side.#right? right?]}}})) - (path' value_pattern end?) - (pipe.when [(pipe.new (not end?) [])] [(///#each ..clean_up)]) - thenC) - - {///pattern.#Complex {///complex.#Tuple tuple}} - (let [tuple::last (-- (list.size tuple))] - (list#mix (function (_ [tuple::lefts tuple::member] nextC) - (.case tuple::member - {///pattern.#Simple {///simple.#Unit}} - nextC - - _ - (let [right? (n.= tuple::last tuple::lefts) - end?' (and end? right?)] - (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Member [/member.#lefts (if right? - (-- tuple::lefts) - tuple::lefts) - /member.#right? right?]}}})) - (path' tuple::member end?') - (pipe.when [(pipe.new (not end?') [])] [(///#each ..clean_up)]) - nextC)))) - thenC - (list.reversed (list.enumeration tuple)))) - )) - -(def (path archive synthesize pattern bodyA) - (-> Archive Phase Pattern Analysis (Operation Path)) - (path' pattern true (///#each (|>> {/.#Then}) (synthesize archive bodyA)))) - -(def (weave_branch weave equivalence [new_test new_then] [[old_test old_then] old_tail]) - (All (_ a) - (-> (-> Path Path Path) (Equivalence a) [a Path] (/.Fork a Path) - (/.Fork a Path))) - (if (at equivalence = new_test old_test) - [[old_test (weave new_then old_then)] old_tail] - [[old_test old_then] - (case old_tail - {.#End} - (list [new_test new_then]) - - {.#Item old_item} - {.#Item (weave_branch weave equivalence [new_test new_then] old_item)})])) - -(def (weave_fork weave equivalence new_fork old_fork) - (All (_ a) - (-> (-> Path Path Path) (Equivalence a) (/.Fork a Path) (/.Fork a Path) - (/.Fork a Path))) - (list#mix (..weave_branch weave equivalence) old_fork {.#Item new_fork})) - -(def (weave new old) - (-> Path Path Path) - (with_expansions [ (these {/.#Alt old new})] - (case [new old] - [_ - {/.#Alt old_left old_right}] - {/.#Alt old_left - (weave new old_right)} - - [{/.#Seq preN postN} - {/.#Seq preO postO}] - (case (weave preN preO) - {/.#Alt _} - - - woven - {/.#Seq woven (weave postN postO)}) - - [{/.#Pop} {/.#Pop}] - old - - [{/.#Bit_Fork new_when new_then new_else} - {/.#Bit_Fork old_when old_then old_else}] - (if (bit#= new_when old_when) - {/.#Bit_Fork old_when - (weave new_then old_then) - (case [new_else old_else] - [{.#None} {.#None}] - {.#None} - - (^.or [{.#Some woven_then} {.#None}] - [{.#None} {.#Some woven_then}]) - {.#Some woven_then} - - [{.#Some new_else} {.#Some old_else}] - {.#Some (weave new_else old_else)})} - {/.#Bit_Fork old_when - (case new_else - {.#None} - old_then - - {.#Some new_else} - (weave new_else old_then)) - {.#Some (case old_else - {.#None} - new_then - - {.#Some old_else} - (weave new_then old_else))}}) - - (^.with_template [ ] - [[{ new_fork} { old_fork}] - { (..weave_fork weave new_fork old_fork)}]) - ([/.#I64_Fork i64.equivalence] - [/.#F64_Fork frac.equivalence] - [/.#Text_Fork text.equivalence]) - - (^.with_template [ ] - [[{/.#Access { [ newL ]}} - {/.#Access { [ oldL ]}}] - (if (n.= newL oldL) - old - )]) - ([/access.#Side .false /side.#lefts /side.#right?] - [/access.#Side .true /side.#lefts /side.#right?] - - [/access.#Member .false /member.#lefts /member.#right?] - [/access.#Member .true /member.#lefts /member.#right?]) - - [{/.#Bind newR} {/.#Bind oldR}] - (if (n.= newR oldR) - old - ) - - _ - ))) - -(def (get patterns @selection) - (-> (///complex.Tuple Pattern) Register (List Member)) - (loop (again [lefts 0 - patterns patterns]) - (with_expansions [ (these (list)) - (these (again (++ lefts) - tail)) - (these (let [right? (list.empty? tail)] - [/member.#lefts (if right? - (-- lefts) - lefts) - /member.#right? right?]))] - (case patterns - {.#End} - - - {.#Item head tail} - (case head - {///pattern.#Simple {///simple.#Unit}} - - - {///pattern.#Bind register} - (if (n.= @selection register) - (list ) - ) - - {///pattern.#Complex {///complex.#Tuple sub_patterns}} - (case (get sub_patterns @selection) - {.#End} - - - sub_members - (list.partial sub_members)) - - _ - ))))) - -(def .public (synthesize_case synthesize archive input [[headP headA] tailPA+]) - (-> Phase Archive Synthesis Match (Operation Synthesis)) - (do [! ///.monad] - [headSP (path archive synthesize headP headA) - tailSP+ (monad.each ! (product.uncurried (path archive synthesize)) tailPA+)] - (in (/.branch/case [input (list#mix weave headSP tailSP+)])))) - -(def !masking - (template (_ ) - [[[{///pattern.#Bind } - {///analysis.#Reference (///reference.local )}] - (list)]])) - -(def .public (synthesize_exec synthesize archive before after) - (-> Phase Archive Synthesis Analysis (Operation Synthesis)) - (do ///.monad - [after (synthesize archive after)] - (in (/.branch/exec [before after])))) - -(def .public (synthesize_let synthesize archive input @variable body) - (-> Phase Archive Synthesis Register Analysis (Operation Synthesis)) - (do ///.monad - [body (/.with_new_local - (synthesize archive body))] - (in (/.branch/let [input @variable body])))) - -(def .public (synthesize_masking synthesize archive input @variable @output) - (-> Phase Archive Synthesis Register Register (Operation Synthesis)) - (if (n.= @variable @output) - (///#in input) - (..synthesize_let synthesize archive input @variable {///analysis.#Reference (///reference.local @output)}))) - -(def .public (synthesize_if synthesize archive test then else) - (-> Phase Archive Synthesis Analysis Analysis (Operation Synthesis)) - (do ///.monad - [then (synthesize archive then) - else (synthesize archive else)] - (in (/.branch/if [test then else])))) - -(def !get - (template (_ ) - [[[(///pattern.tuple ) - {///analysis.#Reference (///reference.local )}] - (.list)]])) - -(def .public (synthesize_get synthesize archive input patterns @member) - (-> Phase Archive Synthesis (///complex.Tuple Pattern) Register (Operation Synthesis)) - (case (..get patterns @member) - {.#End} - (..synthesize_case synthesize archive input (!get patterns @member)) - - path - (case input - (/.branch/get [sub_path sub_input]) - (///#in (/.branch/get [(list#composite path sub_path) sub_input])) - - _ - (///#in (/.branch/get [path input]))))) - -(def .public (synthesize synthesize^ [headB tailB+] archive inputA) - (-> Phase Match Phase) - (do [! ///.monad] - [inputS (synthesize^ archive inputA)] - (case [headB tailB+] - (!masking @variable @output) - (..synthesize_masking synthesize^ archive inputS @variable @output) - - [[(///pattern.unit) body] - {.#End}] - (case inputA - (^.or {///analysis.#Simple _} - {///analysis.#Structure _} - {///analysis.#Reference _}) - (synthesize^ archive body) - - _ - (..synthesize_exec synthesize^ archive inputS body)) - - [[{///pattern.#Bind @variable} body] - {.#End}] - (..synthesize_let synthesize^ archive inputS @variable body) - - (^.or [[(///pattern.bit .true) then] - (list [(///pattern.bit .false) else])] - [[(///pattern.bit .true) then] - (list [(///pattern.unit) else])] - - [[(///pattern.bit .false) else] - (list [(///pattern.bit .true) then])] - [[(///pattern.bit .false) else] - (list [(///pattern.unit) then])]) - (..synthesize_if synthesize^ archive inputS then else) - - (!get patterns @member) - (..synthesize_get synthesize^ archive inputS patterns @member) - - match - (..synthesize_case synthesize^ archive inputS match)))) - -(def .public (count_pops path) - (-> Path [Nat Path]) - (case path - (/.path/seq {/.#Pop} path') - (let [[pops post_pops] (count_pops path')] - [(++ pops) post_pops]) - - _ - [0 path])) - -(def .public pattern_matching_error - "Invalid expression for pattern-matching.") - -(type .public Storage - (Record - [#bindings (Set Register) - #dependencies (Set Variable)])) - -(def empty - Storage - [#bindings (set.empty n.hash) - #dependencies (set.empty ///reference/variable.hash)]) - -... TODO: Use this to declare all local variables at the beginning of -... script functions. -... That way, it should be possible to do cheap "let" expressions, -... since the variable will exist beforehand, so no closure will need -... to be created for it. -... Apply this trick to JS, Python et al. -(def .public (storage path) - (-> Path Storage) - (loop (for_path [path path - path_storage ..empty]) - (case path - (^.or {/.#Pop} - {/.#Access Access}) - path_storage - - (/.path/bind register) - (revised #bindings (set.has register) - path_storage) - - {/.#Bit_Fork _ default otherwise} - (|> (case otherwise - {.#None} - path_storage - - {.#Some otherwise} - (for_path otherwise path_storage)) - (for_path default)) - - (^.or {/.#I64_Fork forks} - {/.#F64_Fork forks} - {/.#Text_Fork forks}) - (|> {.#Item forks} - (list#each product.right) - (list#mix for_path path_storage)) - - (^.or (/.path/seq left right) - (/.path/alt left right)) - (list#mix for_path path_storage (list left right)) - - (/.path/then bodyS) - (loop (for_synthesis [bodyS bodyS - synthesis_storage path_storage]) - (case bodyS - (^.or {/.#Simple _} - (/.constant _)) - synthesis_storage - - (/.variant [lefts right? valueS]) - (for_synthesis valueS synthesis_storage) - - (/.tuple members) - (list#mix for_synthesis synthesis_storage members) - - {/.#Reference {///reference.#Variable {///reference/variable.#Local register}}} - (if (set.member? (the #bindings synthesis_storage) register) - synthesis_storage - (revised #dependencies (set.has {///reference/variable.#Local register}) synthesis_storage)) - - {/.#Reference {///reference.#Variable var}} - (revised #dependencies (set.has var) synthesis_storage) - - (/.function/apply [functionS argsS]) - (list#mix for_synthesis synthesis_storage {.#Item functionS argsS}) - - (/.function/abstraction [environment arity bodyS]) - (list#mix for_synthesis synthesis_storage environment) - - (/.branch/case [inputS pathS]) - (revised #dependencies - (set.union (the #dependencies (for_path pathS synthesis_storage))) - (for_synthesis inputS synthesis_storage)) - - (/.branch/exec [before after]) - (list#mix for_synthesis synthesis_storage (list before after)) - - (/.branch/let [inputS register exprS]) - (revised #dependencies - (set.union (|> synthesis_storage - (revised #bindings (set.has register)) - (for_synthesis exprS) - (the #dependencies))) - (for_synthesis inputS synthesis_storage)) - - (/.branch/if [testS thenS elseS]) - (list#mix for_synthesis synthesis_storage (list testS thenS elseS)) - - (/.branch/get [access whole]) - (for_synthesis whole synthesis_storage) - - (/.loop/scope [start initsS+ iterationS]) - (revised #dependencies - (set.union (|> synthesis_storage - (revised #bindings (set.union (|> initsS+ - list.enumeration - (list#each (|>> product.left (n.+ start))) - (set.of_list n.hash)))) - (for_synthesis iterationS) - (the #dependencies))) - (list#mix for_synthesis synthesis_storage initsS+)) - - (/.loop/again replacementsS+) - (list#mix for_synthesis synthesis_storage replacementsS+) - - {/.#Extension [extension argsS]} - (list#mix for_synthesis synthesis_storage argsS))) - ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux index e9507024a..c1a6184d1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux @@ -59,7 +59,7 @@ [funcS (phase archive funcA) argsS (monad.each ! (phase archive) argsA)] (with_expansions [ (these (/.function/apply [funcS argsS]))] - (case funcS + (when funcS (/.function/abstraction functionS) (if (n.= (the /.#arity functionS) (list.size argsS)) @@ -69,7 +69,7 @@ (//loop.optimization true locals argsS) (maybe#each (is (-> [Nat (List Synthesis) Synthesis] Synthesis) (function (_ [start inits iteration]) - (case iteration + (when iteration (/.loop/scope [start' inits' output]) (if (and (n.= start start') (list.empty? inits')) @@ -89,7 +89,7 @@ (def (find_foreign environment register) (-> (Environment Synthesis) Register (Operation Synthesis)) - (case (list.item register environment) + (when (list.item register environment) {.#Some aliased} (phase#in aliased) @@ -98,7 +98,7 @@ (def (grow_path grow path) (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) - (case path + (when path {/.#Bind register} (phase#in {/.#Bind (++ register)}) @@ -110,16 +110,16 @@ (in { left' right'}))]) ([/.#Alt] [/.#Seq]) - {/.#Bit_Fork when then else} + {/.#Bit_Fork test then else} (do [! phase.monad] [then (grow_path grow then) - else (case else + else (when else {.#Some else} (at ! each (|>> {.#Some}) (grow_path grow else)) {.#None} (in {.#None}))] - (in {/.#Bit_Fork when then else})) + (in {/.#Bit_Fork test then else})) (^.with_template [] [{ [[test then] elses]} @@ -145,9 +145,9 @@ (def (grow environment expression) (-> (Environment Synthesis) Synthesis (Operation Synthesis)) - (case expression + (when expression {/.#Structure structure} - (case structure + (when structure {////analysis/complex.#Variant [lefts right? subS]} (|> subS (grow environment) @@ -162,9 +162,9 @@ (phase#in (/.function/apply [expression (list (/.variable/local 1))])) {/.#Reference reference} - (case reference + (when reference {////reference.#Variable variable} - (case variable + (when variable {////reference/variable.#Local register} (phase#in (/.variable/local (++ register))) @@ -175,9 +175,9 @@ (phase#in expression)) {/.#Control control} - (case control + (when control {/.#Branch branch} - (case branch + (when branch {/.#Exec [this that]} (do phase.monad [this (grow environment this) @@ -202,14 +202,14 @@ [inputS' (grow environment inputS)] (in (/.branch/get [members inputS']))) - {/.#Case [inputS pathS]} + {/.#When [inputS pathS]} (do phase.monad [inputS' (grow environment inputS) pathS' (grow_path (grow environment) pathS)] - (in (/.branch/case [inputS' pathS'])))) + (in (/.branch/when [inputS' pathS'])))) {/.#Loop loop} - (case loop + (when loop {/.#Scope [start initsS+ iterationS]} (do [! phase.monad] [initsS+' (monad.each ! (grow environment) initsS+) @@ -222,11 +222,11 @@ (phase#each (|>> /.loop/again)))) {/.#Function function} - (case function + (when function {/.#Abstraction [_env _arity _body]} (do [! phase.monad] [_env' (monad.each ! - (|>> (pipe.case + (|>> (pipe.when {/.#Reference {////reference.#Variable {////reference/variable.#Foreign register}}} (..find_foreign environment register) @@ -239,7 +239,7 @@ (do [! phase.monad] [funcS (grow environment funcS) argsS+ (monad.each ! (grow environment) argsS+)] - (in (/.function/apply (case funcS + (in (/.function/apply (when funcS (/.function/apply [(..self_reference) pre_argsS+]) [(..self_reference) (list#composite pre_argsS+ argsS+)] @@ -264,7 +264,7 @@ (/.with_locals 2 (phase archive bodyA))) abstraction (is (Operation Abstraction) - (case bodyS + (when bodyS (/.function/abstraction [env' down_arity' bodyS']) (|> bodyS' (grow env') @@ -281,7 +281,7 @@ (in (/.function/abstraction (if currying? abstraction - (case (//loop.optimization false 1 (list) abstraction) + (when (//loop.optimization false 1 (list) abstraction) {.#Some [startL initsL bodyL]} [/.#environment environment /.#arity (the /.#arity abstraction) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux index c967930bf..0ae8912f8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux @@ -33,7 +33,7 @@ (def (path_optimization body_optimization offset) (-> (Transform Synthesis) Register (Transform Path)) (function (again path) - (case path + (when path {/.#Bind register} {.#Some {/.#Bind (register_optimization offset register)}} @@ -45,16 +45,16 @@ (in { left' right'}))]) ([/.#Alt] [/.#Seq]) - {/.#Bit_Fork when then else} + {/.#Bit_Fork test then else} (do [! maybe.monad] [then (again then) - else (case else + else (when else {.#Some else} (at ! each (|>> {.#Some}) (again else)) {.#None} (in {.#None}))] - (in {/.#Bit_Fork when then else})) + (in {/.#Bit_Fork test then else})) (^.with_template [] [{ [[test then] elses]} @@ -82,12 +82,12 @@ (-> Bit Register (Environment Synthesis) Arity (Transform Synthesis)) (loop (again [return? true expr expr]) - (case expr + (when expr {/.#Simple _} {.#Some expr} {/.#Structure structure} - (case structure + (when structure {analysis/complex.#Variant variant} (do maybe.monad [value' (|> variant (the analysis/complex.#value) (again false))] @@ -101,7 +101,7 @@ (maybe#each (|>> /.tuple)))) {/.#Reference reference} - (case reference + (when reference {reference.#Variable (variable.self)} (if true_loop? {.#None} @@ -118,11 +118,11 @@ (list.item register scope_environment) {.#Some expr})) - (/.branch/case [input path]) + (/.branch/when [input path]) (do maybe.monad [input' (again false input) path' (path_optimization (again return?) offset path)] - (in (|> path' [input'] /.branch/case))) + (in (|> path' [input'] /.branch/when))) (/.branch/exec [this that]) (do maybe.monad @@ -174,7 +174,7 @@ (with_expansions [ (these (do ! [abstraction' (again false abstraction)] (in (/.function/apply [abstraction' arguments']))))] - (case abstraction + (when abstraction {/.#Reference {reference.#Variable (variable.self)}} (if (and return? (n.= arity (list.size arguments))) @@ -193,7 +193,7 @@ [input (again false input) matches (monad.each ! (function (_ match) - (case match + (when match {/.#Structure {analysis/complex.#Tuple (list when then)}} (do ! [when (again false when) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux index f6ef820af..0f0d88bdd 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux @@ -43,7 +43,7 @@ (def (remove_local_from_path remove_local redundant) (-> (Remover Synthesis) (Remover Path)) (function (again path) - (case path + (when path {/.#Seq {/.#Bind register} post} (if (n.= redundant register) @@ -101,7 +101,7 @@ (def (remove_local_from_variable redundant variable) (Remover Variable) - (case variable + (when variable {variable.#Local register} {variable.#Local (..prune redundant register)} @@ -111,12 +111,12 @@ (def (remove_local redundant) (Remover Synthesis) (function (again synthesis) - (case synthesis + (when synthesis {/.#Simple _} synthesis {/.#Structure structure} - {/.#Structure (case structure + {/.#Structure (when structure {analysis/complex.#Variant [lefts right value]} {analysis/complex.#Variant [lefts right (again value)]} @@ -124,7 +124,7 @@ {analysis/complex.#Tuple (list#each again tuple)})} {/.#Reference reference} - (case reference + (when reference {reference.#Variable variable} (/.variable (..remove_local_from_variable redundant variable)) @@ -132,9 +132,9 @@ synthesis) {/.#Control control} - {/.#Control (case control + {/.#Control (when control {/.#Branch branch} - {/.#Branch (case branch + {/.#Branch (when branch {/.#Exec this that} {/.#Exec (again this) (again that)} @@ -150,11 +150,11 @@ {/.#Get path record} {/.#Get path (again record)} - {/.#Case input path} - {/.#Case (again input) (remove_local_from_path remove_local redundant path)})} + {/.#When input path} + {/.#When (again input) (remove_local_from_path remove_local redundant path)})} {/.#Loop loop} - {/.#Loop (case loop + {/.#Loop (when loop {/.#Scope [start inits iteration]} {/.#Scope [(..prune redundant start) (list#each again inits) @@ -164,7 +164,7 @@ {/.#Again (list#each again resets)})} {/.#Function function} - {/.#Function (case function + {/.#Function (when function {/.#Abstraction [environment arity body]} {/.#Abstraction [(list#each again environment) arity @@ -205,7 +205,7 @@ (def (list_optimization optimization) (All (_ a) (-> (Optimization a) (Optimization (List a)))) (function (again [redundancy values]) - (case values + (when values {.#End} {try.#Success [redundancy values]} @@ -228,7 +228,7 @@ (def (declare register redundancy) (-> Register Redundancy (Try Redundancy)) - (case (dictionary.value register redundancy) + (when (dictionary.value register redundancy) {.#None} {try.#Success (dictionary.has register ..redundant! redundancy)} @@ -237,7 +237,7 @@ (def (observe register redundancy) (-> Register Redundancy (Try Redundancy)) - (case (dictionary.value register redundancy) + (when (dictionary.value register redundancy) {.#None} (exception.except ..unknown_register [register]) @@ -255,16 +255,16 @@ (def (path_optimization optimization) (-> (Optimization Synthesis) (Optimization Path)) (function (again [redundancy path]) - (case path + (when path (^.or {/.#Pop} {/.#Access _}) {try.#Success [redundancy path]} - {/.#Bit_Fork when then else} + {/.#Bit_Fork test then else} (do [! try.monad] [[redundancy then] (again [redundancy then]) - [redundancy else] (case else + [redundancy else] (when else {.#Some else} (at ! each (function (_ [redundancy else]) @@ -273,7 +273,7 @@ {.#None} (in [redundancy {.#None}]))] - (in [redundancy {/.#Bit_Fork when then else}])) + (in [redundancy {/.#Bit_Fork test then else}])) (^.with_template [ ] [{ [[test then] elses]} @@ -334,12 +334,12 @@ (Optimization Synthesis) (with_expansions [ (these {try.#Success [redundancy synthesis]})] - (case synthesis + (when synthesis {/.#Simple _} {/.#Structure structure} - (case structure + (when structure {analysis/complex.#Variant [lefts right value]} (do try.monad [[redundancy value] (optimization' [redundancy value])] @@ -353,9 +353,9 @@ {/.#Structure {analysis/complex.#Tuple tuple}}]))) {/.#Reference reference} - (case reference + (when reference {reference.#Variable variable} - (case variable + (when variable {variable.#Local register} (do try.monad [redundancy (..observe register redundancy)] @@ -368,9 +368,9 @@ ) {/.#Control control} - (case control + (when control {/.#Branch branch} - (case branch + (when branch {/.#Exec this that} (do try.monad [[redundancy this] (optimization' [redundancy this]) @@ -405,15 +405,15 @@ (in [redundancy {/.#Control {/.#Branch {/.#Get path record}}}])) - {/.#Case input path} + {/.#When input path} (do try.monad [[redundancy input] (optimization' [redundancy input]) [redundancy path] (..path_optimization optimization' [redundancy path])] (in [redundancy - {/.#Control {/.#Branch {/.#Case input path}}}]))) + {/.#Control {/.#Branch {/.#When input path}}}]))) {/.#Loop loop} - (case loop + (when loop {/.#Scope [start inits iteration]} (do try.monad [[redundancy inits] (..list_optimization optimization' [redundancy inits]) @@ -429,7 +429,7 @@ {/.#Control {/.#Loop {/.#Again resets}}}]))) {/.#Function function} - (case function + (when function {/.#Abstraction [environment arity body]} (do [! try.monad] [[redundancy environment] (..list_optimization optimization' [redundancy environment]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux new file mode 100644 index 000000000..c41a41da0 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux @@ -0,0 +1,471 @@ +(.require + [library + [lux (.except Pattern) + [abstract + [equivalence (.only Equivalence)] + ["[0]" monad (.only do)]] + [control + ["[0]" pipe]] + [data + ["[0]" product] + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list (.use "[1]#[0]" functor mix monoid)] + ["[0]" set (.only Set)]]] + [math + [number + ["n" nat] + ["[0]" i64] + ["[0]" frac]]] + [meta + [macro + ["^" pattern]]]]] + ["[0]" /// + [// + ["[1][0]" analysis (.only Match Analysis) + ["[2][0]" simple] + ["[2][0]" complex] + ["[2][0]" pattern (.only Pattern)]] + ["/" synthesis (.only Path Synthesis Operation Phase) + ["[1][0]" access (.only) + ["[2][0]" side] + ["[2][0]" member (.only Member)]]] + [/// + ["[1]" phase (.use "[1]#[0]" monad)] + ["[1][0]" reference (.only) + ["[1]/[0]" variable (.only Register Variable)]] + [meta + [archive (.only Archive)]]]]]) + +(def clean_up + (-> Path Path) + (|>> {/.#Seq {/.#Pop}})) + +(def (path' pattern end? thenC) + (-> Pattern Bit (Operation Path) (Operation Path)) + (when pattern + {///pattern.#Simple simple} + (when simple + {///simple.#Unit} + thenC + + {///simple.#Bit when} + (///#each (function (_ then) + {/.#Bit_Fork when then {.#None}}) + thenC) + + (^.with_template [ ] + [{ test} + (///#each (function (_ then) + { [( test) then] (list)}) + thenC)]) + ([///simple.#Nat /.#I64_Fork .i64] + [///simple.#Int /.#I64_Fork .i64] + [///simple.#Rev /.#I64_Fork .i64] + [///simple.#Frac /.#F64_Fork |>] + [///simple.#Text /.#Text_Fork |>])) + + {///pattern.#Bind register} + (<| (at ///.monad each (|>> {/.#Seq {/.#Bind register}})) + /.with_new_local + thenC) + + {///pattern.#Complex {///complex.#Variant [lefts right? value_pattern]}} + (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Side [/side.#lefts lefts + /side.#right? right?]}}})) + (path' value_pattern end?) + (pipe.if [(pipe.new (not end?) [])] + [(///#each ..clean_up)] + []) + thenC) + + {///pattern.#Complex {///complex.#Tuple tuple}} + (let [tuple::last (-- (list.size tuple))] + (list#mix (function (_ [tuple::lefts tuple::member] nextC) + (.when tuple::member + {///pattern.#Simple {///simple.#Unit}} + nextC + + _ + (let [right? (n.= tuple::last tuple::lefts) + end?' (and end? right?)] + (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Member [/member.#lefts (if right? + (-- tuple::lefts) + tuple::lefts) + /member.#right? right?]}}})) + (path' tuple::member end?') + (pipe.if [(pipe.new (not end?') [])] + [(///#each ..clean_up)] + []) + nextC)))) + thenC + (list.reversed (list.enumeration tuple)))) + )) + +(def (path archive synthesize pattern bodyA) + (-> Archive Phase Pattern Analysis (Operation Path)) + (path' pattern true (///#each (|>> {/.#Then}) (synthesize archive bodyA)))) + +(def (weave_branch weave equivalence [new_test new_then] [[old_test old_then] old_tail]) + (All (_ a) + (-> (-> Path Path Path) (Equivalence a) [a Path] (/.Fork a Path) + (/.Fork a Path))) + (if (at equivalence = new_test old_test) + [[old_test (weave new_then old_then)] old_tail] + [[old_test old_then] + (when old_tail + {.#End} + (list [new_test new_then]) + + {.#Item old_item} + {.#Item (weave_branch weave equivalence [new_test new_then] old_item)})])) + +(def (weave_fork weave equivalence new_fork old_fork) + (All (_ a) + (-> (-> Path Path Path) (Equivalence a) (/.Fork a Path) (/.Fork a Path) + (/.Fork a Path))) + (list#mix (..weave_branch weave equivalence) old_fork {.#Item new_fork})) + +(def (weave new old) + (-> Path Path Path) + (with_expansions [ (these {/.#Alt old new})] + (when [new old] + [_ + {/.#Alt old_left old_right}] + {/.#Alt old_left + (weave new old_right)} + + [{/.#Seq preN postN} + {/.#Seq preO postO}] + (when (weave preN preO) + {/.#Alt _} + + + woven + {/.#Seq woven (weave postN postO)}) + + [{/.#Pop} {/.#Pop}] + old + + [{/.#Bit_Fork new_when new_then new_else} + {/.#Bit_Fork old_when old_then old_else}] + (if (bit#= new_when old_when) + {/.#Bit_Fork old_when + (weave new_then old_then) + (when [new_else old_else] + [{.#None} {.#None}] + {.#None} + + (^.or [{.#Some woven_then} {.#None}] + [{.#None} {.#Some woven_then}]) + {.#Some woven_then} + + [{.#Some new_else} {.#Some old_else}] + {.#Some (weave new_else old_else)})} + {/.#Bit_Fork old_when + (when new_else + {.#None} + old_then + + {.#Some new_else} + (weave new_else old_then)) + {.#Some (when old_else + {.#None} + new_then + + {.#Some old_else} + (weave new_then old_else))}}) + + (^.with_template [ ] + [[{ new_fork} { old_fork}] + { (..weave_fork weave new_fork old_fork)}]) + ([/.#I64_Fork i64.equivalence] + [/.#F64_Fork frac.equivalence] + [/.#Text_Fork text.equivalence]) + + (^.with_template [ ] + [[{/.#Access { [ newL ]}} + {/.#Access { [ oldL ]}}] + (if (n.= newL oldL) + old + )]) + ([/access.#Side .false /side.#lefts /side.#right?] + [/access.#Side .true /side.#lefts /side.#right?] + + [/access.#Member .false /member.#lefts /member.#right?] + [/access.#Member .true /member.#lefts /member.#right?]) + + [{/.#Bind newR} {/.#Bind oldR}] + (if (n.= newR oldR) + old + ) + + _ + ))) + +(def (get patterns @selection) + (-> (///complex.Tuple Pattern) Register (List Member)) + (loop (again [lefts 0 + patterns patterns]) + (with_expansions [ (these (list)) + (these (again (++ lefts) + tail)) + (these (let [right? (list.empty? tail)] + [/member.#lefts (if right? + (-- lefts) + lefts) + /member.#right? right?]))] + (when patterns + {.#End} + + + {.#Item head tail} + (when head + {///pattern.#Simple {///simple.#Unit}} + + + {///pattern.#Bind register} + (if (n.= @selection register) + (list ) + ) + + {///pattern.#Complex {///complex.#Tuple sub_patterns}} + (when (get sub_patterns @selection) + {.#End} + + + sub_members + (list.partial sub_members)) + + _ + ))))) + +(def .public (synthesize_when synthesize archive input [[headP headA] tailPA+]) + (-> Phase Archive Synthesis Match (Operation Synthesis)) + (do [! ///.monad] + [headSP (path archive synthesize headP headA) + tailSP+ (monad.each ! (product.uncurried (path archive synthesize)) tailPA+)] + (in (/.branch/when [input (list#mix weave headSP tailSP+)])))) + +(def !masking + (template (_ ) + [[[{///pattern.#Bind } + {///analysis.#Reference (///reference.local )}] + (list)]])) + +(def .public (synthesize_exec synthesize archive before after) + (-> Phase Archive Synthesis Analysis (Operation Synthesis)) + (do ///.monad + [after (synthesize archive after)] + (in (/.branch/exec [before after])))) + +(def .public (synthesize_let synthesize archive input @variable body) + (-> Phase Archive Synthesis Register Analysis (Operation Synthesis)) + (do ///.monad + [body (/.with_new_local + (synthesize archive body))] + (in (/.branch/let [input @variable body])))) + +(def .public (synthesize_masking synthesize archive input @variable @output) + (-> Phase Archive Synthesis Register Register (Operation Synthesis)) + (if (n.= @variable @output) + (///#in input) + (..synthesize_let synthesize archive input @variable {///analysis.#Reference (///reference.local @output)}))) + +(def .public (synthesize_if synthesize archive test then else) + (-> Phase Archive Synthesis Analysis Analysis (Operation Synthesis)) + (do ///.monad + [then (synthesize archive then) + else (synthesize archive else)] + (in (/.branch/if [test then else])))) + +(def !get + (template (_ ) + [[[(///pattern.tuple ) + {///analysis.#Reference (///reference.local )}] + (.list)]])) + +(def .public (synthesize_get synthesize archive input patterns @member) + (-> Phase Archive Synthesis (///complex.Tuple Pattern) Register (Operation Synthesis)) + (when (..get patterns @member) + {.#End} + (..synthesize_when synthesize archive input (!get patterns @member)) + + path + (when input + (/.branch/get [sub_path sub_input]) + (///#in (/.branch/get [(list#composite path sub_path) sub_input])) + + _ + (///#in (/.branch/get [path input]))))) + +(def .public (synthesize synthesize^ [headB tailB+] archive inputA) + (-> Phase Match Phase) + (do [! ///.monad] + [inputS (synthesize^ archive inputA)] + (when [headB tailB+] + (!masking @variable @output) + (..synthesize_masking synthesize^ archive inputS @variable @output) + + [[(///pattern.unit) body] + {.#End}] + (when inputA + (^.or {///analysis.#Simple _} + {///analysis.#Structure _} + {///analysis.#Reference _}) + (synthesize^ archive body) + + _ + (..synthesize_exec synthesize^ archive inputS body)) + + [[{///pattern.#Bind @variable} body] + {.#End}] + (..synthesize_let synthesize^ archive inputS @variable body) + + (^.or [[(///pattern.bit .true) then] + (list [(///pattern.bit .false) else])] + [[(///pattern.bit .true) then] + (list [(///pattern.unit) else])] + + [[(///pattern.bit .false) else] + (list [(///pattern.bit .true) then])] + [[(///pattern.bit .false) else] + (list [(///pattern.unit) then])]) + (..synthesize_if synthesize^ archive inputS then else) + + (!get patterns @member) + (..synthesize_get synthesize^ archive inputS patterns @member) + + match + (..synthesize_when synthesize^ archive inputS match)))) + +(def .public (count_pops path) + (-> Path [Nat Path]) + (when path + (/.path/seq {/.#Pop} path') + (let [[pops post_pops] (count_pops path')] + [(++ pops) post_pops]) + + _ + [0 path])) + +(def .public pattern_matching_error + "Invalid expression for pattern-matching.") + +(type .public Storage + (Record + [#bindings (Set Register) + #dependencies (Set Variable)])) + +(def empty + Storage + [#bindings (set.empty n.hash) + #dependencies (set.empty ///reference/variable.hash)]) + +... TODO: Use this to declare all local variables at the beginning of +... script functions. +... That way, it should be possible to do cheap "let" expressions, +... since the variable will exist beforehand, so no closure will need +... to be created for it. +... Apply this trick to JS, Python et al. +(def .public (storage path) + (-> Path Storage) + (loop (for_path [path path + path_storage ..empty]) + (when path + (^.or {/.#Pop} + {/.#Access Access}) + path_storage + + (/.path/bind register) + (revised #bindings (set.has register) + path_storage) + + {/.#Bit_Fork _ default otherwise} + (|> (when otherwise + {.#None} + path_storage + + {.#Some otherwise} + (for_path otherwise path_storage)) + (for_path default)) + + (^.or {/.#I64_Fork forks} + {/.#F64_Fork forks} + {/.#Text_Fork forks}) + (|> {.#Item forks} + (list#each product.right) + (list#mix for_path path_storage)) + + (^.or (/.path/seq left right) + (/.path/alt left right)) + (list#mix for_path path_storage (list left right)) + + (/.path/then bodyS) + (loop (for_synthesis [bodyS bodyS + synthesis_storage path_storage]) + (when bodyS + (^.or {/.#Simple _} + (/.constant _)) + synthesis_storage + + (/.variant [lefts right? valueS]) + (for_synthesis valueS synthesis_storage) + + (/.tuple members) + (list#mix for_synthesis synthesis_storage members) + + {/.#Reference {///reference.#Variable {///reference/variable.#Local register}}} + (if (set.member? (the #bindings synthesis_storage) register) + synthesis_storage + (revised #dependencies (set.has {///reference/variable.#Local register}) synthesis_storage)) + + {/.#Reference {///reference.#Variable var}} + (revised #dependencies (set.has var) synthesis_storage) + + (/.function/apply [functionS argsS]) + (list#mix for_synthesis synthesis_storage {.#Item functionS argsS}) + + (/.function/abstraction [environment arity bodyS]) + (list#mix for_synthesis synthesis_storage environment) + + (/.branch/when [inputS pathS]) + (revised #dependencies + (set.union (the #dependencies (for_path pathS synthesis_storage))) + (for_synthesis inputS synthesis_storage)) + + (/.branch/exec [before after]) + (list#mix for_synthesis synthesis_storage (list before after)) + + (/.branch/let [inputS register exprS]) + (revised #dependencies + (set.union (|> synthesis_storage + (revised #bindings (set.has register)) + (for_synthesis exprS) + (the #dependencies))) + (for_synthesis inputS synthesis_storage)) + + (/.branch/if [testS thenS elseS]) + (list#mix for_synthesis synthesis_storage (list testS thenS elseS)) + + (/.branch/get [access whole]) + (for_synthesis whole synthesis_storage) + + (/.loop/scope [start initsS+ iterationS]) + (revised #dependencies + (set.union (|> synthesis_storage + (revised #bindings (set.union (|> initsS+ + list.enumeration + (list#each (|>> product.left (n.+ start))) + (set.of_list n.hash)))) + (for_synthesis iterationS) + (the #dependencies))) + (list#mix for_synthesis synthesis_storage initsS+)) + + (/.loop/again replacementsS+) + (list#mix for_synthesis synthesis_storage replacementsS+) + + {/.#Extension [extension argsS]} + (list#mix for_synthesis synthesis_storage argsS))) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/program.lux b/stdlib/source/library/lux/meta/compiler/language/lux/program.lux index 502922736..864a8f817 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/program.lux @@ -43,7 +43,7 @@ [id (archive.id module archive) [_module output registry] (archive.find module archive)] (in [[module id] registry])))))] - (case (list.one (function (_ [[module module_id] registry]) + (when (list.one (function (_ [[module module_id] registry]) (do maybe.monad [program_id (registry.id ..name registry)] (in [module_id program_id]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux index 86d0cc16a..bbf548818 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux @@ -215,7 +215,7 @@ (def !letE (template (_ ) - [(case + [(when {.#Right } @@ -251,7 +251,7 @@ (Either [Source Text] [Source Code])) (loop (again [source (is Source [(!forward 1 where) offset source_code]) stack (is (List Code) {.#End})]) - (case (parse source) + (when (parse source) {.#Right [source' top]} (again source' {.#Item top stack}) @@ -271,7 +271,7 @@ (def !guarantee_no_new_lines (template (_ where offset source_code content body) - [(case ("lux text index" 0 (static text.new_line) content) + [(when ("lux text index" 0 (static text.new_line) content) {.#None} body @@ -281,7 +281,7 @@ (def (text_parser where offset source_code) (-> Location Offset Text (Either [Source Text] [Source Code])) - (case ("lux text index" offset (static ..text_delimiter) source_code) + (when ("lux text index" offset (static ..text_delimiter) source_code) {.#Some g!end} (<| (let [g!content (!clip offset g!end source_code)]) (!guarantee_no_new_lines where offset source_code g!content) @@ -348,7 +348,7 @@ (def !number_output (template (_ ) - [(case (|> + [(when (|> (!clip ) (text.replaced ..digit_separator "") (at decoded)) @@ -562,7 +562,7 @@ ... It's either a Rev, a symbol, or a comment. (with_expansions [ (rev_parser source_code//size offset/0 where (!++ offset/1) source_code) (!short_symbol_parser source_code//size current_module [where offset/1 source_code] where .#Symbol) - (case ("lux text index" (!++ offset/1) (static text.new_line) source_code) + (when ("lux text index" (!++ offset/1) (static text.new_line) source_code) {.#Some end} (again (!vertical where end source_code)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index 735da0f51..29b3604b8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -98,7 +98,7 @@ {#Let s Register s} {#If s s s} {#Get (List Member) s} - {#Case s (Path' s)})) + {#When s (Path' s)})) (type .public (Scope s) (Record @@ -274,7 +274,7 @@ {} content)]))] - [branch/case ..#Branch ..#Case] + [branch/when ..#Branch ..#When] [branch/exec ..#Branch ..#Exec] [branch/let ..#Branch ..#Let] [branch/if ..#Branch ..#If] @@ -289,16 +289,16 @@ (def .public (%path' %then value) (All (_ a) (-> (Format a) (Format (Path' a)))) - (case value + (when value {#Pop} "_" - {#Bit_Fork when then else} + {#Bit_Fork test then else} (format "(?" - " " (%.bit when) " " (%path' %then then) - (case else + " " (%.bit test) " " (%path' %then then) + (when else {.#Some else} - (format " " (%.bit (not when)) " " (%path' %then else)) + (format " " (%.bit (not test)) " " (%path' %then else)) {.#None} "") @@ -333,12 +333,12 @@ (def .public (%synthesis value) (Format Synthesis) - (case value + (when value {#Simple it} (/simple.format it) {#Structure structure} - (case structure + (when structure {analysis/complex.#Variant [lefts right? content]} (|> (%synthesis content) (format (%.nat lefts) " " (%.bit right?) " ") @@ -354,9 +354,9 @@ (reference.format reference) {#Control control} - (case control + (when control {#Function function} - (case function + (when function {#Abstraction [environment arity body]} (let [environment' (|> environment (list#each %synthesis) @@ -373,7 +373,7 @@ (text.enclosed ["(" ")"]))) {#Branch branch} - (case branch + (when branch {#Exec this that} (|> (format (%synthesis this) " " (%synthesis that)) (text.enclosed ["{#exec " "}"])) @@ -392,12 +392,12 @@ " " (%synthesis record)) (text.enclosed ["{#get " "}"])) - {#Case input path} + {#When input path} (|> (format (%synthesis input) " " (%path' %synthesis path)) - (text.enclosed ["{#case " "}"]))) + (text.enclosed ["{#when " "}"]))) {#Loop loop} - (case loop + (when loop {#Scope scope} (|> (format (%.nat (the #start scope)) " " (|> (the #inits scope) @@ -427,7 +427,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Path' a)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Pop} {#Pop}] true @@ -473,7 +473,7 @@ (..path'_equivalence (at super equivalence))) (def (hash value) - (case value + (when value {#Pop} 2 @@ -491,9 +491,9 @@ (^.with_template [ ] [{ item} - (let [case_hash (product.hash + (let [when_hash (product.hash (path'_hash super)) - item_hash (product.hash case_hash (list.hash case_hash))] + item_hash (product.hash when_hash (list.hash when_hash))] (n.* (at item_hash hash item)))]) ([11 #I64_Fork i64.hash] [13 #F64_Fork f.hash] @@ -515,7 +515,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Branch a)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Let [reference_input reference_register reference_body]} {#Let [sample_input sample_register sample_body]}] (and (#= reference_input sample_input) @@ -533,8 +533,8 @@ (and (at (list.equivalence /member.equivalence) = reference_path sample_path) (#= reference_record sample_record)) - [{#Case [reference_input reference_path]} - {#Case [sample_input sample_path]}] + [{#When [reference_input reference_path]} + {#When [sample_input sample_path]}] (and (#= reference_input sample_input) (at (path'_equivalence #=) = reference_path sample_path)) @@ -548,7 +548,7 @@ (..branch_equivalence (at super equivalence))) (def (hash value) - (case value + (when value {#Exec this that} (all n.* 2 (at super hash this) @@ -571,7 +571,7 @@ (at (list.hash /member.hash) hash path) (at super hash record)) - {#Case [input path]} + {#When [input path]} (all n.* 11 (at super hash input) (at (..path'_hash super) hash path)) @@ -581,7 +581,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Loop a)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Scope [reference_start reference_inits reference_iteration]} {#Scope [sample_start sample_inits sample_iteration]}] (and (n.= reference_start sample_start) @@ -601,7 +601,7 @@ (..loop_equivalence (at super equivalence))) (def (hash value) - (case value + (when value {#Scope [start inits iteration]} (all n.* 2 (at n.hash hash start) @@ -617,7 +617,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Function a)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] [{#Abstraction [reference_environment reference_arity reference_body]} {#Abstraction [sample_environment sample_arity sample_body]}] (and (at (list.equivalence #=) = reference_environment sample_environment) @@ -639,7 +639,7 @@ (..function_equivalence (at super equivalence))) (def (hash value) - (case value + (when value {#Abstraction [environment arity body]} (all n.* 2 (at (list.hash super) hash environment) @@ -656,7 +656,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (Control a)))) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [ ] [[{ reference} { sample}] (at ( #=) = reference sample)]) @@ -674,7 +674,7 @@ (..control_equivalence (at super equivalence))) (def (hash value) - (case value + (when value (^.with_template [ ] [{ value} (n.* (at ( super) hash value))]) @@ -687,7 +687,7 @@ (Equivalence Synthesis) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [ ] [[{ reference'} { sample'}] (at = reference' sample')]) @@ -711,7 +711,7 @@ (def (hash value) (let [again_hash [..equivalence hash]] - (case value + (when value (^.with_template [ ] [{ value} (at hash value)]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access.lux index f599f4d90..fc1d14e8f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/access.lux @@ -19,7 +19,7 @@ (def .public (format it) (Format Access) - (case it + (when it {#Side it} (/side.format it) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux index 738ea9b76..a44021d1f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux @@ -29,7 +29,7 @@ (def .public (format it) (%.Format Simple) - (case it + (when it (^.with_template [ ] [{ value} ( value)]) @@ -44,7 +44,7 @@ (Equivalence Simple) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [ ] [[{ reference'} { sample'}] ( reference' sample')]) @@ -64,7 +64,7 @@ (def equivalence ..equivalence) (def hash - (|>> (pipe.case + (|>> (pipe.when (^.with_template [ ] [{ value'} (n.* (at hash value'))]) diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/archive.lux index a67b84f92..bcbdcaff4 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive.lux @@ -89,7 +89,7 @@ (def .public (id module archive) (-> descriptor.Module Archive (Try module.ID)) (let [(open "/[0]") (representation archive)] - (case (dictionary.value module /#resolver) + (when (dictionary.value module /#resolver) {.#Some [id _]} {try.#Success id} @@ -100,7 +100,7 @@ (def .public (reserve module archive) (-> descriptor.Module Archive (Try [module.ID Archive])) (let [(open "/[0]") (representation archive)] - (case (dictionary.value module /#resolver) + (when (dictionary.value module /#resolver) {.#Some _} (exception.except ..module_has_already_been_reserved [module]) @@ -115,7 +115,7 @@ (def .public (has module entry archive) (-> descriptor.Module (Entry Any) Archive (Try Archive)) (let [(open "/[0]") (representation archive)] - (case (dictionary.value module /#resolver) + (when (dictionary.value module /#resolver) {.#Some [id {.#None}]} {try.#Success (|> archive representation @@ -143,7 +143,7 @@ (def .public (find module archive) (-> descriptor.Module Archive (Try (Entry Any))) (let [(open "/[0]") (representation archive)] - (case (dictionary.value module /#resolver) + (when (dictionary.value module /#resolver) {.#Some [id {.#Some entry}]} {try.#Success entry} @@ -155,7 +155,7 @@ (def .public (archived? archive module) (-> Archive descriptor.Module Bit) - (case (..find module archive) + (when (..find module archive) {try.#Success _} true @@ -168,14 +168,14 @@ (the #resolver) dictionary.entries (list.all (function (_ [module [id descriptor+document]]) - (case descriptor+document + (when descriptor+document {.#Some _} {.#Some module} {.#None} {.#None}))))) (def .public (reserved? archive module) (-> Archive descriptor.Module Bit) (let [(open "/[0]") (representation archive)] - (case (dictionary.value module /#resolver) + (when (dictionary.value module /#resolver) {.#Some [id _]} true @@ -204,7 +204,7 @@ (revised #next (n.max +next)) (revised #resolver (function (_ resolver) (list#mix (function (_ [module [id entry]] resolver) - (case entry + (when entry {.#Some _} (dictionary.has module [id entry] resolver) @@ -240,7 +240,7 @@ (|> /#resolver dictionary.entries (list.all (function (_ [module [id descriptor+document]]) - (case descriptor+document + (when descriptor+document {.#Some _} {.#Some [module id]} {.#None} {.#None}))) [version /#next] diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux index 706ea16ae..0afb9adc5 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux @@ -45,7 +45,7 @@ (Equivalence Category) (implementation (def (= left right) - (case [left right] + (when [left right] [{#Anonymous} {#Anonymous}] true diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/module/descriptor.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/module/descriptor.lux index 057f72e6e..f9cfae82a 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/module/descriptor.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/module/descriptor.lux @@ -41,7 +41,7 @@ (Equivalence Module_State) (implementation (def (= left right) - (case [left right] + (when [left right] (^.with_template [] [[{} {}] true]) diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux index 48f9fb04c..9f1e240d9 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux @@ -82,7 +82,7 @@ sequence.list (list.all (|>> product.left (the //.#category) - (pipe.case + (pipe.when { it} {.#Some it} _ {.#None})))))] @@ -119,7 +119,7 @@ )) category (is (Format Category) (function (_ value) - (case value + (when value (^.with_template [ ] [{ value} ((binary.and binary.nat ) [ value])]) @@ -164,7 +164,7 @@ category (is (Parser Category) (do [! <>.monad] [tag .nat] - (case tag + (when tag (^.with_template [ ] [ (at ! each (|>> {}) )]) @@ -185,7 +185,7 @@ (|> (.sequence_64 (all <>.and category mandatory? dependencies)) (at <>.monad each (sequence#mix (function (_ [category mandatory? dependencies] registry) (product.right - (case category + (when category {//category.#Anonymous} (..resource mandatory? dependencies registry) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux index 9f1d8bf22..26f28d451 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux @@ -38,7 +38,7 @@ (-> (-> Synthesis (List Constant)) (-> Path (List Constant))) (function (again path) - (case path + (when path (^.or {synthesis.#Pop} {synthesis.#Access _} {synthesis.#Bind _}) @@ -52,8 +52,8 @@ ([synthesis.#Alt] [synthesis.#Seq]) - {synthesis.#Bit_Fork when then else} - (case else + {synthesis.#Bit_Fork test then else} + (when else {.#Some else} (.all list#composite (again then) @@ -76,12 +76,12 @@ (def (references value) (-> Synthesis (List Constant)) - (case value + (when value {synthesis.#Simple value} (list) {synthesis.#Structure value} - (case value + (when value {analysis/complex.#Variant value} (|> value (the analysis/complex.#value) @@ -93,7 +93,7 @@ list#conjoint)) {synthesis.#Reference value} - (case value + (when value {reference.#Variable _} (list) @@ -101,9 +101,9 @@ (list value)) {synthesis.#Control value} - (case value + (when value {synthesis.#Branch value} - (case value + (when value {synthesis.#Exec this that} (.all list#composite (references this) @@ -123,13 +123,13 @@ {synthesis.#Get _ record} (references record) - {synthesis.#Case input path} + {synthesis.#When input path} (.all list#composite (references input) (path_references references path))) {synthesis.#Loop value} - (case value + (when value {synthesis.#Scope value} (let [of_inits (|> value (the synthesis.#inits) @@ -145,7 +145,7 @@ list#conjoint)) {synthesis.#Function value} - (case value + (when value {synthesis.#Abstraction value} (|> value (the synthesis.#body) @@ -217,11 +217,11 @@ (let [[mandatory immediate] (immediate_dependencies archive)] (loop (again [pending mandatory minimum unit.none]) - (case pending + (when pending {.#Item head tail} (if (set.member? minimum head) (again tail minimum) - (again (case (dictionary.value head immediate) + (again (when (dictionary.value head immediate) {.#Some additional} (list#composite (set.list additional) tail) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux index 0a9b6028f..60e4af536 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux @@ -57,7 +57,7 @@ (let [memo (is (Memo descriptor.Module Ancestry) (function (_ again module) (do [! state.monad] - [.let [parents (case (archive.find module archive) + [.let [parents (when (archive.find module archive) {try.#Success [module output registry]} (the [module.#descriptor descriptor.#references] module) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/module.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/module.lux index 081911993..619e3db90 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/module.lux @@ -55,14 +55,14 @@ error])] (do ! [? (//.enable! ! fs context)] - (case ? + (when ? {try.#Failure error} (in ) success (|> path (at fs make_directory) - (at ! each (|>> (pipe.case + (at ! each (|>> (pipe.when {try.#Failure error} diff --git a/stdlib/source/library/lux/meta/compiler/meta/cli.lux b/stdlib/source/library/lux/meta/compiler/meta/cli.lux index 21d0885ad..37adb69f4 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cli.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cli.lux @@ -114,7 +114,7 @@ (def .public target (-> Service Target) - (|>> (pipe.case + (|>> (pipe.when (^.or {#Compilation [host_dependencies libraries compilers sources target module]} {#Interpretation [host_dependencies libraries compilers sources target module]} {#Export [sources target]}) diff --git a/stdlib/source/library/lux/meta/compiler/meta/import.lux b/stdlib/source/library/lux/meta/compiler/meta/import.lux index b904d3df6..500de0a6f 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/import.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/import.lux @@ -50,10 +50,10 @@ (at ! conjoint) (at ! each (|>> sequence.list (monad.mix ! (function (_ entry import) - (case entry + (when entry {tar.#Normal [path instant mode ownership content]} (let [path (tar.from_path path)] - (case (dictionary.has' path (tar.data content) import) + (when (dictionary.has' path (tar.data content) import) {try.#Failure error} (exception.except ..duplicate [library path]) diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux index cf8d212f8..40e32ad80 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux @@ -120,13 +120,13 @@ bundles ..empty_bundles output (is Output sequence.empty)]) (let [[analysers synthesizers generators declarations] bundles] - (case input + (when input {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']} - (case (do ! + (when (do ! [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual)) .let [context [@module @artifact] declaration (at host ingest context data)]] - (case artifact_category + (when artifact_category {category.#Anonymous} (do ! [.let [output (sequence.suffix [@artifact {.#None} data] output)] @@ -220,7 +220,7 @@ {try.#Success [definitions bundles output]})))) content (document.content $.key document) definitions (monad.each ! (function (_ [def_name def_global]) - (case def_global + (when def_global (^.with_template [] [{ payload} (in [def_name { payload}])]) @@ -269,7 +269,7 @@ (def (cache_parser customs) (-> (List Custom) (Parser [(module.Module Any) Registry])) - (case (for @.old (as (List (Custom Any Any Any)) + (when (for @.old (as (List (Custom Any Any Any)) customs) customs) {.#End} @@ -380,7 +380,7 @@ (Async (Try [Archive .Lux Bundles])))) (do async.monad [binary (at fs read (cache/archive.descriptor fs context))] - (case binary + (when binary {try.#Success binary} (do (try.with async.monad) [archive (async#in (archive.import ///.version binary))] diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/context.lux b/stdlib/source/library/lux/meta/compiler/meta/io/context.lux index d5cc32d72..e6a80f7a5 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/context.lux @@ -58,7 +58,7 @@ (def (find_source_file fs importer contexts module extension) (-> (file.System Async) Module (List Context) Module Extension (Async (Try file.Path))) - (case contexts + (when contexts {.#End} (async#in (exception.except ..cannot_find_module [importer module])) @@ -81,7 +81,7 @@ ... Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do [! async.monad] [outcome (..find_source_file fs importer contexts module (..full_host_extension partial_host_extension))] - (case outcome + (when outcome {try.#Success path} (|> path (at fs read) @@ -97,13 +97,13 @@ (def (find_library_source_file importer import partial_host_extension module) (-> Module Import Extension Module (Try [file.Path Binary])) (let [path (format module (..full_host_extension partial_host_extension))] - (case (dictionary.value path import) + (when (dictionary.value path import) {.#Some data} {try.#Success [path data]} {.#None} (let [path (format module ..lux_extension)] - (case (dictionary.value path import) + (when (dictionary.value path import) {.#Some data} {try.#Success [path data]} @@ -117,7 +117,7 @@ ... Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do [! async.monad] [outcome (find_local_source_file fs importer import contexts partial_host_extension module)] - (case outcome + (when outcome {try.#Success [path data]} (in outcome) @@ -129,7 +129,7 @@ (Async (Try Input))) (do (try.with async.monad) [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)] - (case (at utf8.codec decoded binary) + (when (at utf8.codec decoded binary) {try.#Success code} (in [////.#module module ////.#file path diff --git a/stdlib/source/library/lux/meta/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/meta/compiler/meta/packager/jvm.lux index b783f1262..1fbba7497 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/packager/jvm.lux @@ -140,7 +140,7 @@ (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) (ffi.as_string ..manifest_version)))] (exec - (case program + (when program {.#Some program} (to attrs (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) @@ -188,7 +188,7 @@ chunk_size (.int ..mebi_byte) buffer (java/io/ByteArrayOutputStream::new (ffi.as_int chunk_size))] (loop (again [so_far 0]) - (case (ffi.of_int (java/io/InputStream::read chunk (ffi.as_int +0) (ffi.as_int chunk_size) input)) + (when (ffi.of_int (java/io/InputStream::read chunk (ffi.as_int +0) (ffi.as_int chunk_size) input)) -1 [so_far (java/io/ByteArrayOutputStream::toByteArray buffer)] @@ -213,7 +213,7 @@ (def (read_jar_entry entry input) (-> java/util/jar/JarEntry java/util/jar/JarInputStream [Nat Binary]) - (case (ffi.of_long (java/util/zip/ZipEntry::getSize entry)) + (when (ffi.of_long (java/util/zip/ZipEntry::getSize entry)) -1 (..read_jar_entry_with_unknown_size input) @@ -230,12 +230,12 @@ (loop (again [entries entries duplicates duplicates sink sink]) - (case (java/util/jar/JarInputStream::getNextJarEntry input) + (when (java/util/jar/JarInputStream::getNextJarEntry input) {try.#Failure error} {try.#Failure error} {try.#Success ?entry} - (case ?entry + (when ?entry {.#None} (exec (java/io/Closeable::close input) @@ -249,7 +249,7 @@ (text.starts_with? "META-INF/leiningen/" entry_path)) (or (text.ends_with? ".SF" entry_path) (text.ends_with? ".DSA" entry_path)))) - (case (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new (ffi.as_string entry_path)) + (when (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new (ffi.as_string entry_path)) sink) {try.#Failure error} (again entries diff --git a/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux index 1c0d70dc2..80be5feaf 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux @@ -49,7 +49,7 @@ (-> descriptor.Module module.ID (Set unit.ID) Output (Try (Maybe _.Statement))) (do [! try.monad] [] - (case (|> output + (when (|> output sequence.list (list.only (function (_ [artifact_id custom content]) (set.member? necessary_dependencies [module_id artifact_id])))) @@ -86,7 +86,7 @@ (do [! try.monad] [bundle (is (Try (Maybe _.Statement)) (..bundle_module module module_id necessary_dependencies (the archive.#output entry)))] - (case bundle + (when bundle {.#None} (in sink) diff --git a/stdlib/source/library/lux/meta/compiler/phase.lux b/stdlib/source/library/lux/meta/compiler/phase.lux index 2b67baec4..b5d04c40e 100644 --- a/stdlib/source/library/lux/meta/compiler/phase.lux +++ b/stdlib/source/library/lux/meta/compiler/phase.lux @@ -29,7 +29,7 @@ (implementation (def (each f it) (function (_ state) - (case (it state) + (when (it state) {try.#Success [state' output]} {try.#Success [state' (f output)]} @@ -47,7 +47,7 @@ (def (conjoint it) (function (_ state) - (case (it state) + (when (it state) {try.#Success [state' it']} (it' state') diff --git a/stdlib/source/library/lux/meta/compiler/reference.lux b/stdlib/source/library/lux/meta/compiler/reference.lux index 340cf1a0d..b7eb370de 100644 --- a/stdlib/source/library/lux/meta/compiler/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/reference.lux @@ -31,7 +31,7 @@ (Equivalence Reference) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [ ] [[{ reference} { sample}] (at = reference sample)]) @@ -48,7 +48,7 @@ ..equivalence) (def (hash value) - (case value + (when value (^.with_template [ ] [{ value} (|> value @@ -85,7 +85,7 @@ (def .public format (Format Reference) - (|>> (pipe.case + (|>> (pipe.when {#Variable variable} (/variable.format variable) diff --git a/stdlib/source/library/lux/meta/compiler/reference/variable.lux b/stdlib/source/library/lux/meta/compiler/reference/variable.lux index caa6d2c89..0e038ed06 100644 --- a/stdlib/source/library/lux/meta/compiler/reference/variable.lux +++ b/stdlib/source/library/lux/meta/compiler/reference/variable.lux @@ -29,7 +29,7 @@ (Equivalence Variable) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [] [[{ reference'} { sample'}] (n.= reference' sample')]) @@ -45,7 +45,7 @@ ..equivalence) (def hash - (|>> (pipe.case + (|>> (pipe.when (^.with_template [ ] [{ register} (|> register @@ -60,7 +60,7 @@ (def .public self? (-> Variable Bit) - (|>> (pipe.case + (|>> (pipe.when (..self) true @@ -69,7 +69,7 @@ (def .public format (Format Variable) - (|>> (pipe.case + (|>> (pipe.when {#Local local} (%.format "+" (%.nat local)) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index 45ca34758..b98d92ee1 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -74,7 +74,7 @@ (def (subsumes? actual expected) (-> Configuration Configuration Bit) - (case expected + (when expected {.#End} true @@ -90,7 +90,7 @@ default (<>.maybe .any)]) (do meta.monad [actual meta.configuration] - (case (list#mix (function (_ [expected then] choice) + (when (list#mix (function (_ [expected then] choice) (if (subsumes? actual expected) {.#Some then} choice)) diff --git a/stdlib/source/library/lux/meta/extension.lux b/stdlib/source/library/lux/meta/extension.lux index f4e7b41d7..175b1143f 100644 --- a/stdlib/source/library/lux/meta/extension.lux +++ b/stdlib/source/library/lux/meta/extension.lux @@ -50,7 +50,7 @@ (with_symbols [g!handler g!inputs g!error g!_] (in (list (` ( (, name) (.function ((, g!handler) (, g!name) (, g!phase) (, g!archive) (, g!inputs)) - (.case ( + (.when ( (monad.do <>.monad [(,* inputs) (, g!_) ] diff --git a/stdlib/source/library/lux/meta/location.lux b/stdlib/source/library/lux/meta/location.lux index a9e62dd5f..2c4fc0eb1 100644 --- a/stdlib/source/library/lux/meta/location.lux +++ b/stdlib/source/library/lux/meta/location.lux @@ -20,7 +20,7 @@ (def .public here (macro (_ tokens compiler) - (case tokens + (when tokens {.#End} (let [location (the .#location compiler)] {.#Right [compiler diff --git a/stdlib/source/library/lux/meta/macro.lux b/stdlib/source/library/lux/meta/macro.lux index 0b7bb514a..298bde13d 100644 --- a/stdlib/source/library/lux/meta/macro.lux +++ b/stdlib/source/library/lux/meta/macro.lux @@ -27,7 +27,7 @@ (def (local ast) (-> Code (Meta Text)) - (case ast + (when ast [_ {.#Symbol ["" name]}] (at //.monad in name) @@ -42,7 +42,7 @@ (def .public with_symbols (.macro (_ tokens) - (case tokens + (when tokens (list [_ {.#Tuple symbols}] body) (do [! //.monad] [symbol_names (monad.each ! ..local symbols) @@ -58,11 +58,11 @@ (def .public times (.macro (_ tokens) - (case tokens + (when tokens (list.partial [_ {.#Nat times}] terms) (loop (again [times times before terms]) - (case times + (when times 0 (at //.monad in before) diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux index 73cda9cd0..5a347775d 100644 --- a/stdlib/source/library/lux/meta/macro/context.lux +++ b/stdlib/source/library/lux/meta/macro/context.lux @@ -33,7 +33,7 @@ (do meta.monad [.let [[@ expected_name] it] defs (meta.definitions @)] - (case (list.one (function (_ [actual_name [exported? type value]]) + (when (list.one (function (_ [actual_name [exported? type value]]) (if (text#= expected_name actual_name) {.#Some value} {.#None})) @@ -50,7 +50,7 @@ (All (_ a) (-> (Stack a) Symbol (Meta a))) (do meta.monad [stack (..global context)] - (case (|> stack + (when (|> stack (as (Stack Any)) list.head) {.#Some top} @@ -69,7 +69,7 @@ (All (_ a) (-> (Stack a) (Predicate a) Symbol (Meta a))) (do meta.monad [stack (..global context)] - (case (|> stack + (when (|> stack (as (Stack Any)) (list.example (as (Predicate Any) ?))) {.#Some it} @@ -88,7 +88,7 @@ (function (_ lux) (let [on_global (is (-> Global Global) (function (_ it) - (case it + (when it {.#Definition it} {.#Definition (on_definition it)} diff --git a/stdlib/source/library/lux/meta/macro/expansion.lux b/stdlib/source/library/lux/meta/macro/expansion.lux index eb30d4ee8..9364ecc77 100644 --- a/stdlib/source/library/lux/meta/macro/expansion.lux +++ b/stdlib/source/library/lux/meta/macro/expansion.lux @@ -20,11 +20,11 @@ (def .public (single syntax) (-> Code (Meta (List Code))) - (case syntax + (when syntax [_ {.#Form {.#Item [[_ {.#Symbol name}] args]}}] (do ///.monad [?macro (///.macro name)] - (case ?macro + (when ?macro {.#Some macro} ((as Macro' macro) args) @@ -36,11 +36,11 @@ (def .public (complete syntax) (-> Code (Meta (List Code))) - (case syntax + (when syntax [_ {.#Form {.#Item [[_ {.#Symbol name}] args]}}] (do ///.monad [?macro (///.macro name)] - (case ?macro + (when ?macro {.#Some macro} (do [! ///.monad] [top_level_complete ((as Macro' macro) args)] @@ -56,11 +56,11 @@ (def .public (total syntax) (-> Code (Meta (List Code))) - (case syntax + (when syntax [_ {.#Form {.#Item [[_ {.#Symbol name}] args]}}] (do ///.monad [?macro (///.macro name)] - (case ?macro + (when ?macro {.#Some macro} (do ///.monad [complete ((as Macro' macro) args) @@ -95,7 +95,7 @@ (-> Code (Meta Code)) (do ///.monad [token+ (..complete token)] - (case token+ + (when token+ (list token') (in token') @@ -108,8 +108,8 @@ (let [[module _] (.symbol .._) [_ short] (.symbol ) macro_name [module short]] - (case (is (Maybe [Bit Code]) - (case tokens + (when (is (Maybe [Bit Code]) + (when tokens (list [_ {.#Text "omit"}] token) {.#Some [true token]} diff --git a/stdlib/source/library/lux/meta/macro/local.lux b/stdlib/source/library/lux/meta/macro/local.lux index 8e0d8d709..c69b32f95 100644 --- a/stdlib/source/library/lux/meta/macro/local.lux +++ b/stdlib/source/library/lux/meta/macro/local.lux @@ -37,9 +37,9 @@ (def (with_module name body) (All (_ a) (-> Text (-> Module (Try [Module a])) (Meta a))) (function (_ compiler) - (case (|> compiler (the .#modules) (property.value name)) + (when (|> compiler (the .#modules) (property.value name)) {.#Some module} - (case (body module) + (when (body module) {try.#Success [module' output]} {try.#Success [(revised .#modules (property.has name module') compiler) output]} @@ -59,7 +59,7 @@ (property.has definition_name definition))]] (..with_module module_name (function (_ module) - (case (|> module (the .#definitions) (property.value definition_name)) + (when (|> module (the .#definitions) (property.value definition_name)) {.#None} {try.#Success [(revised .#definitions add_macro! module) []]} @@ -75,7 +75,7 @@ (property.lacks definition_name))]] (..with_module module_name (function (_ module) - (case (|> module (the .#definitions) (property.value definition_name)) + (when (|> module (the .#definitions) (property.value definition_name)) {.#Some _} {try.#Success [(revised .#definitions lacks_macro! module) []]} @@ -91,7 +91,7 @@ [_ (monad.each ! ..pop_one macros) _ (..pop_one self) compiler meta.compiler_state] - (in (case (the .#expected compiler) + (in (when (the .#expected compiler) {.#Some _} (list (' [])) @@ -135,7 +135,7 @@ locals) expression? (is (Meta Bit) (function (_ lux) - {try.#Success [lux (case (the .#expected lux) + {try.#Success [lux (when (the .#expected lux) {.#None} false diff --git a/stdlib/source/library/lux/meta/macro/pattern.lux b/stdlib/source/library/lux/meta/macro/pattern.lux index b639259ba..f4f352efc 100644 --- a/stdlib/source/library/lux/meta/macro/pattern.lux +++ b/stdlib/source/library/lux/meta/macro/pattern.lux @@ -19,7 +19,7 @@ (def locally (macro (_ tokens lux) (.let [[prelude _] (symbol ._)] - (case tokens + (when tokens (list [@ {.#Symbol ["" name]}]) {.#Right [lux (list (.` ("lux in-module" (., [@ {.#Text prelude}]) (., [@ {.#Symbol [prelude name]}]))))]} @@ -68,9 +68,9 @@ (def .public or (pattern (macro (_ tokens) - (case tokens + (when tokens (list.partial [_ {.#Form patterns}] body branches) - (case patterns + (when patterns {.#End} (///.failure (..wrong_syntax_error (symbol ..or))) @@ -85,12 +85,12 @@ (def .public with_template (pattern (macro (_ tokens) - (case tokens + (when tokens (list.partial [_ {.#Form (list [_ {.#Tuple bindings}] [_ {.#Tuple templates}])}] [_ {.#Form data}] branches) - (case (is (Maybe (List Code)) + (when (is (Maybe (List Code)) (do maybe.monad [bindings' (monad.each maybe.monad symbol_short bindings) data' (monad.each maybe.monad tuple_list data)] @@ -118,7 +118,7 @@ (def (level it) (-> Code (Meta Level)) - (///#in (case it + (///#in (when it [_ {.#Tuple (list expr binding)}] [expr binding] @@ -130,7 +130,7 @@ (def (multiP levels) (-> (List Code) (Meta Multi)) - (case levels + (when levels {.#End} (///.failure "Multi-level patterns cannot be empty.") @@ -142,13 +142,13 @@ (def (multiG g!_ [[init_pattern levels] body]) (-> Code [Multi Code] (List Code)) (.let [inner_pattern_body (list#mix (function (_ [calculation pattern] success) - (.let [bind? (case pattern + (.let [bind? (when pattern [_ {.#Symbol _}] true _ false)] - (.` (case (., calculation) + (.` (when (., calculation) (., pattern) (., success) @@ -162,12 +162,12 @@ (def .public multi (pattern (macro (_ tokens) - (case tokens + (when tokens (list.partial [_meta {.#Form levels}] body next_branches) (with_symbols [g!temp] (do ///.monad [mlc (multiP levels) - .let [initial_bind? (case mlc + .let [initial_bind? (when mlc [[_ {.#Symbol _}] _] true @@ -179,10 +179,10 @@ (., g!temp) {.#None} - (.case (., g!temp) + (.when (., g!temp) (.,* next_branches))} ("lux type check" {.#Apply (., (type_code expected)) Maybe} - (.case (., g!temp) + (.when (., g!temp) (.,* (multiG g!temp [mlc body])) (.,* (if initial_bind? @@ -195,11 +195,11 @@ (def .public let (pattern (macro (_ tokens) - (case tokens + (when tokens (list.partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] pattern)}] body branches) (.let [g!whole (local$ name)] (///#in (list.partial g!whole - (.` (case (., g!whole) (., pattern) (., body))) + (.` (when (., g!whole) (., pattern) (., body))) branches))) _ @@ -208,7 +208,7 @@ (def .public |> (pattern (macro (_ tokens) - (case tokens + (when tokens (list.partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] [_ {.#Tuple steps}])}] body branches) (.let [g!name (local$ name)] (///#in (list.partial g!name @@ -225,7 +225,7 @@ (def (untemplated_partial_list last inits) (-> Code (List Code) Code) - (case inits + (when inits {.#End} last @@ -244,12 +244,12 @@ (with_expansions [ (do ///.monad [=elems (monad.each ///.monad untemplated_pattern elems)] (in (.` [(., g!meta) {(., ) (., (untemplated_list =elems))}])))] - (case (list.reversed elems) + (when (list.reversed elems) {.#Item [_ {.#Form {.#Item [_ {.#Symbol global}] parameters}}] inits} (do ///.monad [micro (///.try (..named_spliced_unquote global))] - (case micro + (when micro {try.#Success micro} (do ///.monad [output (..one_expansion ((//.function micro) parameters)) @@ -281,7 +281,7 @@ (def (untemplated_pattern pattern) (-> Code (Meta Code)) (with_symbols [g!meta] - (case pattern + (when pattern (..with_template [ ] [[_ { value}] (///#in (.` [(., g!meta) { (., ( value))}]))]) @@ -296,7 +296,7 @@ [@composite {.#Form {.#Item [@global {.#Symbol global}] parameters}}] (do [! ///.monad] [micro (///.try (..named_unquote global))] - (case micro + (when micro {try.#Success micro} (do ! [[_ output] (..one_expansion ((//.function micro) parameters))] @@ -316,7 +316,7 @@ (def .public ` (pattern (macro (_ tokens) - (case tokens + (when tokens (list.partial [_meta {.#Form (list template)}] body branches) (do ///.monad [pattern (untemplated_pattern template)] diff --git a/stdlib/source/library/lux/meta/macro/syntax.lux b/stdlib/source/library/lux/meta/macro/syntax.lux index aa415eeb8..ec96b9e42 100644 --- a/stdlib/source/library/lux/meta/macro/syntax.lux +++ b/stdlib/source/library/lux/meta/macro/syntax.lux @@ -18,7 +18,7 @@ (def .public (self_documenting binding parser) (All (_ a) (-> Code (Parser a) (Parser a))) (function (_ tokens) - (case (parser tokens) + (when (parser tokens) {try.#Failure error} {try.#Failure (all text#composite "Failed to parse: " (code.format binding) text.new_line @@ -29,7 +29,7 @@ (def (un_paired pairs) (All (_ a) (-> (List [a a]) (List a))) - (case pairs + (when pairs {.#Item [x y] pairs'} (list.partial x y (un_paired pairs')) @@ -47,11 +47,11 @@ (def .public syntax (macro (_ tokens) - (case (.result ..syntaxP tokens) + (when (.result ..syntaxP tokens) {try.#Success [[name g!state args] body]} (with_symbols [g!tokens g!body g!error] (do [! meta.monad] - [vars+parsers (case (list.pairs args) + [vars+parsers (when (list.pairs args) {.#Some args} (monad.each ! (is (-> [Code Code] (Meta [Code Code])) @@ -59,7 +59,7 @@ (with_expansions [ (in [var (` (..self_documenting (' (, var)) (, parser)))])] - (case var + (when var [_ {.#Symbol ["" _]}] @@ -72,7 +72,7 @@ _ (meta.failure "Syntax pattern expects pairs of bindings and code-parsers.")) - g!state (case g!state + g!state (when g!state {.#Some g!state} (in (code.local g!state)) @@ -81,7 +81,7 @@ this_module meta.current_module_name .let [g!name (code.symbol ["" name])]] (in (list (` (.macro ((, g!name) (, g!tokens) (, g!state)) - (.case (.result + (.when (.result (is (.Parser (Meta (List Code))) (do <>.monad [(,* (..un_paired vars+parsers))] diff --git a/stdlib/source/library/lux/meta/macro/syntax/declaration.lux b/stdlib/source/library/lux/meta/macro/syntax/declaration.lux index 1f4a9cccd..511f10c30 100644 --- a/stdlib/source/library/lux/meta/macro/syntax/declaration.lux +++ b/stdlib/source/library/lux/meta/macro/syntax/declaration.lux @@ -36,7 +36,7 @@ (def .public (format value) (-> Declaration Code) (let [g!name (code.local (the #name value))] - (case (the #arguments value) + (when (the #arguments value) {.#End} g!name diff --git a/stdlib/source/library/lux/meta/macro/syntax/definition.lux b/stdlib/source/library/lux/meta/macro/syntax/definition.lux index 445068226..0f6be7510 100644 --- a/stdlib/source/library/lux/meta/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/meta/macro/syntax/definition.lux @@ -55,7 +55,7 @@ (-> Definition Code) (` ((, (code.text ..extension)) (, (code.local _#name)) - (, (case _#value + (, (when _#value {.#Left check} (//check.format check) @@ -89,7 +89,7 @@ (-> Lux (Parser Definition)) (do <>.monad [definition (..parser compiler) - _ (case (the #value definition) + _ (when (the #value definition) {.#Left _} (in []) diff --git a/stdlib/source/library/lux/meta/macro/syntax/export.lux b/stdlib/source/library/lux/meta/macro/syntax/export.lux index 1bc78cb9f..04e5c730a 100644 --- a/stdlib/source/library/lux/meta/macro/syntax/export.lux +++ b/stdlib/source/library/lux/meta/macro/syntax/export.lux @@ -17,7 +17,7 @@ (Parser Code) (do [! <>.monad] [candidate .next] - (case candidate + (when candidate [_ {.#Symbol ["" _]}] (in default_policy) diff --git a/stdlib/source/library/lux/meta/macro/template.lux b/stdlib/source/library/lux/meta/macro/template.lux index cb6acd2d5..a045bd235 100644 --- a/stdlib/source/library/lux/meta/macro/template.lux +++ b/stdlib/source/library/lux/meta/macro/template.lux @@ -53,7 +53,7 @@ (do <>.monad [[module short] parser] (in (if module_side? - (case module + (when module "" short _ module) short)))) @@ -86,7 +86,7 @@ [(def .public (syntax (_ [name (<>.or (<>.and (..part true) (..part false)) (..part false))]) - (case name + (when name {.#Left [simple complex]} (in (list ( [(text.interposed "" simple) (text.interposed "" complex)]))) @@ -102,9 +102,9 @@ (def (applied env template) (-> Environment Code Code) - (case template + (when template [_ {.#Symbol "" name}] - (case (dictionary.value name env) + (when (dictionary.value name env) {.#Some substitute} substitute @@ -164,7 +164,7 @@ [here_name meta.current_module_name expression? (is (Meta Bit) (function (_ lux) - {try.#Success [lux (case (the .#expected lux) + {try.#Success [lux (when (the .#expected lux) {.#None} false diff --git a/stdlib/source/library/lux/meta/static.lux b/stdlib/source/library/lux/meta/static.lux index 617ce7cdb..9a8d25cfe 100644 --- a/stdlib/source/library/lux/meta/static.lux +++ b/stdlib/source/library/lux/meta/static.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except nat int rev if cond) + [lux (.except nat int rev if cond when) [abstract [monad (.only do)]] [control diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index e46516bb9..edbf2acd3 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -46,12 +46,12 @@ (Codec Text Symbol) (implementation (def (encoded [module short]) - (case module + (when module "" short _ (all text#composite module ..separator short))) (def (decoded input) - (case (text.all_split_by ..separator input) + (when (text.all_split_by ..separator input) (list short) {.#Right ["" short]} diff --git a/stdlib/source/library/lux/meta/target/common_lisp.lux b/stdlib/source/library/lux/meta/target/common_lisp.lux index b7ce2a7fb..9d92f4557 100644 --- a/stdlib/source/library/lux/meta/target/common_lisp.lux +++ b/stdlib/source/library/lux/meta/target/common_lisp.lux @@ -77,7 +77,7 @@ (def .public bool (-> Bit Literal) - (|>> (pipe.case + (|>> (pipe.when #0 ..nil #1 (..symbol "t")))) @@ -154,7 +154,7 @@ (def .public (args& singles rest) (-> (List Var/1) Var/1 Var/*) - (|> (case singles + (|> (when singles {.#End} "" @@ -404,7 +404,7 @@ (with_template [ ] [(def .public ( conditions expression) (-> (List Text) (Expression Any) (Expression Any)) - (case conditions + (when conditions {.#End} expression diff --git a/stdlib/source/library/lux/meta/target/js.lux b/stdlib/source/library/lux/meta/target/js.lux index e5a1ce144..37792d6bc 100644 --- a/stdlib/source/library/lux/meta/target/js.lux +++ b/stdlib/source/library/lux/meta/target/js.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Location Code Label or and function if undefined for comment not int try ++ -- the type_of at ,) + [lux (.except Location Code Label or and function if undefined for comment not int try ++ -- the type_of at , when) [control ["[0]" pipe]] [data @@ -73,7 +73,7 @@ (def .public boolean (-> Bit Literal) - (|>> (pipe.case + (|>> (pipe.when #0 "false" #1 "true") abstraction)) @@ -414,7 +414,7 @@ (..nested (representation then))))) (text.interposed \n+)) \n+ - (case default + (.when default {.#Some default} (format "default:" (..nested (representation default))) diff --git a/stdlib/source/library/lux/meta/target/jvm/attribute.lux b/stdlib/source/library/lux/meta/target/jvm/attribute.lux index 0b0af146e..c6ff2472f 100644 --- a/stdlib/source/library/lux/meta/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/meta/target/jvm/attribute.lux @@ -87,7 +87,7 @@ (def (length attribute) (-> Attribute Nat) - (case attribute + (when attribute (^.with_template [] [{ [name length info]} (|> length //unsigned.value (n.+ ..common_attribute_length))]) @@ -139,7 +139,7 @@ (def .public (format it) (Format Attribute) - (case it + (when it {#Constant it} ((info_format /constant.format) it) diff --git a/stdlib/source/library/lux/meta/target/jvm/bytecode.lux b/stdlib/source/library/lux/meta/target/jvm/bytecode.lux index 6123ee60e..57ea8caf8 100644 --- a/stdlib/source/library/lux/meta/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/meta/target/jvm/bytecode.lux @@ -85,7 +85,7 @@ (def try|do (template (_ ) - [(.case + [(.when {try.#Success } @@ -151,7 +151,7 @@ (let [[pool environment tracker] state] {try.#Success [state [..relative#identity - (case (dictionary.value label (the #known tracker)) + (when (dictionary.value label (the #known tracker)) {.#Some [expected {.#Some address}]} {.#Some [expected address]} @@ -164,7 +164,7 @@ (let [[pool environment tracker] state] {try.#Success [state [..relative#identity - (case (dictionary.value label (the #known tracker)) + (when (dictionary.value label (the #known tracker)) {.#Some [expected {.#None}]} {.#Some expected} @@ -190,7 +190,7 @@ (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) (let [@here (the #program_counter tracker)] - (case (dictionary.value label (the #known tracker)) + (when (dictionary.value label (the #known tracker)) {.#Some [expected {.#Some address}]} (exception.except ..label_has_already_been_set [label]) @@ -211,7 +211,7 @@ (implementation (def (each $ it) (function (_ state) - (case (it state) + (when (it state) {try.#Success [state' [relative it]]} {try.#Success [state' [relative ($ it)]]} @@ -230,9 +230,9 @@ (def (conjoint ^^it) (function (_ state) - (case (^^it state) + (when (^^it state) {try.#Success [state' [left ^it]]} - (case (^it state') + (when (^it state') {try.#Success [state'' [right it]]} {try.#Success [state'' [(relative#composite left right) it]]} @@ -248,7 +248,7 @@ (-> (Bytecode Any) (Bytecode Any)) (do ..monad [stack ..stack] - (.case stack + (.when stack {.#Some _} it @@ -260,7 +260,7 @@ (-> Label (Bytecode Any) (Bytecode Any)) (do ..monad [?@ (..acknowledged? @)] - (.case ?@ + (.when ?@ {.#Some _} it @@ -557,7 +557,7 @@ (-> //constant.UTF8 (Bytecode Any)) (do ..monad [index (..lifted (//constant/pool.string value))] - (case (|> index //index.value //unsigned.value //unsigned.u1) + (when (|> index //index.value //unsigned.value //unsigned.u1) {try.#Success index} (..bytecode $0 $1 @_ _.ldc [index]) @@ -575,14 +575,14 @@ (with_template [ ] [(def .public ( value) (-> (Bytecode Any)) - (case (|> value ) + (when (|> value ) (^.with_template [ ] [ (..bytecode $0 $1 @_ [])]) _ (do ..monad [index (..lifted ( ( value)))] - (case (|> index //index.value //unsigned.value //unsigned.u1) + (when (|> index //index.value //unsigned.value //unsigned.u1) {try.#Success index} (..bytecode $0 $1 @_ _.ldc [index]) @@ -604,7 +604,7 @@ (-> java/lang/Float (Bytecode Any)) (do ..monad [index (..lifted (//constant/pool.float (//constant.float value)))] - (case (|> index //index.value //unsigned.value //unsigned.u1) + (when (|> index //index.value //unsigned.value //unsigned.u1) {try.#Success index} (..bytecode $0 $1 @_ _.ldc [index]) @@ -625,7 +625,7 @@ (if (i.= ..negative_zero_float_bits (..float_bits value)) (..arbitrary_float value) - (case (|> value ffi.float_to_double (as Frac)) + (when (|> value ffi.float_to_double (as Frac)) (^.with_template [ ] [ (..bytecode $0 $1 @_ [])]) ([+0.0 _.fconst_0] @@ -637,7 +637,7 @@ (with_template [ ] [(def .public ( value) (-> (Bytecode Any)) - (case (|> value ) + (when (|> value ) (^.with_template [ ] [ (..bytecode $0 $2 @_ [])]) @@ -671,7 +671,7 @@ (if (i.= ..negative_zero_double_bits (..double_bits value)) (..arbitrary_double value) - (case (as Frac value) + (when (as Frac value) (^.with_template [ ] [ (..bytecode $0 $2 @_ [])]) ([+0.0 _.dconst_0] @@ -685,7 +685,7 @@ (def (register id) (-> Nat (Bytecode Register)) - (case (//unsigned.u1 id) + (when (//unsigned.u1 id) {try.#Success register} (at ..monad in register) @@ -696,7 +696,7 @@ [(def .public ( local) (-> Nat (Bytecode Any)) (with_expansions [' (template.spliced )] - (`` (case local + (`` (when local (,, (with_template [ ] [ (..bytecode $0 [])] @@ -736,7 +736,7 @@ [(def .public ( local) (-> Nat (Bytecode Any)) (with_expansions [' (template.spliced )] - (`` (case local + (`` (when local (,, (with_template [ ] [ (..bytecode $0 [])] @@ -815,7 +815,7 @@ (def (resolve_label label resolver) (-> Label Resolver (Try [Stack Address])) - (case (dictionary.value label resolver) + (when (dictionary.value label resolver) {.#Some [actual {.#Some address}]} {try.#Success [actual address]} @@ -828,7 +828,7 @@ (def (acknowledge_label stack label tracker) (-> Stack Label Tracker Tracker) - (case (dictionary.value label (the #known tracker)) + (when (dictionary.value label (the #known tracker)) {.#Some _} tracker @@ -857,7 +857,7 @@ (try|do _ (exception.assertion ..mismatched_environments [(symbol ) label @here expected actual] (at /stack.equivalence = expected actual))) (try|do jump (..jump @from @to)) - (case jump + (when jump {.#Left jump} (exception.except ..cannot_do_a_big_jump [label @from jump]) @@ -901,12 +901,12 @@ (..acknowledge_label actual label) (has #program_counter program_counter'))] [(function (_ resolver) - (case (dictionary.value label resolver) + (when (dictionary.value label resolver) {.#Some [expected {.#Some @to}]} (<| (try|do _ (exception.assertion ..mismatched_environments [(symbol ) label @here expected actual] (at /stack.equivalence = expected actual))) (try|do jump (..jump @from @to)) - (case jump + (when jump {.#Left jump} @@ -931,7 +931,7 @@ (def (big_jump jump) (-> Any_Jump Big_Jump) - (case jump + (when jump {.#Left big} big @@ -957,7 +957,7 @@ (let [get (is (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.value label resolver)))] - (case (do [! maybe.monad] + (when (do [! maybe.monad] [@default (|> default get (monad.then ! product.right)) @at_minimum (|> at_minimum get (monad.then ! product.right))] (|> afterwards @@ -999,7 +999,7 @@ (let [get (is (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.value label resolver)))] - (case (do [! maybe.monad] + (when (do [! maybe.monad] [@default (|> default get (monad.then ! product.right))] (|> cases (monad.each ! (|>> product.right get)) @@ -1050,7 +1050,7 @@ (-> (Type Object) U1 (Bytecode Any)) (do ..monad [_ (is (Bytecode Any) - (case (|> dimensions //unsigned.value) + (when (|> dimensions //unsigned.value) 0 (..except ..multiarray_cannot_be_zero_dimensional [class]) _ (in []))) index (..lifted (//constant/pool.class (//name.internal (..reflection class))))] @@ -1162,9 +1162,9 @@ (All (_ pre post) (-> (Bytecode pre) (Bytecode post) (Bytecode post))) (function (_ state) - (case (pre state) + (when (pre state) {try.#Success [state' [left _]]} - (case (post state') + (when (post state') {try.#Success [state'' [right it]]} {try.#Success [state'' [(relative#composite left right) it]]} diff --git a/stdlib/source/library/lux/meta/target/jvm/bytecode/environment.lux b/stdlib/source/library/lux/meta/target/jvm/bytecode/environment.lux index 49e3455f4..dd33b7853 100644 --- a/stdlib/source/library/lux/meta/target/jvm/bytecode/environment.lux +++ b/stdlib/source/library/lux/meta/target/jvm/bytecode/environment.lux @@ -53,7 +53,7 @@ (def .public (stack environment) (-> Environment (Try Stack)) - (case (the ..#stack environment) + (when (the ..#stack environment) {.#Some stack} {try.#Success stack} @@ -72,7 +72,7 @@ (def .public (continue expected environment) (-> Stack Environment (Try [Stack Environment])) - (case (the ..#stack environment) + (when (the ..#stack environment) {.#Some actual} (if (at /stack.equivalence = expected actual) {try.#Success [actual environment]} diff --git a/stdlib/source/library/lux/meta/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/meta/target/jvm/bytecode/instruction.lux index 9dc19ed00..573424e12 100644 --- a/stdlib/source/library/lux/meta/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/meta/target/jvm/bytecode/instruction.lux @@ -608,7 +608,7 @@ maximum (///signed.+/4 minimum amount_of_afterwards)] (in (let [_ (binary.has_8! offset (hex "AA") binary) offset (n.+ (///unsigned.value ..opcode_size) offset) - _ (case padding + _ (when padding 3 (|> binary (binary.has_8! offset 0) (binary.has_16! (++ offset) 0)) @@ -624,7 +624,7 @@ (loop (again [offset (n.+ (///unsigned.value ..integer_size) offset) afterwards (is (List Big_Jump) {.#Item at_minimum afterwards})]) - (case afterwards + (when afterwards {.#End} binary @@ -668,7 +668,7 @@ [(n.+ lookupswitch_size offset) (let [_ (binary.has_8! offset (hex "AB") binary) offset (n.+ (///unsigned.value ..opcode_size) offset) - _ (case padding + _ (when padding 3 (|> binary (binary.has_8! offset 0) (binary.has_16! (++ offset) 0)) @@ -681,7 +681,7 @@ _ (binary.has_32! offset amount_of_cases binary)] (loop (again [offset (n.+ (///unsigned.value ..integer_size) offset) cases cases]) - (case cases + (when cases {.#End} binary diff --git a/stdlib/source/library/lux/meta/target/jvm/class.lux b/stdlib/source/library/lux/meta/target/jvm/class.lux index bd9fdd41b..1a5b3a1d8 100644 --- a/stdlib/source/library/lux/meta/target/jvm/class.lux +++ b/stdlib/source/library/lux/meta/target/jvm/class.lux @@ -103,7 +103,7 @@ [classes (install_classes this super interfaces) =fields (monad.all ! fields) =methods (monad.all ! methods) - @signature (case signature + @signature (when signature {.#Some signature} (at ! each (|>> {.#Some}) (//attribute.signature signature)) @@ -120,7 +120,7 @@ #interfaces @interfaces #fields (sequence.of_list =fields) #methods (sequence.of_list =methods) - #attributes (case @signature + #attributes (when @signature {.#Some @signature} (sequence.suffix @signature attributes) diff --git a/stdlib/source/library/lux/meta/target/jvm/constant.lux b/stdlib/source/library/lux/meta/target/jvm/constant.lux index a56a74c11..d05df9511 100644 --- a/stdlib/source/library/lux/meta/target/jvm/constant.lux +++ b/stdlib/source/library/lux/meta/target/jvm/constant.lux @@ -171,7 +171,7 @@ (def .public (size constant) (-> Constant Nat) - (case constant + (when constant (^.or {#Long _} {#Double _}) 2 @@ -184,7 +184,7 @@ ... version below as soon as the new format for variants is implemented. (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [ ] [[{ reference} { sample}] (at = reference sample)]) @@ -242,7 +242,7 @@ ... TODO: Invoke_Dynamic )] (function (_ value) - (case value + (when value (^.with_template [ ] [{ value} (binaryF#composite (/tag.format ) diff --git a/stdlib/source/library/lux/meta/target/jvm/constant/pool.lux b/stdlib/source/library/lux/meta/target/jvm/constant/pool.lux index d3a8c2546..759d88314 100644 --- a/stdlib/source/library/lux/meta/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/meta/target/jvm/constant/pool.lux @@ -49,7 +49,7 @@ (implementation (def (each $ it) (|>> it - (pipe.case + (pipe.when {try.#Success [state output]} {try.#Success [state ($ output)]} @@ -68,7 +68,7 @@ (def (conjoint it) (function (_ state) - (case (it state) + (when (it state) {try.#Success [state' it']} (it' state') @@ -78,7 +78,7 @@ (def try|each (template (_ ) - [(case + [(when {try.#Success } @@ -96,9 +96,9 @@ ' ] (with_expansions [ (these (again (.++ idx)))] (loop (again [idx 0]) - (case (sequence.item idx pool) + (when (sequence.item idx pool) {try.#Success entry} - (case entry + (when entry [index { reference}] (if (at = reference ') {try.#Success [[current pool] @@ -127,7 +127,7 @@ (def /|each (template (_ ) - [(case ( ) + [(when ( ) {try.#Success [ ]} diff --git a/stdlib/source/library/lux/meta/target/jvm/field.lux b/stdlib/source/library/lux/meta/target/jvm/field.lux index e0561b457..49c60849e 100644 --- a/stdlib/source/library/lux/meta/target/jvm/field.lux +++ b/stdlib/source/library/lux/meta/target/jvm/field.lux @@ -73,7 +73,7 @@ (in [#modifier modifier #name @name #descriptor @descriptor - #attributes (case @signature + #attributes (when @signature {.#Some @signature} (sequence.suffix @signature attributes) diff --git a/stdlib/source/library/lux/meta/target/jvm/loader.lux b/stdlib/source/library/lux/meta/target/jvm/loader.lux index 05d45cfad..c8d70c482 100644 --- a/stdlib/source/library/lux/meta/target/jvm/loader.lux +++ b/stdlib/source/library/lux/meta/target/jvm/loader.lux @@ -117,9 +117,9 @@ "throws" [java/lang/ClassNotFoundException] (let [class_name (as Text class_name) classes (|> library atom.read! io.run!)] - (case (dictionary.value class_name classes) + (when (dictionary.value class_name classes) {.#Some bytecode} - (case (..define class_name bytecode (<| self)) + (when (..define class_name bytecode (<| self)) {try.#Success class} (as_expected class) diff --git a/stdlib/source/library/lux/meta/target/jvm/method.lux b/stdlib/source/library/lux/meta/target/jvm/method.lux index 3db1be9bc..ec4780b0f 100644 --- a/stdlib/source/library/lux/meta/target/jvm/method.lux +++ b/stdlib/source/library/lux/meta/target/jvm/method.lux @@ -63,10 +63,10 @@ attributes) (monad.all !) (at ! each sequence.of_list)) - attributes (case code + attributes (when code {.#Some code} (do ! - [environment (case (if (//modifier.has? static modifier) + [environment (when (if (//modifier.has? static modifier) (//environment.static type) (//environment.virtual type)) {try.#Success environment} diff --git a/stdlib/source/library/lux/meta/target/jvm/reflection.lux b/stdlib/source/library/lux/meta/target/jvm/reflection.lux index 0ee71e599..a33bc6507 100644 --- a/stdlib/source/library/lux/meta/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/meta/target/jvm/reflection.lux @@ -112,7 +112,7 @@ (def .public (load class_loader name) (-> java/lang/ClassLoader External (Try (java/lang/Class java/lang/Object))) - (case (java/lang/Class::forName name false class_loader) + (when (java/lang/Class::forName name false class_loader) {try.#Failure _} (exception.except ..unknown_class [name]) @@ -130,7 +130,7 @@ (-> (-> java/lang/reflect/Type (Try (/.Type Parameter))) java/lang/reflect/Type (Try (/.Type Class))) - (<| (case (ffi.as java/lang/Class reflection) + (<| (when (ffi.as java/lang/Class reflection) {.#Some class} (let [class_name (|> class (as (java/lang/Class java/lang/Object)) @@ -151,10 +151,10 @@ (exception.except ..not_a_class [reflection]) {try.#Success (/.class class_name (list))}))) _) - (case (ffi.as java/lang/reflect/ParameterizedType reflection) + (when (ffi.as java/lang/reflect/ParameterizedType reflection) {.#Some reflection} (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)] - (case (ffi.as java/lang/Class raw) + (when (ffi.as java/lang/Class raw) {.#Some raw'} (let [! try.monad] (|> reflection @@ -175,19 +175,19 @@ (def .public (parameter type reflection) (-> (-> java/lang/reflect/Type (Try (/.Type Value))) (-> java/lang/reflect/Type (Try (/.Type Parameter)))) - (<| (case (ffi.as java/lang/reflect/TypeVariable reflection) + (<| (when (ffi.as java/lang/reflect/TypeVariable reflection) {.#Some reflection} {try.#Success (/.var (java/lang/reflect/TypeVariable::getName reflection))} _) - (case (ffi.as java/lang/reflect/WildcardType reflection) + (when (ffi.as java/lang/reflect/WildcardType reflection) {.#Some reflection} ... TODO: Instead of having single lower/upper bounds, should ... allow for multiple ones. - (case [(array.item 0 (java/lang/reflect/WildcardType::getLowerBounds reflection)) + (when [(array.item 0 (java/lang/reflect/WildcardType::getLowerBounds reflection)) (array.item 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))] (^.with_template [ ] [ - (case (ffi.as java/lang/reflect/GenericArrayType bound) + (when (ffi.as java/lang/reflect/GenericArrayType bound) {.#Some it} ... TODO: Array bounds should not be "erased" as they ... are right now. @@ -201,14 +201,14 @@ _ {try.#Success /.wildcard}) _) - (case (ffi.as java/lang/reflect/GenericArrayType reflection) + (when (ffi.as java/lang/reflect/GenericArrayType reflection) {.#Some reflection} (|> reflection java/lang/reflect/GenericArrayType::getGenericComponentType type (at try.monad each /.array)) _) - (case (ffi.as java/lang/Class reflection) + (when (ffi.as java/lang/Class reflection) {.#Some class} (if (java/lang/Class::isArray class) (|> class @@ -221,7 +221,7 @@ (def .public (type reflection) (-> java/lang/reflect/Type (Try (/.Type Value))) - (<| (case (ffi.as java/lang/Class reflection) + (<| (when (ffi.as java/lang/Class reflection) {.#Some reflection} (let [class_name (|> reflection (as (java/lang/Class java/lang/Object)) @@ -254,7 +254,7 @@ (def .public (return reflection) (-> java/lang/reflect/Type (Try (/.Type Return))) (with_expansions [ (these (..type reflection))] - (case (ffi.as java/lang/Class reflection) + (when (ffi.as java/lang/Class reflection) {.#Some class} (let [class_name (|> reflection (as (java/lang/Class java/lang/Object)) @@ -289,8 +289,8 @@ (def .public (correspond class type) (-> (java/lang/Class java/lang/Object) Type (Try Mapping)) - (case type - {.#Primitive array.type_name (list :member:)} + (when type + {.#Primitive array.primitive (list :member:)} (if (java/lang/Class::isArray class) (correspond (java/lang/Class::getComponentType class) :member:) @@ -317,7 +317,7 @@ (correspond class anonymousT) {.#Apply inputT abstractionT} - (case (type.applied (list inputT) abstractionT) + (when (type.applied (list inputT) abstractionT) {.#Some outputT} (correspond class outputT) @@ -349,7 +349,7 @@ (def .public (field field target) (-> Text (java/lang/Class java/lang/Object) (Try java/lang/reflect/Field)) - (case (java/lang/Class::getDeclaredField field target) + (when (java/lang/Class::getDeclaredField field target) {try.#Success field} (let [owner (java/lang/reflect/Field::getDeclaringClass field)] (if (same? owner target) @@ -372,7 +372,7 @@ (do [! try.monad] [fieldJ (..field field class) .let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]] - (case (java/lang/reflect/Modifier::isStatic modifiers) + (when (java/lang/reflect/Modifier::isStatic modifiers) (|> fieldJ java/lang/reflect/Field::getGenericType ..type diff --git a/stdlib/source/library/lux/meta/target/jvm/type/lux.lux b/stdlib/source/library/lux/meta/target/jvm/type/lux.lux index 3af93e1b5..4f6d9076f 100644 --- a/stdlib/source/library/lux/meta/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/meta/target/jvm/type/lux.lux @@ -121,7 +121,7 @@ (-> Mapping (Parser (Check Type))) (do <>.monad [var //parser.var'] - (in (case (dictionary.value var mapping) + (in (when (dictionary.value var mapping) {.#None} (check.except ..unknown_var [var]) @@ -174,7 +174,7 @@ (def array (-> (Parser (Check Type)) (Parser (Check Type))) (|>> (<>#each (check#each (function (_ elementT) - (case elementT + (when elementT {.#Primitive name {.#End}} (if (`` (or (,, (with_template [] [(text#= (//reflection.reflection ) name)] @@ -230,7 +230,7 @@ (def .public (check operation input) (All (_ a) (-> (Parser (Check a)) Text (Check a))) - (case (.result operation input) + (when (.result operation input) {try.#Success check} check diff --git a/stdlib/source/library/lux/meta/target/jvm/type/signature.lux b/stdlib/source/library/lux/meta/target/jvm/type/signature.lux index 6afc33607..96a912cde 100644 --- a/stdlib/source/library/lux/meta/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/meta/target/jvm/type/signature.lux @@ -95,7 +95,7 @@ (abstraction (format //descriptor.class_prefix (|> name ///name.internal ///name.read) - (case parameters + (when parameters {.#End} "" @@ -130,7 +130,7 @@ (def var_declaration/* (-> (List (Signature Var)) Text) - (|>> (pipe.case + (|>> (pipe.when {.#End} "" diff --git a/stdlib/source/library/lux/meta/target/lua.lux b/stdlib/source/library/lux/meta/target/lua.lux index 1ea2f196c..8168b065b 100644 --- a/stdlib/source/library/lux/meta/target/lua.lux +++ b/stdlib/source/library/lux/meta/target/lua.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Location Code Label int if function or and not let local comment the) + [lux (.except Location Code Label int if function or and not let local comment the when) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] @@ -91,7 +91,7 @@ (def .public boolean (-> Bit Literal) - (|>> (pipe.case + (|>> (pipe.when #0 "false" #1 "true") abstraction)) @@ -375,7 +375,7 @@ (def arity_inputs (syntax (_ [arity .nat]) - (in (case arity + (in (.when arity 0 (.list) _ (|> (-- arity) (enum.range n.enum 0) diff --git a/stdlib/source/library/lux/meta/target/php.lux b/stdlib/source/library/lux/meta/target/php.lux index cb7870fd2..748d852c2 100644 --- a/stdlib/source/library/lux/meta/target/php.lux +++ b/stdlib/source/library/lux/meta/target/php.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Location Code Global Label static int if cond or and not comment for try global the parameter) + [lux (.except Location Code Global Label static int if cond or and not comment for try global the parameter when) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] @@ -134,7 +134,7 @@ (def .public bool (-> Bit Literal) - (|>> (pipe.case + (|>> (pipe.when #0 "false" #1 "true") abstraction)) @@ -220,7 +220,7 @@ (def .public (closure uses arguments body!) (-> (List Argument) (List Argument) Statement Literal) - (let [uses (case uses + (let [uses (.when uses {.#End} "" @@ -234,7 +234,7 @@ (def arity_inputs (syntax (_ [arity .nat]) - (in (case arity + (in (.when arity 0 (.list) _ (|> (-- arity) (enum.range n.enum 0) diff --git a/stdlib/source/library/lux/meta/target/python.lux b/stdlib/source/library/lux/meta/target/python.lux index b3c874f26..93014c3e4 100644 --- a/stdlib/source/library/lux/meta/target/python.lux +++ b/stdlib/source/library/lux/meta/target/python.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Location Code not or and list if int comment exec try the is def) + [lux (.except Location Code not or and list if int comment exec try the is def when) ["[0]" ffi] [abstract [equivalence (.only Equivalence)] @@ -132,7 +132,7 @@ (.def .public bool (-> Bit Literal) - (|>> (pipe.case + (|>> (pipe.when #0 "False" #1 "True") abstraction)) @@ -370,7 +370,7 @@ (abstraction (format "while " (representation test) ":" (..nested (representation body!)) - (case else! + (.when else! {.#Some else!} (format \n+ "else:" (..nested (representation else!))) @@ -423,7 +423,7 @@ (.def .public (exec globals code) (-> (Maybe (Expression Any)) (Expression Any) (Statement Any)) - (let [extra (case globals + (let [extra (.when globals {.#Some globals} (.list globals) @@ -453,7 +453,7 @@ (.def arity_inputs (syntax (_ [arity .nat]) - (in (case arity + (in (.when arity 0 (.list) _ (|> (-- arity) (enum.range n.enum 0) diff --git a/stdlib/source/library/lux/meta/target/r.lux b/stdlib/source/library/lux/meta/target/r.lux index f425f584b..7da2c28bd 100644 --- a/stdlib/source/library/lux/meta/target/r.lux +++ b/stdlib/source/library/lux/meta/target/r.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Code or and list if function cond not int) + [lux (.except Code or and list if function cond not int when) [control ["[0]" pipe] ["[0]" function] @@ -113,7 +113,7 @@ (def .public bool (-> Bit Expression) - (|>> (pipe.case + (|>> (pipe.when #0 "FALSE" #1 "TRUE") abstraction)) @@ -211,7 +211,7 @@ (def arity_inputs (syntax (_ [arity .nat]) - (in (case arity + (in (.when arity 0 (.list) _ (|> arity list.indices diff --git a/stdlib/source/library/lux/meta/target/ruby.lux b/stdlib/source/library/lux/meta/target/ruby.lux index 179d0182c..628c02eb3 100644 --- a/stdlib/source/library/lux/meta/target/ruby.lux +++ b/stdlib/source/library/lux/meta/target/ruby.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Location Code static int if function or and not comment local global symbol the) + [lux (.except Location Code static int if function or and not comment local global symbol the when) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] @@ -153,7 +153,7 @@ (def .public bool (-> Bit Literal) - (|>> (pipe.case + (|>> (pipe.when #0 "false" #1 "true") abstraction)) @@ -247,7 +247,7 @@ (list#each (|>> representation)) (text.interposed ..input_separator) (text.enclosed ["(" ")"])) - block (case block + block (.when block {.#None} "" @@ -395,7 +395,7 @@ (def .public (lambda name block) (-> (Maybe LVar) Block Literal) (let [proc (format "lambda " (..block block))] - (|> (case name + (|> (.when name {.#None} proc @@ -483,7 +483,7 @@ (def arity_inputs (syntax (_ [arity .nat]) - (in (case arity + (in (.when arity 0 (.list) _ (|> (-- arity) (enum.range n.enum 0) diff --git a/stdlib/source/library/lux/meta/target/scheme.lux b/stdlib/source/library/lux/meta/target/scheme.lux index 86b9c5921..51a712a6f 100644 --- a/stdlib/source/library/lux/meta/target/scheme.lux +++ b/stdlib/source/library/lux/meta/target/scheme.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Code int or and if cond let symbol) + [lux (.except Code int or and if cond let symbol when) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)]] @@ -81,9 +81,9 @@ (def (arguments [mandatory rest]) (-> Arguments (Code Any)) - (case rest + (.when rest {.#Some rest} - (case mandatory + (.when mandatory {.#End} rest @@ -108,7 +108,7 @@ (def .public bool (-> Bit Computation) - (|>> (pipe.case + (|>> (pipe.when #0 "#f" #1 "#t") abstraction)) @@ -163,7 +163,7 @@ (def form (-> (List (Code Any)) Code) (.let [nested_new_line (format \n+ text.tab)] - (|>> (pipe.case + (|>> (pipe.when {.#End} (abstraction "()") @@ -375,7 +375,7 @@ (def .public (guard variable clauses else body) (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation) (..form (list (..var "guard") - (..form (|> (case else + (..form (|> (.when else {.#None} (list) diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index 70181ea04..a2bec39bf 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -32,7 +32,7 @@ (-> Type [Nat Type]) (loop (again [num_args 0 type type]) - (case type + (when type { env sub_type} (again (++ num_args) sub_type) @@ -45,7 +45,7 @@ (def .public (flat_function type) (-> Type [(List Type) Type]) - (case type + (when type {.#Function in out'} (.let [[ins out] (flat_function out')] [(list.partial in ins) out]) @@ -55,7 +55,7 @@ (def .public (flat_application type) (-> Type [Type (List Type)]) - (case type + (when type {.#Apply arg func'} (.let [[func args] (flat_application func')] [func (list#composite args (list arg))]) @@ -66,7 +66,7 @@ (with_template [ ] [(def .public ( type) (-> Type (List Type)) - (case type + (when type { left right} (list.partial left ( right)) @@ -79,7 +79,7 @@ (`` (def .public (format type) (-> Type Text) - (case type + (when type {.#Primitive name params} (all text#composite "(Primitive " @@ -139,7 +139,7 @@ ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction (`` (def (reduced env type) (-> (List Type) Type Type) - (case type + (when type {.#Primitive name params} {.#Primitive name (list#each (reduced env) params)} @@ -152,7 +152,7 @@ (,, (with_template [] [{ old_env def} - (case old_env + (when old_env {.#End} { env def} @@ -187,7 +187,7 @@ ... TODO: Remove this once JPHP is gone. false (same? x y)) - (case [x y] + (when [x y] [{.#Primitive xname xparams} {.#Primitive yname yparams}] (and (text#= xname yname) (n.= (list.size yparams) (list.size xparams)) @@ -237,12 +237,12 @@ (`` (def .public (applied params func) (-> (List Type) Type (Maybe Type)) - (case params + (when params {.#End} {.#Some func} {.#Item param params'} - (case func + (when func (,, (with_template [] [{ env body} (|> body @@ -263,7 +263,7 @@ (`` (def .public (code type) (-> Type Code) - (case type + (when type {.#Primitive name params} (` {.#Primitive (, (code.text name)) (.list (,* (list#each code params)))}) @@ -300,7 +300,7 @@ (def .public (de_aliased type) (-> Type Type) - (case type + (when type {.#Named _ {.#Named name type'}} (de_aliased {.#Named name type'}) @@ -309,7 +309,7 @@ (def .public (anonymous type) (-> Type Type) - (case type + (when type {.#Named name type'} (anonymous type') @@ -319,7 +319,7 @@ (with_template [ ] [(def .public ( types) (-> (List Type) Type) - (case types + (when types {.#End} @@ -335,7 +335,7 @@ (def .public (function inputs output) (-> (List Type) Type Type) - (case inputs + (when inputs {.#End} output @@ -344,7 +344,7 @@ (def .public (application params quant) (-> (List Type) Type Type) - (case params + (when params {.#End} quant @@ -354,7 +354,7 @@ (with_template [ ] [(def .public ( size body) (-> Nat Type Type) - (case size + (when size 0 body _ (|> body ( (-- size)) { (list)})))] @@ -364,7 +364,7 @@ (`` (def .public (quantified? type) (-> Type Bit) - (case type + (when type {.#Named [module name] _type} (quantified? _type) @@ -385,7 +385,7 @@ (def .public (array depth element_type) (-> Nat Type Type) - (case depth + (when depth 0 element_type _ (|> element_type (array (-- depth)) @@ -395,7 +395,7 @@ (def .public (flat_array type) (-> Type [Nat Type]) (with_expansions [ [0 type]] - (case type + (when type {.#Primitive name (list element_type)} (if (text#= array.primitive name) (.let [[depth element_type] (flat_array element_type)] @@ -423,7 +423,7 @@ (syntax (_ [input (<>.or (<>.and .symbol (<>.maybe (<>.after (.this_symbol ..secret_marker) .any))) .any)]) - (case input + (when input {.#Left [valueN valueC]} (do meta.monad [location meta.location @@ -431,7 +431,7 @@ .let [_ ("lux io log" (all text#composite (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line - "Expression: " (case valueC + "Expression: " (when valueC {.#Some valueC} (code.format valueC) @@ -459,7 +459,7 @@ (.let [casterC (` (is (All ((, g!_) (,* (list#each code.local type_vars))) (-> (, input) (, output))) (|>> as_expected)))] - (case value + (when value {.#None} (in (list casterC)) @@ -511,7 +511,7 @@ (.function (again it) (if (at ..equivalence = before it) after - (case it + (when it {.#Primitive name co_variant} {.#Primitive name (list#each again co_variant)} diff --git a/stdlib/source/library/lux/meta/type/check.lux b/stdlib/source/library/lux/meta/type/check.lux index 90fb49156..184864469 100644 --- a/stdlib/source/library/lux/meta/type/check.lux +++ b/stdlib/source/library/lux/meta/type/check.lux @@ -80,7 +80,7 @@ (implementation (def (each f fa) (function (_ context) - (case (fa context) + (when (fa context) {try.#Success [context' output]} {try.#Success [context' (f output)]} @@ -94,9 +94,9 @@ (def (on fa ff) (function (_ context) - (case (ff context) + (when (ff context) {try.#Success [context' f]} - (case (fa context') + (when (fa context') {try.#Success [context'' a]} {try.#Success [context'' (f a)]} @@ -119,9 +119,9 @@ (def (conjoint ffa) (function (_ context) - (case (ffa context) + (when (ffa context) {try.#Success [context' fa]} - (case (fa context') + (when (fa context') {try.#Success [context'' a]} {try.#Success [context'' a]} @@ -141,7 +141,7 @@ (def (var::get id property_list) (-> Var Type_Vars (Maybe (Maybe Type))) - (case property_list + (when property_list {.#Item [var_id var_type] property_list'} (if (!n#= id var_id) @@ -153,7 +153,7 @@ (def (var::put id value property_list) (-> Var (Maybe Type) Type_Vars Type_Vars) - (case property_list + (when property_list {.#End} (list [id value]) @@ -167,7 +167,7 @@ (def .public (result context proc) (All (_ a) (-> Type_Context (Check a) (Try a))) - (case (proc context) + (when (proc context) {try.#Success [context' output]} {try.#Success output} @@ -201,7 +201,7 @@ [(def .public ( id) (-> Var (Check )) (function (_ context) - (case (|> context (the .#var_bindings) (var::get id)) + (when (|> context (the .#var_bindings) (var::get id)) (^.or {.#Some {.#Some {.#Var _}}} {.#Some {.#None}}) {try.#Success [context ]} @@ -220,7 +220,7 @@ (-> Var (Check Type)) (do ..monad [?type (peek id)] - (case ?type + (when ?type {.#Some type} (in type) @@ -230,7 +230,7 @@ (def (bound id) (-> Var (Check Type)) (function (_ context) - (case (|> context (the .#var_bindings) (var::get id)) + (when (|> context (the .#var_bindings) (var::get id)) {.#Some {.#Some bound}} {try.#Success [context bound]} @@ -243,7 +243,7 @@ (def .public (bind type id) (-> Type Var (Check Any)) (function (_ context) - (case (|> context (the .#var_bindings) (var::get id)) + (when (|> context (the .#var_bindings) (var::get id)) {.#Some {.#None}} {try.#Success [(revised .#var_bindings (var::put id {.#Some type}) context) []]} @@ -257,7 +257,7 @@ (def (re_bind' ?type id) (-> (Maybe Type) Var (Check Any)) (function (_ context) - (case (|> context (the .#var_bindings) (var::get id)) + (when (|> context (the .#var_bindings) (var::get id)) {.#Some _} {try.#Success [(revised .#var_bindings (var::put id ?type) context) []]} @@ -280,11 +280,11 @@ (def (on argT funcT) (-> Type Type (Check Type)) - (case funcT + (when funcT {.#Var func_id} (do ..monad [?funcT' (peek func_id)] - (case ?funcT' + (when ?funcT' {.#Some funcT'} (on argT funcT') @@ -297,7 +297,7 @@ (on argT funcT'')) _ - (case (//.applied (list argT) funcT) + (when (//.applied (list argT) funcT) {.#Some output} (check#in output) @@ -309,9 +309,9 @@ (function (_ context) (loop (again [current start output (list start)]) - (case (|> context (the .#var_bindings) (var::get current)) + (when (|> context (the .#var_bindings) (var::get current)) {.#Some {.#Some type}} - (case type + (when type {.#Var next} (if (!n#= start next) {try.#Success [context output]} @@ -346,7 +346,7 @@ (-> (List Var) Var (Check Type)) (do [! ..monad] [:bound: (..peek @)] - (case :bound: + (when :bound: {.#Some :bound:} (in :bound:) @@ -358,7 +358,7 @@ (do ! [.let [forbidden_aliases (set.of_list n.hash (list.partial @ aliases)) allowed_aliases (set.difference forbidden_aliases existing_aliases)]] - (case (set.list allowed_aliases) + (when (set.list allowed_aliases) {.#Item identity _} (in {.#Var identity}) @@ -387,7 +387,7 @@ (-> Var (Check Any)) (do [! ..monad] [ring (..ring' @)] - (case ring + (when ring (list) (in []) @@ -400,7 +400,7 @@ (erase! @me)) (list.partial @prev _) - (case (list.reversed ring) + (when (list.reversed ring) (list.partial @me @next _) (do ! [_ (re_bind {.#Var @next} @prev) @@ -413,7 +413,7 @@ (def .public (try it) (All (_ a) (-> (Check a) (Check (Try a)))) (function (_ context) - (case (it context) + (when (it context) {try.#Success [context' output]} {try.#Success [context' {try.#Success output}]} @@ -429,7 +429,7 @@ (def (either left right) (All (_ a) (-> (Check a) (Check a) (Check a))) (function (_ context) - (case (left context) + (when (left context) {try.#Failure _} (right context) @@ -483,7 +483,7 @@ (do [! ..monad] [ebound (..try (..bound idE)) abound (..try (..bound idA))] - (case [ebound abound] + (when [ebound abound] ... Link the 2 variables circularly [{try.#Failure _} {try.#Failure _}] (do ! @@ -492,7 +492,7 @@ ... Interpose new variable between 2 existing links [{try.#Success etype} {try.#Failure _}] - (case etype + (when etype {.#Var targetE} (do ! [_ (link/3 idA targetE idE)] @@ -503,7 +503,7 @@ ... Interpose new variable between 2 existing links [{try.#Failure _} {try.#Success atype}] - (case atype + (when atype {.#Var targetA} (do ! [_ (link/3 idE targetA idA)] @@ -513,7 +513,7 @@ (check' assumptions {.#Var idE} atype)) [{try.#Success etype} {try.#Success atype}] - (case [etype atype] + (when [etype atype] [{.#Var targetE} {.#Var targetA}] (do ! [ringE (..ring idE) @@ -551,7 +551,7 @@ (-> (Checker Type) (Checker [Type Type])) (let [[expected_input expected_function] expected [actual_input actual_function] actual] - (case [expected_function actual_function] + (when [expected_function actual_function] [{.#Ex exE} {.#Ex exA}] (if (!n#= exE exA) (check' assumptions expected_input actual_input) @@ -584,7 +584,7 @@ [{.#Var id} _] (function (_ context) - (case ((do ..monad + (when ((do ..monad [expected_function' (..read id)] (check' assumptions {.#Apply expected_input expected_function'} {.#Apply actual})) context) @@ -592,7 +592,7 @@ {try.#Success output} {try.#Failure _} - (case actual_function + (when actual_function {.#UnivQ _ _} ((do ..monad [actual' (..on actual_input actual_function)] @@ -615,7 +615,7 @@ [_ {.#Var id}] (function (_ context) - (case ((do ..monad + (when ((do ..monad [actual_function' (read id)] (check' assumptions {.#Apply expected} {.#Apply actual_input actual_function'})) context) @@ -648,7 +648,7 @@ (same? expected actual)) (check#in assumptions) (with_exception ..type_check_failed [expected actual] - (case [expected actual] + (when [expected actual] [{.#Var idE} {.#Var idA}] (check_vars check' assumptions idE idA) @@ -710,7 +710,7 @@ (loop (again [assumptions assumptions e_params e_params a_params a_params]) - (case [e_params a_params] + (when [e_params a_params] [{.#End} {.#End}] (check#in assumptions) @@ -756,7 +756,7 @@ (def .public (subsumes? expected actual) (-> Type Type Bit) - (case (..result ..fresh_context + (when (..result ..fresh_context (..check expected actual)) {try.#Failure _} false @@ -776,7 +776,7 @@ (def .public (clean aliases inputT) (-> (List Var) Type (Check Type)) - (case inputT + (when inputT {.#Primitive name paramsT+} (|> paramsT+ (monad.each ..monad (clean aliases)) @@ -794,11 +794,11 @@ ([.#Sum] [.#Product] [.#Function] [.#Apply]) {.#Var @it} - (case aliases + (when aliases (list) (do ..monad [?actualT (..peek @it)] - (case ?actualT + (when ?actualT {.#Some actualT} (clean aliases actualT) @@ -808,9 +808,9 @@ _ (do ..monad [:it: (..try (..identity aliases @it))] - (case :it: + (when :it: {try.#Success :it:} - (case :it: + (when :it: {.#Var _} (in inputT) diff --git a/stdlib/source/library/lux/meta/type/implicit.lux b/stdlib/source/library/lux/meta/type/implicit.lux index 835fff931..df5da5767 100644 --- a/stdlib/source/library/lux/meta/type/implicit.lux +++ b/stdlib/source/library/lux/meta/type/implicit.lux @@ -29,10 +29,10 @@ (def (type_var id env) (-> Nat Type_Context (Meta Type)) - (case (list.example (|>> product.left (n.= id)) + (when (list.example (|>> product.left (n.= id)) (the .#var_bindings env)) {.#Some [_ {.#Some type}]} - (case type + (when type {.#Var id'} (type_var id' env) @@ -51,7 +51,7 @@ (do ///.monad [raw_type (///.type var_name) compiler ///.compiler_state] - (case raw_type + (when raw_type {.#Var id} (type_var id (the .#type_context compiler)) @@ -60,12 +60,12 @@ (def (member_type idx sig_type) (-> Nat Type (Check Type)) - (case sig_type + (when sig_type {.#Named _ sig_type'} (member_type idx sig_type') {.#Apply arg func} - (case (//.applied (list arg) func) + (when (//.applied (list arg) func) {.#None} (check.failure (format "Cannot apply type " (%.type func) " to type " (%.type arg))) @@ -84,7 +84,7 @@ (def (member_name member) (-> Symbol (Meta Symbol)) - (case member + (when member ["" simple_name] (///.either (do ///.monad [member (///.normal member) @@ -97,7 +97,7 @@ .let [tag_lists (|> tag_lists list#conjoint (list#each product.left) list#conjoint) candidates (list.only (|>> product.right (text#= simple_name)) tag_lists)]] - (case candidates + (when candidates {.#End} (///.failure (format "Unknown tag: " (%.symbol member))) @@ -181,7 +181,7 @@ (def (on_argument arg func) (-> Type Type (Check Type)) - (case func + (when func {.#Named _ func'} (on_argument arg func') @@ -203,7 +203,7 @@ (def (concrete_type type) (-> Type (Check [(List Nat) Type])) - (case type + (when type {.#UnivQ _} (do check.monad [[id var] check.var @@ -232,9 +232,9 @@ (Meta (List Instance))) (do ///.monad [compiler ///.compiler_state] - (case (|> alts + (when (|> alts (list#each (function (_ [alt_name alt_type]) - (case (check.result context + (when (check.result context (do [! check.monad] [[tvars alt_type] (concrete_type alt_type) .let [[deps alt_type] (//.flat_function alt_type)] @@ -256,7 +256,7 @@ (def (provision sig_type compiler context dep) (-> Type Lux Type_Context Type (Check Instance)) - (case (///.result compiler + (when (///.result compiler (all ///.either (do ///.monad [alts (..local_env sig_type)] (..candidate_provision (provision sig_type) context dep alts)) (do ///.monad [alts (..local_structs sig_type)] (..candidate_provision (provision sig_type) context dep alts)) @@ -265,7 +265,7 @@ (check.failure error) {.#Right candidates} - (case candidates + (when candidates {.#End} (check.failure (format "No candidates for provisioning: " (%.type dep))) @@ -281,9 +281,9 @@ (do ///.monad [compiler ///.compiler_state context ///.type_context] - (case (|> alts + (when (|> alts (list#each (function (_ [alt_name alt_type]) - (case (<| (check.result context) + (when (<| (check.result context) (do [! check.monad] [[tvars alt_type] (concrete_type alt_type) .let [[deps alt_type] (//.flat_function alt_type)] @@ -315,7 +315,7 @@ (def (var? input) (-> Code Bit) - (case input + (when input [_ {.#Symbol _}] #1 @@ -328,7 +328,7 @@ (def (instance$ [constructor dependencies]) (-> Instance Code) - (case dependencies + (when dependencies {.#End} (code.symbol constructor) @@ -339,14 +339,14 @@ (syntax (_ [member .symbol args (<>.or (<>.and (<>.some .symbol) .end) (<>.and (<>.some .any) .end))]) - (case args + (when args {.#Left [args _]} (do [! ///.monad] [[member_idx sig_type] (..implicit_member member) input_types (monad.each ! ..implicit_type args) output_type ///.expected_type chosen_ones (alternatives sig_type member_idx input_types output_type)] - (case chosen_ones + (when chosen_ones {.#End} (///.failure (format "No implementation could be found for member: " (%.symbol member))) diff --git a/stdlib/source/library/lux/meta/type/poly.lux b/stdlib/source/library/lux/meta/type/poly.lux index a9a533d94..cccc9e518 100644 --- a/stdlib/source/library/lux/meta/type/poly.lux +++ b/stdlib/source/library/lux/meta/type/poly.lux @@ -33,7 +33,7 @@ (in (.list (` (syntax ((, g!_) [(, g!type) .any]) (do ///.monad [(, g!type) (///.eval .Type (, g!type))] - (case (is (.Either .Text .Code) + (when (is (.Either .Text .Code) (.result (<>.rec (function ((, g!_) (, g!name)) (, body))) @@ -46,7 +46,7 @@ (def .public (code env type) (-> Env Type Code) - (case type + (when type {.#Primitive name params} (` {.#Primitive (, (code.text name)) (.list (,* (list#each (code env) params)))}) @@ -64,7 +64,7 @@ {.#Apply {.#Primitive "" {.#End}} {.#Parameter idx}} - (case (.argument env idx) + (when (.argument env idx) 0 (|> env (dictionary.value 0) maybe.trusted product.left (code env)) idx (undefined)) diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux index ea277d239..8c6b0a98e 100644 --- a/stdlib/source/library/lux/meta/type/primitive.lux +++ b/stdlib/source/library/lux/meta/type/primitive.lux @@ -46,7 +46,7 @@ [(def .public (syntax (_ [[frame value] ..cast]) (do meta.monad - [[name type_vars abstraction representation] (case frame + [[name type_vars abstraction representation] (when frame {.#Some frame} (..specific frame) diff --git a/stdlib/source/library/lux/meta/type/quotient.lux b/stdlib/source/library/lux/meta/type/quotient.lux index 0687af5ce..04058c1e1 100644 --- a/stdlib/source/library/lux/meta/type/quotient.lux +++ b/stdlib/source/library/lux/meta/type/quotient.lux @@ -51,7 +51,7 @@ ... (..Class (, g!t) (, g!c) (, g!%))) ... (, class)) ] - (.case (.type_of (, class)) + (.when (.type_of (, class)) {.#Apply (, g!%) {.#Apply (, g!c) {.#Apply (, g!t) (, g!:quotient:)}}} (.type_literal (..Quotient (, g!t) (, g!c) (, g!%))) diff --git a/stdlib/source/library/lux/meta/type/refinement.lux b/stdlib/source/library/lux/meta/type/refinement.lux index 5b7e939a5..fb7553897 100644 --- a/stdlib/source/library/lux/meta/type/refinement.lux +++ b/stdlib/source/library/lux/meta/type/refinement.lux @@ -55,12 +55,12 @@ (def .public (only refiner values) (All (_ t %) (-> (Refiner t %) (List t) (List (Refined t %)))) - (case values + (when values {.#End} {.#End} {.#Item head tail} - (case (refiner head) + (when (refiner head) {.#Some refined} {.#Item refined (only refiner tail)} @@ -70,13 +70,13 @@ (def .public (partition refiner values) (All (_ t %) (-> (Refiner t %) (List t) [(List (Refined t %)) (List t)])) - (case values + (when values {.#End} [{.#End} {.#End}] {.#Item head tail} (let [[yes no] (partition refiner tail)] - (case (refiner head) + (when (refiner head) {.#Some refined} [{.#Item refined yes} no] @@ -93,7 +93,7 @@ ... (..Refined (, g!t) (, g!%))) ... (, refiner)) ] - (.case (.type_of (, refiner)) + (.when (.type_of (, refiner)) {.#Apply (, g!%) {.#Apply (, g!t) (, g!:refiner:)}} (.type_literal (..Refined (, g!t) (, g!%))) diff --git a/stdlib/source/library/lux/meta/type/resource.lux b/stdlib/source/library/lux/meta/type/resource.lux index 3e652b8b9..7b1a83195 100644 --- a/stdlib/source/library/lux/meta/type/resource.lux +++ b/stdlib/source/library/lux/meta/type/resource.lux @@ -130,7 +130,7 @@ (def .public exchange (syntax (_ [swaps ..indices]) (macro.with_symbols [g!_ g!context g!!] - (case swaps + (when swaps {.#End} (in (list (` ..no_op))) diff --git a/stdlib/source/library/lux/meta/version.lux b/stdlib/source/library/lux/meta/version.lux index a1e00e3d4..af8da3bce 100644 --- a/stdlib/source/library/lux/meta/version.lux +++ b/stdlib/source/library/lux/meta/version.lux @@ -35,7 +35,7 @@ default (<>.maybe .any)]) (do meta.monad [current meta.version] - (case (list#mix (function (_ [when then] choice) + (when (list#mix (function (_ [when then] choice) (if (text#= when current) {.#Some then} choice)) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 794dcbcc8..9c9e5148a 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -43,14 +43,14 @@ (, g!_) thread.run!] ((,' in) (, g!output)))))] (in (list (` (is Program - (, (case args + (, (when args {#Raw args} (` (.function ((, g!program) (, (code.symbol ["" args]))) (, initialization+event_loop))) {#Parsed args} (` (.function ((, g!program) (, g!args)) - (case (.result (.is (.Parser (io.IO .Any)) + (when (.result (.is (.Parser (io.IO .Any)) (do <>.monad [(,* args) (, g!_) .end] diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux index ff61d64d5..e18d7b36b 100644 --- a/stdlib/source/library/lux/test/property.lux +++ b/stdlib/source/library/lux/test/property.lux @@ -110,7 +110,7 @@ (def .public (times amount test) (-> Nat Test Test) - (case amount + (when amount 0 (..failure (exception.error ..must_try_test_at_least_once [])) _ (do random.monad [seed random.nat] @@ -120,7 +120,7 @@ [[tally documentation] instance] (if (..failed? tally) (in [tally (times_failure seed documentation)]) - (case amount + (when amount 1 instance _ (|> test (times (-- amount)) @@ -143,7 +143,7 @@ unexpected_coverage (set.size unexpected) actual_coverage (n.- unexpected_coverage (set.size (the tally.#actual tally))) - coverage (case expected_coverage + coverage (when expected_coverage 0 "N/A" expected (let [missing_ratio (f./ (n.frac expected) (n.frac (set.size missing))) @@ -197,7 +197,7 @@ (..description duration tally) text.new_line)] _ (with_expansions [ (in {try.#Success (debug.log! report)})] - (.for @.js (case console.default + (.for @.js (when console.default {.#None} @@ -205,7 +205,7 @@ (console.write_line report console)) ))] (async.future (at environment.default exit - (case (the tally.#failures tally) + (when (the tally.#failures tally) 0 ..success_exit_code _ ..failure_exit_code))))) @@ -236,7 +236,7 @@ (def .public (in_parallel tests) (-> (List Test) Test) - (case (list.size tests) + (when (list.size tests) 0 (random#in (async#in [tally.empty ""])) @@ -249,7 +249,7 @@ product.right (function (_ _)) "lux try" - (pipe.case + (pipe.when {try.#Success output} output diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index b1ae1618c..71761bead 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -70,7 +70,7 @@ (IO (Try (Console IO))) (do io.monad [?jvm_console (java/lang/System::console)] - (case ?jvm_console + (when ?jvm_console {.#None} (in (exception.except ..cannot_open [])) @@ -122,10 +122,10 @@ (def !read (template (_ ) [(let [it (process::stdin)] - (case (Readable_Stream::read it) + (when (Readable_Stream::read it) {.#Some buffer} (let [input (Buffer::toString buffer)] - (case (is (Maybe [ Text]) + (when (is (Maybe [ Text]) ) {.#Some [head tail]} (exec @@ -189,7 +189,7 @@ [(def ( _) (do [! io.monad] [|state| (atom.read! state)] - (case (at mock |state|) + (when (at mock |state|) {try.#Success [|state| output]} (do ! [_ (atom.write! |state| state)] @@ -205,7 +205,7 @@ (def (write input) (do [! io.monad] [|state| (atom.read! state)] - (case (at mock on_write input |state|) + (when (at mock on_write input |state|) {try.#Success |state|} (do ! [_ (atom.write! |state| state)] @@ -217,7 +217,7 @@ (def (close _) (do [! io.monad] [|state| (atom.read! state)] - (case (at mock on_close |state|) + (when (at mock on_close |state|) {try.#Success |state|} (do ! [_ (atom.write! |state| state)] diff --git a/stdlib/source/library/lux/world/db/jdbc/output.lux b/stdlib/source/library/lux/world/db/jdbc/output.lux index 383f565dc..6e7976a2c 100644 --- a/stdlib/source/library/lux/world/db/jdbc/output.lux +++ b/stdlib/source/library/lux/world/db/jdbc/output.lux @@ -6,7 +6,6 @@ [functor (.only Functor)] [apply (.only Apply)] [monad (.only Monad do)] - ["ex" exception] ["[0]" try (.only Try)] ["[0]" io (.only IO)]] [world @@ -55,7 +54,7 @@ (implementation (def (each f fa) (function (_ idx+rs) - (case (fa idx+rs) + (when (fa idx+rs) {try.#Failure error} {try.#Failure error} @@ -69,9 +68,9 @@ (def (apply ff fa) (function (_ [idx rs]) - (case (ff [idx rs]) + (when (ff [idx rs]) {try.#Success [idx' f]} - (case (fa [idx' rs]) + (when (fa [idx' rs]) {try.#Success [idx'' a]} {try.#Success [idx'' (f a)]} @@ -92,7 +91,7 @@ (def (conjoint mma) (function (_ [idx rs]) - (case (mma [idx rs]) + (when (mma [idx rs]) {try.#Failure error} {try.#Failure error} @@ -116,7 +115,7 @@ [(def .public (Output ) (function (_ [idx result_set]) - (case ( [(.int idx)] result_set) + (when ( [(.int idx)] result_set) {try.#Failure error} {try.#Failure error} @@ -141,7 +140,7 @@ [(def .public (Output Instant) (function (_ [idx result_set]) - (case ( [(.int idx)] result_set) + (when ( [(.int idx)] result_set) {try.#Failure error} {try.#Failure error} @@ -156,14 +155,14 @@ (def .public (rows output results) (All (_ a) (-> (Output a) java/sql/ResultSet (IO (Try (List a))))) - (case (java/sql/ResultSet::next results) + (when (java/sql/ResultSet::next results) {try.#Success has_next?} (if has_next? - (case (output [1 results]) + (when (output [1 results]) {.#Some [_ head]} (do io.monad [?tail (rows output results)] - (case ?tail + (when ?tail {try.#Success tail} (in {try.#Success {.#Item head tail}}) diff --git a/stdlib/source/library/lux/world/db/sql.lux b/stdlib/source/library/lux/world/db/sql.lux index 70312b648..698c862bc 100644 --- a/stdlib/source/library/lux/world/db/sql.lux +++ b/stdlib/source/library/lux/world/db/sql.lux @@ -214,7 +214,7 @@ (abstraction (format " " - (case columns + (when columns {.#End} "*" @@ -292,7 +292,7 @@ (-> (List [Value Order]) (Query where having No_Order group limit offset) (Query where having With_Order group limit offset))) - (case pairs + (when pairs {.#End} (|> query representation abstraction) @@ -310,7 +310,7 @@ (-> (List Value) (Query where having order No_Group limit offset) (Query where having order With_Group limit offset))) - (case pairs + (when pairs {.#End} (|> query representation abstraction) @@ -335,7 +335,7 @@ (def .public (update table pairs) (-> Table (List [Column Value]) (Command No_Where No_Having)) (abstraction (format "UPDATE " (representation table) - (case pairs + (when pairs {.#End} "" diff --git a/stdlib/source/library/lux/world/environment.lux b/stdlib/source/library/lux/world/environment.lux index ba85d53ef..ba941b30e 100644 --- a/stdlib/source/library/lux/world/environment.lux +++ b/stdlib/source/library/lux/world/environment.lux @@ -62,7 +62,7 @@ variables)] (in (|> entries (list.all (function (_ [name value]) - (case value + (when value {try.#Success value} {.#Some [name value]} @@ -97,7 +97,7 @@ (def available_variables (function.constant (io.io (dictionary.keys environment)))) (def (variable name) - (io.io (case (dictionary.value name environment) + (io.io (when (dictionary.value name environment) {.#Some value} {try.#Success value} @@ -156,7 +156,7 @@ (def (exit_node_js! code) (-> Exit (IO Nothing)) - (case (ffi.global ..NodeJs_Process [process]) + (when (ffi.global ..NodeJs_Process [process]) {.#Some process} (NodeJs_Process::exit (i.frac code) process) @@ -173,7 +173,7 @@ (def (exit_browser! code) (-> Exit (IO Nothing)) - (case [(ffi.global ..Browser_Window [window]) + (when [(ffi.global ..Browser_Window [window]) (ffi.global ..Browser_Location [location])] [{.#Some window} {.#Some location}] (exec @@ -227,9 +227,9 @@ (-> Text Text (IO Text)) (do [! io.monad] [outcome (io/popen [command])] - (case outcome + (when outcome {try.#Success outcome} - (case outcome + (when outcome {.#Some file} (do ! [?output (LuaFile::read "*l" file) @@ -296,7 +296,7 @@ (for @.old @.jvm @.js (io.io (if ffi.on_node_js? - (case (ffi.global Object [process env]) + (when (ffi.global Object [process env]) {.#Some process/env} (|> (Object::entries [process/env]) (array.list {.#None}) @@ -332,7 +332,7 @@ (template.let [(!fetch ) [(do io.monad [value (|> name )] - (in (case value + (in (when value {.#Some value} {try.#Success ( value)} @@ -342,7 +342,7 @@ (for @.old @.jvm @.js (io.io (if ffi.on_node_js? - (case (do maybe.monad + (when (do maybe.monad [process/env (ffi.global Object [process env])] (array.item (as Nat name) (as (Array Text) process/env))) @@ -394,7 +394,7 @@ (for @.old @.jvm @.js (if ffi.on_node_js? - (case (ffi.global ..NodeJs_Process [process]) + (when (ffi.global ..NodeJs_Process [process]) {.#Some process} (NodeJs_Process::cwd process) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index cb8c48307..eb4bb69fa 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -85,7 +85,7 @@ (def (un_rooted fs path) (All (_ !) (-> (System !) Path (Maybe [Path Text]))) (let [/ (at fs separator)] - (case (text.last_index / path) + (when (text.last_index / path) {.#None} {.#None} @@ -228,7 +228,7 @@ [(def ( path) (do [! (try.with io.monad)] [?children (java/io/File::listFiles (java/io/File::new (ffi.as_string path)))] - (case ?children + (when ?children {.#Some children} (|> children (array.list {.#None}) @@ -396,7 +396,7 @@ [?stats (with_async write! (Try Stats) (Fs::stat path (..value_callback write!) node_fs))] - (in (case ?stats + (in (when ?stats {try.#Success stats} ( stats) @@ -414,7 +414,7 @@ (|> node_fs Fs::constants FsConstants::F_OK) (..any_callback write!) node_fs))] - (case outcome + (when outcome {try.#Success _} (in (exception.except ..cannot_make_directory [path])) @@ -463,7 +463,7 @@ (def (can_execute? path) (at async.monad each - (|>> (pipe.case + (|>> (pipe.when {try.#Success _} true @@ -704,7 +704,7 @@ (list#each (|>> (format path ..ruby_separator)))) output (is (List ..Path) (list))]) - (case input + (when input {.#End} (in output) @@ -899,7 +899,7 @@ ... (text#= ".." child)))))) ... output (is (List ( IO)) ... (list))]) - ... (case input + ... (when input ... {.#End} ... (in output) @@ -987,14 +987,14 @@ (-> Text Path Mock (Try [Text Mock_File])) (loop (again [directory mock trail (text.all_split_by separator path)]) - (case trail + (when trail {.#Item head tail} - (case (dictionary.value head directory) + (when (dictionary.value head directory) {.#None} (exception.except ..cannot_find_file [path]) {.#Some node} - (case [node tail] + (when [node tail] [{.#Left file} {.#End}] {try.#Success [head file]} @@ -1011,11 +1011,11 @@ (-> Text Path Instant Binary Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) - (case trail + (when trail {.#Item head tail} - (case (dictionary.value head directory) + (when (dictionary.value head directory) {.#None} - (case tail + (when tail {.#End} {try.#Success (dictionary.has head {.#Left [#mock_last_modified now @@ -1027,7 +1027,7 @@ (exception.except ..cannot_find_file [path])) {.#Some node} - (case [node tail] + (when [node tail] [{.#Left file} {.#End}] {try.#Success (dictionary.has head {.#Left (|> file @@ -1050,16 +1050,16 @@ (-> Text Path Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) - (case trail + (when trail {.#Item head tail} - (case (dictionary.value head directory) + (when (dictionary.value head directory) {.#None} (exception.except ..cannot_delete [path]) {.#Some node} - (case tail + (when tail {.#End} - (case node + (when node {.#Left file} {try.#Success (dictionary.lacks head directory)} @@ -1069,7 +1069,7 @@ (exception.except ..cannot_delete [path]))) {.#Item _} - (case node + (when node {.#Left file} (exception.except ..cannot_delete [path]) @@ -1085,7 +1085,7 @@ (All (_ a) (-> (-> a (Try a)) (Var a) (STM (Try Any)))) (do [! stm.monad] [|var| (stm.read var)] - (case (transform |var|) + (when (transform |var|) {try.#Success |var|} (do ! [_ (stm.write |var| var)] @@ -1098,11 +1098,11 @@ (-> Text Path Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) - (case trail + (when trail {.#Item head tail} - (case (dictionary.value head directory) + (when (dictionary.value head directory) {.#None} - (case tail + (when tail {.#End} {try.#Success (dictionary.has head {.#Right ..empty_mock} directory)} @@ -1110,7 +1110,7 @@ (exception.except ..cannot_make_directory [path])) {.#Some node} - (case [node tail] + (when [node tail] [{.#Right sub_directory} {.#Item _}] (do try.monad [sub_directory (again sub_directory tail)] @@ -1126,22 +1126,22 @@ (-> Text Path Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) - (case trail + (when trail {.#End} {try.#Success directory} {.#Item head tail} - (case (dictionary.value head directory) + (when (dictionary.value head directory) {.#None} (exception.except ..cannot_find_directory [path]) {.#Some node} - (case node + (when node {.#Left _} (exception.except ..cannot_find_directory [path]) {.#Right sub_directory} - (case tail + (when tail {.#End} {try.#Success sub_directory} @@ -1172,7 +1172,7 @@ (stm.commit! (do [! stm.monad] [|store| (stm.read store)] - (case (..make_mock_directory! separator path |store|) + (when (..make_mock_directory! separator path |store|) {try.#Success |store|} (do ! [_ (stm.write |store| store)] @@ -1191,7 +1191,7 @@ (in (|> directory dictionary.entries (list.all (function (_ [node_name node]) - (case node + (when node { _} {.#Some (format path separator node_name)} @@ -1275,7 +1275,7 @@ (stm.commit! (do [! stm.monad] [|store| (stm.read store)] - (case (do try.monad + (when (do try.monad [[name file] (..retrieve_mock_file! separator origin |store|) |store| (..delete_mock_node! separator origin |store|)] (..update_mock_file! separator destination (the #mock_last_modified file) (the #mock_content file) |store|)) @@ -1300,14 +1300,14 @@ (All (_ !) (-> (Monad !) (System !) Path (! (Try Any)))) (let [rooted? (text.starts_with? (at fs separator) path) segments (text.all_split_by (at fs separator) path)] - (case (if rooted? + (when (if rooted? (list.after 1 segments) segments) {.#End} (at monad in (exception.except ..cannot_make_directory [path])) {.#Item head tail} - (case head + (when head "" (at monad in (exception.except ..cannot_make_directory [path])) _ (loop (again [current (if rooted? (format (at fs separator) head) @@ -1315,9 +1315,9 @@ next tail]) (do monad [? (..check_or_make_directory monad fs current)] - (case ? + (when ? {try.#Success _} - (case next + (when next {.#End} (in {try.#Success []}) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index 91cd25c53..c0d79ea50 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -114,7 +114,7 @@ (-> Concern //.Path (Var Directory_Tracker) (STM Bit)) (do [! stm.monad] [@tracker (stm.read tracker)] - (case (dictionary.value path @tracker) + (when (dictionary.value path @tracker) {.#Some [old_concern last_modified]} (do ! [_ (stm.update (dictionary.has path [new_concern last_modified]) tracker)] @@ -210,7 +210,7 @@ (stm.commit! (do stm.monad [@tracker (stm.read tracker)] - (in (case (dictionary.value path @tracker) + (in (when (dictionary.value path @tracker) {.#Some [it file_tracker]} {try.#Success it} @@ -220,7 +220,7 @@ (stm.commit! (do [! stm.monad] [@tracker (stm.read tracker)] - (case (dictionary.value path @tracker) + (when (dictionary.value path @tracker) {.#Some [the_concern file_tracker]} (do ! [_ (stm.update (dictionary.lacks path) tracker)] @@ -381,7 +381,7 @@ (list))]) (do (try.with io.monad) [?key (java/nio/file/WatchService::poll watcher)] - (case ?key + (when ?key {.#Some key} (do [! io.monad] [valid? (java/nio/file/WatchKey::reset key)] @@ -427,7 +427,7 @@ (function (_ path) (do [! async.monad] [@tracker (stm.commit! (stm.read tracker))] - (case (dictionary.value path @tracker) + (when (dictionary.value path @tracker) {.#Some [the_concern key]} (do ! [_ (async.future @@ -453,7 +453,7 @@ (def (concern path) (do async.monad [@tracker (stm.commit! (stm.read tracker))] - (case (dictionary.value path @tracker) + (when (dictionary.value path @tracker) {.#Some [it key]} (in {try.#Success it}) diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index dc3ea4219..c11a8285d 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -111,7 +111,7 @@ (def jvm_method (-> //.Method Text) - (|>> (pipe.case + (|>> (pipe.when {//.#Post} "POST" {//.#Get} "GET" {//.#Put} "PUT" @@ -126,7 +126,7 @@ (-> java/io/BufferedInputStream (//.Body IO)) (|>> (maybe#each (|>> [true])) (maybe.else [false ..default_buffer_size]) - (pipe.case + (pipe.when [_ 0] (do (try.with io.monad) [_ (java/lang/AutoCloseable::close input)] @@ -140,7 +140,7 @@ [.let [remaining (i.- so_far (.int buffer_size))] bytes_read (at ! each (|>> ffi.of_int) (java/io/BufferedInputStream::read buffer (ffi.as_int so_far) (ffi.as_int remaining) input))] - (case bytes_read + (when bytes_read -1 (do ! [_ (java/lang/AutoCloseable::close input)] (in [(.nat so_far) buffer])) @@ -154,10 +154,10 @@ [.let [remaining (i.- so_far (.int buffer_size))] bytes_read (at ! each (|>> ffi.of_int) (java/io/BufferedInputStream::read buffer (ffi.as_int so_far) (ffi.as_int remaining) input))] - (case bytes_read + (when bytes_read -1 (do ! [_ (java/lang/AutoCloseable::close input)] - (case so_far + (when so_far +0 (in (..body_of output)) _ (|> buffer (binary.slice 0 (.nat so_far)) @@ -178,7 +178,7 @@ headers //.empty]) (do [! (try.with io.monad)] [?name (java/net/URLConnection::getHeaderFieldKey (ffi.as_int index) connection)] - (case ?name + (when ?name {.#Some name} (do ! [?value (java/net/URLConnection::getHeaderField (ffi.as_int index) connection)] @@ -200,7 +200,7 @@ _ (monad.each ! (function (_ [name value]) (java/net/URLConnection::setRequestProperty (ffi.as_string name) (ffi.as_string value) connection)) (dictionary.entries headers)) - _ (case data + _ (when data {.#Some data} (do ! [_ (java/net/URLConnection::setDoOutput true connection) @@ -231,7 +231,7 @@ (|> (at client request method url headers data) async.future (at async.monad each - (|>> (pipe.case + (|>> (pipe.when {try.#Success [status message]} {try.#Success [status (revised //.#body (is (-> (//.Body IO) (//.Body Async)) (function (_ body) diff --git a/stdlib/source/library/lux/world/net/http/cookie.lux b/stdlib/source/library/lux/world/net/http/cookie.lux index a87addd69..5863b5bee 100644 --- a/stdlib/source/library/lux/world/net/http/cookie.lux +++ b/stdlib/source/library/lux/world/net/http/cookie.lux @@ -65,7 +65,7 @@ (def .public (same_site policy) (-> CSRF_Policy Directive) - (..directive (format "SameSite=" (case policy + (..directive (format "SameSite=" (when policy {#Strict} "Strict" {#Lax} "Lax")))) diff --git a/stdlib/source/library/lux/world/net/http/header.lux b/stdlib/source/library/lux/world/net/http/header.lux index 21b00565a..91ad629a2 100644 --- a/stdlib/source/library/lux/world/net/http/header.lux +++ b/stdlib/source/library/lux/world/net/http/header.lux @@ -15,7 +15,7 @@ (def .public (has name value) (-> Text Text Header) (dictionary.revised' name "" - (|>> (pipe.case + (|>> (pipe.when "" value diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index fdf8a8aa1..c69666791 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -59,7 +59,7 @@ (function (_ (^.let request [identification protocol resource message])) (do async.monad [?raw (read_text_body (the //.#body message))] - (case (do try.monad + (when (do try.monad [raw ?raw content (at json.codec decoded raw)] (json.result content reader)) @@ -74,7 +74,7 @@ (function (_ (^.let request [identification protocol resource message])) (do async.monad [?raw (read_text_body (the //.#body message))] - (case ?raw + (when ?raw {try.#Success content} (server content request) @@ -88,7 +88,7 @@ [uri query] (|> full (text.split_by "?") (maybe.else [full ""]))] - (case (do try.monad + (when (do try.monad [query (//query.parameters query) input (context.result query property)] (in [[identification protocol (has //.#uri uri resource) message] @@ -104,7 +104,7 @@ (function (_ (^.let request [identification protocol resource message])) (do async.monad [?body (read_text_body (the //.#body message))] - (case (do try.monad + (when (do try.monad [body ?body form (//query.parameters body)] (context.result form property)) @@ -117,7 +117,7 @@ (def .public (cookies property server) (All (_ a) (-> (Property a) (-> a Server) Server)) (function (_ (^.let request [identification protocol resource message])) - (case (do try.monad + (when (do try.monad [cookies (|> (the //.#headers message) (dictionary.value "Cookie") (maybe.else "") diff --git a/stdlib/source/library/lux/world/net/http/route.lux b/stdlib/source/library/lux/world/net/http/route.lux index 53d533334..bcb7aa4a8 100644 --- a/stdlib/source/library/lux/world/net/http/route.lux +++ b/stdlib/source/library/lux/world/net/http/route.lux @@ -21,7 +21,7 @@ [(def .public ( server) (-> Server Server) (function (_ (^.let request [identification protocol resource message])) - (case (the //.#scheme protocol) + (when (the //.#scheme protocol) {} (server request) @@ -36,7 +36,7 @@ [(def .public ( server) (-> Server Server) (function (_ (^.let request [identification protocol resource message])) - (case (the //.#method resource) + (when (the //.#method resource) {} (server request) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 4e9bd0d37..5ab10bba6 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -250,7 +250,7 @@ [(def ( _) (do ! [output (java/io/BufferedReader::readLine )] - (case output + (when output {.#Some output} (in (ffi.of_string output)) @@ -332,7 +332,7 @@ [(def ( _) (do [! io.monad] [|state| (atom.read! state)] - (case (at mock |state|) + (when (at mock |state|) {try.#Success [|state| output]} (do ! [_ (atom.write! |state| state)] @@ -348,7 +348,7 @@ (def (write message) (do [! io.monad] [|state| (atom.read! state)] - (case (at mock on_write message |state|) + (when (at mock on_write message |state|) {try.#Success |state|} (do ! [_ (atom.write! |state| state)] @@ -359,7 +359,7 @@ (def (destroy _) (do [! io.monad] [|state| (atom.read! state)] - (case (at mock on_destroy |state|) + (when (at mock on_destroy |state|) {try.#Success |state|} (do ! [_ (atom.write! |state| state)] diff --git a/stdlib/source/library/lux/world/time.lux b/stdlib/source/library/lux/world/time.lux index d24e87497..22a0d85f3 100644 --- a/stdlib/source/library/lux/world/time.lux +++ b/stdlib/source/library/lux/world/time.lux @@ -118,7 +118,7 @@ (def pred (|>> representation - (pipe.case + (pipe.when 0 ..limit millis millis) -- diff --git a/stdlib/source/library/lux/world/time/day.lux b/stdlib/source/library/lux/world/time/day.lux index 5daf79ac0..f763fbb8f 100644 --- a/stdlib/source/library/lux/world/time/day.lux +++ b/stdlib/source/library/lux/world/time/day.lux @@ -34,7 +34,7 @@ (Equivalence Day) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [] [[{} {}] true]) @@ -51,7 +51,7 @@ (def (nat day) (-> Day Nat) - (case day + (when day (^.with_template [ ] [{} ]) ([0 #Sunday] @@ -76,7 +76,7 @@ (def order ..order) (def (succ day) - (case day + (when day {#Sunday} {#Monday} {#Monday} {#Tuesday} {#Tuesday} {#Wednesday} @@ -86,7 +86,7 @@ {#Saturday} {#Sunday})) (def (pred day) - (case day + (when day {#Monday} {#Sunday} {#Tuesday} {#Monday} {#Wednesday} {#Tuesday} @@ -103,7 +103,7 @@ (Codec Text Day) (implementation (def (encoded value) - (case value + (when value (^.with_template [] [{} (text.replaced "#" "" (template.text []))]) @@ -115,7 +115,7 @@ [..#Saturday] [..#Sunday]))) (def (decoded value) - (case (text#composite "#" value) + (when (text#composite "#" value) (^.with_template [] [(template.text []) {try.#Success {}}]) @@ -147,7 +147,7 @@ [07 #Saturday])] (def .public (number day) (-> Day Nat) - (case day + (when day (^.with_template [ ] [{} ]) @@ -163,7 +163,7 @@ (def .public (by_number number) (-> Nat (Try Day)) - (case number + (when number (^.with_template [ ] [ {try.#Success {}}]) @@ -178,7 +178,7 @@ (implementation (def equivalence ..equivalence) (def (hash day) - (case day + (when day (^.with_template [ ] [{} ]) diff --git a/stdlib/source/library/lux/world/time/duration.lux b/stdlib/source/library/lux/world/time/duration.lux index 00a7c1d1e..a8850b4fb 100644 --- a/stdlib/source/library/lux/world/time/duration.lux +++ b/stdlib/source/library/lux/world/time/duration.lux @@ -159,7 +159,7 @@ (function (_ suffix false_suffix) (|> (.many .decimal) (<>.codec nat.decimal) - (<>.before (case false_suffix + (<>.before (when false_suffix "" (.this suffix) _ (<>.after (<>.not (.this false_suffix)) (.this suffix)))) @@ -178,7 +178,7 @@ (..composite (..up minutes ..minute)) (..composite (..up seconds ..second)) (..composite (..up millis ..milli_second)))]] - (in (case sign + (in (when sign {.#Left _} (..inverse span) {.#Right _} span))))) diff --git a/stdlib/source/library/lux/world/time/instant.lux b/stdlib/source/library/lux/world/time/instant.lux index 2f08a6833..55bb1eae8 100644 --- a/stdlib/source/library/lux/world/time/instant.lux +++ b/stdlib/source/library/lux/world/time/instant.lux @@ -95,7 +95,7 @@ bce? (i.< +0 offset) [days day_time] (if bce? (let [[days millis] (i./% ..millis_per_day offset)] - (case millis + (when millis +0 [days millis] _ [(-- days) (i.+ ..millis_per_day millis)])) (i./% ..millis_per_day offset))] @@ -209,7 +209,7 @@ days) ... 1970/01/01 was a Thursday y1970m0d0 +4] - (case (|> y1970m0d0 + (when (|> y1970m0d0 (i.+ days) (i.% +7) ... This is done to turn negative days into positive days. (i.+ +7) (i.% +7)) diff --git a/stdlib/source/library/lux/world/time/month.lux b/stdlib/source/library/lux/world/time/month.lux index c2e88c976..35f56020d 100644 --- a/stdlib/source/library/lux/world/time/month.lux +++ b/stdlib/source/library/lux/world/time/month.lux @@ -39,7 +39,7 @@ (Equivalence Month) (implementation (def (= reference sample) - (case [reference sample] + (when [reference sample] (^.with_template [] [[{} {}] true]) @@ -73,7 +73,7 @@ [12 #December])] (def .public (number month) (-> Month Nat) - (case month + (when month (^.with_template [ ] [{} ]) @@ -89,7 +89,7 @@ (def .public (by_number number) (-> Nat (Try Month)) - (case number + (when number (^.with_template [ ] [ {try.#Success {}}]) @@ -104,7 +104,7 @@ (implementation (def equivalence ..equivalence) (def (hash month) - (case month + (when month (^.with_template [ ] [{} ]) @@ -136,7 +136,7 @@ (def order ..order) (def (succ month) - (case month + (when month {#January} {#February} {#February} {#March} {#March} {#April} @@ -151,7 +151,7 @@ {#December} {#January})) (def (pred month) - (case month + (when month {#February} {#January} {#March} {#February} {#April} {#March} @@ -167,7 +167,7 @@ (def .public (days month) (-> Month Nat) - (case month + (when month (^.with_template [ ] [{} ]) @@ -189,7 +189,7 @@ (def .public (leap_year_days month) (-> Month Nat) - (case month + (when month {#February} (++ (..days month)) _ (..days month))) @@ -216,7 +216,7 @@ (Codec Text Month) (implementation (def (encoded value) - (case value + (when value (^.with_template [] [{} (text.replaced "#" "" (template.text []))]) @@ -233,7 +233,7 @@ [..#November] [..#December]))) (def (decoded value) - (case (text#composite "#" value) + (when (text#composite "#" value) (^.with_template [] [(template.text []) {try.#Success {}}]) diff --git a/stdlib/source/library/lux/world/time/year.lux b/stdlib/source/library/lux/world/time/year.lux index a7bdb0dcf..ae01271f5 100644 --- a/stdlib/source/library/lux/world/time/year.lux +++ b/stdlib/source/library/lux/world/time/year.lux @@ -41,7 +41,7 @@ (def .public (year value) (-> Int (Try Year)) - (case value + (when value +0 (exception.except ..there_is_no_year_0 []) _ {try.#Success (abstraction (..internal value))})) @@ -118,7 +118,7 @@ [sign (<>.or (.this "-") (in [])) digits (.many .decimal) raw_year (<>.codec i.decimal (in (text#composite "+" digits)))] - (<>.lifted (..year (case sign + (<>.lifted (..year (when sign {.#Left _} (i.* -1 raw_year) {.#Right _} raw_year))))) -- cgit v1.2.3