概して、プログラムの方、良く書けていたと思います(って何度も打ち込んでいる私)。 ただ、いくつか気になったところもあるので、指摘しておきます。 僕の書いたプログラム例は、最後に付記しておきます。
別に構わないんですが、すこし気をつけると簡潔に書けます。
(define (trans-add-expr expr) (cons (load-value (car expr)) ; 先頭要素を mov?? に変換するもの (trans-add-expr-aux (cdr expr)))) ; 残りの要素を add?? に変換するもの (define (trans-add-expr-aux exprs) (if (null? exprs) ; リストが「空」ならば (list) ; 空リストを返し、さもなくば、 (cons (trans-add-expr-1 (car expr)) ; 先頭要素にtrans-add-expr-1 を施して、 (trans-add-expr-aux (cdr expr))))) ; 残りを変換したものの先頭につけ足す。 ; つまり cons です。 (define (trans-add-expr-1 item) (cond ((symbol? item) ....) ; 変数が来たら ((number? item) ....))) ; 定数が来たらという感じ。
(define (trans-add-expr expr) (map trans-add-expr-1 expr))と書けるようになっておきましょう。
(define (trans-sub-expr expr) ; sub は、残りを add のように (append (trans-add-expr (cdr expr)) ; に変換した後、先頭要素が定数/変数 (list (trans-expr-item (car expr) ; の場合、SUBLW/SUBWF を実行 'SUBLW 'SUBWF))))
(define (trans-add-expr-aux exprs) (trans-add-expr-aux2 exprs (list))) (define (trans-add-expr-aux2 from to) (if (null? from) (reverse to) ; to には逆順につまっているので、最後に反転 (trans-add-expr-aux2 (cdr from) ; from を一つ取り除き、 (cons (trans-add-expr-1 (car from)) to)))) ; toに逆順に詰める
差分をこの色で書いておきます。
;;; trans-simple-expr ;;; 式(入れ子なし)を与えると、 ;;; 結果を W レジスタにおくためのアセンブリコード(list形式)を出力する関数 ;;; ex. ;;; (trans-simple-expr '4) => ((MOVLW 4)) ;;; (trans-simple-expr 'x) => ((MOVF x 0)) ;;; ;;; (trans-simple-expr '(+ 1 x y 3)) ;;; => ((MOVLW 1) (ADDWF x 0) (ADDWF y 0) (ADDLW 3)) ;;; ;;; (trans-simple-expr '(- 1 x y 3)) ;;; => ((MOVF x 0) (ADDWF y 0) (ADDLW 3) (SUBLW 1)) ; (- 1 (+ x y 3)) を行う ;;; ;;; (trans-simple-expr '(and x y 3)) ;;; => ((MOVF x 0) (ANDWF y 0) (ANDLW 3)) ;;; (trans-simple-expr '(or x y 3)) ;;; => ((MOVF x 0) (IORWF y 0) (IORLW 3)) ;;; (trans-simple-expr '(not x)) ;;; => ((COMF x 0)) ;;; ;;; ヒント: ;;; ;;; まずは式についてですが、"変数"とはシンボルのことです。即値とは整数のことです。 ;;; また、演算子ですが、それぞれ +, -, and, or という"シンボル"です。 ;;; ;;; 演算子付の式を変換するにあたっては、+,and, or については、 ;;; 先頭要素を(MOV??) してから、後続部を(AND??)などすればOKです。リスト操作を頑張りましょう。 ;;; - については、例をみながら考えてみましょう。 (define (trans-simple-expr expr) (cond ((number? expr) (list (trans-expr-num expr))) ; 即値の場合 ((symbol? expr) (list (trans-expr-var expr))) ; 変数そのものの場合 ((eq? (car expr) '+) (trans-add-expr (cdr expr))) ; (+ ...) な場合 ((eq? (car expr) '-) (trans-sub-expr (cdr expr))) ; (- ...) な場合 ((eq? (car expr) 'and) (trans-and-expr (cdr expr))); (and ...) な場合 ((eq? (car expr) 'or) (trans-or-expr (cdr expr))) ; (or ...) な場合 ((eq? (car expr) 'not) (trans-not-expr (cdr expr))); (not ...) な場合 (else (error 'trans-simple-expr ; しらないやつの場合 "receives an unknown operator: ~a" (car expr))))) (define (trans-expr-num num) (list 'MOVLW num)) (define (trans-expr-var var) (list 'MOVF var 0)) ; この二つは、trans-load-item で対処可 ;;; 汎用をめざした関数 ;;; trans-expr-item/items (define (trans-expr-item item lw wf) ; trans-expr-item は、 (cond ((number? item) (list lw item)) ; item が nuber なら lw なるタグをつけ、 ((symbol? item) (list wf item 0)) ; symbol なら、wf なるタグをつける。 (else (error 'trans-expr-item "receives an unknown sub-expression: ~a" item)))) (define (trans-expr-items items lw wf) ; list に対して、 trans-expr-item を操作する関数 (if (null? items) (list) (cons (trans-expr-item (car items) lw wf) (trans-expr-items (cdr items) lw wf)))) ;;; それぞれの式の形に応じた処理を行う関数 ;;; trans-add/and/or/sub/not-expr (define (trans-load-item item) ; load するだけなら 定数/変数に応じ (trans-expr-item item 'MOVLW 'MOVF)) ; MOVLW/MOVF をつかう (define (trans-add-expr expr) ; add の場合。 (cons (trans-load-item (car expr)) ; まず最初の値を load し、 (trans-expr-items (cdr expr) 'ADDLW 'ADDWF))) ; そのあと 定数/変数はADDLW/ADDWF ; をつかって足し込んでいく (define (trans-and-expr expr) ; and もおなじく。 (cons (trans-load-item (car expr)) (trans-expr-items (cdr expr) 'ANDLW 'ANDWF))) (define (trans-or-expr expr) ; or も add と同じく (cons (trans-load-item (car expr)) (trans-expr-items (cdr expr) 'IORLW 'IORWF))) (define (trans-sub-expr expr) ; sub は、残りを add のように (append (trans-add-expr (cdr expr)) ; に変換した後、先頭要素が定数/変数 (list (trans-expr-item (car expr) ; の場合、SUBLW/SUBWF を実行 'SUBLW 'SUBWF)))) ; (define (trans-not-expr expr) (if (symbol? (car expr)) (list (list 'COMF (car expr) 0)) (error 'trans-not-expr "receives only variables."))) ;;; trans-stmt ;;; 式を変換して対応するアセンブリコードを出力する関数 ;;; ;;; ex. ;;; (trans-stmt ;;; ;;; (define (trans-stmt stmt) (cond ((eq? (car stmt) ':=) ; 代入文の場合 (trans-assign-stmt (cadr stmt) (caddr stmt))) ((eq? (car stmt) 'if) ; if 文の場合 (trans-if-stmt (cadr stmt) (caddr stmt) (cadddr stmt))) ((eq? (car stmt) 'while) ; while 文の場合 (trans-while-stmt (cadr stmt) (caddr stmt))) ((eq? (car stmt) 'begin) ; 複文の場合 (trans-stmts (cdr stmt))) (else ; 知らないものの場合 (error 'trams-stmt "Unknown statement.")))) ;;; trans-stmts は複数の文を処理 (define (trans-stmts stmts) ; 複文の場合 (if (null? stmts) (list) (append (trans-stmt (car stmts)) ; リストとリストを (trans-stmts (cdr stmts))))) ; 連結しましょう ;;; trans-assign-stmt ;;; (trans-assign-stmt var expr) は expr を計算して、var に代入 (define (trans-assign-stmt var expr) (append (trans-simple-expr expr) ; ここまで expr が Wレジスタに入り (list (list 'MOVWF var)))) ; ここで、var に書き込み ;;; trans-if-stmt ;;; (trans-if-stmt expr then-stmt else-stmt) は ;;; expr の結果が 0 以外なら then を 0 なら else を実行する (define (trans-if-stmt expr then-stmt else-stmt) (trans-if-stmt-aux expr then-stmt else-stmt (gensym) ; else-label 用の新規 symbol の生成 (gensym) ; exit-label 用の新規 symbol の生成 )) (define (trans-if-stmt-aux expr then-stmt else-stmt else-label exit-label) (append (trans-simple-expr expr) ; expr を評価し (list (list 'BTFSC 'STATUS 2) ; Zero-Flag がたっていなければ then (list 'GOTO else-label)) ; たっていれば、else へ goto (trans-stmt then-stmt) ; then を変換したもの (list (list 'GOTO exit-label) ; then が終われば exit へ goto else-label) ; else はここから (trans-stmt else-stmt) ; else を変換したもの (list exit-label))) ; if 文終了 ;;; trans-while-stmt ;;; (trans-while-stmt expr stmt) は ;;; expr を評価し、0 以外でならば繰り返し stmt を実行する ;;; ヒント: ;;; trans-if-stmt を理解できれば問題ないはず。 ;;; 真似して作ってみましょう。 (define (trans-while-stmt expr stmt) (trans-while-stmt-aux expr stmt (gensym) (gensym))) (define (trans-while-stmt-aux expr stmt init-label exit-label) ; (append (list init-label) ; init のlabel (trans-simple-expr expr) ; まず expr を評価して (list (list 'BTFSC 'STATUS 2) ; 0 でなければ stmt にいき (list 'GOTO exit-label)); 0 ならば while を抜ける (trans-stmt stmt) ; stmt を変換したもの (list (list 'GOTO init-label) ; 始めに戻る exit-label))) ; while の終わり
2000.12.27/ Tomio KAMADA: kamada@cs.kobe-u.ac.jp