From 8b6d474dd5d2b323d1dba29359460af4708402ea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 12 Feb 2022 05:29:58 -0400 Subject: Optimizations for the pure-Lux JVM compiler. [Part 2] --- stdlib/source/library/lux/data/binary.lux | 427 +++++---------------- stdlib/source/library/lux/target/jvm/bytecode.lux | 20 +- .../lux/target/jvm/bytecode/instruction.lux | 198 +++++----- stdlib/source/library/lux/target/python.lux | 33 +- .../tool/compiler/language/lux/analysis/type.lux | 3 +- .../language/lux/phase/extension/analysis/lux.lux | 14 +- 6 files changed, 212 insertions(+), 483 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 4eb32df1b..479c7d7a1 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -1,372 +1,137 @@ (.using - [library - [lux {"-" i64} - ["@" target] - ["[0]" ffi] - [abstract - [monad {"+" do}] - [equivalence {"+" Equivalence}] - [monoid {"+" Monoid}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - [text - ["%" format {"+" format}]] - [collection - ["[0]" array]]] - [math - [number {"+" hex} - ["n" nat] - ["f" frac] - ["[0]" i64]]]]]) - -(exception: .public (index_out_of_bounds [size Nat - index Nat]) - (exception.report - ["Size" (%.nat size)] - ["Index" (%.nat index)])) - -(exception: .public (slice_out_of_bounds [size Nat - offset Nat - length Nat]) - (exception.report - ["Size" (%.nat size)] - ["Offset" (%.nat offset)] - ["Length" (%.nat length)])) - -(with_expansions [ (as_is (type: .public Binary - (ffi.type [byte])) - - (ffi.import: java/lang/Object) - - (ffi.import: java/lang/System - ["[1]::[0]" - ("static" arraycopy [java/lang/Object int java/lang/Object int int] "try" void)]) - - (ffi.import: java/util/Arrays - ["[1]::[0]" - ("static" copyOfRange [[byte] int int] [byte]) - ("static" equals [[byte] [byte]] boolean)]) - - (def: byte_mask - I64 - (|> i64.bits_per_byte i64.mask .i64)) - - (def: i64 - (-> (Primitive "java.lang.Byte") I64) - (|>> ffi.byte_to_long (:as I64) (i64.and ..byte_mask))) - - (def: byte - (-> (I64 Any) (Primitive "java.lang.Byte")) - (for [@.old - (|>> .int ffi.long_to_byte) - - @.jvm - (|>> .int (:as (Primitive "java.lang.Long")) ffi.long_to_byte)])))] - (for [@.old (as_is ) - @.jvm (as_is ) - - @.js - (as_is (ffi.import: ArrayBuffer - ["[1]::[0]" - (new [ffi.Number])]) - - (ffi.import: Uint8Array - ["[1]::[0]" - (new [ArrayBuffer]) - (length ffi.Number)]) - - (type: .public Binary - Uint8Array)) - - @.python - (type: .public Binary - (Primitive "bytearray")) - - @.scheme - (as_is (type: .public Binary - (Primitive "bytevector")) - - (ffi.import: (make-bytevector [Nat] Binary)) - (ffi.import: (bytevector-u8-ref [Binary Nat] I64)) - (ffi.import: (bytevector-u8-set! [Binary Nat (I64 Any)] Any)) - (ffi.import: (bytevector-length [Binary] Nat)))] - - ... Default - (type: .public Binary - (array.Array (I64 Any))))) - -(template: (!size binary) - [(for [@.old (ffi.length binary) - @.jvm (ffi.length binary) - - @.js - (|> binary - Uint8Array::length - f.nat) - - @.python - (|> binary - (:as (array.Array (I64 Any))) - "python array length") - - @.scheme - (..bytevector-length [binary])] - - ... Default - (array.size binary))]) - -(template: (!read index binary) - [(for [@.old (..i64 (ffi.read! index binary)) - @.jvm (..i64 (ffi.read! index binary)) - - @.js - (|> binary - (: ..Binary) - (:as (array.Array .Frac)) - ("js array read" index) - f.nat - .i64) - - @.python - (|> binary - (:as (array.Array .I64)) - ("python array read" index)) - - @.scheme - (..bytevector-u8-ref [binary index])] - - ... Default - (|> binary - (array.read! index) - (maybe.else (: (I64 Any) 0)) - (:as I64)))]) - -(template: (!!write index value binary) - [(|> binary - (: ..Binary) - (:as (array.Array )) - ( index (|> value .nat (n.% (hex "100")) )) - (:as ..Binary))]) - -(template: (!write index value binary) - [(for [@.old (ffi.write! index (..byte value) binary) - @.jvm (ffi.write! index (..byte value) binary) - - @.js (!!write .Frac n.frac "js array write" index value binary) - @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" index value binary) - @.scheme (exec (..bytevector-u8-set! [binary index value]) - binary)] - - ... Default - (array.write! index (|> value .nat (n.% (hex "100"))) binary))]) + [library + [lux "*" + ["@" target] + ["[0]" ffi] + [abstract + [equivalence {"+" Equivalence}] + [monoid {"+" Monoid}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + [text + ["%" format]] + [collection + ["[0]" array]]] + [math + [number + ["n" nat]]]]] + ["[0]" / "_" + ["[1]" \\unsafe]]) + +(type: .public Binary + /.Binary) (def: .public size (-> Binary Nat) - (|>> !size)) + (|>> /.size)) (def: .public (empty size) (-> Nat Binary) - (for [@.old (ffi.array byte size) - @.jvm (ffi.array byte size) - - @.js - (|> size n.frac ArrayBuffer::new Uint8Array::new) - - @.python - (|> size - ("python apply" (:as ffi.Function ("python constant" "bytearray"))) - (:as Binary)) - - @.scheme - (..make-bytevector size)] + (/.empty size)) - ... Default - (array.empty size))) - -(def: .public (aggregate f init binary) +(def: .public (aggregate $ init it) (All (_ a) (-> (-> I64 a a) a Binary a)) - (let [size (..!size binary)] + (let [size (/.size it)] (loop [index 0 output init] (if (n.< size index) - (again (++ index) (f (!read index binary) output)) + (again (++ index) ($ (/.bytes/1 index it) output)) output)))) -(def: .public (read/8! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) index) - {try.#Success (!read index binary)} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (read/16! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 1 index)) - {try.#Success ($_ i64.or - (i64.left_shifted 8 (!read index binary)) - (!read (n.+ 1 index) binary))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (read/32! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 3 index)) - {try.#Success ($_ i64.or - (i64.left_shifted 24 (!read index binary)) - (i64.left_shifted 16 (!read (n.+ 1 index) binary)) - (i64.left_shifted 8 (!read (n.+ 2 index) binary)) - (!read (n.+ 3 index) binary))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (read/64! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 7 index)) - {try.#Success ($_ i64.or - (i64.left_shifted 56 (!read index binary)) - (i64.left_shifted 48 (!read (n.+ 1 index) binary)) - (i64.left_shifted 40 (!read (n.+ 2 index) binary)) - (i64.left_shifted 32 (!read (n.+ 3 index) binary)) - (i64.left_shifted 24 (!read (n.+ 4 index) binary)) - (i64.left_shifted 16 (!read (n.+ 5 index) binary)) - (i64.left_shifted 8 (!read (n.+ 6 index) binary)) - (!read (n.+ 7 index) binary))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (write/8! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) index) - {try.#Success (|> binary - (!write index value))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (write/16! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 1 index)) - {try.#Success (|> binary - (!write index (i64.right_shifted 8 value)) - (!write (n.+ 1 index) value))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (write/32! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 3 index)) - {try.#Success (|> binary - (!write index (i64.right_shifted 24 value)) - (!write (n.+ 1 index) (i64.right_shifted 16 value)) - (!write (n.+ 2 index) (i64.right_shifted 8 value)) - (!write (n.+ 3 index) value))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) +(exception: .public (index_out_of_bounds [size Nat + index Nat]) + (exception.report + ["Size" (%.nat size)] + ["Index" (%.nat index)])) -(def: .public (write/64! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 7 index)) - (for [@.scheme (let [write_high (|>> (!write index (i64.right_shifted 56 value)) - (!write (n.+ 1 index) (i64.right_shifted 48 value)) - (!write (n.+ 2 index) (i64.right_shifted 40 value)) - (!write (n.+ 3 index) (i64.right_shifted 32 value))) - write_low (|>> (!write (n.+ 4 index) (i64.right_shifted 24 value)) - (!write (n.+ 5 index) (i64.right_shifted 16 value)) - (!write (n.+ 6 index) (i64.right_shifted 8 value)) - (!write (n.+ 7 index) value))] - (|> binary write_high write_low {try.#Success}))] - {try.#Success (|> binary - (!write index (i64.right_shifted 56 value)) - (!write (n.+ 1 index) (i64.right_shifted 48 value)) - (!write (n.+ 2 index) (i64.right_shifted 40 value)) - (!write (n.+ 3 index) (i64.right_shifted 32 value)) - (!write (n.+ 4 index) (i64.right_shifted 24 value)) - (!write (n.+ 5 index) (i64.right_shifted 16 value)) - (!write (n.+ 6 index) (i64.right_shifted 8 value)) - (!write (n.+ 7 index) value))}) - (exception.except ..index_out_of_bounds [(..!size binary) index]))) +(template [ ] + [(def: .public ( index it) + (-> Nat Binary (Try I64)) + (if (n.< (/.size it) (|> index )) + {try.#Success ( index it)} + (exception.except ..index_out_of_bounds [(/.size it) index])))] + + [read/8! /.bytes/1 (|>)] + [read/16! /.bytes/2 (n.+ 1)] + [read/32! /.bytes/4 (n.+ 3)] + [read/64! /.bytes/8 (n.+ 7)] + ) + +(template [ ] + [(def: .public ( index value it) + (-> Nat (I64 Any) Binary (Try Binary)) + (if (n.< (/.size it) (|> index )) + {try.#Success ( index value it)} + (exception.except ..index_out_of_bounds [(/.size it) index])))] + + [write/8! /.with/1! (|>)] + [write/16! /.with/2! (n.+ 1)] + [write/32! /.with/4! (n.+ 3)] + [write/64! /.with/8! (n.+ 7)] + ) (implementation: .public equivalence (Equivalence Binary) (def: (= reference sample) - (with_expansions [ (java/util/Arrays::equals reference sample)] - (for [@.old - @.jvm ] - (let [limit (!size reference)] - (and (n.= limit - (!size sample)) - (loop [index 0] - (if (n.< limit index) - (and (n.= (!read index reference) - (!read index sample)) - (again (++ index))) - true)))))))) + (/.= reference sample))) -(for [@.old (as_is) - @.jvm (as_is)] - - ... Default - (exception: .public (cannot_copy_bytes [bytes Nat - source_input Nat - target_output Nat]) - (exception.report - ["Bytes" (%.nat bytes)] - ["Source input space" (%.nat source_input)] - ["Target output space" (%.nat target_output)]))) +(exception: .public (cannot_copy_bytes [bytes Nat + source_input Nat + target_output Nat]) + (exception.report + ["Bytes" (%.nat bytes)] + ["Source input space" (%.nat source_input)] + ["Target output space" (%.nat target_output)])) (def: .public (copy bytes source_offset source target_offset target) (-> Nat Nat Binary Nat Binary (Try Binary)) - (with_expansions [ (as_is (do try.monad - [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] - (in target)))] - (for [@.old - @.jvm ] - - ... Default - (let [source_input (n.- source_offset (!size source)) - target_output (n.- target_offset (!size target))] - (if (n.> source_input bytes) - (exception.except ..cannot_copy_bytes [bytes source_input target_output]) - (loop [index 0] - (if (n.< bytes index) - (exec (!write (n.+ target_offset index) - (!read (n.+ source_offset index) source) - target) - (again (++ index))) - {try.#Success target}))))))) + (let [source_input (n.- source_offset (/.size source))] + (if (n.< bytes source_input) + (let [target_output (n.- target_offset (/.size target))] + (exception.except ..cannot_copy_bytes [bytes source_input target_output])) + {try.#Success (/.copy! bytes source_offset source target_offset target)}))) + +(exception: .public (slice_out_of_bounds [size Nat + offset Nat + length Nat]) + (exception.report + ["Size" (%.nat size)] + ["Offset" (%.nat offset)] + ["Length" (%.nat length)])) (def: .public (slice offset length binary) (-> Nat Nat Binary (Try Binary)) - (let [size (..!size binary) + (let [size (/.size binary) limit (n.+ length offset)] - (if (n.> size limit) + (if (n.< limit size) (exception.except ..slice_out_of_bounds [size offset length]) - (with_expansions [ (as_is {try.#Success (java/util/Arrays::copyOfRange binary (.int offset) (.int limit))})] - (for [@.old - @.jvm ] - - ... Default - (..copy length offset binary 0 (..empty length))))))) + {try.#Success (/.slice offset length binary)}))) (def: .public (after bytes binary) (-> Nat Binary Binary) - (case bytes - 0 binary - _ (let [distance (n.- bytes (..!size binary))] - (case (..slice bytes distance binary) - {try.#Success slice} - slice - - {try.#Failure _} - (..empty 0))))) + (cond (n.= 0 bytes) + binary + + (n.< bytes (/.size binary)) + (/.empty 0) + + ... else + (/.slice bytes (n.- bytes (/.size binary)) binary))) (implementation: .public monoid (Monoid Binary) (def: identity - (..empty 0)) + (/.empty 0)) (def: (composite left right) - (let [sizeL (!size left) - sizeR (!size right) - output (..empty (n.+ sizeL sizeR))] + (let [sizeL (/.size left) + sizeR (/.size right) + output (/.empty (n.+ sizeL sizeR))] (exec - (..copy sizeL 0 left 0 output) - (..copy sizeR 0 right sizeL output) + (/.copy! sizeL 0 left 0 output) + (/.copy! sizeR 0 right sizeL output) output)))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 5c70611bf..4cdd42299 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -211,8 +211,8 @@ {try.#Success [state' [relative ($ it)]]} ... {try.#Failure error} - it - (:expected it))))) + failure + (:expected failure))))) (implementation: .public monad (Monad Bytecode) @@ -232,12 +232,12 @@ {try.#Success [state'' [(relative#composite left right) it]]} ... {try.#Failure error} - it - (:expected it)) + failure + (:expected failure)) ... {try.#Failure error} - it - (:expected it))))) + failure + (:expected failure))))) (def: .public (when_continuous it) (-> (Bytecode Any) (Bytecode Any)) @@ -1148,9 +1148,9 @@ {try.#Success [state'' [(relative#composite left right) it]]} ... {try.#Failure error} - it - it) + failure + failure) ... {try.#Failure error} - it - (:expected it)))) + failure + (:expected failure)))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index c422dd1c2..4f371461a 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -1,6 +1,7 @@ (.using [library [lux "*" + [ffi {"+"}] [abstract [monad {"+" do}] [monoid {"+" Monoid}]] @@ -9,7 +10,9 @@ ["[0]" try]] [data ["[0]" product] - ["[0]" binary] + ["[0]" binary "_" + [/ {"+"}] + ["[1]" \\unsafe]] ["[0]" format "_" ["[1]" binary {"+" Mutation Specification}]] [collection @@ -76,8 +79,7 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..opcode_size) offset) - (try.trusted - (binary.write/8! offset opcode binary))])) + (binary.with/1! offset opcode binary)])) (def: nullary [Estimator (-> Opcode Instruction)] @@ -105,12 +107,10 @@ (-> Opcode Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary)] - ( (n.+ (///unsigned.value ..opcode_size) offset) - ( input0) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + ( (n.+ (///unsigned.value ..opcode_size) offset) + ( input0)))])) (def: [Estimator (-> Opcode Instruction)] @@ -119,10 +119,10 @@ [(n.+ (///unsigned.value ) size) (|>> mutation (( opcode input0)))])]))] - [..size/1 unary/1 U1 binary.write/8! ///unsigned.value] - [..size/2 unary/2 U2 binary.write/16! ///unsigned.value] - [..size/2 jump/2 Jump binary.write/16! ///signed.value] - [..size/4 jump/4 Big_Jump binary.write/32! ///signed.value] + [..size/1 unary/1 U1 binary.with/1! ///unsigned.value] + [..size/2 unary/2 U2 binary.with/2! ///unsigned.value] + [..size/2 jump/2 Jump binary.with/2! ///signed.value] + [..size/4 jump/4 Big_Jump binary.with/4! ///signed.value] ) (template [ ] @@ -131,12 +131,10 @@ (-> Opcode Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary)] - ( (n.+ (///unsigned.value ..opcode_size) offset) - (///signed.value input0) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + ( (n.+ (///unsigned.value ..opcode_size) offset) + (///signed.value input0)))])) (def: [Estimator (-> Opcode Instruction)] @@ -145,8 +143,8 @@ [(n.+ (///unsigned.value ) size) (|>> mutation (( opcode input0)))])]))] - [..size/1 unary/1' S1 binary.write/8!] - [..size/2 unary/2' S2 binary.write/16!] + [..size/1 unary/1' S1 binary.with/1!] + [..size/2 unary/2' S2 binary.with/2!] ) (def: size/11 @@ -159,15 +157,12 @@ (-> Opcode U1 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/11) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary) - _ (binary.write/8! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0) - binary)] - (binary.write/8! (n.+ (///unsigned.value ..size/1) offset) - (///unsigned.value input1) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (binary.with/1! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.with/1! (n.+ (///unsigned.value ..size/1) offset) + (///unsigned.value input1)))])) (def: binary/11 [Estimator (-> Opcode U1 U1 Instruction)] @@ -186,15 +181,12 @@ (-> Opcode U2 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/21) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary) - _ (binary.write/16! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0) - binary)] - (binary.write/8! (n.+ (///unsigned.value ..size/2) offset) - (///unsigned.value input1) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (binary.with/2! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.with/1! (n.+ (///unsigned.value ..size/2) offset) + (///unsigned.value input1)))])) (def: binary/21 [Estimator (-> Opcode U2 U1 Instruction)] @@ -214,18 +206,14 @@ (-> Opcode U2 U1 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/211) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary) - _ (binary.write/16! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0) - binary) - _ (binary.write/8! (n.+ (///unsigned.value ..size/2) offset) - (///unsigned.value input1) - binary)] - (binary.write/8! (n.+ (///unsigned.value ..size/21) offset) - (///unsigned.value input2) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (binary.with/2! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.with/1! (n.+ (///unsigned.value ..size/2) offset) + (///unsigned.value input1)) + (binary.with/1! (n.+ (///unsigned.value ..size/21) offset) + (///unsigned.value input2)))])) (def: trinary/211 [Estimator (-> Opcode U2 U1 U1 Instruction)] @@ -617,34 +605,34 @@ (try.trusted (do [! try.monad] [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) - maximum (///signed.+/4 minimum amount_of_afterwards) - _ (binary.write/8! offset (hex "AA") binary) - .let [offset (n.+ (///unsigned.value ..opcode_size) offset)] - _ (case padding - 3 (do ! - [_ (binary.write/8! offset 0 binary)] - (binary.write/16! (++ offset) 0 binary)) - 2 (binary.write/16! offset 0 binary) - 1 (binary.write/8! offset 0 binary) - _ (in binary)) - .let [offset (n.+ padding offset)] - _ (binary.write/32! offset (///signed.value default) binary) - .let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] - _ (binary.write/32! offset (///signed.value minimum) binary) - .let [offset (n.+ (///unsigned.value ..integer_size) offset)] - _ (binary.write/32! offset (///signed.value maximum) binary)] - (loop [offset (n.+ (///unsigned.value ..integer_size) offset) - afterwards (: (List Big_Jump) - {.#Item at_minimum afterwards})] - (case afterwards - {.#End} - (in binary) - - {.#Item head tail} - (do ! - [_ (binary.write/32! offset (///signed.value head) binary)] - (again (n.+ (///unsigned.value ..big_jump_size) offset) - tail))))))]))] + maximum (///signed.+/4 minimum amount_of_afterwards)] + (in (let [_ (binary.with/1! offset (hex "AA") binary) + offset (n.+ (///unsigned.value ..opcode_size) offset) + _ (case padding + 3 (|> binary + (binary.with/1! offset 0) + (binary.with/2! (++ offset) 0)) + 2 (binary.with/2! offset 0 binary) + 1 (binary.with/1! offset 0 binary) + _ binary) + offset (n.+ padding offset) + _ (binary.with/4! offset (///signed.value default) binary) + offset (n.+ (///unsigned.value ..big_jump_size) offset) + _ (binary.with/4! offset (///signed.value minimum) binary) + offset (n.+ (///unsigned.value ..integer_size) offset) + _ (binary.with/4! offset (///signed.value maximum) binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + afterwards (: (List Big_Jump) + {.#Item at_minimum afterwards})] + (case afterwards + {.#End} + binary + + {.#Item head tail} + (exec + (binary.with/4! offset (///signed.value head) binary) + (again (n.+ (///unsigned.value ..big_jump_size) offset) + tail))))))))]))] [(n.+ tableswitch_size size) (|>> mutation tableswitch_mutation)]))))])) @@ -678,33 +666,31 @@ lookupswitch_mutation (: Mutation (function (_ [offset binary]) [(n.+ lookupswitch_size offset) - (try.trusted - (do [! try.monad] - [_ (binary.write/8! offset (hex "AB") binary) - .let [offset (n.+ (///unsigned.value ..opcode_size) offset)] - _ (case padding - 3 (do ! - [_ (binary.write/8! offset 0 binary)] - (binary.write/16! (++ offset) 0 binary)) - 2 (binary.write/16! offset 0 binary) - 1 (binary.write/8! offset 0 binary) - _ (in binary)) - .let [offset (n.+ padding offset)] - _ (binary.write/32! offset (///signed.value default) binary) - .let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] - _ (binary.write/32! offset amount_of_cases binary)] - (loop [offset (n.+ (///unsigned.value ..integer_size) offset) - cases cases] - (case cases - {.#End} - (in binary) - - {.#Item [value jump] tail} - (do ! - [_ (binary.write/32! offset (///signed.value value) binary) - _ (binary.write/32! (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary)] - (again (n.+ case_size offset) - tail))))))]))] + (let [_ (binary.with/1! offset (hex "AB") binary) + offset (n.+ (///unsigned.value ..opcode_size) offset) + _ (case padding + 3 (|> binary + (binary.with/1! offset 0) + (binary.with/2! (++ offset) 0)) + 2 (binary.with/2! offset 0 binary) + 1 (binary.with/1! offset 0 binary) + _ binary) + offset (n.+ padding offset) + _ (binary.with/4! offset (///signed.value default) binary) + offset (n.+ (///unsigned.value ..big_jump_size) offset) + _ (binary.with/4! offset amount_of_cases binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + cases cases] + (case cases + {.#End} + binary + + {.#Item [value jump] tail} + (exec + (binary.with/4! offset (///signed.value value) binary) + (binary.with/4! (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary) + (again (n.+ case_size offset) + tail)))))]))] [(n.+ lookupswitch_size size) (|>> mutation lookupswitch_mutation)]))))])) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index dc1b5e935..90d8210ef 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -230,29 +230,16 @@ (format (:representation func) "(" (text.interposed ", " (list#each ..code args)) ")"))) (template [ ] - [(def: ( var) - (-> (Expression Any) Text) - (format (:representation var)))] + [(def: .public + (-> (Expression Any) (Expression Any)) + (|>> :representation + (format ) + :abstraction))] [splat_poly Poly "*"] [splat_keyword Keyword "**"] ) - (template [ ] - [(def: .public ( args extra func) - (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ... ..expression - (format (:representation func) - (format "(" (|> args - (list#each (function (_ arg) (format (:representation arg) ", "))) - text.together) - ( extra) ")"))))] - - [apply_poly splat_poly] - [apply_keyword splat_keyword] - ) - (def: .public (the name object) (-> Text (Expression Any) (Computation Any)) (:abstraction (format (:representation object) "." name))) @@ -261,16 +248,6 @@ (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) (..apply/* (..the method object) args)) - (template [ ] - [(def: .public ( args extra method) - (-> (List (Expression Any)) (Expression Any) Text - (-> (Expression Any) (Computation Any))) - (|>> (..the method) ( args extra)))] - - [do_poly apply_poly] - [do_keyword apply_keyword] - ) - (def: .public (item idx array) (-> (Expression Any) (Expression Any) Location) (:abstraction (format (:representation array) "[" (:representation idx) "]"))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux index bd2c04844..db622ca0c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux @@ -117,8 +117,7 @@ [var (..check check.var) .let [[@it :it:] var] it (it var) - ... _ (..check (check.forget! @it)) - ] + _ (..check (check.forget! @it))] (in it))) (def: .public (inferring action) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index d747ff070..21cf02c95 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -136,12 +136,14 @@ (function (_ extension_name analyse archive args) (case args (^ (list opC)) - (do ////.monad - [[var_id varT] (typeA.check check.var) - _ (typeA.inference (type (Either Text varT))) - opA (<| (typeA.expecting (type (-> .Any varT))) - (analyse archive opC))] - (in {////analysis.#Extension extension_name (list opA)})) + (<| typeA.with_var + (function (_ [@var :var:])) + (do [! ////.monad] + [_ (typeA.inference (type (Either Text :var:)))] + (|> opC + (analyse archive) + (typeA.expecting (type (-> .Any :var:))) + (# ! each (|>> list {////analysis.#Extension extension_name}))))) _ (////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) -- cgit v1.2.3