diff options
Diffstat (limited to 'stdlib/source/library')
| -rw-r--r-- | stdlib/source/library/lux/control/parser.lux | 238 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/color/hsb.lux | 65 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/color/hsl.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/color/rgb.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/format/tar.lux | 406 | ||||
| -rw-r--r-- | stdlib/source/library/lux/ffi.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/library/lux/ffi/export.js.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/library/lux/ffi/export.py.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/frac.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux | 1 |
12 files changed, 463 insertions, 322 deletions
diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index 207e486de..cd25b8bbf 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -99,31 +99,6 @@ (Try [state of]))) (parser input)) -(def .public (and left right) - (All (_ state left right) - (-> (Parser state left) (Parser state right) - (Parser state (And left right)))) - (do [! ..monad] - [head left] - (of ! each (|>> [head]) right))) - -(def .public (or left right) - (All (_ state left right) - (-> (Parser state left) (Parser state right) - (Parser state (Or left right)))) - (function (_ tokens) - (when (left tokens) - {try.#Success [tokens' output]} - {try.#Success [tokens' {0 #0 output}]} - - {try.#Failure _} - (when (right tokens) - {try.#Success [tokens' output]} - {try.#Success [tokens' {0 #1 output}]} - - {try.#Failure error} - {try.#Failure error})))) - (def .public (either this that) (All (_ state of) (-> (Parser state of) (Parser state of) @@ -136,27 +111,137 @@ success success))) -(def .public (some parser) - (All (_ state of) - (-> (Parser state of) - (Parser state (List of)))) - (function (_ input) - (when (parser input) - {try.#Success [input' head]} - (..result (of ..monad each (|>> (list.partial head)) - (some parser)) - input') - - {try.#Failure _} - {try.#Success [input (list)]}))) - -(def .public (many parser) - (All (_ state of) - (-> (Parser state of) - (Parser state (List of)))) - (|> (..some parser) - (..and parser) - (of ..monad each (|>> {.#Item})))) +(with_expansions [<failure> {try.#Failure error} + <handle_failure!> (these <failure> + <failure>)] + (def .public (and left right) + (All (_ state left right) + (-> (Parser state left) (Parser state right) + (Parser state (And left right)))) + (function (_ state) + (when (left state) + {try.#Success [state left]} + (when (right state) + {try.#Success [state right]} + {try.#Success [state [left right]]} + + + <handle_failure!>) + + <handle_failure!>))) + + (def .public (or left right) + (All (_ state left right) + (-> (Parser state left) (Parser state right) + (Parser state (Or left right)))) + (function (_ tokens) + (when (left tokens) + {try.#Success [tokens' output]} + {try.#Success [tokens' {0 #0 output}]} + + {try.#Failure _} + (when (right tokens) + {try.#Success [tokens' output]} + {try.#Success [tokens' {0 #1 output}]} + + <handle_failure!>)))) + + (def .public (some it) + (All (_ state of) + (-> (Parser state of) + (Parser state (List of)))) + (function (_ state) + (loop (next [state state + output (list)]) + (when (it state) + {try.#Success [state head]} + (next state (list.partial head output)) + + {try.#Failure _} + {try.#Success [state (list.reversed output)]})))) + + (def .public (many parser) + (All (_ state of) + (-> (Parser state of) + (Parser state (List of)))) + (function (_ state) + (when (parser state) + {try.#Success [state head]} + (when (..some parser state) + {try.#Success [state tail]} + {try.#Success [state {.#Item head tail}]} + + <handle_failure!>) + + <handle_failure!>))) + + (def .public (after parameter it) + (All (_ state _ of) + (-> (Parser state _) (Parser state of) + (Parser state of))) + (function (_ state) + (when (parameter state) + {try.#Success [state _]} + (when (it state) + <handle_failure!> + + success + success) + + <handle_failure!>))) + + (def .public (before parameter it) + (All (_ state _ of) + (-> (Parser state _) (Parser state of) + (Parser state of))) + (function (_ state) + (when (it state) + {try.#Success [state it]} + (when (parameter state) + {try.#Success [state _]} + {try.#Success [state it]} + + <handle_failure!>) + + <handle_failure!>))) + + (def .public (of_try operation) + (All (_ state of) + (-> (Try of) + (Parser state of))) + (function (_ input) + (when operation + {try.#Success output} + {try.#Success [input output]} + + <handle_failure!>))) + + (def .public (parses parser) + (All (_ state of) + (-> (Parser state of) + (Parser state Any))) + (function (_ input) + (when (parser input) + {try.#Success [input' _]} + {try.#Success [input' []]} + + <handle_failure!>))) + + (def .public (codec codec parser) + (All (_ state medium of) + (-> (Codec medium of) (Parser state medium) + (Parser state of))) + (function (_ input) + (when (parser input) + {try.#Success [input' to_decode]} + (when (of codec decoded to_decode) + {try.#Success value} + {try.#Success [input' value]} + + <handle_failure!>) + + <handle_failure!>))) + ) (def .public (exactly amount parser) (All (_ state of) @@ -240,18 +325,6 @@ (function (_ input) {try.#Failure message})) -(def .public (of_try operation) - (All (_ state of) - (-> (Try of) - (Parser state of))) - (function (_ input) - (when operation - {try.#Success output} - {try.#Success [input output]} - - {try.#Failure error} - {try.#Failure error}))) - (def .public (else value parser) (All (_ state of) (-> of (Parser state of) @@ -276,24 +349,8 @@ (Parser state of)) (Parser state of))) (function (_ inputs) - (..result (parser (rec parser)) inputs))) - -(def .public (after param subject) - (All (_ state _ of) - (-> (Parser state _) (Parser state of) - (Parser state of))) - (do ..monad - [_ param] - subject)) - -(def .public (before param subject) - (All (_ state _ of) - (-> (Parser state _) (Parser state of) - (Parser state of))) - (do ..monad - [output subject - _ param] - (in output))) + (..result (parser (rec parser)) + inputs))) (def .public (only test parser) (All (_ state of) @@ -316,18 +373,6 @@ {try.#Failure error} {try.#Success [input false]}))) -(def .public (parses parser) - (All (_ state of) - (-> (Parser state of) - (Parser state Any))) - (function (_ input) - (when (parser input) - {try.#Success [input' _]} - {try.#Success [input' []]} - - {try.#Failure error} - {try.#Failure error}))) - (def .public (speculative parser) (All (_ state of) (-> (Parser state of) @@ -339,20 +384,3 @@ failure failure))) - -(def .public (codec codec parser) - (All (_ state medium of) - (-> (Codec medium of) (Parser state medium) - (Parser state of))) - (function (_ input) - (when (parser input) - {try.#Success [input' to_decode]} - (when (of codec decoded to_decode) - {try.#Success value} - {try.#Success [input' value]} - - {try.#Failure error} - {try.#Failure error}) - - {try.#Failure error} - {try.#Failure error}))) diff --git a/stdlib/source/library/lux/data/color/hsb.lux b/stdlib/source/library/lux/data/color/hsb.lux index 9bf403cf2..87d03137f 100644 --- a/stdlib/source/library/lux/data/color/hsb.lux +++ b/stdlib/source/library/lux/data/color/hsb.lux @@ -9,13 +9,19 @@ [control [function [predicate (.only Predicate)]]] + [data + [text + ["%" \\format]]] [math [number ["f" frac] + ["[0]" nat] ["[0]" int]]] [meta [type - ["[0]" nominal]]]]] + ["[0]" nominal]] + ["[0]" macro + ["[1]" local]]]]] [// ["[0]" rgb (.only RGB)]]) @@ -90,7 +96,7 @@ (def down (-> Nat Frac) - (|>> .int int.frac (f./ rgb_factor))) + (|>> nat.frac (f./ rgb_factor))) (def up (-> Frac @@ -111,37 +117,33 @@ saturation (if (f.= +0.0 brightness) +0.0 (|> chroma (f./ brightness)))] - (nominal.abstraction - [#hue (cond (f.= +0.0 chroma) - ... Achromatic - +0.0 - ... Chromatic - (and (f.= brightness red) - (not (f.= red blue))) - (|> green (f.- blue) - (f./ chroma) - (f.+ +0.0) - (f./ +6.0)) - - (f.= brightness green) - (|> blue (f.- red) - (f./ chroma) - (f.+ +2.0) - (f./ +6.0)) - - ... (f.= brightness blue) - (|> red (f.- green) - (f./ chroma) - (f.+ +4.0) - (f./ +6.0))) - #saturation saturation - #brightness brightness]))) + (macro.let [hue_of (template (_ <base> <shift> <adjustment>) + [(|> <base> (f.- <shift>) + (f./ chroma) + <adjustment> + (f./ +6.0))])] + (nominal.abstraction + [#hue (cond (f.= +0.0 chroma) + ... Achromatic + +0.0 + ... Chromatic + (f.= brightness red) + (hue_of green blue (f.mod +6.0)) + + (f.= brightness green) + (hue_of blue red (f.+ +2.0)) + + ... (f.= brightness blue) + (hue_of red green (f.+ +4.0))) + #saturation saturation + #brightness brightness])))) (def .public (rgb it) (-> HSB RGB) (let [[hue saturation brightness] (nominal.representation it) hue (|> hue (f.* +6.0)) + i (f.floor hue) f (|> hue (f.- i)) p (|> +1.0 (f.- saturation) (f.* brightness)) @@ -156,4 +158,13 @@ (rgb.rgb (..up red) (..up green) (..up blue)))) + + (def .public (format it) + (%.Format HSB) + (let [it (nominal.representation it)] + (%.format "hsb(" + (%.nat (f.nat (f.degree (the #hue it)))) + " " (%.nat (f.nat (f.percentage (the #saturation it)))) "%" + " " (%.nat (f.nat (f.percentage (the #brightness it)))) "%" + ")"))) ) diff --git a/stdlib/source/library/lux/data/color/hsl.lux b/stdlib/source/library/lux/data/color/hsl.lux index a47ef0d2f..07366f0e9 100644 --- a/stdlib/source/library/lux/data/color/hsl.lux +++ b/stdlib/source/library/lux/data/color/hsl.lux @@ -10,6 +10,9 @@ [control [function [predicate (.only Predicate)]]] + [data + [text + ["%" \\format]]] [math [number ["i" int] @@ -187,3 +190,11 @@ (|>> (the #luminance) (..hsl +0.0 +0.0))) + +(def .public (format it) + (%.Format HSL) + (%.format "hsl(" + (%.nat (f.nat (f.degree (the #hue it)))) + " " (%.nat (f.nat (f.percentage (the #saturation it)))) "%" + " " (%.nat (f.nat (f.percentage (the #luminance it)))) "%" + ")")) diff --git a/stdlib/source/library/lux/data/color/rgb.lux b/stdlib/source/library/lux/data/color/rgb.lux index c930451af..ace3f6f70 100644 --- a/stdlib/source/library/lux/data/color/rgb.lux +++ b/stdlib/source/library/lux/data/color/rgb.lux @@ -13,7 +13,9 @@ [function [predicate (.only Predicate)]]] [data - ["[0]" product]] + ["[0]" product] + [text + ["%" \\format]]] [math [number ["n" nat] @@ -161,3 +163,11 @@ [darker ..black] [brighter ..white] ) + +(def .public (format it) + (%.Format RGB) + (%.format "rgb(" + (%.nat (the #red it)) + "," (%.nat (the #green it)) + "," (%.nat (the #blue it)) + ")")) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 2f3aaa42e..b5627f0b2 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -35,7 +35,8 @@ ["[0]" i64]]] [meta [macro - ["^" pattern]] + ["^" pattern] + ["[0]" template]] [type ["[0]" nominal (.except def #name)]]] [world @@ -52,7 +53,8 @@ 8) (def (octal_padding max_size number) - (-> Size Text Text) + (-> Size Text + Text) (let [padding_size (n.- (text.size number) max_size) padding (|> "0" @@ -86,13 +88,15 @@ Nat (def .public (<in> value) - (-> Nat (Try <type>)) + (-> Nat + (Try <type>)) (if (n.< <limit> value) {try.#Success (abstraction value)} (exception.except <exception> [value]))) (def .public <out> - (-> <type> Nat) + (-> <type> + Nat) (|>> representation)) (def <format> @@ -107,7 +111,8 @@ (!binary.segment padded_size)))) (def <coercion> - (-> Nat <type>) + (-> Nat + <type>) (|>> (n.% <limit>) abstraction)) )] @@ -128,50 +133,59 @@ (list ["Expected" (%.nat expected)] ["Actual" (%.nat actual)]))) +(def parsed + (template (_ <state> <binding> <parser> <body>) + [(when (<parser> <state>) + {try.#Success [<state> <binding>]} + <body> + + {try.#Failure error} + {try.#Failure error})])) + (def small_suffix (Parser Any) - (do <>.monad - [pre_end ?binary.bits_8 - _ (let [expected (`` (char (,, (static ..blank))))] - (<>.assertion (exception.error ..wrong_character [expected pre_end]) - (n.= expected pre_end))) - - end ?binary.bits_8 - _ (let [expected (`` (char (,, (static ..null))))] - (<>.assertion (exception.error ..wrong_character [expected end]) - (n.= expected end)))] - (in []))) + (<| (function (_ state)) + (parsed state pre_end ?binary.bits_8) + (let [expected (`` (char (,, (static ..blank))))]) + (if (not (n.= expected pre_end)) + (exception.except ..wrong_character [expected pre_end])) + (parsed state end ?binary.bits_8) + (let [expected (`` (char (,, (static ..null))))]) + (if (not (n.= expected end)) + (exception.except ..wrong_character [expected end])) + {try.#Success [state []]})) (def small_parser (Parser Small) - (do <>.monad - [digits (?binary.segment ..small_size) - digits (<>.of_try (of utf8.codec decoded digits)) - _ ..small_suffix] - (<>.of_try - (do [! try.monad] - [value (of n.octal decoded digits)] - (..small value))))) + (<| (function (_ state)) + (parsed state digits (?binary.segment ..small_size)) + (parsed state digits (<>.of_try (of utf8.codec decoded digits))) + (parsed state _ ..small_suffix) + (do [! try.monad] + [value (of n.octal decoded digits) + value (..small value)] + (in [state value])))) (def big_parser (Parser Big) - (do <>.monad - [digits (?binary.segment ..big_size) - digits (<>.of_try (of utf8.codec decoded digits)) - end ?binary.bits_8 - _ (let [expected (`` (char (,, (static ..blank))))] - (<>.assertion (exception.error ..wrong_character [expected end]) - (n.= expected end)))] - (<>.of_try - (do [! try.monad] - [value (of n.octal decoded digits)] - (..big value))))) + (<| (function (_ state)) + (parsed state digits (?binary.segment ..big_size)) + (parsed state digits (<>.of_try (of utf8.codec decoded digits))) + (parsed state end ?binary.bits_8) + (let [expected (`` (char (,, (static ..blank))))]) + (if (not (n.= expected end)) + (exception.except ..wrong_character [expected end])) + (do [! try.monad] + [value (of n.octal decoded digits) + value (..big value)] + (in [state value])))) (nominal.def Checksum Text (def from_checksum - (-> Checksum Text) + (-> Checksum + Text) (|>> representation)) (def dummy_checksum @@ -182,7 +196,8 @@ (%.format ..blank ..null)) (def checksum - (-> Binary Nat) + (-> Binary + Nat) (binary.mix n.+ 0)) (def checksum_checksum @@ -192,7 +207,8 @@ ..checksum)) (def checksum_code - (-> Binary Checksum) + (-> Binary + Checksum) (|>> ..checksum ..as_small ..from_small @@ -211,14 +227,14 @@ (def checksum_parser (Parser [Nat Checksum]) - (do <>.monad - [ascii (?binary.segment ..small_size) - digits (<>.of_try (of utf8.codec decoded ascii)) - _ ..small_suffix - value (<>.of_try - (of n.octal decoded digits))] - (in [value - (abstraction (%.format digits ..checksum_suffix))]))) + (<| (function (_ state)) + (parsed state ascii (?binary.segment ..small_size)) + (parsed state digits (<>.of_try (of utf8.codec decoded ascii))) + (parsed state _ ..small_suffix) + (parsed state value (<>.of_try + (of n.octal decoded digits))) + {try.#Success [state [value + (abstraction (%.format digits ..checksum_suffix))]]})) ) (def last_ascii @@ -226,7 +242,8 @@ (number.hex "007F")) (def ascii? - (-> Text Bit) + (-> Text + Bit) (|>> (of utf8.codec encoded) (binary.mix (function (_ char verdict) (.and verdict @@ -242,7 +259,8 @@ (def .public path_size Size 99) (def (un_padded string) - (-> Binary Binary) + (-> Binary + Binary) (when (binary!.size string) 0 string @@ -271,7 +289,8 @@ ["Maximum" (%.nat <size>)]))) (def .public (<in> value) - (-> <representation> (Try <type>)) + (-> <representation> + (Try <type>)) (if (..ascii? value) (if (|> value (of utf8.codec encoded) @@ -282,7 +301,8 @@ (exception.except ..not_ascii [value]))) (def .public <out> - (-> <type> <representation>) + (-> <type> + <representation>) (|>> representation)) (def <format> @@ -296,16 +316,16 @@ (def <parser> (Parser <type>) - (do <>.monad - [string (?binary.segment <size>) - end ?binary.bits_8 - .let [expected (`` (char (,, (static ..null))))] - _ (<>.assertion (exception.error ..wrong_character [expected end]) - (n.= expected end))] - (<>.of_try - (do [! try.monad] - [text (of utf8.codec decoded (..un_padded string))] - (<in> text))))) + (<| (function (_ state)) + (parsed state string (?binary.segment <size>)) + (parsed state end ?binary.bits_8) + (let [expected (`` (char (,, (static ..null))))]) + (if (not (n.= expected end)) + (exception.except ..wrong_character [expected end])) + (do [! try.monad] + [text (of utf8.codec decoded (..un_padded string)) + it (<in> text)] + (in [state it])))) (def .public <none> <type> @@ -325,7 +345,8 @@ (abstraction "ustar ")) (def from_magic - (-> Magic Text) + (-> Magic + Text) (|>> representation)) (def magic_format @@ -338,15 +359,14 @@ (def magic_parser (Parser Magic) - (do <>.monad - [string (?binary.segment ..magic_size) - end ?binary.bits_8 - .let [expected (`` (char (,, (static ..null))))] - _ (<>.assertion (exception.error ..wrong_character [expected end]) - (n.= expected end))] - (<>.of_try - (of try.monad each (|>> abstraction) - (of utf8.codec decoded string))))) + (<| (function (_ state)) + (parsed state string (?binary.segment ..magic_size)) + (parsed state end ?binary.bits_8) + (let [expected (`` (char (,, (static ..null))))]) + (if (not (n.= expected end)) + (exception.except ..wrong_character [expected end])) + (of try.monad each (|>> abstraction [state]) + (of utf8.codec decoded string)))) ) (def block_size Size 512) @@ -363,15 +383,18 @@ (def device_size Size ..small_size) (def small_number - (-> Size Size) + (-> Size + Size) (|>> (all n.+ ..blank_size ..null_size))) (def big_number - (-> Size Size) + (-> Size + Size) (|>> (all n.+ ..blank_size))) (def string - (-> Size Size) + (-> Size + Size) (|>> (all n.+ ..null_size))) (def header_size @@ -409,7 +432,8 @@ Char (def link_flag - (-> Link_Flag Char) + (-> Link_Flag + Char) (|>> representation)) (def link_flag_format @@ -441,28 +465,30 @@ (def link_flag_parser (Parser Link_Flag) - (do <>.monad - [it ?binary.bits_8] - (when (.nat it) - (^.with_template [<value> <link_flag>] - [<value> - (in <link_flag>)]) - (<options>) - - _ - (<>.of_try - (exception.except ..invalid_link_flag [(.nat it)])))))) + (<| (function (_ state)) + (parsed state it ?binary.bits_8) + (when (.nat it) + (^.with_template [<value> <link_flag>] + [<value> + {try.#Success [state <link_flag>]}]) + (<options>) + + _ + (exception.except ..invalid_link_flag [(.nat it)])))) + ) ) (nominal.def .public Mode Nat (def .public mode - (-> Mode Nat) + (-> Mode + Nat) (|>> representation)) (def .public (and left right) - (-> Mode Mode Mode) + (-> Mode Mode + Mode) (abstraction (i64.or (representation left) (representation right)))) @@ -526,13 +552,14 @@ (def mode_parser (Parser Mode) - (do [! <>.monad] - [value (of ! each ..from_small ..small_parser)] - (if (n.> (representation ..maximum_mode) - value) - (<>.of_try - (exception.except ..invalid_mode [value])) - (in (abstraction value)))))) + (<| (function (_ state)) + (parsed state value ..small_parser) + (let [value (..from_small value)]) + (if (n.> (representation ..maximum_mode) + value) + (exception.except ..invalid_mode [value]) + {try.#Success [state (abstraction value)]}))) + ) ) (def maximum_content_size @@ -545,18 +572,22 @@ [Big Binary] (def .public (content it) - (-> Binary (Try Content)) + (-> Binary + (Try Content)) (do try.monad [size (..big (binary!.size it))] (in (abstraction [size it])))) (def from_content - (-> Content [Big Binary]) + (-> Content + [Big Binary]) (|>> representation)) (def .public data - (-> Content Binary) - (|>> representation product.right)) + (-> Content + Binary) + (|>> representation + product.right)) ) (type .public ID @@ -639,7 +670,8 @@ (exception.except ..unknown_file [expected]))) (def (blocks size) - (-> Big Nat) + (-> Big + Nat) (n.+ (n./ ..block_size (..from_big size)) (when (n.% ..block_size (..from_big size)) @@ -647,7 +679,8 @@ _ 1))) (def rounded_content_size - (-> Big Nat) + (-> Big + Nat) (|>> ..blocks (n.* ..block_size))) @@ -699,14 +732,16 @@ (!binary.segment ..block_size)))) (def modification_time - (-> Instant Big) + (-> Instant + Big) (|>> instant.relative (duration.ticks duration.second) .nat ..as_big)) (def (file_format link_flag) - (-> Link_Flag (Format File)) + (-> Link_Flag + (Format File)) (function (_ [path modification_time mode ownership content]) (let [[size content] (..from_content content) format (all !binary.and @@ -810,7 +845,8 @@ ... To correct for this, it is necessary to calculate the checksum of just the checksum field, subtract that, and then ... add-in the checksum of the spaces. (def (expected_checksum checksum header) - (-> Checksum Binary Nat) + (-> Checksum Binary + Nat) (let [|checksum| (|> checksum ..from_checksum (of utf8.codec encoded) @@ -821,81 +857,105 @@ (def header_parser (Parser Header) - (do <>.monad - [binary_header (<>.speculative (?binary.segment block_size)) - path ..path_parser - mode ..mode_parser - user_id ..small_parser - group_id ..small_parser - size ..big_parser - modification_time ..big_parser - [actual checksum_code] ..checksum_parser - _ (let [expected (expected_checksum checksum_code binary_header)] - (<>.of_try - (exception.assertion ..wrong_checksum [expected actual] - (n.= expected actual)))) - link_flag ..link_flag_parser - link_name ..path_parser - magic ..magic_parser - user_name ..name_parser - group_name ..name_parser - major_device ..small_parser - minor_device ..small_parser - _ (?binary.segment ..header_padding_size)] - (in [#path path - #mode mode - #user_id user_id - #group_id group_id - #size size - #modification_time modification_time - #checksum checksum_code - #link_flag link_flag - #link_name link_name - #magic magic - #user_name user_name - #group_name group_name - #major_device major_device - #minor_device minor_device]))) + (function (_ state) + (`` (<| (,, (with_template [<binding> <parser>] + [(parsed state <binding> <parser>)] + + [binary_header (<>.speculative (?binary.segment block_size))] + [path ..path_parser] + [mode ..mode_parser] + [user_id ..small_parser] + [group_id ..small_parser] + [size ..big_parser] + [modification_time ..big_parser] + [[actual checksum_code] ..checksum_parser] + )) + (let [expected (expected_checksum checksum_code binary_header)]) + (if (not (n.= expected actual)) + (exception.except ..wrong_checksum [expected actual])) + (,, (with_template [<binding> <parser>] + [(parsed state <binding> <parser>)] + + [link_flag ..link_flag_parser] + [link_name ..path_parser] + [magic ..magic_parser] + [user_name ..name_parser] + [group_name ..name_parser] + [major_device ..small_parser] + [minor_device ..small_parser] + [_ (?binary.segment ..header_padding_size)] + )) + {try.#Success [state [#path path + #mode mode + #user_id user_id + #group_id group_id + #size size + #modification_time modification_time + #checksum checksum_code + #link_flag link_flag + #link_name link_name + #magic magic + #user_name user_name + #group_name group_name + #major_device major_device + #minor_device minor_device]]})))) (def (file_parser header) - (-> Header (Parser File)) - (do <>.monad - [.let [size (the #size header) - rounded_size (..rounded_content_size size)] - content (?binary.segment (..from_big size)) - content (<>.of_try (..content content)) - _ (?binary.segment (n.- (..from_big size) rounded_size))] - (in [(the #path header) - (|> header - (the #modification_time) - ..from_big - .int - duration.of_millis - (duration.up (|> duration.second duration.millis .nat)) - instant.absolute) - (the #mode header) - [#user [#name (the #user_name header) - #id (the #user_id header)] - #group [#name (the #group_name header) - #id (the #group_id header)]] - content]))) + (-> Header + (Parser File)) + (function (_ state) + (`` (<| (let [size (the #size header) + rounded_size (..rounded_content_size size)]) + (,, (with_template [<binding> <parser>] + [(parsed state <binding> <parser>)] + + [content (?binary.segment (..from_big size))] + [content (<>.of_try (..content content))] + [_ (?binary.segment (n.- (..from_big size) rounded_size))] + )) + {try.#Success [state [(the #path header) + (|> header + (the #modification_time) + ..from_big + .int + duration.of_millis + (duration.up (|> duration.second duration.millis .nat)) + instant.absolute) + (the #mode header) + [#user [#name (the #user_name header) + #id (the #user_id header)] + #group [#name (the #group_name header) + #id (the #group_id header)]] + content]]})))) (def entry_parser (Parser Entry) - (do [! <>.monad] - [header ..header_parser] - (cond (same? ..contiguous (the #link_flag header)) - (of ! each (|>> {..#Contiguous}) (..file_parser header)) - - (same? ..symbolic_link (the #link_flag header)) - (in {..#Symbolic_Link (the #link_name header)}) - - (same? ..directory (the #link_flag header)) - (in {..#Directory (the #path header)}) - - ... (or (same? ..normal (the #link_flag header)) - ... (same? ..old_normal (the #link_flag header))) - (of ! each (|>> {..#Normal}) (..file_parser header))))) + (function (_ state) + (when (..header_parser state) + {try.#Success [state header]} + (template.let [(of_file <tag>) + [(when (..file_parser header state) + {try.#Success [state it]} + {try.#Success [state {<tag> it}]} + + {try.#Failure error} + {try.#Failure error})] + + (of_other <flag> <tag> <slot>) + [(same? <flag> (the #link_flag header)) + {try.#Success [state {<tag> (the <slot> header)}]}]] + (`` (cond (or (same? ..normal (the #link_flag header)) + (same? ..old_normal (the #link_flag header))) + (,, (of_file ..#Normal)) + + (,, (of_other ..symbolic_link ..#Symbolic_Link #link_name)) + (,, (of_other ..directory ..#Directory #path)) + + ... (same? ..contiguous (the #link_flag header)) + (,, (of_file ..#Contiguous))))) + + {try.#Failure error} + {try.#Failure error}))) ... It's safe to implement the parser this way because the range of values for Nat is 2^64 ... Whereas the maximum possible value for the checksum of a 512 block is (256 × 512) = 131,072 diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index f76ab1675..632fc1c3f 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -216,7 +216,8 @@ (def .public undefined? (template (undefined? <it>) - [(.as .Bit (.is .Any (undefined?|analysis <it>)))])) + [(.as .Bit + (..undefined?|analysis <it>))])) (translation undefined|translation [phase archive state] @@ -232,7 +233,8 @@ (def .public undefined (template (_) - [(.is ..Undefined (undefined|analysis))])) + [(.is ..Undefined + (..undefined|analysis))])) (def (pairs it) (All (_ a) (-> (List a) (List [a a]))) @@ -298,7 +300,7 @@ (def .public object (syntax (_ [it (<>.some <code>.any)]) (in (list (` (.as (..Object .Any) - (object|analysis (,* it)))))))) + (..object|analysis (,* it)))))))) (translation set|translation [phase archive state] @@ -334,7 +336,8 @@ (syntax (_ [field <code>.any value <code>.any object <code>.any]) - (in (list (` (.as .Any (set|analysis (, field) (, value) (, object)))))))) + (in (list (` (.as .Any + (..set|analysis (, field) (, value) (, object)))))))) ) ... else (these)) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index e13051cb4..6b1cff03f 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -21,9 +21,9 @@ [macro [syntax (.only syntax)] ["[0]" expansion]] - [target - ["/" js]] [compiler + [target + ["/" js]] [meta [cache ["[0]" dependency @@ -56,9 +56,10 @@ type.inferring (next archive term)) + lux (declaration.of_analysis meta.compiler_state) next declaration.synthesis term (declaration.of_synthesis - (next archive term)) + (next lux archive term)) dependencies (declaration.of_translation (dependency.dependencies archive term)) @@ -66,7 +67,7 @@ next declaration.translation [interim_artifacts term] (declaration.of_translation (translation.with_interim_artifacts archive - (next archive term))) + (next lux archive term))) _ (declaration.of_translation (do ! diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 66b0d1478..d9e729a8a 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -21,9 +21,9 @@ [macro [syntax (.only syntax)] ["[0]" expansion]] - [target - ["/" python]] [compiler + [target + ["/" python]] [meta [cache ["[0]" dependency @@ -37,7 +37,8 @@ ["[0]" type]]]]]]]]) (def definition - (-> Code (Meta [Text Code])) + (-> Code + (Meta [Text Code])) (|>> (list) (<code>.result (<| <code>.form (<>.after (<code>.this_symbol (symbol .def#))) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 87e4958ab..a2148b973 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -919,3 +919,19 @@ (..< +0.0 remainder))) (..+ divisor remainder) remainder))) + +(with_template [<factor> <name>] + [(def .public <name> + (-> Frac + Frac) + (|>> (* <factor>)))] + + [+100.0 percentage] + [+360.0 degree] + + ... https://en.wikipedia.org/wiki/Per_mille + [+01,000.0 permille] + + ... https://en.wikipedia.org/wiki/Basis_point + [+10,000.0 permyriad] + ) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 3a45da32d..87987c272 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -26,8 +26,9 @@ ["[0]" symbol (.use "[1]#[0]" absolute equivalence)] ["[0]" code]]) -... (.type (Meta a) -... (-> Lux (Try [Lux a]))) +... (.type (Meta of) +... (-> Lux +... (Try [Lux of]))) (def .public functor (Functor Meta) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux index 0d2b79c43..2effaf905 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux @@ -558,10 +558,10 @@ (_.define r00 (ll parameter)) (_.define x00 (_.* l00 r00)) - (_.define x16 (high_16 x00)) + (_.define x16 (|> (high_16 x00) + (_.+ (_.* l16 r00)))) (_.statement (_.set x00 (low_16 x00))) - (_.statement (_.set x16 (|> x16 (_.+ (_.* l16 r00))))) (_.define x32 (high_16 x16)) (_.statement (_.set x16 (|> x16 low_16 (_.+ (_.* l00 r16))))) (_.statement (_.set x32 (|> x32 (_.+ (high_16 x16))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux index c18822e3c..b2ecca205 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux @@ -43,7 +43,6 @@ ["[1][0]" foreign]]] ["/[1]" // ["[1][0]" runtime] - ["[1][0]" value] ["[1][0]" reference] [//// [analysis (.only Environment)] |