utils.sls

(library (tagbody utils)
(export plist->alist
        shift-left
        unzip
        syntax->list
        )
(import (rnrs))

(define (syntax->list stxobj)
  (define (inner stx)
    (syntax-case stx ()
      [() '()]
      [(x . rest)
       (cons #'x (inner #'rest))]))
  (assert (list? (syntax->datum stxobj)))
  (inner stxobj))

(define (plist->alist car? plist)
  ;; assumes head of (car? plist) is true
  (define (rcons a b)
    (cons (reverse a) b))
  (if (null? plist)
      '()
      (let loop ((plist (cdr plist))
                 (current-field (list (car plist)))
                 (return-list '()))
        (cond ((null? plist)
               (reverse
                (if (null? current-field)
                    return-list
                    (rcons current-field return-list))))
              ((car? (car plist))
               (loop (cdr plist)
                     (list (car plist))
                     (rcons current-field return-list)))
              (else
               (loop (cdr plist)
                     (cons (car plist) current-field)
                     return-list))))))

(define (unzip list-of-pairs)
  (let loop ((pairs list-of-pairs) (cars '()) (cdrs '()))
    (if (null? pairs)
        (values (reverse cars) (reverse cdrs))
        (loop (cdr pairs) (cons (caar pairs) cars)
              (cons (cdar pairs) cdrs)))))

(define (shift-left old-list end)
  (append (cdr old-list) (list end)))

)