SICP 問題 5.08
start (goto (label here)) here (assign a (const 3)) (goto (label there)) here (assign a (const 4)) (goto (label there)) there
この時thereに達した時のaの値は何かという問題.
(define (extract-labels text receive) (if (null? text) (receive '() '()) (extract-labels (cdr text) (lambda (insts labels) (let ((next-inst (car text))) ;; symbolであればlabel (if (symbol? next-inst) ;; (receive insts labels)なのでsymbolならlabelsにcons ;; falseならinstsにcons (receive insts (cons (make-label-entry next-inst insts) labels)) (receive (cons (make-instruction next-inst) insts) labels))))))) (define (update-insts! insts labels machine) (let ((pc (get-register machine 'pc)) (flag (get-register machine 'flag)) (stack (machine 'stack)) (ops (machine 'operations))) (for-each (lambda (inst) (set-instruction-execution-proc! inst (make-execution-procedure (instruction-text inst) labels machine pc flag stack ps))) insts))) (define (make-label-entry label-name insts) (cons label-name insts)) (define (lookup-label labels label-name) (let ((val (assoc label-name labels))) (if val (cdr val) (error "Undefined label -- ASSEMBLE" label-name))))
からlabelsは順番を保持してlabelsに登録されていく.
lookup-labelではassocが使われているので先頭に近いものが先に選ばれる.
そのため(goto (label here))で向かうのは最初のhere.
aには3が入っている.
これを同じラベルを違う場所に登録しようとするとエラーとなるようにする.
(define (extract-labels text receive) (if (null? text) (receive '() '()) (extract-labels (cdr text) (lambda (insts labels) (let ((next-inst (car text))) ;; symbolであればlabel (if (symbol? next-inst) (if (assoc next-inst labels) ;;labelsに既に登録されていればここでtrueが返る (error "The same label name is used to indicate two different location " label-name) (receive insts (cons (make-label-entry next-inst insts) labels))) (receive (cons (make-instruction next-inst) insts) labels)))))))