collector.ss
#lang scheme

(require (planet cce/scheme:4:1/planet))
(require (for-syntax scheme)
         (this-package-in datatype)
         (this-package-in private/gc-core))

(provide (except-out (all-from-out scheme) #%module-begin)
         (this-package-out private/gc-core)
         (this-package-out datatype)
         (rename-out 
          [collector-module-begin #%module-begin]))


;;; Since we explicitly identify the procedures to be exported here, an error is raised in the
;;; collector if a procedure is not defined.
(define-syntax (collector-module-begin stx)
  (syntax-case stx ()
    [(_ body ...) 
     (with-syntax ([(init-allocator gc:deref gc:alloc-flat gc:cons gc:first gc:rest gc:flat?
                                    gc:cons? gc:set-first! gc:set-rest!)
                    (map (λ (s) (datum->syntax stx s))
                         '(init-allocator gc:deref gc:alloc-flat gc:cons gc:first gc:rest gc:flat? 
                                          gc:cons? gc:set-first! gc:set-rest!))])
       #`(#%module-begin 
          
          (require (for-syntax scheme))
          
          (provide/contract (init-allocator (-> any)))
          
          (provide/contract (gc:deref (location? . -> . heap-value?)))
          
          (provide/contract (gc:alloc-flat (heap-value? . -> . location?)))
          (provide/contract (gc:cons (location? location? . -> . location?)))
          
          (provide/contract (gc:first (location? . -> . location?)))
          (provide/contract (gc:rest (location? . -> . location?)))
          
          (provide/contract (gc:flat? (location? . -> . boolean?)))
          (provide/contract (gc:cons? (location? . -> . boolean?)))
          
          (provide/contract (gc:set-first! (location? location? . -> . void?)))
          (provide/contract (gc:set-rest! (location? location? . -> . void?)))
          
          body ...
          
          ))]))