From e5625dd840a8b8adc76987f649da254335d3d93a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 11 Aug 2022 16:50:42 -0400 Subject: Improved exception-definition macro. --- .../library/lux/control/concurrency/actor.lux | 6 +- .../source/library/lux/control/concurrency/frp.lux | 4 +- .../library/lux/control/concurrency/semaphore.lux | 5 +- .../library/lux/control/concurrency/thread.lux | 4 +- stdlib/source/library/lux/control/exception.lux | 86 +++++++++++----------- .../library/lux/control/function/contract.lux | 5 +- stdlib/source/library/lux/control/region.lux | 6 +- stdlib/source/library/lux/control/remember.lux | 8 +- stdlib/source/library/lux/data/binary.lux | 16 ++-- .../library/lux/data/collection/dictionary.lux | 4 +- stdlib/source/library/lux/data/collection/list.lux | 47 ++++++------ .../library/lux/data/collection/sequence.lux | 10 +-- stdlib/source/library/lux/data/format/tar.lux | 27 ++++--- stdlib/source/library/lux/data/sum.lux | 34 +++++---- stdlib/source/library/lux/data/text/escape.lux | 14 ++-- stdlib/source/library/lux/data/text/regex.lux | 6 +- stdlib/source/library/lux/debug.lux | 12 +-- stdlib/source/library/lux/documentation.lux | 5 +- stdlib/source/library/lux/ffi.jvm.lux | 31 ++++---- stdlib/source/library/lux/math.lux | 5 +- stdlib/source/library/lux/math/modular.lux | 10 +-- stdlib/source/library/lux/math/modulus.lux | 4 +- stdlib/source/library/lux/meta/compiler.lux | 5 +- .../library/lux/meta/compiler/default/platform.lux | 20 ++--- .../compiler/language/lux/analysis/coverage.lux | 13 ++-- .../compiler/language/lux/analysis/inference.lux | 13 ++-- .../meta/compiler/language/lux/analysis/macro.lux | 12 ++- .../meta/compiler/language/lux/analysis/module.lux | 17 +++-- .../meta/compiler/language/lux/analysis/scope.lux | 6 +- .../lux/meta/compiler/language/lux/generation.lux | 16 ++-- .../meta/compiler/language/lux/phase/analysis.lux | 5 +- .../language/lux/phase/analysis/complex.lux | 34 ++++----- .../language/lux/phase/analysis/function.lux | 13 ++-- .../language/lux/phase/analysis/reference.lux | 14 ++-- .../compiler/language/lux/phase/analysis/when.lux | 23 +++--- .../compiler/language/lux/phase/declaration.lux | 11 ++- .../meta/compiler/language/lux/phase/extension.lux | 19 +++-- .../language/lux/phase/extension/analysis/jvm.lux | 58 +++++++-------- .../language/lux/phase/extension/analysis/lux.lux | 8 +- .../lux/phase/extension/declaration/lux.lux | 11 ++- .../lux/phase/extension/generation/jvm/host.lux | 5 +- .../compiler/language/lux/phase/generation/js.lux | 4 +- .../language/lux/phase/generation/jvm/host.lux | 14 ++-- .../compiler/language/lux/phase/generation/lua.lux | 4 +- .../compiler/language/lux/phase/generation/php.lux | 4 +- .../language/lux/phase/generation/python.lux | 4 +- .../lux/phase/generation/r/procedure/common.lux | 5 +- .../language/lux/phase/generation/ruby.lux | 4 +- .../language/lux/phase/synthesis/function.lux | 6 +- .../language/lux/phase/synthesis/variable.lux | 5 +- .../lux/meta/compiler/language/lux/program.lux | 5 +- .../lux/meta/compiler/language/lux/syntax.lux | 14 ++-- .../library/lux/meta/compiler/meta/archive.lux | 18 ++--- .../meta/compiler/meta/archive/module/document.lux | 6 +- .../lux/meta/compiler/meta/archive/registry.lux | 5 +- .../lux/meta/compiler/meta/cache/module.lux | 7 +- .../library/lux/meta/compiler/meta/import.lux | 8 +- .../library/lux/meta/compiler/meta/io/context.lux | 9 ++- stdlib/source/library/lux/meta/configuration.lux | 4 +- stdlib/source/library/lux/meta/macro/context.lux | 9 ++- stdlib/source/library/lux/meta/macro/local.lux | 9 ++- .../library/lux/meta/macro/syntax/definition.lux | 5 +- .../library/lux/meta/macro/syntax/export.lux | 24 +++--- stdlib/source/library/lux/meta/macro/template.lux | 6 +- .../source/library/lux/meta/macro/vocabulary.lux | 6 +- .../library/lux/meta/target/jvm/bytecode.lux | 37 +++++----- .../lux/meta/target/jvm/bytecode/environment.lux | 8 +- .../lux/meta/target/jvm/encoding/signed.lux | 6 +- .../lux/meta/target/jvm/encoding/unsigned.lux | 13 ++-- .../source/library/lux/meta/target/jvm/loader.lux | 12 +-- .../library/lux/meta/target/jvm/reflection.lux | 30 ++++---- .../library/lux/meta/target/jvm/type/lux.lux | 5 +- stdlib/source/library/lux/meta/type/check.lux | 32 ++++---- stdlib/source/library/lux/meta/type/dynamic.lux | 6 +- stdlib/source/library/lux/meta/type/resource.lux | 7 +- stdlib/source/library/lux/meta/version.lux | 4 +- stdlib/source/library/lux/test/property.lux | 7 +- stdlib/source/library/lux/world/console.lux | 8 +- stdlib/source/library/lux/world/environment.lux | 5 +- stdlib/source/library/lux/world/file.lux | 8 +- stdlib/source/library/lux/world/file/watch.lux | 5 +- stdlib/source/library/lux/world/shell.lux | 4 +- stdlib/source/library/lux/world/time.lux | 8 +- stdlib/source/library/lux/world/time/date.lux | 10 +-- stdlib/source/library/lux/world/time/day.lux | 8 +- stdlib/source/library/lux/world/time/month.lux | 8 +- stdlib/source/library/lux/world/time/year.lux | 4 +- 87 files changed, 554 insertions(+), 518 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index e1eb5ff68..d4c50b896 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -6,7 +6,7 @@ [control ["[0]" pipe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception] ["[0]" io (.only IO io)]] [data ["[0]" bit] @@ -21,8 +21,8 @@ ["[0]" async (.only Async Resolver)] ["[0]" frp (.only Channel Channel')]]) -(exception .public poisoned) -(exception .public dead) +(exception.def .public poisoned) +(exception.def .public dead) (local.let [ (template (_ Actor s) [(-> s (Actor s) (Async (Try s)))]) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index c1b7c9931..b5005661a 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -9,7 +9,7 @@ [control ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception] ["[0]" io (.only IO io)]] [meta ["[0]" type (.only sharing)]]]] @@ -24,7 +24,7 @@ (type .public (Channel a) (Channel' a a)) -(exception .public already_closed) +(exception.def .public already_closed) (type .public (Sink w) (Interface diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index 557f9fca8..7e2b8c0cd 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -7,7 +7,7 @@ ["[0]" pipe] ["[0]" io (.only IO)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -66,7 +66,8 @@ ))))) signal))) - (exception .public (semaphore_is_maxed_out [max_positions Nat]) + (exception.def .public (semaphore_is_maxed_out max_positions) + (Exception Nat) (exception.report (list ["Max Positions" (%.nat max_positions)]))) diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 25e1d02d8..def0f230d 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -7,7 +7,7 @@ ["[0]" monad (.only do)]] [control ["[0]" try] - ["[0]" exception (.only exception)] + ["[0]" exception] ["[0]" io (.only IO io)]] [data ["[0]" text] @@ -161,7 +161,7 @@ @.python (these) ... Default - (these (exception .public cannot_continue_running_threads) + (these (exception.def .public cannot_continue_running_threads) ... https://en.wikipedia.org/wiki/Event_loop ... Starts the event-loop. diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 834f8afe8..8d39a9daf 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 when) + [lux (.except except with when def) [abstract [monad (.only do)]] [control @@ -19,9 +19,7 @@ ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only) [syntax (.only syntax) - ["|[0]|" input] - ["[0]" type - ["|[1]_[0]|" variable]]]]]]] + ["[0]" export]]]]]] [// ["//" try (.only Try)]]) @@ -30,11 +28,11 @@ [#label Text #constructor (-> a Text)])) -(def .public (match? exception error) +(.def .public (match? exception error) (All (_ e) (-> (Exception e) Text Bit)) (text.starts_with? (the #label exception) error)) -(def .public (when exception then try) +(.def .public (when exception then try) (All (_ e a) (-> (Exception e) (-> Text a) (Try a) (Try a))) @@ -51,7 +49,7 @@ then)} {//.#Failure error})))) -(def .public (otherwise else try) +(.def .public (otherwise else try) (All (_ a) (-> (-> Text a) (Try a) a)) (.when try @@ -61,52 +59,50 @@ {//.#Failure error} (else error))) -(def .public (error exception message) +(.def .public (error exception message) (All (_ e) (-> (Exception e) e Text)) ((the ..#constructor exception) message)) -(def .public (except exception message) +(.def .public (except exception message) (All (_ e a) (-> (Exception e) e (Try a))) {//.#Failure (..error exception message)}) -(def .public (assertion exception message test) +(.def .public (assertion exception message test) (All (_ e) (-> (Exception e) e Bit (Try Any))) (if test {//.#Success []} (..except exception message))) -(def exceptionP - (Parser [Code (List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)]) - (let [private (is (Parser [(List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)]) - (all <>.and - (<>.else (list) (.tuple (<>.some |type_variable|.parser))) - (<>.either (.form (<>.and .local |input|.parser)) - (<>.and .local (<>#in (list)))) - (<>.maybe .any) - ))] - (all <>.either - (<>.and .any private) - (<>.and (<>#in (` .private)) private) - ))) - -(def .public exception - (syntax (_ [[export_policy t_vars [name inputs] body] ..exceptionP]) - (macro.with_symbols [g!_ g!descriptor] +(.def exceptionP + (Parser [export.Policy [[Text Code] Code Code]]) + (export.parser + (all <>.either + (all <>.and + (.form (<>.and .local .any)) + .any + .any) + (do <>.monad + [name .local] + (in [[name (code.local name)] + (` (Exception Any)) + (` "")]))))) + +(.def .public def + (syntax (_ [[export_policy [[name input] type body]] ..exceptionP]) + (macro.with_symbols [g!descriptor] (do meta.monad - [current_module meta.current_module_name - .let [descriptor (all text#composite "{" current_module "." name "}" text.new_line) - g!self (code.local name)]] - (in (list (` (def (, export_policy) - (, g!self) - (All ((, g!_) (,* (list#each |type_variable|.format t_vars))) - (..Exception [(,* (list#each (the |input|.#type) inputs))])) - (let [(, g!descriptor) (, (code.text descriptor))] - [..#label (, g!descriptor) - ..#constructor (function ((, g!self) [(,* (list#each (the |input|.#binding) inputs))]) - (at text.monoid (,' composite) (, g!descriptor) - (, (maybe.else (' "") body))))]))))))))) - -(def .public (report entries) + [current_module meta.current_module_name] + (let [descriptor (all text#composite "{" current_module "." name "}" text.new_line) + g!self (code.local name)] + (in (list (` (.def (, export_policy) + (, g!self) + (, type) + (let [(, g!descriptor) (, (code.text descriptor))] + [..#label (, g!descriptor) + ..#constructor (function ((, g!self) (, input)) + (at text.monoid (,' composite) (, g!descriptor) (, body)))])))))))))) + +(.def .public (report entries) (-> (List [Text Text]) Text) (let [header_separator ": " largest_header_size (list#mix (function (_ [header _] max) @@ -137,7 +133,7 @@ (on_entry head) tail)))) -(def .public (listing format entries) +(.def .public (listing format entries) (All (_ a) (-> (-> a Text) (List a) Text)) (|> entries @@ -150,7 +146,7 @@ list.reversed ..report)) -(def separator +(.def separator (let [gap (all "lux text concat" text.new_line text.new_line) horizontal_line (|> "-" (list.repeated 64) text.together)] (all "lux text concat" @@ -158,14 +154,14 @@ horizontal_line gap))) -(def (decorated prelude error) +(.def (decorated prelude error) (-> Text Text Text) (all "lux text concat" prelude ..separator error)) -(def .public (with exception message computation) +(.def .public (with exception message computation) (All (_ e a) (-> (Exception e) e (Try a) (Try a))) (.when computation {//.#Failure error} diff --git a/stdlib/source/library/lux/control/function/contract.lux b/stdlib/source/library/lux/control/function/contract.lux index a5f73c098..bc3ac4926 100644 --- a/stdlib/source/library/lux/control/function/contract.lux +++ b/stdlib/source/library/lux/control/function/contract.lux @@ -2,7 +2,7 @@ [library [lux (.except) [control - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]]] @@ -16,7 +16,8 @@ ["<[1]>" \\parser]]]]]) (with_template [] - [(exception .public ( [condition Code]) + [(exception.def .public ( condition) + (Exception Code) (exception.report (list ["Condition" (%.code condition)])))] diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index e752b57a9..4216a1e78 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -13,7 +13,7 @@ [collection ["[0]" list (.use "[1]#[0]" mix)]]]]] [// - ["[0]" exception (.only Exception exception)]]) + ["[0]" exception (.only Exception)]]) (type (Cleaner r !) (-> r (! (Try Any)))) @@ -31,8 +31,8 @@ "-----------------------------------------" text.new_line text.new_line)) -(exception .public [a] (clean_up_error [error Text - output (Try a)]) +(exception.def .public (clean_up_error [error output]) + (All (_ a) (Exception [Text (Try a)])) (format error (when output {try.#Success _} diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index 1b3d0c2f0..be344f2ef 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -7,7 +7,7 @@ ["<>" parser (.use "[1]#[0]" functor)] ["[0]" io] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text ["%" \\format (.only format)]]] @@ -22,10 +22,8 @@ ["[0]" instant] ["[0]" date (.only Date) (.use "[1]#[0]" order)]]]]]) -(exception .public (must_remember [deadline Date - today Date - message Text - focus (Maybe Code)]) +(exception.def .public (must_remember [deadline today message focus]) + (Exception [Date Date Text (Maybe Code)]) (exception.report (list ["Deadline" (%.date deadline)] ["Today" (%.date today)] diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index bc384140e..2803023a5 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -7,7 +7,7 @@ [monoid (.only Monoid)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format]] @@ -40,8 +40,8 @@ (again (++ index) ($ (/.bits_8 index it) output)) output)))) -(exception .public (index_out_of_bounds [size Nat - index Nat]) +(exception.def .public (index_out_of_bounds [size index]) + (Exception [Nat Nat]) (exception.report (list ["Size" (%.nat size)] ["Index" (%.nat index)]))) @@ -78,9 +78,8 @@ (def (= reference sample) (/.= reference sample)))) -(exception .public (cannot_copy [bytes Nat - source_input Nat - target_output Nat]) +(exception.def .public (cannot_copy [bytes source_input target_output]) + (Exception [Nat Nat Nat]) (exception.report (list ["Bytes" (%.nat bytes)] ["Source input space" (%.nat source_input)] @@ -95,9 +94,8 @@ (exception.except ..cannot_copy [bytes source_input target_output]) {try.#Success (/.copy! bytes source_offset source target_offset target)}))) -(exception .public (slice_out_of_bounds [size Nat - offset Nat - length Nat]) +(exception.def .public (slice_out_of_bounds [size offset length]) + (Exception [Nat Nat Nat]) (exception.report (list ["Size" (%.nat size)] ["Offset" (%.nat offset)] diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index a2e1282d5..482824d85 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -9,7 +9,7 @@ [control ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [data ["[0]" product] [collection @@ -599,7 +599,7 @@ {.#Some _} true)) -(exception .public key_already_exists) +(exception.def .public key_already_exists) (def .public (has' key val dict) (All (_ k v) (-> k v (Dictionary k v) (Try (Dictionary k v)))) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index c2dff94fc..77e5529b1 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -46,13 +46,13 @@ {.#Item [head tail]} {.#Item [init (mixes f (f head init) tail)]})) -(def .public (reversed xs) +(def .public (reversed it) (All (_ a) (-> (List a) (List a))) (mix (function (_ head tail) {.#Item head tail}) {.#End} - xs)) + it)) (def .public (only keep? xs) (All (_ a) @@ -341,26 +341,24 @@ (implementation (def identity {.#End}) - (def (composite xs ys) - (.when xs - {.#End} - ys - - {.#Item x xs'} - {.#Item x (composite xs' ys)})))) + (def (composite left right) + ... TODO: Use the more obvious implementation once "tail recursion modulo cons" is added to the compiler. + (mix (function (_ head tail) + {.#Item head tail}) + right + (reversed left))))) (use "[0]" ..monoid) (def .public functor (Functor List) (implementation - (def (each f ma) - (.when ma - {.#End} - {.#End} - - {.#Item a ma'} - {.#Item (f a) (each f ma')})))) + (def (each f it) + ... TODO: Use the more obvious implementation once "tail recursion modulo cons" is added to the compiler. + (mix (function (_ head tail) + {.#Item (f head) tail}) + (list) + (reversed it))))) (use "[0]" ..functor) @@ -371,21 +369,21 @@ (def (on fa ff) (.when ff - {.#End} - {.#End} - {.#Item f ff'} (|> ff' (on fa) - (composite (each f fa))))))) + (composite (each f fa))) + + {.#End} + {.#End})))) (def .public monad (Monad List) (implementation (def functor ..functor) - (def (in a) - {.#Item a {.#End}}) + (def in + (|>> list)) (def conjoint (|>> reversed (mix composite identity))))) @@ -406,7 +404,10 @@ (is (,, (type_of xs)) (list))]) xs')] - (.all composite (sorted < pre) (list x) (sorted < post))))) + (.all composite + (sorted < pre) + (list x) + (sorted < post))))) (def .public (empty? xs) (All (_ a) (Predicate (List a))) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 55c782acf..c015edb06 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -15,7 +15,7 @@ ["<>" parser] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] [function [predicate (.only Predicate)]]] [data @@ -241,15 +241,15 @@ (.has #tail (..tail val))) ))) -(exception incorrect_sequence_structure) +(exception.def incorrect_sequence_structure) -(exception .public [a] (index_out_of_bounds [sequence (Sequence a) - index Nat]) +(exception.def .public (index_out_of_bounds [sequence index]) + (All (_ a) (Exception [(Sequence a) Nat])) (exception.report (.list ["Size" (at n.decimal encoded (the #size sequence))] ["Index" (at n.decimal encoded index)]))) -(exception base_was_not_found) +(exception.def base_was_not_found) (def .public (within_bounds? sequence idx) (All (_ a) (-> (Sequence a) Nat Bit)) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 360ceeb11..e682544bc 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -8,7 +8,7 @@ ["<>" parser] ["[0]" pipe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" binary (.only Binary) @@ -71,7 +71,8 @@ (list#mix n.* 1) ++)) - (exception .public ( [value Nat]) + (exception.def .public ( value) + (Exception Nat) (exception.report (list ["Value" (%.nat value)] ["Maximum" (%.nat (-- ))]))) @@ -116,8 +117,8 @@ as_big] ) -(exception .public (wrong_character [expected Char - actual Char]) +(exception.def .public (wrong_character [expected actual]) + (Exception [Char Char]) (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)]))) @@ -227,7 +228,8 @@ (n.<= ..last_ascii char))) true))) -(exception .public (not_ascii [text Text]) +(exception.def .public (not_ascii text) + (Exception Text) (exception.report (list ["Text" (%.text text)]))) @@ -256,7 +258,8 @@ [(primitive .public - (exception .public ( [value Text]) + (exception.def .public ( value) + (Exception Text) (exception.report (list ["Value" (%.text value)] ["Size" (%.nat (text.size value))] @@ -426,7 +429,8 @@ ) - (exception .public (invalid_link_flag [value Nat]) + (exception.def .public (invalid_link_flag value) + (Exception Nat) (exception.report (list ["Value" (%.nat value)]))) @@ -465,7 +469,8 @@ try.trusted ..small_format)) - (exception .public (invalid_mode [value Nat]) + (exception.def .public (invalid_mode value) + (Exception Nat) (exception.report (list ["Value" (%.nat value)]))) @@ -749,8 +754,8 @@ tar) (\\format.segment ..end_of_archive_size end_of_archive))))) -(exception .public (wrong_checksum [expected Nat - actual Nat]) +(exception.def .public (wrong_checksum [expected actual]) + (Exception [Nat Nat]) (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)]))) @@ -863,7 +868,7 @@ (exception.assertion ..wrong_checksum [0 actual] (n.= 0 actual)))))) -(exception .public invalid_end_of_archive) +(exception.def .public invalid_end_of_archive) (def end_of_archive_parser (Parser Any) diff --git a/stdlib/source/library/lux/data/sum.lux b/stdlib/source/library/lux/data/sum.lux index 0ed2931d1..72d5d52df 100644 --- a/stdlib/source/library/lux/data/sum.lux +++ b/stdlib/source/library/lux/data/sum.lux @@ -3,7 +3,10 @@ [lux (.except left right) [abstract [equivalence (.only Equivalence)] - [hash (.only Hash)]]]]) + [hash (.only Hash)]] + [data + [collection + ["[0]" list (.use "[1]#[0]" mix)]]]]]) (with_template [ ] [(def .public ( value) @@ -32,21 +35,22 @@ {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 ))) - (when items - {.#End} - {.#End} - - {.#Item {0 x} items'} - {.#Item [x ( items')]} - - {.#Item _ items'} - ( items')))] +(with_template [ ] + [(def .public ( it) + (All (_ t0 t1) (-> (List (Or t0 t1)) (List ))) + ... TODO: Use the more obvious implementation once "tail recursion modulo cons" is added to the compiler. + (list#mix (function (_ head tail) + (when head + {0 head} + (list.partial head tail) - [lefts a #0] - [rights b #1] + _ + tail)) + (list) + (list.reversed it)))] + + [#0 t0 lefts] + [#1 t1 rights] ) (def .public (partition xs) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 2ce6021a6..b09ae72c7 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -7,7 +7,7 @@ ["<>" parser] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [math [number (.only hex) ["n" nat]]] @@ -141,21 +141,21 @@ (again (++ offset) previous current limit))) (format previous current)))) -(exception .public (dangling_escape [text Text]) +(exception.def .public (dangling_escape text) + (Exception Text) (exception.report (list ["In" (%.text text)] ["At" (%.nat (-- (//.size text)))]))) -(exception .public (invalid_escape [text Text - offset Nat - sigil Char]) +(exception.def .public (invalid_escape [text offset sigil]) + (Exception [Text Nat Char]) (exception.report (list ["In" (%.text text)] ["At" (%.nat offset)] ["Name" (%.text (//.of_char sigil))]))) -(exception .public (invalid_unicode_escape [text Text - offset Nat]) +(exception.def .public (invalid_unicode_escape [text offset]) + (Exception [Text Nat]) (exception.report (list ["In" (%.text text)] ["At" (%.nat offset)]))) diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 09dba9073..c59578a58 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -7,7 +7,7 @@ ["<>" parser (.use "[1]#[0]" monad)] ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text @@ -231,8 +231,8 @@ (in (` (together (<>.many (, base))))) ))) -(exception .public (incorrect_quantification [from Nat - to Nat]) +(exception.def .public (incorrect_quantification [from to]) + (Exception [Nat Nat]) (exception.report (list ["Input" (format (%.nat from) "," (%.nat to))] ["Should be" (format (%.nat to) "," (%.nat from))]))) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 88df6bc7b..c5f95dae2 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -9,7 +9,7 @@ ["[0]" pipe] ["[0]" function] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.only) ["%" \\format (.only Format)]] @@ -381,7 +381,8 @@ )) ))) -(exception .public (cannot_represent_value [type Type]) +(exception.def .public (cannot_represent_value type) + (Exception Type) (exception.report (list ["Type" (%.type type)]))) @@ -534,8 +535,8 @@ (-> Text Any) ("lux io log" message)) -(exception .public (type_hole [location Location - type Type]) +(exception.def .public (type_hole [location type]) + (Exception [Location Type]) (exception.report (list ["Location" (%.location location)] ["Type" (%.type type)]))) @@ -557,7 +558,8 @@ (.tuple (<>.and .local (at <>.monad each (|>> {.#Some}) .any))))) -(exception .public (unknown_local_binding [name Text]) +(exception.def .public (unknown_local_binding name) + (Exception Text) (exception.report (list ["Name" (%.text name)]))) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index dc8e85722..af0d07a07 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -7,7 +7,7 @@ [control ["<>" parser (.use "[1]#[0]" monad)] ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" sum] ["[0]" product] @@ -439,7 +439,8 @@ (<>.or (.this_text "") .any)) -(exception .public (unqualified_symbol [name Symbol]) +(exception.def .public (unqualified_symbol name) + (Exception Symbol) (exception.report (list ["Name" (%.symbol name)]))) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index be31fd27a..871f6afec 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -8,7 +8,7 @@ ["[0]" io] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only Exception exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) @@ -433,12 +433,13 @@ (.this (' "abstract")) (in [])))) -(exception .public (class_names_cannot_contain_periods [name Text]) +(exception.def .public (class_names_cannot_contain_periods name) + (Exception Text) (exception.report (list ["Name" (%.text name)]))) -(exception .public (class_name_cannot_be_a_type_variable [name Text - type_vars (List (Type Var))]) +(exception.def .public (class_name_cannot_be_a_type_variable [name type_vars]) + (Exception [Text (List (Type Var))]) (exception.report (list ["Name" (%.text name)] ["Type Variables" (exception.listing parser.name type_vars)]))) @@ -471,8 +472,8 @@ (.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))] (in (jvm.class (name.safe name) parameters)))) -(exception .public (unknown_type_variable [name Text - type_vars (List (Type Var))]) +(exception.def .public (unknown_type_variable [name type_vars]) + (Exception [Text (List (Type Var))]) (exception.report (list ["Unexpected type variable" (%.text name)] ["Expected type variables" (exception.listing parser.name type_vars)]))) @@ -1028,8 +1029,8 @@ [body (super_expression declaration,method body)] (in (list body))))) -(exception .public (insufficient_parameters [expected Nat - actual Nat]) +(exception.def .public (insufficient_parameters [expected actual]) + (Exception [Nat Nat]) (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)]))) @@ -1106,8 +1107,8 @@ (in (list body))))) (with_template [ ] - [(exception .public ( [class Text - member Text]) + [(exception.def .public ( [class member]) + (Exception [Text Text]) (exception.report (list ["Class" (%.text class)] [ (%.text member)])))] @@ -1647,8 +1648,8 @@ (list name (` .any)))) list#conjoint)) -(exception .public (cannot_write_to_field [class Text - field Text]) +(exception.def .public (cannot_write_to_field [class field]) + (Exception [Text Text]) (exception.report (list ["Class" (%.text class)] ["Field" (%.text field)]))) @@ -1881,7 +1882,8 @@ (.is (, (value_type {#ManualPrM} (jvm.array type))) ("jvm array new object" (, g!size)))))))))))) -(exception .public (cannot_convert_to_jvm_type [type .Type]) +(exception.def .public (cannot_convert_to_jvm_type type) + (Exception .Type) (exception.report (list ["Lux type" (%.type type)]))) @@ -2108,7 +2110,8 @@ (syntax (_ [type (..type^ (list))]) (in (list (..value_type {#ManualPrM} type))))) -(exception .public (cannot_cast_to_non_object [type (Type Value)]) +(exception.def .public (cannot_cast_to_non_object type) + (Exception (Type Value)) (exception.report (list ["Signature" (..signature type)] ["Reflection" (..reflection type)]))) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 0d470214a..eecff5842 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -6,7 +6,7 @@ [control ["<>" parser] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format]] @@ -41,7 +41,8 @@ ["[0]" ratio (.only Ratio)] ["[0]" complex (.only Complex)]]]) -(exception (no_arithmetic_for [type Type]) +(exception.def (no_arithmetic_for type) + (Exception Type) (exception.report (list ["Type" (%.type type)]))) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index 3899e9a55..e9810f66c 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -10,7 +10,7 @@ [control ["<>" parser] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" monoid) @@ -45,8 +45,8 @@ [value Int product.right] ) - (exception .public [%] (incorrect_modulus [modulus (Modulus %) - parsed Int]) + (exception.def .public (incorrect_modulus [modulus parsed]) + (All (_ %) (Exception [(Modulus %) Int])) (exception.report (list ["Expected" (i#encoded (//.divisor modulus))] ["Actual" (i#encoded parsed)]))) @@ -139,8 +139,8 @@ _ {.#None}))) ) -(exception .public [r% s%] (moduli_are_not_equal [reference (Modulus r%) - subject (Modulus s%)]) +(exception.def .public (moduli_are_not_equal [reference subject]) + (All (_ r% s%) (Exception [(Modulus r%) (Modulus s%)])) (exception.report (list ["Reference" (i#encoded (//.divisor reference))] ["Subject" (i#encoded (//.divisor subject))]))) diff --git a/stdlib/source/library/lux/math/modulus.lux b/stdlib/source/library/lux/math/modulus.lux index effc03dd9..69b29f4dd 100644 --- a/stdlib/source/library/lux/math/modulus.lux +++ b/stdlib/source/library/lux/math/modulus.lux @@ -5,7 +5,7 @@ [monad (.only do)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [math [number ["i" int]]] @@ -17,7 +17,7 @@ [type [primitive (.except)]]]]]) -(exception .public zero_cannot_be_a_modulus) +(exception.def .public zero_cannot_be_a_modulus) (primitive .public (Modulus %) Int diff --git a/stdlib/source/library/lux/meta/compiler.lux b/stdlib/source/library/lux/meta/compiler.lux index 8f9150839..64f5a38fd 100644 --- a/stdlib/source/library/lux/meta/compiler.lux +++ b/stdlib/source/library/lux/meta/compiler.lux @@ -4,7 +4,7 @@ [control ["<>" parser (.only)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text] ["[0]" binary (.only Binary) @@ -54,6 +54,7 @@ (type .public (Instancer s d o) (-> (Key d) (List Parameter) (Compiler s d o))) -(exception .public (cannot_compile [module Module]) +(exception.def .public (cannot_compile module) + (Exception Module) (exception.report (list ["Module" module]))) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 12b6c63f1..d3a60d7b4 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -8,7 +8,7 @@ ["[0]" function] ["[0]" maybe] ["[0]" try (.only Try) (.use "[1]#[0]" monad)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] [concurrency ["[0]" async (.only Async Resolver) (.use "[1]#[0]" monad)] ["[0]" stm (.only Var STM)]]] @@ -387,18 +387,19 @@ (or (dependence? import (the #depends_on) module) (dependence? module (the #depended_by) import)))) - (exception .public (module_cannot_import_itself [module descriptor.Module]) + (exception.def .public (module_cannot_import_itself module) + (Exception descriptor.Module) (exception.report (list ["Module" (%.text module)]))) - (exception .public (cannot_import_circular_dependency [importer descriptor.Module - importee descriptor.Module]) + (exception.def .public (cannot_import_circular_dependency [importer importee]) + (Exception [descriptor.Module descriptor.Module]) (exception.report (list ["Importer" (%.text importer)] ["Importee" (%.text importee)]))) - (exception .public (cannot_import_twice [importer descriptor.Module - duplicates (Set descriptor.Module)]) + (exception.def .public (cannot_import_twice [importer duplicates]) + (Exception [descriptor.Module (Set descriptor.Module)]) (exception.report (list ["Importer" (%.text importer)] ["Duplicates" (%.list %.text (set.list duplicates))]))) @@ -414,7 +415,8 @@ ... else {try.#Success []})) - (exception .public (cannot_overwrite_extension [extension extension.Name]) + (exception.def .public (cannot_overwrite_extension extension) + (Exception extension.Name) (exception.report (list ["Extension" (%.text extension)]))) @@ -841,8 +843,8 @@ Type (type_literal (-> (List Text) (Try ///.Custom)))) - (exception .public (invalid_custom_compiler [definition Symbol - type Type]) + (exception.def .public (invalid_custom_compiler [definition type]) + (Exception [Symbol Type]) (exception.report (list ["Definition" (%.symbol definition)] ["Expected type" (%.type ..Custom)] 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 3403461fb..8799f8b57 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 @@ -7,7 +7,7 @@ [control ["[0]" maybe (.use "[1]#[0]" monoid monad)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" bit (.use "[1]#[0]" equivalence)] ["[0]" text (.only) @@ -158,7 +158,8 @@ {#Exhaustive} "*")) -(exception .public (invalid_tuple [size Nat]) +(exception.def .public (invalid_tuple size) + (Exception Nat) (exception.report (list ["Expected size" ">= 2"] ["Actual size" (%.nat size)]))) @@ -235,14 +236,14 @@ ... always be a pattern prior to them that would match the input. ... Because of that, the presence of redundant patterns is assumed to ... be a bug, likely due to programmer carelessness. -(exception .public (redundancy [so_far Coverage - addition Coverage]) +(exception.def .public (redundancy [so_far addition]) + (Exception [Coverage Coverage]) (exception.report (list ["Coverage so-far" (format so_far)] ["Additional coverage" (format addition)]))) -(exception .public (variant_mismatch [expected Nat - mismatched Nat]) +(exception.def .public (variant_mismatch [expected mismatched]) + (Exception [Nat Nat]) (exception.report (list ["Expected cases" (%.nat expected)] ["Mismatched cases" (%.nat mismatched)]))) 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 d85a576cd..5765aa7a9 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 @@ -7,7 +7,7 @@ ["[0]" pipe] ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.only) ["%" \\format (.only format)]] @@ -32,20 +32,21 @@ [meta [archive (.only Archive)]]]]]) -(exception .public (cannot_infer [type Type - arguments (List Code)]) +(exception.def .public (cannot_infer [type arguments]) + (Exception [Type (List Code)]) (exception.report (list ["Type" (%.type type)] ["Arguments" (exception.listing %.code arguments)]))) -(exception .public (cannot_infer_argument [type Type - argument Code]) +(exception.def .public (cannot_infer_argument [type argument]) + (Exception [Type Code]) (exception.report (list ["Type" (%.type type)] ["Argument" (%.code argument)]))) (with_template [] - [(exception .public ( [type Type]) + [(exception.def .public ( type) + (Exception Type) (exception.report (list ["Type" (%.type type)])))] 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 b8bf793ec..7abe0bc57 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 @@ -6,24 +6,22 @@ [monad (.only do)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text ["%" \\format (.only format)]]]]] [///// ["[0]" phase]]) -(exception .public (expansion_failed [macro Symbol - inputs (List Code) - error Text]) +(exception.def .public (expansion_failed [macro inputs error]) + (Exception [Symbol (List Code) Text]) (exception.report (list ["Macro" (%.symbol macro)] ["Inputs" (exception.listing %.code inputs)] ["Error" error]))) -(exception .public (must_have_single_expansion [macro Symbol - inputs (List Code) - outputs (List Code)]) +(exception.def .public (must_have_single_expansion [macro inputs outputs]) + (Exception [Symbol (List Code) (List Code)]) (exception.report (list ["Macro" (%.symbol macro)] ["Inputs" (exception.listing %.code inputs)] 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 b7a808dbf..e6f531191 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 @@ -7,7 +7,7 @@ [control ["[0]" pipe] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] @@ -24,13 +24,14 @@ (type .public Label Text) -(exception .public (unknown_module [module Text]) +(exception.def .public (unknown_module module) + (Exception Text) (exception.report (list ["Module" module]))) (with_template [] - [(exception .public ( [labels (List Label) - owner Type]) + [(exception.def .public ( [labels owner]) + (Exception [(List Label) Type]) (exception.report (list ["Labels" (text.interposed " " labels)] ["Type" (%.type owner)])))] @@ -39,8 +40,8 @@ [cannot_declare_labels_for_foreign_type] ) -(exception .public (cannot_define_more_than_once [name Symbol - already_existing Global]) +(exception.def .public (cannot_define_more_than_once [name already_existing]) + (Exception [Symbol Global]) (exception.report (list ["Definition" (%.symbol name)] ["Original" (when already_existing @@ -59,8 +60,8 @@ {.#Slot _} (format "slot " (%.symbol name)))]))) -(exception .public (can_only_change_state_of_active_module [module Text - state Module_State]) +(exception.def .public (can_only_change_state_of_active_module [module state]) + (Exception [Text Module_State]) (exception.report (list ["Module" module] ["Desired state" (when state 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 c7d17b9cb..ba360a38b 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 @@ -6,7 +6,7 @@ [control ["[0]" maybe (.use "[1]#[0]" monad)] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [data ["[0]" text (.use "[1]#[0]" equivalence)] ["[0]" product] @@ -105,8 +105,8 @@ {.#Some [ref_type ref]}]}) ))))) -(exception .public no_scope) -(exception .public drained) +(exception.def .public no_scope) +(exception.def .public drained) (def .public (with_local [name type] action) (All (_ a) (-> [Text Type] (Operation a) (Operation a))) 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 1b9dbb961..93e1420f8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux @@ -5,7 +5,7 @@ [monad (.only do)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" function]] [data [binary (.only Binary)] @@ -42,12 +42,14 @@ (type .public (Buffer declaration) (Sequence [artifact.ID (Maybe Text) declaration])) -(exception .public (cannot_interpret [error Text]) +(exception.def .public (cannot_interpret error) + (Exception Text) (exception.report (list ["Error" error]))) (with_template [] - [(exception .public ( [it artifact.ID]) + [(exception.def .public ( it) + (Exception artifact.ID) (exception.report (list ["Artifact ID" (%.nat it)])))] @@ -119,7 +121,7 @@ (with_template [ ] - [(exception .public ) + [(exception.def .public ) (def .public (All (_ anchor expression declaration output) ) @@ -267,8 +269,8 @@ [Text #0 [] [] learn_declaration registry.declaration] ) -(exception .public (unknown_definition [name Symbol - known_definitions (List category.Definition)]) +(exception.def .public (unknown_definition [name known_definitions]) + (Exception [Symbol (List category.Definition)]) (exception.report (list ["Definition" (symbol.short name)] ["Module" (symbol.module name)] @@ -312,7 +314,7 @@ {.#Some [@artifact def]} {try.#Success [stateE [[@module @artifact] def]]}))))) -(exception .public no_context) +(exception.def .public no_context) (def .public (module_id module archive) (All (_ anchor expression declaration) 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 9ea79eab0..2775a6787 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -36,7 +36,8 @@ [meta [archive (.only Archive)]]]]]]) -(exception .public (invalid [syntax Code]) +(exception.def .public (invalid syntax) + (Exception Code) (exception.report (list ["Syntax" (%.code syntax)]))) 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 42d01ad16..21c5fba14 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 @@ -6,7 +6,7 @@ [control ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" state]] [data ["[0]" product] @@ -37,13 +37,14 @@ [meta [archive (.only Archive)]]]]]]) -(exception .public (not_a_quantified_type [type Type]) +(exception.def .public (not_a_quantified_type type) + (Exception Type) (exception.report (list ["Type" (%.type type)]))) (with_template [] - [(exception .public ( [type Type - members (List Code)]) + [(exception.def .public ( [type members]) + (Exception [Type (List Code)]) (exception.report (list ["Type" (%.type type)] ["Expression" (%.code (` [(,* members)]))])))] @@ -53,10 +54,8 @@ ) (with_template [] - [(exception .public ( [type Type - lefts Nat - right? Bit - code Code]) + [(exception.def .public ( [type lefts right? code]) + (Exception [Type Nat Bit Code]) (exception.report (list ["Type" (%.type type)] ["Lefts" (%.nat lefts)] @@ -68,16 +67,15 @@ [cannot_infer_sum] ) -(exception .public (cannot_analyse_variant [type Type - tag Symbol - code Code]) +(exception.def .public (cannot_analyse_variant [type tag code]) + (Exception [Type Symbol Code]) (exception.report (list ["Type" (%.type type)] ["Tag" (%.symbol tag)] ["Expression" (%.code code)]))) -(exception .public (cannot_repeat_slot [key Symbol - record (List [Symbol Code])]) +(exception.def .public (cannot_repeat_slot [key record]) + (Exception [Symbol (List [Symbol Code])]) (exception.report (list ["Slot" (%.code (code.symbol key))] ["Record" (%.code (code.tuple (|> record @@ -85,16 +83,14 @@ (list (code.symbol keyI) valC))) list#conjoint)))]))) -(exception .public (slot_does_not_belong_to_record [key Symbol - type Type]) +(exception.def .public (slot_does_not_belong_to_record [key type]) + (Exception [Symbol Type]) (exception.report (list ["Slot" (%.code (code.symbol key))] ["Type" (%.type type)]))) -(exception .public (record_size_mismatch [expected Nat - actual Nat - type Type - record (List [Symbol Code])]) +(exception.def .public (record_size_mismatch [expected actual type record]) + (Exception [Nat Nat Type (List [Symbol Code])]) (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)] 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 7864fd3d5..30f87ec84 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 @@ -6,7 +6,7 @@ [control ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.only) @@ -31,19 +31,16 @@ [reference (.only) [variable (.only)]]]]]) -(exception .public (cannot_analyse [expected Type - function Text - argument Text - body Code]) +(exception.def .public (cannot_analyse [expected function argument body]) + (Exception [Type Text Text Code]) (exception.report (list ["Type" (%.type expected)] ["Function" function] ["Argument" argument] ["Body" (%.code body)]))) -(exception .public (cannot_apply [:function: Type - functionC Code - arguments (List Code)]) +(exception.def .public (cannot_apply [:function: functionC arguments]) + (Exception [Type Code (List Code)]) (exception.report (list ["Function type" (%.type :function:)] ["Function" (%.code functionC)] 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 d71fa4ad0..51816df59 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]]] @@ -22,21 +22,21 @@ ["[1][0]" reference] ["[1]" phase]]]]]) -(exception .public (foreign_module_has_not_been_imported [current Text - foreign Text - quoted Text - definition Symbol]) +(exception.def .public (foreign_module_has_not_been_imported [current foreign quoted definition]) + (Exception [Text Text Text Symbol]) (exception.report (list ["Current" current] ["Foreign" foreign] ["Quoted" quoted] ["Definition" (%.symbol definition)]))) -(exception .public (definition_has_not_been_exported [definition Symbol]) +(exception.def .public (definition_has_not_been_exported definition) + (Exception Symbol) (exception.report (list ["Definition" (%.symbol definition)]))) -(exception .public (labels_are_not_definitions [definition Symbol]) +(exception.def .public (labels_are_not_definitions definition) + (Exception Symbol) (exception.report (list ["Label" (%.symbol definition)]))) 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 index ceb60e374..84fd24cc2 100644 --- 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 @@ -6,7 +6,7 @@ [control ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] [text @@ -38,29 +38,30 @@ [/// ["[1]" phase]]]]]]) -(exception .public (mismatch [type Type - pattern Code]) +(exception.def .public (mismatch [type pattern]) + (Exception [Type Code]) (exception.report (list ["Type" (%.type type)] ["Pattern" (%.code pattern)]))) -(exception .public (sum_has_no_case [case Nat - type Type]) +(exception.def .public (sum_has_no_case [case type]) + (Exception [Nat Type]) (exception.report (list ["Case" (%.nat case)] ["Type" (%.type type)]))) -(exception .public (invalid [it Code]) +(exception.def .public (invalid it) + (Exception Code) (exception.report (list ["Pattern" (%.code it)]))) -(exception .public (non_tuple [type Type]) +(exception.def .public (non_tuple type) + (Exception Type) (exception.report (list ["Type" (%.type type)]))) -(exception .public (non_exhaustive [input Code - branches (List [Code Code]) - coverage Coverage]) +(exception.def .public (non_exhaustive [input branches coverage]) + (Exception [Code (List [Code Code]) Coverage]) (exception.report (list ["Input" (%.code input)] ["Branches" (%.code (code.tuple (|> branches @@ -69,7 +70,7 @@ list#conjoint)))] ["Coverage" (/coverage.format coverage)]))) -(exception .public empty_branches) +(exception.def .public empty_branches) (def (quantified envs baseT) (-> (List (List Type)) Type Type) 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 cd102ce48..832944c9c 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 @@ -6,7 +6,7 @@ ["[0]" monad (.only do)]] [control ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -28,15 +28,18 @@ [meta [archive (.only Archive)]]]]]) -(exception .public (not_a_declaration [code Code]) +(exception.def .public (not_a_declaration code) + (Exception Code) (exception.report (list ["Declaration" (%.code code)]))) -(exception .public (invalid_macro_call [code Code]) +(exception.def .public (invalid_macro_call code) + (Exception Code) (exception.report (list ["Code" (%.code code)]))) -(exception .public (macro_was_not_found [name Symbol]) +(exception.def .public (macro_was_not_found name) + (Exception Symbol) (exception.report (list ["Name" (%.symbol name)]))) 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 0ad49b88e..aa15450d3 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 @@ -8,7 +8,7 @@ [control ["[0]" function] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" order) @@ -64,27 +64,26 @@ (type .public (Phase s i o) (//.Phase (State s i o) i o)) -(exception .public (cannot_overwrite [name Name]) +(exception.def .public (cannot_overwrite name) + (Exception Name) (exception.report (list ["Extension" (%.text name)]))) -(exception .public (incorrect_arity [name Name - arity Nat - args Nat]) +(exception.def .public (incorrect_arity [name arity args]) + (Exception [Name Nat Nat]) (exception.report (list ["Extension" (%.text name)] ["Expected" (%.nat arity)] ["Actual" (%.nat args)]))) -(exception .public [a] (invalid_syntax [name Name - %format (Format a) - inputs (List a)]) +(exception.def .public (invalid_syntax [name %format inputs]) + (All (_ a) (Exception [Name (Format a) (List a)])) (exception.report (list ["Extension" (%.text name)] ["Inputs" (exception.listing %format inputs)]))) -(exception .public [s i o] (unknown [name Name - bundle (Bundle s i o)]) +(exception.def .public (unknown [name bundle]) + (All (_ s i o) (Exception [Name (Bundle s i o)])) (exception.report (list ["Extension" (%.text name)] ["Available" (|> bundle 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 9b8eabe1b..eecfece1f 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 @@ -9,7 +9,7 @@ ["[0]" pipe] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try) (.use "[1]#[0]" monad)] - ["[0]" exception (.only exception)] + ["[0]" exception] [function ["[0]" predicate]]] [data @@ -157,8 +157,8 @@ (getInterfaces [] [(java/lang/Class java/lang/Object)])) (with_template [] - [(exception .public ( [class External - field Text]) + [(exception.def .public ( [class field]) + (exception.Exception [External Text]) (exception.report (list ["Class" (%.text class)] ["Field" (%.text field)])))] @@ -167,15 +167,15 @@ [deprecated_field] ) -(exception .public (deprecated_method [class External - method Text - type .Type]) +(exception.def .public (deprecated_method [class method type]) + (exception.Exception [External Text .Type]) (exception.report (list ["Class" (%.text class)] ["Method" (%.text method)] ["Type" (%.type type)]))) -(exception .public (deprecated_class [class External]) +(exception.def .public (deprecated_class class) + (exception.Exception External) (exception.report (list ["Class" (%.text class)]))) @@ -244,7 +244,8 @@ #throws (List .Type)])) (with_template [] - [(exception .public ( [type .Type]) + [(exception.def .public ( type) + (exception.Exception .Type) (exception.report (list ["Type" (%.type type)])))] @@ -255,7 +256,8 @@ ) (with_template [] - [(exception .public ( [class External]) + [(exception.def .public ( class) + (exception.Exception External) (exception.report (list ["Class/type" (%.text class)])))] @@ -265,12 +267,8 @@ ) (with_template [] - [(exception .public ( [class_variables (List (Type Var)) - class External - method Text - method_variables (List (Type Var)) - inputsJT (List (Type Value)) - hints (List Method_Signature)]) + [(exception.def .public ( [class_variables class method method_variables inputsJT hints]) + (exception.Exception [(List (Type Var)) External Text (List (Type Var)) (List (Type Value)) (List Method_Signature)]) (exception.report (list ["Class Variables" (exception.listing ..signature class_variables)] ["Class" class] @@ -283,22 +281,20 @@ [too_many_candidates] ) -(exception .public (cannot_cast [from (Type Value) - to (Type Value) - value Code]) +(exception.def .public (cannot_cast [from to value]) + (exception.Exception [(Type Value) (Type Value) Code]) (exception.report (list ["From" (..signature from)] ["To" (..signature to)] ["Value" (%.code value)]))) (with_template [] - [(exception .public ( [message Text]) + [(exception.def .public ( message) + (exception.Exception Text) message)] [primitives_cannot_have_type_parameters] - [cannot_possibly_be_an_instance] - [unknown_type_var] ) @@ -1747,8 +1743,9 @@ ) (with_template [] - [(exception .public ( [expected (List [(Type Class) Text (Type Method)]) - actual (List [(Type Class) Text (Type Method)])]) + [(exception.def .public ( [expected actual]) + (exception.Exception [(List [(Type Class) Text (Type Method)]) + (List [(Type Class) Text (Type Method)])]) (let [%method (is (%.Format [(Type Class) Text (Type Method)]) (function (_ [super name type]) (format (..signature super) " :: " (%.text name) " " (..signature type))))] @@ -2257,15 +2254,14 @@ .any ))) -(exception .public (unknown_super [name Text - supers (List (Type Class))]) +(exception.def .public (unknown_super [name supers]) + (exception.Exception [Text (List (Type Class))]) (exception.report (list ["Name" (%.text name)] ["Available" (exception.listing (|>> parser.read_class product.left) supers)]))) -(exception .public (mismatched_super_parameters [name Text - expected Nat - actual Nat]) +(exception.def .public (mismatched_super_parameters [name expected actual]) + (exception.Exception [Text Nat Nat]) (exception.report (list ["Name" (%.text name)] ["Expected" (%.nat expected)] @@ -2372,10 +2368,8 @@ (not (list.any? (matched? sub) super_set))) sub_set)) -(exception .public (class_parameter_mismatch [name Text - declaration (Type Class) - expected (List Text) - actual (List (Type Parameter))]) +(exception.def .public (class_parameter_mismatch [name declaration expected actual]) + (exception.Exception [Text (Type Class) (List Text) (List (Type Parameter))]) (exception.report (list ["Class" (%.text name)] ["Declaration" (signature.signature (jvm.signature declaration))] 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 98912da07..981d1a7a1 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 @@ -7,7 +7,7 @@ ["<>" parser] ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.only) ["%" \\format (.only format)]] @@ -83,7 +83,8 @@ ... TODO: Get rid of this ASAP (these - (exception .public (char_text_must_be_size_1 [text Text]) + (exception.def .public (char_text_must_be_size_1 text) + (Exception Text) (exception.report (list ["Text" (%.text text)]))) @@ -203,7 +204,8 @@ (<| (typeA.expecting input) (phase archive valueC))))])) -(exception .public (not_a_type [symbol Symbol]) +(exception.def .public (not_a_type symbol) + (Exception Symbol) (exception.report (list ["Symbol" (%.symbol symbol)]))) 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 c917dd6a0..050c6263d 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 @@ -8,7 +8,7 @@ ["<>" parser] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" binary] ["[0]" product] @@ -332,16 +332,15 @@ (in [/////declaration.#imports imports /////declaration.#referrals (list)])))])) -(exception .public (cannot_alias_an_alias [local Alias - foreign Alias - target Symbol]) +(exception.def .public (cannot_alias_an_alias [local foreign target]) + (Exception [Alias Alias Symbol]) (exception.report (list ["Local alias" (%.symbol local)] ["Foreign alias" (%.symbol foreign)] ["Target definition" (%.symbol target)]))) -(exception .public (cannot_alias_a_label [local Alias - foreign Alias]) +(exception.def .public (cannot_alias_a_label [local foreign]) + (Exception [Alias Alias]) (exception.report (list ["Alias" (%.symbol local)] ["Label" (%.symbol foreign)]))) 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 0d7953920..88906a74f 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 @@ -6,7 +6,7 @@ [control ["<>" parser] ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] [binary @@ -364,7 +364,8 @@ (-> (Type category) Text)) (|>> type.signature signature.signature)) -(exception .public (not_an_object_array [arrayJT (Type Array)]) +(exception.def .public (not_an_object_array arrayJT) + (Exception (Type Array)) (exception.report (list ["JVM type" (..signature arrayJT)]))) 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 009b99257..911215b10 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception]] [meta [macro ["^" pattern]] @@ -33,7 +33,7 @@ [reference (.only) [variable (.only)]]]]]]]) -(exception .public cannot_recur_as_an_expression) +(exception.def .public cannot_recur_as_an_expression) (def (expression archive synthesis) Phase 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 973ab7cad..a7f0a8444 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 @@ -7,7 +7,7 @@ [control ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" io (.only IO io)] [concurrency ["[0]" atom (.only Atom atom)]]] @@ -66,21 +66,21 @@ (def init::type (type.method [(list) (list) type.void (list)])) (def init::modifier (all modifier#composite method.public method.static method.strict)) -(exception .public (cannot_load [class Text - error Text]) +(exception.def .public (cannot_load [class error]) + (Exception [Text Text]) (exception.report (list ["Class" class] ["Error" error]))) -(exception .public (invalid_field [class Text - field Text - error Text]) +(exception.def .public (invalid_field [class field error]) + (Exception [Text Text Text]) (exception.report (list ["Class" class] ["Field" field] ["Error" error]))) -(exception .public (invalid_value [class Text]) +(exception.def .public (invalid_value class) + (Exception Text) (exception.report (list ["Class" class]))) 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 08fbc07cf..ef70e5688 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception]] [meta [macro ["^" pattern]] @@ -33,7 +33,7 @@ [reference (.only) [variable (.only)]]]]]]]) -(exception .public cannot_recur_as_an_expression) +(exception.def .public cannot_recur_as_an_expression) (def (expression archive synthesis) Phase 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 12e2dffd3..b78a425d9 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception]] [meta [macro ["^" pattern]] @@ -66,7 +66,7 @@ (//////phase#each _.return (/function.function statement expression archive abstraction)) )) -(exception .public cannot_recur_as_an_expression) +(exception.def .public cannot_recur_as_an_expression) (def .public (expression archive synthesis) Phase 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 b2692261f..4f2ead520 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception]] [meta [macro ["^" pattern]] @@ -33,7 +33,7 @@ [reference (.only) [variable (.only)]]]]]]]) -(exception .public cannot_recur_as_an_expression) +(exception.def .public cannot_recur_as_an_expression) (def .public (expression archive synthesis) Phase 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 f57141564..f1ce04dee 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 @@ -2,7 +2,7 @@ lux (lux (control [library [monad (.only do)]] - ["ex" exception (.only exception)] + ["ex" exception] ["p" parser]) (data ["e" error] [text] @@ -62,7 +62,8 @@ Unary (runtimeT.lux//try riskyO)) -(exception .public (Wrong_Syntax [message Text]) +(exception.def .public (Wrong_Syntax message) + (Exception Text) message) (def .public (wrong_syntax procedure args) 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 9c2719467..8d89f45cd 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 @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" exception (.only exception)]] + ["[0]" exception]] [meta [macro ["^" pattern]] @@ -33,7 +33,7 @@ [reference (.only) [variable (.only)]]]]]]]) -(exception .public cannot_recur_as_an_expression) +(exception.def .public cannot_recur_as_an_expression) (def (expression archive synthesis) Phase 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 c1a6184d1..95fc2cc39 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 @@ -7,7 +7,7 @@ [control ["[0]" pipe] ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -31,8 +31,8 @@ ["[1][0]" reference (.only) ["[1]/[0]" variable (.only Register Variable)]]]]]) -(exception .public (cannot_find_foreign_variable_in_environment [foreign Register - environment (Environment Synthesis)]) +(exception.def .public (cannot_find_foreign_variable_in_environment [foreign environment]) + (Exception [Register (Environment Synthesis)]) (exception.report (list ["Foreign" (%.nat foreign)] ["Environment" (exception.listing /.%synthesis environment)]))) 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 0f0d88bdd..553a7e662 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 @@ -6,7 +6,7 @@ [control ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.only) @@ -218,7 +218,8 @@ {.#Item head tail}]))))) (with_template [] - [(exception .public ( [register Register]) + [(exception.def .public ( register) + (Exception Register) (exception.report (list ["Register" (%.nat register)])))] 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 864a8f817..0024c1fca 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/program.lux @@ -6,7 +6,7 @@ [control ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] [text @@ -28,7 +28,8 @@ Text "") -(exception .public (cannot_find_program [modules (List descriptor.Module)]) +(exception.def .public (cannot_find_program modules) + (Exception (List descriptor.Module)) (exception.report (list ["Modules" (exception.listing %.text modules)]))) 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 bbf548818..c74188b26 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/syntax.lux @@ -32,7 +32,7 @@ [control ["<>" parser] ["[0]" maybe] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.only) [\\parser (.only Offset)] @@ -162,7 +162,8 @@ [symbol.separator symbol_separator] ) -(exception .public (end_of_file [module Text]) +(exception.def .public (end_of_file module) + (Exception Text) (exception.report (list ["Module" (%.text module)]))) @@ -173,10 +174,8 @@ (let [end (|> start (!n/+ amount_of_input_shown) (n.min ("lux text size" input)))] (!clip start end input))) -(exception .public (unrecognized_input [[file line column] Location - context Text - input Text - offset Offset]) +(exception.def .public (unrecognized_input [[file line column] context input offset]) + (Exception [Location Text Text Offset]) (exception.report (list ["File" file] ["Line" (%.nat line)] @@ -184,7 +183,8 @@ ["Context" (%.text context)] ["Input" (input_at offset input)]))) -(exception .public (text_cannot_contain_new_lines [text Text]) +(exception.def .public (text_cannot_contain_new_lines text) + (Exception Text) (exception.report (list ["Text" (%.text text)]))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/archive.lux index bcbdcaff4..f492ed908 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive.lux @@ -8,7 +8,7 @@ ["<>" parser] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" function]] [data ["[0]" product] @@ -42,22 +42,22 @@ (type .public Output (Sequence [artifact.ID (Maybe Text) Binary])) -(exception .public (unknown_document [module descriptor.Module - known_modules (List descriptor.Module)]) +(exception.def .public (unknown_document [module known_modules]) + (Exception [descriptor.Module (List descriptor.Module)]) (exception.report (list ["Module" (%.text module)] ["Known Modules" (exception.listing %.text known_modules)]))) -(exception .public (cannot_replace_document [module descriptor.Module - old (Document Any) - new (Document Any)]) +(exception.def .public (cannot_replace_document [module old new]) + (Exception [descriptor.Module (Document Any) (Document Any)]) (exception.report (list ["Module" (%.text module)] ["Old key" (signature.description (document.signature old))] ["New key" (signature.description (document.signature new))]))) (with_template [] - [(exception .public ( [it descriptor.Module]) + [(exception.def .public ( it) + (Exception descriptor.Module) (exception.report (list ["Module" (%.text it)])))] @@ -246,8 +246,8 @@ [version /#next] (\\format.result ..format)))) - (exception .public (version_mismatch [expected Version - actual Version]) + (exception.def .public (version_mismatch [expected actual]) + (Exception [Version Version]) (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)]))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/module/document.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/module/document.lux index 3baa41932..3c0df9cbc 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/module/document.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/module/document.lux @@ -6,7 +6,7 @@ [control ["<>" parser] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [collection ["[0]" dictionary (.only Dictionary)]] @@ -20,8 +20,8 @@ ["[0]" signature (.only Signature) (.use "[1]#[0]" equivalence)] ["[0]" key (.only Key)]]) -(exception .public (invalid_signature [expected Signature - actual Signature]) +(exception.def .public (invalid_signature [expected actual]) + (Exception [Signature Signature]) (exception.report (list ["Expected" (signature.description expected)] ["Actual" (signature.description actual)]))) 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 9f1e240d9..e3d675ec0 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/archive/registry.lux @@ -7,7 +7,7 @@ ["<>" parser] ["[0]" pipe] ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" binary @@ -145,7 +145,8 @@ dependencies])) artifacts))) - (exception .public (invalid_category [tag Nat]) + (exception.def .public (invalid_category tag) + (Exception Nat) (exception.report (list ["Tag" (%.nat tag)]))) 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 619e3db90..a78ddc424 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/module.lux @@ -6,7 +6,7 @@ [control ["[0]" pipe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [binary (.only Binary)] ["[0]" product] @@ -25,9 +25,8 @@ [archive ["[0]" module]]]]) -(exception .public (cannot_enable [archive file.Path - @module module.ID - error Text]) +(exception.def .public (cannot_enable [archive @module error]) + (Exception [file.Path module.ID Text]) (exception.report (list ["Archive" archive] ["Module ID" (%.nat @module)] diff --git a/stdlib/source/library/lux/meta/compiler/meta/import.lux b/stdlib/source/library/lux/meta/compiler/meta/import.lux index 500de0a6f..334c2aa13 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/import.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/import.lux @@ -6,7 +6,7 @@ [control ["<>" parser] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] [concurrency ["[0]" async (.only Async)]]] [data @@ -29,10 +29,10 @@ (def Action (type_literal (All (_ a) (Async (Try a))))) -(exception .public useless_tar_entry) +(exception.def .public useless_tar_entry) -(exception .public (duplicate [library Library - module Module]) +(exception.def .public (duplicate [library module]) + (Exception [Library Module]) (exception.report (list ["Module" (%.text module)] ["Library" (%.text library)]))) 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 e6a80f7a5..ae87b57af 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/context.lux @@ -6,7 +6,7 @@ [control ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] [concurrency ["[0]" async (.only Async) (.use "[1]#[0]" monad)]] [function @@ -32,13 +32,14 @@ [module [descriptor (.only Module)]]]]]) -(exception .public (cannot_find_module [importer Module - module Module]) +(exception.def .public (cannot_find_module [importer module]) + (Exception [Module Module]) (exception.report (list ["Module" (%.text module)] ["Importer" (%.text importer)]))) -(exception .public (cannot_read_module [module Module]) +(exception.def .public (cannot_read_module module) + (Exception Module) (exception.report (list ["Module" (%.text module)]))) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index b98d92ee1..d8bf76a9a 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -8,7 +8,7 @@ [control ["<>" parser] ["[0]" maybe (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format] @@ -66,7 +66,7 @@ (.slice (.some! (.none_of! ..end)))))] (<>.some (<>.and parser' parser')))) -(exception .public invalid) +(exception.def .public invalid) (def configuration (.Parser Configuration) diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux index 5a347775d..dc2911506 100644 --- a/stdlib/source/library/lux/meta/macro/context.lux +++ b/stdlib/source/library/lux/meta/macro/context.lux @@ -5,7 +5,7 @@ [monad (.only do)]] [control ["?" parser] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" maybe] [function [predicate (.only Predicate)]]] @@ -24,7 +24,8 @@ (type .public Stack List) -(exception .public (no_definition [it Symbol]) +(exception.def .public (no_definition it) + (Exception Symbol) (exception.report (list ["Definition" (symbol#encoded it)]))) @@ -44,7 +45,7 @@ {.#None} (meta.failure (exception.error ..no_definition [it]))))) -(exception .public no_active_context) +(exception.def .public no_active_context) (.def .public (peek' _ context) (All (_ a) (-> (Stack a) Symbol (Meta a))) @@ -63,7 +64,7 @@ (syntax (_ [g!it (at ?.monad each code.symbol ?code.global)]) (in (list (` (..peek' (, g!it) (.symbol (, g!it)))))))) -(exception .public no_example) +(exception.def .public no_example) (.def .public (search' _ ? context) (All (_ a) (-> (Stack a) (Predicate a) Symbol (Meta a))) diff --git a/stdlib/source/library/lux/meta/macro/local.lux b/stdlib/source/library/lux/meta/macro/local.lux index c69b32f95..48ca7db43 100644 --- a/stdlib/source/library/lux/meta/macro/local.lux +++ b/stdlib/source/library/lux/meta/macro/local.lux @@ -6,7 +6,7 @@ [control ["<>" parser] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text] @@ -19,13 +19,14 @@ ["[0]" // (.only) [syntax (.only syntax)]]) -(exception .public (unknown_module [module Text]) +(exception.def .public (unknown_module module) + (Exception Text) (exception.report (list ["Module" (text.format module)]))) (with_template [] - [(exception .public ( [module Text - definition Text]) + [(exception.def .public ( [module definition]) + (Exception [Text Text]) (exception.report (list ["Module" (text.format module)] ["Definition" (text.format definition)])))] diff --git a/stdlib/source/library/lux/meta/macro/syntax/definition.lux b/stdlib/source/library/lux/meta/macro/syntax/definition.lux index 0f6be7510..0db62599f 100644 --- a/stdlib/source/library/lux/meta/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/meta/macro/syntax/definition.lux @@ -6,7 +6,7 @@ [monad (.only do)]] [control ["<>" parser] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" sum] ["[0]" product] @@ -81,7 +81,8 @@ .bit )))) -(exception .public (lacks_type [definition Definition]) +(exception.def .public (lacks_type definition) + (Exception Definition) (exception.report (list ["Definition" (%.code (..format definition))]))) diff --git a/stdlib/source/library/lux/meta/macro/syntax/export.lux b/stdlib/source/library/lux/meta/macro/syntax/export.lux index 04e5c730a..98db6124e 100644 --- a/stdlib/source/library/lux/meta/macro/syntax/export.lux +++ b/stdlib/source/library/lux/meta/macro/syntax/export.lux @@ -9,30 +9,34 @@ ["[0]" code ["<[1]>" \\parser (.only Parser)]]]]]) -(def .public default_policy - Code +(type .public Policy + Code) + +(def .public default + Policy (` .private)) (`` (def policy - (Parser Code) + (Parser Policy) (do [! <>.monad] [candidate .next] (when candidate [_ {.#Symbol ["" _]}] - (in default_policy) + (in default) - (,, (with_template [] - [ + (,, (with_template [] + [[_ { _}] (do ! [_ .any] (in candidate))] - [[_ {.#Bit _}]] - [[_ {.#Symbol _}]])) + [.#Bit] + [.#Symbol] + )) _ - (in default_policy))))) + (in default))))) (def .public parser - (All (_ a) (-> (Parser a) (Parser [Code a]))) + (All (_ a) (-> (Parser a) (Parser [Policy a]))) (<>.and ..policy)) diff --git a/stdlib/source/library/lux/meta/macro/template.lux b/stdlib/source/library/lux/meta/macro/template.lux index a045bd235..829c971cf 100644 --- a/stdlib/source/library/lux/meta/macro/template.lux +++ b/stdlib/source/library/lux/meta/macro/template.lux @@ -6,7 +6,7 @@ [control ["<>" parser (.use "[1]#[0]" functor)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" bit (.use "[1]#[0]" codec)] ["[0]" text] @@ -127,8 +127,8 @@ #parameters (List Text) #template (List Code)])) -(exception .public (irregular_arguments [expected Nat - actual Nat]) +(exception.def .public (irregular_arguments [expected actual]) + (Exception [Nat Nat]) (exception.report (list ["Expected" (at nat.decimal encoded expected)] ["Actual" (at nat.decimal encoded actual)]))) diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux index 3f54c9db4..ce47d7f96 100644 --- a/stdlib/source/library/lux/meta/macro/vocabulary.lux +++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux @@ -7,7 +7,7 @@ [monad (.only do)]] [control ["?" parser (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]]]] + ["[0]" exception (.only Exception)]]]] ["[0]" // (.only) [syntax (.only syntax) ["[0]" export]] @@ -17,8 +17,8 @@ ["[0]" type (.only) [primitive (.except)]]]]) -(exception .public (invalid_type [expected Type - actual Type]) +(exception.def .public (invalid_type [expected actual]) + (Exception [Type Type]) (exception.report (list ["Expected" (type.format expected)] ["Actual" (type.format actual)]))) diff --git a/stdlib/source/library/lux/meta/target/jvm/bytecode.lux b/stdlib/source/library/lux/meta/target/jvm/bytecode.lux index 57ea8caf8..fb54ac19a 100644 --- a/stdlib/source/library/lux/meta/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/meta/target/jvm/bytecode.lux @@ -11,7 +11,7 @@ ["[0]" state (.only +State)] ["[0]" maybe] ["[0]" try (.only Try) (.use "[1]#[0]" monad)] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [data ["[0]" product] [text @@ -129,15 +129,13 @@ [..relative#identity (the #next tracker)]]})) -(exception .public (label_has_already_been_set [label Label]) +(exception.def .public (label_has_already_been_set label) + (exception.Exception Label) (exception.report (list ["Label" (%.nat label)]))) -(exception .public (mismatched_environments [instruction Symbol - label Label - address Address - expected Stack - actual Stack]) +(exception.def .public (mismatched_environments [instruction label address expected actual]) + (exception.Exception [Symbol Label Address Stack Stack]) (exception.report (list ["Instruction" (%.symbol instruction)] ["Label" (%.nat label)] @@ -679,7 +677,8 @@ _ (..arbitrary_double value)))) -(exception .public (invalid_register [id Nat]) +(exception.def .public (invalid_register id) + (exception.Exception Nat) (exception.report (list ["ID" (%.nat id)]))) @@ -781,13 +780,13 @@ [$0 $1 sipush _.sipush S2] ) -(exception .public (unknown_label [label Label]) +(exception.def .public (unknown_label label) + (exception.Exception Label) (exception.report (list ["Label" (%.nat label)]))) -(exception .public (cannot_do_a_big_jump [label Label - @from Address - jump Big_Jump]) +(exception.def .public (cannot_do_a_big_jump [label @from jump]) + (exception.Exception [Label Address Big_Jump]) (exception.report (list ["Label" (%.nat label)] ["Start" (|> @from /address.value //unsigned.value %.nat)] @@ -809,7 +808,8 @@ (try#each (|>> {.#Left}) (//signed.s4 jump)) (try#each (|>> {.#Right}) (//signed.s2 jump))))) -(exception .public (unset_label [label Label]) +(exception.def .public (unset_label label) + (exception.Exception Label) (exception.report (list ["Label" (%.nat label)]))) @@ -938,7 +938,7 @@ {.#Right small} (/jump.lifted small))) -(exception .public invalid_tableswitch) +(exception.def .public invalid_tableswitch) (def .public (tableswitch minimum default [at_minimum afterwards]) (-> S4 Label [Label (List Label)] (Bytecode Any)) @@ -976,7 +976,7 @@ (exception.except ..invalid_tableswitch [])))) []]])))))) -(exception .public invalid_lookupswitch) +(exception.def .public invalid_lookupswitch) (def .public (lookupswitch default cases) (-> Label (List [S4 Label]) (Bytecode Any)) @@ -1042,7 +1042,8 @@ [register (..register register)] (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))) -(exception .public (multiarray_cannot_be_zero_dimensional [class (Type Object)]) +(exception.def .public (multiarray_cannot_be_zero_dimensional class) + (exception.Exception (Type Object)) (exception.report (list ["Class" (..reflection class)]))) @@ -1128,8 +1129,8 @@ [putfield $2 _.putfield/1 $3 _.putfield/2] ) -(exception .public (invalid_range_for_try [start Address - end Address]) +(exception.def .public (invalid_range_for_try [start end]) + (exception.Exception [Address Address]) (exception.report (list ["Start" (|> start /address.value //unsigned.value %.nat)] ["End" (|> end /address.value //unsigned.value %.nat)]))) 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 dd33b7853..a7e687751 100644 --- a/stdlib/source/library/lux/meta/target/jvm/bytecode/environment.lux +++ b/stdlib/source/library/lux/meta/target/jvm/bytecode/environment.lux @@ -6,7 +6,7 @@ [monoid (.only Monoid)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]]]] + ["[0]" exception (.only Exception)]]]] [/ ["/[0]" limit (.only Limit) ["/[0]" stack (.only Stack)] @@ -49,7 +49,7 @@ [environment (left environment)] (right environment)))))) -(exception .public discontinuity) +(exception.def .public discontinuity) (def .public (stack environment) (-> Environment (Try Stack)) @@ -64,8 +64,8 @@ (-> Environment Environment) (.has ..#stack {.#None})) -(exception .public (mismatched_stacks [expected Stack - actual Stack]) +(exception.def .public (mismatched_stacks [expected actual]) + (Exception [Stack Stack]) (exception.report (list ["Expected" (/stack.text expected)] ["Actual" (/stack.text actual)]))) diff --git a/stdlib/source/library/lux/meta/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/meta/target/jvm/encoding/signed.lux index 430263c8d..11a43668f 100644 --- a/stdlib/source/library/lux/meta/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/meta/target/jvm/encoding/signed.lux @@ -6,7 +6,7 @@ [order (.only Order)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -43,8 +43,8 @@ (def (< reference sample) (i.< (representation reference) (representation sample))))) - (exception .public (value_exceeds_the_scope [value Int - scope Nat]) + (exception.def .public (value_exceeds_the_scope [value scope]) + (Exception [Int Nat]) (exception.report (list ["Value" (%.int value)] ["Scope (in bytes)" (%.nat scope)]))) diff --git a/stdlib/source/library/lux/meta/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/meta/target/jvm/encoding/unsigned.lux index 1c2bc77a6..0c6e7cde3 100644 --- a/stdlib/source/library/lux/meta/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/meta/target/jvm/encoding/unsigned.lux @@ -6,7 +6,7 @@ [order (.only Order)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -44,18 +44,15 @@ (n.< (representation reference) (representation sample))))) - (exception .public (value_exceeds_the_maximum [type Symbol - value Nat - maximum (Unsigned Any)]) + (exception.def .public (value_exceeds_the_maximum [type value maximum]) + (Exception [Symbol Nat (Unsigned Any)]) (exception.report (list ["Type" (%.symbol type)] ["Value" (%.nat value)] ["Maximum" (%.nat (representation maximum))]))) - (exception .public [brand] (subtraction_cannot_yield_negative_value - [type Symbol - parameter (Unsigned brand) - subject (Unsigned brand)]) + (exception.def .public (subtraction_cannot_yield_negative_value [type parameter subject]) + (All (_ brand) (Exception [Symbol (Unsigned brand) (Unsigned brand)])) (exception.report (list ["Type" (%.symbol type)] ["Parameter" (%.nat (representation parameter))] diff --git a/stdlib/source/library/lux/meta/target/jvm/loader.lux b/stdlib/source/library/lux/meta/target/jvm/loader.lux index c8d70c482..3f2c4dd39 100644 --- a/stdlib/source/library/lux/meta/target/jvm/loader.lux +++ b/stdlib/source/library/lux/meta/target/jvm/loader.lux @@ -6,7 +6,7 @@ [monad (.only do)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" io (.only IO)] [concurrency ["[0]" atom (.only Atom)]]] @@ -23,16 +23,18 @@ (type .public Library (Atom (Dictionary Text Binary))) -(exception .public (already_stored [class Text]) +(exception.def .public (already_stored class) + (Exception Text) (exception.report (list ["Class" class]))) -(exception .public (unknown [class Text]) +(exception.def .public (unknown class) + (Exception Text) (exception.report (list ["Class" class]))) -(exception .public (cannot_define [class Text - error Text]) +(exception.def .public (cannot_define [class error]) + (Exception [Text Text]) (exception.report (list ["Class" class] ["Error" error]))) diff --git a/stdlib/source/library/lux/meta/target/jvm/reflection.lux b/stdlib/source/library/lux/meta/target/jvm/reflection.lux index a33bc6507..2a0ad37a8 100644 --- a/stdlib/source/library/lux/meta/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/meta/target/jvm/reflection.lux @@ -6,7 +6,7 @@ ["[0]" monad (.only do)]] [control ["[0]" try (.only Try) (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)] @@ -96,12 +96,14 @@ (isArray [] boolean) (getComponentType [] (java/lang/Class java/lang/Object))) -(exception .public (unknown_class [class External]) +(exception.def .public (unknown_class class) + (Exception External) (exception.report (list ["Class" (%.text class)]))) (with_template [] - [(exception .public ( [jvm_type java/lang/reflect/Type]) + [(exception.def .public ( jvm_type) + (Exception java/lang/reflect/Type) (exception.report (list ["Type" (java/lang/reflect/Type::getTypeName jvm_type)] ["Class" (|> jvm_type java/lang/Object::getClass java/lang/Object::toString)])))] @@ -267,23 +269,22 @@ {.#None} ))) -(exception .public (cannot_correspond [class (java/lang/Class java/lang/Object) - type Type]) +(exception.def .public (cannot_correspond [class type]) + (Exception [(java/lang/Class java/lang/Object) Type]) (exception.report (list ["Class" (java/lang/Object::toString class)] ["Type" (%.type type)]))) -(exception .public (type_parameter_mismatch [expected Nat - actual Nat - class (java/lang/Class java/lang/Object) - type Type]) +(exception.def .public (type_parameter_mismatch [expected actual class type]) + (Exception [Nat Nat (java/lang/Class java/lang/Object) Type]) (exception.report (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)] ["Class" (java/lang/Object::toString class)] ["Type" (%.type type)]))) -(exception .public (non_jvm_type [type Type]) +(exception.def .public (non_jvm_type type) + (Exception Type) (exception.report (list ["Type" (%.type type)]))) @@ -327,17 +328,16 @@ _ (exception.except ..non_jvm_type [type]))) -(exception .public (mistaken_field_owner [field java/lang/reflect/Field - owner (java/lang/Class java/lang/Object) - target (java/lang/Class java/lang/Object)]) +(exception.def .public (mistaken_field_owner [field owner target]) + (Exception [java/lang/reflect/Field (java/lang/Class java/lang/Object) (java/lang/Class java/lang/Object)]) (exception.report (list ["Field" (java/lang/Object::toString field)] ["Owner" (java/lang/Object::toString owner)] ["Target" (java/lang/Object::toString target)]))) (with_template [] - [(exception .public ( [field Text - class (java/lang/Class java/lang/Object)]) + [(exception.def .public ( [field class]) + (Exception [Text (java/lang/Class java/lang/Object)]) (exception.report (list ["Field" (%.text field)] ["Class" (java/lang/Object::toString class)])))] 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 4f6d9076f..89639ce4d 100644 --- a/stdlib/source/library/lux/meta/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/meta/target/jvm/type/lux.lux @@ -6,7 +6,7 @@ [control ["<>" parser (.use "[1]#[0]" monad)] ["[0]" try] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) @@ -44,7 +44,8 @@ Mapping (dictionary.empty text.hash)) -(exception .public (unknown_var [var Text]) +(exception.def .public (unknown_var var) + (Exception Text) (exception.report (list ["Var" (%.text var)]))) diff --git a/stdlib/source/library/lux/meta/type/check.lux b/stdlib/source/library/lux/meta/type/check.lux index 184864469..718f27931 100644 --- a/stdlib/source/library/lux/meta/type/check.lux +++ b/stdlib/source/library/lux/meta/type/check.lux @@ -8,7 +8,7 @@ [control ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only Exception exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" monoid equivalence)] @@ -32,30 +32,31 @@ (template (_ reference subject) [("lux text =" reference subject)])) -(exception .public (unknown_type_var [id Nat]) - (exception.report - (list ["ID" (n#encoded id)]))) +(with_template [] + [(exception.def .public ( id) + (Exception Nat) + (exception.report + (list ["ID" (n#encoded id)])))] -(exception .public (unbound_type_var [id Nat]) - (exception.report - (list ["ID" (n#encoded id)]))) + [unknown_type_var] + [unbound_type_var] + ) -(exception .public (invalid_type_application [funcT Type - argT Type]) +(exception.def .public (invalid_type_application [funcT argT]) + (Exception [Type Type]) (exception.report (list ["Type function" (//.format funcT)] ["Type argument" (//.format argT)]))) -(exception .public (cannot_rebind_var [id Nat - type Type - bound Type]) +(exception.def .public (cannot_rebind_var [id type bound]) + (Exception [Nat Type Type]) (exception.report (list ["Var" (n#encoded id)] ["Wanted type" (//.format type)] ["Current type" (//.format bound)]))) -(exception .public (type_check_failed [expected Type - actual Type]) +(exception.def .public (type_check_failed [expected actual]) + (Exception [Type Type]) (exception.report (list ["Expected" (//.format expected)] ["Actual" (//.format actual)]))) @@ -338,7 +339,8 @@ (set.member? it @1)) (..ring @0))) -(exception .public (cannot_identify [var Var]) +(exception.def .public (cannot_identify var) + (Exception Var) (exception.report (list ["Var" (n#encoded var)]))) diff --git a/stdlib/source/library/lux/meta/type/dynamic.lux b/stdlib/source/library/lux/meta/type/dynamic.lux index a10d24530..6c69e7417 100644 --- a/stdlib/source/library/lux/meta/type/dynamic.lux +++ b/stdlib/source/library/lux/meta/type/dynamic.lux @@ -4,7 +4,7 @@ ["[0]" debug] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format]]] @@ -16,8 +16,8 @@ ["[0]" // (.only) ["[0]" primitive (.only primitive)]]) -(exception .public (wrong_type [expected Type - actual Type]) +(exception.def .public (wrong_type [expected actual]) + (Exception [Type Type]) (exception.report (list ["Expected" (%.type expected)] ["Actual" (%.type actual)]))) diff --git a/stdlib/source/library/lux/meta/type/resource.lux b/stdlib/source/library/lux/meta/type/resource.lux index 7b1a83195..904ee3129 100644 --- a/stdlib/source/library/lux/meta/type/resource.lux +++ b/stdlib/source/library/lux/meta/type/resource.lux @@ -7,7 +7,7 @@ [control ["<>" parser] ["[0]" maybe] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data [text ["%" \\format (.only format)]] @@ -102,11 +102,12 @@ (at monad in [keys (representation resource)]))) ) -(exception .public (index_cannot_be_repeated [index Nat]) +(exception.def .public (index_cannot_be_repeated index) + (Exception Nat) (exception.report (list ["Index" (%.nat index)]))) -(exception .public amount_cannot_be_zero) +(exception.def .public amount_cannot_be_zero) (def indices (Parser (List Nat)) diff --git a/stdlib/source/library/lux/meta/version.lux b/stdlib/source/library/lux/meta/version.lux index af8da3bce..b25439e57 100644 --- a/stdlib/source/library/lux/meta/version.lux +++ b/stdlib/source/library/lux/meta/version.lux @@ -5,7 +5,7 @@ [monad (.only do)]] [control ["<>" parser] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [data ["[0]" text (.use "[1]#[0]" equivalence)] [collection @@ -28,7 +28,7 @@ [it meta.version] (in (list (code.text it)))))) -(exception .public invalid) +(exception.def .public invalid) (def .public for (syntax (_ [specializations (<>.some (<>.and .text .any)) diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux index e18d7b36b..2e1739797 100644 --- a/stdlib/source/library/lux/test/property.lux +++ b/stdlib/source/library/lux/test/property.lux @@ -8,7 +8,7 @@ ["[0]" pipe] ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" io] [concurrency ["[0]" atom (.only Atom)] @@ -106,7 +106,7 @@ (format documentation ..separator ..separator "Failed with this seed: " (%.nat seed))) -(exception .public must_try_test_at_least_once) +(exception.def .public must_try_test_at_least_once) (def .public (times amount test) (-> Nat Test Test) @@ -230,7 +230,8 @@ (|>> (//.covering (, module))) (, test))))))) -(exception .public (error_during_execution [error Text]) +(exception.def .public (error_during_execution error) + (Exception Text) (exception.report (list ["Error" (%.text error)]))) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index 71761bead..440063bca 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -7,7 +7,7 @@ [control ["[0]" maybe] ["[0]" try (.only Try) (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)] + ["[0]" exception] ["[0]" io (.only IO io) (.use "[1]#[0]" functor)] [concurrency ["[0]" async (.only Async) (.use "[1]#[0]" monad)] @@ -41,7 +41,7 @@ [write] [close]))))) -(exception .public cannot_close) +(exception.def .public cannot_close) (with_expansions [ (these (import java/lang/String "[1]::[0]") @@ -64,7 +64,7 @@ ("read_only" "static" in java/io/InputStream) ("read_only" "static" out java/io/PrintStream)) - (exception .public cannot_open) + (exception.def .public cannot_open) (def .public default (IO (Try (Console IO))) @@ -117,7 +117,7 @@ ("static" stdout Writable_Stream) ("static" stdin Readable_Stream)) - (exception .public cannot_read) + (exception.def .public cannot_read) (def !read (template (_ ) diff --git a/stdlib/source/library/lux/world/environment.lux b/stdlib/source/library/lux/world/environment.lux index ba941b30e..69d8dce95 100644 --- a/stdlib/source/library/lux/world/environment.lux +++ b/stdlib/source/library/lux/world/environment.lux @@ -8,7 +8,7 @@ ["[0]" io (.only IO)] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] [concurrency ["[0]" atom] ["[0]" async (.only Async)]]] @@ -36,7 +36,8 @@ [file (.only Path)] [shell (.only Exit)]]))) -(exception .public (unknown_environment_variable [name Text]) +(exception.def .public (unknown_environment_variable name) + (Exception Text) (exception.report (list ["Name" (%.text name)]))) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index eb4bb69fa..1e2bdd90d 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -7,7 +7,7 @@ ["[0]" pipe] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try) (.use "[1]#[0]" functor)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] ["[0]" io (.only IO) (.use "[1]#[0]" functor)] ["[0]" function] [concurrency @@ -147,7 +147,8 @@ (format parent (at fs separator) child)) (with_template [] - [(exception .public ( [file Path]) + [(exception.def .public ( file) + (Exception Path) (exception.report (list ["Path" file])))] @@ -813,7 +814,8 @@ ... (def default_separator (..DIRECTORY_SEPARATOR)) ... (with_template [] - ... [(exception .public ( [file Path]) + ... [(exception.def .public ( file) + ... (Exception Path) ... (exception.report ... (list ["Path" file])))] diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index c0d79ea50..f5f64dcf5 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -8,7 +8,7 @@ ["[0]" io (.only IO)] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception (.only Exception)] [concurrency ["[0]" async (.only Async)] ["[0]" stm (.only STM Var)]] @@ -96,7 +96,8 @@ poll))) (with_template [] - [(exception .public ( [path //.Path]) + [(exception.def .public ( path) + (Exception //.Path) (exception.report (list ["Path" (%.text path)])))] diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 5ab10bba6..bd7829907 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -7,7 +7,7 @@ [control ["[0]" function] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)] + ["[0]" exception] ["[0]" io (.only IO)] [security ["?" policy (.only Context Safety Safe)]] @@ -230,7 +230,7 @@ (destroy [] "io" "try" void) (waitFor [] "io" "try" int)) - (exception .public no_more_output) + (exception.def .public no_more_output) (def (default_process process) (-> java/lang/Process (IO (Try (Process IO)))) diff --git a/stdlib/source/library/lux/world/time.lux b/stdlib/source/library/lux/world/time.lux index 22a0d85f3..853b0429f 100644 --- a/stdlib/source/library/lux/world/time.lux +++ b/stdlib/source/library/lux/world/time.lux @@ -11,7 +11,7 @@ ["<>" parser (.only)] ["[0]" pipe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" monoid) ["<[1]>" \\parser (.only Parser)]]] @@ -39,7 +39,8 @@ Nat (.nat (duration.millis duration.day))) -(exception .public (time_exceeds_a_day [time Nat]) +(exception.def .public (time_exceeds_a_day time) + (Exception Nat) (exception.report (list ["Time (in milli-seconds)" (n#encoded time)] ["Maximum (in milli-seconds)" (n#encoded (-- limit))]))) @@ -58,7 +59,8 @@ (at <>.monad in 0))) (with_template [ ] - [(exception .public ( [value Nat]) + [(exception.def .public ( value) + (Exception Nat) (exception.report (list ["Value" (n#encoded value)] ["Minimum" (n#encoded 0)] diff --git a/stdlib/source/library/lux/world/time/date.lux b/stdlib/source/library/lux/world/time/date.lux index 09fd828ae..30c182179 100644 --- a/stdlib/source/library/lux/world/time/date.lux +++ b/stdlib/source/library/lux/world/time/date.lux @@ -11,7 +11,7 @@ ["<>" parser (.only)] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" monoid) ["<[1]>" \\parser (.only Parser)]] @@ -50,9 +50,8 @@ (or (n.< ..minimum_day day) (n.> (..month_days year month) day))) -(exception .public (invalid_day [year Year - month Month - day Nat]) +(exception.def .public (invalid_day [year month day]) + (Exception [Year Month Nat]) (exception.report (list ["Value" (n#encoded day)] ["Minimum" (n#encoded ..minimum_day)] @@ -154,7 +153,8 @@ (at <>.monad in 0))) (with_template [ ] - [(exception .public ( [value Nat]) + [(exception.def .public ( value) + (Exception Nat) (exception.report (list ["Value" (n#encoded value)] ["Minimum" (n#encoded )] diff --git a/stdlib/source/library/lux/world/time/day.lux b/stdlib/source/library/lux/world/time/day.lux index f763fbb8f..67a7600d3 100644 --- a/stdlib/source/library/lux/world/time/day.lux +++ b/stdlib/source/library/lux/world/time/day.lux @@ -9,7 +9,7 @@ [codec (.only Codec)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" monoid)]] [math @@ -95,7 +95,8 @@ {#Saturday} {#Friday} {#Sunday} {#Saturday})))) -(exception .public (not_a_day_of_the_week [value Text]) +(exception.def .public (not_a_day_of_the_week value) + (Exception Text) (exception.report (list ["Value" (text.format value)]))) @@ -153,7 +154,8 @@ ]) ())) - (exception .public (invalid_day [number Nat]) + (exception.def .public (invalid_day number) + (Exception Nat) (exception.report (list ["Number" (at n.decimal encoded number)] ["Valid range" (all "lux text concat" diff --git a/stdlib/source/library/lux/world/time/month.lux b/stdlib/source/library/lux/world/time/month.lux index 35f56020d..814eb32c9 100644 --- a/stdlib/source/library/lux/world/time/month.lux +++ b/stdlib/source/library/lux/world/time/month.lux @@ -9,7 +9,7 @@ [codec (.only Codec)]] [control ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception (.only Exception)]] [data ["[0]" text (.use "[1]#[0]" monoid)]] [math @@ -79,7 +79,8 @@ ]) ())) - (exception .public (invalid_month [number Nat]) + (exception.def .public (invalid_month number) + (Exception Nat) (exception.report (list ["Number" (at n.decimal encoded number)] ["Valid range" (all "lux text concat" @@ -208,7 +209,8 @@ {#November} {#December})) -(exception .public (not_a_month_of_the_year [value Text]) +(exception.def .public (not_a_month_of_the_year value) + (Exception Text) (exception.report (list ["Value" (text.format value)]))) diff --git a/stdlib/source/library/lux/world/time/year.lux b/stdlib/source/library/lux/world/time/year.lux index ae01271f5..8826f089d 100644 --- a/stdlib/source/library/lux/world/time/year.lux +++ b/stdlib/source/library/lux/world/time/year.lux @@ -9,7 +9,7 @@ [control ["<>" parser (.only)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] + ["[0]" exception]] [data ["[0]" text (.use "[1]#[0]" monoid) ["<[1]>" \\parser (.only Parser)]]] @@ -33,7 +33,7 @@ year (-- year))) -(exception .public there_is_no_year_0) +(exception.def .public there_is_no_year_0) ... https://en.wikipedia.org/wiki/Gregorian_calendar (primitive .public Year -- cgit v1.2.3