aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
authorEduardo Julian2023-01-26 02:39:27 -0400
committerEduardo Julian2023-01-26 02:39:27 -0400
commitf391f448f4fe6508502a68aa1c51d60475967952 (patch)
tree0ebfaee3aee8d2083e20917157eb8dab6c2f47c3 /stdlib/source/library
parent70aa7154e64c0ab2352c00e5f993e88737929ccc (diff)
Optimized Tar parsing in order to fix stack-overflow when loading cache.
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/control/parser.lux238
-rw-r--r--stdlib/source/library/lux/data/color/hsb.lux65
-rw-r--r--stdlib/source/library/lux/data/color/hsl.lux11
-rw-r--r--stdlib/source/library/lux/data/color/rgb.lux12
-rw-r--r--stdlib/source/library/lux/data/format/tar.lux406
-rw-r--r--stdlib/source/library/lux/ffi.lux11
-rw-r--r--stdlib/source/library/lux/ffi/export.js.lux9
-rw-r--r--stdlib/source/library/lux/ffi/export.py.lux7
-rw-r--r--stdlib/source/library/lux/math/number/frac.lux16
-rw-r--r--stdlib/source/library/lux/meta.lux5
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/js/runtime.lux4
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/apply.lux1
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)]