54 lines
1.5 KiB
Racket
54 lines
1.5 KiB
Racket
#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))
|
||
|
||
(: initial-dump Dump)
|
||
(define initial-dump '())
|
||
|
||
(: initial-stats Stats)
|
||
(define initial-stats 0)
|
||
|
||
(: 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)))))
|