;;;; Copyright 2002, Jonathan Bachrach.  See file TERMS.

(use goo/boot)
(use goo/fun)
(use goo/class)
(use goo/macros)
(use goo/types)
(use goo/math)
(use goo/cols/col)
(use goo/cols/seq)

(exported
  (dc <packer> (<any>))
  (dg packer (init add|<fun> res|<fun> => <packer>))
  (dg packer-fab (t|<type> => <packer>))
  (dg packer-add (a|<packer> x => <packer>))
  (dg packer-res (a|<packer> => <any>))
  packing-with packing-in packing packing-as pack-in pack packed)

(dc <sim-packer> (<packer>))
(dp! packer-value (<sim-packer> => <any>))
(dp packer-adder (<sim-packer> => <fun>))
(dp packer-reser (<sim-packer> => <fun>) (fun (x) x))

(dm packer (init add|<fun> res|<fun> => <sim-packer>)
  (new <sim-packer> packer-value init packer-adder add packer-reser res))

(dm packer-add (a|<sim-packer> x => <sim-packer>)
  (renew a packer-value ((packer-adder a) x (packer-value a))))
(dm packer-res (a|<sim-packer> => <any>)
  ((packer-reser a) (packer-value a)))

(dm packer-fab (t|(t< <seq>) => <packer>)
  (packer '() pair (fun (x) (as t (rev! x)))))

(dm packer-fab (t|(t< <int>) => <packer>)
  (packer 0 + (fun (x) x)))

(ds packing-with ((,@decls) ,@body)
  (match decls
    (() 
     `(seq ,@body))
    (((,var ,pack) ,@rest)
     `(let ((,var ,pack)) (packing-with (,@rest) ,@body)))))
 
(ds packing-in ((,@vars) ,@body)
  (match vars
    (() 
     `(seq ,@body))
    (((,name ,type) ,@rest)
     `(packing-with ((,name (packer-fab ,type)))
        (packing-in (,@rest) ,@body)))
    ((,name ,@rest)
     `(packing-in ((,name <lst>) ,@rest) ,@body))))
 
(ds packing (,@body)
  `(packing-in ((packer- <lst>)) (seq ,@body (packed packer-))))
 
(ds packing-as (,type ,@body)
  `(packing-in ((packer- ,type)) (seq ,@body (packed packer-))))
 
(ds pack-in (,pack ,value)
  `(opf ,pack (packer-add _ ,value)))
  
(ds pack (,value)
  `(pack-in packer- ,value))
  
(ds packed (,name)
  `(packer-res ,name))

