diff options
author | Eduardo Julian | 2022-02-11 19:57:00 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-02-11 19:57:00 -0400 |
commit | 105ab334201646be6b594d3d1215297e3b629a10 (patch) | |
tree | d1f972d5fe676f8b93f4efa8fb0a8ce602878903 /stdlib/source/library/lux/tool | |
parent | 469b171e5793422a4dbd27f4f2fab8a261c9ccf9 (diff) |
Fixed directive extensions for Lux/Python.
Diffstat (limited to 'stdlib/source/library/lux/tool')
12 files changed, 226 insertions, 61 deletions
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/library/lux/tool/compiler/meta/import.lux b/stdlib/source/library/lux/tool/compiler/meta/import.lux new file mode 100644 index 000000000..d3a356c43 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/import.lux @@ -0,0 +1,74 @@ +(.using + [library + [lux {"-" Module} + [abstract + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + [concurrency + ["[0]" async {"+" Async}]] + ["<>" parser + ["<[0]>" binary]]] + [data + [binary {"+" Binary}] + ["[0]" text + ["%" format]] + [collection + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence]] + [format + ["[0]" tar]]] + [tool + [compiler + [meta + [cli {"+" Library Module}]]]] + [world + ["[0]" file]]]]) + +(def: Action + (type (All (_ a) (Async (Try a))))) + +(exception: .public useless_tar_entry) + +(exception: .public (duplicate [library Library + module Module]) + (exception.report + ["Module" (%.text module)] + ["Library" (%.text library)])) + +(type: .public Import + (Dictionary file.Path Binary)) + +(def: (import_library system library import) + (-> (file.System Async) Library Import (Action Import)) + (let [! async.monad] + (|> library + (# system read) + (# ! each (let [! try.monad] + (|>> (# ! each (<binary>.result tar.parser)) + (# ! conjoint) + (# ! each (|>> sequence.list + (monad.mix ! (function (_ entry import) + (case entry + {tar.#Normal [path instant mode ownership content]} + (let [path (tar.from_path path)] + (case (dictionary.has' path (tar.data content) import) + {try.#Failure error} + (exception.except ..duplicate [library path]) + + import' + import')) + + _ + (exception.except ..useless_tar_entry []))) + import))) + (# ! conjoint))))))) + +(def: .public (import system libraries) + (-> (file.System Async) (List Library) (Action Import)) + (monad.mix (: (Monad Action) + (try.with async.monad)) + (..import_library system) + (dictionary.empty text.hash) + libraries)) 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 |