From e1af5374ba4d969f866867db47af7ecf60cc9933 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 15 Jan 2022 02:17:35 -0400 Subject: Fixed a logging/reporting issue for Lux/JS. --- stdlib/source/library/lux/test.lux | 19 +++- .../library/lux/tool/compiler/default/init.lux | 2 +- .../library/lux/tool/compiler/default/platform.lux | 21 ++-- .../lux/tool/compiler/language/lux/analysis.lux | 32 +++--- .../compiler/language/lux/analysis/pattern.lux | 22 ++--- .../compiler/language/lux/analysis/primitive.lux | 62 ------------ .../tool/compiler/language/lux/analysis/simple.lux | 62 ++++++++++++ .../compiler/language/lux/phase/analysis/case.lux | 20 ++-- .../language/lux/phase/analysis/case/coverage.lux | 18 ++-- .../language/lux/phase/analysis/primitive.lux | 18 ++-- .../tool/compiler/language/lux/phase/synthesis.lux | 20 ++-- .../compiler/language/lux/phase/synthesis/case.lux | 20 ++-- .../lux/tool/compiler/meta/archive/document.lux | 13 ++- .../lux/tool/compiler/meta/cache/dependency.lux | 2 +- .../library/lux/tool/compiler/meta/io/archive.lux | 108 ++++++++++----------- stdlib/source/library/lux/world/console.lux | 53 ++++++++-- stdlib/source/program/aedifex/command/build.lux | 1 + stdlib/source/program/compositor.lux | 24 +++-- stdlib/source/test/lux/tool.lux | 8 +- .../compiler/language/lux/analysis/pattern.lux | 4 +- .../compiler/language/lux/analysis/primitive.lux | 45 --------- .../tool/compiler/language/lux/analysis/simple.lux | 45 +++++++++ .../lux/tool/compiler/meta/archive/document.lux | 93 ++++++++++++++++++ 23 files changed, 435 insertions(+), 277 deletions(-) delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/primitive.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/document.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 204e6db11..3b4203980 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -1,6 +1,7 @@ (.using [library [lux {"-" and for} + ["@" target] ["[0]" debug] [abstract ["[0]" monad {"+" do}]] @@ -38,7 +39,8 @@ ["[0]" meta ["[0]" symbol]] [world - ["[0]" program]]]]) + ["[0]" program] + ["[0]" console]]]]) (type: .public Tally (Record @@ -244,9 +246,18 @@ [tally documentation] (|> test (random.result prng) product.right) post (async.future instant.now) .let [duration (instant.span pre post) - _ (debug.log! (format documentation text.new_line text.new_line - (..description duration tally) - text.new_line))]] + report (format documentation + text.new_line text.new_line + (..description duration tally) + text.new_line)] + _ (with_expansions [ (in (debug.log! report))] + (.for [@.js (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console))] + ))] (async.future (# program.default exit (case (value@ #failures tally) 0 ..success_exit_code diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 952d1a13c..59d7ce5e0 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -258,7 +258,7 @@ descriptor.#registry final_registry]]] (in [state {.#Right [descriptor - (document.write key analysis_module) + (document.document key analysis_module) (sequence#each (function (_ [artifact_id custom directive]) [artifact_id custom (write_directive directive)]) final_buffer)]}])) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 6c38763b0..d78c5d4f7 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -28,7 +28,8 @@ [format ["_" binary {"+" Writer}]]] [world - ["[0]" file {"+" Path}]]]] + ["[0]" file {"+" Path}] + ["[0]" console]]]] ["[0]" // "_" ["[1][0]" init] ["/[1]" // @@ -111,7 +112,7 @@ (monad.each ..monad write_artifact!) (: (Action (List Any))))) document (# async.monad in - (document.check $.key document))] + (document.marked? $.key document))] (ioW.cache system static module_id (_.result ..writer [descriptor document]))))) @@ -140,7 +141,7 @@ (def: runtime_document (Document .Module) - (document.write $.key (module.empty 0))) + (document.document $.key (module.empty 0))) (def: (process_runtime archive platform) (All (_ ) @@ -541,7 +542,7 @@ [modules (monad.each ! (function (_ module) (do ! [[descriptor document output] (archive.find module archive) - lux_module (document.read $.key document)] + lux_module (document.content $.key document)] (in [module lux_module]))) (archive.archived archive)) .let [additions (|> modules @@ -673,8 +674,16 @@ {.#Right [descriptor document output]} (do ! - [.let [_ (debug.log! (..module_compilation_log module state)) - descriptor (with@ descriptor.#references all_dependencies descriptor)] + [_ (let [report (..module_compilation_log module state)] + (with_expansions [ (in (debug.log! report))] + (for [@.js (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console))] + ))) + .let [descriptor (with@ descriptor.#references all_dependencies descriptor)] _ (..cache_module static platform module_id [descriptor document output])] (case (archive.has module [descriptor document output] archive) {try.#Success archive} 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 cc373b65b..108c5670e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Primitive Tuple Variant nat int rev} + [lux {"-" Tuple Variant nat int rev} [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}] @@ -26,7 +26,7 @@ [meta ["[0]" location]]]] ["[0]" / "_" - ["[1][0]" primitive {"+" Primitive}] + ["[1][0]" simple {"+" Simple}] ["[1][0]" composite {"+" Tuple Variant Composite}] ["[1][0]" pattern {"+" Pattern}] [// @@ -53,7 +53,7 @@ (type: .public Analysis (Rec Analysis (.Variant - {#Primitive Primitive} + {#Simple Simple} {#Structure (Composite Analysis)} {#Reference Reference} {#Case Analysis (Match' Analysis)} @@ -79,8 +79,8 @@ (def: (= reference sample) (case [reference sample] - [{#Primitive reference} {#Primitive sample}] - (# /primitive.equivalence = reference sample) + [{#Simple reference} {#Simple sample}] + (# /simple.equivalence = reference sample) [{#Structure reference} {#Structure sample}] (# (/composite.equivalence =) = reference sample) @@ -117,18 +117,18 @@ ) (template: .public (unit) - [{..#Primitive {/primitive.#Unit}}]) + [{..#Simple {/simple.#Unit}}]) (template [ ] [(template: .public ( value) - [{..#Primitive { value}}])] - - [bit /primitive.#Bit] - [nat /primitive.#Nat] - [int /primitive.#Int] - [rev /primitive.#Rev] - [frac /primitive.#Frac] - [text /primitive.#Text] + [{..#Simple { value}}])] + + [bit /simple.#Bit] + [nat /simple.#Nat] + [int /simple.#Int] + [rev /simple.#Rev] + [frac /simple.#Frac] + [text /simple.#Text] ) (type: .public (Abstraction c) @@ -189,8 +189,8 @@ (def: .public (%analysis analysis) (Format Analysis) (case analysis - {#Primitive it} - (/primitive.format it) + {#Simple it} + (/simple.format it) {#Structure it} (/composite.format %analysis it) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux index d2b57321f..9aaf606ac 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -1,13 +1,13 @@ (.using [library - [lux {"-" Primitive nat int rev} + [lux {"-" nat int rev} [abstract [equivalence {"+" Equivalence}]] [math [number ["n" nat]]]]] ["[0]" // "_" - ["[1][0]" primitive {"+" Primitive}] + ["[1][0]" simple {"+" Simple}] ["[1][0]" composite {"+" Composite}] [//// [reference @@ -16,7 +16,7 @@ (type: .public Pattern (Rec Pattern (.Variant - {#Simple Primitive} + {#Simple Simple} {#Complex (Composite Pattern)} {#Bind Register}))) @@ -26,7 +26,7 @@ (def: (= reference sample) (case [reference sample] [{#Simple reference} {#Simple sample}] - (# //primitive.equivalence = reference sample) + (# //simple.equivalence = reference sample) [{#Complex reference} {#Complex sample}] (# (//composite.equivalence =) = reference sample) @@ -48,18 +48,18 @@ ) (template: .public (unit) - [{..#Simple {//primitive.#Unit}}]) + [{..#Simple {//simple.#Unit}}]) (template [ ] [(template: .public ( content) [{..#Simple { content}}])] - [bit //primitive.#Bit] - [nat //primitive.#Nat] - [int //primitive.#Int] - [rev //primitive.#Rev] - [frac //primitive.#Frac] - [text //primitive.#Text] + [bit //simple.#Bit] + [nat //simple.#Nat] + [int //simple.#Int] + [rev //simple.#Rev] + [frac //simple.#Frac] + [text //simple.#Text] ) (template: .public (bind register) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/primitive.lux deleted file mode 100644 index b4eca6b5e..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/primitive.lux +++ /dev/null @@ -1,62 +0,0 @@ -(.using - [library - [lux {"-" Primitive} - [abstract - [equivalence {"+" Equivalence}]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" Format}]]] - [math - [number - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac]]]]]) - -(type: .public Primitive - (Variant - {#Unit} - {#Bit Bit} - {#Nat Nat} - {#Int Int} - {#Rev Rev} - {#Frac Frac} - {#Text Text})) - -(implementation: .public equivalence - (Equivalence Primitive) - - (def: (= reference sample) - (case [reference sample] - [{#Unit} {#Unit}] - true - - (^template [ <=>] - [[{ reference} { sample}] - (<=> reference sample)]) - ([#Bit bit#=] - [#Nat n.=] - [#Int i.=] - [#Rev r.=] - [#Frac f.=] - [#Text text#=]) - - _ - false))) - -(def: .public (format it) - (Format Primitive) - (case it - {#Unit} - "[]" - - (^template [ ] - [{ value} - ( value)]) - ([#Bit %.bit] - [#Nat %.nat] - [#Int %.int] - [#Rev %.rev] - [#Frac %.frac] - [#Text %.text]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux new file mode 100644 index 000000000..192e6552f --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux @@ -0,0 +1,62 @@ +(.using + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" Format}]]] + [math + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]]]]) + +(type: .public Simple + (Variant + {#Unit} + {#Bit Bit} + {#Nat Nat} + {#Int Int} + {#Rev Rev} + {#Frac Frac} + {#Text Text})) + +(implementation: .public equivalence + (Equivalence Simple) + + (def: (= reference sample) + (case [reference sample] + [{#Unit} {#Unit}] + true + + (^template [ <=>] + [[{ reference} { sample}] + (<=> reference sample)]) + ([#Bit bit#=] + [#Nat n.=] + [#Int i.=] + [#Rev r.=] + [#Frac f.=] + [#Text text#=]) + + _ + false))) + +(def: .public (format it) + (Format Simple) + (case it + {#Unit} + "[]" + + (^template [ ] + [{ value} + ( value)]) + ([#Bit %.bit] + [#Nat %.nat] + [#Int %.int] + [#Rev %.rev] + [#Frac %.frac] + [#Text %.text]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index 4bca0ffcd..03ff2ea6e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -31,7 +31,7 @@ ["[1][0]" extension] [// ["/" analysis {"+" Analysis Operation Phase} - ["[1][0]" primitive] + ["[1][0]" simple] ["[1][0]" composite] ["[1][0]" pattern {"+" Pattern}]] [/// @@ -147,7 +147,7 @@ _ (# ///.monad in (re_quantify envs caseT))))) -(def: (analyse_primitive type inputT location output next) +(def: (analyse_simple type inputT location output next) (All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) (/.with_location location (do ///.monad @@ -235,14 +235,14 @@ (^template [ ] [[location ] - (analyse_primitive inputT location {/pattern.#Simple } next)]) - ([Bit {.#Bit pattern_value} {/primitive.#Bit pattern_value}] - [Nat {.#Nat pattern_value} {/primitive.#Nat pattern_value}] - [Int {.#Int pattern_value} {/primitive.#Int pattern_value}] - [Rev {.#Rev pattern_value} {/primitive.#Rev pattern_value}] - [Frac {.#Frac pattern_value} {/primitive.#Frac pattern_value}] - [Text {.#Text pattern_value} {/primitive.#Text pattern_value}] - [Any {.#Tuple {.#End}} {/primitive.#Unit}]) + (analyse_simple inputT location {/pattern.#Simple } next)]) + ([Bit {.#Bit pattern_value} {/simple.#Bit pattern_value}] + [Nat {.#Nat pattern_value} {/simple.#Nat pattern_value}] + [Int {.#Int pattern_value} {/simple.#Int pattern_value}] + [Rev {.#Rev pattern_value} {/simple.#Rev pattern_value}] + [Frac {.#Frac pattern_value} {/simple.#Frac pattern_value}] + [Text {.#Text pattern_value} {/simple.#Text pattern_value}] + [Any {.#Tuple {.#End}} {/simple.#Unit}]) (^ [location {.#Tuple (list singleton)}]) (analyse_pattern {.#None} inputT singleton next) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index 15bb062a4..aa66b8c01 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -25,7 +25,7 @@ ["[0]" //// "_" [// ["/" analysis {"+" Operation} - ["[1][0]" primitive] + ["[1][0]" simple] ["[1][0]" composite] ["[1][0]" pattern {"+" Pattern}]] [/// @@ -117,25 +117,25 @@ (def: .public (determine pattern) (-> Pattern (Operation Coverage)) (case pattern - (^or {/pattern.#Simple {/primitive.#Unit}} + (^or {/pattern.#Simple {/simple.#Unit}} {/pattern.#Bind _}) (////#in {#Exhaustive}) - ... Primitive patterns always have partial coverage because there + ... Simple patterns always have partial coverage because there ... are too many possibilities as far as values go. (^template [ ] [{/pattern.#Simple { it}} (////#in { (set.of_list (list it))})]) - ([/primitive.#Nat #Nat n.hash] - [/primitive.#Int #Int i.hash] - [/primitive.#Rev #Rev r.hash] - [/primitive.#Frac #Frac f.hash] - [/primitive.#Text #Text text.hash]) + ([/simple.#Nat #Nat n.hash] + [/simple.#Int #Int i.hash] + [/simple.#Rev #Rev r.hash] + [/simple.#Frac #Frac f.hash] + [/simple.#Text #Text text.hash]) ... Bits are the exception, since there is only "#1" and ... "#0", which means it is possible for bit ... pattern-matching to become exhaustive if complementary parts meet. - {/pattern.#Simple {/primitive.#Bit value}} + {/pattern.#Simple {/simple.#Bit value}} (////#in {#Bit value}) ... Tuple patterns can be exhaustive if there is exhaustiveness for all of diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index 547d23a8e..69984ab22 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -8,7 +8,7 @@ ["/[1]" // "_" [// ["/" analysis {"+" Analysis Operation} - ["[1][0]" primitive]] + ["[1][0]" simple]] [/// ["[1]" phase]]]]]) @@ -17,18 +17,18 @@ (-> (Operation Analysis)) (do ///.monad [_ (//type.infer )] - (in {/.#Primitive { value}})))] + (in {/.#Simple { value}})))] - [bit .Bit /primitive.#Bit] - [nat .Nat /primitive.#Nat] - [int .Int /primitive.#Int] - [rev .Rev /primitive.#Rev] - [frac .Frac /primitive.#Frac] - [text .Text /primitive.#Text] + [bit .Bit /simple.#Bit] + [nat .Nat /simple.#Nat] + [int .Int /simple.#Int] + [rev .Rev /simple.#Rev] + [frac .Frac /simple.#Frac] + [text .Text /simple.#Text] ) (def: .public unit (Operation Analysis) (do ///.monad [_ (//type.infer .Any)] - (in {/.#Primitive {/primitive.#Unit}}))) + (in {/.#Simple {/simple.#Unit}}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux index e8aec1a83..7edfdb599 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -19,7 +19,7 @@ ["/[1]" // "_" ["/" synthesis {"+" Synthesis Phase}] ["[1][0]" analysis {"+" Analysis} - ["[2][0]" primitive] + ["[2][0]" simple] ["[2][0]" composite]] [/// ["[0]" phase ("[1]#[0]" monad)] @@ -27,30 +27,30 @@ [variable {"+"}]]]]]]) (def: (primitive analysis) - (-> ///primitive.Primitive /.Primitive) + (-> ///simple.Simple /.Primitive) (case analysis - {///primitive.#Unit} + {///simple.#Unit} {/.#Text /.unit} (^template [ ] [{ value} { value}]) - ([///primitive.#Bit /.#Bit] - [///primitive.#Frac /.#F64] - [///primitive.#Text /.#Text]) + ([///simple.#Bit /.#Bit] + [///simple.#Frac /.#F64] + [///simple.#Text /.#Text]) (^template [ ] [{ value} { (.i64 value)}]) - ([///primitive.#Nat /.#I64] - [///primitive.#Int /.#I64] - [///primitive.#Rev /.#I64]))) + ([///simple.#Nat /.#I64] + [///simple.#Int /.#I64] + [///simple.#Rev /.#I64]))) (def: (optimization archive) Phase (function (optimization' analysis) (case analysis - {///analysis.#Primitive analysis'} + {///analysis.#Simple analysis'} (phase#in {/.#Primitive (..primitive analysis')}) {///analysis.#Reference reference} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 47d9fbe79..89d432d68 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -22,7 +22,7 @@ [// ["/" synthesis {"+" Path Synthesis Operation Phase}] ["[1][0]" analysis {"+" Match Analysis} - ["[2][0]" primitive] + ["[2][0]" simple] ["[2][0]" composite] ["[2][0]" pattern {"+" Pattern}]] [/// @@ -41,10 +41,10 @@ (case pattern {///pattern.#Simple simple} (case simple - {///primitive.#Unit} + {///simple.#Unit} thenC - {///primitive.#Bit when} + {///simple.#Bit when} (///#each (function (_ then) {/.#Bit_Fork when then {.#None}}) thenC) @@ -54,11 +54,11 @@ (///#each (function (_ then) { [( test) then] (list)}) thenC)]) - ([///primitive.#Nat /.#I64_Fork .i64] - [///primitive.#Int /.#I64_Fork .i64] - [///primitive.#Rev /.#I64_Fork .i64] - [///primitive.#Frac /.#F64_Fork |>] - [///primitive.#Text /.#Text_Fork |>])) + ([///simple.#Nat /.#I64_Fork .i64] + [///simple.#Int /.#I64_Fork .i64] + [///simple.#Rev /.#I64_Fork .i64] + [///simple.#Frac /.#F64_Fork |>] + [///simple.#Text /.#Text_Fork |>])) {///pattern.#Bind register} (<| (# ///.monad each (|>> {/.#Seq {/.#Bind register}})) @@ -77,7 +77,7 @@ (let [tuple::last (-- (list.size tuple))] (list#mix (function (_ [tuple::lefts tuple::member] nextC) (.case tuple::member - {///pattern.#Simple {///primitive.#Unit}} + {///pattern.#Simple {///simple.#Unit}} nextC _ @@ -209,7 +209,7 @@ {.#Item head tail} (case head - {///pattern.#Simple {///primitive.#Unit}} + {///pattern.#Simple {///simple.#Unit}} {///pattern.#Bind register} diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux index 1171852cb..432e1573c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [abstract [monad {"+" do}]] [control @@ -17,8 +17,7 @@ abstract]]] [// ["[0]" signature {"+" Signature}] - ["[0]" key {"+" Key}] - [descriptor {"+" Module}]]) + ["[0]" key {"+" Key}]]) (exception: .public (invalid_signature [expected Signature actual Signature]) @@ -31,7 +30,7 @@ [#signature Signature #content d]) - (def: .public (read key document) + (def: .public (content key document) (All (_ d) (-> (Key d) (Document Any) (Try d))) (let [[document//signature document//content] (:representation document)] (if (# signature.equivalence = @@ -46,15 +45,15 @@ (exception.except ..invalid_signature [(key.signature key) document//signature])))) - (def: .public (write key content) + (def: .public (document key content) (All (_ d) (-> (Key d) d (Document d))) (:abstraction [#signature (key.signature key) #content content])) - (def: .public (check key document) + (def: .public (marked? key document) (All (_ d) (-> (Key d) (Document Any) (Try (Document d)))) (do try.monad - [_ (..read key document)] + [_ (..content key document)] (in (:expected document)))) (def: .public signature diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux index 6e8a800ec..dd4b64aa4 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux @@ -94,5 +94,5 @@ (do try.monad [module_id (archive.id module archive) [descriptor document output] (archive.find module archive) - document (document.check key document)] + document (document.marked? key document)] (in [module [module_id [descriptor document output]]]))))))) 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 ee222ea36..55c03a050 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -1,55 +1,55 @@ (.using - [library - [lux {"-" Module} - [target {"+" Target}] - [abstract - [predicate {"+" Predicate}] - ["[0]" monad {"+" do}]] - [control - [pipe {"+" case>}] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - [concurrency - ["[0]" async {"+" Async} ("[1]#[0]" monad)]] - ["<>" parser - ["<[0]>" binary {"+" Parser}]]] - [data - [binary {"+" Binary}] - ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence {"+" Sequence}] - ["[0]" set]]] - [math - [number - ["n" nat]]] - [world - ["[0]" file]]]] - [program - [compositor - [import {"+" Import}] - ["[0]" static {"+" Static}]]] - ["[0]" // {"+" Context} - ["[1][0]" context] - ["/[1]" // - ["[0]" archive {"+" Output Archive} - ["[0]" artifact {"+" Artifact}] - ["[0]" descriptor {"+" Module Descriptor}] - ["[0]" document {"+" Document}]] - [cache - ["[0]" dependency]] - ["/[1]" // {"+" Input} - [language - ["$" lux - ["[0]" version] - ["[0]" analysis] - ["[0]" synthesis] - ["[0]" generation] - ["[0]" directive] - ["[1]/[0]" program]]]]]]) + [library + [lux {"-" Module} + [target {"+" Target}] + [abstract + [predicate {"+" Predicate}] + ["[0]" monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + [concurrency + ["[0]" async {"+" Async} ("[1]#[0]" monad)]] + ["<>" parser + ["<[0]>" binary {"+" Parser}]]] + [data + [binary {"+" Binary}] + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence {"+" Sequence}] + ["[0]" set]]] + [math + [number + ["n" nat]]] + [world + ["[0]" file]]]] + [program + [compositor + [import {"+" Import}] + ["[0]" static {"+" Static}]]] + ["[0]" // {"+" Context} + ["[1][0]" context] + ["/[1]" // + ["[0]" archive {"+" Output Archive} + ["[0]" artifact {"+" Artifact}] + ["[0]" descriptor {"+" Module Descriptor}] + ["[0]" document {"+" Document}]] + [cache + ["[0]" dependency]] + ["/[1]" // {"+" Input} + [language + ["$" lux + ["[0]" version] + ["[0]" analysis] + ["[0]" synthesis] + ["[0]" generation] + ["[0]" directive] + ["[1]/[0]" program]]]]]]) (exception: .public (cannot_prepare [archive file.Path module_id archive.ID @@ -171,7 +171,7 @@ (monad.each ! (function (_ module) (do ! [[descriptor document output] (archive.find module archive) - content (document.read $.key document)] + content (document.content $.key document)] (in [module content]))) (archive.archived archive)))] (in (with@ .#modules modules (fresh_analysis_state host))))) @@ -320,7 +320,7 @@ {.#End} {try.#Success [definitions bundles output]})))) - content (document.read $.key document) + content (document.content $.key document) definitions (monad.each ! (function (_ [def_name def_global]) (case def_global (^template [] @@ -345,7 +345,7 @@ (# ! each (function (_ def_value) [def_name {.#Type [exported? (:as .Type def_value) labels]}]))))) (value@ .#definitions content))] - (in [(document.write $.key (with@ .#definitions definitions content)) + (in [(document.document $.key (with@ .#definitions definitions content)) bundles]))) (def: (load_definitions fs static module_id host_environment descriptor document) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index fd53c6a8a..8a3372e61 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -1,8 +1,8 @@ (.using [library [lux "*" - [ffi {"+" import:}] ["@" target] + ["[0]" ffi {"+" import:}] [abstract [monad {"+" do}]] [control @@ -10,7 +10,7 @@ ["[0]" exception {"+" exception:}] ["[0]" io {"+" IO io}] [concurrency - ["[0]" async {"+" Async}] + ["[0]" async {"+" Async} ("[1]#[0]" monad)] ["[0]" atom]]] [data ["[0]" text {"+" Char} @@ -39,6 +39,8 @@ [write] [close]))))) +(exception: .public cannot_close) + (with_expansions [ (as_is (import: java/lang/String) (import: java/io/Console @@ -59,12 +61,7 @@ ("static" in java/io/InputStream) ("static" out java/io/PrintStream)]) - (template [] - [(exception: .public )] - - [cannot_open] - [cannot_close] - ) + (exception: .public cannot_open) (def: .public default (IO (Try (Console IO))) @@ -95,7 +92,45 @@ (def: close (|>> (exception.except ..cannot_close) in)))))))))] (for [@.old (as_is ) - @.jvm (as_is )] + @.jvm (as_is ) + @.js (as_is (ffi.import: Readable + ["[1]::[0]"]) + + (ffi.import: Writable + ["[1]::[0]" + (write [ffi.String ffi.Function] ffi.Boolean) + (once [ffi.String ffi.Function] Any)]) + + (ffi.import: process + ["[1]::[0]" + ("static" stdout Writable) + ("static" stdin Readable)]) + + ... TODO: Implement fully. https://nodejs.org/api/readline.html + (exception: .public cannot_read) + + (def: .public default + (Maybe (Console Async)) + (if ffi.on_node_js? + {.#Some (implementation + (def: read + (|>> (exception.except ..cannot_read) async#in)) + + (def: read_line + (|>> (exception.except ..cannot_read) async#in)) + + (def: (write it) + (let [[read! write!] (: [(async.Async (Try [])) (async.Resolver (Try []))] + (async.async []))] + (exec + (Writable::write [it + (ffi.closure [] (io.run! (write! {try.#Success []})))] + (process::stdout)) + read!))) + + (def: close + (|>> (exception.except ..cannot_close) async#in)))} + {.#None})))] (as_is))) (def: .public (write_line message console) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 15a671615..ba461d461 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -202,6 +202,7 @@ ... But it's written this way because the more straightforward way (i.e. by using (try.with async.monad)) ... eventually led to the function hanging/freezing. ... I'm not sure why it happened, but I got this weirder implementation to work. + ... TODO: Improve this implementation. (let [[read! write!] (: [(Async (Try Any)) (async.Resolver (Try Any))] (async.async [])) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 54fc903ad..2b6850cf8 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -22,9 +22,8 @@ ["[0]" instant]] ["[0]" world "_" ["[0]" file] - ["[1]/[0]" program] - ... ["[0]" console] - ] + ["[0]" console] + ["[1]/[0]" program]] [tool [compiler ["[0]" phase] @@ -59,14 +58,23 @@ (def: (or_crash! failure_description action) (All (_ a) (-> Text (Async (Try a)) (Async a))) - (do async.monad + (do [! async.monad] [?output action] (case ?output {try.#Failure error} - (exec (debug.log! (format text.new_line - failure_description text.new_line - error text.new_line)) - (io.run! (# world/program.default exit +1))) + (let [report (format text.new_line + failure_description text.new_line + error text.new_line)] + (do ! + [_ (with_expansions [ (in (debug.log! report))] + (for [@.js (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console))] + ))] + (io.run! (# world/program.default exit +1)))) {try.#Success output} (in output)))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 79d25b75e..736c8757c 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -12,7 +12,7 @@ [lux ... ["[1][0]" syntax] ["[1][0]" analysis "_" - ["[1]/[0]" primitive] + ["[1]/[0]" simple] ["[1]/[0]" composite] ["[1]/[0]" pattern]] ... [phase @@ -22,7 +22,8 @@ ["[1][0]" meta "_" ["[1]/[0]" archive "_" ["[1]/[0]" signature] - ["[1]/[0]" key]]] + ["[1]/[0]" key] + ["[1]/[0]" document]]] ]]) (def: .public test @@ -32,11 +33,12 @@ /version.test /reference.test /phase.test - /analysis/primitive.test + /analysis/simple.test /analysis/composite.test /analysis/pattern.test /meta/archive/signature.test /meta/archive/key.test + /meta/archive/document.test ... /syntax.test ... /analysis.test ... /synthesis.test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux index b4ee9e9c8..7a1d4c66d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -16,7 +16,7 @@ [\\library ["[0]" /]] ["[0]" // "_" - ["[1][0]" primitive] + ["[1][0]" simple] ["[1][0]" composite]]) (def: .public random @@ -24,7 +24,7 @@ (random.rec (function (_ random) ($_ random.or - //primitive.random + //simple.random (//composite.random 4 random) random.nat )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/primitive.lux deleted file mode 100644 index 3c88cd1e5..000000000 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/primitive.lux +++ /dev/null @@ -1,45 +0,0 @@ -(.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)] - [number - ["f" frac]]]]] - [\\library - ["[0]" /]]) - -(def: .public random - (Random /.Primitive) - ($_ random.or - (random#in []) - random.bit - random.nat - random.int - random.rev - (random.only (|>> f.not_a_number? not) random.frac) - (random.ascii/lower 5) - )) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [/.Primitive]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [left ..random - right ..random] - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right))))) - ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux new file mode 100644 index 000000000..e7c22559f --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux @@ -0,0 +1,45 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["f" frac]]]]] + [\\library + ["[0]" /]]) + +(def: .public random + (Random /.Simple) + ($_ random.or + (random#in []) + random.bit + random.nat + random.int + random.rev + (random.only (|>> f.not_a_number? not) random.frac) + (random.ascii/lower 5) + )) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Simple]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [left ..random + right ..random] + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right))))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux new file mode 100644 index 000000000..749dcdd09 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux @@ -0,0 +1,93 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception] + [parser + ["<[0]>" binary]]] + [data + [format + ["[0]F" binary]]] + [math + ["[0]" random] + [number + ["[0]" nat]]]]] + [\\library + ["[0]" / + [// + ["[1][0]" signature ("[1]#[0]" equivalence)] + ["[1][0]" key]]]] + ["[0]" // "_" + ["[1][0]" signature]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Document]) + (do random.monad + [signature/0 //signature.random + signature/1 (random.only (|>> (/signature#= signature/0) not) + //signature.random) + .let [key/0 (/key.key signature/0 0) + key/1 (/key.key signature/1 0)] + expected random.nat] + ($_ _.and + (_.cover [/.document /.content] + (|> expected + (/.document key/0) + (/.content key/0) + (try#each (same? expected)) + (try.else false))) + (_.cover [/.signature] + (|> expected + (/.document key/0) + /.signature + (same? signature/0))) + (_.cover [/.marked?] + (and (|> expected + (/.document key/0) + (/.marked? key/0) + (case> {try.#Success it} true + {try.#Failure error} false)) + (|> expected + (/.document key/0) + (/.marked? key/1) + (case> {try.#Success it} false + {try.#Failure error} true)))) + (_.cover [/.invalid_signature] + (and (|> expected + (/.document key/0) + (/.content key/1) + (case> {try.#Success it} + false + + {try.#Failure error} + (exception.match? /.invalid_signature error))) + (|> expected + (/.document key/0) + (/.marked? key/1) + (case> {try.#Success it} + false + + {try.#Failure error} + (exception.match? /.invalid_signature error))))) + (_.cover [/.writer /.parser] + (|> expected + (/.document key/0) + (binaryF.result (/.writer binaryF.nat)) + (.result (/.parser .nat)) + (case> {try.#Success it} + (and (/signature#= signature/0 (/.signature it)) + (|> it + (/.content key/0) + (try#each (nat.= expected)) + (try.else false))) + + {try.#Failure error} + false))) + )))) -- cgit v1.2.3