diff options
Diffstat (limited to 'stdlib/source/library')
19 files changed, 128 insertions, 164 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index c488444dd..862c84fff 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -4339,45 +4339,6 @@ {#None} (failure "Wrong syntax for loop")))) -(macro: .public (^slots tokens) - (case tokens - (^ (list& [_ {#Form (list [_ {#Tuple (list& hslot' tslots')}])}] body branches)) - (do meta_monad - [slots (: (Meta [Symbol (List Symbol)]) - (case (: (Maybe [Symbol (List Symbol)]) - (do maybe_monad - [hslot (..identifier_name hslot') - tslots (monad#each maybe_monad ..identifier_name tslots')] - (in [hslot tslots]))) - {#Some slots} - (in_meta slots) - - {#None} - (failure "Wrong syntax for ^slots"))) - .let [[hslot tslots] slots] - hslot (..normal hslot) - tslots (monad#each meta_monad ..normal tslots) - output (..type_slot hslot) - g!_ (..identifier "_") - .let [[idx tags exported? type] output - slot_pairings (list#each (: (-> Symbol [Text Code]) - (function (_ [module name]) - [name (local_identifier$ name)])) - (list& hslot tslots)) - pattern (|> tags - (list#each (: (-> Symbol (List Code)) - (function (_ [module name]) - (let [tag (identifier$ [module name])] - (case (plist#value name slot_pairings) - {#Some binding} (list tag binding) - {#None} (list tag g!_)))))) - list#conjoint - tuple$)]] - (in_meta (list& pattern body branches))) - - _ - (failure "Wrong syntax for ^slots"))) - (def: (with_expansions' label tokens target) (-> Text (List Code) Code (List Code)) (case target diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 5b2291bba..493c36d80 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -111,11 +111,11 @@ (in (list)) {.#Item definition {.#End}} - (.let [(^slots [#export_policy #mutual]) definition - (^slots [#declaration #type #body]) #mutual] - (in (list (` (.def: (~ #export_policy) (~ (declaration.format #declaration)) - (~ #type) - (~ #body)))))) + (.let [(^open "_[0]") definition + (^open "_[0]") _#mutual] + (in (list (` (.def: (~ _#export_policy) (~ (declaration.format _#declaration)) + (~ _#type) + (~ _#body)))))) _ (macro.with_identifiers [g!context g!output] diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index 5260d808d..650ed17ff 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -28,8 +28,8 @@ (def: .public (list queue) (All (_ a) (-> (Queue a) (List a))) - (let [(^slots [#front #rear]) queue] - (list#composite #front (list.reversed #rear)))) + (let [(^open "_[0]") queue] + (list#composite _#front (list.reversed _#rear)))) (def: .public front (All (_ a) (-> (Queue a) (Maybe a))) @@ -37,9 +37,9 @@ (def: .public (size queue) (All (_ a) (-> (Queue a) Nat)) - (let [(^slots [#front #rear]) queue] - (n.+ (list.size #front) - (list.size #rear)))) + (let [(^open "_[0]") queue] + (n.+ (list.size _#front) + (list.size _#rear)))) (def: .public empty? (All (_ a) (-> (Queue a) Bit)) @@ -47,9 +47,9 @@ (def: .public (member? equivalence queue member) (All (_ a) (-> (Equivalence a) (Queue a) a Bit)) - (let [(^slots [#front #rear]) queue] - (or (list.member? equivalence #front member) - (list.member? equivalence #rear member)))) + (let [(^open "_[0]") queue] + (or (list.member? equivalence _#front member) + (list.member? equivalence _#rear member)))) (def: .public (next queue) (All (_ a) (-> (Queue a) (Queue a))) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index 2fb288b99..c1b3b6ece 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -491,9 +491,9 @@ {#Hierarchy hierarchy} (<array> (help predicate) hierarchy))))] (function (<name> predicate row) - (let [(^slots [#root #tail]) row] - (<op> (help predicate {#Hierarchy #root}) - (help predicate {#Base #tail}))))))] + (let [(^open "_[0]") row] + (<op> (help predicate {#Hierarchy _#root}) + (help predicate {#Base _#tail}))))))] [every? array.every? #1 and] [any? array.any? #0 or] diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 8bf58d308..19581bb40 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -102,19 +102,19 @@ (All (_ a) (-> (Zipper a) (Maybe (Zipper a)))) (do maybe.monad [family (value@ #family zipper)] - (in (let [(^slots [#parent #lefts #rights]) family] + (in (let [(^open "_[0]") family] (for [@.old (revised@ #node (: (-> (Tree (:parameter 0)) (Tree (:parameter 0))) - (with@ //.#children (list#composite (list.reversed #lefts) + (with@ //.#children (list#composite (list.reversed _#lefts) {.#Item (value@ #node zipper) - #rights}))) - #parent)] + _#rights}))) + _#parent)] (with@ [#node //.#children] - (list#composite (list.reversed #lefts) + (list#composite (list.reversed _#lefts) {.#Item (value@ #node zipper) - #rights}) - #parent)))))) + _#rights}) + _#parent)))))) (template [<one> <all> <side> <op_side>] [(def: .public (<one> zipper) @@ -292,13 +292,13 @@ (implementation: .public functor (Functor Zipper) - (def: (each f (^slots [#family #node])) - [#family (maybe#each (function (_ (^slots [#parent #lefts #rights])) - [#parent (each f #parent) - #lefts (list#each (//#each f) #lefts) - #rights (list#each (//#each f) #rights)]) - #family) - #node (//#each f #node)])) + (def: (each f (^open "_[0]")) + [#family (maybe#each (function (_ (^open "_[0]")) + [#parent (each f _#parent) + #lefts (list#each (//#each f) _#lefts) + #rights (list#each (//#each f) _#rights)]) + _#family) + #node (//#each f _#node)])) (implementation: .public comonad (CoMonad Zipper) @@ -309,16 +309,16 @@ (def: out (value@ [#node //.#value])) - (def: (disjoint (^slots [#family #node])) + (def: (disjoint (^open "_[0]")) (let [tree_splitter (: (All (_ a) (-> (Tree a) (Tree (Zipper a)))) (function (tree_splitter tree) [//.#value (..zipper tree) //.#children (|> tree (value@ //.#children) (list#each tree_splitter))]))] - [#family (maybe#each (function (_ (^slots [#parent #lefts #rights])) - [..#parent (disjoint #parent) - ..#lefts (list#each tree_splitter #lefts) - ..#rights (list#each tree_splitter #rights)]) - #family) - #node (tree_splitter #node)]))) + [#family (maybe#each (function (_ (^open "_[0]")) + [..#parent (disjoint _#parent) + ..#lefts (list#each tree_splitter _#lefts) + ..#rights (list#each tree_splitter _#rights)]) + _#family) + #node (tree_splitter _#node)]))) diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux index 3cb2f5777..9a761f86f 100644 --- a/stdlib/source/library/lux/data/format/css/selector.lux +++ b/stdlib/source/library/lux/data/format/css/selector.lux @@ -183,11 +183,11 @@ (def: .public (formula input) (-> Formula Index) - (let [(^slots [#constant #variable]) input] - (:abstraction (format (if (i.< +0 variable) - (%.int variable) - (%.nat (.nat variable))) - (%.int constant))))) + (let [(^open "_[0]") input] + (:abstraction (format (if (i.< +0 _#variable) + (%.int _#variable) + (%.nat (.nat _#variable))) + (%.int _#constant))))) (template [<name> <pseudo>] [(def: .public (<name> index) diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index f2c8bb1c3..b57294ade 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -827,14 +827,14 @@ (def: .public (rgba pigment) (-> color.Pigment (Value Color)) - (let [(^slots [color.#color color.#alpha]) pigment - [red green blue] (color.rgb color)] + (let [(^open "_[0]") pigment + [red green blue] (color.rgb _#color)] (..apply "rgba" (list (%.nat red) (%.nat green) (%.nat blue) - (if (r.= (# r.interval top) alpha) + (if (r.= (# r.interval top) _#alpha) "1.0" - (format "0" (%.rev alpha))))))) + (format "0" (%.rev _#alpha))))))) (template [<name> <suffix>] [(def: .public (<name> value) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index fddde12e9..f739e2ff2 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -1043,7 +1043,7 @@ (def: (method_decl$ [[name pm anns] method_decl]) (-> [Member_Declaration MethodDecl] Code) - (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl] + (let [(^open "[0]") method_decl] (` ((~ (code.text name)) [(~+ (list#each annotation$ anns))] [(~+ (list#each var$ #method_tvars))] @@ -1332,7 +1332,7 @@ (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)])) (case member (^or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) - (let [(^slots [#import_member_tvars #import_member_args]) commons] + (let [(^open "[0]") commons] (do [! meta.monad] [arg_inputs (monad.each ! (: (-> [Bit (Type Value)] (Meta [Bit Code])) @@ -1533,8 +1533,8 @@ (with_identifiers [g!obj] (do meta.monad [.let [def_name (code.identifier ["" (..import_name import_format method_prefix (value@ #import_member_alias commons))]) - (^slots [#import_member_kind]) commons - (^slots [#import_method_name]) method + (^open "[0]") commons + (^open "[0]") method [jvm_op object_ast] (: [Text (List Code)] (case #import_member_kind {#StaticIMK} diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 174e8e8d9..d27658372 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -351,7 +351,7 @@ (-> Type_Parameter Code) (code.identifier ["" name])) -(def: (class_decl_type$ (^slots [#class_name #class_params])) +(def: (class_decl_type$ (^open "[0]")) (-> Class_Declaration Code) (let [=params (list#each (: (-> Type_Parameter Code) (function (_ [pname pbounds]) @@ -1017,7 +1017,7 @@ (-> Class_Declaration JVM_Code) (format "(" (safe #class_name) " " (spaced (list#each type_param$ #class_params)) ")")) -(def: (super_class_decl$ (^slots [#super_class_name #super_class_params])) +(def: (super_class_decl$ (^open "[0]")) (-> Super_Class_Decl JVM_Code) (format "(" (safe #super_class_name) " " (spaced (list#each generic_type$ #super_class_params)) @@ -1025,7 +1025,7 @@ (def: (method_decl$ [[name pm anns] method_decl]) (-> [Member_Declaration MethodDecl] JVM_Code) - (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl] + (let [(^open "[0]") method_decl] (with_parens (spaced (list name (with_brackets (spaced (list#each annotation$ anns))) @@ -1321,7 +1321,7 @@ (-> (List Type_Parameter) Class_Declaration Import_Member_Declaration (Meta [(List [Bit Code]) (List Text) (List Code)])) (case member (^or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]}) - (let [(^slots [#import_member_tvars #import_member_args]) commons] + (let [(^open "[0]") commons] (do [! meta.monad] [arg_inputs (monad.each ! (: (-> [Bit GenericType] (Meta [Bit Code])) @@ -1478,8 +1478,8 @@ (with_identifiers [g!obj] (do meta.monad [.let [def_name (code.identifier ["" (..import_name import_format method_prefix (value@ #import_member_alias commons))]) - (^slots [#import_member_kind]) commons - (^slots [#import_method_name]) method + (^open "[0]") commons + (^open "[0]") method [jvm_op object_ast] (: [Text (List Code)] (case #import_member_kind {#StaticIMK} diff --git a/stdlib/source/library/lux/macro/syntax/check.lux b/stdlib/source/library/lux/macro/syntax/check.lux index a84838a4a..b9f7afe79 100644 --- a/stdlib/source/library/lux/macro/syntax/check.lux +++ b/stdlib/source/library/lux/macro/syntax/check.lux @@ -29,11 +29,11 @@ code.equivalence )) -(def: .public (format (^slots [#type #value])) +(def: .public (format (^open "_[0]")) (-> Check Code) (` ((~ (code.text ..extension)) - (~ #type) - (~ #value)))) + (~ _#type) + (~ _#value)))) (def: .public parser (Parser Check) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index 59b946503..d9d83ebd4 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -50,17 +50,17 @@ .#line (~ (code.nat (value@ .#line location.dummy))) .#column (~ (code.nat (value@ .#column location.dummy)))])) -(def: .public (format (^slots [#name #value #export?])) +(def: .public (format (^open "_[0]")) (-> Definition Code) (` ((~ (code.text ..extension)) - (~ (code.local_identifier #name)) - (~ (case #value + (~ (code.local_identifier _#name)) + (~ (case _#value {.#Left check} (//check.format check) {.#Right value} value)) - (~ (code.bit #export?))))) + (~ (code.bit _#export?))))) (def: .public (parser compiler) (-> Lux (Parser Definition)) diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index d0355c4af..b6a67cadd 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -127,17 +127,17 @@ ["Expected" (# nat.decimal encoded expected)] ["Actual" (# nat.decimal encoded actual)])) -(def: (macro (^slots [#parameters #template])) +(def: (macro (^open "_[0]")) (-> Local Macro) ("lux macro" (function (_ inputs compiler) - (.let [parameters_amount (list.size #parameters) + (.let [parameters_amount (list.size _#parameters) inputs_amount (list.size inputs)] (if (nat.= parameters_amount inputs_amount) (.let [environment (: Environment - (|> (list.zipped/2 #parameters inputs) + (|> (list.zipped/2 _#parameters inputs) (dictionary.of_list text.hash)))] - {.#Right [compiler (list#each (..applied environment) #template)]}) + {.#Right [compiler (list#each (..applied environment) _#template)]}) (exception.except ..irregular_arguments [parameters_amount inputs_amount])))))) (def: local diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 1473ec0c0..7a64584b3 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -111,7 +111,7 @@ (def: .public (/ param input) (-> Complex Complex Complex) - (let [(^slots [#real #imaginary]) param] + (let [(^open "[0]") param] (if (f.< (f.abs #imaginary) (f.abs #real)) (let [quot (f./ #imaginary #real) @@ -125,7 +125,7 @@ (def: .public (/' param subject) (-> Frac Complex Complex) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] [..#real (f./ param #real) ..#imaginary (f./ param #imaginary)])) @@ -140,7 +140,7 @@ (def: .public (cos subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] [..#real (f.* (math.cosh #imaginary) (math.cos #real)) ..#imaginary (f.opposite (f.* (math.sinh #imaginary) @@ -148,7 +148,7 @@ (def: .public (cosh subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] [..#real (f.* (math.cos #imaginary) (math.cosh #real)) ..#imaginary (f.* (math.sin #imaginary) @@ -156,7 +156,7 @@ (def: .public (sin subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] [..#real (f.* (math.cosh #imaginary) (math.sin #real)) ..#imaginary (f.* (math.sinh #imaginary) @@ -164,7 +164,7 @@ (def: .public (sinh subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] [..#real (f.* (math.cos #imaginary) (math.sinh #real)) ..#imaginary (f.* (math.sin #imaginary) @@ -172,7 +172,7 @@ (def: .public (tan subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject + (let [(^open "[0]") subject r2 (f.* +2.0 #real) i2 (f.* +2.0 #imaginary) d (f.+ (math.cos r2) (math.cosh i2))] @@ -181,7 +181,7 @@ (def: .public (tanh subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject + (let [(^open "[0]") subject r2 (f.* +2.0 #real) i2 (f.* +2.0 #imaginary) d (f.+ (math.cosh r2) (math.cos i2))] @@ -190,7 +190,7 @@ (def: .public (abs subject) (-> Complex Frac) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] (if (f.< (f.abs #imaginary) (f.abs #real)) (if (f.= +0.0 #imaginary) @@ -206,14 +206,14 @@ (def: .public (exp subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject + (let [(^open "[0]") subject r_exp (math.exp #real)] [..#real (f.* r_exp (math.cos #imaginary)) ..#imaginary (f.* r_exp (math.sin #imaginary))])) (def: .public (log subject) (-> Complex Complex) - (let [(^slots [#real #imaginary]) subject] + (let [(^open "[0]") subject] [..#real (|> subject ..abs math.log) ..#imaginary (math.atan/2 #real #imaginary)])) @@ -232,7 +232,7 @@ (def: .public (root/2 input) (-> Complex Complex) - (let [(^slots [#real #imaginary]) input + (let [(^open "[0]") input t (|> input ..abs (f.+ (f.abs #real)) (f./ +2.0) (math.pow +0.5))] (if (f.< +0.0 #real) [..#real (f./ (f.* +2.0 t) @@ -246,7 +246,7 @@ (-> Complex Complex) (|> (complex +1.0) (- (* input input)) ..root/2)) -(def: .public (reciprocal (^slots [#real #imaginary])) +(def: .public (reciprocal (^open "[0]")) (-> Complex Complex) (if (f.< (f.abs #imaginary) (f.abs #real)) @@ -284,7 +284,7 @@ ..log (..* (../ (..complex +2.0) ..i)))) -(def: .public (argument (^slots [#real #imaginary])) +(def: .public (argument (^open "[0]")) (-> Complex Frac) (math.atan/2 #real #imaginary)) diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index 0a31b4e8e..87144de00 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -33,11 +33,11 @@ 1 {.#Some (value@ #numerator value)} _ {.#None})) -(def: (normal (^slots [#numerator #denominator])) +(def: (normal (^open "_[0]")) (-> Ratio Ratio) - (let [common (n.gcd #numerator #denominator)] - [..#numerator (n./ common #numerator) - ..#denominator (n./ common #denominator)])) + (let [common (n.gcd _#numerator _#denominator)] + [..#numerator (n./ common _#numerator) + ..#denominator (n./ common _#denominator)])) (syntax: .public (ratio [numerator <code>.any ?denominator (<>.maybe <code>.any)]) @@ -121,18 +121,20 @@ (..- (revised@ #numerator (n.* quot) parameter) subject))) -(def: .public (reciprocal (^slots [#numerator #denominator])) +(def: .public (reciprocal (^open "_[0]")) (-> Ratio Ratio) - [..#numerator #denominator - ..#denominator #numerator]) + [..#numerator _#denominator + ..#denominator _#numerator]) (def: separator ":") (implementation: .public codec (Codec Text Ratio) - (def: (encoded (^slots [#numerator #denominator])) - ($_ text#composite (n#encoded #numerator) ..separator (n#encoded #denominator))) + (def: (encoded (^open "_[0]")) + ($_ text#composite + (n#encoded _#numerator) + ..separator (n#encoded _#denominator))) (def: (decoded input) (case (text.split_by ..separator input) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index d9c84288d..aa333b9d3 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -300,9 +300,9 @@ (function (_ lux) (case (: (Maybe Global) (do maybe.monad - [(^slots [.#definitions]) (|> lux - (value@ .#modules) - (plist.value normal_module))] + [(^open "[0]") (|> lux + (value@ .#modules) + (plist.value normal_module))] (plist.value normal_short #definitions))) {.#Some definition} {try.#Success [lux definition]} @@ -534,14 +534,14 @@ (def: .public (imported_modules module_name) (-> Text (Meta (List Text))) (do ..monad - [(^slots [.#imports]) (..module module_name)] - (in #imports))) + [(^open "_[0]") (..module module_name)] + (in _#imports))) (def: .public (imported_by? import module) (-> Text Text (Meta Bit)) (do ..monad - [(^slots [.#imports]) (..module module)] - (in (list.any? (text#= import) #imports)))) + [(^open "_[0]") (..module module)] + (in (list.any? (text#= import) _#imports)))) (def: .public (imported? import) (-> Text (Meta Bit)) diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 0eaba81d6..5ceaa5e86 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -199,12 +199,12 @@ (def: (format time) (-> Time Text) - (let [(^slots [#hour #minute #second #milli_second]) (..clock time)] + (let [(^open "_[0]") (..clock time)] ($_ text#composite - (..padded #hour) - ..separator (..padded #minute) - ..separator (..padded #second) - (..millis_format #milli_second)))) + (..padded _#hour) + ..separator (..padded _#minute) + ..separator (..padded _#second) + (..millis_format _#milli_second)))) (implementation: .public codec (Codec Text Time) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index fd5753492..dae79178d 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -89,14 +89,14 @@ (def: .public (id module archive) (-> Module Archive (Try ID)) - (let [(^slots [..#resolver]) (:representation archive)] - (case (dictionary.value module #resolver) + (let [(^open "_[0]") (:representation archive)] + (case (dictionary.value module _#resolver) {.#Some [id _]} {try.#Success id} {.#None} (exception.except ..unknown_document [module - (dictionary.keys #resolver)])))) + (dictionary.keys _#resolver)])))) (def: .public (reserve module archive) (-> Module Archive (Try [ID Archive])) @@ -115,8 +115,8 @@ (def: .public (has module [descriptor document output] archive) (-> Module [Descriptor (Document Any) Output] Archive (Try Archive)) - (let [(^slots [..#resolver]) (:representation archive)] - (case (dictionary.value module #resolver) + (let [(^open "_[0]") (:representation archive)] + (case (dictionary.value module _#resolver) {.#Some [id {.#None}]} {try.#Success (|> archive :representation @@ -134,8 +134,8 @@ (def: .public (find module archive) (-> Module Archive (Try [Descriptor (Document Any) Output])) - (let [(^slots [..#resolver]) (:representation archive)] - (case (dictionary.value module #resolver) + (let [(^open "_[0]") (:representation archive)] + (case (dictionary.value module _#resolver) {.#Some [id {.#Some entry}]} {try.#Success entry} @@ -144,7 +144,7 @@ {.#None} (exception.except ..unknown_document [module - (dictionary.keys #resolver)])))) + (dictionary.keys _#resolver)])))) (def: .public (archived? archive module) (-> Archive Module Bit) @@ -167,8 +167,8 @@ (def: .public (reserved? archive module) (-> Archive Module Bit) - (let [(^slots [..#resolver]) (:representation archive)] - (case (dictionary.value module #resolver) + (let [(^open "_[0]") (:representation archive)] + (case (dictionary.value module _#resolver) {.#Some [id _]} bit.yes @@ -229,14 +229,14 @@ (def: .public (export version archive) (-> Version Archive Binary) - (let [(^slots [..#next ..#resolver]) (:representation archive)] - (|> #resolver + (let [(^open "_[0]") (:representation archive)] + (|> _#resolver dictionary.entries (list.all (function (_ [module [id descriptor+document]]) (case descriptor+document {.#Some _} {.#Some [module id]} {.#None} {.#None}))) - [version #next] + [version _#next] (binary.result ..writer)))) (exception: .public (version_mismatch [expected Version diff --git a/stdlib/source/library/lux/type/refinement.lux b/stdlib/source/library/lux/type/refinement.lux index 52421e0a1..02745abd2 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -43,11 +43,11 @@ (-> (-> t t) (-> (Refined t %) (Maybe (Refined t %))))) (function (_ refined) - (let [(^slots [#value #predicate]) (:representation refined) - value' (transform #value)] - (if (#predicate value') + (let [(^open "_[0]") (:representation refined) + value' (transform _#value)] + (if (_#predicate value') {.#Some (:abstraction [..#value value' - ..#predicate #predicate])} + ..#predicate _#predicate])} {.#None})))) ) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index 605867277..6509f6505 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -121,7 +121,7 @@ <code>.local_identifier ..scaleP))]) (do meta.monad - [.let [(^slots [ratio.#numerator ratio.#denominator]) ratio] + [.let [(^open "_[0]") ratio] @ meta.current_module_name .let [g!scale (code.local_identifier type_name)]] (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u)) @@ -132,16 +132,17 @@ (def: (~' scale) (|>> ((~! ..out')) - (i.* (~ (code.int (.int #numerator)))) - (i./ (~ (code.int (.int #denominator)))) + (i.* (~ (code.int (.int _#numerator)))) + (i./ (~ (code.int (.int _#denominator)))) ((~! ..in')))) (def: (~' de_scale) (|>> ((~! ..out')) - (i.* (~ (code.int (.int #denominator)))) - (i./ (~ (code.int (.int #numerator)))) + (i.* (~ (code.int (.int _#denominator)))) + (i./ (~ (code.int (.int _#numerator)))) ((~! ..in')))) (def: (~' ratio) - [(~ (code.nat #numerator)) (~ (code.nat #denominator))]))) + [(~ (code.nat _#numerator)) + (~ (code.nat _#denominator))]))) )))) (def: .public (re_scaled from to quantity) |