diff options
Diffstat (limited to '')
40 files changed, 714 insertions, 378 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 7ddfa427f..75575ebe4 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3718,13 +3718,6 @@ cases)] output)) -(def: (on_either f x1 x2) - (All (_ a b) - (-> (-> a (Maybe b)) a a (Maybe b))) - (case (f x1) - {#None} (f x2) - {#Some y} {#Some y})) - (def: (in_env name state) (-> Text Lux (Maybe Type)) (case state @@ -3738,14 +3731,13 @@ [..#name _ ..#inner _ ..#locals [..#counter _ ..#mappings locals] - ..#captured [..#counter _ ..#mappings closure]] - (on_either (list#one (: (-> [Text [Type Any]] (Maybe Type)) - (function (_ [bname [type _]]) - (if (text#= name bname) - {#Some type} - {#None})))) - (: (List [Text [Type Any]]) locals) - (: (List [Text [Type Any]]) closure))))) + ..#captured _] + (list#one (: (-> [Text [Type Any]] (Maybe Type)) + (function (_ [bname [type _]]) + (if (text#= name bname) + {#Some type} + {#None}))) + locals)))) scopes))) (def: (definition_type name state) @@ -3839,24 +3831,25 @@ [.let [[module name] full_name] current_module current_module_name] (function (_ compiler) - (let [temp (if (text#= "" module) - (case (in_env name compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + (let [temp (: (Either Text [Lux Type]) + (if (text#= "" module) + (case (in_env name compiler) + {#Some struct_type} + {#Right [compiler struct_type]} - _ - (case (definition_type [current_module name] compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + _ + (case (definition_type [current_module name] compiler) + {#Some struct_type} + {#Right [compiler struct_type]} - _ - {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})) - (case (definition_type full_name compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + _ + {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})) + (case (definition_type full_name compiler) + {#Some struct_type} + {#Right [compiler struct_type]} - _ - {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))] + _ + {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})))] (case temp {#Right [compiler {#Var type_id}]} (let [[..#info _ ..#source _ ..#current_module _ ..#modules _ @@ -4708,30 +4701,6 @@ _ (failure (..wrong_syntax_error [..prelude_module "symbol"])))) -(def: (scope_type_vars state) - (Meta (List Nat)) - (case state - [..#info info ..#source source ..#current_module _ ..#modules modules - ..#scopes scopes ..#type_context types ..#host host - ..#seed seed ..#expected expected ..#location location ..#extensions extensions - ..#scope_type_vars scope_type_vars ..#eval _eval] - {#Right [state scope_type_vars]})) - -(macro: .public (:parameter tokens) - (case tokens - (^ (list [_ {#Nat idx}])) - (do meta_monad - [stvs ..scope_type_vars] - (case (..item idx (list#reversed stvs)) - {#Some var_id} - (in (list (` {.#Ex (~ (nat$ var_id))}))) - - {#None} - (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx))))) - - _ - (failure (..wrong_syntax_error (symbol ..$))))) - (def: .public (same? reference sample) (All (_ a) (-> a a Bit)) @@ -4927,6 +4896,32 @@ _ (failure (..wrong_syntax_error (symbol ..for)))))) +... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and ":parameter" ASAP. +(for ["{old}" (as_is (def: (scope_type_vars state) + (Meta (List Nat)) + (case state + [..#info info ..#source source ..#current_module _ ..#modules modules + ..#scopes scopes ..#type_context types ..#host host + ..#seed seed ..#expected expected ..#location location ..#extensions extensions + ..#scope_type_vars scope_type_vars ..#eval _eval] + {#Right [state scope_type_vars]})) + + (macro: .public (:parameter tokens) + (case tokens + (^ (list [_ {#Nat idx}])) + (do meta_monad + [stvs ..scope_type_vars] + (case (..item idx (list#reversed stvs)) + {#Some var_id} + (in (list (` {.#Ex (~ (nat$ var_id))}))) + + {#None} + (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx))))) + + _ + (failure (..wrong_syntax_error (symbol ..$))))))] + (as_is)) + (macro: .public (using _imports) (do meta_monad [current_module ..current_module_name diff --git a/stdlib/source/library/lux/abstract/enum.lux b/stdlib/source/library/lux/abstract/enum.lux index 45026abc1..f136fc92d 100644 --- a/stdlib/source/library/lux/abstract/enum.lux +++ b/stdlib/source/library/lux/abstract/enum.lux @@ -1,8 +1,8 @@ (.using - [library - [lux "*"]] - [// - ["[0]" order {"+" Order}]]) + [library + [lux "*"]] + [// + ["[0]" order {"+" Order}]]) (type: .public (Enum e) (Interface @@ -12,14 +12,15 @@ (def: .public (range enum from to) (All (_ a) (-> (Enum a) a a (List a))) - (let [(^open "[0]") enum] + (let [(^open "/#[0]") enum] (loop [end to - output {.#End}] - (cond (< end from) - (again (pred end) {.#Item end output}) + output (`` (: (List (~~ (:of from))) + {.#End}))] + (cond (/#< end from) + (again (/#pred end) {.#Item end output}) - (< from end) - (again (succ end) {.#Item end output}) + (/#< from end) + (again (/#succ end) {.#Item end output}) ... (= end from) {.#Item end output})))) diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux index 9e59da7dc..8d3c877d8 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -1,28 +1,33 @@ (.using - [library - [lux "*" - [abstract - [functor {"+" Functor}] - [apply {"+" Apply}] - [monad {"+" Monad do}] - [equivalence {"+" Equivalence}]] - [control - ["[0]" io] - [parser - ["<[0]>" code]] - [concurrency - ["[0]" atom]]] - [macro {"+" with_symbols} - [syntax {"+" syntax:}]] - [type - abstract]]]) + [library + [lux "*" + [abstract + [functor {"+" Functor}] + [apply {"+" Apply}] + [monad {"+" Monad do}] + [equivalence {"+" Equivalence}]] + [control + ["[0]" io] + [parser + ["<[0]>" code]] + [concurrency + ["[0]" atom]]] + [macro {"+" with_symbols} + [syntax {"+" syntax:}]] + [type {"+" :sharing} + abstract]]]) (abstract: .public (Lazy a) (-> [] a) (def: (lazy' generator) (All (_ a) (-> (-> [] a) (Lazy a))) - (let [cache (atom.atom {.#None})] + (let [cache (atom.atom (:sharing [a] + (-> [] a) + generator + + (Maybe a) + {.#None}))] (:abstraction (function (_ _) (case (io.run! (atom.read! cache)) {.#Some value} diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index ea16cddfc..437c80bfa 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -275,10 +275,10 @@ Nat (-- 0)) -(def: (list|-default array) - (All (_ a) (-> (Array a) (List a))) +(def: (list|-default array empty) + (All (_ a) (-> (Array a) (List a) (List a))) (loop [idx (-- (size array)) - output {.#End}] + output empty] (case idx (^ (static ..underflow)) output @@ -295,7 +295,8 @@ (def: (list|+default default array) (All (_ a) (-> a (Array a) (List a))) (loop [idx (-- (size array)) - output {.#End}] + output (`` (: (List (~~ (:of default))) + {.#End}))] (case idx (^ (static ..underflow)) output @@ -312,7 +313,7 @@ (list|+default default array) {.#None} - (list|-default array))) + (list|-default array {.#End}))) (implementation: .public (equivalence (^open ",#[0]")) (All (_ a) (-> (Equivalence a) (Equivalence (Array a)))) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index 083ad161c..7437962f6 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -475,9 +475,6 @@ (let [(^open "_#[0]") (value@ #&order dict) [?root found?] (loop [?root (value@ #root dict)] (case ?root - {.#None} - [{.#None} #0] - {.#Some root} (let [root_key (value@ #key root) root_val (value@ #value root)] @@ -514,6 +511,9 @@ #0]) ))) )) + + {.#None} + [{.#None} #0] ))] (case ?root {.#None} diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 28f4d3db7..e5130f985 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -382,7 +382,10 @@ (if (< x x') [{.#Item x' pre} post] [pre {.#Item x' post}])) - [(list) (list)] + (`` [(: (~~ (:of xs)) + (list)) + (: (~~ (:of xs)) + (list))]) xs')] ($_ composite (sorted < pre) (list x) (sorted < post))))) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 07ebeba76..746654c57 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -224,10 +224,8 @@ ... If so, a brand-new root must be established, that is ... 1-level taller. (|> sequence - (with@ #root (|> (for [@.old - (: (Hierarchy (:parameter 0)) - (empty_hierarchy []))] - (empty_hierarchy [])) + (with@ #root (|> (`` (: (Hierarchy (~~ (:of val))) + (empty_hierarchy []))) (array.write! 0 {#Hierarchy (value@ #root sequence)}) (array.write! 1 (..path (value@ #level sequence) (value@ #tail sequence))))) (revised@ #level level_up)) @@ -293,10 +291,9 @@ {try.#Success (if (n.< (tail_off sequence_size) idx) (revised@ #root (hierarchy#has (value@ #level sequence) idx val) sequence) - (revised@ #tail (for [@.old - (: (-> (Base (:parameter 0)) (Base (:parameter 0))) - (|>> array.clone (array.write! (branch_idx idx) val)))] - (|>> array.clone (array.write! (branch_idx idx) val))) + (revised@ #tail (`` (: (-> (Base (~~ (:of val))) + (Base (~~ (:of val)))) + (|>> array.clone (array.write! (branch_idx idx) val)))) sequence))} (exception.except ..index_out_of_bounds [sequence idx])))) diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux index 270623c6e..7c8a244b1 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -15,8 +15,8 @@ (Record [#monoid (Monoid t) #tag t - #root (Or v - [(Tree @ t v) (Tree @ t v)])]) + #root (Either v + [(Tree @ t v) (Tree @ t v)])]) (type: .public (Builder @ t) (Interface @@ -45,13 +45,13 @@ (:abstraction [#monoid monoid #tag tag - #root {0 #0 value}])) + #root {.#Left value}])) (def: (branch left right) (:abstraction [#monoid monoid #tag (# monoid composite (..tag left) (..tag right)) - #root {0 #1 [left right]}]))) + #root {.#Right [left right]}]))) (def: .public (value tree) (All (_ @ t v) (-> (Tree @ t v) v)) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 59d2b2374..46ffa8021 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -1258,9 +1258,9 @@ (syntax: .public (??? [expr <code>.any]) (with_symbols [g!temp] (in (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - {.#None} - {.#Some (~ g!temp)}))))))) + (if (not ("jvm object null?" (~ g!temp))) + {.#Some (~ g!temp)} + {.#None}))))))) (syntax: .public (!!! [expr <code>.any]) (with_symbols [g!value] diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 469a17226..1b3a9426a 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -352,7 +352,7 @@ (let [magic 6364136223846793005] (function (_ _) [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg_32) - (let [rot (|> seed .i64 (i64.right_shifted 59))] + (let [rot (|> seed .nat (i64.right_shifted 59))] (|> seed (i64.right_shifted 18) (i64.xor seed) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 87864e062..dc1b5e935 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -450,7 +450,7 @@ (def: .public (comment commentary on) (All (_ brand) (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..safe commentary) \n+ + (:abstraction (format "# " (text.replaced text.\n "\n" commentary) \n+ (:representation on)))) ) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index ef79450e9..f13ffecd2 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -51,6 +51,7 @@ [phase ["[0]" extension {"+" Extender}]]]] [meta + [import {"+" Import}] [cli {"+" Compilation Library} ["[0]" compiler {"+" Compiler}]] ["[0]" archive {"+" Output Archive} @@ -64,7 +65,6 @@ ["ioW" archive]]]]] [program [compositor - [import {"+" Import}] ["[0]" static {"+" Static}]]]) (with_expansions [<type_vars> (as_is anchor expression directive) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index 2d231f1cc..65b191979 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -159,7 +159,8 @@ (def: .public (reification analysis) (-> Analysis (Reification Analysis)) (loop [abstraction analysis - inputs (list)] + inputs (: (List Analysis) + (list))] (.case abstraction {#Apply input next} (again next {.#Item input inputs}) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux index 1b693629a..6ca7137d2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux @@ -3,7 +3,7 @@ [lux "*" ["[0]" meta] [abstract - [monad {"+" do}]] + ["[0]" monad {"+" do}]] [control [pipe {"+" case>}] ["[0]" maybe] @@ -53,25 +53,6 @@ [invalid_type_application] ) -(def: prefix - (format (%.symbol (symbol ..type)) "#")) - -(def: .public (existential? type) - (-> Type Bit) - (case type - {.#Primitive actual {.#End}} - (text.starts_with? ..prefix actual) - - _ - false)) - -(def: existential - (Operation Type) - (do phase.monad - [module (extension.lifted meta.current_module_name) - [id _] (/type.check check.existential)] - (in {.#Primitive (format ..prefix module "#" (%.nat id)) (list)}))) - (def: .public (quantified @var @parameter :it:) (-> check.Var Nat Type Type) (case :it: @@ -111,33 +92,34 @@ ... tagged variants). ... But, so long as the type being used for the inference can be treated ... as a function type, this method of inference should work. -(def: .public (general archive analyse inferT args) - (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)])) +(def: (general' vars archive analyse inferT args) + (-> (List check.Var) Archive Phase Type (List Code) (Operation [Type_Context (List check.Var) Type (List Analysis)])) (case args {.#End} (do phase.monad - [_ (/type.inference inferT)] - (in [inferT (list)])) + [just_before (/type.check check.context) + _ (/type.inference inferT)] + (in [just_before vars inferT (list)])) {.#Item argC args'} (case inferT {.#Named name unnamedT} - (general archive analyse unnamedT args) + (general' vars archive analyse unnamedT args) {.#UnivQ _} (do phase.monad [[@var :var:] (/type.check check.var)] - (general archive analyse (maybe.trusted (type.applied (list :var:) inferT)) args)) + (general' (list& @var vars) archive analyse (maybe.trusted (type.applied (list :var:) inferT)) args)) {.#ExQ _} (do phase.monad - [:ex: ..existential] - (general archive analyse (maybe.trusted (type.applied (list :ex:) inferT)) args)) + [:ex: /type.existential] + (general' vars archive analyse (maybe.trusted (type.applied (list :ex:) inferT)) args)) {.#Apply inputT transT} (case (type.applied (list inputT) transT) {.#Some outputT} - (general archive analyse outputT args) + (general' vars archive analyse outputT args) {.#None} (/.except ..invalid_type_application [inferT])) @@ -151,18 +133,18 @@ ... things together more easily. {.#Function inputT outputT} (do phase.monad - [[outputT' args'A] (general archive analyse outputT args') + [[just_before vars outputT' args'A] (general' vars archive analyse outputT args') argA (<| (/.with_exception ..cannot_infer_argument [inputT argC]) (/type.expecting inputT) (analyse archive argC))] - (in [outputT' (list& argA args'A)])) + (in [just_before vars outputT' (list& argA args'A)])) {.#Var infer_id} (do phase.monad [?inferT' (/type.check (check.peek infer_id))] (case ?inferT' {.#Some inferT'} - (general archive analyse inferT' args) + (general' vars archive analyse inferT' args) _ (/.except ..cannot_infer [inferT args]))) @@ -171,6 +153,40 @@ (/.except ..cannot_infer [inferT args])) )) +(def: .public (general archive analyse inferT args) + (-> Archive Phase Type (List Code) (Operation [Type (List Analysis)])) + (do [! phase.monad] + [[just_before vars :inference: terms] (general' (list) archive analyse inferT args)] + (in [:inference: terms]) + ... (case vars + ... (^ (list)) + ... (in [:inference: terms]) + + ... _ + ... (do ! + ... [:inference: (/type.check + ... (do [! check.monad] + ... [quantifications (monad.mix ! (function (_ @var level) + ... (do ! + ... [:var: (check.try (check.identity vars @var))] + ... (case :var: + ... {try.#Success _} + ... (in level) + + ... {try.#Failure _} + ... (do ! + ... [.let [:var: (|> level (n.* 2) ++ {.#Parameter})] + ... _ (check.bind :var: @var)] + ... (in (++ level)))))) + ... 0 + ... vars) + ... :inference:' (# ! each (type.univ_q quantifications) (check.clean vars :inference:)) + ... _ (check.with just_before)] + ... (in :inference:'))) + ... _ (/type.inference :inference:)] + ... (in [:inference: terms]))) + )) + (def: (with_recursion @self recursion) (-> Nat Type Type Type) (function (again it) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux index c066115ec..bd2c04844 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux @@ -3,10 +3,18 @@ [lux "*" ["[0]" meta] [abstract - [monad {"+" do}]] + ["[0]" monad {"+" do}]] [control ["[0]" function] ["[0]" try]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list]]] + [math + [number + ["n" nat]]] [type ["[0]" check {"+" Check}]]]] ["/" // {"+" Operation} @@ -16,11 +24,6 @@ [/// ["[0]" phase]]]]) -(def: .public (expecting expected) - (All (_ a) (-> Type (Operation a) (Operation a))) - (extension.localized (value@ .#expected) (with@ .#expected) - (function.constant {.#Some expected}))) - (def: .public (check action) (All (_ a) (-> (Check a) (Operation a))) (function (_ (^@ stateE [bundle state])) @@ -32,6 +35,34 @@ {try.#Failure error} ((/.failure error) stateE)))) +(def: prefix + (format (%.symbol (symbol ..type)) "#")) + +(def: .public (existential? type) + (-> Type Bit) + (case type + {.#Primitive actual {.#End}} + (text.starts_with? ..prefix actual) + + _ + false)) + +(def: (existential' module id) + (-> Text Nat Type) + {.#Primitive (format ..prefix module "#" (%.nat id)) (list)}) + +(def: .public existential + (Operation Type) + (do phase.monad + [module (extension.lifted meta.current_module_name) + [id _] (..check check.existential)] + (in (..existential' module id)))) + +(def: .public (expecting expected) + (All (_ a) (-> Type (Operation a) (Operation a))) + (extension.localized (value@ .#expected) (with@ .#expected) + (function.constant {.#Some expected}))) + (def: .public fresh (All (_ a) (-> (Operation a) (Operation a))) (extension.localized (value@ .#type_context) (with@ .#type_context) @@ -40,8 +71,44 @@ (def: .public (inference actualT) (-> Type (Operation Any)) (do phase.monad - [expectedT (extension.lifted meta.expected_type)] - (..check (check.check expectedT actualT)))) + [module (extension.lifted meta.current_module_name) + expectedT (extension.lifted meta.expected_type)] + (..check (check.check expectedT actualT) + ... (do [! check.monad] + ... [pre check.context + ... it (check.check expectedT actualT) + ... post check.context + ... .let [pre#var_counter (value@ .#var_counter pre)]] + ... (if (n.< (value@ .#var_counter post) + ... pre#var_counter) + ... (do ! + ... [.let [new! (: (-> [Nat (Maybe Type)] (Maybe Nat)) + ... (function (_ [id _]) + ... (if (n.< id pre#var_counter) + ... {.#Some id} + ... {.#None}))) + ... new_vars (|> post + ... (value@ .#var_bindings) + ... (list.all new!))] + ... _ (monad.each ! (function (_ @new) + ... (do ! + ... [:new: (check.try (check.identity new_vars @new))] + ... (case :new: + ... {try.#Success :new:} + ... (in :new:) + + ... {try.#Failure error} + ... (do ! + ... [[id _] check.existential + ... .let [:new: (..existential' module id)] + ... _ (check.bind :new: @new)] + ... (in :new:))))) + ... new_vars) + ... expectedT' (check.clean new_vars expectedT) + ... _ (check.with pre)] + ... (check.check expectedT' actualT)) + ... (in it))) + ))) (def: .public (with_var it) (All (_ a) (-> (-> [check.Var Type] (Operation a)) @@ -50,7 +117,8 @@ [var (..check check.var) .let [[@it :it:] var] it (it var) - _ (..check (check.forget! @it))] + ... _ (..check (check.forget! @it)) + ] (in it))) (def: .public (inferring action) @@ -58,5 +126,10 @@ (do phase.monad [[@it :it:] (..check check.var) it (..expecting :it: action) - :it: (..check (check.clean :it:))] + :it: (..check (check.clean (list) :it:)) + ... :it: (..check (do check.monad + ... [:it: (check.identity (list) @it) + ... _ (check.forget! @it)] + ... (in :it:))) + ] (in [:it: it]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux index 726860314..cce7b1f00 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux @@ -105,7 +105,7 @@ (function (again valueC) (do [! ///.monad] [expectedT (///extension.lifted meta.expected_type) - expectedT' (/type.check (check.clean expectedT))] + expectedT' (/type.check (check.clean (list) expectedT))] (/.with_exception ..cannot_analyse_variant [expectedT' lefts right? valueC] (case expectedT {.#Sum _} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index a7d889777..2338824c4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -461,7 +461,7 @@ [var_id varT] (typeA.check check.var) arrayA (<| (typeA.expecting (.type (array.Array varT))) (analyse archive arrayC)) - varT (typeA.check (check.clean varT)) + varT (typeA.check (check.clean (list) varT)) arrayJT (jvm_array_type (.type (array.Array varT)))] (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT)) arrayA)})) @@ -667,7 +667,7 @@ _ (typeA.inference varT) arrayA (<| (typeA.expecting (.type (array.Array varT))) (analyse archive arrayC)) - varT (typeA.check (check.clean varT)) + varT (typeA.check (check.clean (list) varT)) arrayJT (jvm_array_type (.type (array.Array varT))) idxA (<| (typeA.expecting ..int) (analyse archive idxC))] @@ -710,7 +710,7 @@ _ (typeA.inference (.type (array.Array varT))) arrayA (<| (typeA.expecting (.type (array.Array varT))) (analyse archive arrayC)) - varT (typeA.check (check.clean varT)) + varT (typeA.check (check.clean (list) varT)) arrayJT (jvm_array_type (.type (array.Array varT))) idxA (<| (typeA.expecting ..int) (analyse archive idxC)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 04006e52f..e159172b2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -146,7 +146,7 @@ (do ! [[code//type codeA] (typeA.inferring (analyse archive codeC)) - code//type (typeA.check (check.clean code//type))] + code//type (typeA.check (check.clean (list) code//type))] (in [code//type codeA])) {.#Some expected} diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index d8347d9fd..4ec08ed90 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -108,7 +108,7 @@ {try.#Success [/#next (|> archive :representation - (revised@ #resolver (dictionary.has module [/#next {.#None}])) + (revised@ #resolver (dictionary.has module [/#next (: (Maybe (Entry Any)) {.#None})])) (revised@ #next ++) :abstraction)]}))) @@ -261,7 +261,7 @@ (in (:abstraction [#next next #resolver (list#mix (function (_ [module id] archive) - (dictionary.has module [id {.#None}] archive)) + (dictionary.has module [id (: (Maybe (Entry Any)) {.#None})] archive)) (value@ #resolver (:representation ..empty)) reservations)])))) ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/export.lux b/stdlib/source/library/lux/tool/compiler/meta/export.lux index 79c5a2a44..9b21de75b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/export.lux @@ -30,7 +30,13 @@ (def: .public file "library.tar") -(def: commons +(def: .public mode + ($_ tar.and + tar.read_by_owner tar.write_by_owner + tar.read_by_group tar.write_by_group + tar.read_by_other)) + +(def: .public ownership tar.Ownership (let [commons (: tar.Owner [tar.#name tar.anonymous @@ -51,11 +57,8 @@ tar.path)] (try#each (|>> [path (instant.of_millis +0) - ($_ tar.and - tar.read_by_owner tar.write_by_owner - tar.read_by_group tar.write_by_group - tar.read_by_other) - ..commons] + ..mode + ..ownership] {tar.#Normal}) (tar.content source_code))))) (try#each sequence.of_list))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/library/lux/tool/compiler/meta/import.lux index 7f21f20ec..d3a356c43 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/import.lux @@ -7,13 +7,13 @@ ["[0]" try {"+" Try}] ["[0]" exception {"+" exception:}] [concurrency - ["[0]" async {"+" Async} ("[1]#[0]" monad)]] + ["[0]" async {"+" Async}]] ["<>" parser ["<[0]>" binary]]] [data [binary {"+" Binary}] ["[0]" text - ["%" format {"+" format}]] + ["%" format]] [collection ["[0]" dictionary {"+" Dictionary}] ["[0]" sequence]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 63cae0681..b9b99208f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -30,11 +30,11 @@ ["[0]" file]]]] [program [compositor - [import {"+" Import}] ["[0]" static {"+" Static}]]] ["[0]" // {"+" Context} ["[1][0]" context] ["/[1]" // + [import {"+" Import}] ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] ["[0]" unit] diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux index 2f99ddce1..d576571eb 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -22,11 +22,9 @@ ["[0]" list]]] [world ["[0]" file]]]] - [program - [compositor - [import {"+" Import}]]] ["[0]" // {"+" Context Code} ["/[1]" // "_" + [import {"+" Import}] ["/[1]" // {"+" Input}] [archive [module diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 31ec9da05..984456187 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -299,10 +299,7 @@ _ (except ..invalid_type_application [funcT argT])))) -(type: Ring - (Set Var)) - -(def: (ring' start) +(def: .public (ring' start) (-> Var (Check (List Var))) (function (_ context) (loop [current start @@ -326,7 +323,7 @@ ... TODO: Optimize this by not using sets anymore. (def: ring - (-> Var (Check Ring)) + (-> Var (Check (Set Var))) (|>> ..ring' (check#each (set.of_list n.hash)))) @@ -336,15 +333,7 @@ (set.member? it @1)) (..ring @0))) -(exception: (invalid_alias [var Var - expected (List Var) - actual (List Var)]) - (exception.report - ["Var" (n#encoded var)] - ["Expected" (exception.listing n#encoded expected)] - ["Actual" (exception.listing n#encoded actual)])) - -(exception: (cannot_identify [var Var]) +(exception: .public (cannot_identify [var Var]) (exception.report ["Var" (n#encoded var)])) @@ -358,18 +347,18 @@ {.#None} (do ! - [existing_aliases (..ring @) - _ (if (list.every? (set.member? existing_aliases) aliases) - (in []) - (..except ..invalid_alias [@ aliases (set.list existing_aliases)])) - .let [forbidden_aliases (set.of_list n.hash (list& @ aliases)) - allowed_aliases (set.difference forbidden_aliases existing_aliases)]] - (case (set.list allowed_aliases) - {.#Item identity _} - (in {.#Var identity}) - - {.#None} - (..except ..cannot_identify [@])))))) + [existing_aliases (..ring @)] + (if (n.< 2 (set.size existing_aliases)) + (..except ..cannot_identify [@]) + (do ! + [.let [forbidden_aliases (set.of_list n.hash (list& @ aliases)) + allowed_aliases (set.difference forbidden_aliases existing_aliases)]] + (case (set.list allowed_aliases) + {.#Item identity _} + (in {.#Var identity}) + + {.#None} + (..except ..cannot_identify [@])))))))) (def: (erase! @) (-> Var (Check Any)) @@ -639,7 +628,7 @@ _ ..silent_failure!))) -(def: (with exception parameter check) +(def: (with_exception exception parameter check) (All (_ e a) (-> (Exception e) e (Check a) (Check a))) (|>> check (exception.with exception parameter))) @@ -652,7 +641,7 @@ @.php false] (same? expected actual)) (check#in assumptions) - (with ..type_check_failed [expected actual] + (with_exception ..type_check_failed [expected actual] (case [expected actual] [{.#Var idE} {.#Var idA}] (check_vars check' assumptions idE idA) @@ -774,12 +763,17 @@ (function (_ context) {try.#Success [context context]})) -(def: .public (clean inputT) - (-> Type (Check Type)) +(def: .public (with context) + (-> Type_Context (Check Any)) + (function (_ _) + {try.#Success [context []]})) + +(def: .public (clean aliases inputT) + (-> (List Var) Type (Check Type)) (case inputT {.#Primitive name paramsT+} (|> paramsT+ - (monad.each ..monad clean) + (monad.each ..monad (clean aliases)) (check#each (|>> {.#Primitive name}))) (^or {.#Parameter _} {.#Ex _} {.#Named _}) @@ -788,26 +782,43 @@ (^template [<tag>] [{<tag> leftT rightT} (do ..monad - [leftT' (clean leftT)] - (|> (clean rightT) + [leftT' (clean aliases leftT)] + (|> (clean aliases rightT) (check#each (|>> {<tag> leftT'}))))]) ([.#Sum] [.#Product] [.#Function] [.#Apply]) {.#Var @} - (do ..monad - [?actualT (peek @)] - (case ?actualT - {.#Some actualT} - (clean actualT) + (case aliases + (^ (list)) + (do ..monad + [?actualT (peek @)] + (case ?actualT + {.#Some actualT} + (clean aliases actualT) - _ - (in inputT))) + _ + (in inputT))) + + _ + (do ..monad + [:it: (..try (..identity aliases @))] + (case :it: + {try.#Success :it:} + (case :it: + {.#Var _} + (in inputT) + + _ + (clean aliases :it:)) + + failure + (in inputT)))) (^template [<tag>] [{<tag> envT+ unquantifiedT} (do [! ..monad] - [envT+' (monad.each ! clean envT+) - unquantifiedT' (clean unquantifiedT)] + [envT+' (monad.each ! (clean aliases) envT+) + unquantifiedT' (clean aliases unquantifiedT)] (in {<tag> envT+' unquantifiedT'}))]) ([.#UnivQ] [.#ExQ]) )) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 950f19206..5fdc9cc21 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -306,10 +306,11 @@ (Program IO) (def: (available_variables _) - (with_expansions [<jvm> (io.io (|> (java/lang/System::getenv) - java/util/Map::keySet - java/util/Set::iterator - ..jvm##consume))] + (with_expansions [<jvm> (|> (java/lang/System::getenv) + java/util/Map::keySet + java/util/Set::iterator + ..jvm##consume + io.io)] (for [@.old <jvm> @.jvm <jvm> @.js (io.io (if ffi.on_node_js? @@ -325,9 +326,7 @@ @.python (# io.monad each (array.list {.#None}) (os/environ::keys [])) ... Lua offers no way to get all the environment variables available. @.lua (io.io (list)) - @.ruby (|> (RubyEnv::keys []) - (array.list {.#None}) - io.io) + @.ruby (io.io (array.list {.#None} (RubyEnv::keys []))) ... @.php (do io.monad ... [environment (..getenv/0 [])] ... (in (|> environment diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 55da4161b..4e0599859 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -42,6 +42,7 @@ [meta [packager {"+" Packager}] ["[0]" cli {"+" Service}] + ["[0]" import] ["[0]" export] [archive {"+" Archive} ["[0]" unit] @@ -52,8 +53,7 @@ ... ["[0]" interpreter] ]]] ["[0]" / "_" - ["[1][0]" static {"+" Static}] - ["[1][0]" import]]) + ["[1][0]" static {"+" Static}]]) (def: (or_crash! failure_description action) (All (_ a) @@ -153,7 +153,7 @@ ..timed (do (try.with async.monad) [.let [[compilation_host_dependencies compilation_libraries compilation_compilers compilation_sources compilation_target compilation_module] compilation] - import (/import.import (value@ platform.#&file_system platform) compilation_libraries) + import (import.import (value@ platform.#&file_system platform) compilation_libraries) [state archive phase_wrapper] (:sharing [<parameters>] (Platform <parameters>) platform diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux index 867a7b76f..3d01a1217 100644 --- a/stdlib/source/specification/lux/abstract/apply.lux +++ b/stdlib/source/specification/lux/abstract/apply.lux @@ -1,65 +1,69 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" function]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Apply}]] - [// - [functor {"+" Injection Comparison}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" function]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" Apply}]] + [// + [functor {"+" Injection Comparison}]]) -(def: (identity injection comparison (^open "#[0]")) +(def: (identity injection comparison (^open "/#[0]")) (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) (do [! random.monad] [sample (# ! each injection random.nat)] (_.test "Identity." ((comparison n.=) - (#on sample (injection function.identity)) + (/#on sample (injection function.identity)) sample)))) -(def: (homomorphism injection comparison (^open "#[0]")) +(def: (homomorphism injection comparison (^open "/#[0]")) (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) (do [! random.monad] [sample random.nat increase (# ! each n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (#on (injection sample) (injection increase)) + (/#on (injection sample) (injection increase)) (injection (increase sample)))))) -(def: (interchange injection comparison (^open "#[0]")) +(def: (interchange injection comparison (^open "/#[0]")) (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) (do [! random.monad] [sample random.nat increase (# ! each n.+ random.nat)] (_.test "Interchange." ((comparison n.=) - (#on (injection sample) (injection increase)) - (#on (injection increase) (injection (: (-> (-> Nat Nat) Nat) - (function (_ f) (f sample))))))))) + (/#on (injection sample) (injection increase)) + (/#on (injection increase) (injection (: (-> (-> Nat Nat) Nat) + (function (_ f) (f sample))))))))) -(def: (composition injection comparison (^open "#[0]")) +(def: (composition injection comparison (^open "/#[0]")) (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) - (do [! random.monad] - [sample random.nat - increase (# ! each n.+ random.nat) - decrease (# ! each n.- random.nat)] - (_.test "Composition." - ((comparison n.=) - (|> (injection function.composite) - (#on (injection increase)) - (#on (injection decrease)) - (#on (injection sample))) - (#on (#on (injection sample) - (injection increase)) - (injection decrease)))))) + (:let [:$/1: (-> Nat Nat)] + (do [! random.monad] + [sample random.nat + increase (: (Random :$/1:) + (# ! each n.+ random.nat)) + decrease (: (Random :$/1:) + (# ! each n.- random.nat))] + (_.test "Composition." + ((comparison n.=) + (|> (injection (: (-> :$/1: :$/1: :$/1:) + function.composite)) + (/#on (injection increase)) + (/#on (injection decrease)) + (/#on (injection sample))) + (/#on (/#on (injection sample) + (injection increase)) + (injection decrease))))))) (def: .public (spec injection comparison apply) (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 00b421f97..85a1f4ac8 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -141,8 +141,10 @@ sample random.nat start random.nat .let [distance 10 - |++| (/.apply/1 ++) - |test| (/.apply/1 (|>> (n.- start) (n.< distance)))]] + |++| (: (/.=> [Nat] [Nat]) + (/.apply/1 ++)) + |test| (: (/.=> [Nat] [Bit]) + (/.apply/1 (|>> (n.- start) (n.< distance))))]] ($_ _.and (_.cover [/.call /.apply/1] (n.= (++ sample) @@ -244,18 +246,21 @@ (_.cover [/.loop] (n.= (n.+ distance start) (||> (/.push start) - (/.push (|>> |++| /.dup |test|)) + (/.push (: (/.=> [Nat] [Nat Bit]) + (|>> |++| /.dup |test|))) /.loop))) (_.cover [/.while] (n.= (n.+ distance start) (||> (/.push start) - (/.push (|>> /.dup |test|)) + (/.push (: (/.=> [Nat] [Nat Bit]) + (|>> /.dup |test|))) (/.push |++|) /.while))) (_.cover [/.do] (n.= (++ sample) (||> (/.push sample) - (/.push (|>> (/.push false))) + (/.push (: (/.=> [] [Bit]) + (|>> (/.push false)))) (/.push |++|) /.do /.while))) (_.cover [/.compose] diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 466f1c61f..7b564d904 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -1,30 +1,30 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad]]] - [control - ["[0]" try] - ["[0]" exception] - ["[0]" io {"+" IO io}]] - [data - [collection - ["[0]" list ("[1]#[0]" mix monoid)] - ["[0]" sequence {"+" Sequence}]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / - [// - ["[0]" async {"+" Async} ("[1]#[0]" monad)] - ["[0]" atom {"+" Atom atom}]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad]]] + [control + ["[0]" try] + ["[0]" exception] + ["[0]" io {"+" IO io}]] + [data + [collection + ["[0]" list ("[1]#[0]" mix monoid)] + ["[0]" sequence {"+" Sequence}]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + [// + ["[0]" async {"+" Async} ("[1]#[0]" monad)] + ["[0]" atom {"+" Atom atom}]]]]) (def: injection (Injection /.Channel) @@ -86,7 +86,8 @@ (_.cover [/.Channel /.Sink /.channel] (case (io.run! (do (try.with io.monad) - [.let [[channel sink] (/.channel [])] + [.let [[channel sink] (: [(/.Channel Nat) (/.Sink Nat)] + (/.channel []))] _ (# sink feed sample) _ (# sink close)] (in channel))) @@ -106,7 +107,8 @@ (_.cover [/.channel_is_already_closed] (case (io.run! (do (try.with io.monad) - [.let [[channel sink] (/.channel [])] + [.let [[channel sink] (: [(/.Channel Nat) (/.Sink Nat)] + (/.channel []))] _ (# sink close)] (# sink feed sample))) {try.#Success _} diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux index a798c19aa..fe8528548 100644 --- a/stdlib/source/test/lux/control/maybe.lux +++ b/stdlib/source/test/lux/control/maybe.lux @@ -65,7 +65,8 @@ value random.nat] (_.cover [/.else] (and (same? default (/.else default - {.#None})) + (: (Maybe Nat) + {.#None}))) (same? value (/.else default {.#Some value}))))) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 4c923924b..85b98df02 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -185,9 +185,7 @@ (in directive.no_requirements))) (for [... TODO: No longer skip testing Lua after Rembulan isn't being used anymore. - @.lua (as_is) - ... TODO: No longer skip testing Python. - @.python (as_is)] + @.lua (as_is)] (`` ((~~ (static ..directive)) (n.* 2 3)))) )) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index c9a5cfb7c..8c154b3a0 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -24,7 +24,8 @@ ["[1][0]" meta "_" ["[1]/[0]" archive] ["[1]/[0]" cli] - ["[1]/[0]" export]] + ["[1]/[0]" export] + ["[1]/[0]" import]] ]]) (def: .public test @@ -38,6 +39,7 @@ /meta/archive.test /meta/cli.test /meta/export.test + /meta/import.test /phase/extension.test /phase/analysis/simple.test /phase/analysis/complex.test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux index 97bdb7a54..3eec3a5b4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux @@ -108,6 +108,8 @@ (_.cover [/.general] (and (|> (/.general archive.empty ..analysis expected (list)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false)) @@ -115,6 +117,8 @@ (type.function (list.repeated arity .Nat) expected) (list#each code.nat nats)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (function (_ [actual analysis/*]) (and (type#= expected actual) @@ -126,6 +130,8 @@ (type (-> type/0 expected)) (list term/0)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false)) @@ -133,6 +139,8 @@ (type {.#Named name (-> type/0 expected)}) (list term/0)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false)) @@ -140,7 +148,9 @@ (type (All (_ a) (-> a a))) (list term/0)) (//type.expecting type/0) - (/phase#each (|>> product.left check.clean //type.check)) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) /phase#conjoint (/phase.result state) (try#each (type#= type/0)) @@ -149,6 +159,8 @@ (type ((All (_ a) (-> a a)) type/0)) (list term/0)) (//type.expecting type/0) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= type/0))) (try.else false)) @@ -157,11 +169,23 @@ _ (//type.check (check.check varT (type (-> type/0 expected))))] (/.general archive.empty ..analysis varT (list term/0))) (//type.expecting expected) - (/phase#each (|>> product.left check.clean //type.check)) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) /phase#conjoint (/phase.result state) (try#each (type#= expected)) (try.else false)) + (|> (/.general archive.empty ..analysis + (type (Ex (_ a) (-> a a))) + (list (` ("lux io error" "")))) + //type.inferring + (//module.with 0 (product.left name)) + (/phase#each (|>> product.right product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each //type.existential?) + (try.else false)) )) (_.cover [/.cannot_infer] (and (|> (/.general archive.empty ..analysis expected (list term/0)) @@ -179,19 +203,9 @@ (type (-> expected expected)) (list term/0)) (//type.expecting expected) - (/phase.result state) - (..fails? /.cannot_infer_argument))) - (_.cover [/.existential?] - (|> (/.general archive.empty ..analysis - (type (Ex (_ a) (-> a a))) - (list (` ("lux io error" "")))) - //type.inferring (//module.with 0 (product.left name)) - (/phase#each (|>> product.right product.left check.clean //type.check)) - /phase#conjoint (/phase.result state) - (try#each /.existential?) - (try.else false))) + (..fails? /.cannot_infer_argument))) ))) (def: test|variant diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux index 2e63f1bc8..867ef7e5a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux @@ -16,11 +16,12 @@ [\\library ["[0]" / ["/[1]" // + ["[2][0]" module] [// [phase ["[2][0]" extension]] [/// - ["[2][0]" phase]]]]]]) + ["[2][0]" phase ("[1]#[0]" functor)]]]]]]) (def: .public random_state (Random Lux) @@ -44,27 +45,36 @@ /extension.#state lux]] expected ..primitive dummy (random.only (|>> (type#= expected) not) - ..primitive)] + ..primitive) + module (random.ascii/lower 1)] ($_ _.and (_.cover [/.expecting /.inference] (and (|> (/.inference expected) (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} true {try.#Failure _} false)) (|> (/.inference dummy) (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} false {try.#Failure _} true)) (|> (/.inference expected) (/.expecting dummy) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} false {try.#Failure _} true)))) (_.cover [/.inferring] (|> (/.inference expected) /.inferring + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false))) @@ -75,9 +85,19 @@ (in type)))] (|> (/.inference exT) (/.expecting exT))) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} true {try.#Failure _} false))) + (_.cover [/.existential /.existential?] + (|> (do /phase.monad + [:it: /.existential] + (in (/.existential? :it:))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try.else false))) (_.cover [/.fresh] (and (|> (do /phase.monad [varT (/.check (do check.monad @@ -85,6 +105,8 @@ (in type)))] (|> (/.inference expected) (/.expecting varT))) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} true {try.#Failure _} false)) @@ -95,6 +117,8 @@ (|> (/.inference expected) (/.expecting varT) /.fresh)) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} false {try.#Failure _} true)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index 50fbc1c50..b5f2e4fc4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -195,59 +195,66 @@ (exception.otherwise (text.contains? (value@ exception.#label /.cannot_analyse))))) ))) +(def: test|apply + Test + (do [! random.monad] + [lux $//type.random_state + .let [state [//extension.#bundle (//extension/analysis.bundle ..eval) + //extension.#state lux]] + [input/0 term/0] $//inference.simple_parameter + [input/1 term/1] (random.only (|>> product.left (same? input/0) not) + $//inference.simple_parameter) + output/0 ($type.random 0) + module/0 (random.ascii/lower 1)] + ($_ _.and + (_.cover [/.apply] + (let [reification? (: (-> Type (List Code) Type Bit) + (function (_ :abstraction: terms :expected:) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.apply ..analysis terms + :abstraction: + (//analysis.unit) + archive.empty + (' [])) + //type.inferring)] + (in (and (check.subsumes? :expected: :actual:) + (case analysis + {//analysis.#Apply _} + true + + _ + false)))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) + (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) + (reification? (All (_ a) (-> a a)) (list term/0) input/0) + (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) + (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) + (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) + (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) + (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) + (_.cover [/.cannot_apply] + (|> (do //phase.monad + [_ (|> (/.apply ..analysis (list term/1 term/0) + (-> input/0 input/1 output/0) + (//analysis.unit) + archive.empty + (' [])) + (//type.expecting output/0))] + (in false)) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (value@ exception.#label /.cannot_apply))))) + ))) + (def: .public test Test (<| (_.covering /._) - (do [! random.monad] - [lux $//type.random_state - .let [state [//extension.#bundle (//extension/analysis.bundle ..eval) - //extension.#state lux]] - [input/0 term/0] $//inference.simple_parameter - [input/1 term/1] $//inference.simple_parameter - output/0 ($type.random 0) - module/0 (random.ascii/lower 1)] - ($_ _.and - ..test|function - (_.cover [/.apply] - (let [reification? (: (-> Type (List Code) Type Bit) - (function (_ :abstraction: terms :expected:) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.apply ..analysis terms - :abstraction: - (//analysis.unit) - archive.empty - (' [])) - //type.inferring)] - (in (and (check.subsumes? :expected: :actual:) - (case analysis - {//analysis.#Apply _} - true - - _ - false)))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) - (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) - (reification? (All (_ a) (-> a a)) (list term/0) input/0) - (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) - (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) - (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) - (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) - (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) - (_.cover [/.cannot_apply] - (|> (do //phase.monad - [_ (|> (/.apply ..analysis (list term/1 term/0) - (-> input/0 input/1 output/0) - (//analysis.unit) - archive.empty - (' [])) - (//type.expecting output/0))] - (in false)) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (value@ exception.#label /.cannot_apply))))) - )))) + ($_ _.and + ..test|function + ..test|apply + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index c16cbf491..af84eb488 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -49,6 +49,8 @@ (//scope.with_local [expected_name expected_type]) //type.inferring //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) (//phase.result state) (try#each (|>> product.right (case> (^ [actual_type (//analysis.local 0)]) @@ -64,6 +66,8 @@ //scope.with (//scope.with_local [expected_name expected_type]) //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) (//phase.result state) (try#each (|>> product.right product.right diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux index a93b4c3e1..45c22f1ec 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -8,6 +8,8 @@ [control [pipe {"+" case>}] ["[0]" try]] + [data + ["[0]" product]] [math ["[0]" random]]]] [\\library @@ -16,14 +18,17 @@ ["[1][0]" extension] [// ["[1][0]" analysis {"+" Analysis Operation} - ["[2][0]" type]] + ["[2][0]" type] + ["[2][0]" module]] [/// - ["[1][0]" phase]]]]]]) + ["[1][0]" phase ("[1]#[0]" functor)]]]]]]) -(def: (analysis state type it ?) - (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit) +(def: (analysis state module type it ?) + (-> Lux Text Type (Operation Analysis) (-> Analysis Bit) Bit) (and (|> it (/type.expecting type) + (/module.with 0 module) + (/phase#each product.right) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Success analysis}) @@ -33,6 +38,8 @@ false)) (|> it (/type.expecting .Nothing) + (/module.with 0 module) + (/phase#each product.right) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Failure error}) @@ -42,6 +49,8 @@ false)) (|> it /type.inferring + (/module.with 0 module) + (/phase#each product.right) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Success [inferred analysis]}) @@ -64,17 +73,18 @@ (<| (_.covering /._) (do [! random.monad] [version random.nat - host (random.ascii/lower 5) + host (random.ascii/lower 1) + module (random.ascii/lower 2) .let [state (/analysis.state (/analysis.info version host))]] (`` ($_ _.and (_.cover [/.unit] - (..analysis state .Any /.unit + (..analysis state module .Any /.unit (|>> (case> (^ (/analysis.unit)) true _ false)))) (~~ (template [<analysis> <type> <random> <tag>] [(do ! [sample <random>] (_.cover [<analysis>] - (..analysis state <type> (<analysis> sample) + (..analysis state module <type> (<analysis> sample) ((..analysis? <type> <tag>) sample))))] [/.bit .Bit random.bit /analysis.bit] diff --git a/stdlib/source/test/lux/tool/compiler/meta/export.lux b/stdlib/source/test/lux/tool/compiler/meta/export.lux index 11a6ea9ce..2864dabfd 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/export.lux @@ -75,15 +75,19 @@ export_tar (# ! in (<binary>.result tar.parser export_tar))] (in [library_tar export_tar]))] ($_ _.and' - (_.cover' [/.library] + (_.cover' [/.library /.mode /.ownership] (|> it (try#each (|>> product.left sequence.list - (case> (^ (list {tar.#Normal [actual_path/0 _ _ _ actual_content/0]} - {tar.#Normal [actual_path/1 _ _ _ actual_content/1]})) + (case> (^ (list {tar.#Normal [actual_path/0 when/0 mode/0 ownership/0 actual_content/0]} + {tar.#Normal [actual_path/1 when/1 mode/1 ownership/1 actual_content/1]})) (with_expansions [<test> (and (and (text#= file/0' (tar.from_path actual_path/0)) + (same? /.mode mode/0) + (same? /.ownership ownership/0) (binary#= content/0 (tar.data actual_content/0))) (and (text#= file/1' (tar.from_path actual_path/1)) + (same? /.mode mode/1) + (same? /.ownership ownership/1) (binary#= content/1 (tar.data actual_content/1))))] (or <test> (let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]] diff --git a/stdlib/source/test/lux/tool/compiler/meta/import.lux b/stdlib/source/test/lux/tool/compiler/meta/import.lux new file mode 100644 index 000000000..7a24f9a82 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/import.lux @@ -0,0 +1,158 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception] + [concurrency + ["[0]" async]] + [parser + ["<[0]>" binary]]] + [data + ["[0]" product] + ["[0]" binary {"+" Binary} ("[1]#[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" format "_" + ["[0]" tar {"+" Tar}] + ["[1]" binary]] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}] + [encoding + ["[0]" utf8]]] + [collection + ["[0]" sequence] + ["[0]" dictionary]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [world + ["[0]" file]]]] + [\\library + ["[0]" / + [// + ["[0]" export] + ["[0]" io "_" + ["[1]" context]]]]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Import]) + (do [! random.monad] + [library/0 (random.ascii/lower 1) + library/1 (random.ascii/lower 2) + + .let [/ .module_separator + random_file (: (Random file.Path) + (# ! each (text.suffix io.lux_extension) (random.ascii/lower 3)))] + file/0 random_file + + dir/0 (random.ascii/lower 4) + file/1 (# ! each (|>> (format dir/0 /)) random_file) + + .let [random_content (: (Random Binary) + (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] + now random.instant + content/0 random_content + content/1 random_content + .let [library_content (|> (do try.monad + [file/0 (tar.path file/0) + file/1 (tar.path file/1) + content/0 (tar.content content/0) + content/1 (tar.content content/1)] + (in (|> (sequence.sequence {tar.#Normal [file/0 now export.mode export.ownership content/0]} + {tar.#Normal [file/1 now export.mode export.ownership content/1]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/0 (|> (do try.monad + [file/0 (tar.path file/0) + content/0 (tar.content content/0)] + (in (|> (sequence.sequence {tar.#Normal [file/0 now export.mode export.ownership content/0]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/1 (|> (do try.monad + [file/1 (tar.path file/1) + content/1 (tar.content content/1)] + (in (|> (sequence.sequence {tar.#Normal [file/1 now export.mode export.ownership content/1]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/-0 (|> (do try.monad + [file/0 (tar.path file/0) + content/0 (tar.content content/0)] + (in (|> (sequence.sequence {tar.#Contiguous [file/0 now export.mode export.ownership content/0]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/-1 (|> (do try.monad + [file/0 (tar.path file/0)] + (in (|> (sequence.sequence {tar.#Symbolic_Link file/0}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/-2 (|> (do try.monad + [file/0 (tar.path file/0)] + (in (|> (sequence.sequence {tar.#Directory file/0}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + imported? (: (-> /.Import Bit) + (function (_ it) + (and (n.= 2 (dictionary.size it)) + (|> it + (dictionary.value file/0) + (maybe#each (binary#= content/0)) + (maybe.else false)) + (|> it + (dictionary.value file/1) + (maybe#each (binary#= content/1)) + (maybe.else false)))))]] + ($_ _.and + (in (do [! async.monad] + [it/0 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content library/0)] + (/.import fs (list library/0))) + it/1 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/0 library/0) + _ (# fs write library_content/1 library/1)] + (/.import fs (list library/0 library/1)))] + (_.cover' [/.import] + (and (|> it/0 + (try#each imported?) + (try.else false)) + (|> it/1 + (try#each imported?) + (try.else false)))))) + (in (do [! async.monad] + [it (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content library/0) + _ (/.import fs (list library/0 library/0))] + (in false))] + (_.cover' [/.duplicate] + (exception.otherwise (exception.match? /.duplicate) it)))) + (in (do [! async.monad] + [it/0 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/-0 library/0) + _ (/.import fs (list library/0))] + (in false)) + it/1 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/-1 library/0) + _ (/.import fs (list library/0))] + (in false)) + it/2 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/-2 library/0) + _ (/.import fs (list library/0))] + (in false))] + (_.cover' [/.useless_tar_entry] + (and (exception.otherwise (exception.match? /.useless_tar_entry) it/0) + (exception.otherwise (exception.match? /.useless_tar_entry) it/1) + (exception.otherwise (exception.match? /.useless_tar_entry) it/2))))) + )))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 9d38c6f6d..818441adf 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -731,7 +731,7 @@ (_.cover [/.clean] (and (|> (do /.monad [[var_id varT] /.var - cleanedT (/.clean (type_shape varT))] + cleanedT (/.clean (list) (type_shape varT))] (in (type#= (type_shape varT) cleanedT))) (/.result /.fresh_context) @@ -740,7 +740,7 @@ [[var_id varT] /.var [_ replacementT] /.existential _ (/.check varT replacementT) - cleanedT (/.clean (type_shape varT))] + cleanedT (/.clean (list) (type_shape varT))] (in (type#= (type_shape replacementT) cleanedT))) (/.result /.fresh_context) |