aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/format
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/format')
-rw-r--r--stdlib/source/format/lux/data/binary.lux298
-rw-r--r--stdlib/source/format/lux/data/text.lux133
2 files changed, 431 insertions, 0 deletions
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 [<name> <extension> <post>]
+ [(def: <name>
+ (template (<name> <parameter> <subject>)
+ [(<post> (<extension> (.int <parameter>) (.int <subject>)))]))]
+
+ [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 [<name> <size> <write>]
+ [(def: .public <name>
+ (Writer (I64 Any))
+ (function (_ value)
+ [<size>
+ (function (_ [offset binary])
+ [(n#+ <size> offset)
+ (<write> 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 [<number> <tag> <writer>]
+ [{<tag> caseV}
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.++ caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (/.has_8! offset <number>)
+ [(.++ 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 [<name> <type>]
+ [(def: .public <name> (Writer <type>) ..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 [<name> <bits> <size> <write>]
+ [(def: .public <name>
+ (Writer Binary)
+ (let [mask (..mask <size>)]
+ (function (_ value)
+ (let [size (|> value /.size (i64.and mask))
+ size' (n#+ <size> size)]
+ [size'
+ (function (_ [offset binary])
+ [(n#+ size' offset)
+ (|> binary
+ (<write> offset size)
+ (/.copy! size 0 value (n#+ <size> 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 [<name> <binary>]
+ [(def: .public <name>
+ (Writer Text)
+ (|>> (at utf8.codec encoded) <binary>))]
+
+ [utf8_8 ..binary_8]
+ [utf8_16 ..binary_16]
+ [utf8_32 ..binary_32]
+ [utf8_64 ..binary_64]
+ )
+
+(def: .public text ..utf8_64)
+
+(with_template [<name> <size> <write>]
+ [(def: .public (<name> valueW)
+ (All (_ v) (-> (Writer v) (Writer (Sequence v))))
+ (function (_ value)
+ (let [original_count (sequence.size value)
+ capped_count (i64.and (..mask <size>)
+ 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> size)
+ (function (_ [offset binary])
+ (|> binary
+ (<write> offset capped_count)
+ [(n#+ <size> 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 [<number> <tag> <writer>]
+ [{<tag> caseV}
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.++ caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (/.has_8! offset <number>)
+ [(.++ 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 [<number> <tag> <writer>]
+ [{<tag> caseV}
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.++ caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (/.has_8! offset <number>)
+ [(.++ 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 <code>.any)])
+ (in (.list (` (all "lux text concat" (~+ fragments)))))))
+
+(with_template [<name> <type> <formatter>]
+ [(def: .public <name>
+ (Format <type>)
+ <formatter>)]
+
+ [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 [<type> <format>,<codec>]
+ [(`` (with_template [<format> <codec>]
+ [(def: .public <format>
+ (Format <type>)
+ (at <codec> encoded))]
+
+ (~~ (template.spliced <format>,<codec>))))]
+
+ [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) "}"))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 00:46:20 +0000