From f47fb7404bcbd9fac5df8697e57e08f03ec468ac Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 19 Jan 2022 06:06:10 -0400 Subject: Fixes for the pure-Lux JVM compiler machinery. [Part 8] --- .../lux/tool/compiler/language/lux/analysis.lux | 4 +- stdlib/source/library/lux.lux | 124 ++++-- .../source/library/lux/control/parser/analysis.lux | 9 +- stdlib/source/library/lux/data/text/escape.lux | 38 +- stdlib/source/library/lux/target/ruby.lux | 53 ++- .../lux/tool/compiler/language/lux/analysis.lux | 102 ++--- .../compiler/language/lux/analysis/complex.lux | 98 +++++ .../compiler/language/lux/analysis/composite.lux | 98 ----- .../compiler/language/lux/analysis/pattern.lux | 27 +- .../compiler/language/lux/phase/analysis/case.lux | 6 +- .../language/lux/phase/analysis/case/coverage.lux | 6 +- .../language/lux/phase/analysis/inference.lux | 2 +- .../language/lux/phase/analysis/module.lux | 14 +- .../language/lux/phase/analysis/reference.lux | 10 +- .../language/lux/phase/analysis/structure.lux | 6 +- .../tool/compiler/language/lux/phase/extension.lux | 53 ++- .../language/lux/phase/extension/analysis/jvm.lux | 31 +- .../language/lux/phase/extension/directive/jvm.lux | 116 ++++-- .../language/lux/phase/generation/jvm/case.lux | 3 +- .../lux/phase/generation/jvm/structure.lux | 2 +- .../language/lux/phase/generation/ruby/runtime.lux | 19 +- .../tool/compiler/language/lux/phase/synthesis.lux | 10 +- .../compiler/language/lux/phase/synthesis/case.lux | 12 +- .../language/lux/phase/synthesis/function.lux | 6 +- .../compiler/language/lux/phase/synthesis/loop.lux | 14 +- .../language/lux/phase/synthesis/variable.lux | 18 +- .../lux/tool/compiler/language/lux/synthesis.lux | 16 +- .../lux/tool/compiler/meta/archive/dependency.lux | 8 +- stdlib/source/test/lux/data.lux | 44 +-- stdlib/source/test/lux/data/text/escape.lux | 62 +-- stdlib/source/test/lux/target/ruby.lux | 68 +++- stdlib/source/test/lux/tool.lux | 9 +- .../lux/tool/compiler/language/lux/analysis.lux | 439 +++++++++++++++++++++ .../compiler/language/lux/analysis/complex.lux | 76 ++++ .../compiler/language/lux/analysis/composite.lux | 76 ---- .../compiler/language/lux/analysis/pattern.lux | 4 +- .../compiler/language/lux/phase/synthesis/case.lux | 108 ++--- 37 files changed, 1239 insertions(+), 552 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/composite.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/composite.lux (limited to 'stdlib') diff --git a/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux index 92f6991ab..153ed2a11 100644 --- a/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/documentation/lux/tool/compiler/language/lux/analysis.lux @@ -31,7 +31,7 @@ ($.default /.composite_equivalence) ($.default /.composite_hash) ($.default /.equivalence) - ($.default /.control/case) + ($.default /.case) ($.default /.unit) ($.default /.bit) ($.default /.nat) @@ -60,7 +60,7 @@ ($.default /.pattern/frac) ($.default /.pattern/text) ($.default /.pattern/bind) - ($.default /.%analysis) + ($.default /.format) ($.default /.State+) ($.default /.Operation) ($.default /.Phase) diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 9655f0afa..4ae552aba 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -2079,42 +2079,98 @@ (in_meta (list token))} token)) -(def:''' .private (full_expansion syntax) - (-> Code ($' Meta ($' List Code))) - ({[_ {#Form {#Item [_ {#Symbol name}] args}}] - (do meta_monad - [name' (normal name) - ?macro (macro' name')] - ({{#Some macro} - (do meta_monad - [expansion (("lux type as" Macro' macro) args) - expansion' (monad#each meta_monad full_expansion expansion)] - (in (list#conjoint expansion'))) - - {#None} - (do meta_monad - [args' (monad#each meta_monad full_expansion args)] - (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} - ?macro)) +(def:''' .private (full_expansion' full_expansion name args) + (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) + (do meta_monad + [name' (normal name) + ?macro (macro' name')] + ({{#Some macro} + (do meta_monad + [expansion (("lux type as" Macro' macro) args) + expansion' (monad#each meta_monad full_expansion expansion)] + (in (list#conjoint expansion'))) + + {#None} + (do meta_monad + [args' (monad#each meta_monad full_expansion args)] + (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} + ?macro))) - [_ {#Form members}] - (do meta_monad - [members' (monad#each meta_monad full_expansion members)] - (in (list (form$ (list#conjoint members'))))) +(def:''' .private (in_module module meta) + (All (_ a) + (-> Text ($' Meta a) ($' Meta a))) + (function' [lux] + ({[..#info info ..#source source + ..#current_module current_module ..#modules modules + ..#scopes scopes ..#type_context type_context + ..#host host ..#seed seed + ..#expected expected ..#location location + ..#extensions extensions ..#scope_type_vars scope_type_vars + ..#eval eval] + ({{#Left error} + {#Left error} + + {#Right [[..#info info' ..#source source' + ..#current_module _ ..#modules modules' + ..#scopes scopes' ..#type_context type_context' + ..#host host' ..#seed seed' + ..#expected expected' ..#location location' + ..#extensions extensions' ..#scope_type_vars scope_type_vars' + ..#eval eval'] + output]} + {#Right [[..#info info' ..#source source' + ..#current_module current_module ..#modules modules' + ..#scopes scopes' ..#type_context type_context' + ..#host host' ..#seed seed' + ..#expected expected' ..#location location' + ..#extensions extensions' ..#scope_type_vars scope_type_vars' + ..#eval eval'] + output]}} + (meta [..#info info ..#source source + ..#current_module {.#Some module} ..#modules modules + ..#scopes scopes ..#type_context type_context + ..#host host ..#seed seed + ..#expected expected ..#location location + ..#extensions extensions ..#scope_type_vars scope_type_vars + ..#eval eval]))} + lux))) + +(def:''' .private (full_expansion expand_in_module?) + (-> Bit Code ($' Meta ($' List Code))) + (function' again [syntax] + ({[_ {#Form {#Item head tail}}] + ({[_ {#Form {#Item [_ {#Text "lux in-module"}] + {#Item [_ {#Text module}] + {#Item [_ {#Symbol name}] + {#End}}}}}] + (if expand_in_module? + (..in_module module (..full_expansion' again name tail)) + (do meta_monad + [members' (monad#each meta_monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))) + + [_ {#Symbol name}] + (..full_expansion' again name tail) - [_ {#Variant members}] - (do meta_monad - [members' (monad#each meta_monad full_expansion members)] - (in (list (variant$ (list#conjoint members'))))) + _ + (do meta_monad + [members' (monad#each meta_monad again {#Item head tail})] + (in (list (form$ (list#conjoint members')))))} + head) - [_ {#Tuple members}] - (do meta_monad - [members' (monad#each meta_monad full_expansion members)] - (in (list (tuple$ (list#conjoint members'))))) + [_ {#Variant members}] + (do meta_monad + [members' (monad#each meta_monad again members)] + (in (list (variant$ (list#conjoint members'))))) - _ - (in_meta (list syntax))} - syntax)) + [_ {#Tuple members}] + (do meta_monad + [members' (monad#each meta_monad again members)] + (in (list (tuple$ (list#conjoint members'))))) + + _ + (in_meta (list syntax))} + syntax))) (def:''' .private (text#encoded original) (-> Text Text) @@ -2218,7 +2274,7 @@ [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] (if initialized_quantification? (do meta_monad - [type+ (full_expansion type)] + [type+ (full_expansion #0 type)] ({{#Item type' {#End}} (in (list (normal_type type'))) @@ -2381,7 +2437,7 @@ (case tokens {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} (do meta_monad - [pattern+ (full_expansion pattern)] + [pattern+ (full_expansion #1 pattern)] (case pattern+ {#Item pattern' {#End}} (in (list& pattern' body branches)) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index 73889de68..fbe5f943c 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -30,24 +30,23 @@ [variable {"+" }]] [language [lux - ["/" analysis {"+" Environment Analysis} - ["[1][0]" composite]]]]]]]] + ["/" analysis {"+" Environment Analysis}]]]]]]] ["[0]" //]) (def: (remaining_inputs asts) (-> (List Analysis) Text) (format text.new_line "Remaining input: " (|> asts - (list#each /.%analysis) + (list#each /.format) (text.interposed " ")))) (exception: .public (cannot_parse [input (List Analysis)]) (exception.report - ["Input" (exception.listing /.%analysis input)])) + ["Input" (exception.listing /.format input)])) (exception: .public (unconsumed_input [input (List Analysis)]) (exception.report - ["Input" (exception.listing /.%analysis input)])) + ["Input" (exception.listing /.format input)])) (type: .public Parser (//.Parser (List Analysis))) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index d3bfa17b0..c30343aac 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - ["[0]" meta] - [abstract - [monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" code]]] - [math - [number {"+" hex} - ["n" nat]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code]]]] - ["[0]" // {"+" Char} - ["%" format {"+" format}]]) + [library + [lux "*" + ["[0]" meta] + [abstract + [monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code]]] + [math + [number {"+" hex} + ["n" nat]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]]]] + ["[0]" // {"+" Char} + ["%" format {"+" format}]]) (def: sigil "\") diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index eb3c30c2f..1d96e72ff 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -77,6 +77,7 @@ [Literal [Computation' Expression' Code]] [Access [Location' Computation' Expression' Code]] + [CVar [Var' Location' Computation' Expression' Code]] [GVar [Var' Location' Computation' Expression' Code]] [IVar [Var' Location' Computation' Expression' Code]] [SVar [Var' Location' Computation' Expression' Code]] @@ -89,15 +90,13 @@ (-> Text ) (|>> (format ) :abstraction))] + [LVar "l_" local] + [CVar "C_" constant] [GVar "$" global] [IVar "@" instance] [SVar "@@" static] ) - (def: .public local - (-> Text LVar) - (|>> :abstraction)) - (template [ ] [(template [ ] [(def: .public @@ -133,7 +132,8 @@ (template [ ] [(def: .public - (..local ))] + CVar + (..manual ))] ["ARGV" command_line_arguments] ) @@ -367,6 +367,10 @@ [break "break"] ) + (def: .public initialize + LVar + (..manual "initialize")) + (def: .public (function name args body!) (-> LVar (List LVar) Statement Statement) (<| :abstraction @@ -433,27 +437,34 @@ (:abstraction (format "# " (..safe commentary) \n+ (:representation on)))) - (def: .public (class name definition) - (-> LVar Statement Statement) - (:abstraction - (format "class " (:representation name) - (control_structure - (nested - (:representation definition)))))) - - (def: .public (attribute_readers attributes) - (-> (List Text) Statement) - (..statement - (..apply/* (list#each ..string attributes) {.#None} (..local "attr_reader")))) + (template [] + [(`` (def: .public ((~~ (template.symbol [ "/*"])) attributes) + (-> (List Text) Statement) + (..statement + (..apply/* (list#each ..string attributes) {.#None} (..manual )))))] + + ["attr_reader"] + ["attr_writer"] + ["attr_accessor"]) ) (def: .public (do method arguments block object) (-> Text (List Expression) (Maybe Block) Expression Computation) (|> object (..the method) (..apply/* arguments block))) +(def: .public new + (-> (List Expression) (Maybe Block) Expression Computation) + (..do "new")) + +(def: .public (class definition) + (-> Block Computation) + (|> (..manual "Class") + (..new (list) {.#Some definition}))) + (def: .public (apply_lambda/* args lambda) (-> (List Expression) Expression Computation) - (..do "call" args {.#None} lambda)) + (|> lambda + (..do "call" args {.#None}))) (syntax: (arity_inputs [arity .nat]) (in (case arity @@ -473,7 +484,7 @@ (template [] [(`` (def: .public ((~~ (template.symbol [ "/" ])) ) (-> Computation) - (..apply/* (.list ) {.#None} (..local ))))] + (..apply/* (.list ) {.#None} (..manual ))))] ))] @@ -490,8 +501,8 @@ (def: .public (throw/1 error) (-> Expression Statement) - (..statement (..apply/* (list error) {.#None} (..local "throw")))) + (..statement (..apply/* (list error) {.#None} (..manual "throw")))) (def: .public (throw/2 tag value) (-> Expression Expression Statement) - (..statement (..apply/* (list tag value) {.#None} (..local "throw")))) + (..statement (..apply/* (list tag value) {.#None} (..manual "throw")))) 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 108c5670e..0f1d59581 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 {"-" Tuple Variant nat int rev} + [lux {"-" Tuple Variant nat int rev case} [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}] @@ -9,14 +9,18 @@ ["[0]" function] ["[0]" maybe] ["[0]" try] - ["[0]" exception {"+" Exception}]] + ["[0]" exception {"+" Exception}] + [parser + ["<[0]>" code]]] [data ["[0]" product] ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" Format format}]] + ["%" format {"+" Format}]] [collection ["[0]" list ("[1]#[0]" functor mix)]]] + [macro + [syntax {"+" syntax:}]] [math [number ["n" nat] @@ -27,14 +31,14 @@ ["[0]" location]]]] ["[0]" / "_" ["[1][0]" simple {"+" Simple}] - ["[1][0]" composite {"+" Tuple Variant Composite}] + ["[1][0]" complex {"+" Tuple Variant Complex}] ["[1][0]" pattern {"+" Pattern}] [// [phase ["[0]" extension {"+" Extension}]] [/// [arity {"+" Arity}] - [version {"+" Version}] + ["[0]" version {"+" Version}] ["[0]" phase] ["[0]" reference {"+" Reference} ["[0]" variable {"+" Register Variable}]]]]]) @@ -54,7 +58,7 @@ (Rec Analysis (.Variant {#Simple Simple} - {#Structure (Composite Analysis)} + {#Structure (Complex Analysis)} {#Reference Reference} {#Case Analysis (Match' Analysis)} {#Function (Environment Analysis) Analysis} @@ -78,12 +82,12 @@ (Equivalence Analysis) (def: (= reference sample) - (case [reference sample] + (.case [reference sample] [{#Simple reference} {#Simple sample}] (# /simple.equivalence = reference sample) [{#Structure reference} {#Structure sample}] - (# (/composite.equivalence =) = reference sample) + (# (/complex.equivalence =) = reference sample) [{#Reference reference} {#Reference sample}] (# reference.equivalence = reference sample) @@ -113,7 +117,7 @@ [(template: .public ( content) [{ content}])] - [control/case ..#Case] + [case ..#Case] ) (template: .public (unit) @@ -156,7 +160,7 @@ (-> Analysis (Application Analysis)) (loop [abstraction analysis inputs (list)] - (case abstraction + (.case abstraction {#Apply input next} (again next {.#Item input inputs}) @@ -164,16 +168,16 @@ [abstraction inputs]))) (template [ ] - [(template: .public ( content) - [(.<| {..#Reference} - - content)])] + [(syntax: .public ( [content .any]) + (in (list (` (.<| {..#Reference} + + (~ content))))))] [variable {reference.#Variable}] [constant {reference.#Constant}] - [variable/local (reference.local)] - [variable/foreign (reference.foreign)] + [variable/local ((~! reference.local))] + [variable/foreign ((~! reference.foreign))] ) (template [ ] @@ -182,47 +186,54 @@ {} content)])] - [variant /composite.#Variant] - [tuple /composite.#Tuple] + [variant /complex.#Variant] + [tuple /complex.#Tuple] ) -(def: .public (%analysis analysis) +(def: .public (format analysis) (Format Analysis) - (case analysis + (.case analysis {#Simple it} (/simple.format it) {#Structure it} - (/composite.format %analysis it) + (/complex.format format it) {#Reference reference} (reference.format reference) {#Case analysis match} - "{?}" + (%.format "({" + (|> {.#Item match} + (list#each (function (_ [when then]) + (%.format (/pattern.format when) " " (format then)))) + (text.interposed " ")) + "} " + (format analysis) + ")") {#Function environment body} - (|> (%analysis body) - (format " ") - (format (|> environment - (list#each %analysis) - (text.interposed " ") - (text.enclosed ["[" "]"]))) + (|> (format body) + (%.format " ") + (%.format (|> environment + (list#each format) + (text.interposed " ") + (text.enclosed ["[" "]"]))) (text.enclosed ["(" ")"])) {#Apply _} (|> analysis ..application {.#Item} - (list#each %analysis) + (list#each format) (text.interposed " ") (text.enclosed ["(" ")"])) {#Extension name parameters} (|> parameters - (list#each %analysis) + (list#each format) (text.interposed " ") - (format (%.text name) " ") + (%.format (%.text name) " ") (text.enclosed ["(" ")"])))) (template [ ] @@ -240,7 +251,7 @@ (All (_ a) (-> Source (Operation a) (Operation a))) (function (_ [bundle state]) (let [old_source (value@ .#source state)] - (case (action [bundle (with@ .#source source state)]) + (.case (action [bundle (with@ .#source source state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (with@ .#source old_source state')] output]} @@ -263,9 +274,9 @@ (def: .public (with_scope action) (All (_ a) (-> (Operation a) (Operation [Scope a]))) (function (_ [bundle state]) - (case (action [bundle (revised@ .#scopes (|>> {.#Item fresh_scope}) state)]) + (.case (action [bundle (revised@ .#scopes (|>> {.#Item fresh_scope}) state)]) {try.#Success [[bundle' state'] output]} - (case (value@ .#scopes state') + (.case (value@ .#scopes state') {.#Item head tail} {try.#Success [[bundle' (with@ .#scopes tail state')] [head output]]} @@ -283,7 +294,7 @@ (def: .public (without_scopes action) (All (_ a) (-> (Operation a) (Operation a))) (function (_ [bundle state]) - (case (action [bundle (with@ .#scopes ..scope_reset state)]) + (.case (action [bundle (with@ .#scopes ..scope_reset state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (with@ .#scopes (value@ .#scopes state) state')] output]} @@ -303,7 +314,7 @@ action (function (_ [bundle state]) (let [old_location (value@ .#location state)] - (case (action [bundle (with@ .#location location state)]) + (.case (action [bundle (with@ .#location location state)]) {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (with@ .#location old_location state')] output]} @@ -313,8 +324,8 @@ (def: (locate_error location error) (-> Location Text Text) - (format (%.location location) text.new_line - error)) + (%.format (%.location location) text.new_line + error)) (def: .public (failure error) (-> Text Operation) @@ -331,20 +342,11 @@ (# phase.monad in []) (..except exception parameters))) -(def: .public (failure' error) - (-> Text (phase.Operation Lux)) - (function (_ state) - {try.#Failure (locate_error (value@ .#location state) error)})) - -(def: .public (except' exception parameters) - (All (_ e) (-> (Exception e) e (phase.Operation Lux))) - (..failure' (exception.error exception parameters))) - (def: .public (with_stack exception message action) (All (_ e o) (-> (Exception e) e (Operation o) (Operation o))) (function (_ bundle,state) - (case (exception.with exception message - (action bundle,state)) + (.case (exception.with exception message + (action bundle,state)) {try.#Success output} {try.#Success output} @@ -389,7 +391,7 @@ (def: .public (info version host) (-> Version Text Info) [.#target host - .#version (%.nat version) + .#version (version.format version) .#mode {.#Build}]) (def: .public (state info) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux new file mode 100644 index 000000000..b3a2f635f --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux @@ -0,0 +1,98 @@ +(.using + [library + [lux {"-" Tuple Variant} + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text + ["%" format {"+" Format}]] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + [number + ["n" nat]]]]]) + +(type: .public (Variant a) + (Record + [#lefts Nat + #right? Bit + #value a])) + +(type: .public (Tuple a) + (List a)) + +(type: .public (Complex a) + (.Variant + {#Variant (Variant a)} + {#Tuple (Tuple a)})) + +(type: .public Tag + Nat) + +(def: .public (tag right? lefts) + (-> Bit Nat Tag) + (if right? + (++ lefts) + lefts)) + +(def: .public (lefts right? tag) + (-> Bit Tag Nat) + (if right? + (-- tag) + tag)) + +(def: .public (choice multiplicity pick) + (-> Nat Tag [Nat Bit]) + (let [right? (n.= (-- multiplicity) pick)] + [(..lefts right? pick) + right?])) + +(implementation: .public (equivalence (^open "/#[0]")) + (All (_ a) (-> (Equivalence a) (Equivalence (Complex a)))) + + (def: (= reference sample) + (case [reference sample] + [{#Variant [reference_lefts reference_right? reference_value]} + {#Variant [sample_lefts sample_right? sample_value]}] + (and (n.= reference_lefts sample_lefts) + (bit#= reference_right? sample_right?) + (/#= reference_value sample_value)) + + [{#Tuple reference} {#Tuple sample}] + (# (list.equivalence /#=) = reference sample) + + _ + false))) + +(implementation: .public (hash super) + (All (_ a) (-> (Hash a) (Hash (Complex a)))) + + (def: &equivalence + (..equivalence (# super &equivalence))) + + (def: (hash value) + (case value + {#Variant [lefts right? value]} + ($_ n.* 2 + (# n.hash hash lefts) + (# bit.hash hash right?) + (# super hash value)) + + {#Tuple members} + ($_ n.* 3 + (# (list.hash super) hash members)) + ))) + +(def: .public (format %it it) + (All (_ a) (-> (Format a) (Format (Complex a)))) + (case it + {#Variant [lefts right? it]} + (%.format "{" (%.nat lefts) " " (%.bit right?) " " (%it it) "}") + + {#Tuple it} + (|> it + (list#each %it) + (text.interposed " ") + (text.enclosed ["[" "]"])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/composite.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/composite.lux deleted file mode 100644 index c85f332f9..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/composite.lux +++ /dev/null @@ -1,98 +0,0 @@ -(.using - [library - [lux {"-" Tuple Variant} - [abstract - [equivalence {"+" Equivalence}] - [hash {"+" Hash}]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text - ["%" format {"+" Format}]] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [math - [number - ["n" nat]]]]]) - -(type: .public (Variant a) - (Record - [#lefts Nat - #right? Bit - #value a])) - -(type: .public (Tuple a) - (List a)) - -(type: .public (Composite a) - (.Variant - {#Variant (Variant a)} - {#Tuple (Tuple a)})) - -(type: .public Tag - Nat) - -(def: .public (tag right? lefts) - (-> Bit Nat Tag) - (if right? - (++ lefts) - lefts)) - -(def: .public (lefts right? tag) - (-> Bit Tag Nat) - (if right? - (-- tag) - tag)) - -(def: .public (choice multiplicity pick) - (-> Nat Tag [Nat Bit]) - (let [right? (n.= (-- multiplicity) pick)] - [(..lefts right? pick) - right?])) - -(implementation: .public (equivalence (^open "/#[0]")) - (All (_ a) (-> (Equivalence a) (Equivalence (Composite a)))) - - (def: (= reference sample) - (case [reference sample] - [{#Variant [reference_lefts reference_right? reference_value]} - {#Variant [sample_lefts sample_right? sample_value]}] - (and (n.= reference_lefts sample_lefts) - (bit#= reference_right? sample_right?) - (/#= reference_value sample_value)) - - [{#Tuple reference} {#Tuple sample}] - (# (list.equivalence /#=) = reference sample) - - _ - false))) - -(implementation: .public (hash super) - (All (_ a) (-> (Hash a) (Hash (Composite a)))) - - (def: &equivalence - (..equivalence (# super &equivalence))) - - (def: (hash value) - (case value - {#Variant [lefts right? value]} - ($_ n.* 2 - (# n.hash hash lefts) - (# bit.hash hash right?) - (# super hash value)) - - {#Tuple members} - ($_ n.* 3 - (# (list.hash super) hash members)) - ))) - -(def: .public (format %it it) - (All (_ a) (-> (Format a) (Format (Composite a)))) - (case it - {#Variant [lefts right? it]} - (%.format "{" (%.nat lefts) " " (%.bit right?) " " (%it it) "}") - - {#Tuple it} - (|> it - (list#each %it) - (text.interposed " ") - (text.enclosed ["[" "]"])))) 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 9aaf606ac..21b6218ba 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 @@ -3,21 +3,24 @@ [lux {"-" nat int rev} [abstract [equivalence {"+" Equivalence}]] + [data + [text + ["%" format {"+" Format}]]] [math [number ["n" nat]]]]] ["[0]" // "_" ["[1][0]" simple {"+" Simple}] - ["[1][0]" composite {"+" Composite}] + ["[1][0]" complex {"+" Complex}] [//// [reference - [variable {"+" Register}]]]]) + ["[1][0]" variable {"+" Register}]]]]) (type: .public Pattern (Rec Pattern (.Variant {#Simple Simple} - {#Complex (Composite Pattern)} + {#Complex (Complex Pattern)} {#Bind Register}))) (implementation: .public equivalence @@ -29,7 +32,7 @@ (# //simple.equivalence = reference sample) [{#Complex reference} {#Complex sample}] - (# (//composite.equivalence =) = reference sample) + (# (//complex.equivalence =) = reference sample) [{#Bind reference} {#Bind sample}] (n.= reference sample) @@ -37,14 +40,26 @@ _ false))) +(def: .public (format it) + (Format Pattern) + (case it + {#Simple it} + (//simple.format it) + + {#Complex it} + (//complex.format format it) + + {#Bind it} + (//variable.format {//variable.#Local it}))) + (template [ ] [(template: .public ( content) [(.<| {..#Complex} content)])] - [variant {//composite.#Variant}] - [tuple {//composite.#Tuple}] + [variant {//complex.#Variant}] + [tuple {//complex.#Tuple}] ) (template: .public (unit) 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 03ff2ea6e..e2d411efe 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 @@ -32,7 +32,7 @@ [// ["/" analysis {"+" Analysis Operation Phase} ["[1][0]" simple] - ["[1][0]" composite] + ["[1][0]" complex] ["[1][0]" pattern {"+" Pattern}]] [/// ["[1]" phase]]]]]]) @@ -287,7 +287,7 @@ (let [flat_sum (type.flat_variant inputT') size_sum (list.size flat_sum) num_cases (maybe.else size_sum num_tags) - idx (/composite.tag right? lefts)] + idx (/complex.tag right? lefts)] (.case (list.item idx flat_sum) (^multi {.#Some caseT} (n.< num_cases idx)) @@ -324,7 +324,7 @@ [idx group variantT] (///extension.lifted (meta.tag tag)) _ (//type.with_env (check.check inputT variantT)) - .let [[lefts right?] (/composite.choice (list.size group) idx)]] + .let [[lefts right?] (/complex.choice (list.size group) idx)]] (analyse_pattern {.#Some (list.size group)} inputT (` {(~ (code.nat lefts)) (~ (code.bit right?)) (~+ values)}) 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 aa66b8c01..7ec92c76b 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 @@ -26,7 +26,7 @@ [// ["/" analysis {"+" Operation} ["[1][0]" simple] - ["[1][0]" composite] + ["[1][0]" complex] ["[1][0]" pattern {"+" Pattern}]] [/// ["[1]" phase ("[1]#[0]" monad)]]]]) @@ -140,7 +140,7 @@ ... Tuple patterns can be exhaustive if there is exhaustiveness for all of ... their sub-patterns. - {/pattern.#Complex {/composite.#Tuple membersP+}} + {/pattern.#Complex {/complex.#Tuple membersP+}} (case (list.reversed membersP+) (^or {.#End} {.#Item _ {.#End}}) (/.except ..invalid_tuple_pattern []) @@ -162,7 +162,7 @@ ... Variant patterns can be shown to be exhaustive if all the possible ... cases are handled exhaustively. - {/pattern.#Complex {/composite.#Variant [lefts right? value]}} + {/pattern.#Complex {/complex.#Variant [lefts right? value]}} (do ////.monad [value_coverage (determine value) .let [idx (if right? diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 6c94f14bd..6c0b9a429 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -23,7 +23,7 @@ ["[1][0]" extension] [// ["/" analysis {"+" Analysis Operation Phase} - [composite {"+" Tag}]] + [complex {"+" Tag}]] [/// ["[1]" phase ("[1]#[0]" monad)] [meta diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux index 76cf4f82a..3ca157f38 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -132,7 +132,8 @@ []]} {.#Some already_existing} - ((/.except' ..cannot_define_more_than_once [[self_name name] already_existing]) state)))))) + ((///extension.up (/.except ..cannot_define_more_than_once [[self_name name] already_existing])) + state)))))) (def: .public (create hash name) (-> Nat Text (Operation Any)) @@ -167,11 +168,12 @@ (plist.has module_name (with@ .#module_state {} module)) state) []]} - ((/.except' can_only_change_state_of_active_module [module_name {}]) + ((///extension.up (/.except can_only_change_state_of_active_module [module_name {}])) state))) {.#None} - ((/.except' unknown_module module_name) state))))) + ((///extension.up (/.except unknown_module module_name)) + state))))) (def: .public ( module_name) (-> Text (Operation Bit)) @@ -185,7 +187,8 @@ _ #0)]} {.#None} - ((/.except' unknown_module module_name) state)))))] + ((///extension.up (/.except unknown_module module_name)) + state)))))] [set_active active? .#Active] [set_compiled compiled? .#Compiled] @@ -201,7 +204,8 @@ {try.#Success [state (value@ .#module_hash module)]} {.#None} - ((/.except' unknown_module module_name) state))))) + ((///extension.up (/.except unknown_module module_name)) + state))))) (def: .public (declare_tags record? tags exported? type) (-> Bit (List Tag) Bit Type (Operation Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux index abee40e63..87337d8b6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -21,10 +21,12 @@ ["[1]" phase]]]]]) (exception: .public (foreign_module_has_not_been_imported [current Text - foreign Text]) + foreign Text + definition Symbol]) (exception.report ["Current" current] - ["Foreign" foreign])) + ["Foreign" foreign] + ["Definition" (%.symbol definition)])) (exception: .public (definition_has_not_been_exported [definition Symbol]) (exception.report @@ -55,7 +57,7 @@ [imported! (///extension.lifted (meta.imported_by? ::module current))] (if imported! - (/.except foreign_module_has_not_been_imported [current ::module]))) + (/.except foreign_module_has_not_been_imported [current ::module def_name]))) (/.except definition_has_not_been_exported def_name)))) {.#Type [exported? value labels]} @@ -70,7 +72,7 @@ [imported! (///extension.lifted (meta.imported_by? ::module current))] (if imported! - (/.except foreign_module_has_not_been_imported [current ::module]))) + (/.except foreign_module_has_not_been_imported [current ::module def_name]))) (/.except definition_has_not_been_exported def_name)))) {.#Tag _} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 54eca8afb..bcc0a82fe 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -33,7 +33,7 @@ ["[1][0]" extension] [// ["/" analysis {"+" Analysis Operation Phase} - ["[1][0]" composite {"+" Tag}]] + ["[1][0]" complex {"+" Tag}]] [/// ["[1]" phase] [meta @@ -109,7 +109,7 @@ (def: .public (sum analyse lefts right? archive) (-> Phase Nat Bit Phase) - (let [tag (/composite.tag right? lefts)] + (let [tag (/complex.tag right? lefts)] (function (again valueC) (do [! ///.monad] [expectedT (///extension.lifted meta.expected_type) @@ -290,7 +290,7 @@ [tag (///extension.lifted (meta.normal tag)) [idx group variantT] (///extension.lifted (meta.tag tag)) .let [case_size (list.size group) - [lefts right?] (/composite.choice case_size idx)] + [lefts right?] (/complex.choice case_size idx)] expectedT (///extension.lifted meta.expected_type)] (case expectedT {.#Var _} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux index 568e061a6..0f1848eff 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux @@ -1,25 +1,25 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [hash {"+" Hash}] - ["[0]" monad {"+" do}]] - [control - ["[0]" function] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" product] - ["[0]" text ("[1]#[0]" order) - ["%" format {"+" Format format}]] - [collection - ["[0]" list] - ["[0]" dictionary {"+" Dictionary}]]]]] - [///// - ["//" phase] - [meta - [archive {"+" Archive}]]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}] + ["[0]" monad {"+" do}]] + [control + ["[0]" function] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" product] + ["[0]" text ("[1]#[0]" order) + ["%" format {"+" Format format}]] + [collection + ["[0]" list] + ["[0]" dictionary {"+" Dictionary}]]]]] + [///// + ["//" phase] + [meta + [archive {"+" Archive}]]]) (type: .public Name Text) @@ -180,3 +180,14 @@ {try.#Failure error} {try.#Failure error}))) + +(def: .public (up it) + (All (_ s i o v) + (-> (Operation s i o v) (//.Operation s v))) + (function (_ state) + (case (it [..empty state]) + {try.#Success [[_ state'] output]} + {try.#Success [state' output]} + + {try.#Failure error} + {try.#Failure error}))) 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 db5642a25..1e6c6af8e 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 @@ -51,7 +51,7 @@ ["[0]" scope]] ["/[1]" // "_" ["[1][0]" analysis {"+" Analysis Operation Phase Handler Bundle} - ["[1]/[0]" composite] + ["[1]/[0]" complex] ["[1]/[0]" pattern]] ["[1][0]" synthesis] [/// @@ -169,7 +169,9 @@ ... TODO: Get rid of this template block and use the definition in ... lux/ffi.jvm.lux ASAP (template [ ] - [(def: .public .Type {.#Primitive {.#End}})] + [(def: .public + .Type + {.#Primitive {.#End}})] ... Boxes [Boolean box.boolean] @@ -206,7 +208,7 @@ (Record [#method .Type #deprecated? Bit - #exceptions (List .Type)])) + #throws (List .Type)])) (template [] [(exception: .public ( [type .Type]) @@ -1749,6 +1751,27 @@ (.tuple (<>.some ..class)) .any))) +(type: .public (Method_Declaration a) + (Record + [#name Text + #annotations (List (Annotation a)) + #type_variables (List (Type Var)) + #exceptions (List (Type Class)) + #arguments (List (Type Value)) + #return (Type Return)])) + +(def: .public method_declaration + (Parser (Method_Declaration Code)) + (.form + ($_ <>.and + .text + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + (.tuple (<>.some ..class)) + (.tuple (<>.some ..type)) + ..return + ))) + (def: .public (analyse_virtual_method analyse archive selfT mapping method) (-> Phase Archive .Type Mapping (Virtual_Method Code) (Operation Analysis)) (let [[method_name visibility @@ -1982,7 +2005,7 @@ {/////analysis.#Case (/////analysis.unit) [[/////analysis.#when {/////analysis/pattern.#Complex - {/////analysis/composite.#Tuple + {/////analysis/complex.#Tuple (|> arity list.indices (list#each (|>> (n.+ 2) {/////analysis/pattern.#Bind})))}} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index b7693e24b..5442fafdb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -7,8 +7,8 @@ [control [pipe {"+" case>}] ["<>" parser ("[1]#[0]" monad) - ["" code {"+" Parser}] - ["" text]]] + ["<[0]>" code {"+" Parser}] + ["<[0]>" text]]] [data ["[0]" product] [text @@ -16,7 +16,9 @@ [collection ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary] - ["[0]" sequence]]] + ["[0]" sequence]] + ["[0]" format "_" + ["[1]" binary]]] [macro ["[0]" template]] [math @@ -29,13 +31,14 @@ ["[0]" attribute] ["[0]" field] ["[0]" version] + ["[0]" method {"+" Method}] ["[0]" class] ["[0]" constant ["[0]" pool {"+" Resource}]] [encoding - ["[0]" name]] + ["[0]" name {"+" External}]] ["[0]" type {"+" Type Constraint Argument Typed} - [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter}] + [category {"+" Void Value Return Primitive Object Class Array Var Parameter}] ["[0]T" lux {"+" Mapping}] ["[0]" signature] ["[0]" descriptor {"+" Descriptor}] @@ -44,7 +47,8 @@ [compiler ["[0]" phase] [meta - [archive {"+" Archive}]] + [archive {"+" Archive} + ["[0]" artifact]]] [language [lux ["[0]" analysis] @@ -56,7 +60,7 @@ ["[0]A" type]] [generation [jvm - [runtime {"+" Anchor Definition Extender}]]] + ["[0]" runtime {"+" Anchor Definition Extender}]]] ["[0]" extension ["[0]" bundle] [analysis @@ -76,13 +80,13 @@ (def: declaration (Parser Declaration) - (.form (<>.and .text (<>.some jvm.var)))) + (.form (<>.and .text (<>.some jvm.var)))) (def: visibility (Parser (Modifier field.Field)) (`` ($_ <>.either (~~ (template [