diff --git a/semantics.rkt b/semantics.rkt index ab4c45f..4c0c68b 100644 --- a/semantics.rkt +++ b/semantics.rkt @@ -76,6 +76,13 @@ (State (list (lookup-globals globals 'main)) empty-dump heap globals empty-stats))) +(: eval-state (-> State (Pairof State (Listof State)))) +(define (eval-state st) + (if (final-state? st) + (list st) + (let ([next-st (update-stats incr-stats (step st))]) + (cons st (eval-state next-st))))) + (: data-node? (-> Node Boolean)) (define data-node? integer?) @@ -101,6 +108,12 @@ [(list 'define (list name args ...) body) (step-sc rstack st args body)])) +(: get-arg (-> Heap Addr Addr)) +(define (get-arg heap addr) + (match (lookup-node heap addr) + [(list _ a) a] + [_ (error "Not an application node")])) + (: step-sc (-> Stack State (Listof Name) CoreExpr State)) (define (step-sc rstack state arg-names body) (let ([heap (State-heap state)]) @@ -110,7 +123,7 @@ ([arg-name : Name arg-names]) (if (null? stack) (error "Not enough arguments to apply the supercombinator") - (values (update-globals globals arg-name (car stack)) (cdr stack))))] + (values (update-globals globals arg-name (get-arg heap (car stack))) (cdr stack))))] [(new-heap addr) (instantiate-body body new-env heap)]) (let ([new-stack (cons addr new-stack)]) (struct-copy State state [stack new-stack] [heap new-heap])))))