Potluck time!

Potluck time!

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 888 bytes --]

Hello Guilers!

As you may know, it’s that time of the year where we are all invited to
prepare dishes and to bring them to the Guile birthday potluck.  This
has become a tradition to celebrate the release of Guile 2, which took
place on Feb. 16th¹, 5 years ago!

So the idea is that you hack up something with Guile, and next Tuesday,
on the 16th, you share your hack with people on this mailing list.

Here are the fine dishes that people brought in previous years:

  2012: http://savannah.gnu.org/forum/forum.php?forum_id=7111
  2013: http://savannah.gnu.org/forum/forum.php?forum_id=7509
  2014: http://savannah.gnu.org/forum/forum.php?forum_id=7887
  2015: https://lists.gnu.org/archive/html/guile-user/2015-02/threads.html

Time to fire up a REPL and hack!  :-)

Thanks,
Ludo’.

¹ https://lists.gnu.org/archive/html/guile-devel/2011-02/msg00173.html


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 818 bytes --]

Re: Potluck time!

[Christopher Allan Webber]

Ludovic Courtès writes:

> Hello Guilers!
>
> As you may know, it’s that time of the year where we are all invited to
> prepare dishes and to bring them to the Guile birthday potluck.  This
> has become a tradition to celebrate the release of Guile 2, which took
> place on Feb. 16th¹, 5 years ago!
>
> So the idea is that you hack up something with Guile, and next Tuesday,
> on the 16th, you share your hack with people on this mailing list.
>
> Here are the fine dishes that people brought in previous years:
>
>   2012: http://savannah.gnu.org/forum/forum.php?forum_id=7111
>   2013: http://savannah.gnu.org/forum/forum.php?forum_id=7509
>   2014: http://savannah.gnu.org/forum/forum.php?forum_id=7887
>   2015: https://lists.gnu.org/archive/html/guile-user/2015-02/threads.html
>
> Time to fire up a REPL and hack!  :-)
>
> Thanks,
> Ludo’.
>
> ¹ https://lists.gnu.org/archive/html/guile-devel/2011-02/msg00173.html

Whoo whoo!  Maybe I can get out an 8sync 0.1 release by then... :)

Re: Potluck time!

[Stefan Israelsson Tampe]

