diff options
Diffstat (limited to 'stdlib/source/library')
21 files changed, 227 insertions, 144 deletions
diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 3a63629a9..b704a4cfc 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -23,7 +23,7 @@ ["n" nat] ["[0]" int]]] [meta - ["[0]" symbol (.use "[1]#[0]" equivalence codec)]]]]) + ["[0]" symbol (.use "[1]#[0]" equivalence absolute)]]]]) (type .public Tag Symbol) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index fa6dea601..7fec7dba4 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -1679,7 +1679,7 @@ {.#Apply A F} (when (type.applied (list A) F) {.#None} - (meta.failure (format "Cannot apply type: " (type.format F) " to " (type.format A))) + (meta.failure (format "Cannot apply type: " (%.type F) " to " (%.type A))) {.#Some type'} (type_class_name type')) @@ -1688,7 +1688,7 @@ (type_class_name type') _ - (meta.failure (format "Cannot convert to JvmType: " (type.format type)))))) + (meta.failure (format "Cannot convert to JvmType: " (%.type type)))))) (def .public read! (syntax (_ [idx <code>.any diff --git a/stdlib/source/library/lux/math/arithmetic/fixed_point.lux b/stdlib/source/library/lux/math/arithmetic/fixed_point.lux index e6ac5834b..4498bce85 100644 --- a/stdlib/source/library/lux/math/arithmetic/fixed_point.lux +++ b/stdlib/source/library/lux/math/arithmetic/fixed_point.lux @@ -112,6 +112,7 @@ Rev)) (|>> nominal.representation (i64.and (i64.mask (nominal.representation Point @))) + (i64.left_shifted (n.- (nominal.representation Point @) i64.width)) .rev)) (with_template [<composite_type> <post_processing> <fp> <int>] diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index d581c3a7e..3a45da32d 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -23,7 +23,7 @@ ["i" int]]]]] [/ ["[0]" location] - ["[0]" symbol (.use "[1]#[0]" codec equivalence)] + ["[0]" symbol (.use "[1]#[0]" absolute equivalence)] ["[0]" code]]) ... (.type (Meta a) @@ -79,11 +79,15 @@ {try.#Failure msg}))))) (def .public (result' lux action) - (All (_ a) (-> Lux (Meta a) (Try [Lux a]))) + (All (_ of) + (-> Lux (Meta of) + (Try [Lux of]))) (action lux)) (def .public (result lux action) - (All (_ a) (-> Lux (Meta a) (Try a))) + (All (_ of) + (-> Lux (Meta of) + (Try of))) (when (action lux) {try.#Success [_ output]} {try.#Success output} @@ -92,7 +96,9 @@ {try.#Failure error})) (def .public (either left right) - (All (_ a) (-> (Meta a) (Meta a) (Meta a))) + (All (_ of) + (-> (Meta of) (Meta of) + (Meta of))) (function (_ lux) (when (left lux) {try.#Success [lux' output]} @@ -102,20 +108,23 @@ (right lux)))) (def .public (assertion message test) - (-> Text Bit (Meta Any)) + (-> Text Bit + (Meta Any)) (function (_ lux) (if test {try.#Success [lux []]} {try.#Failure message}))) (def .public (failure error) - (All (_ a) - (-> Text (Meta a))) + (All (_ of) + (-> Text + (Meta of))) (function (_ state) {try.#Failure (location.with (the .#location state) error)})) (def .public (module name) - (-> Text (Meta Module)) + (-> Text + (Meta Module)) (function (_ lux) (when (property.value name (the .#modules lux)) {.#Some module} @@ -142,7 +151,8 @@ /#conjoint))) (def (macro_type? type) - (-> Type Bit) + (-> Type + Bit) (when type {.#Named [.prelude "Macro"] {.#Nominal "#Macro" {.#End}}} @@ -152,7 +162,8 @@ false)) (def .public (normal name) - (-> Symbol (Meta Symbol)) + (-> Symbol + (Meta Symbol)) (when name ["" name] (do ..monad @@ -163,7 +174,8 @@ (of ..monad in name))) (def .public (macro full_name) - (-> Symbol (Meta (Maybe Macro))) + (-> Symbol + (Meta (Maybe Macro))) (do ..monad [[module name] (..normal full_name)] (is (Meta (Maybe Macro)) @@ -203,7 +215,8 @@ (the .#seed lux)]})) (def .public (module_exists? module) - (-> Text (Meta Bit)) + (-> Text + (Meta Bit)) (function (_ lux) {try.#Success [lux (when (property.value module (the .#modules lux)) {.#Some _} @@ -213,14 +226,19 @@ false)]})) (def (on_either f x1 x2) - (All (_ a b) - (-> (-> a (Maybe b)) a a (Maybe b))) + (All (_ input output) + (-> (-> input (Maybe output)) input input + (Maybe output))) (when (f x1) - {.#None} (f x2) - {.#Some y} {.#Some y})) + {.#None} + (f x2) + + some + some)) (def (type_variable idx bindings) - (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) + (-> Nat (List [Nat (Maybe Type)]) + (Maybe Type)) (when bindings {.#End} {.#None} @@ -231,7 +249,8 @@ (type_variable idx bindings')))) (`` (def (clean_type type) - (-> Type (Meta Type)) + (-> Type + (Meta Type)) (when type {.#Var var} (function (_ lux) @@ -253,7 +272,8 @@ (of ..monad in type)))) (def .public (var_type name) - (-> Text (Meta Type)) + (-> Text + (Meta Type)) (function (_ lux) (let [test (is (-> [Text [Type Any]] Bit) (|>> product.left (text#= name)))] @@ -277,7 +297,8 @@ {try.#Failure (all text#composite "Unknown variable: " name)})))) (def without_lux_runtime - (-> (List Text) (List Text)) + (-> (List Text) + (List Text)) ... The Lux runtime shows up as "" ... so I'm excluding it. (list.only (|>> text.empty? not))) @@ -287,14 +308,16 @@ (all text#composite text.new_line " ")) (def module_listing - (-> (List Text) Text) + (-> (List Text) + Text) (|>> ..without_lux_runtime (list.sorted text#<) (text.interposed ..listing_separator))) (with_template [<name> <yes>] [(def .public (<name> name) - (-> Symbol (Meta [Bit Global])) + (-> Symbol + (Meta [Bit Global])) (do ..monad [name (..normal name) .let [[normal_module normal_short] name]] @@ -360,7 +383,8 @@ ) (def .public (export name) - (-> Symbol (Meta Definition)) + (-> Symbol + (Meta Definition)) (do [! ..monad] [name (..normal name) .let [[expected _] name] @@ -385,7 +409,8 @@ (symbol#encoded name)))))) (def .public (default name) - (-> Symbol (Meta Default)) + (-> Symbol + (Meta Default)) (do [! ..monad] [name (..normal name) [exported? definition] (..default' name)] @@ -439,7 +464,8 @@ ) (def .public (definition_type name) - (-> Symbol (Meta Type)) + (-> Symbol + (Meta Type)) (do ..monad [[exported? definition] (definition name)] (when definition @@ -455,7 +481,8 @@ (symbol#encoded name)))))) (def .public (type name) - (-> Symbol (Meta Type)) + (-> Symbol + (Meta Type)) (when name ["" _name] (either (var_type _name) @@ -465,7 +492,8 @@ (definition_type name))) (def .public (type_definition name) - (-> Symbol (Meta Type)) + (-> Symbol + (Meta Type)) (do ..monad [[exported? definition] (definition name)] (when definition @@ -485,7 +513,8 @@ (..failure (all text#composite "Default is not a type: " (symbol#encoded name)))))) (def .public (globals module) - (-> Text (Meta (List [Text [Bit Global]]))) + (-> Text + (Meta (List [Text [Bit Global]]))) (function (_ lux) (when (property.value module (the .#modules lux)) {.#Some module} @@ -495,7 +524,8 @@ {try.#Failure (all text#composite "Unknown module: " module)}))) (def .public (definitions module) - (-> Text (Meta (List [Text [Bit Definition]]))) + (-> Text + (Meta (List [Text [Bit Definition]]))) (of ..monad each (list.all (function (_ [name [exported? global]]) (when global @@ -510,7 +540,8 @@ (..globals module))) (def .public (resolved_globals module) - (-> Text (Meta (List [Text [Bit Definition]]))) + (-> Text + (Meta (List [Text [Bit Definition]]))) (do [! ..monad] [it (..globals module) .let [input (is (List [Text Bit (Either Symbol Definition)]) @@ -563,7 +594,8 @@ {try.#Failure error}))))))) (def .public (exports module_name) - (-> Text (Meta (List [Text Definition]))) + (-> Text + (Meta (List [Text Definition]))) (do ..monad [constants (..definitions module_name)] (in (do list.monad @@ -587,7 +619,8 @@ (`` (.in_module# (,, (static .prelude)) .type#encoded))) (def .public (tags_of type_name) - (-> Symbol (Meta (Maybe (List Symbol)))) + (-> Symbol + (Meta (Maybe (List Symbol)))) (do ..monad [.let [[module_name name] type_name] module (..module module_name)] @@ -631,26 +664,30 @@ {try.#Failure "Not expecting any type."}))) (def .public (imported_modules module_name) - (-> Text (Meta (List Text))) + (-> Text + (Meta (List Text))) (do ..monad [(open "_[0]") (..module module_name)] (in _#imports))) (def .public (imported_by? import module) - (-> Text Text (Meta Bit)) + (-> Text Text + (Meta Bit)) (do ..monad [(open "_[0]") (..module module)] (in (list.any? (text#= import) _#imports)))) (def .public (imported? import) - (-> Text (Meta Bit)) + (-> Text + (Meta Bit)) (of ..functor each (|>> (the .#imports) (list.any? (text#= import))) ..current_module)) (with_template [<name> <description> <type>] [(def .public (<name> label_name) - (-> Symbol (Meta Label)) + (-> Symbol + (Meta Label)) (do ..monad [.let [[module name] label_name] =module (..module module) @@ -673,7 +710,8 @@ ) (def .public (tag_lists module) - (-> Text (Meta (List [(List Symbol) Type]))) + (-> Text + (Meta (List [(List Symbol) Type]))) (do ..monad [=module (..module module) this_module_name ..current_module_name] @@ -719,7 +757,8 @@ {try.#Failure "No local environment"}))) (def .public (de_aliased def_name) - (-> Symbol (Meta Symbol)) + (-> Symbol + (Meta Symbol)) (do ..monad [[exported? constant] (..definition def_name)] (in (when constant @@ -744,7 +783,8 @@ (..failure error))) (def .public (eval type code) - (-> Type Code (Meta Any)) + (-> Type Code + (Meta Any)) (do [! ..monad] [eval (of ! each (the .#eval) ..compiler_state)] diff --git a/stdlib/source/library/lux/meta/code.lux b/stdlib/source/library/lux/meta/code.lux index 480ea56c9..9065e8232 100644 --- a/stdlib/source/library/lux/meta/code.lux +++ b/stdlib/source/library/lux/meta/code.lux @@ -101,7 +101,7 @@ [.#Int int.decimal] [.#Rev rev.decimal] [.#Frac frac.decimal] - [.#Symbol symbol.codec])) + [.#Symbol symbol.absolute])) [_ {.#Text value}] (text.format value) 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 d71d0b0c6..acb4a676e 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 @@ -1,10 +1,10 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + (.require [library [lux (.except Tag Analysis) [abstract -... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. -... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. - ["[0]" monad (.only do)]] [control ["[0]" maybe] 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 2fffba00c..1a8b75275 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 @@ -16,7 +16,7 @@ ["[0]" binary] ["[0]" product] ["[0]" text - ["%" \\format (.only format)]] + ["%" \\format]] [collection ["[0]" dictionary] ["[0]" array] @@ -192,11 +192,12 @@ (in [])))] (in []))) -(def (announce_definition! short type) +(def (announce_definition! module short type) (All (_ anchor expression declaration) - (-> Text Type (Operation anchor expression declaration Any))) + (-> Text Text Type + (Operation anchor expression declaration Any))) (/////declaration.of_translation - (/////translation.log! (format short " : " (%.type type))))) + (/////translation.log! (%.format short " : " (type.relative_format module type))))) (def lux::def Handler @@ -233,7 +234,7 @@ [_ _ exported?] (evaluate! archive Bit exported?C) _ (/////declaration.of_analysis (moduleA.define short_name [(as Bit exported?) {.#Definition [type value]}])) - _ (..announce_definition! short_name type)] + _ (..announce_definition! current_module short_name type)] (in /////declaration.no_requirements))))])) (def imports diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux index 4ddfd3fd4..15a4a8057 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm.lux @@ -29,7 +29,7 @@ ["[0]" / [runtime (.only Operation Phase Handler)] ["[1][0]" primitive] - ["[1][0]" structure] + ["[1][0]" complex] ["[1][0]" reference] ["[1][0]" function] ["[1][0]" when] @@ -73,11 +73,11 @@ (synthesis.variant @ variantS) (with_source_mapping @ - (/structure.variant phase archive variantS)) + (/complex.variant phase archive variantS)) (synthesis.tuple @ members) (with_source_mapping @ - (/structure.tuple phase archive members)) + (/complex.tuple phase archive members)) [@ {synthesis.#Reference reference}] (with_source_mapping @ diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux index b06724932..a449ffa45 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/structure.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/complex.lux @@ -32,34 +32,9 @@ [analysis [complex (.only Variant Tuple)]]]]) -(def .public (tuple phase archive membersS) - (Translator (Tuple Synthesis)) - (when membersS - {.#End} - (of phase.monad in //runtime.unit) - - {.#Item singletonS {.#End}} - (phase archive singletonS) - - _ - (do [! phase.monad] - [membersI (|> membersS - list.enumeration - (monad.each ! (function (_ [idx member]) - (do ! - [memberI (phase archive member)] - (in (do _.monad - [_ _.dup - _ (_.int (.i64 idx)) - _ memberI] - _.aastore))))))] - (in (do [! _.monad] - [_ (_.int (.i64 (list.size membersS))) - _ (_.anewarray //type.value)] - (monad.all ! membersI)))))) - (def .public (lefts lefts) - (-> Nat (Bytecode Any)) + (-> Nat + (Bytecode Any)) (when lefts 0 _.iconst_0 1 _.iconst_1 @@ -80,7 +55,8 @@ (_.int (.i64 lefts)))))) (def .public (right? right?) - (-> Bit (Bytecode Any)) + (-> Bit + (Bytecode Any)) (if right? //runtime.right_right? //runtime.left_right?)) @@ -98,3 +74,29 @@ (list //type.lefts //type.right? //type.value) //type.variant (list)])))))) + +(def .public (tuple phase archive membersS) + (Translator (Tuple Synthesis)) + (when membersS + {.#End} + (of phase.monad in //runtime.unit) + + {.#Item singletonS {.#End}} + (phase archive singletonS) + + _ + (do [! phase.monad] + [membersI (|> membersS + list.enumeration + (monad.each ! (function (_ [idx member]) + (do ! + [memberI (phase archive member)] + (in (do _.monad + [_ _.dup + _ (_.int (.i64 idx)) + _ memberI] + _.aastore))))))] + (in (do [! _.monad] + [_ (_.int (.i64 (list.size membersS))) + _ (_.anewarray //type.value)] + (monad.all ! membersI)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux index 86ffa8239..fdcf78041 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/primitive.lux @@ -137,10 +137,12 @@ ..double_bits (i.= ..d0_bits)) _.dconst_0 - (_.double (as java/lang/Double value)))] + (_.double value))] (do _.monad [_ constantI] ..wrap_f64)))) (def .public text + (-> Text + (Bytecode Any)) _.string) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux index c2d2536b4..558353ad8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/when.lux @@ -33,7 +33,7 @@ ["[1][0]" type] ["[1][0]" runtime (.only Operation Phase Translator)] ["[1][0]" value] - ["[1][0]" structure] + ["[1][0]" complex] [//// ["[0]" phase (.use "operation#[0]" monad)] ["[0]" translation] @@ -195,8 +195,8 @@ (all _.composite ..peek (_.checkcast //type.variant) - (//structure.lefts lefts) - (//structure.right? right?) + (//complex.lefts lefts) + (//complex.right? right?) //runtime.when _.dup (_.ifnonnull @success) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux index 355b45be8..389716606 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/python.lux @@ -11,8 +11,9 @@ [meta [macro ["^" pattern]] - [target - ["_" python]]]]] + [compiler + [target + ["_" python]]]]]] ["[0]" / [runtime (.only Phase)] ["[1][0]" primitive] diff --git a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux index 20d7be577..abaf5e2c9 100644 --- a/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/meta/compiler/target/jvm/bytecode.lux @@ -631,7 +631,10 @@ (as Int))) (def negative_zero_float_bits - (|> -0.0 (as java/lang/Double) ffi.double_to_float ..float_bits)) + (|> -0.0 + (as java/lang/Double) + ffi.double_to_float + ..float_bits)) (def .public (float value) (-> java/lang/Float (Bytecode Any)) @@ -666,21 +669,22 @@ ) (def (arbitrary_double value) - (-> java/lang/Double (Bytecode Any)) + (-> Frac (Bytecode Any)) (do ..monad - [index (..lifted (//constant/pool.double (//constant.double (as Frac value))))] + [index (..lifted (//constant/pool.double (//constant.double value)))] (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) (def double_bits - (-> java/lang/Double Int) - (|>> java/lang/Double::doubleToRawLongBits + (-> Frac Int) + (|>> (as java/lang/Double) + java/lang/Double::doubleToRawLongBits (as Int))) (def negative_zero_double_bits - (..double_bits (as java/lang/Double -0.0))) + (..double_bits -0.0)) (def .public (double value) - (-> java/lang/Double (Bytecode Any)) + (-> Frac (Bytecode Any)) (if (i.= ..negative_zero_double_bits (..double_bits value)) (..arbitrary_double value) diff --git a/stdlib/source/library/lux/meta/macro.lux b/stdlib/source/library/lux/meta/macro.lux index ee01882f1..4cf514b07 100644 --- a/stdlib/source/library/lux/meta/macro.lux +++ b/stdlib/source/library/lux/meta/macro.lux @@ -17,7 +17,7 @@ ["[1][0]" expansion]] ["[0]" // (.only) ["[0]" code] - ["[0]" symbol (.use "[1]#[0]" codec)]]) + ["[0]" symbol (.use "[1]#[0]" absolute)]]) (def .public (symbol prefix) (-> Text (Meta Code)) diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux index 1afd92690..2ed4963c1 100644 --- a/stdlib/source/library/lux/meta/macro/context.lux +++ b/stdlib/source/library/lux/meta/macro/context.lux @@ -20,7 +20,7 @@ ["[0]" property]]]] ["[0]" meta (.only) [type (.only sharing by_example)] - ["[0]" symbol (.use "[1]#[0]" codec)] + ["[0]" symbol (.use "[1]#[0]" absolute)] ["[0]" code (.only) ["?[1]" \\parser]]]]] ["[0]" // (.only) diff --git a/stdlib/source/library/lux/meta/macro/expansion.lux b/stdlib/source/library/lux/meta/macro/expansion.lux index d7171c0e3..936234ed1 100644 --- a/stdlib/source/library/lux/meta/macro/expansion.lux +++ b/stdlib/source/library/lux/meta/macro/expansion.lux @@ -13,7 +13,7 @@ ["[0]" /// (.only) ["[0]" code] ["[0]" location] - ["[0]" symbol (.use "[1]#[0]" codec)]]) + ["[0]" symbol (.use "[1]#[0]" absolute)]]) (def wrong_syntax_error (-> Symbol Text) diff --git a/stdlib/source/library/lux/meta/macro/vocabulary.lux b/stdlib/source/library/lux/meta/macro/vocabulary.lux index 2d236372c..48ae4bff6 100644 --- a/stdlib/source/library/lux/meta/macro/vocabulary.lux +++ b/stdlib/source/library/lux/meta/macro/vocabulary.lux @@ -23,8 +23,8 @@ (exception.def .public (invalid_type [expected actual]) (Exception [Type Type]) (exception.report - (list ["Expected" (type.format expected)] - ["Actual" (type.format actual)]))) + (list ["Expected" (type.absolute_format expected)] + ["Actual" (type.absolute_format actual)]))) (.def local (Parser [Code Code]) diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index 3e8fbf768..b6436066c 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -46,7 +46,7 @@ (def .public separator ".") -(def .public codec +(def .public absolute (Codec Text Symbol) (implementation (def (encoded [module short]) @@ -68,7 +68,7 @@ _ {.#Left (text#composite "Invalid format for Symbol: " input)})))) -(def .public (relative_codec expected) +(def .public (relative expected) (-> Text (Codec Text Symbol)) (implementation diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index afe41bec4..7952b99d8 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -6,7 +6,8 @@ [lux (.except function as let) [abstract [equivalence (.only Equivalence)] - [monad (.only Monad do)]] + [monad (.only Monad do)] + [codec (.only Codec)]] [control ["<>" parser] ["[0]" function] @@ -22,7 +23,7 @@ ["n" nat (.use "[1]#[0]" decimal)]]] ["[0]" meta (.only) ["[0]" location] - ["[0]" symbol (.use "[1]#[0]" equivalence codec)] + ["[0]" symbol (.use "[1]#[0]" equivalence)] ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only) @@ -33,7 +34,8 @@ (with_template [<name> <tag>] [(def .public (<name> type) - (-> Type [Nat Type]) + (-> Type + [Nat Type]) (loop (again [num_args 0 type type]) (when type @@ -48,7 +50,8 @@ ) (def .public (flat_function type) - (-> Type [(List Type) Type]) + (-> Type + [(List Type) Type]) (when type {.#Function in out'} (.let [[ins out] (flat_function out')] @@ -58,7 +61,8 @@ [(list) type])) (def .public (flat_application type) - (-> Type [Type (List Type)]) + (-> Type + [Type (List Type)]) (when type {.#Apply arg func'} (.let [[func args] (flat_application func')] @@ -69,7 +73,8 @@ (with_template [<name> <tag>] [(def .public (<name> type) - (-> Type (List Type)) + (-> Type + (List Type)) (when type {<tag> left right} (list.partial left (<name> right)) @@ -81,15 +86,16 @@ [flat_tuple .#Product] ) -(`` (def .public (format type) - (-> Type Text) +(`` (def (format symbol_codec type) + (-> (Codec Text Symbol) Type + Text) (when type {.#Nominal name params} (all text#composite "(Nominal " (text.enclosed' text.double_quote name) (|> params - (list#each (|>> format (text#composite " "))) + (list#each (|>> (format symbol_codec) (text#composite " "))) (list#mix (function.flipped text#composite) "")) ")") @@ -97,7 +103,7 @@ [{<tag> _} (all text#composite <open> (|> (<flat> type) - (list#each format) + (list#each (format symbol_codec)) list.reversed (list.interposed " ") (list#mix text#composite "")) @@ -110,11 +116,11 @@ (.let [[ins out] (flat_function type)] (all text#composite "(-> " (|> ins - (list#each format) + (list#each (format symbol_codec)) list.reversed (list.interposed " ") (list#mix text#composite "")) - " " (format out) ")")) + " " (format symbol_codec out) ")")) {.#Parameter idx} (n#encoded idx) @@ -127,22 +133,33 @@ {.#Apply param fun} (.let [[type_func type_args] (flat_application type)] - (all text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")")) + (all text#composite "(" (format symbol_codec type_func) " " (|> type_args (list#each (format symbol_codec)) list.reversed (list.interposed " ") (list#mix text#composite "")) ")")) (,, (with_template [<tag> <desc>] [{<tag> env body} - (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")] + (all text#composite "(" <desc> " {" (|> env (list#each (format symbol_codec)) (text.interposed " ")) "} " (format symbol_codec body) ")")] [.#UnivQ "All"] [.#ExQ "Ex"])) {.#Named name type} - (symbol#encoded name) + (of symbol_codec encoded name) ))) +(def .public absolute_format + (-> Type + Text) + (..format symbol.absolute)) + +(def .public (relative_format module) + (-> Text Type + Text) + (..format (symbol.relative module))) + ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction (`` (def (reduced env type) - (-> (List Type) Type Type) + (-> (List Type) Type + Type) (when type {.#Nominal name params} {.#Nominal name (list#each (reduced env) params)} @@ -175,7 +192,7 @@ (list#each (.function (_ [index type]) (all text#composite (n#encoded index) - " " (..format type)))) + " " (..absolute_format type)))) (text.interposed (text#composite text.new_line " "))))) (list.item idx env)) @@ -240,7 +257,8 @@ )))))) (`` (def .public (applied params func) - (-> (List Type) Type (Maybe Type)) + (-> (List Type) Type + (Maybe Type)) (when params {.#End} {.#Some func} @@ -266,7 +284,8 @@ {.#None})))) (`` (def .public (code type) - (-> Type Code) + (-> Type + Code) (when type {.#Nominal name params} (` {.#Nominal (, (code.text name)) @@ -303,7 +322,8 @@ ))) (def .public (de_aliased type) - (-> Type Type) + (-> Type + Type) (when type {.#Named _ {.#Named name type'}} (de_aliased {.#Named name type'}) @@ -312,7 +332,8 @@ type)) (def .public (anonymous type) - (-> Type Type) + (-> Type + Type) (when type {.#Named name type'} (anonymous type') @@ -322,7 +343,8 @@ (with_template [<name> <base> <ctor>] [(def .public (<name> types) - (-> (List Type) Type) + (-> (List Type) + Type) (when types {.#End} <base> @@ -338,7 +360,8 @@ ) (def .public (function inputs output) - (-> (List Type) Type Type) + (-> (List Type) Type + Type) (when inputs {.#End} output @@ -347,7 +370,8 @@ {.#Function input (function inputs' output)})) (def .public (application params quant) - (-> (List Type) Type Type) + (-> (List Type) Type + Type) (when params {.#End} quant @@ -357,7 +381,8 @@ (with_template [<name> <tag>] [(def .public (<name> size body) - (-> Nat Type Type) + (-> Nat Type + Type) (when size 0 body _ (|> body (<name> (-- size)) {<tag> (list)})))] @@ -367,7 +392,8 @@ ) (`` (def .public (quantified? type) - (-> Type Bit) + (-> Type + Bit) (when type {.#Named [module name] _type} (quantified? _type) @@ -388,7 +414,8 @@ false))) (def .public (array depth element_type) - (-> Nat Type Type) + (-> Nat Type + Type) (when depth 0 element_type _ (|> element_type @@ -397,7 +424,8 @@ {.#Nominal array.nominal}))) (def .public (flat_array type) - (-> Type [Nat Type]) + (-> Type + [Nat Type]) (with_expansions [<default> [0 type]] (when type {.#Nominal name (list element_type)} @@ -410,7 +438,8 @@ <default>))) (def .public array? - (-> Type Bit) + (-> Type + Bit) (|>> ..flat_array product.left (n.> 0))) @@ -432,16 +461,17 @@ (do meta.monad [location meta.location valueT (meta.type valueN) - .let [_ (.log!# (all text#composite - (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line + .let [[@ _ _] location + _ (.log!# (all text#composite + (of symbol.absolute encoded (symbol ..log!)) " " (location.format location) text.new_line "Expression: " (when valueC {.#Some valueC} (code.format valueC) {.#None} - (symbol#encoded valueN)) + (of symbol.absolute encoded valueN)) text.new_line - " Type: " (..format valueT)))]] + " Type: " (..relative_format @ valueT)))]] (in (list (code.symbol valueN)))) {.#Right valueC} @@ -475,7 +505,8 @@ #expression Code])) (def (typed lux) - (-> Lux (Parser Typed)) + (-> Lux + (Parser Typed)) (do <>.monad [it <code>.any type_check (<>.of_try (meta.result lux (expansion.complete it)))] @@ -510,7 +541,8 @@ (.as .Nothing []))))))))) (`` (def .public (replaced before after) - (-> Type Type Type Type) + (-> Type Type Type + Type) (.function (again it) (if (of ..equivalence = before it) after diff --git a/stdlib/source/library/lux/meta/type/check.lux b/stdlib/source/library/lux/meta/type/check.lux index 72dc101b3..62242e421 100644 --- a/stdlib/source/library/lux/meta/type/check.lux +++ b/stdlib/source/library/lux/meta/type/check.lux @@ -49,21 +49,21 @@ (exception.def .public (invalid_type_application [funcT argT]) (Exception [Type Type]) (exception.report - (list ["Type function" (//.format funcT)] - ["Type argument" (//.format argT)]))) + (list ["Type function" (//.absolute_format funcT)] + ["Type argument" (//.absolute_format argT)]))) (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)]))) + ["Wanted type" (//.absolute_format type)] + ["Current type" (//.absolute_format bound)]))) (exception.def .public (type_check_failed [expected actual]) (Exception [Type Type]) (exception.report - (list ["Expected" (//.format expected)] - ["Actual" (//.format actual)]))) + (list ["Expected" (//.absolute_format expected)] + ["Actual" (//.absolute_format actual)]))) (type .public Var Nat) diff --git a/stdlib/source/library/lux/meta/type/nominal.lux b/stdlib/source/library/lux/meta/type/nominal.lux index a9ddf084d..73e776829 100644 --- a/stdlib/source/library/lux/meta/type/nominal.lux +++ b/stdlib/source/library/lux/meta/type/nominal.lux @@ -14,7 +14,7 @@ [collection ["[0]" list (.use "[1]#[0]" functor)]]] [meta - ["[0]" symbol (.use "[1]#[0]" codec)] + ["[0]" symbol (.use "[1]#[0]" absolute)] ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only) |