diff --git a/semantics.rkt b/semantics.rkt index 22a3add..5712e5d 100644 --- a/semantics.rkt +++ b/semantics.rkt @@ -10,6 +10,14 @@ (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)) @@ -23,6 +31,10 @@ (: 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))])) @@ -32,12 +44,11 @@ (let ([addr (new-addr)]) (values (hash-set heap addr node) addr))) -(: allocate-sc (-> Heap CoreScDefn (Values Heap (Pair Name Addr)))) -(define (allocate-sc heap scdef) - (let-values ([(heap addr) (allocate-node heap scdef)]) - (values heap (cons (scdefn-name scdef) addr)))) - - -;; (: initial-heap (-> (Listof CoreScDefn) (Values Heap Globals))) -;; (define (initial-heap scs) -;; (for/fold ([heap ]))) +(: 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)))))