From 289f9de576a7980184339f380d5000f7d71f6d7e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 13 Jun 2022 01:55:22 -0400 Subject: New "format" hierarchy. --- stdlib/source/format/lux/data/binary.lux | 298 +++++++++++++++++++++++++++++++ stdlib/source/format/lux/data/text.lux | 133 ++++++++++++++ 2 files changed, 431 insertions(+) create mode 100644 stdlib/source/format/lux/data/binary.lux create mode 100644 stdlib/source/format/lux/data/text.lux (limited to 'stdlib/source/format') diff --git a/stdlib/source/format/lux/data/binary.lux b/stdlib/source/format/lux/data/binary.lux new file mode 100644 index 000000000..e29a737ce --- /dev/null +++ b/stdlib/source/format/lux/data/binary.lux @@ -0,0 +1,298 @@ +(.using + [library + [lux (.except and or nat int rev list type symbol) + [ffi (.only)] + [abstract + [monoid (.only Monoid)] + [monad (.only Monad do)] + [equivalence (.only Equivalence)]] + [control + ["[0]" pipe] + ["[0]" function] + ["<>" parser (.open: "[1]#[0]" monad) + ["" binary (.only Offset Size Parser)]]] + [data + ["[0]" product] + [text + ["%" \\format (.only format)] + [encoding + ["[0]" utf8]]] + [collection + ["[0]" list] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" functor)] + ["[0]" set (.only Set)] + [array + [\\unsafe (.only)]]]] + [macro + ["^" pattern]] + [math + [number + ["n" nat] + ["[0]" i64] + ["[0]" frac]]]]] + [\\unsafe + ["[0]" / (.only Binary)]]) + +(with_template [ ] + [(def: + (template ( ) + [( ( (.int ) (.int )))]))] + + [n#= "lux i64 =" .|>] + [n#+ "lux i64 +" .nat] + [n#* "lux i64 *" .nat] + ) + +(def: mask + (-> Size (I64 Any)) + (|>> (n#* i64.bits_per_byte) i64.mask)) + +(type: .public Mutation + (-> [Offset Binary] [Offset Binary])) + +(type: .public Specification + [Size Mutation]) + +(def: .public no_op + Specification + [0 function.identity]) + +(def: .public (instance [size mutation]) + (-> Specification Binary) + (|> size /.empty [0] mutation product.right)) + +(def: .public monoid + (Monoid Specification) + (implementation + (def: identity + ..no_op) + + (def: (composite [sizeL mutL] [sizeR mutR]) + [(n#+ sizeL sizeR) + (|>> mutL mutR)]))) + +(type: .public (Writer a) + (-> a Specification)) + +(def: .public (result writer value) + (All (_ a) (-> (Writer a) a Binary)) + (..instance (writer value))) + +(with_template [ ] + [(def: .public + (Writer (I64 Any)) + (function (_ value) + [ + (function (_ [offset binary]) + [(n#+ offset) + ( offset value binary)])]))] + + [bits_8 .size_8 /.has_8!] + [bits_16 .size_16 /.has_16!] + [bits_32 .size_32 /.has_32!] + [bits_64 .size_64 /.has_64!] + ) + +(def: .public (or left right) + (All (_ l r) (-> (Writer l) (Writer r) (Writer (Or l r)))) + (function (_ altV) + (case altV + (^.with_template [ ] + [{ caseV} + (let [[caseS caseT] ( caseV)] + [(.++ caseS) + (function (_ [offset binary]) + (|> binary + (/.has_8! offset ) + [(.++ offset)] + caseT))])]) + ([0 .#Left left] + [1 .#Right right]) + ))) + +(def: .public (and pre post) + (All (_ a b) (-> (Writer a) (Writer b) (Writer [a b]))) + (function (_ [preV postV]) + (at ..monoid composite (pre preV) (post postV)))) + +(def: .public (rec body) + (All (_ a) (-> (-> (Writer a) (Writer a)) (Writer a))) + (function (again value) + (body again value))) + +(def: .public any + (Writer Any) + (function.constant ..no_op)) + +(def: .public bit + (Writer Bit) + (|>> (pipe.case #0 0 #1 1) ..bits_8)) + +(with_template [ ] + [(def: .public (Writer ) ..bits_64)] + + [nat Nat] + [int Int] + [rev Rev] + ) + +(def: .public frac + (Writer Frac) + (|>> frac.bits ..bits_64)) + +(def: .public (segment size) + (-> Nat (Writer Binary)) + (function (_ value) + [size + (function (_ [offset binary]) + [(n#+ size offset) + (/.copy! (n.min size (/.size value)) + 0 + value + offset + binary)])])) + +(with_template [ ] + [(def: .public + (Writer Binary) + (let [mask (..mask )] + (function (_ value) + (let [size (|> value /.size (i64.and mask)) + size' (n#+ size)] + [size' + (function (_ [offset binary]) + [(n#+ size' offset) + (|> binary + ( offset size) + (/.copy! size 0 value (n#+ offset)))])]))))] + + [binary_8 ..bits_8 .size_8 /.has_8!] + [binary_16 ..bits_16 .size_16 /.has_16!] + [binary_32 ..bits_32 .size_32 /.has_32!] + [binary_64 ..bits_64 .size_64 /.has_64!] + ) + +(with_template [ ] + [(def: .public + (Writer Text) + (|>> (at utf8.codec encoded) ))] + + [utf8_8 ..binary_8] + [utf8_16 ..binary_16] + [utf8_32 ..binary_32] + [utf8_64 ..binary_64] + ) + +(def: .public text ..utf8_64) + +(with_template [ ] + [(def: .public ( valueW) + (All (_ v) (-> (Writer v) (Writer (Sequence v)))) + (function (_ value) + (let [original_count (sequence.size value) + capped_count (i64.and (..mask ) + original_count) + value (if (n#= original_count capped_count) + value + (|> value sequence.list (list.first capped_count) sequence.of_list)) + (open "specification#[0]") ..monoid + [size mutation] (|> value + (sequence#each valueW) + (at sequence.mix mix + (function (_ post pre) + (specification#composite pre post)) + specification#identity))] + [(n#+ size) + (function (_ [offset binary]) + (|> binary + ( offset capped_count) + [(n#+ offset)] + mutation))])))] + + [sequence_8 .size_8 /.has_8!] + [sequence_16 .size_16 /.has_16!] + [sequence_32 .size_32 /.has_32!] + [sequence_64 .size_64 /.has_64!] + ) + +(def: .public maybe + (All (_ a) (-> (Writer a) (Writer (Maybe a)))) + (..or ..any)) + +(def: .public (list value) + (All (_ a) (-> (Writer a) (Writer (List a)))) + (..rec + (|>> (..and value) + (..or ..any)))) + +(def: .public (set value) + (All (_ a) (-> (Writer a) (Writer (Set a)))) + (|>> set.list (..list value))) + +(def: .public symbol + (Writer Symbol) + (..and ..text ..text)) + +(def: .public type + (Writer Type) + (..rec + (function (_ again) + (let [pair (..and again again) + indexed ..nat + quantified (..and (..list again) again)] + (function (_ altV) + (case altV + (^.with_template [ ] + [{ caseV} + (let [[caseS caseT] ( caseV)] + [(.++ caseS) + (function (_ [offset binary]) + (|> binary + (/.has_8! offset ) + [(.++ offset)] + caseT))])]) + ([0 .#Primitive (..and ..text (..list again))] + [1 .#Sum pair] + [2 .#Product pair] + [3 .#Function pair] + [4 .#Parameter indexed] + [5 .#Var indexed] + [6 .#Ex indexed] + [7 .#UnivQ quantified] + [8 .#ExQ quantified] + [9 .#Apply pair] + [10 .#Named (..and ..symbol again)]) + )))))) + +(def: .public location + (Writer Location) + (all ..and ..text ..nat ..nat)) + +(def: .public code + (Writer Code) + (..rec + (function (_ again) + (let [sequence (..list again)] + (..and ..location + (function (_ altV) + (case altV + (^.with_template [ ] + [{ caseV} + (let [[caseS caseT] ( caseV)] + [(.++ caseS) + (function (_ [offset binary]) + (|> binary + (/.has_8! offset ) + [(.++ offset)] + caseT))])]) + ([0 .#Bit ..bit] + [1 .#Nat ..nat] + [2 .#Int ..int] + [3 .#Rev ..rev] + [4 .#Frac ..frac] + [5 .#Text ..text] + [6 .#Symbol ..symbol] + [7 .#Form sequence] + [8 .#Variant sequence] + [9 .#Tuple sequence]) + ))))))) diff --git a/stdlib/source/format/lux/data/text.lux b/stdlib/source/format/lux/data/text.lux new file mode 100644 index 000000000..606cace14 --- /dev/null +++ b/stdlib/source/format/lux/data/text.lux @@ -0,0 +1,133 @@ +(.using + [library + [lux (.except list nat int rev type symbol) + [abstract + [monad (.only do)] + [functor + ["[0]" contravariant]]] + [control + ["<>" parser (.only) + ["<[0]>" code (.only Parser)]]] + [data + ["[0]" bit] + ["[0]" text] + [format + ["[0]" xml] + ["[0]" json]] + [collection + ["[0]" list (.open: "[1]#[0]" monad)]]] + ["[0]" time (.only) + ["[0]" instant] + ["[0]" duration] + ["[0]" date] + ["[0]" day] + ["[0]" month]] + [math + ["[0]" modular] + [number + ["[0]" nat] + ["[0]" int] + ["[0]" rev] + ["[0]" frac] + ["[0]" ratio]]] + [macro + [syntax (.only syntax)] + ["[0]" code] + ["[0]" template]] + [meta + ["[0]" location] + ["[0]" symbol]] + ["[0]" type]]]) + +(type: .public (Format a) + (-> a Text)) + +(def: .public functor + (contravariant.Functor Format) + (implementation + (def: (each f fb) + (|>> f fb)))) + +(def: .public format + (syntax (_ [fragments (<>.many .any)]) + (in (.list (` (all "lux text concat" (~+ fragments))))))) + +(with_template [ ] + [(def: .public + (Format ) + )] + + [bit Bit (at bit.codec encoded)] + [nat Nat (at nat.decimal encoded)] + [int Int (at int.decimal encoded)] + [rev Rev (at rev.decimal encoded)] + [frac Frac (at frac.decimal encoded)] + [text Text text.format] + + [ratio ratio.Ratio (at ratio.codec encoded)] + [symbol Symbol (at symbol.codec encoded)] + [location Location location.format] + [code Code code.format] + [type Type type.format] + + [instant instant.Instant (at instant.codec encoded)] + [duration duration.Duration (at duration.codec encoded)] + [date date.Date (at date.codec encoded)] + [time time.Time (at time.codec encoded)] + [day day.Day (at day.codec encoded)] + [month month.Month (at month.codec encoded)] + + [xml xml.XML (at xml.codec encoded)] + [json json.JSON (at json.codec encoded)] + ) + +(with_template [ ,] + [(`` (with_template [ ] + [(def: .public + (Format ) + (at encoded))] + + (~~ (template.spliced ,))))] + + [Nat + [[nat_2 nat.binary] + [nat_8 nat.octal] + [nat_10 nat.decimal] + [nat_16 nat.hex]]] + [Int + [[int_2 int.binary] + [int_8 int.octal] + [int_10 int.decimal] + [int_16 int.hex]]] + [Rev + [[rev_2 rev.binary] + [rev_8 rev.octal] + [rev_10 rev.decimal] + [rev_16 rev.hex]]] + [Frac + [[frac_2 frac.binary] + [frac_8 frac.octal] + [frac_10 frac.decimal] + [frac_16 frac.hex]]] + ) + +(def: .public (mod modular) + (All (_ m) (Format (modular.Mod m))) + (let [codec (modular.codec (modular.modulus modular))] + (at codec encoded modular))) + +(def: .public (list formatter) + (All (_ a) (-> (Format a) (Format (List a)))) + (|>> (list#each (|>> formatter (format " "))) + text.together + (text.enclosed ["(list" ")"]))) + +(def: .public (maybe format) + (All (_ a) (-> (Format a) (Format (Maybe a)))) + (function (_ value) + (case value + {.#None} + "{.#None}" + + {.#Some value} + (..format "{.#Some " (format value) "}")))) -- cgit v1.2.3