diff options
Diffstat (limited to 'stdlib/source/library/lux/meta/target')
4 files changed, 148 insertions, 17 deletions
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} |