ref: 21973ff5337936387681435e507c19d393e52c27
parent: 991160b28f27849a616f39059f79cde0b312e01a
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Dec 25 22:36:04 EST 2024
lz-unpack: change to use :size or :to keyed args
--- a/compress.c
+++ b/compress.c
@@ -1,4 +1,5 @@
#include "flisp.h"
+#include "compress.h"
#include "cvalues.h"
#include "types.h"
#include "brieflz.h"
@@ -40,7 +41,7 @@
BUILTIN("lz-unpack", lz_unpack) {- argcount(nargs, 2);
+ argcount(nargs, 3);
uint8_t *in;
size_t insz;
@@ -47,12 +48,29 @@
to_sized_ptr(args[0], &in, &insz);
if(!isarray(args[0]))
type_error("array", args[0]);- size_t outsz = tosize(args[1]);
- value_t v = cvalue(cv_class(ptr(args[0])), outsz);
- uint8_t *out = cvalue_data(v);
+ size_t outsz;
+ uint8_t *out;
+ value_t v;
+ if(args[1] == FL(sizesym)){+ outsz = tosize(args[2]);
+ v = cvalue(cv_class(ptr(args[0])), outsz);
+ out = cvalue_data(v);
+ }else if(args[1] == FL(tosym)){+ v = args[2];
+ to_sized_ptr(v, &out, &outsz);
+ }else{+ lerrorf(FL(ArgError), "either :size or :to must be specified");
+ }
unsigned long n = blz_depack_safe(in, insz, out, outsz);
if(n == BLZ_ERROR)
lerrorf(FL(ArgError), "blz error");
cvalue_len(v) = n;
return v;
+}
+
+void
+compress_init(void)
+{+ FL(sizesym) = symbol(":size", false);+ FL(tosym) = symbol(":to", false);}
--- /dev/null
+++ b/compress.h
@@ -1,0 +1,1 @@
+void compress_init(void);
--- a/docs_extra.lsp
+++ b/docs_extra.lsp
@@ -21,9 +21,10 @@
trade-off between time/space and ratio. Level 10 is optimal but very
slow.")
-(doc-for (lz-unpack data decompressed-bytes)
+(doc-for (lz-unpack data :to destination :size decompressed-bytes)
"Return decompressed data previously compressed using lz-pack.
-The decompressed-bytes parameter is the expected size of the
-decompressed data.")
+Either destination for the decompressed data or the expected size of
+the decompressed data must be specified. In the latter case a new
+array is allocated.")
(del! *syntax-environment* 'doc-for)
--- a/flisp.boot
+++ b/flisp.boot
@@ -14,8 +14,9 @@
#fn("6000n201l:" #()) #fn("6000n201m:" #()) 0 #fn("8000z0700}2:" #(vector)) #fn("8000z0700}2:" #(aset!)) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #()))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 0)- *properties* #table(*funvars* #table(lz-unpack (data decompressed-bytes) void? (x) length= (lst
- n) help (term) void rest *prompt* nil lz-pack (data (level 0)) vm-stats nil) *doc* #table(lz-unpack "Return decompressed data previously compressed using lz-pack.\nThe decompressed-bytes parameter is the expected size of the\ndecompressed data." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
+ *properties* #table(*funvars* #table(lz-unpack (data :to destination :size
+ decompressed-bytes) void? (x) length= (lst
+ n) help (term) void rest *prompt* nil lz-pack (data (level 0)) vm-stats nil) *doc* #table(lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
*runestring-type* (array rune) *string-type* (array byte)
*syntax-environment* #table(unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym) let λ prog1 trycatch begin raise)) help #fn("<000n170021527002252853\\0738551474504863B07450475086P51@30O47450@B0732627051524745047860:" #(getprop--- a/flisp.c
+++ b/flisp.c
@@ -17,6 +17,7 @@
#include "table.h"
#include "iostream.h"
#include "fsixel.h"
+#include "compress.h"
typedef struct {char *name;
@@ -2331,6 +2332,7 @@
table_init();
iostream_init();
fsixel_init();
+ compress_init();
}
// top level ------------------------------------------------------------------
--- a/flisp.h
+++ b/flisp.h
@@ -391,6 +391,8 @@
value_t tablesym;
fltype_t *tabletype;
+ value_t sizesym, tosym;
+
value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym;
value_t instrsym, outstrsym;
fltype_t *iostreamtype;
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -450,10 +450,13 @@
(s (file "unittest.lsp"))
(in (io-readall s))
(packed (lz-pack in level))
- (unpacked (lz-unpack packed (sizeof in))))
+ (unpacked (lz-unpack packed :size (sizeof in)))
+ (unpacked2 (array-alloc 'byte (sizeof in) 0)))
(io-close s)
(assert (< (sizeof packed) (sizeof in)))
(assert (equal? in unpacked))
+ (assert (eq? unpacked2 (lz-unpack packed :to unpacked2)))
+ (assert (equal? in unpacked2))
(princ "lz packing at level " level ": " (sizeof in) " → " (sizeof packed))
(newline))