#lang typed/racket
(require "ast.rkt")

(struct State ([stack : Stack] [dump : Dump] [heap : Heap] [globals : Globals] [stats : Stats]))
(define-type Addr Symbol)
(define-type Stack (Listof Addr))
(define-type Dump Null)
(define-type Heap (Immutable-HashTable Addr Node))
(define-type Node (∪ (List Addr Addr) CoreScDefn Integer))
(define-type Globals (Immutable-HashTable Name Addr))
(define-type Stats Nonnegative-Integer)

(: empty-heap Heap)
(define empty-heap
  (make-immutable-hash))

(: empty-globals Globals)
(define empty-globals
  (make-immutable-hash))

(: new-addr (-> Addr))
(define (new-addr)
  (gensym))

(: empty-dump Dump)
(define empty-dump '())

(: empty-stats Stats)
(define empty-stats 0)

(: empty-stack Stack)
(define empty-stack '())

(: incr-stats (-> Stats Stats))
(define incr-stats add1)

(: update-globals (-> Globals Name Addr Globals))
(define (update-globals globals name addr)
  (hash-set globals name addr))

(: update-stats (-> (-> Stats Stats) State State))
(define (update-stats f mstate)
  (struct-copy State mstate [stats (f (State-stats mstate))]))

(: allocate-node (-> Heap Node (Values Heap Addr)))
(define (allocate-node heap node)
  (let ([addr (new-addr)])
    (values (hash-set heap addr node) addr)))

(: initialize-heap (-> (Listof CoreScDefn) (Values Heap Globals)))
(define (initialize-heap scs)
  (for/fold ([heap : Heap empty-heap]
             [globals : Globals empty-globals])
            ([sc : CoreScDefn scs])
    (let-values ([(new-heap addr) (allocate-node heap sc)])
      (values new-heap
              (update-globals globals (scdefn-name sc) addr)))))

(: compile-core (-> (Listof CoreScDefn) State))
(define (compile-core scdefs)
  (let-values ([(heap globals) (initialize-heap scdefs)])
    (State empty-stack empty-dump heap globals empty-stats)))