SICP 問題 5.10
新しく構文を追加する.
簡単にincrementとdecrementで.
(define (make-execution-procedure inst labels machine pc flag stack ops) (cond ((eq? (car inst) 'assign) (make-assign inst machine labels ops pc)) ((eq? (car inst) 'test) (make-test inst machine labels ops flag pc)) ((eq? (car inst) 'branch) (make-branch inst machine labels flag pc)) ((eq? (car inst) 'goto) (make-goto inst machine labels pc)) ((eq? (car inst) 'save) (make-save inst machine stack pc)) ((eq? (car inst) 'restore) (make-restore inst machine stack pc)) ((eq? (car inst) 'perform) (make-perform inst machine labels ops pc)) ((eq? (car inst) 'increment) ;increment (make-increment inst machine pc)) ((eq? (car inst) 'decrement) ;decrement (make-decrement inst machine pc)) (else (error "Unknown instruction type -- ASSEMBLE" inst)))) ;;; 選択子 (define (increment-reg-name name) (cadr name)) (define (decrement-reg-name name) (cadr name)) (define (make-increment inst machine pc) (let ((target (get-register machine (increment-reg-name inst)))) (lambda () (let ((value (get-contents target))) (cond ((number? value) (set-contents! target (+ value 1)) (advance-pc pc)) (error "INCREMENT require number, but" value)))))) (define (make-decrement inst machine pc) (let ((target (get-register machine (decrement-reg-name inst)))) (lambda () (let ((value (get-contents target))) (cond ((number? value) (set-contents! target (- value 1)) (advance-pc pc)) (error "DECREMENT require number, but" value))))))
test
(define add-two (make-machine '(a) (list ) '(controller main (increment a) (increment a) (increment a) (decrement a) done))) gosh> (set-register-contents! add-two 'a 200) done gosh> (start add-two) done gosh> (get-register-contents add-two 'a) 202