diff options
Diffstat (limited to '')
40 files changed, 1256 insertions, 977 deletions
diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 063593890..f2c3710f2 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -14,6 +14,7 @@ [meta [extension (.only analysis)] ["@" target] + ["[0]" location] ["[0]" code ["<[1]>" \\parser]] [macro @@ -48,7 +49,7 @@ (when <+> [_ {.#Symbol [.prelude $]}] (phase#in (list#mix (function (_ left right) - {analysis.#Extension [.prelude $] (list left right)}) + [location.dummy {analysis.#Extension [.prelude $] (list left right)}]) last prevs)) @@ -108,28 +109,28 @@ ... else (phase.except ..no_arithmetic_for [:it:]))))))))))] - [+ [[.Nat (in (analysis.nat 0)) .i64_+#|generation] - [.Int (in (analysis.int +0)) .i64_+#|generation] - [.Rev (in (analysis.rev .0)) .i64_+#|generation] - [.Frac (in (analysis.frac +0.0)) .f64_+#|generation] + [+ [[.Nat (in (analysis.nat location.dummy 0)) .i64_+#|generation] + [.Int (in (analysis.int location.dummy +0)) .i64_+#|generation] + [.Rev (in (analysis.rev location.dummy .0)) .i64_+#|generation] + [.Frac (in (analysis.frac location.dummy +0.0)) .f64_+#|generation] [Ratio (type.expecting Ratio (phase archive (` <ratio/0>))) ratio.+] [Complex (type.expecting Complex (phase archive (` <complex/0>))) complex.+]]] - [- [[.Nat (in (analysis.nat 0)) .i64_-#|generation] - [.Int (in (analysis.int -0)) .i64_-#|generation] - [.Rev (in (analysis.rev .0)) .i64_-#|generation] - [.Frac (in (analysis.frac -0.0)) .f64_-#|generation] + [- [[.Nat (in (analysis.nat location.dummy 0)) .i64_-#|generation] + [.Int (in (analysis.int location.dummy -0)) .i64_-#|generation] + [.Rev (in (analysis.rev location.dummy .0)) .i64_-#|generation] + [.Frac (in (analysis.frac location.dummy -0.0)) .f64_-#|generation] [Ratio (type.expecting Ratio (phase archive (` <ratio/0>))) ratio.-] [Complex (type.expecting Complex (phase archive (` <complex/0>))) complex.-]]] - [* [[.Nat (in (analysis.nat 1)) nat.*] - [.Int (in (analysis.int +1)) .int_*#|generation] - [.Rev (in (analysis.rev rev./1)) rev.*] - [.Frac (in (analysis.frac +1.0)) .f64_*#|generation] + [* [[.Nat (in (analysis.nat location.dummy 1)) nat.*] + [.Int (in (analysis.int location.dummy +1)) .int_*#|generation] + [.Rev (in (analysis.rev location.dummy rev./1)) rev.*] + [.Frac (in (analysis.frac location.dummy +1.0)) .f64_*#|generation] [Ratio (type.expecting Ratio (phase archive (` <ratio/1>))) ratio.*] [Complex (type.expecting Complex (phase archive (` <complex/1>))) complex.*]]] - [/ [[.Nat (in (analysis.nat 1)) nat./] - [.Int (in (analysis.int +1)) .int_/#|generation] - [.Rev (in (analysis.rev rev./1)) rev./] - [.Frac (in (analysis.frac +1.0)) .f64_/#|generation] + [/ [[.Nat (in (analysis.nat location.dummy 1)) nat./] + [.Int (in (analysis.int location.dummy +1)) .int_/#|generation] + [.Rev (in (analysis.rev location.dummy rev./1)) rev./] + [.Frac (in (analysis.frac location.dummy +1.0)) .f64_/#|generation] [Ratio (type.expecting Ratio (phase archive (` <ratio/1>))) ratio./] [Complex (type.expecting Complex (phase archive (` <complex/1>))) complex./]]] ) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux index cc976b37e..0c827a334 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -26,6 +26,7 @@ [meta ["[0]" location] ["[0]" configuration (.only Configuration)] + ["[0]" type] ["[0]" code ["<[1]>" \\parser]] [macro @@ -57,16 +58,20 @@ (type .public (Environment a) (List a)) -(type .public Analysis - (Rec Analysis +(with_expansions [@ ($ (Analysis' $))] + (type .public (Analysis' $) (.Variant {#Simple Simple} - {#Structure (Complex Analysis)} + {#Structure (Complex @)} {#Reference Reference} - {#When Analysis (Match' Analysis)} - {#Function (Environment Analysis) Analysis} - {#Apply Analysis Analysis} - {#Extension (Extension Analysis)}))) + {#When @ (Match' @)} + {#Function (Environment @) @} + {#Apply @ @} + {#Extension (Extension @)}))) + +(type .public Analysis + (Ann Location + (Analysis' (Ann Location)))) (type .public Branch (Branch' Analysis)) @@ -75,7 +80,8 @@ (Match' Analysis)) (def (branch_equivalence equivalence) - (-> (Equivalence Analysis) (Equivalence Branch)) + (-> (Equivalence Analysis) + (Equivalence Branch)) (implementation (def (= [reference_pattern reference_body] [sample_pattern sample_body]) (and (at /pattern.equivalence = reference_pattern sample_pattern) @@ -84,7 +90,7 @@ (def .public equivalence (Equivalence Analysis) (implementation - (def (= reference sample) + (def (= [_ reference] [_ sample]) (.when [reference sample] [{#Simple reference} {#Simple sample}] (at /simple.equivalence = reference sample) @@ -118,20 +124,20 @@ (with_template [<name> <tag>] [(def .public <name> - (template (<name> content) - [{<tag> content}]))] + (template (<name> location content) + [[location {<tag> content}]]))] [when ..#When] ) (def .public unit - (template (unit) - [{..#Simple {/simple.#Unit}}])) + (template (unit location) + [[location {..#Simple {/simple.#Unit}}]])) (with_template [<name> <tag>] [(def .public <name> - (template (<name> value) - [{..#Simple {<tag> value}}]))] + (template (<name> location value) + [[location {..#Simple {<tag> value}}]]))] [bit /simple.#Bit] [nat /simple.#Nat] @@ -148,24 +154,24 @@ [c (List c)]) (def .public no_op - (template (no_op value) + (template (no_op @ value) [(|> 1 {variable.#Local} {reference.#Variable} - {..#Reference} - {..#Function (list)} - {..#Apply value})])) + {..#Reference} [@] + {..#Function (list)} [@] + {..#Apply value} [@])])) -(def .public (reified [abstraction inputs]) +(def .public (reified [[@ abstraction] inputs]) (-> (Reification Analysis) Analysis) (list#mix (function (_ input abstraction') - {#Apply input abstraction'}) - abstraction + [@ {#Apply input abstraction'}]) + [@ abstraction] inputs)) (def .public (reification analysis) (-> Analysis (Reification Analysis)) - (loop (again [abstraction analysis + (loop (again [[@ abstraction] analysis inputs (is (List Analysis) (list))]) (.when abstraction @@ -173,12 +179,14 @@ (again next {.#Item input inputs}) _ - [abstraction inputs]))) + [[@ abstraction] inputs]))) (with_template [<name> <tag>] [(def .public <name> - (syntax (_ [content <code>.any]) - (in (list (` (.<| {..#Reference} + (syntax (_ [location <code>.any + content <code>.any]) + (in (list (` (.<| [(, location)] + {..#Reference} <tag> (, content)))))))] @@ -191,8 +199,9 @@ (with_template [<name> <tag>] [(def .public <name> - (template (<name> content) - [(.<| {..#Structure} + (template (<name> location content) + [(.<| [location] + {..#Structure} {<tag>} content)]))] @@ -200,7 +209,7 @@ [tuple /complex.#Tuple] ) -(def .public (format analysis) +(def .public (format [@ analysis]) (Format Analysis) (.when analysis {#Simple it} @@ -232,7 +241,7 @@ (text.enclosed ["(" ")"])) {#Apply _} - (|> analysis + (|> [@ analysis] ..reification {.#Item} (list#each format) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux index a79b9afcf..d34049cf6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Synthesis #module #counter #host symbol) + [lux (.except Synthesis #module #counter #host #location symbol) [abstract [monad (.only do)]] [control diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux index 2714a2a98..7448e0212 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux @@ -119,7 +119,7 @@ [[function_type function_analysis] (/type.inferring (analysis archive functionC))] (when function_analysis - (/.constant def_name) + (/.constant @ def_name) (global_application extender expander analysis archive function_type function_analysis def_name functionC argsC+) _ @@ -146,10 +146,10 @@ (def .public (phase extender expander) (-> Extender Expander Phase) (function (analysis archive code) - (<| (let [[location code'] code]) + (<| (let [[@ code'] code]) ... The location must be set in the state for the sake ... of having useful error messages. - (/.with_location location) + (/.with_location @) (when code (^.with_template [<tag> <analyser>] [[_ {<tag> value}] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux index eb01fd9e0..9c39f43a1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -117,12 +117,13 @@ (function (again valueC) (do [! ///.monad] [expectedT meta.expected_type - expectedT' (/type.check (check.clean (list) expectedT))] + expectedT' (/type.check (check.clean (list) expectedT)) + @ meta.location] (/.with_exception ..cannot_analyse_sum [expectedT' lefts right? valueC] (when expectedT {.#Sum _} (|> (analyse archive valueC) - (at ! each (|>> [lefts right?] /.variant)) + (at ! each (|>> [lefts right?] (/.variant @))) (/type.expecting (|> expectedT type.flat_variant (list.item tag) @@ -198,8 +199,9 @@ {.#Var _} (do ! [inferenceT (/inference.variant lefts right? variantT) - [inferredT valueA+] (/inference.general archive analyse inferenceT (list valueC))] - (in (/.variant [lefts right? (|> valueA+ list.head maybe.trusted)]))) + [inferredT valueA+] (/inference.general archive analyse inferenceT (list valueC)) + @ meta.location] + (in (/.variant @ [lefts right? (|> valueA+ list.head maybe.trusted)]))) _ (/.with_exception ..cannot_analyse_variant [expectedT tag valueC] @@ -207,8 +209,9 @@ (def (typed_product analyse expectedT archive members) (-> Phase Type Archive (List Code) (Operation Analysis)) - (<| (let [! ///.monad]) - (at ! each (|>> /.tuple)) + (<| (do [! ///.monad] + [@ meta.location]) + (at ! each (|>> (/.tuple @))) (is (Operation (List Analysis))) (loop (again [membersT+ (type.flat_tuple expectedT) membersC+ members]) @@ -262,8 +265,9 @@ (do ! [membersTA (monad.each ! (|>> (analyse archive) /type.inferring) membersC) _ (/type.check (check.check expectedT - (type.tuple (list#each product.left membersTA))))] - (in (/.tuple (list#each product.right membersTA)))))) + (type.tuple (list#each product.left membersTA)))) + @ meta.location] + (in (/.tuple @ (list#each product.right membersTA)))))) {.#UnivQ _} (do ! @@ -484,8 +488,9 @@ {.#Var _} (do ! [inferenceT (/inference.record record_size recordT) - [inferredT membersA] (/inference.general archive analyse inferenceT membersC)] - (in (/.tuple membersA))) + [inferredT membersA] (/inference.general archive analyse inferenceT membersC) + @ meta.location] + (in (/.tuple @ membersA))) _ (..product analyse archive membersC))))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux index 2065c0773..73c26493d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -57,10 +57,12 @@ (/.with_exception ..cannot_analyse [expectedT function_name arg_name body] (when expectedT {.#Function :input: :output:} - (<| (at ! each (.function (_ [scope bodyA]) - {/.#Function (list#each (|>> /.variable) - (/scope.environment scope)) - bodyA})) + (<| (do ! + [@ meta.location]) + (at ! each (.function (_ [scope bodyA]) + [@ {/.#Function (list#each (|>> (/.variable @)) + (/scope.environment scope)) + bodyA}])) /scope.with ... Functions have access not only to their argument, but ... also to themselves, through a local variable. diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux index e83cf63bd..914fe1fe7 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/simple.lux @@ -1,6 +1,7 @@ (.require [library [lux (.except Analysis nat int rev) + ["[0]" meta] [abstract [monad (.only do)]]]] ["[0]" /// @@ -13,10 +14,12 @@ (with_template [<name> <type> <tag>] [(def .public (<name> value) - (-> <type> (Operation Analysis)) + (-> <type> + (Operation Analysis)) (do ///.monad - [_ (/type.inference <type>)] - (in {/.#Simple {<tag> value}})))] + [_ (/type.inference <type>) + @ meta.location] + (in [@ {/.#Simple {<tag> value}}])))] [bit .Bit /simple.#Bit] [nat .Nat /simple.#Nat] @@ -29,5 +32,6 @@ (def .public unit (Operation Analysis) (do ///.monad - [_ (/type.inference .Any)] - (in {/.#Simple {/simple.#Unit}}))) + [_ (/type.inference .Any) + @ meta.location] + (in [@ {/.#Simple {/simple.#Unit}}]))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux index 5f839c67a..eed015604 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux @@ -359,8 +359,9 @@ (/coverage.exhaustive? coverage)) {try.#Failure error} - (/.failure error))] - (in {/.#When inputA [outputH outputT]})) + (/.failure error)) + @ meta.location] + (in [@ {/.#When inputA [outputH outputT]}])) {.#End} (/.except ..empty_branches []))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux index 18e067716..ee14e65bc 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux @@ -74,7 +74,7 @@ (analysis/type.inferring (analysis archive function_term)))] (when analysis - (analysis.constant definition) + (analysis.constant @ definition) (if (or (check.subsumes? .Macro type) (check.subsumes? .Declaration type)) (in [true definition]) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux index 170753ca1..4e5b5d435 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -458,9 +458,10 @@ arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array primitive_type) ..reflection) (list)}) - (analyse archive arrayC))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list arrayA)})))])) + (analyse archive arrayC)) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list arrayA)}])))])) (def array::length::object (-> Text Handler) @@ -477,10 +478,11 @@ (analyse archive arrayC)) :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) - arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text (..signature arrayJT)) - arrayA)}))))])) + arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ (..signature arrayJT)) + arrayA)}]))))])) (def (new_primitive_array_handler primitive_type) (-> (Type Primitive) (-> Text Handler)) @@ -491,9 +493,10 @@ [lengthA (<| (typeA.expecting ..int) (analyse archive lengthC)) _ (typeA.inference {.#Primitive (|> (jvm.array primitive_type) ..reflection) - (list)})] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list lengthA)})))])) + (list)}) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list lengthA)}])))])) (def array::new::object (-> Text Handler) @@ -510,10 +513,11 @@ (in elementJT) {.#None} - (/////analysis.except ..non_array expectedT))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text (..signature elementJT)) - lengthA)})))])) + (/////analysis.except ..non_array expectedT)) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ (..signature elementJT)) + lengthA)}])))])) (def (check_parameter objectT) (-> .Type (Operation (Type Parameter))) @@ -688,9 +692,10 @@ (analyse archive idxC)) arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array jvm_type) ..reflection) (list)}) - (analyse archive arrayC))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list idxA arrayA)})))])) + (analyse archive arrayC)) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list idxA arrayA)}])))])) (def array::read::object (-> Text Handler) @@ -709,11 +714,12 @@ (analyse archive idxC)) :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) - arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text (..signature arrayJT)) - idxA - arrayA)}))))])) + arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ (..signature arrayJT)) + idxA + arrayA)}]))))])) (def (write_primitive_array_handler lux_type jvm_type) (-> .Type (Type Primitive) (-> Text Handler)) @@ -729,11 +735,12 @@ valueA (<| (typeA.expecting lux_type) (analyse archive valueC)) arrayA (<| (typeA.expecting array_type) - (analyse archive arrayC))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list idxA - valueA - arrayA)})))]))) + (analyse archive arrayC)) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list idxA + valueA + arrayA)}])))]))) (def array::write::object (-> Text Handler) @@ -754,12 +761,13 @@ (analyse archive valueC)) :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) - arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text (..signature arrayJT)) - idxA - valueA - arrayA)}))))])) + arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:))) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ (..signature arrayJT)) + idxA + valueA + arrayA)}]))))])) (def with_array_extensions (-> Bundle Bundle) @@ -812,9 +820,10 @@ (do phase.monad [expectedT meta.expected_type [_ :object:] (check_object expectedT) - _ (typeA.inference :object:)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list)})))])) + _ (typeA.inference :object:) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list)}])))])) (def object::null? (-> Text Handler) @@ -825,9 +834,10 @@ [_ (typeA.inference .Bit) [objectT objectA] (typeA.inferring (analyse archive objectC)) - _ (check_object objectT)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list objectA)})))])) + _ (check_object objectT) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list objectA)}])))])) (def object::synchronized (-> Text Handler) @@ -838,9 +848,10 @@ [[monitorT monitorA] (typeA.inferring (analyse archive monitorC)) _ (check_object monitorT) - exprA (analyse archive exprC)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list monitorA exprA)})))])) + exprA (analyse archive exprC) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list monitorA exprA)}])))])) (def (object::throw class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -856,9 +867,10 @@ _ (is (Operation Any) (if ? (in []) - (/////analysis.except non_throwable exception_class)))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list exceptionA)})))])) + (/////analysis.except non_throwable exception_class))) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list exceptionA)}])))])) (def (object::class class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -868,9 +880,10 @@ (do phase.monad [_ (..ensure_fresh_class! class_loader class) _ (typeA.inference {.#Primitive "java.lang.Class" (list {.#Primitive class (list)})}) - _ (phase.lifted (reflection!.load class_loader class))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text class))})))])) + _ (phase.lifted (reflection!.load class_loader class)) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ class))}])))])) (def (object::instance? class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -883,10 +896,11 @@ [objectT objectA] (typeA.inferring (analyse archive objectC)) [object_class _] (check_object objectT) - ? (phase.lifted (reflection!.sub? class_loader object_class sub_class))] + ? (phase.lifted (reflection!.sub? class_loader object_class sub_class)) + @ meta.location] (if ? - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text sub_class) objectA)}) + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ sub_class) objectA)}]) (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) (def (class_candidate_parents class_loader from_name fromT to_name to_class) @@ -973,12 +987,13 @@ true _ - false)))))))] + false))))))) + @ meta.location] (if can_cast? - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (/////analysis.text from_name) - (/////analysis.text to_name) - fromA)}) + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (/////analysis.text @ from_name) + (/////analysis.text @ to_name) + fromA)}]) (/////analysis.except ..cannot_cast [fromJT toJT fromC]))))])) (def (with_object_extensions class_loader) @@ -1006,11 +1021,12 @@ _ (phase.assertion ..deprecated_field [class field] (not deprecated?)) fieldT (reflection_type luxT.fresh fieldJT) - _ (typeA.inference fieldT)] - (in (<| {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (..signature fieldJT)))))))])) + _ (typeA.inference fieldT) + @ meta.location] + (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} + (list (/////analysis.text @ class) + (/////analysis.text @ field) + (/////analysis.text @ (..signature fieldJT)))))))])) (def (put::static class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -1030,11 +1046,12 @@ ... (not final?)) fieldT (reflection_type luxT.fresh fieldJT) valueA (<| (typeA.expecting fieldT) - (analyse archive valueC))] - (in (<| {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (..signature fieldJT)) + (analyse archive valueC)) + @ meta.location] + (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} + (list (/////analysis.text @ class) + (/////analysis.text @ field) + (/////analysis.text @ (..signature fieldJT)) valueA)))))])) (def (get::virtual class_loader) @@ -1055,11 +1072,12 @@ _ (phase.assertion ..deprecated_field [class field] (not deprecated?)) fieldT (reflection_type mapping fieldJT) - _ (typeA.inference fieldT)] - (in (<| {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (..signature fieldJT)) + _ (typeA.inference fieldT) + @ meta.location] + (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} + (list (/////analysis.text @ class) + (/////analysis.text @ field) + (/////analysis.text @ (..signature fieldJT)) objectA)))))])) (def (put::virtual class_loader) @@ -1084,11 +1102,12 @@ (not final?)) fieldT (reflection_type mapping fieldJT) valueA (<| (typeA.expecting fieldT) - (analyse archive valueC))] - (in (<| {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (..signature fieldJT)) + (analyse archive valueC)) + @ meta.location] + (in (<| [@] {/////analysis.#Extension [.prelude (%.format extension_name "|generation")]} + (list (/////analysis.text @ class) + (/////analysis.text @ field) + (/////analysis.text @ (..signature fieldJT)) valueA objectA)))))])) @@ -1448,12 +1467,12 @@ (Parser (Typed Code)) (<code>.tuple (<>.and ..type <code>.any))) -(def (decorate_inputs typesT inputsA) - (-> (List (Type Value)) (List Analysis) (List Analysis)) +(def (decorate_inputs @ typesT inputsA) + (-> Location (List (Type Value)) (List Analysis) (List Analysis)) (|> inputsA - (list.zipped_2 (list#each (|>> ..signature /////analysis.text) typesT)) + (list.zipped_2 (list#each (|>> ..signature (/////analysis.text @)) typesT)) (list#each (function (_ [type value]) - (/////analysis.tuple (list type value)))))) + (/////analysis.tuple @ (list type value)))))) (def type_vars (<code>.tuple (<>.some ..var))) @@ -1470,12 +1489,13 @@ _ (phase.assertion ..deprecated_method [class method methodT] (not deprecated?)) [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) - outputJT (check_return outputT)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - (decorate_inputs argsT argsA))})))])) + outputJT (check_return outputT) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) + (/////analysis.text @ method) + (/////analysis.text @ (..signature outputJT)) + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::virtual class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -1495,13 +1515,14 @@ _ (undefined))] - outputJT (check_return outputT)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))})))])) + outputJT (check_return outputT) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) + (/////analysis.text @ method) + (/////analysis.text @ (..signature outputJT)) + objectA + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::special class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -1521,13 +1542,14 @@ _ (undefined))] - outputJT (check_return outputT)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))})))])) + outputJT (check_return outputT) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) + (/////analysis.text @ method) + (/////analysis.text @ (..signature outputJT)) + objectA + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::interface class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -1550,13 +1572,14 @@ _ (undefined))] - outputJT (check_return outputT)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list.partial (/////analysis.text (..signature (jvm.class class_name (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))})))])) + outputJT (check_return outputT) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list.partial (/////analysis.text @ (..signature (jvm.class class_name (list)))) + (/////analysis.text @ method) + (/////analysis.text @ (..signature outputJT)) + objectA + (decorate_inputs @ argsT argsA))}])))])) (def (invoke::constructor class_loader) (-> java/lang/ClassLoader (-> Text Handler)) @@ -1569,10 +1592,11 @@ [methodT deprecated? exceptionsT] (..constructor_candidate class_loader class_tvars class method_tvars argsT) _ (phase.assertion ..deprecated_method [class ..constructor_method methodT] (not deprecated?)) - [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC))] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (decorate_inputs argsT argsA))})))])) + [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list.partial (/////analysis.text @ (..signature (jvm.class class (list)))) + (decorate_inputs @ argsT argsA))}])))])) (def (with_member_extensions class_loader) (-> java/lang/ClassLoader (-> Bundle Bundle)) @@ -1607,19 +1631,22 @@ (Parser Argument) (<code>.tuple (<>.and <code>.text ..type))) -(def (annotation_parameter_analysis [name value]) - (-> (Annotation_Parameter Analysis) Analysis) - (/////analysis.tuple (list (/////analysis.text name) value))) +(def (annotation_parameter_analysis @ [name value]) + (-> Location (Annotation_Parameter Analysis) + Analysis) + (/////analysis.tuple @ (list (/////analysis.text @ name) value))) -(def (annotation_analysis [name parameters]) - (-> (Annotation Analysis) Analysis) - (/////analysis.tuple (list.partial (/////analysis.text name) - (list#each annotation_parameter_analysis parameters)))) +(def (annotation_analysis @ [name parameters]) + (-> Location (Annotation Analysis) + Analysis) + (/////analysis.tuple @ (list.partial (/////analysis.text @ name) + (list#each (annotation_parameter_analysis @) parameters)))) (with_template [<name> <category>] - [(def <name> - (-> (Type <category>) Analysis) - (|>> ..signature /////analysis.text))] + [(def (<name> @) + (-> Location (Type <category>) + Analysis) + (|>> ..signature (/////analysis.text @)))] [var_analysis Var] [class_analysis Class] @@ -1627,15 +1654,15 @@ [return_analysis Return] ) -(def (typed_analysis [type term]) - (-> (Typed Analysis) Analysis) - (/////analysis.tuple (list (value_analysis type) term))) +(def (typed_analysis @ [type term]) + (-> Location (Typed Analysis) Analysis) + (/////analysis.tuple @ (list (value_analysis @ type) term))) -(def (argument_analysis [argument argumentJT]) - (-> Argument Analysis) - (/////analysis.tuple - (list (/////analysis.text argument) - (value_analysis argumentJT)))) +(def (argument_analysis @ [argument argumentJT]) + (-> Location Argument Analysis) + (<| (/////analysis.tuple @) + (list (/////analysis.text @ argument) + (value_analysis @ argumentJT)))) (with_template [<name> <only> <methods>] [(def (<name> [type class]) @@ -1735,13 +1762,13 @@ (Parser Visibility) (<text>.then ..visibility' <code>.text)) -(def .public (visibility_analysis visibility) - (-> Visibility Analysis) - (/////analysis.text (when visibility - {#Public} ..public_tag - {#Private} ..private_tag - {#Protected} ..protected_tag - {#Default} ..default_tag))) +(def .public (visibility_analysis @ visibility) + (-> Location Visibility Analysis) + (/////analysis.text @ (when visibility + {#Public} ..public_tag + {#Private} ..private_tag + {#Protected} ..protected_tag + {#Default} ..default_tag))) (.type Exception (Type Class)) @@ -1803,16 +1830,17 @@ (in [name valueA]))) parameters)] (in [name parametersA]))) - annotations)] - (in (/////analysis.tuple (list (/////analysis.text ..abstract_tag) - (/////analysis.text method_name) - (visibility_analysis visibility) - (/////analysis.tuple (list#each annotation_analysis annotationsA)) - (/////analysis.tuple (list#each var_analysis vars)) - (/////analysis.tuple (list#each ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list#each class_analysis exceptions)) - )))))) + annotations) + @ meta.location] + (in (/////analysis.tuple @ (list (/////analysis.text @ ..abstract_tag) + (/////analysis.text @ method_name) + (visibility_analysis @ visibility) + (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (/////analysis.tuple @ (list#each (var_analysis @) vars)) + (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (/////analysis.tuple @ (list#each (class_analysis @) exceptions)) + )))))) (.type .public (Constructor a) [Visibility @@ -1860,86 +1888,94 @@ {pattern.#Bind it} {pattern.#Bind (++ it)})) -(def (with_fake_parameter it) +(def (with_fake_parameter [@ it]) (-> Analysis Analysis) - (when it - {/////analysis.#Simple _} - it + [@ (when it + {/////analysis.#Simple _} + it - {/////analysis.#Structure it} - {/////analysis.#Structure - (when it - {complex.#Variant it} - {complex.#Variant (revised complex.#value with_fake_parameter it)} + {/////analysis.#Structure it} + {/////analysis.#Structure + (when it + {complex.#Variant it} + {complex.#Variant (revised complex.#value with_fake_parameter it)} - {complex.#Tuple it} - {complex.#Tuple (list#each with_fake_parameter it)})} + {complex.#Tuple it} + {complex.#Tuple (list#each with_fake_parameter it)})} - {/////analysis.#Reference it} - {/////analysis.#Reference - (when it - {reference.#Variable it} - {reference.#Variable + {/////analysis.#Reference it} + {/////analysis.#Reference (when it - {variable.#Local it} - {variable.#Local (++ it)} + {reference.#Variable it} + {reference.#Variable + (when it + {variable.#Local it} + {variable.#Local (++ it)} + + {variable.#Foreign _} + it)} - {variable.#Foreign _} + {reference.#Constant _} it)} - {reference.#Constant _} - it)} - - {/////analysis.#When value [head tail]} - {/////analysis.#When (with_fake_parameter value) - (let [with_fake_parameter (is (-> /////analysis.Branch /////analysis.Branch) - (|>> (revised /////analysis.#when with_fake_parameter#pattern) - (revised /////analysis.#then with_fake_parameter)))] - [(with_fake_parameter head) - (list#each with_fake_parameter tail)])} - - {/////analysis.#Function environment body} - {/////analysis.#Function (list#each with_fake_parameter environment) - body} - - {/////analysis.#Apply parameter abstraction} - {/////analysis.#Apply (with_fake_parameter parameter) - (with_fake_parameter abstraction)} - - {/////analysis.#Extension name parameters} - {/////analysis.#Extension name (list#each with_fake_parameter parameters)})) + {/////analysis.#When value [head tail]} + {/////analysis.#When (with_fake_parameter value) + (let [with_fake_parameter (is (-> /////analysis.Branch /////analysis.Branch) + (|>> (revised /////analysis.#when with_fake_parameter#pattern) + (revised /////analysis.#then with_fake_parameter)))] + [(with_fake_parameter head) + (list#each with_fake_parameter tail)])} + + {/////analysis.#Function environment body} + {/////analysis.#Function (list#each with_fake_parameter environment) + body} + + {/////analysis.#Apply parameter abstraction} + {/////analysis.#Apply (with_fake_parameter parameter) + (with_fake_parameter abstraction)} + + {/////analysis.#Extension name parameters} + {/////analysis.#Extension name (list#each with_fake_parameter parameters)})]) -(def .public (hidden_method_body arity bodyA) - (-> Nat Analysis Analysis) - (<| /////analysis.tuple - (list (/////analysis.unit)) +(def .public (hidden_method_body @ arity bodyA) + (-> Location Nat Analysis Analysis) + (<| (/////analysis.tuple @) + (list (/////analysis.unit @)) (when arity (^.or 0 1) bodyA 2 - (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] - {/////analysis.#When (/////analysis.unit) - [[/////analysis.#when - {pattern.#Bind 2} - - /////analysis.#then - (/////analysis.tuple (list forced_refencing bodyA))] - (list)]}) + (let [forced_refencing (is Analysis + (/////analysis.tuple @ (is (List Analysis) + (list#each (is (-> Nat Analysis) + (|>> (/////analysis.local @))) + (list.indices (++ arity))))))] + [@ {/////analysis.#When (/////analysis.unit @) + [[/////analysis.#when + {pattern.#Bind 2} + + /////analysis.#then + (/////analysis.tuple @ (list forced_refencing bodyA))] + (list)]}]) _ - (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] - {/////analysis.#When (/////analysis.unit) - [[/////analysis.#when - {pattern.#Complex - {complex.#Tuple - (|> (-- arity) - list.indices - (list#each (|>> (n.+ 2) {pattern.#Bind})))}} - - /////analysis.#then - (/////analysis.tuple (list forced_refencing bodyA))] - (list)]})))) + (let [forced_refencing (is Analysis + (/////analysis.tuple @ (is (List Analysis) + (list#each (is (-> Nat Analysis) + (|>> (/////analysis.local @))) + (list.indices (++ arity))))))] + [@ {/////analysis.#When (/////analysis.unit @) + [[/////analysis.#when + {pattern.#Complex + {complex.#Tuple + (|> (-- arity) + list.indices + (list#each (|>> (n.+ 2) {pattern.#Bind})))}} + + /////analysis.#then + (/////analysis.tuple @ (list forced_refencing bodyA))] + (list)]}])))) (def .public (analyse_constructor_method analyse archive selfT mapping method) (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) @@ -1976,24 +2012,25 @@ (list#mix scope.with_local (analyse archive body)) (typeA.expecting .Any) scope.with) - .let [arity (list.size arguments)]] - (in (/////analysis.tuple (list (/////analysis.text ..constructor_tag) - (visibility_analysis visibility) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list#each annotation_analysis annotationsA)) - (/////analysis.tuple (list#each var_analysis vars)) - (/////analysis.tuple (list#each class_analysis exceptions)) - (/////analysis.text self_name) - (/////analysis.tuple (list#each ..argument_analysis arguments)) - (/////analysis.tuple (list#each typed_analysis super_arguments)) - {/////analysis.#Function - (list#each (|>> /////analysis.variable) - (scope.environment scope)) - (<| (..hidden_method_body arity) - (when arity - 0 (with_fake_parameter bodyA) - _ bodyA))} - )))))) + .let [arity (list.size arguments)] + @ meta.location] + (in (/////analysis.tuple @ (list (/////analysis.text @ ..constructor_tag) + (visibility_analysis @ visibility) + (/////analysis.bit @ strict_fp?) + (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (/////analysis.tuple @ (list#each (var_analysis @) vars)) + (/////analysis.tuple @ (list#each (class_analysis @) exceptions)) + (/////analysis.text @ self_name) + (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (/////analysis.tuple @ (list#each (typed_analysis @) super_arguments)) + [@ {/////analysis.#Function + (list#each (|>> (/////analysis.variable @)) + (scope.environment scope)) + (<| (..hidden_method_body @ arity) + (when arity + 0 (with_fake_parameter bodyA) + _ bodyA))}] + )))))) (.type .public (Virtual_Method a) [Text @@ -2078,26 +2115,27 @@ (list#mix scope.with_local (analyse archive body)) (typeA.expecting :return:) scope.with) - .let [arity (list.size arguments)]] - (in (/////analysis.tuple (list (/////analysis.text ..virtual_tag) - (/////analysis.text method_name) - (visibility_analysis visibility) - (/////analysis.bit final?) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list#each annotation_analysis annotationsA)) - (/////analysis.tuple (list#each var_analysis vars)) - (/////analysis.text self_name) - (/////analysis.tuple (list#each ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list#each class_analysis exceptions)) - {/////analysis.#Function - (list#each (|>> /////analysis.variable) - (scope.environment scope)) - (<| (..hidden_method_body arity) - (when arity - 0 (with_fake_parameter bodyA) - _ bodyA))} - )))))) + .let [arity (list.size arguments)] + @ meta.location] + (in (/////analysis.tuple @ (list (/////analysis.text @ ..virtual_tag) + (/////analysis.text @ method_name) + (visibility_analysis @ visibility) + (/////analysis.bit @ final?) + (/////analysis.bit @ strict_fp?) + (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (/////analysis.tuple @ (list#each (var_analysis @) vars)) + (/////analysis.text @ self_name) + (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (/////analysis.tuple @ (list#each (class_analysis @) exceptions)) + [@ {/////analysis.#Function + (list#each (|>> (/////analysis.variable @)) + (scope.environment scope)) + (<| (..hidden_method_body @ arity) + (when arity + 0 (with_fake_parameter bodyA) + _ bodyA))}] + )))))) (.type .public (Static_Method a) [Text @@ -2155,22 +2193,23 @@ list.reversed (list#mix scope.with_local (analyse archive body)) (typeA.expecting :return:) - scope.with)] - (in (/////analysis.tuple (list (/////analysis.text ..static_tag) - (/////analysis.text method_name) - (visibility_analysis visibility) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list#each annotation_analysis annotationsA)) - (/////analysis.tuple (list#each var_analysis vars)) - (/////analysis.tuple (list#each ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list#each class_analysis - exceptions)) - {/////analysis.#Function - (list#each (|>> /////analysis.variable) - (scope.environment scope)) - (/////analysis.tuple (list bodyA))} - )))))) + scope.with) + @ meta.location] + (in (/////analysis.tuple @ (list (/////analysis.text @ ..static_tag) + (/////analysis.text @ method_name) + (visibility_analysis @ visibility) + (/////analysis.bit @ strict_fp?) + (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (/////analysis.tuple @ (list#each (var_analysis @) vars)) + (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (/////analysis.tuple @ (list#each (class_analysis @) + exceptions)) + [@ {/////analysis.#Function + (list#each (|>> (/////analysis.variable @)) + (scope.environment scope)) + (/////analysis.tuple @ (list bodyA))}] + )))))) (.type .public (Overriden_Method a) [(Type Class) @@ -2282,26 +2321,27 @@ (list#mix scope.with_local (analyse archive body)) (typeA.expecting :return:) scope.with) - .let [arity (list.size arguments)]] - (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag) - (class_analysis parent_type) - (/////analysis.text method_name) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list#each annotation_analysis annotationsA)) - (/////analysis.tuple (list#each var_analysis vars)) - (/////analysis.text self_name) - (/////analysis.tuple (list#each ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list#each class_analysis - exceptions)) - {/////analysis.#Function - (list#each (|>> /////analysis.variable) - (scope.environment scope)) - (<| (..hidden_method_body arity) - (when arity - 0 (with_fake_parameter bodyA) - _ bodyA))} - )))))) + .let [arity (list.size arguments)] + @ meta.location] + (in (/////analysis.tuple @ (list (/////analysis.text @ ..overriden_tag) + (class_analysis @ parent_type) + (/////analysis.text @ method_name) + (/////analysis.bit @ strict_fp?) + (/////analysis.tuple @ (list#each (annotation_analysis @) annotationsA)) + (/////analysis.tuple @ (list#each (var_analysis @) vars)) + (/////analysis.text @ self_name) + (/////analysis.tuple @ (list#each (..argument_analysis @) arguments)) + (return_analysis @ return) + (/////analysis.tuple @ (list#each (class_analysis @) + exceptions)) + [@ {/////analysis.#Function + (list#each (|>> (/////analysis.variable @)) + (scope.environment scope)) + (<| (..hidden_method_body @ arity) + (when arity + 0 (with_fake_parameter bodyA) + _ bodyA))}] + )))))) (def (matched? [sub sub_method subJT] [super super_method superJT]) (-> [(Type Class) Text (Type Method)] [(Type Class) Text (Type Method)] Bit) @@ -2658,12 +2698,13 @@ constructor_args) .let [supers {.#Item super_class super_interfaces}] _ (..require_complete_method_concretion class_loader supers methods) - methodsA (monad.each ! (analyse_overriden_method analyse archive selfT mapping supers) methods)] - (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] - (list (class_analysis super_class) - (/////analysis.tuple (list#each class_analysis super_interfaces)) - (/////analysis.tuple (list#each typed_analysis constructor_argsA+)) - (/////analysis.tuple methodsA))})))])) + methodsA (monad.each ! (analyse_overriden_method analyse archive selfT mapping supers) methods) + @ meta.location] + (in [@ {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] + (list (class_analysis @ super_class) + (/////analysis.tuple @ (list#each (class_analysis @) super_interfaces)) + (/////analysis.tuple @ (list#each (typed_analysis @) constructor_argsA+)) + (/////analysis.tuple @ methodsA))}])))])) (def (with_class_extensions class_loader host) (-> java/lang/ClassLoader runtime.Host (-> Bundle Bundle)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index 4b9e57fda..becc2aad5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -76,8 +76,9 @@ (function (_ [argT argC]) (<| (typeA.expecting argT) (analyse archive argC))) - (list.zipped_2 inputsT+ args))] - (in {analysis.#Extension [.prelude (format extension_name "|generation")] argsA})) + (list.zipped_2 inputsT+ args)) + @ meta.location] + (in [@ {analysis.#Extension [.prelude (format extension_name "|generation")] argsA}])) (analysis.except ..incorrect_arity [num_expected num_actual])))))) (def .public (nullary valueT) @@ -105,8 +106,9 @@ argsA (monad.each ! (|>> (analyse archive) (typeA.expecting input)) - args)] - (in {analysis.#Extension [.prelude (next extension_name)] argsA})))) + args) + @ meta.location] + (in [@ {analysis.#Extension [.prelude (next extension_name)] argsA}])))) ... TODO: Get rid of this ASAP (these @@ -143,14 +145,16 @@ (in [cases branch]))) conditionals) else (<| (typeA.expecting expectedT) - (phase archive else))] + (phase archive else)) + @ meta.location] (in (|> conditionals (list#each (function (_ [cases branch]) - (analysis.tuple - (list (analysis.tuple (list#each (|>> analysis.nat) cases)) - branch)))) + (<| (analysis.tuple @) + (list (analysis.tuple @ (list#each (|>> (analysis.nat @)) cases)) + branch)))) (list.partial input else) - {analysis.#Extension [.prelude (format extension_name "|generation")]}))))]))) + {analysis.#Extension [.prelude (format extension_name "|generation")]} + [@]))))]))) ... .is?# represents reference/pointer equality. (def (lux::is? extension_name) @@ -170,11 +174,14 @@ (<| typeA.with_var (function (_ [@var :var:])) (do [! phase.monad] - [_ (typeA.inference (type_literal (Either Text :var:)))] + [_ (typeA.inference (type_literal (Either Text :var:))) + @ meta.location] (|> opC (analyse archive) (typeA.expecting (type_literal (-> .Any :var:))) - (at ! each (|>> list {analysis.#Extension [.prelude (format extension_name "|generation")]}))))))])) + (at ! each (|>> list + {analysis.#Extension [.prelude (format extension_name "|generation")]} + [@]))))))])) (def lux::in_module (-> Text Handler) @@ -242,23 +249,24 @@ (..custom [(<>.and <code>.text <code>.global) (function (_ extension_name phase archive [quoted_module def_name]) - (with_expansions [<return> (in (|> def_name reference.constant {analysis.#Reference}))] - (loop (again [exported_alias? false - def_name def_name]) - (do [! phase.monad] - [(^.let def_name [::module ::name]) (meta.normal def_name) - current meta.current_module_name - [exported? constant] (meta.definition def_name)] - (when constant - {.#Alias real_def_name} - (again (or exported_alias? - (text#= current ::module) - exported?) - real_def_name) - - {.#Definition [actualT _]} - (do ! - [_ (typeA.inference actualT)] + (loop (again [exported_alias? false + def_name def_name]) + (do [! phase.monad] + [(^.let def_name [::module ::name]) (meta.normal def_name) + current meta.current_module_name + [exported? constant] (meta.definition def_name)] + (when constant + {.#Alias real_def_name} + (again (or exported_alias? + (text#= current ::module) + exported?) + real_def_name) + + {.#Definition [actualT _]} + (do ! + [_ (typeA.inference actualT) + @ meta.location] + (with_expansions [<return> (in (|> def_name reference.constant {analysis.#Reference} [@]))] (if (or exported_alias? (text#= current ::module)) <return> @@ -269,10 +277,10 @@ (text#= quoted_module ::module)) <return> (analysis.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name]))) - (analysis.except ..global_has_not_been_exported [def_name])))) + (analysis.except ..global_has_not_been_exported [def_name]))))) - {.#Default _} - (analysis.except ..defaults_cannot_be_referenced [def_name]))))))])) + {.#Default _} + (analysis.except ..defaults_cannot_be_referenced [def_name])))))])) (exception.def .public (unknown_local name) (Exception Text) @@ -289,8 +297,9 @@ (when ?var {.#Some [local_type local_reference]} (do ! - [_ (typeA.inference local_type)] - (in (|> local_reference reference.variable {analysis.#Reference}))) + [_ (typeA.inference local_type) + @ meta.location] + (in (|> local_reference reference.variable {analysis.#Reference} [@]))) {.#None} (analysis.except ..unknown_local [it]))))])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 988395df8..efc224a6d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -130,7 +130,7 @@ [interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generation archive codeS)) .let [@abstraction (when codeS - (/////synthesis.function/abstraction [env arity body]) + (/////synthesis.function/abstraction @ [env arity body]) (|> interim_artifacts list.last (maybe#each (|>> [arity]))) @@ -262,7 +262,7 @@ (analysis archive valueC)) [_ _ exported?] (evaluate! archive Bit exported?C) .let [original (when codeA - (analysis.constant original) + (analysis.constant @ original) original _ diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux index 5f51dcaba..853c0c0ae 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -24,6 +24,7 @@ ["n" nat] ["[0]" i32]]] [meta + ["[0]" location] [macro ["^" pattern] ["[0]" template]] @@ -810,16 +811,16 @@ [1 _]) body - [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple (list _ hidden))}}}] + [2 [@ {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple @ (list _ hidden))}}}]] hidden - [_ {synthesis.#Control {synthesis.#Branch {synthesis.#When _ path}}}] + [_ [@ {synthesis.#Control {synthesis.#Branch {synthesis.#When _ path}}}]] (loop (again [path (is Path path)]) (when path {synthesis.#Seq _ next} (again next) - {synthesis.#Then (synthesis.tuple (list _ hidden))} + {synthesis.#Then (synthesis.tuple @ (list _ hidden))} hidden _ @@ -865,91 +866,91 @@ (def .public (without_fake_parameter it) (-> Synthesis Synthesis) (when it - {synthesis.#Simple _} + [@ {synthesis.#Simple _}] it - {synthesis.#Structure it} - {synthesis.#Structure - (when it - {complex.#Variant it} - {complex.#Variant (revised complex.#value without_fake_parameter it)} - - {complex.#Tuple it} - {complex.#Tuple (list#each without_fake_parameter it)})} - - {synthesis.#Reference it} - {synthesis.#Reference - (when it - {//////reference.#Variable it} - {//////reference.#Variable + [@ {synthesis.#Structure it}] + [@ {synthesis.#Structure (when it - {//////variable.#Local it} - {//////variable.#Local (-- it)} - - {//////variable.#Foreign _} - it)} - - {//////reference.#Constant _} - it)} + {complex.#Variant it} + {complex.#Variant (revised complex.#value without_fake_parameter it)} + + {complex.#Tuple it} + {complex.#Tuple (list#each without_fake_parameter it)})}] - {synthesis.#Control it} - {synthesis.#Control - (when it - {synthesis.#Branch it} - {synthesis.#Branch + [@ {synthesis.#Reference it}] + [@ {synthesis.#Reference (when it - {synthesis.#Exec before after} - {synthesis.#Exec (without_fake_parameter before) - (without_fake_parameter after)} - - {synthesis.#Let value register body} - {synthesis.#Let (without_fake_parameter value) - (-- register) - (without_fake_parameter body)} - - {synthesis.#If when then else} - {synthesis.#If (without_fake_parameter when) - (without_fake_parameter then) - (without_fake_parameter else)} + {//////reference.#Variable it} + {//////reference.#Variable + (when it + {//////variable.#Local it} + {//////variable.#Local (-- it)} + + {//////variable.#Foreign _} + it)} - {synthesis.#Get members record} - {synthesis.#Get members - (without_fake_parameter record)} - - {synthesis.#When value path} - {synthesis.#When (without_fake_parameter value) - (without_fake_parameter#path without_fake_parameter path)})} - - {synthesis.#Loop it} - {synthesis.#Loop + {//////reference.#Constant _} + it)}] + + [@ {synthesis.#Control it}] + [@ {synthesis.#Control (when it - {synthesis.#Scope [synthesis.#start start - synthesis.#inits inits - synthesis.#iteration iteration]} - {synthesis.#Scope [synthesis.#start (-- start) - synthesis.#inits (list#each without_fake_parameter inits) - synthesis.#iteration iteration]} + {synthesis.#Branch it} + {synthesis.#Branch + (when it + {synthesis.#Exec before after} + {synthesis.#Exec (without_fake_parameter before) + (without_fake_parameter after)} + + {synthesis.#Let value register body} + {synthesis.#Let (without_fake_parameter value) + (-- register) + (without_fake_parameter body)} + + {synthesis.#If when then else} + {synthesis.#If (without_fake_parameter when) + (without_fake_parameter then) + (without_fake_parameter else)} + + {synthesis.#Get members record} + {synthesis.#Get members + (without_fake_parameter record)} + + {synthesis.#When value path} + {synthesis.#When (without_fake_parameter value) + (without_fake_parameter#path without_fake_parameter path)})} - {synthesis.#Again _} - it)} - - {synthesis.#Function it} - {synthesis.#Function - (when it - {synthesis.#Abstraction [synthesis.#environment environment - synthesis.#arity arity - synthesis.#body body]} - {synthesis.#Abstraction [synthesis.#environment (list#each without_fake_parameter environment) - synthesis.#arity arity - synthesis.#body body]} + {synthesis.#Loop it} + {synthesis.#Loop + (when it + {synthesis.#Scope [synthesis.#start start + synthesis.#inits inits + synthesis.#iteration iteration]} + {synthesis.#Scope [synthesis.#start (-- start) + synthesis.#inits (list#each without_fake_parameter inits) + synthesis.#iteration iteration]} + + {synthesis.#Again _} + it)} - {synthesis.#Apply [synthesis.#function function - synthesis.#arguments arguments]} - {synthesis.#Apply [synthesis.#function (without_fake_parameter function) - synthesis.#arguments (list#each without_fake_parameter arguments)]})})} - - {synthesis.#Extension name parameters} - {synthesis.#Extension name (list#each without_fake_parameter parameters)})) + {synthesis.#Function it} + {synthesis.#Function + (when it + {synthesis.#Abstraction [synthesis.#environment environment + synthesis.#arity arity + synthesis.#body body]} + {synthesis.#Abstraction [synthesis.#environment (list#each without_fake_parameter environment) + synthesis.#arity arity + synthesis.#body body]} + + {synthesis.#Apply [synthesis.#function function + synthesis.#arguments arguments]} + {synthesis.#Apply [synthesis.#function (without_fake_parameter function) + synthesis.#arguments (list#each without_fake_parameter arguments)]})})}] + + [@ {synthesis.#Extension name parameters}] + [@ {synthesis.#Extension name (list#each without_fake_parameter parameters)}])) (def overriden_method_definition (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) @@ -1023,62 +1024,62 @@ (^.with_template [<tag>] [<tag> body]) - ([{synthesis.#Simple _}] - [(synthesis.constant _)]) + ([[@ {synthesis.#Simple _}]] + [(synthesis.constant @ _)]) - (synthesis.variant [lefts right? sub]) - (synthesis.variant [lefts right? (again sub)]) + (synthesis.variant @ [lefts right? sub]) + (synthesis.variant @ [lefts right? (again sub)]) - (synthesis.tuple members) - (synthesis.tuple (list#each again members)) + (synthesis.tuple @ members) + (synthesis.tuple @ (list#each again members)) - (synthesis.variable var) + (synthesis.variable @ var) (|> mapping (dictionary.value body) (maybe.else var) - synthesis.variable) + (synthesis.variable @)) - (synthesis.branch/when [inputS pathS]) - (synthesis.branch/when [(again inputS) (normalize_path again pathS)]) + (synthesis.branch/when @ [inputS pathS]) + (synthesis.branch/when @ [(again inputS) (normalize_path again pathS)]) - (synthesis.branch/exec [this that]) - (synthesis.branch/exec [(again this) (again that)]) + (synthesis.branch/exec @ [this that]) + (synthesis.branch/exec @ [(again this) (again that)]) - (synthesis.branch/let [inputS register outputS]) - (synthesis.branch/let [(again inputS) register (again outputS)]) + (synthesis.branch/let @ [inputS register outputS]) + (synthesis.branch/let @ [(again inputS) register (again outputS)]) - (synthesis.branch/if [testS thenS elseS]) - (synthesis.branch/if [(again testS) (again thenS) (again elseS)]) + (synthesis.branch/if @ [testS thenS elseS]) + (synthesis.branch/if @ [(again testS) (again thenS) (again elseS)]) - (synthesis.branch/get [path recordS]) - (synthesis.branch/get [path (again recordS)]) + (synthesis.branch/get @ [path recordS]) + (synthesis.branch/get @ [path (again recordS)]) - (synthesis.loop/scope [offset initsS+ bodyS]) - (synthesis.loop/scope [offset (list#each again initsS+) (again bodyS)]) + (synthesis.loop/scope @ [offset initsS+ bodyS]) + (synthesis.loop/scope @ [offset (list#each again initsS+) (again bodyS)]) - (synthesis.loop/again updatesS+) - (synthesis.loop/again (list#each again updatesS+)) + (synthesis.loop/again @ updatesS+) + (synthesis.loop/again @ (list#each again updatesS+)) - (synthesis.function/abstraction [environment arity bodyS]) - (synthesis.function/abstraction [(list#each (function (_ captured) - (when captured - (synthesis.variable var) - (|> mapping - (dictionary.value captured) - (maybe.else var) - synthesis.variable) + (synthesis.function/abstraction @ [environment arity bodyS]) + (synthesis.function/abstraction @ [(list#each (function (_ captured) + (when captured + (synthesis.variable @ var) + (|> mapping + (dictionary.value captured) + (maybe.else var) + (synthesis.variable @)) - _ - captured)) - environment) - arity - bodyS]) + _ + captured)) + environment) + arity + bodyS]) - (synthesis.function/apply [functionS inputsS+]) - (synthesis.function/apply [(again functionS) (list#each again inputsS+)]) + (synthesis.function/apply @ [functionS inputsS+]) + (synthesis.function/apply @ [(again functionS) (list#each again inputsS+)]) - {synthesis.#Extension [name inputsS+]} - {synthesis.#Extension [name (list#each again inputsS+)]}))) + [@ {synthesis.#Extension [name inputsS+]}] + [@ {synthesis.#Extension [name (list#each again inputsS+)]}]))) (def $Object (type.class "java.lang.Object" (list))) @@ -1254,7 +1255,7 @@ local_mapping (|> environment list.enumeration (list#each (function (_ [foreign_id capture]) - [(synthesis.variable/foreign foreign_id) + [(synthesis.variable/foreign location.dummy foreign_id) (|> global_mapping (dictionary.value capture) maybe.trusted)])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux index c266d6999..64c98bdfa 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/synthesis/lux.lux @@ -9,6 +9,7 @@ ["[0]" list (.use "[1]#[0]" monad)] ["[0]" dictionary]]] [meta + ["[0]" location] ["[0]" symbol (.use "[1]#[0]" equivalence)] [compiler ["[0]" phase]]]]] @@ -34,7 +35,7 @@ (List Synthesis)) (|>> (list#each (function (_ it) (when it - {synthesis.#Extension actual parameters} + [@ {synthesis.#Extension actual parameters}] (if (symbol#= expected actual) parameters (list it)) @@ -49,7 +50,7 @@ (function (_ synthesis archive parts) (do [! phase.monad] [parts (monad.each ! (synthesis archive) parts)] - (in {synthesis.#Extension generation (flat_text_composite generation parts)}))))) + (in [location.dummy {synthesis.#Extension generation (flat_text_composite generation parts)}]))))) (def .public bundle Bundle diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux index c293cb44c..3c4de2531 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux @@ -7,14 +7,14 @@ ["[0]" try] ["[0]" exception (.only Exception)]] [data - [text + ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format]]] ["[0]" meta (.only) [macro ["^" pattern]] [target [jvm - [bytecode (.only Bytecode)]]] + ["_" bytecode (.only Bytecode)]]] [type ["[0]" check]] [compiler @@ -35,65 +35,94 @@ ["[0]" extension] [// ["[0]" synthesis (.only Synthesis)] + ["[0]" generation] [/// ["[0]" reference] - ["[1]" phase (.use "[1]#[0]" monad)]]]]]) + ["[0]" phase (.use "[1]#[0]" monad)]]]]]) + +(def (with_source_mapping @ it) + (All (_ of) + (-> Location (Operation (Bytecode of)) + (Operation (Bytecode of)))) + (do [! phase.monad] + [.let [[expected_module line column] @] + actual_module generation.module + it it] + (in (if (text#= expected_module actual_module) + (do _.monad + [_ (_.map line)] + it) + it)))) (def .public (generate extender lux) (-> extension.Extender Lux Phase) (function (phase archive synthesis) (when synthesis (^.with_template [<tag> <generator>] - [(<tag> value) - (///#in (<generator> value))]) + [(<tag> @ value) + (with_source_mapping @ + (phase#in (<generator> value)))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] [synthesis.text /primitive.text]) - (synthesis.variant variantS) - (/structure.variant phase archive variantS) + (synthesis.variant @ variantS) + (with_source_mapping @ + (/structure.variant phase archive variantS)) - (synthesis.tuple members) - (/structure.tuple phase archive members) + (synthesis.tuple @ members) + (with_source_mapping @ + (/structure.tuple phase archive members)) - {synthesis.#Reference reference} - (when reference - {reference.#Variable variable} - (/reference.variable archive variable) - - {reference.#Constant constant} - (/reference.constant archive constant)) + [@ {synthesis.#Reference reference}] + (with_source_mapping @ + (when reference + {reference.#Variable variable} + (/reference.variable archive variable) + + {reference.#Constant constant} + (/reference.constant archive constant))) - (synthesis.branch/when [valueS pathS]) - (/when.when phase archive [valueS pathS]) + (synthesis.branch/when @ [valueS pathS]) + (with_source_mapping @ + (/when.when phase archive [valueS pathS])) - (synthesis.branch/exec [this that]) - (/when.exec phase archive [this that]) + (synthesis.branch/exec @ [this that]) + (with_source_mapping @ + (/when.exec phase archive [this that])) - (synthesis.branch/let [inputS register bodyS]) - (/when.let phase archive [inputS register bodyS]) + (synthesis.branch/let @ [inputS register bodyS]) + (with_source_mapping @ + (/when.let phase archive [inputS register bodyS])) - (synthesis.branch/if [conditionS thenS elseS]) - (/when.if phase archive [conditionS thenS elseS]) + (synthesis.branch/if @ [conditionS thenS elseS]) + (with_source_mapping @ + (/when.if phase archive [conditionS thenS elseS])) - (synthesis.branch/get [path recordS]) - (/when.get phase archive [path recordS]) + (synthesis.branch/get @ [path recordS]) + (with_source_mapping @ + (/when.get phase archive [path recordS])) - (synthesis.loop/scope scope) - (/loop.scope phase archive scope) + (synthesis.loop/scope @ scope) + (with_source_mapping @ + (/loop.scope phase archive scope)) - (synthesis.loop/again updates) - (/loop.again phase archive updates) + (synthesis.loop/again @ updates) + (with_source_mapping @ + (/loop.again phase archive updates)) - (synthesis.function/abstraction abstraction) - (/function.abstraction phase archive abstraction) + (synthesis.function/abstraction @ abstraction) + (with_source_mapping @ + (/function.abstraction phase archive abstraction)) - (synthesis.function/apply application) - (/function.apply phase archive application) + (synthesis.function/apply @ application) + (with_source_mapping @ + (/function.apply phase archive application)) - {synthesis.#Extension [name parameters]} - (extension.application extender lux phase archive .Generation false name parameters - (|>>) - (function (_ _) {.#None})) + [@ {synthesis.#Extension [name parameters]}] + (with_source_mapping @ + (extension.application extender lux phase archive .Generation false name parameters + (|>>) + (function (_ _) {.#None}))) ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux index 76640103d..0f4221157 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function.lux @@ -3,12 +3,14 @@ [lux (.except Type Label Synthesis with) [abstract ["[0]" monad (.only do)]] + [control + ["[0]" try]] [data ["[0]" product] [binary ["[0]" \\format]] [collection - ["[0]" list (.use "[1]#[0]" monoid functor)] + ["[0]" list (.use "[1]#[0]" monoid mix functor)] ["[0]" sequence]]] [math [number @@ -20,10 +22,10 @@ ["_" bytecode (.only Label Bytecode) (.use "[1]#[0]" monad)] ["[0]" version] ["[0]" modifier (.only Modifier) (.use "[1]#[0]" monoid)] - ["[0]" attribute] ["[0]" field (.only Field)] ["[0]" method (.only Method)] ["[0]" class (.only Class)] + ["[0]" attribute] ["[0]" type (.only Type) [category (.only Return' Value')] ["[0]" reflection]] @@ -83,10 +85,10 @@ (if (arity.multiary? arity) (|> (n.min arity /arity.maximum) list.indices - (list#each (|>> ++ (/apply.method classT environment arity @begin body))) + (list#each (|>> ++ (/apply.method classT environment arity @begin))) (list.partial (/implementation.method classT arity @begin body))) (list (/implementation.method classT arity @begin body) - (/apply.method classT environment arity @begin body 1)))))] + (/apply.method classT environment arity @begin 1)))))] (do phase.monad [instance (/new.instance generate archive classT environment arity)] (in [fields methods instance])))) @@ -97,22 +99,25 @@ class.public class.final)) -(def this_offset 1) +(def this_offset + 1) (def internal (All (_ category) (-> (Type (<| Return' Value' category)) Internal)) - (|>> type.reflection reflection.reflection name.internal)) + (|>> type.reflection + reflection.reflection + name.internal)) (def .public (abstraction generate archive [environment arity bodyS]) (Generator Abstraction) (do phase.monad [dependencies (cache/artifact.dependencies archive bodyS) @begin //runtime.forge_label - [function_context bodyG] (generation.with_new_context archive dependencies - (generation.with_anchor [@begin ..this_offset] - (generate archive bodyS))) + [function_context bodyG] (<| (generation.with_new_context archive dependencies) + (generation.with_anchor [@begin ..this_offset]) + (generate archive bodyS)) .let [function_class (//runtime.class_name function_context)] [fields methods instance] (..with generate archive @begin function_class environment arity bodyG) module generation.module @@ -173,7 +178,7 @@ (def .public (apply generate archive [abstractionS inputsS]) (Generator Apply) (when abstractionS - (synthesis.constant $abstraction) + (synthesis.constant @ $abstraction) (do [! phase.monad] [[@definition |abstraction|] (generation.definition archive $abstraction) .let [actual_arity (list.size inputsS)]] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index 2efd2e739..34a552ba6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -79,8 +79,8 @@ (def this_offset 1) -(def .public (method class environment function_arity @begin body apply_arity) - (-> (Type Class) (Environment Synthesis) Arity Label (Bytecode Any) Arity (Resource Method)) +(def .public (method class environment function_arity @begin apply_arity) + (-> (Type Class) (Environment Synthesis) Arity Label Arity (Resource Method)) (let [num_partials (-- function_arity) over_extent (i.- (.int apply_arity) (.int function_arity))] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux index a4dedf683..1a6682f08 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm/loop.lux @@ -30,7 +30,7 @@ (def (invariant? register changeS) (-> Register Synthesis Bit) (when changeS - (synthesis.variable/local var) + (synthesis.variable/local @ var) (n.= register var) _ diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux index 83605d36c..a840feeb8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux @@ -59,47 +59,47 @@ (-> Extender Lux Phase) (function (phase archive analysis) (when analysis - {///analysis.#Simple analysis'} - (phase#in {/.#Simple (..simple analysis')}) + [@ {///analysis.#Simple analysis'}] + (phase#in [@ {/.#Simple (..simple analysis')}]) - {///analysis.#Reference reference} - (phase#in {/.#Reference reference}) + [@ {///analysis.#Reference reference}] + (phase#in [@ {/.#Reference reference}]) - {///analysis.#Structure structure} + [@ {///analysis.#Structure structure}] (/.with_currying? false (when structure {///complex.#Variant variant} (phase#each (function (_ valueS) - (/.variant (has ///complex.#value valueS variant))) + (/.variant @ (has ///complex.#value valueS variant))) (phase archive (the ///complex.#value variant))) {///complex.#Tuple tuple} (|> tuple (monad.each phase.monad (phase archive)) - (phase#each (|>> /.tuple))))) + (phase#each (|>> (/.tuple @)))))) - {///analysis.#When inputA branchesAB+} + [@ {///analysis.#When inputA branchesAB+}] (/.with_currying? false - (/when.synthesize phase branchesAB+ archive inputA)) + (/when.synthesize @ phase branchesAB+ archive inputA)) - (///analysis.no_op value) + (///analysis.no_op @ value) (phase archive value) - {///analysis.#Apply _} + [@ {///analysis.#Apply _}] (/.with_currying? false - (/function.apply phase archive analysis)) + (/function.apply @ phase archive analysis)) - {///analysis.#Function environmentA bodyA} - (/function.abstraction phase environmentA archive bodyA) + [@ {///analysis.#Function environmentA bodyA}] + (/function.abstraction @ phase environmentA archive bodyA) - {///analysis.#Extension name parameters} + [@ {///analysis.#Extension name parameters}] (extension.application extender lux phase archive .Synthesis false name parameters (|>>) (function (_ _) {.#Some (|> parameters (monad.each phase.monad (phase archive)) - (phase#each (|>> [name] {/.#Extension})))})) + (phase#each (|>> [name] {/.#Extension} [@])))})) ))) (def .public (phase extender lux archive analysis) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux index 7f9b5f218..f985b86ba 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/function.lux @@ -37,30 +37,20 @@ (list ["Foreign" (%.nat foreign)] ["Environment" (exception.listing /.%synthesis environment)]))) -(def arity_arguments - (-> Arity (List Synthesis)) - (|>> -- - (enum.range n.enum 1) - (list#each (|>> /.variable/local)))) - (def .public self_reference - (template (self_reference) - [(/.variable/local 0)])) - -(def (expanded_nested_self_reference arity) - (-> Arity Synthesis) - (/.function/apply [(..self_reference) (arity_arguments arity)])) + (template (self_reference @) + [(/.variable/local @ 0)])) -(def .public (apply phase) - (-> Phase Phase) +(def .public (apply @ phase) + (-> Location Phase Phase) (function (_ archive exprA) (let [[funcA argsA] (////analysis.reification exprA)] (do [! phase.monad] [funcS (phase archive funcA) argsS (monad.each ! (phase archive) argsA)] - (with_expansions [<apply> (these (/.function/apply [funcS argsS]))] + (with_expansions [<apply> (these (/.function/apply @ [funcS argsS]))] (when funcS - (/.function/abstraction functionS) + (/.function/abstraction @ functionS) (if (n.= (the /.#arity functionS) (list.size argsS)) (do ! @@ -70,19 +60,19 @@ (maybe#each (is (-> [Nat (List Synthesis) Synthesis] Synthesis) (function (_ [start inits iteration]) (when iteration - (/.loop/scope [start' inits' output]) + (/.loop/scope @ [start' inits' output]) (if (and (n.= start start') (list.empty? inits')) - (/.loop/scope [start inits output]) - (/.loop/scope [start inits iteration])) + (/.loop/scope @ [start inits output]) + (/.loop/scope @ [start inits iteration])) _ - (/.loop/scope [start inits iteration]))))) + (/.loop/scope @ [start inits iteration]))))) (maybe.else <apply>)))) (in <apply>)) - (/.function/apply [funcS' argsS']) - (in (/.function/apply [funcS' (list#composite argsS' argsS)])) + (/.function/apply @ [funcS' argsS']) + (in (/.function/apply @ [funcS' (list#composite argsS' argsS)])) _ (in <apply>))))))) @@ -146,27 +136,27 @@ (def (grow environment expression) (-> (Environment Synthesis) Synthesis (Operation Synthesis)) (when expression - {/.#Structure structure} + [@ {/.#Structure structure}] (when structure {////analysis/complex.#Variant [lefts right? subS]} (|> subS (grow environment) - (phase#each (|>> [lefts right?] /.variant))) + (phase#each (|>> [lefts right?] (/.variant @)))) {////analysis/complex.#Tuple membersS+} (|> membersS+ (monad.each phase.monad (grow environment)) - (phase#each (|>> /.tuple)))) + (phase#each (|>> (/.tuple @))))) - (..self_reference) - (phase#in (/.function/apply [expression (list (/.variable/local 1))])) + (..self_reference @) + (phase#in (/.function/apply @ [expression (list (/.variable/local @ 1))])) - {/.#Reference reference} + [@ {/.#Reference reference}] (when reference {////reference.#Variable variable} (when variable {////reference/variable.#Local register} - (phase#in (/.variable/local (++ register))) + (phase#in (/.variable/local @ (++ register))) {////reference/variable.#Foreign register} (..find_foreign environment register)) @@ -174,7 +164,7 @@ {////reference.#Constant constant} (phase#in expression)) - {/.#Control control} + [@ {/.#Control control}] (when control {/.#Branch branch} (when branch @@ -182,31 +172,31 @@ (do phase.monad [this (grow environment this) that (grow environment that)] - (in (/.branch/exec [this that]))) + (in (/.branch/exec @ [this that]))) {/.#Let [inputS register bodyS]} (do phase.monad [inputS' (grow environment inputS) bodyS' (grow environment bodyS)] - (in (/.branch/let [inputS' (++ register) bodyS']))) + (in (/.branch/let @ [inputS' (++ register) bodyS']))) {/.#If [testS thenS elseS]} (do phase.monad [testS' (grow environment testS) thenS' (grow environment thenS) elseS' (grow environment elseS)] - (in (/.branch/if [testS' thenS' elseS']))) + (in (/.branch/if @ [testS' thenS' elseS']))) {/.#Get members inputS} (do phase.monad [inputS' (grow environment inputS)] - (in (/.branch/get [members inputS']))) + (in (/.branch/get @ [members inputS']))) {/.#When [inputS pathS]} (do phase.monad [inputS' (grow environment inputS) pathS' (grow_path (grow environment) pathS)] - (in (/.branch/when [inputS' pathS'])))) + (in (/.branch/when @ [inputS' pathS'])))) {/.#Loop loop} (when loop @@ -214,12 +204,12 @@ (do [! phase.monad] [initsS+' (monad.each ! (grow environment) initsS+) iterationS' (grow environment iterationS)] - (in (/.loop/scope [(++ start) initsS+' iterationS']))) + (in (/.loop/scope @ [(++ start) initsS+' iterationS']))) {/.#Again argumentsS+} (|> argumentsS+ (monad.each phase.monad (grow environment)) - (phase#each (|>> /.loop/again)))) + (phase#each (|>> (/.loop/again @))))) {/.#Function function} (when function @@ -227,37 +217,37 @@ (do [! phase.monad] [_env' (monad.each ! (|>> (pipe.when - {/.#Reference {////reference.#Variable {////reference/variable.#Foreign register}}} + [@ {/.#Reference {////reference.#Variable {////reference/variable.#Foreign register}}}] (..find_foreign environment register) captured (grow environment captured))) _env)] - (in (/.function/abstraction [_env' _arity _body]))) + (in (/.function/abstraction @ [_env' _arity _body]))) {/.#Apply funcS argsS+} (do [! phase.monad] [funcS (grow environment funcS) argsS+ (monad.each ! (grow environment) argsS+)] - (in (/.function/apply (when funcS - (/.function/apply [(..self_reference) pre_argsS+]) - [(..self_reference) - (list#composite pre_argsS+ argsS+)] + (in (/.function/apply @ (when funcS + (/.function/apply @ [(..self_reference @) pre_argsS+]) + [(..self_reference @) + (list#composite pre_argsS+ argsS+)] - _ - [funcS - argsS+])))))) + _ + [funcS + argsS+])))))) - {/.#Extension name argumentsS+} + [@ {/.#Extension name argumentsS+}] (|> argumentsS+ (monad.each phase.monad (grow environment)) - (phase#each (|>> {/.#Extension name}))) + (phase#each (|>> {/.#Extension name} [@]))) - {/.#Simple _} + [@ {/.#Simple _}] (phase#in expression))) -(def .public (abstraction phase environment archive bodyA) - (-> Phase (Environment Analysis) Phase) +(def .public (abstraction @ phase environment archive bodyA) + (-> Location Phase (Environment Analysis) Phase) (do [! phase.monad] [environment (monad.each ! (phase archive) environment) bodyS (/.with_currying? true @@ -265,7 +255,7 @@ (phase archive bodyA))) abstraction (is (Operation Abstraction) (when bodyS - (/.function/abstraction [env' down_arity' bodyS']) + (/.function/abstraction @ [env' down_arity' bodyS']) (|> bodyS' (grow env') (at ! each (function (_ body) @@ -278,14 +268,14 @@ /.#arity 1 /.#body bodyS]))) currying? /.currying?] - (in (/.function/abstraction - (if currying? - abstraction - (when (//loop.optimization false 1 (list) abstraction) - {.#Some [startL initsL bodyL]} - [/.#environment environment - /.#arity (the /.#arity abstraction) - /.#body (/.loop/scope [startL initsL bodyL])] - - {.#None} - abstraction)))))) + (in (<| (/.function/abstraction @) + (if currying? + abstraction + (when (//loop.optimization false 1 (list) abstraction) + {.#Some [startL initsL bodyL]} + [/.#environment environment + /.#arity (the /.#arity abstraction) + /.#body (/.loop/scope @ [startL initsL bodyL])] + + {.#None} + abstraction)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux index 0c73a8683..effe78818 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/loop.lux @@ -83,24 +83,24 @@ (loop (again [return? true expr expr]) (when expr - {/.#Simple _} + [@ {/.#Simple _}] {.#Some expr} - {/.#Structure structure} + [@ {/.#Structure structure}] (when structure {analysis/complex.#Variant variant} (do maybe.monad [value' (|> variant (the analysis/complex.#value) (again false))] (in (|> variant (has analysis/complex.#value value') - /.variant))) + (/.variant @)))) {analysis/complex.#Tuple tuple} (|> tuple (monad.each maybe.monad (again false)) - (maybe#each (|>> /.tuple)))) + (maybe#each (|>> (/.tuple @))))) - {/.#Reference reference} + [@ {/.#Reference reference}] (when reference {reference.#Variable (variable.self)} (if true_loop? @@ -111,74 +111,74 @@ {.#Some expr} (reference.local register) - {.#Some {/.#Reference (reference.local (register_optimization offset register))}} + {.#Some [@ {/.#Reference (reference.local (register_optimization offset register))}]} (reference.foreign register) (if true_loop? (list.item register scope_environment) {.#Some expr})) - (/.branch/when [input path]) + (/.branch/when @ [input path]) (do maybe.monad [input' (again false input) path' (path_optimization (again return?) offset path)] - (in (|> path' [input'] /.branch/when))) + (in (|> path' [input'] (/.branch/when @)))) - (/.branch/exec [this that]) + (/.branch/exec @ [this that]) (do maybe.monad [this (again false this) that (again return? that)] - (in (/.branch/exec [this that]))) + (in (/.branch/exec @ [this that]))) - (/.branch/let [input register body]) + (/.branch/let @ [input register body]) (do maybe.monad [input' (again false input) body' (again return? body)] - (in (/.branch/let [input' (register_optimization offset register) body']))) + (in (/.branch/let @ [input' (register_optimization offset register) body']))) - (/.branch/if [input then else]) + (/.branch/if @ [input then else]) (do maybe.monad [input' (again false input) then' (again return? then) else' (again return? else)] - (in (/.branch/if [input' then' else']))) + (in (/.branch/if @ [input' then' else']))) - (/.branch/get [path record]) + (/.branch/get @ [path record]) (do maybe.monad [record (again false record)] - (in (/.branch/get [path record]))) + (in (/.branch/get @ [path record]))) - (/.loop/scope scope) + (/.loop/scope @ scope) (do [! maybe.monad] [inits' (|> scope (the /.#inits) (monad.each ! (again false))) iteration' (again return? (the /.#iteration scope))] - (in (/.loop/scope [/.#start (|> scope (the /.#start) (register_optimization offset)) - /.#inits inits' - /.#iteration iteration']))) + (in (/.loop/scope @ [/.#start (|> scope (the /.#start) (register_optimization offset)) + /.#inits inits' + /.#iteration iteration']))) - (/.loop/again args) + (/.loop/again @ args) (|> args (monad.each maybe.monad (again false)) - (maybe#each (|>> /.loop/again))) + (maybe#each (|>> (/.loop/again @)))) - (/.function/abstraction [environment arity body]) + (/.function/abstraction @ [environment arity body]) (do [! maybe.monad] [environment' (monad.each ! (again false) environment)] - (in (/.function/abstraction [environment' arity body]))) + (in (/.function/abstraction @ [environment' arity body]))) - (/.function/apply [abstraction arguments]) + (/.function/apply @ [abstraction arguments]) (do [! maybe.monad] [arguments' (monad.each ! (again false) arguments)] (with_expansions [<application> (these (do ! [abstraction' (again false abstraction)] - (in (/.function/apply [abstraction' arguments']))))] + (in (/.function/apply @ [abstraction' arguments']))))] (when abstraction - {/.#Reference {reference.#Variable (variable.self)}} + [@ {/.#Reference {reference.#Variable (variable.self)}}] (if (and return? (n.= arity (list.size arguments))) - (in (/.loop/again arguments')) + (in (/.loop/again @ arguments')) (if true_loop? {.#None} <application>)) @@ -187,30 +187,31 @@ <application>))) ... TODO: Stop relying on this custom code. - {/.#Extension [[.prelude "when_char#|generation"] (list.partial input else matches)]} + [@ {/.#Extension [[.prelude "when_char#|generation"] (list.partial input else matches)]}] (if return? (do [! maybe.monad] [input (again false input) matches (monad.each ! - (function (_ match) - (when match - {/.#Structure {analysis/complex.#Tuple (list when then)}} - (do ! - [when (again false when) - then (again return? then)] - (in {/.#Structure {analysis/complex.#Tuple (list when then)}})) - - _ - (again false match))) + (is (-> Synthesis (Maybe Synthesis)) + (function (_ match) + (when match + [@ {/.#Structure {analysis/complex.#Tuple (list when then)}}] + (do ! + [when (again false when) + then (again return? then)] + (in [@ {/.#Structure {analysis/complex.#Tuple (list when then)}}])) + + _ + (again false match)))) matches) else (again return? else)] - (in {/.#Extension [[.prelude "when_char#|generation"] (list.partial input else matches)]})) + (in [@ {/.#Extension [[.prelude "when_char#|generation"] (list.partial input else matches)]}])) {.#None}) - {/.#Extension [name args]} + [@ {/.#Extension [name args]}] (|> args (monad.each maybe.monad (again false)) - (maybe#each (|>> [name] {/.#Extension})))))) + (maybe#each (|>> [name] {/.#Extension} [@])))))) (def .public (optimization true_loop? offset inits functionS) (-> Bit Register (List Synthesis) Abstraction (Maybe [Register (List Synthesis) Synthesis])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux index 2ae6884e2..22cafb4ae 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/variable.lux @@ -112,69 +112,69 @@ (Remover Synthesis) (function (again synthesis) (when synthesis - {/.#Simple _} + [@ {/.#Simple _}] synthesis - {/.#Structure structure} - {/.#Structure (when structure - {analysis/complex.#Variant [lefts right value]} - {analysis/complex.#Variant [lefts right (again value)]} - - {analysis/complex.#Tuple tuple} - {analysis/complex.#Tuple (list#each again tuple)})} + [@ {/.#Structure structure}] + [@ {/.#Structure (when structure + {analysis/complex.#Variant [lefts right value]} + {analysis/complex.#Variant [lefts right (again value)]} + + {analysis/complex.#Tuple tuple} + {analysis/complex.#Tuple (list#each again tuple)})}] - {/.#Reference reference} + [@ {/.#Reference reference}] (when reference {reference.#Variable variable} - (/.variable (..remove_local_from_variable redundant variable)) + (/.variable @ (..remove_local_from_variable redundant variable)) {reference.#Constant constant} synthesis) - {/.#Control control} - {/.#Control (when control - {/.#Branch branch} - {/.#Branch (when branch - {/.#Exec this that} - {/.#Exec (again this) - (again that)} - - {/.#Let input register output} - {/.#Let (again input) - (..prune redundant register) - (again output)} - - {/.#If test then else} - {/.#If (again test) (again then) (again else)} - - {/.#Get path record} - {/.#Get path (again record)} - - {/.#When input path} - {/.#When (again input) (remove_local_from_path remove_local redundant path)})} - - {/.#Loop loop} - {/.#Loop (when loop - {/.#Scope [start inits iteration]} - {/.#Scope [(..prune redundant start) - (list#each again inits) - (again iteration)]} - - {/.#Again resets} - {/.#Again (list#each again resets)})} - - {/.#Function function} - {/.#Function (when function - {/.#Abstraction [environment arity body]} - {/.#Abstraction [(list#each again environment) - arity - body]} - - {/.#Apply abstraction inputs} - {/.#Apply (again abstraction) (list#each again inputs)})})} + [@ {/.#Control control}] + [@ {/.#Control (when control + {/.#Branch branch} + {/.#Branch (when branch + {/.#Exec this that} + {/.#Exec (again this) + (again that)} + + {/.#Let input register output} + {/.#Let (again input) + (..prune redundant register) + (again output)} + + {/.#If test then else} + {/.#If (again test) (again then) (again else)} + + {/.#Get path record} + {/.#Get path (again record)} + + {/.#When input path} + {/.#When (again input) (remove_local_from_path remove_local redundant path)})} + + {/.#Loop loop} + {/.#Loop (when loop + {/.#Scope [start inits iteration]} + {/.#Scope [(..prune redundant start) + (list#each again inits) + (again iteration)]} + + {/.#Again resets} + {/.#Again (list#each again resets)})} + + {/.#Function function} + {/.#Function (when function + {/.#Abstraction [environment arity body]} + {/.#Abstraction [(list#each again environment) + arity + body]} + + {/.#Apply abstraction inputs} + {/.#Apply (again abstraction) (list#each again inputs)})})}] - {/.#Extension name inputs} - {/.#Extension name (list#each again inputs)}))) + [@ {/.#Extension name inputs}] + [@ {/.#Extension name (list#each again inputs)}]))) (type Redundancy (Dictionary Register Bit)) @@ -336,24 +336,24 @@ (with_expansions [<no_op> (these {try.#Success [redundancy synthesis]})] (when synthesis - {/.#Simple _} + [@ {/.#Simple _}] <no_op> - {/.#Structure structure} + [@ {/.#Structure structure}] (when structure {analysis/complex.#Variant [lefts right value]} (do try.monad [[redundancy value] (optimization' [redundancy value])] (in [redundancy - {/.#Structure {analysis/complex.#Variant [lefts right value]}}])) + [@ {/.#Structure {analysis/complex.#Variant [lefts right value]}}]])) {analysis/complex.#Tuple tuple} (do try.monad [[redundancy tuple] (..list_optimization optimization' [redundancy tuple])] (in [redundancy - {/.#Structure {analysis/complex.#Tuple tuple}}]))) + [@ {/.#Structure {analysis/complex.#Tuple tuple}}]]))) - {/.#Reference reference} + [@ {/.#Reference reference}] (when reference {reference.#Variable variable} (when variable @@ -368,7 +368,7 @@ {reference.#Constant constant} <no_op>) - {/.#Control control} + [@ {/.#Control control}] (when control {/.#Branch branch} (when branch @@ -377,7 +377,7 @@ [[redundancy this] (optimization' [redundancy this]) [redundancy that] (optimization' [redundancy that])] (in [redundancy - (/.branch/exec [this that])])) + (/.branch/exec @ [this that])])) {/.#Let input register output} (do try.monad @@ -388,9 +388,9 @@ (dictionary.value register) (maybe.else ..necessary!))]] (in [(dictionary.lacks register redundancy) - {/.#Control {/.#Branch (if redundant? - {/.#Exec input (..remove_local register output)} - {/.#Let input register output})}}])) + [@ {/.#Control {/.#Branch (if redundant? + {/.#Exec input (..remove_local register output)} + {/.#Let input register output})}}]])) {/.#If test then else} (do try.monad @@ -398,20 +398,20 @@ [redundancy then] (optimization' [redundancy then]) [redundancy else] (optimization' [redundancy else])] (in [redundancy - {/.#Control {/.#Branch {/.#If test then else}}}])) + [@ {/.#Control {/.#Branch {/.#If test then else}}}]])) {/.#Get path record} (do try.monad [[redundancy record] (optimization' [redundancy record])] (in [redundancy - {/.#Control {/.#Branch {/.#Get path record}}}])) + [@ {/.#Control {/.#Branch {/.#Get path record}}}]])) {/.#When input path} (do try.monad [[redundancy input] (optimization' [redundancy input]) [redundancy path] (..path_optimization optimization' [redundancy path])] (in [redundancy - {/.#Control {/.#Branch {/.#When input path}}}]))) + [@ {/.#Control {/.#Branch {/.#When input path}}}]]))) {/.#Loop loop} (when loop @@ -421,13 +421,13 @@ .let [[extension redundancy] (..extended start (list.size inits) redundancy)] [redundancy iteration] (optimization' [redundancy iteration])] (in [(list#mix dictionary.lacks redundancy extension) - {/.#Control {/.#Loop {/.#Scope [start inits iteration]}}}])) + [@ {/.#Control {/.#Loop {/.#Scope [start inits iteration]}}}]])) {/.#Again resets} (do try.monad [[redundancy resets] (..list_optimization optimization' [redundancy resets])] (in [redundancy - {/.#Control {/.#Loop {/.#Again resets}}}]))) + [@ {/.#Control {/.#Loop {/.#Again resets}}}]]))) {/.#Function function} (when function @@ -436,20 +436,20 @@ [[redundancy environment] (..list_optimization optimization' [redundancy environment]) [_ body] (optimization' [(..default arity) body])] (in [redundancy - {/.#Control {/.#Function {/.#Abstraction [environment arity body]}}}])) + [@ {/.#Control {/.#Function {/.#Abstraction [environment arity body]}}}]])) {/.#Apply abstraction inputs} (do try.monad [[redundancy abstraction] (optimization' [redundancy abstraction]) [redundancy inputs] (..list_optimization optimization' [redundancy inputs])] (in [redundancy - {/.#Control {/.#Function {/.#Apply abstraction inputs}}}])))) + [@ {/.#Control {/.#Function {/.#Apply abstraction inputs}}}]])))) - {/.#Extension name inputs} + [@ {/.#Extension name inputs}] (do try.monad [[redundancy inputs] (..list_optimization optimization' [redundancy inputs])] (in [redundancy - {/.#Extension name inputs}]))))) + [@ {/.#Extension name inputs}]]))))) (def .public optimization (-> Synthesis (Try Synthesis)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux index 10c58a62f..98248e985 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis/when.lux @@ -128,7 +128,8 @@ (list#mix (..weave_branch weave equivalence) old_fork {.#Item new_fork})) (def (weave new old) - (-> Path Path Path) + (-> Path Path + Path) (with_expansions [<default> (these {/.#Alt old new})] (when [new old] [_ @@ -205,7 +206,8 @@ <default>))) (def (get patterns @selection) - (-> (///complex.Tuple Pattern) Register (List Member)) + (-> (///complex.Tuple Pattern) Register + (List Member)) (loop (again [lefts 0 patterns patterns]) (with_expansions [<failure> (these (list)) @@ -241,87 +243,87 @@ _ <failure>))))) -(def .public (synthesize_when synthesize archive input [[headP headA] tailPA+]) - (-> Phase Archive Synthesis Match (Operation Synthesis)) +(def .public (synthesize_when synthesize @ archive input [[headP headA] tailPA+]) + (-> Phase Location Archive Synthesis Match (Operation Synthesis)) (do [! ///.monad] [headSP (path archive synthesize headP headA) tailSP+ (monad.each ! (product.uncurried (path archive synthesize)) tailPA+)] - (in (/.branch/when [input (list#mix weave headSP tailSP+)])))) + (in (/.branch/when @ [input (list#mix weave headSP tailSP+)])))) (def !masking - (template (_ <variable> <output>) + (template (_ <@> <variable> <output>) [[[{///pattern.#Bind <variable>} - {///analysis.#Reference (///reference.local <output>)}] + [<@> {///analysis.#Reference (///reference.local <output>)}]] (list)]])) -(def .public (synthesize_exec synthesize archive before after) - (-> Phase Archive Synthesis Analysis (Operation Synthesis)) +(def .public (synthesize_exec synthesize @ archive before after) + (-> Phase Location Archive Synthesis Analysis (Operation Synthesis)) (do ///.monad [after (synthesize archive after)] - (in (/.branch/exec [before after])))) + (in (/.branch/exec @ [before after])))) -(def .public (synthesize_let synthesize archive input @variable body) - (-> Phase Archive Synthesis Register Analysis (Operation Synthesis)) +(def .public (synthesize_let synthesize @ archive input @variable body) + (-> Phase Location Archive Synthesis Register Analysis (Operation Synthesis)) (do ///.monad [body (/.with_new_local (synthesize archive body))] - (in (/.branch/let [input @variable body])))) + (in (/.branch/let @ [input @variable body])))) -(def .public (synthesize_masking synthesize archive input @variable @output) - (-> Phase Archive Synthesis Register Register (Operation Synthesis)) +(def .public (synthesize_masking synthesize @ archive input @variable @output) + (-> Phase Location Archive Synthesis Register Register (Operation Synthesis)) (if (n.= @variable @output) (///#in input) - (..synthesize_let synthesize archive input @variable {///analysis.#Reference (///reference.local @output)}))) + (..synthesize_let synthesize @ archive input @variable [@ {///analysis.#Reference (///reference.local @output)}]))) -(def .public (synthesize_if synthesize archive test then else) - (-> Phase Archive Synthesis Analysis Analysis (Operation Synthesis)) +(def .public (synthesize_if synthesize @ archive test then else) + (-> Phase Location Archive Synthesis Analysis Analysis (Operation Synthesis)) (do ///.monad [then (synthesize archive then) else (synthesize archive else)] - (in (/.branch/if [test then else])))) + (in (/.branch/if @ [test then else])))) (def !get - (template (_ <patterns> <output>) + (template (_ <@> <patterns> <output>) [[[(///pattern.tuple <patterns>) - {///analysis.#Reference (///reference.local <output>)}] + [<@> {///analysis.#Reference (///reference.local <output>)}]] (.list)]])) -(def .public (synthesize_get synthesize archive input patterns @member) - (-> Phase Archive Synthesis (///complex.Tuple Pattern) Register (Operation Synthesis)) +(def .public (synthesize_get synthesize @ archive input patterns @member) + (-> Phase Location Archive Synthesis (///complex.Tuple Pattern) Register (Operation Synthesis)) (when (..get patterns @member) {.#End} - (..synthesize_when synthesize archive input (!get patterns @member)) + (..synthesize_when synthesize @ archive input (!get @ patterns @member)) path - (when input - (/.branch/get [sub_path sub_input]) - (///#in (/.branch/get [(list#composite path sub_path) sub_input])) + (///#in (when input + (/.branch/get @ [sub_path sub_input]) + (/.branch/get @ [(list#composite path sub_path) sub_input]) - _ - (///#in (/.branch/get [path input]))))) + _ + (/.branch/get @ [path input]))))) -(def .public (synthesize synthesize^ [headB tailB+] archive inputA) - (-> Phase Match Phase) +(def .public (synthesize @ synthesize^ [headB tailB+] archive inputA) + (-> Location Phase Match Phase) (do [! ///.monad] [inputS (synthesize^ archive inputA)] (when [headB tailB+] - (!masking @variable @output) - (..synthesize_masking synthesize^ archive inputS @variable @output) + (!masking @ @variable @output) + (..synthesize_masking synthesize^ @ archive inputS @variable @output) [[(///pattern.unit) body] {.#End}] (when inputA - (^.or {///analysis.#Simple _} - {///analysis.#Structure _} - {///analysis.#Reference _}) + (^.or [@ {///analysis.#Simple _}] + [@ {///analysis.#Structure _}] + [@ {///analysis.#Reference _}]) (synthesize^ archive body) _ - (..synthesize_exec synthesize^ archive inputS body)) + (..synthesize_exec synthesize^ @ archive inputS body)) [[{///pattern.#Bind @variable} body] {.#End}] - (..synthesize_let synthesize^ archive inputS @variable body) + (..synthesize_let synthesize^ @ archive inputS @variable body) (^.or [[(///pattern.bit .true) then] (list [(///pattern.bit .false) else])] @@ -332,13 +334,13 @@ (list [(///pattern.bit .true) then])] [[(///pattern.bit .false) else] (list [(///pattern.unit) then])]) - (..synthesize_if synthesize^ archive inputS then else) + (..synthesize_if synthesize^ @ archive inputS then else) - (!get patterns @member) - (..synthesize_get synthesize^ archive inputS patterns @member) + (!get @ patterns @member) + (..synthesize_get synthesize^ @ archive inputS patterns @member) match - (..synthesize_when synthesize^ archive inputS match)))) + (..synthesize_when synthesize^ @ archive inputS match)))) (def .public (count_pops path) (-> Path [Nat Path]) @@ -406,39 +408,39 @@ (loop (for_synthesis [bodyS bodyS synthesis_storage path_storage]) (when bodyS - (^.or {/.#Simple _} - (/.constant _)) + (^.or [@ {/.#Simple _}] + (/.constant @ _)) synthesis_storage - (/.variant [lefts right? valueS]) + (/.variant @ [lefts right? valueS]) (for_synthesis valueS synthesis_storage) - (/.tuple members) + (/.tuple @ members) (list#mix for_synthesis synthesis_storage members) - {/.#Reference {///reference.#Variable {///reference/variable.#Local register}}} + [@ {/.#Reference {///reference.#Variable {///reference/variable.#Local register}}}] (if (set.member? (the #bindings synthesis_storage) register) synthesis_storage (revised #dependencies (set.has {///reference/variable.#Local register}) synthesis_storage)) - {/.#Reference {///reference.#Variable var}} + [@ {/.#Reference {///reference.#Variable var}}] (revised #dependencies (set.has var) synthesis_storage) - (/.function/apply [functionS argsS]) + (/.function/apply @ [functionS argsS]) (list#mix for_synthesis synthesis_storage {.#Item functionS argsS}) - (/.function/abstraction [environment arity bodyS]) + (/.function/abstraction @ [environment arity bodyS]) (list#mix for_synthesis synthesis_storage environment) - (/.branch/when [inputS pathS]) + (/.branch/when @ [inputS pathS]) (revised #dependencies (set.union (the #dependencies (for_path pathS synthesis_storage))) (for_synthesis inputS synthesis_storage)) - (/.branch/exec [before after]) + (/.branch/exec @ [before after]) (list#mix for_synthesis synthesis_storage (list before after)) - (/.branch/let [inputS register exprS]) + (/.branch/let @ [inputS register exprS]) (revised #dependencies (set.union (|> synthesis_storage (revised #bindings (set.has register)) @@ -446,13 +448,13 @@ (the #dependencies))) (for_synthesis inputS synthesis_storage)) - (/.branch/if [testS thenS elseS]) + (/.branch/if @ [testS thenS elseS]) (list#mix for_synthesis synthesis_storage (list testS thenS elseS)) - (/.branch/get [access whole]) + (/.branch/get @ [access whole]) (for_synthesis whole synthesis_storage) - (/.loop/scope [start initsS+ iterationS]) + (/.loop/scope @ [start initsS+ iterationS]) (revised #dependencies (set.union (|> synthesis_storage (revised #bindings (set.union (|> initsS+ @@ -463,9 +465,9 @@ (the #dependencies))) (list#mix for_synthesis synthesis_storage initsS+)) - (/.loop/again replacementsS+) + (/.loop/again @ replacementsS+) (list#mix for_synthesis synthesis_storage replacementsS+) - {/.#Extension [extension argsS]} + [@ {/.#Extension [extension argsS]}] (list#mix for_synthesis synthesis_storage argsS))) ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index ac6c959bc..957296e67 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -122,14 +122,18 @@ {#Loop (Loop s)} {#Function (Function s)})) -(type .public Synthesis - (Rec Synthesis +(with_expansions [@ ($ (Synthesis' $))] + (type .public (Synthesis' $) (Variant {#Simple Simple} - {#Structure (Complex Synthesis)} + {#Structure (Complex @)} {#Reference Reference} - {#Control (Control Synthesis)} - {#Extension (Extension Synthesis)}))) + {#Control (Control @)} + {#Extension (Extension @)}))) + +(type .public Synthesis + (Ann Location + (Synthesis' (Ann Location)))) (type .public Operation (phase.Operation State)) @@ -237,8 +241,8 @@ (with_template [<name> <tag>] [(def .public <name> - (template (<name> content) - [{..#Simple {<tag> content}}]))] + (template (<name> <@> content) + [[<@> {..#Simple {<tag> content}}]]))] [bit /simple.#Bit] [i64 /simple.#I64] @@ -248,8 +252,9 @@ (with_template [<name> <tag>] [(def .public <name> - (template (<name> content) - [(.<| {..#Structure} + (template (<name> <@> content) + [(.<| [<@>] + {..#Structure} {<tag>} content)]))] @@ -259,8 +264,9 @@ (with_template [<name> <tag>] [(def .public <name> - (template (<name> content) - [(.<| {..#Reference} + (template (<name> <@> content) + [(.<| [<@>] + {..#Reference} <tag> content)]))] @@ -272,8 +278,9 @@ (with_template [<name> <family> <tag>] [(def .public <name> - (template (<name> content) - [(.<| {..#Control} + (template (<name> <@> content) + [(.<| [<@>] + {..#Control} {<family>} {<tag>} content)]))] @@ -335,7 +342,7 @@ (|> (%then then) (text.enclosed ["(! " ")"])))) -(def .public (%synthesis value) +(def .public (%synthesis [_ value]) (Format Synthesis) (when value {#Simple it} @@ -690,7 +697,7 @@ (def .public equivalence (Equivalence Synthesis) (implementation - (def (= reference sample) + (def (= [_ reference] [_ sample]) (when [reference sample] (^.with_template [<tag> <equivalence>] [[{<tag> reference'} {<tag> sample'}] @@ -717,7 +724,7 @@ (let [again_hash [..equivalence hash]] (when value (^.with_template [<factor> <tag> <hash>] - [{<tag> value} + [[_ {<tag> value}] (n.* <factor> (at <hash> hash value))]) ([02 #Simple /simple.hash] [03 #Structure (analysis/complex.hash again_hash)] diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux index 831a6e282..fc15276d7 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/artifact.lux @@ -74,7 +74,7 @@ {synthesis.#Then then} (references then)))) -(def (references value) +(def (references [_ value]) (-> Synthesis (List Constant)) (when value {synthesis.#Simple value} diff --git a/stdlib/source/library/lux/meta/target/jvm/attribute.lux b/stdlib/source/library/lux/meta/target/jvm/attribute.lux index f3410723a..04d68cb41 100644 --- a/stdlib/source/library/lux/meta/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/meta/target/jvm/attribute.lux @@ -27,7 +27,8 @@ ["[2][0]" pool (.only Pool Resource) (.use "[1]#[0]" monad)]]] ["[0]" / ["[1][0]" constant (.only Constant)] - ["[1][0]" code]]) + ["[1][0]" code] + ["[1][0]" line_number_table (.only Line_Number_Table)]]) (type .public (Info about) (Record @@ -62,7 +63,8 @@ {#Constant (Info (Constant Any))} {#Code (Info <Code>)} {#Signature (Info (Index UTF8))} - {#Source_File (Info (Index UTF8))}))) + {#Source_File (Info (Index UTF8))} + {#Line_Number_Table (Info Line_Number_Table)}))) (type .public Code <Code>) @@ -77,6 +79,7 @@ (info_equivalence (/code.equivalence equivalence)) (info_equivalence //index.equivalence) (info_equivalence //index.equivalence) + (info_equivalence /line_number_table.equivalence) )))) (def common_attribute_length @@ -96,7 +99,8 @@ ([#Constant] [#Code] [#Signature] - [#Source_File]))) + [#Source_File] + [#Line_Number_Table]))) ... TODO: Inline ASAP (def (constant' index @name) @@ -136,9 +140,10 @@ (def .public (signature it) (All (_ category) (-> (Signature category) (Resource Attribute))) - (do [! //pool.monad] + (do //pool.monad [it (|> it //signature.signature //pool.utf8)] - (at ! each (signature' it) (//pool.utf8 "Signature")))) + (//pool#each (signature' it) + (//pool.utf8 "Signature")))) ... TODO: Inline ASAP (def (source_file' it @name) @@ -152,9 +157,28 @@ (def .public (source_file it) (-> Text (Resource Attribute)) - (do [! //pool.monad] + (do //pool.monad [it (//pool.utf8 it)] - (at ! each (source_file' it) (//pool.utf8 "SourceFile")))) + (//pool#each (source_file' it) + (//pool.utf8 "SourceFile")))) + +... TODO: Inline ASAP +(def (line_number_table' it @name) + (-> Line_Number_Table (Index UTF8) + Attribute) + {#Line_Number_Table [#name @name + ... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7.12 + #length (|> it + /line_number_table.length + //unsigned.u4 + try.trusted) + #info it]}) + +(def .public (line_number_table it) + (-> Line_Number_Table + (Resource Attribute)) + (//pool#each (line_number_table' it) + (//pool.utf8 "LineNumberTable"))) (def .public (format it) (Format Attribute) @@ -169,4 +193,7 @@ ((info_format //index.format) it) {#Source_File it} - ((info_format //index.format) it))) + ((info_format //index.format) it) + + {#Line_Number_Table it} + ((info_format /line_number_table.format) it))) diff --git a/stdlib/source/library/lux/meta/target/jvm/attribute/line_number_table.lux b/stdlib/source/library/lux/meta/target/jvm/attribute/line_number_table.lux new file mode 100644 index 000000000..1a3e73ece --- /dev/null +++ b/stdlib/source/library/lux/meta/target/jvm/attribute/line_number_table.lux @@ -0,0 +1,71 @@ +... https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.7.12 +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)]] + [data + ["[0]" product] + ["[0]" binary + ["![1]" \\format (.only Format) (.use "[1]#[0]" monoid)]] + [collection + ["[0]" sequence (.only Sequence)]]] + [math + [number + ["n" nat]]]]] + [/// + [encoding + ["[0]" unsigned (.only U2)]]]) + +(type .public Entry + (Record + [#start_program_counter U2 + #line_number U2])) + +(def entry_length + Nat + (all n.+ + ... u2 start_pc; + unsigned.bytes/2 + ... u2 line_number; + unsigned.bytes/2 + )) + +(def entry_equivalence + (Equivalence Entry) + (all product.equivalence + unsigned.equivalence + unsigned.equivalence + )) + +(def (entry_format it) + (Format Entry) + (all !binary#composite + (unsigned.format/2 (the #start_program_counter it)) + (unsigned.format/2 (the #line_number it)) + )) + +(type .public Line_Number_Table + (Sequence Entry)) + +(def .public empty + Line_Number_Table + sequence.empty) + +(def .public (length it) + (-> Line_Number_Table + Nat) + (all n.+ + ... u2 line_number_table_length; + unsigned.bytes/2 + ... line_number_table[line_number_table_length]; + (n.* entry_length (sequence.size it)) + )) + +(def .public equivalence + (Equivalence Line_Number_Table) + (sequence.equivalence entry_equivalence)) + +(def .public format + (Format Line_Number_Table) + (!binary.sequence_16 entry_format)) diff --git a/stdlib/source/library/lux/meta/target/jvm/bytecode.lux b/stdlib/source/library/lux/meta/target/jvm/bytecode.lux index fb54ac19a..cb236893f 100644 --- a/stdlib/source/library/lux/meta/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/meta/target/jvm/bytecode.lux @@ -46,6 +46,7 @@ ["[1][0]" constant (.only UTF8) ["[1]/[0]" pool (.only Pool Resource)]] [attribute + ["[0]" line_number_table (.only Line_Number_Table)] [code ["[1][0]" exception (.only Exception)]]] ["[0]" type (.only Type) @@ -63,16 +64,20 @@ (Record [#program_counter Address #next Label - #known Resolver])) + #known Resolver + #line_number_table Line_Number_Table])) (def fresh Tracker [#program_counter /address.start #next 0 - #known (dictionary.empty n.hash)]) + #known (dictionary.empty n.hash) + #line_number_table line_number_table.empty]) (type .public Relative - (-> Resolver (Try [(Sequence Exception) Instruction]))) + (-> Resolver + (Try [(Sequence Exception) + Instruction]))) (def no_exceptions (Sequence Exception) @@ -118,7 +123,8 @@ (def composite ..relative#composite))) (type .public (Bytecode a) - (+State Try [Pool Environment Tracker] (Writer Relative a))) + (+State Try [Pool Environment Tracker] + (Writer Relative a))) (def .public new_label (Bytecode Label) @@ -276,11 +282,17 @@ (..failure (exception.error exception value))) (def .public (resolve environment bytecode) - (All (_ a) (-> Environment (Bytecode a) (Resource [Environment (Sequence Exception) Instruction a]))) + (All (_ a) + (-> Environment (Bytecode a) + (Resource [Environment Line_Number_Table (Sequence Exception) Instruction a]))) (function (_ pool) (<| (try|do [[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh])) (try|do [exceptions instruction] (relative (the #known tracker))) - (try|in [pool [environment exceptions instruction output]])))) + (try|in [pool [environment + (the #line_number_table tracker) + exceptions + instruction + output]])))) (def (step estimator counter) (-> Estimator Address (Try Address)) @@ -1176,3 +1188,17 @@ ... {try.#Failure error} failure (as_expected failure)))) + +(def .public (map line) + (-> Nat (Bytecode Any)) + (function (_ [pool environment tracker]) + (<| (let [instruction (/address.value (the #program_counter tracker))]) + (try|do line (//unsigned.u2 line)) + (try|in [[pool + environment + (revised #line_number_table + (sequence.suffix [line_number_table.#start_program_counter instruction + line_number_table.#line_number line]) + tracker)] + [..relative#identity + []]])))) diff --git a/stdlib/source/library/lux/meta/target/jvm/method.lux b/stdlib/source/library/lux/meta/target/jvm/method.lux index ec4780b0f..629aaae94 100644 --- a/stdlib/source/library/lux/meta/target/jvm/method.lux +++ b/stdlib/source/library/lux/meta/target/jvm/method.lux @@ -73,13 +73,20 @@ (in environment) {try.#Failure error} - (function (_ _) {try.#Failure error})) - [environment exceptions instruction output] (//bytecode.resolve environment code) + (function (_ _) + {try.#Failure error})) + [environment line_number_table exceptions instruction output] (//bytecode.resolve environment code) .let [bytecode (|> instruction //instruction.result \\format.instance)] + code_attributes (is (Resource (Sequence Attribute)) + (if (sequence.empty? line_number_table) + (in sequence.empty) + (do ! + [@line_number_table (//attribute.line_number_table line_number_table)] + (in (sequence.sequence @line_number_table))))) @code (//attribute.code [//code.#limit (the //environment.#limit environment) //code.#code bytecode //code.#exception_table exceptions - //code.#attributes (sequence.sequence)])] + //code.#attributes code_attributes])] (in (sequence.suffix @code attributes))) {.#None} diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux index d03a8d398..542ddc9ee 100644 --- a/stdlib/source/library/lux/world/net/http.lux +++ b/stdlib/source/library/lux/world/net/http.lux @@ -1,17 +1,12 @@ (.require [library - [lux (.except #version #host) + [lux (.except) [control [try (.only Try)]] [data [binary (.only Binary)]]]] [/ - [version (.only Version)] - [status (.only Status)] - [header (.only Headers)]] - [// (.only Address) - [uri (.only URI) - [scheme (.only Scheme)]]]) + [header (.only Headers)]]) (type .public Method (Variant @@ -29,21 +24,6 @@ (-> (Maybe Nat) (! (Try [Nat Binary])))) -(type .public Identification - (Record - [#local Address - #remote Address])) - -(type .public Protocol - (Record - [#version Version - #scheme Scheme])) - -(type .public Resource - (Record - [#method Method - #uri URI])) - (type .public (Message !) (Record [#headers Headers diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index 05b55332a..92f532ba3 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except) + [lux (.except #version) [abstract [monad (.only Monad)]] [control @@ -12,20 +12,35 @@ ["[0]" utf8 (.use "[1]#[0]" codec)]]] [format ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]]] - ["[0]" // (.only Body) - ["[0]" version] + ["[0]" // (.only Method Body) + ["[0]" version (.only Version)] ["[0]" header (.only Header)] - ["/[1]" // (.only) + ["/[1]" // (.only Address) ["[0]" mime] [uri (.only URI) - ["[0]" scheme] + ["[0]" scheme (.only Scheme)] ["[0]" query (.only Query) (.use "[1]#[0]" codec)]]]]) +(type .public Identification + (Record + [#local Address + #remote Address])) + +(type .public Protocol + (Record + [#version Version + #scheme Scheme])) + +(type .public Resource + (Record + [#method Method + #uri URI])) + (type .public (Request !) (Record - [#identification //.Identification - #protocol //.Protocol - #resource //.Resource + [#identification Identification + #protocol Protocol + #resource Resource #message (//.Message !)])) (def (body ! it) @@ -39,14 +54,14 @@ (All (_ !) (-> (Monad !) Text (Request !))) - [#identification [//.#local [///.#host "" - ///.#port 0] - //.#remote [///.#host "" - ///.#port 0]] - #protocol [//.#version version.v1_1 - //.#scheme scheme.http] - #resource [//.#method {//.#Post} - //.#uri ""] + [#identification [#local [///.#host "" + ///.#port 0] + #remote [///.#host "" + ///.#port 0]] + #protocol [#version version.v1_1 + #scheme scheme.http] + #resource [#method {//.#Post} + #uri ""] #message [//.#headers (|> header.empty (header.has header.content_type mime.utf_8)) //.#body (body ! (utf8#encoded it))]]) @@ -57,14 +72,14 @@ (All (_ !) (-> (Monad !) JSON (Request !))) - [#identification [//.#local [///.#host "" - ///.#port 0] - //.#remote [///.#host "" - ///.#port 0]] - #protocol [//.#version version.v1_1 - //.#scheme scheme.http] - #resource [//.#method {//.#Post} - //.#uri ""] + [#identification [#local [///.#host "" + ///.#port 0] + #remote [///.#host "" + ///.#port 0]] + #protocol [#version version.v1_1 + #scheme scheme.http] + #resource [#method {//.#Post} + #uri ""] #message [//.#headers (|> header.empty (header.has header.content_type mime.json)) //.#body (body ! (utf8#encoded (json#encoded it)))]]) @@ -73,14 +88,14 @@ (All (_ !) (-> (Monad !) Query (Request !))) - [#identification [//.#local [///.#host "" - ///.#port 0] - //.#remote [///.#host "" - ///.#port 0]] - #protocol [//.#version version.v1_1 - //.#scheme scheme.http] - #resource [//.#method {//.#Post} - //.#uri ""] + [#identification [#local [///.#host "" + ///.#port 0] + #remote [///.#host "" + ///.#port 0]] + #protocol [#version version.v1_1 + #scheme scheme.http] + #resource [#method {//.#Post} + #uri ""] #message [//.#headers (|> header.empty (header.has header.content_type mime.form)) //.#body (body ! (utf8#encoded (query#encoded it)))]]) @@ -90,7 +105,7 @@ (All (_ !) (-> (Request !) (Request !))) - (|>> (has [#protocol //.#scheme] <scheme>)))] + (|>> (has [#protocol #scheme] <scheme>)))] [http scheme.http] [https scheme.https] @@ -101,7 +116,7 @@ (All (_ !) (-> (Request !) (Request !))) - (has [#resource //.#method] {<method>}))] + (has [#resource #method] {<method>}))] [post //.#Post] [get //.#Get] @@ -118,7 +133,7 @@ (All (_ !) (-> URI (Request !) (Request !))) - (|>> (has [#resource //.#uri] it))) + (|>> (has [#resource #uri] it))) (def .public (with_header it value) (All (_ ! of) diff --git a/stdlib/source/library/lux/world/net/http/server.lux b/stdlib/source/library/lux/world/net/http/server.lux index 43c2b7816..a453c944b 100644 --- a/stdlib/source/library/lux/world/net/http/server.lux +++ b/stdlib/source/library/lux/world/net/http/server.lux @@ -45,7 +45,7 @@ (-> (Server !) (Server !))) (function (_ ! request) - (if (scheme#= <scheme> (the [request.#protocol //.#scheme] request)) + (if (scheme#= <scheme> (the [request.#protocol request.#scheme] request)) (server ! request) (at ! in (response.not_found !)))))] @@ -59,7 +59,7 @@ (-> (Server !) (Server !))) (function (_ ! request) - (when (the [request.#resource //.#method] request) + (when (the [request.#resource request.#method] request) {<method>} (server ! request) @@ -82,8 +82,8 @@ (-> URI (Server !) (Server !))) (function (_ ! request) - (if (text.starts_with? path (the [request.#resource //.#uri] request)) - (server ! (revised [request.#resource //.#uri] + (if (text.starts_with? path (the [request.#resource request.#uri] request)) + (server ! (revised [request.#resource request.#uri] (|>> (text.clip_since (text.size path)) maybe.trusted) request)) @@ -129,14 +129,14 @@ (-> (?environment.Parser of) (-> of (Server !)) (Server !))) (function (_ ! request) - (let [full (the [request.#resource //.#uri] request) + (let [full (the [request.#resource request.#uri] request) [uri query] (|> full (text.split_by "?") (maybe.else [full ""]))] (when (do try.monad [query (query#decoded query) input (?environment.result parser query)] - (in [(has [request.#resource //.#uri] uri request) + (in [(has [request.#resource request.#uri] uri request) input])) {try.#Success [request input]} (server input ! request) diff --git a/stdlib/source/parser/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/parser/lux/meta/compiler/language/lux/analysis.lux index 1a32701c5..dec8032ed 100644 --- a/stdlib/source/parser/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/parser/lux/meta/compiler/language/lux/analysis.lux @@ -53,14 +53,14 @@ (def .public (result parser input) (All (_ a) (-> (Parser a) (List Analysis) (Try a))) (when (parser input) - {try.#Failure error} - {try.#Failure error} - {try.#Success [{.#End} value]} {try.#Success value} {try.#Success [unconsumed _]} - (exception.except ..unconsumed_input unconsumed))) + (exception.except ..unconsumed_input unconsumed) + + {try.#Failure error} + {try.#Failure error})) (def .public any (Parser Analysis) @@ -76,9 +76,12 @@ (Parser Any) (function (_ tokens) (when tokens - {.#End} {try.#Success [tokens []]} - _ {try.#Failure (format "Expected list of tokens to be empty!" - (remaining_inputs tokens))}))) + {.#End} + {try.#Success [tokens []]} + + _ + {try.#Failure (format "Expected list of tokens to be empty!" + (remaining_inputs tokens))}))) (def .public end? (Parser Bit) @@ -92,7 +95,7 @@ (Parser <type>) (function (_ input) (when input - (list.partial (<tag> x) input') + (list.partial (<tag> @ x) input') {try.#Success [input' x]} _ @@ -102,7 +105,7 @@ (-> <type> (Parser Any)) (function (_ input) (when input - (list.partial (<tag> actual) input') + (list.partial (<tag> @ actual) input') (if (at <eq> = expected actual) {try.#Success [input' []]} (exception.except ..cannot_parse input)) @@ -125,7 +128,7 @@ (All (_ a) (-> (Parser a) (Parser a))) (function (_ input) (when input - (list.partial (/.tuple head) tail) + (list.partial (/.tuple @ head) tail) (do try.monad [output (..result parser head)] {try.#Success [tail output]}) diff --git a/stdlib/source/parser/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/parser/lux/meta/compiler/language/lux/synthesis.lux index 66b41582e..e1d740d92 100644 --- a/stdlib/source/parser/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/parser/lux/meta/compiler/language/lux/synthesis.lux @@ -93,7 +93,7 @@ (Parser <type>) (.function (_ input) (when input - (list.partial (<tag> x) input') + (list.partial (<tag> @ x) input') {try.#Success [input' x]} _ @@ -103,7 +103,7 @@ (-> <type> (Parser Any)) (.function (_ input) (when input - (list.partial (<tag> actual) input') + (list.partial (<tag> @ actual) input') (if (at <eq> = expected actual) {try.#Success [input' []]} (exception.except ..cannot_parse input)) @@ -124,7 +124,7 @@ (All (_ a) (-> (Parser a) (Parser a))) (.function (_ input) (when input - (list.partial (/.tuple head) tail) + (list.partial (/.tuple @ head) tail) (do try.monad [output (..result parser head)] {try.#Success [tail output]}) @@ -136,7 +136,7 @@ (All (_ a) (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) (.function (_ input) (when input - (list.partial (/.function/abstraction [environment actual body]) tail) + (list.partial (/.function/abstraction @ [environment actual body]) tail) (if (n.= expected actual) (do try.monad [output (..result parser (list body))] @@ -150,7 +150,7 @@ (All (_ a b) (-> (Parser a) (Parser b) (Parser [Register a b]))) (.function (_ input) (when input - (list.partial (/.loop/scope [start inits iteration]) tail) + (list.partial (/.loop/scope @ [start inits iteration]) tail) (do try.monad [inits (..result init_parsers inits) iteration (..result iteration_parser (list iteration))] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d2af0e624..916f1dbc2 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -341,7 +341,8 @@ example_nat random.nat example_int random.int] (all _.and - (_.for [/.Code /.Code'] + (_.for [/.Code /.Code' + /.#Bit /.#Nat /.#Int /.#Rev /.#Frac /.#Text /.#Symbol /.#Form /.#Variant /.#Tuple] (all _.and ..for_code/' ..for_code/` @@ -1107,15 +1108,17 @@ (do meta.monad [prelude (meta.module .prelude)] (in (list (code.bit (when (the .#module_state prelude) - {.#Active} false - _ true))))))) + {/.#Active} false + {/.#Compiled} true + {/.#Cached} true))))))) (def for_meta Test (all _.and (_.coverage [/.Mode /.Info] (for_meta|Info)) - (_.coverage [/.Module_State] + (_.coverage [/.Module_State + /.#Active /.#Compiled /.#Cached] (for_meta|Module_State)) )) diff --git a/stdlib/source/test/lux/meta/extension.lux b/stdlib/source/test/lux/meta/extension.lux index ab58d17b3..e27b0282f 100644 --- a/stdlib/source/test/lux/meta/extension.lux +++ b/stdlib/source/test/lux/meta/extension.lux @@ -21,6 +21,7 @@ [number ["n" nat]]] ["[0]" meta (.only) + ["[0]" location] ["[0]" code ["<[1]>" \\parser]] ["@" target (.only) @@ -91,7 +92,10 @@ (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) - (at ! each (|>> {analysis.#Extension (symbol ..my_synthesis|synthesis)})))))) + (at ! each (|>> (is (List analysis.Analysis)) + {analysis.#Extension (symbol ..my_synthesis|synthesis)} + [location.dummy] + (is analysis.Analysis))))))) ... Generation (def my_generation|generation @@ -105,7 +109,9 @@ (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) - (at ! each (|>> {synthesis.#Extension (symbol ..my_generation|generation)})))))) + (at ! each (|>> {synthesis.#Extension (symbol ..my_generation|generation)} + [location.dummy] + (is synthesis.Synthesis))))))) (def my_generation Analysis @@ -113,7 +119,10 @@ (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) - (at ! each (|>> {analysis.#Extension (symbol ..my_generation|synthesis)})))))) + (at ! each (|>> (is (List analysis.Analysis)) + {analysis.#Extension (symbol ..my_generation|synthesis)} + [location.dummy] + (is analysis.Analysis))))))) (def dummy_generation|generation Generation @@ -131,12 +140,14 @@ (def dummy_generation|synthesis Synthesis (synthesis (_ phase archive []) - (at phase.monad in {synthesis.#Extension (symbol ..dummy_generation|generation) (list)}))) + (at phase.monad in (is synthesis.Synthesis + [location.dummy {synthesis.#Extension (symbol ..dummy_generation|generation) (list)}])))) (def dummy_generation Analysis (analysis (_ phase archive []) - (at phase.monad in {analysis.#Extension (symbol ..dummy_generation|synthesis) (list)}))) + (at phase.monad in (is analysis.Analysis + [location.dummy {analysis.#Extension (symbol ..dummy_generation|synthesis) (list)}])))) ... Declaration (def my_declaration diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux index 695308c40..ddcd8dcfd 100644 --- a/stdlib/source/test/lux/world/net.lux +++ b/stdlib/source/test/lux/world/net.lux @@ -12,15 +12,7 @@ ["[0]" / ["[1][0]" mime] ["[1][0]" uri] - ["[1][0]" http - ["[1]/[0]" client] - ["[1]/[0]" cookie] - ["[1]/[0]" header] - ["[1]/[0]" status] - ["[1]/[0]" version] - ["[1]/[0]" response] - ["[1]/[0]" request] - ["[1]/[0]" server]]]) + ["[1][0]" http]]) (def .public test Test @@ -36,15 +28,6 @@ true) /mime.test - - /http/client.test - /http/cookie.test - /http/header.test - /http/status.test - /http/version.test - /http/response.test - /http/request.test - /http/server.test - + /http.test /uri.test ))) diff --git a/stdlib/source/test/lux/world/net/http.lux b/stdlib/source/test/lux/world/net/http.lux new file mode 100644 index 000000000..457eb507e --- /dev/null +++ b/stdlib/source/test/lux/world/net/http.lux @@ -0,0 +1,45 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [math + ["[0]" random (.only Random)]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]] + ["[0]" / + ["[1][0]" client] + ["[1][0]" cookie] + ["[1][0]" header] + ["[1][0]" status] + ["[1][0]" version] + ["[1][0]" response] + ["[1][0]" request] + ["[1][0]" server]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (all _.and + (_.coverage [/.Method + /.#Post /.#Get /.#Put /.#Patch /.#Delete /.#Head /.#Connect /.#Options /.#Trace] + true) + (_.coverage [/.Body] + true) + (_.coverage [/.Message + /.#headers /.#body] + true) + + /client.test + /cookie.test + /header.test + /status.test + /version.test + /response.test + /request.test + /server.test + ))) diff --git a/stdlib/source/test/lux/world/net/http/request.lux b/stdlib/source/test/lux/world/net/http/request.lux index 0d117920f..afc7e88ad 100644 --- a/stdlib/source/test/lux/world/net/http/request.lux +++ b/stdlib/source/test/lux/world/net/http/request.lux @@ -107,7 +107,7 @@ (let [it (is (/.Request Identity) (<request> (/.utf8 identity.monad expected_text)))] (and (|> it - (the [/.#protocol //.#scheme]) + (the [/.#protocol /.#scheme]) (scheme#= <scheme>)) (|> it (the [/.#message //.#headers]) @@ -135,7 +135,7 @@ (let [it (is (/.Request Identity) (<request> (/.utf8 identity.monad expected_text)))] (and (|> it - (the [/.#resource //.#method]) + (the [/.#resource /.#method]) (|.when {<method>} true @@ -174,7 +174,7 @@ (let [it (is (/.Request Identity) (/.uri expected_uri (/.utf8 identity.monad expected_text)))] (and (|> it - (the [/.#resource //.#uri]) + (the [/.#resource /.#uri]) (same? expected_uri)) (|> it (the [/.#message //.#headers]) diff --git a/stdlib/source/test/lux/world/net/http/server.lux b/stdlib/source/test/lux/world/net/http/server.lux index 63f0d76ed..92f57b953 100644 --- a/stdlib/source/test/lux/world/net/http/server.lux +++ b/stdlib/source/test/lux/world/net/http/server.lux @@ -58,14 +58,14 @@ )) (def identification - (Random //.Identification) + (Random request.Identification) (all random.and ..address ..address )) (def protocol - (Random //.Protocol) + (Random request.Protocol) (all random.and versionT.random schemeT.random @@ -86,7 +86,7 @@ )) (def resource - (Random //.Resource) + (Random request.Resource) (all random.and ..method (random.lower_cased 2) @@ -135,11 +135,11 @@ (`` (all _.and (,, (with_template [<server> <scheme>] [(in (do [! async.monad] - [good_response (let [expected_request (has [request.#protocol //.#scheme] <scheme> expected_request)] + [good_response (let [expected_request (has [request.#protocol request.#scheme] <scheme> expected_request)] (<server> expected_server ! expected_request)) good_body ((the [response.#message //.#body] good_response) {.#None}) - bad_response (let [expected_request (has [request.#protocol //.#scheme] scheme.file expected_request)] + bad_response (let [expected_request (has [request.#protocol request.#scheme] scheme.file expected_request)] (<server> expected_server ! expected_request))] (unit.coverage [<server>] (and (n.= expected_status @@ -174,11 +174,11 @@ (`` (all _.and (,, (with_template [<server> <correct_method> <incorrect_method>] [(in (do [! async.monad] - [good_response (let [expected_request (has [request.#resource //.#method] {<correct_method>} expected_request)] + [good_response (let [expected_request (has [request.#resource request.#method] {<correct_method>} expected_request)] (<server> expected_server ! expected_request)) good_body ((the [response.#message //.#body] good_response) {.#None}) - bad_response (let [expected_request (has [request.#resource //.#method] {<incorrect_method>} expected_request)] + bad_response (let [expected_request (has [request.#resource request.#method] {<incorrect_method>} expected_request)] (<server> expected_server ! expected_request))] (unit.coverage [<server>] (and (n.= expected_status @@ -226,11 +226,11 @@ [bad_uri (random.upper_cased 2) good_uri (random.upper_cased 3)] (in (do [! async.monad] - [good_response (let [expected_request (has [request.#resource //.#uri] good_uri expected_request)] + [good_response (let [expected_request (has [request.#resource request.#uri] good_uri expected_request)] (/.uri good_uri expected_server ! expected_request)) good_body ((the [response.#message //.#body] good_response) {.#None}) - bad_response (let [expected_request (has [request.#resource //.#uri] bad_uri expected_request)] + bad_response (let [expected_request (has [request.#resource request.#uri] bad_uri expected_request)] (/.uri good_uri expected_server ! expected_request))] (unit.coverage [/.uri] (and (n.= expected_status @@ -250,13 +250,13 @@ [.let [server (is /.Server (/.or (/.http expected_server) (/.https expected_server)))] - http_response (server ! (has [request.#protocol //.#scheme] scheme.http expected_request)) + http_response (server ! (has [request.#protocol request.#scheme] scheme.http expected_request)) http_body ((the [response.#message //.#body] http_response) {.#None}) - https_response (server ! (has [request.#protocol //.#scheme] scheme.https expected_request)) + https_response (server ! (has [request.#protocol request.#scheme] scheme.https expected_request)) https_body ((the [response.#message //.#body] https_response) {.#None}) - bad_response (server ! (has [request.#protocol //.#scheme] scheme.file expected_request))] + bad_response (server ! (has [request.#protocol request.#scheme] scheme.file expected_request))] (unit.coverage [/.or] (let [correct_http_status! (n.= expected_status @@ -297,7 +297,7 @@ (in (do [! async.monad] [.let [server (is (/.Server Async) (/.static (response.content ! expected_status expected_mime expected_data)))] - response (server ! (has [request.#protocol //.#scheme] scheme.http expected_request)) + response (server ! (has [request.#protocol request.#scheme] scheme.http expected_request)) body ((the [response.#message //.#body] response) {.#None})] (unit.coverage [/.static] (and (n.= expected_status |