#lang scheme
;; Sequential Lists (cons-as-struct)
(require (planet cce/scheme:4:1/planet)
         (planet schematics/schemeunit)
         (this-package-in private/fold))

(provide (struct-out s:kons)
         s:empty s:cons
         s:empty? s:cons?
         s:first s:rest
         s:foldl s:foldr
         s:map)

(define-struct s:mt () 
  #:property prop:equal+hash
  (list 
   (lambda (mt1 mt2 _) (eq? mt1 mt2))
   (lambda (mt _) 1984)
   (lambda (mt _) 4891))
  
  #:property prop:sequence
  (lambda (mt)
    (make-do-sequence
     (lambda ()
       (values void
               void
               'ignore
               (lambda _ false)
               void
               void)))))

(define-struct s:kons (first rest)
  #:property prop:equal+hash
  (list 
   (lambda (sc1 sc2 equal?)
     (and (equal? (s:first sc1) (s:first sc2))
          (equal? (s:rest sc1) (s:rest sc2))))
   
   ;; I'm just guessing here...
   (lambda (sc equal-hash-code)
     (+ (bitwise-bit-field (equal-hash-code (s:first sc)) 0 14)
        (arithmetic-shift 
         (bitwise-bit-field (equal-hash-code (s:rest sc)) 0 14) 14)))
   
   (lambda (sc equal-hash-code)
     (+ (bitwise-bit-field (equal-hash-code (s:first sc)) 14 28)
        (arithmetic-shift 
         (bitwise-bit-field (equal-hash-code (s:rest sc)) 14 28) 14))))
  
  
  #:property prop:sequence 
  (lambda (sc)
    (make-do-sequence
     (lambda ()
       (values s:first
               s:rest
               sc
               s:cons?
               void
               void)))))

(define the-s:mt (make-s:mt))
(define s:first s:kons-first)
(define s:rest  s:kons-rest)
(define s:cons? s:kons?)
(define s:empty? (lambda (x) (eq? x the-s:mt)))

(define-match-expander s:empty
  (syntax-rules ()
    [(s:empty) (struct s:mt ())])
  the-s:mt)

(define-match-expander s:cons 
  (syntax-rules ()
    [(s:cons x y) (struct s:kons (x y))])
  make-s:kons)

;; [X Y -> Y] Y [SListof X] -> Y
(define s:foldl (make-foldl s:empty? s:first s:rest))
(define s:foldr (make-foldr s:empty? s:first s:rest))

;; [X -> Y] [SListof X] -> [SListof Y]
(define (s:map f ls)
  (s:foldr (lambda (x r) (s:cons (f x) r)) s:empty ls))