[-- Attachment #1: Type: text/plain, Size: 3021 bytes --]

Hi,

I will take on to introduce attributed variables (see swi prolog) to
minikanren. My hypothesis is that apart from the pure logical
constructs conde fresh and == all defined predicates can be constructed
with the attribute framework with no need to add extra stacks.

The idea is to maintain only two stacks S,A e.g. the normal variable stack
S and attributed stack A. All is mapping from variables
to values, for the attributed case there is no variable pointing to
variables, but resetting of values will be done and attributed value
is an assoc of type ((id1 . data1) ...) id1 contain a custom unification
predicate f : (f u v lam) that will execute before the unification of
u and v, and lam will be bound to either #f or a predicate to be executed
after the unification. The basic interface is simple. You have
(put-attr id var val)  will put a new value val in attribute data for
identity id and variable var, if the attribute does not exist create a
                               new one first
(put-attr-last id var val) the same but in case  a new attribute id will be
put last (use this for attributes that does not change values, this
                                     is a bit more gc friendly for
attribute values that is created and then never change

(get-attr id var valout)  fetch the attribute data for identity id and
variable var, if not an attributed variable of id, fail.

There will need to be a custom printer as well in order to have a nice
printout so there need to be a little framework for that. So from this
the plan is to make all other predicates needed to construct evalo.

The nice thing about this is that attributed variables is a way to
customize condition on variables. So one does not need to proliferate the
number
of stacks. But I tend to agree that the minikanren sources are really
minimalistic and probably the use of attributed variables will make the
code much more verbose. This will be my potluck contribution.

Regards

On Wed, Feb 10, 2016 at 11:23 AM, Ludovic Courtès <ludo@gnu.org> wrote:

> Hello Guilers!
>
> As you may know, it’s that time of the year where we are all invited to
> prepare dishes and to bring them to the Guile birthday potluck.  This
> has become a tradition to celebrate the release of Guile 2, which took
> place on Feb. 16th¹, 5 years ago!
>
> So the idea is that you hack up something with Guile, and next Tuesday,
> on the 16th, you share your hack with people on this mailing list.
>
> Here are the fine dishes that people brought in previous years:
>
>   2012: http://savannah.gnu.org/forum/forum.php?forum_id=7111
>   2013: http://savannah.gnu.org/forum/forum.php?forum_id=7509
>   2014: http://savannah.gnu.org/forum/forum.php?forum_id=7887
>   2015: https://lists.gnu.org/archive/html/guile-user/2015-02/threads.html
>
> Time to fire up a REPL and hack!  :-)
>
> Thanks,
> Ludo’.
>
> ¹ https://lists.gnu.org/archive/html/guile-devel/2011-02/msg00173.html
>
>

[-- Attachment #2: Type: text/html, Size: 4768 bytes --]

Re: Potluck time!

[Stefan Israelsson Tampe]

[-- Attachment #1: Type: text/plain, Size: 1677 bytes --]

Hey Guilers

My potluk contibution is tp implement attributed variables for minikanren
ontop af the source written by  William E. Byrd.

You can find the source at https://gitlab.com/tampe/attributed-minikanren

The source containes examples using attributed variables to implement =/=
symbolo numbero absento freezeo and wheno

API
(define AttributeId  (make-attribute unify-fkn portray-fkn)

(unify-fkn var data val lam)
var is the varibale that is unified (not yet unified at the execution of
this fkn) data is the data associated with AttributedId for variable var
and val is the value that var will be unified to and lam is a variable that
can be bound to a predicate to be executed after the unification have
been taken.

(portray-fkn var data s)
Return a list of  representations of attribuete AttributedId with data data
for variable var. s is the variable binding stack.

(get-attr var id data)
Get data associated with attributed id if no attribute exists fail

(put-attr var id data)
Put attributed data data of kind id to variable var.

New Examples
(wheno (cons test1 lam1) (cons test2 lam2) u1 u2 ...)
If u1 u2 ... is bound then before bounding test1 will by tried with no
unification as a result and if success lam2 will be executed else the
binding will fail
then the variable will be bound and test2 lam2 combo will be tried
similarly, the conses can be repaced with #f to indicate a void semantics.

(freezeo u lam1 lam2)
before the binding of u lam1 will be tried and after the binding of u lam2
will be tried.

The rest of the constraints was implemented by other means before and is
known please read the documentation by  William E. Byrd.

Regards
Stefan

[-- Attachment #2: Type: text/html, Size: 2209 bytes --]

Re: Potluck time!

[Stefan Israelsson Tampe]

[-- Attachment #1: Type: text/plain, Size: 1940 bytes --]

I manage to fail pushing the code earlier. It is fixed now. Happy Hacking
/stefan

On Sat, Feb 13, 2016 at 3:36 PM, Stefan Israelsson Tampe <
stefan.itampe@gmail.com> wrote:

> Hey Guilers
>
> My potluk contibution is tp implement attributed variables for minikanren
> ontop af the source written by  William E. Byrd.
>
> You can find the source at https://gitlab.com/tampe/attributed-minikanren
>
> The source containes examples using attributed variables to implement =/=
> symbolo numbero absento freezeo and wheno
>
> API
> (define AttributeId  (make-attribute unify-fkn portray-fkn)
>
> (unify-fkn var data val lam)
> var is the varibale that is unified (not yet unified at the execution of
> this fkn) data is the data associated with AttributedId for variable var
> and val is the value that var will be unified to and lam is a variable
> that can be bound to a predicate to be executed after the unification have
> been taken.
>
> (portray-fkn var data s)
> Return a list of  representations of attribuete AttributedId with data
> data for variable var. s is the variable binding stack.
>
> (get-attr var id data)
> Get data associated with attributed id if no attribute exists fail
>
> (put-attr var id data)
> Put attributed data data of kind id to variable var.
>
> New Examples
> (wheno (cons test1 lam1) (cons test2 lam2) u1 u2 ...)
> If u1 u2 ... is bound then before bounding test1 will by tried with no
> unification as a result and if success lam2 will be executed else the
> binding will fail
> then the variable will be bound and test2 lam2 combo will be tried
> similarly, the conses can be repaced with #f to indicate a void semantics.
>
> (freezeo u lam1 lam2)
> before the binding of u lam1 will be tried and after the binding of u lam2
> will be tried.
>
> The rest of the constraints was implemented by other means before and is
> known please read the documentation by  William E. Byrd.
>
> Regards
> Stefan
>
>
>

[-- Attachment #2: Type: text/html, Size: 2764 bytes --]

[potluck dish] the module (potluck struct)

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 2102 bytes --]

If you have used the Python struct module then this will look
familiar.  Otherwise, check out
https://docs.python.org/2/library/struct.html

Attached are three files: * struct.scm: the source code * struct.texi:
documentation * struct.test: test code


Struct Module =============

The '(potluck struct)' module provides procedures for packing and
unpacking scheme data to and from bytevectors based on a format
string.

     (use-modules (potluck struct))

     ;; pack two unsigned shorts and a double float in big endian
     order (define data (pack ">2Hd" 3 22 34.0)) (write data)
     (newline) ==> #vu8(0 3 0 22 64 65 0 0 0 0 0 0)

     ;; verify using unpack (write (unpack ">2Hd" data)) (newline) ==>
     (3 22 34.0)

 -- Scheme Procedure: pack format vals ...  Return a bytevector that
     contains encoded data from VALS, based on the string FORMAT.

 -- Scheme Procedure: unpack format bvec Return a list of scheme
     objects decoded from the bytevector BVEC, based on the string
     FORMAT.

 -- Scheme Procedure: packed-size format Return the number of bytes
     represented by the string FORMAT.

   The _format_ string used for PACK and UNPACK is constructed as a
sequence of digits, representing a repeat count, and codes,
representing the binary content.

The string may optionally begin with a special character that
represents the endianness: = native endianness < little-endian >
big-endian !  network order -- i.e., big-endian

Type codes used in the format string are interpreted as follows: x
    blank byte c 8-bit character ?  boolean b signed 8-bit integer B
    unsigned 8-bit integer h signed 16-bit integer H unsigned 16-bit
    integer i signed 32-bit integer I unsigned 32-bit integer l signed
    32-bit integer L unsigned 32-bit integer q signed 64-bit integer Q
    unsigned 64-bit integer f 32-bit IEEE floating point d 64-bit IEEE
    floating point s string

   The following issues remain to be addressed: string padding 'pack'
assumes that the string length in the format is the same as in the
passed string.  Non-conformance is not trapped as an error.



[-- Attachment #2.1: Type: text/html, Size: 5664 bytes --]

[-- Attachment #2.2: struct.scm --]
[-- Type: application/octet-stream, Size: 7550 bytes --]

;;; potluck/struct.scm - byte pack/unpack, like the Python struct module
;;;
;;; Copyright (C) 2016 Matthew R. Wette
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.

(define-module (potluck struct)
  #:export (unpack pack packed-size)
  #:use-module (rnrs bytevectors))


;; @deffn ctoi-at str ix => integer
;; Return integer value of the character in string @var{str} at index @var{ix}.
(define (ctoi-at str ix) (- (char->integer (string-ref str ix)) 48))

;; character codes used to indicate endianness:
(define cs:md (string->char-set "=<>!"))

;; @deffn get-nd code => endianness
;; Return endianness given the character code @var{code}.
(define (get-nd code)
  (case code
    ((#\!) (endianness big))		; network
    ((#\>) (endianness big))
    ((#\<) (endianness little))
    ((#\=) (native-endianness))
    ((#\@) (error "alignment not supported"))
    (else  (native-endianness))))

;; character codes used to indicate type:
(define cs:df (string->char-set "xcbB?hHiIlLqQfdsp")) ; type char

;; @deffn bv-size ct ch => byte count
;; Return the size in bytes for data indicated by format count and type.
;; @example
;; (get-size 12 #\s) => 12
;; (get-size 12 #\i) => 4
(define (bv-size ct ch)
  (case ch
    ((#\x) 1) ((#\c) 1) ((#\b) 1) ((#\B) 1) ((#\?) 1)
    ((#\h) 2) ((#\H) 2) ((#\i) 4) ((#\I) 4) ((#\l) 4) ((#\L) 4)
    ((#\q) 8) ((#\Q) 8) ((#\f) 4) ((#\d) 8) ((#\s #\p) ct)
    (else (error "unknown code"))))

;; @deffn fmt-cnt ct ch => datum count
;; Return the number of datums indicated by the format count and type.
(define (fmt-cnt ct ch)
  (case ch
    ((#\s #\p) ct)
    (else 1)))
  

;; set value, return number bytes written
;; This is a helper for @code{pack}.
(define (set-value! bv ix nd ct ch val)
  (case ch
    ((#\x) (if #f #f))
    ((#\c) ;; todo: check for 8-bit char
     (bytevector-u8-set! bv ix (char->integer val) nd))
    ((#\b) (bytevector-s8-set! bv ix val))
    ((#\B) (bytevector-u8-set! bv ix val))
    ((#\?) (bytevector-u8-set! bv ix (if val 1 0) nd))
    ((#\h) (bytevector-s16-set! bv ix val nd))
    ((#\H) (bytevector-u16-set! bv ix val nd))
    ((#\i #\l) (bytevector-s32-set! bv ix val nd))
    ((#\I #\L) (bytevector-u32-set! bv ix val nd))
    ((#\q) (bytevector-s64-set! bv ix val nd))
    ((#\Q) (bytevector-u64-set! bv ix val nd))
    ((#\f) (bytevector-ieee-single-set! bv ix val nd))
    ((#\d) (bytevector-ieee-double-set! bv ix val nd))
    ((#\s #\p)
     (bytevector-copy!
      (u8-list->bytevector (map char->integer (string->list val))) 0 bv ix sz))
    (else
     (scm-error 'misc-error "unpack"
		"bad type code: ~A" '(ch) #f))))

;; @deffn pack format datum ... => bytevector
;; Pack the datums into a bytevector.
(define (pack format . args)
  (cond
   ((zero? (string-length format)) (make-bytevector 0))
   (else
    (let* ((char-at (lambda (ix) (string-ref format ix)))
	   (f0 (if (char-set-contains? cs:md (char-at 0)) 1 0))
	   (nd (get-nd (char-at 0)))
	   (ln (string-length format))
	   (bvec (make-bytevector (packed-size format))))
      
      (let iter ((bx 0)		     ; index into resulting bytevector
		 (fx f0)	     ; index into format
		 (vals args)	     ; values to add
		 (ct 0)		     ; count from format
		 (ch #f))	     ; char from format
	;;(simple-format #t "bx=~S fx=~S ct=~S ch=~S\n" bx fx ct ch)
	(cond
	 ((positive? ct)		; encode a value
	  (set-value! bvec bx nd ct ch (car vals))
	  (iter (+ bx (bv-size ct ch)) fx (cdr vals) (- ct (fmt-cnt ct ch)) ch))
	 ((= fx ln)			; done
	  bvec)
	 ((null? vals)
	  (scm-error 'misc-error "pack"
		     "format size larger than input size" '() #f))
	 ((char-numeric? (string-ref format fx))
	  (iter bx (1+ fx) vals (- (* 10 ct) (ctoi-at format fx)) ch))
	 ((zero? ct)
	  (iter bx fx vals -1 ch))
	 ((char-set-contains? cs:df (string-ref format fx))
	  (iter bx (1+ fx) vals (- ct) (string-ref format fx)))
	 (else
	  (scm-error 'misc-error "pack"
		     "pack error" '() #f))))))))


;; @deffn cons-value bv ix nd cd tail => list
;; Cons the datum indicated by the data with @var{tail}, where
;; @itemize
;; @item @var{bv} is the bytevector
;; @item @var{ix} is the index into the bytevector
;; @item @var{nd} is the endianness
;; @item @var{cd} is the code
;; @end itemize
;; This is a helper for @code{unpack}.
(define cons-value
  (let ((sbuf (make-bytevector 128)))
    (lambda (bv ix nd sz ch tail)
      (case ch
	((#\x) tail)
	((#\c) (cons (integer->char (bytevector-u8-ref bv ix)) tail))
	((#\b) (cons (bytevector-s8-ref bv ix) tail))
	((#\B) (cons (bytevector-u8-ref bv ix) tail))
	((#\?) (cons (if (zero? (bytevector-u8-ref bv ix)) #f #t) tail))
	((#\h) (cons (bytevector-s16-ref bv ix nd) tail))
	((#\H) (cons (bytevector-u16-ref bv ix nd) tail))
	((#\i) (cons (bytevector-s32-ref bv ix nd) tail))
	((#\I) (cons (bytevector-u32-ref bv ix nd) tail))
	((#\l) (cons (bytevector-s32-ref bv ix nd) tail))
	((#\L) (cons (bytevector-u32-ref bv ix nd) tail))
	((#\q) (cons (bytevector-s64-ref bv ix nd) tail))
	((#\Q) (cons (bytevector-u64-ref bv ix nd) tail))
	((#\f) (cons (bytevector-ieee-single-ref bv ix nd) tail))
	((#\d) (cons (bytevector-ieee-double-ref bv ix nd) tail))
	((#\s #\p)
	 (set! sbuf (make-bytevector sz))
	 (bytevector-copy! bv ix sbuf 0 sz)
	 (cons (utf8->string sbuf) tail))
	(else
	 (scm-error 'misc-error "unpack"
		    "bad type code: ~A" '(ch) #f))))))

;; @deffn unpack format bytevec => list
;; Unpack datums from the bytevector into a list.
(define (unpack format bytevec)
  (cond
   ((zero? (string-length format)) '())
   (else
    (let* ((char-at (lambda (ix) (string-ref format ix)))
	   (f0 (if (char-set-contains? cs:md (char-at 0)) 1 0))
	   (nd (get-nd (char-at 0)))
	   (ln (string-length format)))
      (let iter ((rz '())			; result, list of bytevectors
		 (bx 0)			; index into input bytevector
		 (fx f0)			; index into format string
		 (ct 0)			; format count
		 (ch #f))			; format char
	;;(simple-format #t "bx=~S fx=~S ct=~S ch=~S\n" bx fx ct ch)
	(cond
	 ((> fx ln)
	  (error "format size larger than input bv size"))
	 ((positive? ct)
	  (iter (cons-value bytevec bx nd ct ch rz)
		(+ bx (bv-size ct ch)) fx (- ct (fmt-cnt ct ch)) ch))
	 ((= fx ln)
	  ;;(if (not (= bx (bytevector-length bytevec))) (error "error"))
	  (reverse rz))
	 ((char-numeric? (string-ref format fx))
	  (iter rz bx (1+ fx) (- (* 10 ct) (ctoi-at format fx)) ch))
	 ((zero? ct)
	  (iter rz bx fx -1 ch))
	 ((char-set-contains? cs:df (string-ref format fx))
	  (iter rz bx (1+ fx) (- ct) (string-ref format fx)))
	 (else
	  (scm-error 'misc-error "unpack" "format error" '() #f))))))))


;; @deffn packed-size format => size
;; In the Python struct module this is called "calcsize".
(define (packed-size format)
  (cond
   ((zero? (string-length format)) 0)
   (else
    (let* ((char-at (lambda (ix) (string-ref format ix)))
	   (f0 (if (char-set-contains? cs:md (char-at 0)) 1 0))
	   (ln (string-length format)))
      (let iter ((sz 0) (fx f0) (ct 0))	; sz: result, fx: inddx; ct: count
	(cond
	 ((= fx ln)
	  sz)
	 ((char-numeric? (string-ref format fx))
	  (iter sz (1+ fx) (+ (* 10 ct) (ctoi-at format fx))))
	 ((zero? ct)
	  (iter sz fx 1))
	 ((char-set-contains? cs:df (string-ref format fx))
	  (iter (+ sz (* ct (bv-size 1 (string-ref format fx)))) (1+ fx) 0))
	 (else
	  (scm-error 'misc-error "unpack" "format error" '() #f))))))))
  
;;; --- last line ---

[-- Attachment #2.3: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.4: struct.test --]
[-- Type: application/octet-stream, Size: 3448 bytes --]

;; struct.test				-*- scheme -*-
;;
;; Copyright (C) 2015 Matthew R. Wette
;; 
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved.  This file is offered as-is,
;; without any warranty.

(use-modules (potluck struct))		; pack, unpack, packed-size
(use-modules (rnrs bytevectors))
(use-modules (srfi srfi-2))		; and-let*

(set! *random-state* (random-state-from-platform))

(define (test1)
  (if (not (and-let*
	       (((= (packed-size "33s") 33))
		((= (packed-size "4I") 16))
		((= (packed-size "3B") 3))
		((= (packed-size "i") 4))
		)))
      (error "packed-size broken")))

(define (test2)
  (let* ((bv04 (make-bytevector 4)))
    ;; i
    (bytevector-s32-set! bv04 0 -1234 (native-endianness))
    (or (= (car (unpack "i" bv04)) -1234) (error "error"))
    ;; I
    (bytevector-s32-set! bv04 0 1234 (native-endianness))
    (or (= (car (unpack "I" bv04)) 1234) (error "error"))
    ))

(define (test3)
  (let* ((data (pack "I" 1234))
	 (vals (unpack "I" data)))
    (if (eqv? (car vals) 1234) #t (error "failed"))
    #t))

(define (test4)
  (define data (pack ">2Hd" 3 22 34.0)) ; pack two unsigned and a double
  (write data)(newline)
  (write (unpack ">2Hd" data))(newline))


(define (test5)

  ;; make a truncated copy of a bytevector
  (define (mk-bvec bv0 len)
    (let ((bv1 (make-bytevector len)))
      (bytevector-copy! bv0 0 bv1 0 len)
      bv1))

  ;; check pack/unpack consistency given
  ;;   format string, binary data, and list of datums
  (define (do-test format data vals)
    (when #f
      (simple-format #t "fm=~S\n" format)
      (simple-format #t "xv=~S\n" vals)
      (simple-format #t "us=~S\n" (unpack format data)))
    ;; Test pack:
    (if (not (equal? data (apply pack format vals)))
	(error "pack not working"))
    ;; Test unpack:
    (let iter ((xvals vals) (svals (unpack format data)))
      (cond
       ((and (null? xvals) (pair? svals))
	(error "mismatched count"))
       ((and (pair? xvals) (null? svals))
	(error "mismatched count"))
       ((null? xvals)
	#t)
       ((not (eqv? (car xvals) (car svals)))
	(error "value mismatch"))
       (else
	(iter (cdr xvals) (cdr svals)))))
    #f)

  (define (r-ct) (random 5))
  (define (r-ty) (random 8))
  
  (let ((bv (make-bytevector 1024))
	(nd (native-endianness))
	)
    (let iter ((fl '()) (bx 0) (xpt '()) (rc (r-ct)) (rt (r-ty)))
      ;;(simple-format #t "fl=~S bx=~S xpt=~S\n" fl bx xpt)
      (case rt
	((0)
	 (do-test (string-join (reverse fl) "") (mk-bvec bv bx) (reverse xpt)))
	((1)
	 (bytevector-s8-set! bv bx -123)
	 (iter (cons "1b" fl) (+ 1 bx) (cons -123 xpt) (r-ct) (r-ty)))
	((2)
	 (bytevector-s16-set! bv bx -1234 nd)
	 (iter (cons "1h" fl) (+ 2 bx) (cons -1234 xpt) (r-ct) (r-ty)))
	((3)
	 (bytevector-s32-set! bv bx -9123 nd)
	 (iter (cons "1i" fl) (+ 4 bx) (cons -9123 xpt) (r-ct) (r-ty)))
	((4)
	 (bytevector-s32-set! bv bx -3991123 nd)
	 (iter (cons "1l" fl) (+ 4 bx) (cons -3991123 xpt) (r-ct) (r-ty)))
	((5)
	 (bytevector-s64-set! bv bx -3339123 nd)
	 (iter (cons "1q" fl) (+ 8 bx) (cons -3339123 xpt) (r-ct) (r-ty)))
	((6)
	 (bytevector-ieee-single-set! bv bx 1.32e4 nd)
	 (iter (cons "1f" fl) (+ 4 bx) (cons 1.32e4 xpt) (r-ct) (r-ty)))
	((7)
	 (bytevector-ieee-double-set! bv bx 1.32e4 nd)
	 (iter (cons "1d" fl) (+ 8 bx) (cons 1.32e4 xpt) (r-ct) (r-ty)))
	))))

(test5)

;; --- last line ---

[-- Attachment #2.5: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.6: struct.texi --]
[-- Type: application/octet-stream, Size: 2614 bytes --]

@c -*-texinfo-*-

@c Copyright (C) 2016 Matthew R. Wette
@c
@c Permission is granted to copy, distribute and/or modify this document
@c under the terms of the GNU Free Documentation License, Version 1.3 or
@c any later version published by the Free Software Foundation; with no
@c Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.

@node Struct
@section Struct Module

The @code{(potluck struct)} module provides procedures for packing and
unpacking scheme data to and from bytevectors based on a format string.
@c (@ref{Bytevectors})

@example
(use-modules (potluck struct))

;; pack two unsigned shorts and a double float in big endian order
(define data (pack ">2Hd" 3 22 34.0))
(write data) (newline)
==>
#vu8(0 3 0 22 64 65 0 0 0 0 0 0)

;; verify using unpack
(write (unpack ">2Hd" data)) (newline)
==>
(3 22 34.0)
@end example

@deffn {Scheme Procedure} pack format vals @dots{}
Return a bytevector that contains encoded data from @var{vals}, based on
the string @var{format}.
@end deffn

@deffn {Scheme Procedure} unpack format bvec
Return a list of scheme objects decoded from the bytevector
@var{bvec}, based on the string @var{format}.
@end deffn

@deffn {Scheme Procedure} packed-size format
Return the number of bytes represented by the string @var{format}.
@end deffn

The @emph{format} string used for @var{pack} and @var{unpack} is
constructed as a sequence of digits, representing a repeat count, and codes,
representing the binary content.

@noindent
The string may optionally begin with a special character that
represents the endianness:
@verbatim
    =        native endianness
    <        little-endian 
    >        big-endian 
    !        network order -- i.e., big-endian
@end verbatim

@noindent
Type codes used in the format string are interpreted as follows:
@verbatim
    x        blank byte
    c        8-bit character
    ?        boolean
    b        signed 8-bit integer
    B        unsigned 8-bit integer
    h        signed 16-bit integer
    H        unsigned 16-bit integer
    i        signed 32-bit integer
    I        unsigned 32-bit integer
    l        signed 32-bit integer
    L        unsigned 32-bit integer
    q        signed 64-bit integer
    Q        unsigned 64-bit integer
    f        32-bit IEEE floating point
    d        64-bit IEEE floating point
    s        string
@end verbatim

The following issues remain to be addressed:
@table @asis
@item string padding
@code{pack} assumes that the string length in the format is the same
as in the passed string.  Non-conformance is not trapped as an error.
@end table

@c --- last line ---

[-- Attachment #2.7: Type: text/html, Size: 151 bytes --]

[potluck dish] the module (potluck regexc)

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 1695 bytes --]

The (potluck regexc) module provides a macro for throwing a string
at a sequence of regular expressions, executing an associated body
when a match is found.

Attached are three files:
* regexc.scm: the source code
* regexc.texi: documentation
* regexc.test: test code


Regexp Utilities
----------------

 -- Scheme Procedure: regexp-case str case ... [else body]
     Match the string STR against each CASE in turn.  Each CASE is of
     the form
          ((pat VAR1 VAR2 ...)
           body)
     where pat is a regular expression string literal, VAR1 ... are
     bound to the ordered list of matched subexpressions, and BODY is a
     sequence of expressions.  If no match is found and the optional
     ELSE case exists, the associated body is executed, otherwise an
     error is signaled.

   The following example matches a string aginst either a simple
variable name, or a simple variable name with an array reference, and
returns a list with the variable name and the string index, or '"1"'.
If no match is found, '#f' is returned.

     (define str "foo")
     (regexp-case str
      (("^([a-z]+)\\(([0-9]+)\\)$" var idx)
       (list var idx))
      (("^([a-z]+)$" var)
       (list var "1"))
      (else #f))
     ==>
     ("foo" "1")

 -- Scheme Procedure: make-string-matcher (str ...) case ... [else body]
     This is similar to 'regexp-case' but generates a procedure '(lambda
     (str ...) ...)' that matches its string argument STR againt each
     CASE in turn.

     (define my-matcher
       (make-string-matcher (str a b c)
        (("^([a-z]+)\\(([0-9]+)\\)$" var idx)
         (list var idx))
        (("^([a-z]+)$" var)
         (list var "1"))
        (else #f))


[-- Attachment #2.1: Type: text/html, Size: 5264 bytes --]

[-- Attachment #2.2: regexc.scm --]
[-- Type: application/octet-stream, Size: 3466 bytes --]

;;; potluck/regexc.scm
;;;
;;; Copyright (C) 2016 Matthew R. Wette
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.

(define-module (potluck regexc)
  #:export-syntax (regexp-case make-string-matcher)
  #:use-module (ice-9 regex)
  #:re-export (match:count
	       match:string match:prefix match:suffix
	       regexp-match? regexp-quote match:start match:end match:substring
	       string-match regexp-substitute fold-matches list-matches
	       regexp-substitute/global)
  )

;; (rx-let m (v ...) exp ...) => (let ((v (match:substring m 1)) ...) exp ...)
;; This syntax expands application of a regex match to a body of expressions.
;; This is a helper macro for regexp-case.
(define-syntax rx-let
  (lambda (x)
    (syntax-case x ()
      ((_ m (v ...) exp ...)
       (with-syntax (((i ...)
		      (let f ((n 1) (vl #'(v ...))) ; fold (v ...) to (1 ...)
			(if (null? vl) '() (cons n (f (1+ n) (cdr vl)))))))
	 #'(let ((v (match:substring m i)) ...) exp ...))))))

;; (all-const-string? pattern-list) => #t|#f
;; This syntax checks if each member of pattern-list is a string literal.
;; This is a helper for regexp-case.
(define-syntax-rule (all-const-string? pattern-list)
  (let iter ((res #t) (pl pattern-list))
    (if (null? pl) res
	(iter (and res
		   (or (and (not (identifier? (car pl)))
			    (string? (syntax->datum (car pl))))
		       (syntax-violation
			"regexp-case" "expecting string literal" (car pl))))
	      (cdr pl)))))

;; I'm not sure eval-when is doing the optimization I hoped for.

(define-syntax regexp-case
  (lambda (x)
    (syntax-case x (else)
      ((_ str ((pat v ...) exp ...) ... (else else-exp ...))
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 (all-const-string? #'(pat ...))
	 #'(let ((id (eval-when (expand load eval) (make-regexp pat))) ...)
	     (cond
	      ((regexp-exec id str) =>
	       (lambda (m) (rx-let m (v ...) exp ...)))
	      ...
	      (else else-exp ...)))))
      ((_ str ((pat v ...) exp ...) ...)
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 (all-const-string? #'(pat ...))
	 #'(let ((id (eval-when (expand load eval) (make-regexp pat))) ...)
	     (cond
	      ((regexp-exec id str) =>
	       (lambda (m) (rx-let m (v ...) exp ...)))
	      ...
	      (else
	       (scm-error 'misc-error "regexp-case"
			  "no match found: ~S" (list str)
			  #f)))))))))

(define-syntax make-string-matcher
  (lambda (x)
    (syntax-case x (else)
      ((_ (str . args) ((pat v ...) exp ...) ... (else else-exp ...))
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 (all-const-string? #'(pat ...))
	 #'(let ((id (make-regexp pat)) ...)
	     (lambda (str . args)
	       (cond
		((regexp-exec id str) =>
		 (lambda (m) (rx-let m (v ...) exp ...)))
		...
		(else else-exp ...))))))
      ((_ (str . args) ((pat v ...) exp ...) ...)
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 (all-const-string? #'(pat ...))
	 #'(let ((id (make-regexp pat)) ...)
	     (lambda (str . args)
	       (cond
		((regexp-exec id str) =>
		 (lambda (m) (rx-let m (v ...) exp ...)))
		...
		(else
		 (scm-error 'misc-error "regexp-case"
			    "no match found: ~S" (list str)
			    #f))))))))))

;; --- last line ---

[-- Attachment #2.3: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.4: regexc.test --]
[-- Type: application/octet-stream, Size: 1726 bytes --]

;; regexc.test				-*- scheme -*-
;;
;; Copyright (C) 2016 Matthew R. Wette
;; 
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved.  This file is offered as-is,
;; without any warranty.

(use-modules (potluck regexc))
(use-modules (ice-9 pretty-print))
(use-modules (system base compile))

(define* (expand-form e #:key (opts '()))
  (call-with-values
      (lambda ()
	(decompile
	 (compile e #:from 'scheme #:to 'tree-il #:env (current-module))
	 #:from 'tree-il #:to 'scheme #:opts opts))
    (lambda (exp env) exp)))
(define-syntax-rule (expand _expression_) (expand-form '_expression_))


;; just show the expansion
(define (test0)
  (pretty-print
   (expand
    (regexp-case str
		 (("^([a-z]+)\\(([0-9]+)\\)$" v i)
		  (list v i))
		 (("^([a-z]+)$" v)
		  (list v "1")))
    )))


(define (test1)
  (define (f1 str)
    (regexp-case str
      (("^([a-z]+)\\(([0-9]+)\\)$" v i)
       (list v i))
      (("^([a-z]+)$" v)
       (list v "1"))
      (else
       #f)
      ))
  
  (if (not (equal? (f1 "foo") (list "foo" "1")))
      (error "not working")))


;; The following should generate a syntax error, but how to I trap that?
;;(define (test2) (regexp-case str (("abc") #t) ((pat) #f) (("ghi") #t)))

  
(define (test3)
  (define f3
    (make-string-matcher (str a b)
      (("^([a-z]+)\\(([0-9]+)\\)$" v i)
       (list v i b a))
      (("^([a-z]+)$" v)
       (list v "1" b a))
      (else
       #f)
      ))

  (if (not (equal? (f3 "foo" 'hello 'world)
		   (list "foo" "1" 'world 'hello)))
      (error "not working")))


;;(test0)
(test1)
;;(test2)
(test3)

;; --- last line ---

[-- Attachment #2.5: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.6: regexc.texi --]
[-- Type: application/octet-stream, Size: 1889 bytes --]

@c -*-texinfo-*-

@c Copyright (C) 2016 Matthew R. Wette
@c
@c Permission is granted to copy, distribute and/or modify this document
@c under the terms of the GNU Free Documentation License, Version 1.3 or
@c any later version published by the Free Software Foundation; with no
@c Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.

@node Regexp Utilities
@subsection Regexp Utilities

@deffn {Scheme Procedure} regexp-case str case @dots{} [else body]
Match the string @var{str} against each @var{case} in turn.  Each
@var{case} is of the form
@example
((@i{pat} @var{var1} @var{var2} @dots{})
 @i{body})
@end example
@noindent
where @i{pat} is a regular expression string literal, @var{var1}
@dots{} are bound to the ordered list of matched subexpressions, and
@var{body} is a sequence of expressions.  If no match is found and the
optional @var{else} case exists, the associated body is executed,
otherwise an error is signaled. 
@end deffn

The following example matches a string aginst either a simple variable
name, or a simple variable name with an array reference, and returns a
list with the variable name and the string index, or @code{"1"}.  If
no match is found, @code{#f} is returned.

@example
(define str "foo")
(regexp-case str
 (("^([a-z]+)\\(([0-9]+)\\)$" var idx)
  (list var idx))
 (("^([a-z]+)$" var)
  (list var "1"))
 (else #f))
==>
("foo" "1")
@end example

@deffn {Scheme Procedure} make-string-matcher (str @dots{}) case @dots{} [else body]
This is similar to @code{regexp-case} but generates a procedure
@code{(lambda (str @dots{}) @dots{})} that  matches its string argument
@var{str} againt each @var{case} in turn.
@end deffn

@example
(define my-matcher
  (make-string-matcher (str a b c)
   (("^([a-z]+)\\(([0-9]+)\\)$" var idx)
    (list var idx))
   (("^([a-z]+)$" var)
    (list var "1"))
   (else #f))
@end example

@c --- last line ---

[-- Attachment #2.7: Type: text/html, Size: 151 bytes --]

[potluck dish] the (potluck struct) module

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 2102 bytes --]

If you have used the Python struct module then this will look
familiar.  Otherwise, check out
https://docs.python.org/2/library/struct.html

Attached are three files: * struct.scm: the source code * struct.texi:
documentation * struct.test: test code


Struct Module =============

The '(potluck struct)' module provides procedures for packing and
unpacking scheme data to and from bytevectors based on a format
string.

     (use-modules (potluck struct))

     ;; pack two unsigned shorts and a double float in big endian
     order (define data (pack ">2Hd" 3 22 34.0)) (write data)
     (newline) ==> #vu8(0 3 0 22 64 65 0 0 0 0 0 0)

     ;; verify using unpack (write (unpack ">2Hd" data)) (newline) ==>
     (3 22 34.0)

 -- Scheme Procedure: pack format vals ...  Return a bytevector that
     contains encoded data from VALS, based on the string FORMAT.

 -- Scheme Procedure: unpack format bvec Return a list of scheme
     objects decoded from the bytevector BVEC, based on the string
     FORMAT.

 -- Scheme Procedure: packed-size format Return the number of bytes
     represented by the string FORMAT.

   The _format_ string used for PACK and UNPACK is constructed as a
sequence of digits, representing a repeat count, and codes,
representing the binary content.

The string may optionally begin with a special character that
represents the endianness: = native endianness < little-endian >
big-endian !  network order -- i.e., big-endian

Type codes used in the format string are interpreted as follows: x
    blank byte c 8-bit character ?  boolean b signed 8-bit integer B
    unsigned 8-bit integer h signed 16-bit integer H unsigned 16-bit
    integer i signed 32-bit integer I unsigned 32-bit integer l signed
    32-bit integer L unsigned 32-bit integer q signed 64-bit integer Q
    unsigned 64-bit integer f 32-bit IEEE floating point d 64-bit IEEE
    floating point s string

   The following issues remain to be addressed: string padding 'pack'
assumes that the string length in the format is the same as in the
passed string.  Non-conformance is not trapped as an error.



[-- Attachment #2.1: Type: text/html, Size: 5664 bytes --]

[-- Attachment #2.2: struct.scm --]
[-- Type: application/octet-stream, Size: 7550 bytes --]

;;; potluck/struct.scm - byte pack/unpack, like the Python struct module
;;;
;;; Copyright (C) 2016 Matthew R. Wette
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.

(define-module (potluck struct)
  #:export (unpack pack packed-size)
  #:use-module (rnrs bytevectors))


;; @deffn ctoi-at str ix => integer
;; Return integer value of the character in string @var{str} at index @var{ix}.
(define (ctoi-at str ix) (- (char->integer (string-ref str ix)) 48))

;; character codes used to indicate endianness:
(define cs:md (string->char-set "=<>!"))

;; @deffn get-nd code => endianness
;; Return endianness given the character code @var{code}.
(define (get-nd code)
  (case code
    ((#\!) (endianness big))		; network
    ((#\>) (endianness big))
    ((#\<) (endianness little))
    ((#\=) (native-endianness))
    ((#\@) (error "alignment not supported"))
    (else  (native-endianness))))

;; character codes used to indicate type:
(define cs:df (string->char-set "xcbB?hHiIlLqQfdsp")) ; type char

;; @deffn bv-size ct ch => byte count
;; Return the size in bytes for data indicated by format count and type.
;; @example
;; (get-size 12 #\s) => 12
;; (get-size 12 #\i) => 4
(define (bv-size ct ch)
  (case ch
    ((#\x) 1) ((#\c) 1) ((#\b) 1) ((#\B) 1) ((#\?) 1)
    ((#\h) 2) ((#\H) 2) ((#\i) 4) ((#\I) 4) ((#\l) 4) ((#\L) 4)
    ((#\q) 8) ((#\Q) 8) ((#\f) 4) ((#\d) 8) ((#\s #\p) ct)
    (else (error "unknown code"))))

;; @deffn fmt-cnt ct ch => datum count
;; Return the number of datums indicated by the format count and type.
(define (fmt-cnt ct ch)
  (case ch
    ((#\s #\p) ct)
    (else 1)))
  

;; set value, return number bytes written
;; This is a helper for @code{pack}.
(define (set-value! bv ix nd ct ch val)
  (case ch
    ((#\x) (if #f #f))
    ((#\c) ;; todo: check for 8-bit char
     (bytevector-u8-set! bv ix (char->integer val) nd))
    ((#\b) (bytevector-s8-set! bv ix val))
    ((#\B) (bytevector-u8-set! bv ix val))
    ((#\?) (bytevector-u8-set! bv ix (if val 1 0) nd))
    ((#\h) (bytevector-s16-set! bv ix val nd))
    ((#\H) (bytevector-u16-set! bv ix val nd))
    ((#\i #\l) (bytevector-s32-set! bv ix val nd))
    ((#\I #\L) (bytevector-u32-set! bv ix val nd))
    ((#\q) (bytevector-s64-set! bv ix val nd))
    ((#\Q) (bytevector-u64-set! bv ix val nd))
    ((#\f) (bytevector-ieee-single-set! bv ix val nd))
    ((#\d) (bytevector-ieee-double-set! bv ix val nd))
    ((#\s #\p)
     (bytevector-copy!
      (u8-list->bytevector (map char->integer (string->list val))) 0 bv ix sz))
    (else
     (scm-error 'misc-error "unpack"
		"bad type code: ~A" '(ch) #f))))

;; @deffn pack format datum ... => bytevector
;; Pack the datums into a bytevector.
(define (pack format . args)
  (cond
   ((zero? (string-length format)) (make-bytevector 0))
   (else
    (let* ((char-at (lambda (ix) (string-ref format ix)))
	   (f0 (if (char-set-contains? cs:md (char-at 0)) 1 0))
	   (nd (get-nd (char-at 0)))
	   (ln (string-length format))
	   (bvec (make-bytevector (packed-size format))))
      
      (let iter ((bx 0)		     ; index into resulting bytevector
		 (fx f0)	     ; index into format
		 (vals args)	     ; values to add
		 (ct 0)		     ; count from format
		 (ch #f))	     ; char from format
	;;(simple-format #t "bx=~S fx=~S ct=~S ch=~S\n" bx fx ct ch)
	(cond
	 ((positive? ct)		; encode a value
	  (set-value! bvec bx nd ct ch (car vals))
	  (iter (+ bx (bv-size ct ch)) fx (cdr vals) (- ct (fmt-cnt ct ch)) ch))
	 ((= fx ln)			; done
	  bvec)
	 ((null? vals)
	  (scm-error 'misc-error "pack"
		     "format size larger than input size" '() #f))
	 ((char-numeric? (string-ref format fx))
	  (iter bx (1+ fx) vals (- (* 10 ct) (ctoi-at format fx)) ch))
	 ((zero? ct)
	  (iter bx fx vals -1 ch))
	 ((char-set-contains? cs:df (string-ref format fx))
	  (iter bx (1+ fx) vals (- ct) (string-ref format fx)))
	 (else
	  (scm-error 'misc-error "pack"
		     "pack error" '() #f))))))))


;; @deffn cons-value bv ix nd cd tail => list
;; Cons the datum indicated by the data with @var{tail}, where
;; @itemize
;; @item @var{bv} is the bytevector
;; @item @var{ix} is the index into the bytevector
;; @item @var{nd} is the endianness
;; @item @var{cd} is the code
;; @end itemize
;; This is a helper for @code{unpack}.
(define cons-value
  (let ((sbuf (make-bytevector 128)))
    (lambda (bv ix nd sz ch tail)
      (case ch
	((#\x) tail)
	((#\c) (cons (integer->char (bytevector-u8-ref bv ix)) tail))
	((#\b) (cons (bytevector-s8-ref bv ix) tail))
	((#\B) (cons (bytevector-u8-ref bv ix) tail))
	((#\?) (cons (if (zero? (bytevector-u8-ref bv ix)) #f #t) tail))
	((#\h) (cons (bytevector-s16-ref bv ix nd) tail))
	((#\H) (cons (bytevector-u16-ref bv ix nd) tail))
	((#\i) (cons (bytevector-s32-ref bv ix nd) tail))
	((#\I) (cons (bytevector-u32-ref bv ix nd) tail))
	((#\l) (cons (bytevector-s32-ref bv ix nd) tail))
	((#\L) (cons (bytevector-u32-ref bv ix nd) tail))
	((#\q) (cons (bytevector-s64-ref bv ix nd) tail))
	((#\Q) (cons (bytevector-u64-ref bv ix nd) tail))
	((#\f) (cons (bytevector-ieee-single-ref bv ix nd) tail))
	((#\d) (cons (bytevector-ieee-double-ref bv ix nd) tail))
	((#\s #\p)
	 (set! sbuf (make-bytevector sz))
	 (bytevector-copy! bv ix sbuf 0 sz)
	 (cons (utf8->string sbuf) tail))
	(else
	 (scm-error 'misc-error "unpack"
		    "bad type code: ~A" '(ch) #f))))))

;; @deffn unpack format bytevec => list
;; Unpack datums from the bytevector into a list.
(define (unpack format bytevec)
  (cond
   ((zero? (string-length format)) '())
   (else
    (let* ((char-at (lambda (ix) (string-ref format ix)))
	   (f0 (if (char-set-contains? cs:md (char-at 0)) 1 0))
	   (nd (get-nd (char-at 0)))
	   (ln (string-length format)))
      (let iter ((rz '())			; result, list of bytevectors
		 (bx 0)			; index into input bytevector
		 (fx f0)			; index into format string
		 (ct 0)			; format count
		 (ch #f))			; format char
	;;(simple-format #t "bx=~S fx=~S ct=~S ch=~S\n" bx fx ct ch)
	(cond
	 ((> fx ln)
	  (error "format size larger than input bv size"))
	 ((positive? ct)
	  (iter (cons-value bytevec bx nd ct ch rz)
		(+ bx (bv-size ct ch)) fx (- ct (fmt-cnt ct ch)) ch))
	 ((= fx ln)
	  ;;(if (not (= bx (bytevector-length bytevec))) (error "error"))
	  (reverse rz))
	 ((char-numeric? (string-ref format fx))
	  (iter rz bx (1+ fx) (- (* 10 ct) (ctoi-at format fx)) ch))
	 ((zero? ct)
	  (iter rz bx fx -1 ch))
	 ((char-set-contains? cs:df (string-ref format fx))
	  (iter rz bx (1+ fx) (- ct) (string-ref format fx)))
	 (else
	  (scm-error 'misc-error "unpack" "format error" '() #f))))))))


;; @deffn packed-size format => size
;; In the Python struct module this is called "calcsize".
(define (packed-size format)
  (cond
   ((zero? (string-length format)) 0)
   (else
    (let* ((char-at (lambda (ix) (string-ref format ix)))
	   (f0 (if (char-set-contains? cs:md (char-at 0)) 1 0))
	   (ln (string-length format)))
      (let iter ((sz 0) (fx f0) (ct 0))	; sz: result, fx: inddx; ct: count
	(cond
	 ((= fx ln)
	  sz)
	 ((char-numeric? (string-ref format fx))
	  (iter sz (1+ fx) (+ (* 10 ct) (ctoi-at format fx))))
	 ((zero? ct)
	  (iter sz fx 1))
	 ((char-set-contains? cs:df (string-ref format fx))
	  (iter (+ sz (* ct (bv-size 1 (string-ref format fx)))) (1+ fx) 0))
	 (else
	  (scm-error 'misc-error "unpack" "format error" '() #f))))))))
  
;;; --- last line ---

[-- Attachment #2.3: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.4: struct.test --]
[-- Type: application/octet-stream, Size: 3448 bytes --]

;; struct.test				-*- scheme -*-
;;
;; Copyright (C) 2015 Matthew R. Wette
;; 
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved.  This file is offered as-is,
;; without any warranty.

(use-modules (potluck struct))		; pack, unpack, packed-size
(use-modules (rnrs bytevectors))
(use-modules (srfi srfi-2))		; and-let*

(set! *random-state* (random-state-from-platform))

(define (test1)
  (if (not (and-let*
	       (((= (packed-size "33s") 33))
		((= (packed-size "4I") 16))
		((= (packed-size "3B") 3))
		((= (packed-size "i") 4))
		)))
      (error "packed-size broken")))

(define (test2)
  (let* ((bv04 (make-bytevector 4)))
    ;; i
    (bytevector-s32-set! bv04 0 -1234 (native-endianness))
    (or (= (car (unpack "i" bv04)) -1234) (error "error"))
    ;; I
    (bytevector-s32-set! bv04 0 1234 (native-endianness))
    (or (= (car (unpack "I" bv04)) 1234) (error "error"))
    ))

(define (test3)
  (let* ((data (pack "I" 1234))
	 (vals (unpack "I" data)))
    (if (eqv? (car vals) 1234) #t (error "failed"))
    #t))

(define (test4)
  (define data (pack ">2Hd" 3 22 34.0)) ; pack two unsigned and a double
  (write data)(newline)
  (write (unpack ">2Hd" data))(newline))


(define (test5)

  ;; make a truncated copy of a bytevector
  (define (mk-bvec bv0 len)
    (let ((bv1 (make-bytevector len)))
      (bytevector-copy! bv0 0 bv1 0 len)
      bv1))

  ;; check pack/unpack consistency given
  ;;   format string, binary data, and list of datums
  (define (do-test format data vals)
    (when #f
      (simple-format #t "fm=~S\n" format)
      (simple-format #t "xv=~S\n" vals)
      (simple-format #t "us=~S\n" (unpack format data)))
    ;; Test pack:
    (if (not (equal? data (apply pack format vals)))
	(error "pack not working"))
    ;; Test unpack:
    (let iter ((xvals vals) (svals (unpack format data)))
      (cond
       ((and (null? xvals) (pair? svals))
	(error "mismatched count"))
       ((and (pair? xvals) (null? svals))
	(error "mismatched count"))
       ((null? xvals)
	#t)
       ((not (eqv? (car xvals) (car svals)))
	(error "value mismatch"))
       (else
	(iter (cdr xvals) (cdr svals)))))
    #f)

  (define (r-ct) (random 5))
  (define (r-ty) (random 8))
  
  (let ((bv (make-bytevector 1024))
	(nd (native-endianness))
	)
    (let iter ((fl '()) (bx 0) (xpt '()) (rc (r-ct)) (rt (r-ty)))
      ;;(simple-format #t "fl=~S bx=~S xpt=~S\n" fl bx xpt)
      (case rt
	((0)
	 (do-test (string-join (reverse fl) "") (mk-bvec bv bx) (reverse xpt)))
	((1)
	 (bytevector-s8-set! bv bx -123)
	 (iter (cons "1b" fl) (+ 1 bx) (cons -123 xpt) (r-ct) (r-ty)))
	((2)
	 (bytevector-s16-set! bv bx -1234 nd)
	 (iter (cons "1h" fl) (+ 2 bx) (cons -1234 xpt) (r-ct) (r-ty)))
	((3)
	 (bytevector-s32-set! bv bx -9123 nd)
	 (iter (cons "1i" fl) (+ 4 bx) (cons -9123 xpt) (r-ct) (r-ty)))
	((4)
	 (bytevector-s32-set! bv bx -3991123 nd)
	 (iter (cons "1l" fl) (+ 4 bx) (cons -3991123 xpt) (r-ct) (r-ty)))
	((5)
	 (bytevector-s64-set! bv bx -3339123 nd)
	 (iter (cons "1q" fl) (+ 8 bx) (cons -3339123 xpt) (r-ct) (r-ty)))
	((6)
	 (bytevector-ieee-single-set! bv bx 1.32e4 nd)
	 (iter (cons "1f" fl) (+ 4 bx) (cons 1.32e4 xpt) (r-ct) (r-ty)))
	((7)
	 (bytevector-ieee-double-set! bv bx 1.32e4 nd)
	 (iter (cons "1d" fl) (+ 8 bx) (cons 1.32e4 xpt) (r-ct) (r-ty)))
	))))

(test5)

;; --- last line ---

[-- Attachment #2.5: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.6: struct.texi --]
[-- Type: application/octet-stream, Size: 2614 bytes --]

@c -*-texinfo-*-

@c Copyright (C) 2016 Matthew R. Wette
@c
@c Permission is granted to copy, distribute and/or modify this document
@c under the terms of the GNU Free Documentation License, Version 1.3 or
@c any later version published by the Free Software Foundation; with no
@c Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.

@node Struct
@section Struct Module

The @code{(potluck struct)} module provides procedures for packing and
unpacking scheme data to and from bytevectors based on a format string.
@c (@ref{Bytevectors})

@example
(use-modules (potluck struct))

;; pack two unsigned shorts and a double float in big endian order
(define data (pack ">2Hd" 3 22 34.0))
(write data) (newline)
==>
#vu8(0 3 0 22 64 65 0 0 0 0 0 0)

;; verify using unpack
(write (unpack ">2Hd" data)) (newline)
==>
(3 22 34.0)
@end example

@deffn {Scheme Procedure} pack format vals @dots{}
Return a bytevector that contains encoded data from @var{vals}, based on
the string @var{format}.
@end deffn

@deffn {Scheme Procedure} unpack format bvec
Return a list of scheme objects decoded from the bytevector
@var{bvec}, based on the string @var{format}.
@end deffn

@deffn {Scheme Procedure} packed-size format
Return the number of bytes represented by the string @var{format}.
@end deffn

The @emph{format} string used for @var{pack} and @var{unpack} is
constructed as a sequence of digits, representing a repeat count, and codes,
representing the binary content.

@noindent
The string may optionally begin with a special character that
represents the endianness:
@verbatim
    =        native endianness
    <        little-endian 
    >        big-endian 
    !        network order -- i.e., big-endian
@end verbatim

@noindent
Type codes used in the format string are interpreted as follows:
@verbatim
    x        blank byte
    c        8-bit character
    ?        boolean
    b        signed 8-bit integer
    B        unsigned 8-bit integer
    h        signed 16-bit integer
    H        unsigned 16-bit integer
    i        signed 32-bit integer
    I        unsigned 32-bit integer
    l        signed 32-bit integer
    L        unsigned 32-bit integer
    q        signed 64-bit integer
    Q        unsigned 64-bit integer
    f        32-bit IEEE floating point
    d        64-bit IEEE floating point
    s        string
@end verbatim

The following issues remain to be addressed:
@table @asis
@item string padding
@code{pack} assumes that the string length in the format is the same
as in the passed string.  Non-conformance is not trapped as an error.
@end table

@c --- last line ---

[-- Attachment #2.7: Type: text/html, Size: 151 bytes --]

Re: [potluck dish] the (potluck struct) module

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 2364 bytes --]

First message got garbled.  Redo:

If you have used the Python struct module then this will look familiar.
Otherwise, check out https://docs.python.org/2/library/struct.html

Attached are three files:
* struct.scm: the source code 
* struct.texi: documentation 
* struct.test: test code

Struct Module
=============

The '(potluck struct)' module provides procedures for packing and
unpacking scheme data to and from bytevectors based on a format string.

     (use-modules (potluck struct))

     ;; pack two unsigned shorts and a double float in big endian order
     (define data (pack ">2Hd" 3 22 34.0))
     (write data) (newline)
     ==>
     #vu8(0 3 0 22 64 65 0 0 0 0 0 0)

     ;; verify using unpack
     (write (unpack ">2Hd" data)) (newline)
     ==>
     (3 22 34.0)

 -- Scheme Procedure: pack format vals ...
     Return a bytevector that contains encoded data from VALS, based on
     the string FORMAT.

 -- Scheme Procedure: unpack format bvec
     Return a list of scheme objects decoded from the bytevector BVEC,
     based on the string FORMAT.

 -- Scheme Procedure: packed-size format
     Return the number of bytes represented by the string FORMAT.

   The _format_ string used for PACK and UNPACK is constructed as a
sequence of digits, representing a repeat count, and codes, representing
the binary content.

The string may optionally begin with a special character that represents
the endianness:
    =        native endianness
    <        little-endian
    >        big-endian
    !        network order -- i.e., big-endian

Type codes used in the format string are interpreted as follows:
    x        blank byte
    c        8-bit character
    ?        boolean
    b        signed 8-bit integer
    B        unsigned 8-bit integer
    h        signed 16-bit integer
    H        unsigned 16-bit integer
    i        signed 32-bit integer
    I        unsigned 32-bit integer
    l        signed 32-bit integer
    L        unsigned 32-bit integer
    q        signed 64-bit integer
    Q        unsigned 64-bit integer
    f        32-bit IEEE floating point
    d        64-bit IEEE floating point
    s        string

   The following issues remain to be addressed:
string padding
     'pack' assumes that the string length in the format is the same as
     in the passed string.  Non-conformance is not trapped as an error.


[-- Attachment #2: Type: text/html, Size: 7754 bytes --]

Re: [potluck dish] the (potluck struct) module

[Nala Ginrut]

Hi Matt!
I'm finding `python pack' stuff, and I found your potluck is very cool!
Could you put it in a git repo somewhere? It would be worth to maintain
or receive patches. And maybe a better module name rather than (potluck
struc)
Thanks!

On Tue, 2016-02-16 at 05:53 -0800, Matt Wette wrote:
> First message got garbled.  Redo:
> 
> If you have used the Python struct module then this will look
> familiar.
> Otherwise, check out https://docs.python.org/2/library/struct.html
> 
> Attached are three files:
> * struct.scm: the source code 
> * struct.texi: documentation 
> * struct.test: test code
> 
> Struct Module
> =============
> 
> The '(potluck struct)' module provides procedures for packing and
> unpacking scheme data to and from bytevectors based on a format
> string.
> 
>      (use-modules (potluck struct))
> 
>      ;; pack two unsigned shorts and a double float in big endian
> order
>      (define data (pack ">2Hd" 3 22 34.0))
>      (write data) (newline)
>      ==>
>      #vu8(0 3 0 22 64 65 0 0 0 0 0 0)
> 
>      ;; verify using unpack
>      (write (unpack ">2Hd" data)) (newline)
>      ==>
>      (3 22 34.0)
> 
>  -- Scheme Procedure: pack format vals ...
>      Return a bytevector that contains encoded data from VALS, based
> on
>      the string FORMAT.
> 
>  -- Scheme Procedure: unpack format bvec
>      Return a list of scheme objects decoded from the bytevector
> BVEC,
>      based on the string FORMAT.
> 
>  -- Scheme Procedure: packed-size format
>      Return the number of bytes represented by the string FORMAT.
> 
>    The _format_ string used for PACK and UNPACK is constructed as a
> sequence of digits, representing a repeat count, and codes,
> representing
> the binary content.
> 
> The string may optionally begin with a special character that
> represents
> the endianness:
>     =        native endianness
>     <        little-endian
>     >        big-endian
>     !        network order -- i.e., big-endian
> 
> Type codes used in the format string are interpreted as follows:
>     x        blank byte
>     c        8-bit character
>     ?        boolean
>     b        signed 8-bit integer
>     B        unsigned 8-bit integer
>     h        signed 16-bit integer
>     H        unsigned 16-bit integer
>     i        signed 32-bit integer
>     I        unsigned 32-bit integer
>     l        signed 32-bit integer
>     L        unsigned 32-bit integer
>     q        signed 64-bit integer
>     Q        unsigned 64-bit integer
>     f        32-bit IEEE floating point
>     d        64-bit IEEE floating point
>     s        string
> 
>    The following issues remain to be addressed:
> string padding
>      'pack' assumes that the string length in the format is the same
> as
>      in the passed string.  Non-conformance is not trapped as an
> error.
> 

Re: [potluck dish] the (potluck struct) module

[Matt Wette]

[-- Attachment #1: Type: text/plain, Size: 437 bytes --]


> On May 8, 2016, at 2:59 AM, Nala Ginrut <nalaginrut@gmail.com> wrote:
> 
> Hi Matt!
> I'm finding `python pack' stuff, and I found your potluck is very cool!
> Could you put it in a git repo somewhere? It would be worth to maintain
> or receive patches. And maybe a better module name rather than (potluck
> struc)
> Thanks!

Once I come up with a name, I will put it under github.com/mwette <http://github.com/mwette>



[-- Attachment #2: Type: text/html, Size: 1011 bytes --]