Scheme Compiler の勉強(25) - リファクタリング

小休止して、汚く冗長なコンパイラを少し整理。今までは何でも文字列で処理していたので、見た目も悪いしメンテしにくかった。instruction を定義して（まだ乱暴だけど）、以前だと (emit "~a = load i32 %ret" %tmp1) などと書いていた処理を、(assign %tmp1 (inst-load 'i32 "%ret")) と書けるようになった。まだぜんぜんエレガントでないのは仕方ないけど、とりあえず。SSA ってひたすら assign ばっかりしているのだなぁ、と今更気付く。以下のような感じになっている。

(define-primitive ($fxadd1 env expr)
  (with-uvar (%tmp %tmp2)
    (emit-expr env expr)
    (assign %tmp (inst-load 'i32* "%ret"))
    (assign %tmp2 (inst-add 'i32 (immediate-rep 1) %tmp))
    (inst-store 'i32 %tmp2 'i32* "%ret")))
...
(define-primitive (fixnum? env expr)
  (with-uvar (%tmp %tmp2 %tmp3 %tmp4)
    (emit-expr env expr)
    (assign %tmp (inst-load 'i32* "%ret"))
    (assign %tmp2 (inst-and 'i32 %tmp fxmask))
    (assign %tmp3 (inst-icmp 'eq 'i32 %tmp2 0))
    (assign %tmp4 (inst-select %tmp3 'i32 bool_t 'i32 bool_f))
    (inst-store 'i32 %tmp4 'i32* "%ret")))
...
(define (emit-lambda env)
  (lambda (expr label args)
    (define-function label args
      (let ((fmls (lambda-formals expr))
	    (body (lambda-body expr)))
	(let f ((fmls fmls) (env env) (idx 1))
	  (cond
	   ((null? fmls) (emit-expr env body))
	   (else
	    (with-svar (%arg_addr)
	      (assign %arg_addr (inst-alloca 'i32))
	      (inst-store 'i32 (format #f "%arg~a" idx) 'i32* %arg_addr)
	      (bind-value env (car fmls) %arg_addr)
	      (f (cdr fmls)
		 (extend-env env) (+ idx 1))))))))))

マクロを上手く作るにはまだまだ修行が必要。