Scheme Compiler の勉強(22) - letrec ,引数あり、のコンパイル

procedure (letrec)

(letrec *1 が通るようになった。おお、これは嬉しい。

以下のような scheme のプログラム断片が、

(build-program '(letrec ((f (lambda (n)
			      (if ($fxzero? n)
				  1
				  (fx* n (f ($fxsub1 n)))))))
		  (f 3)))

自作の”コンパイラ”によって以下の LLVM IR に変換される。

define i32 @Label_62(i32 %arg1) nounwind {
entry:
    %ret = alloca i32
; here
    %sta69 = alloca i32
    store i32 %arg1, i32* %sta69
; emit-lambda
    %var309 = load i32* %sta69
    store i32 %var309, i32* %ret
    %var306 = load i32* %ret
    %var307 = icmp eq i32 %var306, 0
    %var308 = select i1 %var307, i32 111, i32 47
    store i32 %var308, i32* %ret
    %var304 = load i32* %ret
    %var305 = icmp eq i32 %var304, 47
    br i1 %var305, label %Label_64, label %Label_63
Label_63:
    store i32 4, i32* %ret
    br label %Label_65
Label_64:
    %var320 = load i32* %sta69
    store i32 %var320, i32* %ret
    %sta70 = alloca i32
    %var310 = load i32* %ret
    store i32 %var310, i32* %sta70
    %var326 = load i32* %sta69
    store i32 %var326, i32* %ret
    %var323 = load i32* %ret
    %var324 = sub i32 4, %var323
    %var325 = sub i32 0, %var324
    store i32 %var325, i32* %ret
    %var322 = load i32* %ret
    %var321 = call i32 @Label_62(i32 %var322)
    store i32 %var321, i32* %ret
    %sta71 = alloca i32
    %var311 = load i32* %ret
    store i32 %var311, i32* %sta71
    %var312 = load i32* %sta70
    %var314 = load i32* %sta71
    %var313 = sdiv i32 %var312, 4
    %var315 = sdiv i32 %var314, 4
    %var316 = mul i32 %var313, %var315
    %var317 = mul i32 %var316, 4
    store i32 %var317, i32* %ret
    br label %Label_65
Label_65:
    %retval = load i32* %ret
    ret i32 %retval
}
define i32 @scheme_entry() nounwind {
entry:
    %ret = alloca i32
    store i32 12, i32* %ret
    %var328 = load i32* %ret
    %var327 = call i32 @Label_62(i32 %var328)
    store i32 %var327, i32* %ret
    %retval = load i32* %ret
    ret i32 %retval
}

LLVM の opt コマンドで最適化してやる。なんだか良くわからないけど、なにかの最適化がされているらしい。
※「なんだか良くわからないけど、なにかの最適化」というのはあんまりなのであとで追うこと。

define i32 @Label_62(i32 %arg1) nounwind  {
entry:
	%var307 = icmp eq i32 %arg1, 0		; <i1> [#uses=1]
	br i1 %var307, label %UnifiedReturnBlock, label %Label_64

Label_64:		; preds = %entry
	%var324 = add i32 %arg1, -4		; <i32> [#uses=1]
	%var321 = call i32 @Label_62( i32 %var324 )		; <i32> [#uses=1]
	%var313 = sdiv i32 %arg1, 4		; <i32> [#uses=1]
	%var315 = sdiv i32 %var321, 4		; <i32> [#uses=1]
	%var316 = shl i32 %var313, 2		; <i32> [#uses=1]
	%var317 = mul i32 %var316, %var315		; <i32> [#uses=1]
	ret i32 %var317

UnifiedReturnBlock:		; preds = %entry
	ret i32 4
}

define i32 @scheme_entry() nounwind  {
entry:
	%var321.i = tail call i32 @Label_62( i32 8 ) nounwind 		; <i32> [#uses=1]
	%var315.i = sdiv i32 %var321.i, 4		; <i32> [#uses=1]
	%var317.i = mul i32 %var315.i, 12		; <i32> [#uses=1]
	ret i32 %var317.i
}

で、さらにアセンブラ(PowerPC)に変換するとこんな感じ。ほほう。

	.machine ppc7400
	.section __TEXT,__textcoal_nt,coalesced,pure_instructions
	.section __TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16
	.text


	.globl	_Label_62
	.align	4
_Label_62:
	mflr r0
	stw r0, 8(r1)
	stwu r1, -64(r1)
	stw r30, 60(r1)
	cmplwi cr0, r3, 0
	mr r30, r3
	beq cr0, LBB1_2	; UnifiedReturnBlock
LBB1_1:	; Label_64
	addi r3, r30, -4
	bl _Label_62
	srawi r2, r3, 2
	addze r2, r2
	srawi r3, r30, 2
	addze r3, r3
	mullw r2, r3, r2
	slwi r3, r2, 2
	lwz r30, 60(r1)
	addi r1, r1, 64
	lwz r0, 8(r1)
	mtlr r0
	blr 
LBB1_2:	; UnifiedReturnBlock
	li r3, 4
	lwz r30, 60(r1)
	addi r1, r1, 64
	lwz r0, 8(r1)
	mtlr r0
	blr 


	.globl	_scheme_entry
	.align	4
_scheme_entry:
	mflr r0
	stw r0, 8(r1)
	stwu r1, -64(r1)
	li r3, 8
	bl _Label_62
	srawi r2, r3, 2
	addze r2, r2
	mulli r3, r2, 12
	addi r1, r1, 64
	lwz r0, 8(r1)
	mtlr r0
	blr 

	.subsections_via_symbols

letrec 完了

引数の無いラムダ式 (lambda () 5)、引数１個(lambda (x) (fxadd1 x))、と順番に実装し、引数複数も対応した。これで以下のようなテストが通るようになった。

(letrec ([f (lambda (x) 
                 (if ($fxzero? x)
                     1
                     (fx* x (f ($fxsub1 x)))))])
      (f 5))
=> 120

(letrec ([f (lambda (x) (g x x))]
            [g (lambda (x y) (fx+ x y))])
     (f 12))
=> 24

*1:f lambda (x) 5))) (f