#lang plai/gc2/collector

(print-only-errors)

;; invariant: address 0 holds the allocation pointer
(define (init-allocator)
  (heap-set! 0 1))

;; malloc : size -> address
(define (malloc n)
  (define addr (heap-ref 0))
  (when (> (+ addr n) (heap-size))
    (error 'malloc "out of memory!"))
  (heap-set! 0 (+ addr n))
  addr)


;; gc:alloc-flat : flat-value -> address
(define (gc:alloc-flat value)
  (define addr (malloc 2))
  (heap-set! addr 'flat)
  (heap-set! (+ addr 1) value)
  addr)
;; gc:flat? : address -> boolean
(define (gc:flat? address)
  (equal? (heap-ref address) 'flat))
;; gc:deref : address -> flat-value
(define (gc:deref address)
  (unless (gc:flat? address)
    (error 'gc:deref "not a flat: ~a" address))
  (heap-ref (+ address 1)))


;; gc:cons : root root -> address
(define (gc:cons root1 root2)
  (define addr (malloc 3))
  (heap-set! addr 'cons)
  (heap-set! (+ addr 1) (read-root root1))
  (heap-set! (+ addr 2) (read-root root2))
  addr)
;; gc:cons? : address -> boolean
(define (gc:cons? address)
  (equal? (heap-ref address) 'cons))
;; gc:first : address -> address
(define (gc:first address)
  (unless (gc:cons? address)
    (error 'gc:first "not a pair: ~a" address))
  (heap-ref (+ address 1)))
;; gc:rest : address -> address
(define (gc:rest address)
  (unless (gc:cons? address)
    (error 'gc:rest "not a pair: ~a" address))
  (heap-ref (+ address 2)))
;; gc:set-first! : address address -> void
(define (gc:set-first! address new-value-address)
  (unless (gc:cons? address)
    (error 'gc:set-first! "not a pair: ~a" address))
  (heap-set! (+ address 1) new-value-address))
;; gc:set-rest! : address address -> void
(define (gc:set-rest! address new-value-address)
  (unless (gc:cons? address)
    (error 'gc:set-rest! "not a pair: ~a" address))
  (heap-set! (+ address 2) new-value-address))


;; gc:closure : opaque-value (listof root) -> address
(define (gc:closure code-ptr free-vars)
  (define addr (malloc (+ 2 (length free-vars))))
  (heap-set! addr 'clos)
  (heap-set! (+ addr 1) code-ptr)
  (for ([i  (in-range (length free-vars))]
        [fv (in-list free-vars)])
    (heap-set! (+ addr 2 i) (read-root fv)))
  addr)
;; gc:closure? : address -> boolean
(define (gc:closure? address)
  (equal? (heap-ref address) 'clos))
;; gc:closure-code-ptr : address -> opaque-value
(define (gc:closure-code-ptr address)
  (unless (gc:closure? address)
    (error 'gc:closure-code-ptr "not a closure: ~a" address))
  (heap-ref (+ address 1)))
;; gc:closure-env-ref : address integer -> address
(define (gc:closure-env-ref address i)
  (unless (gc:closure? address)
    (error 'gc:closure-env-ref "not a closure: ~a" address))
  (heap-ref (+ address 2 i)))

;; TODO: with-heap tests