メモ

クロージャーの前に、今までは C で印字していたけどちゃんとした printer を作っておこう、としたらいろいろとプログラムの粗が出てきた。うーん。

• printf を直接呼び出すように declare しようとしたら、call インストラクションの呼び出しの整備、などなどが足りないことが判明。printf は典型的な vararg function という奴で、そのため呼び出す時に http://llvm.org/docs/LangRef.html#i_call のオプション fnty が必須となる。declare する際も 型に noalias というオプションを付けるべきらしい。これも未整備だったがごまかした。
• begin も無いとプログラムを書き難いので追加。

メモ。

• Lisp オブジェクトを印字する、なんていう面倒なものを LLVM IR で直接書くのは辛すぎる。ところで既にある程度の scheme プログラムを LLVM に変換できるコンパイラもどきをもっているのだから、これを使わない手はない。ちょっとした scheme プログラムを LLVM レベルの関数として定義できる仕組みを作れば良い。
• scheme から直接 LLVM の関数を呼ぶ仕組みはないので、 LLVM レベルの関数をプリミティブ $display-obj として呼び出せるようにしておく。これは普通の関数をコンパイルするとほとんど同じだけど、普通の関数は一意になるように名前を変換しているのでちょっと違う。
• 出力には putchar と printf をラップして使う。まだこのコンパイラには cond が無いので if だけで書く。
• これで C に依存していた部分がほとんど無くなった。
• よく考えると、これはわたしのコンパイラもどきが始めて何かの役に立った瞬間かもしれない。コンパイラもどき自身を拡張するのが簡単になった、という小さい利益ではあるけれども。

;; vector を印字する。コンパイルされて LLVM の関数となる。今のところ port は無視していて、標準出力のみ。
gosh> (define f ((code->define-function *top-env*)
            '(code (v n)
               (let ((size (vector-length v)))
                 (if (= size 0)
                     (begin
                       ($display-char #\#)
                       ($display-char #\()
                       ($display-char #\)))
                     (begin
                       (if (= n 0)
                           (begin
                             ($display-char #\#)
                             ($display-char #\()
                             ($display-obj (vector-ref v n)))
                           (if (<= n (- size 1))
                               ($display-obj (vector-ref v n))))
                       (if (= n (- size 1))
                           ($display-char #\))
                           (begin
                             ($display-char #\Space)
                             ($display-vector v (+ n 1)))))))) '@display_vector))

;; 上がコンパイルされた結果

(define-function () i32 @display_vector
  ((i32 %arg1) (i32 %arg2))
  (assign %ret (alloca i32))
  (assign %sta637 (alloca i32))
  (store (i32 %arg1) (i32* %sta637))
  (assign %sta638 (alloca i32))
  (store (i32 %arg2) (i32* %sta638))
  (assign %var6944 (load (i32* %sta637)))
  (store (i32 %var6944) (i32* %ret))
  (assign %var6940 (load (i32* %ret)))
  (assign %var6941 (sub (i32 %var6940 2)))
  (assign %var6942 (inttoptr (i32 %var6941) i32*))
  (assign %var6943 (load (i32* %var6942)))
  (store (i32 %var6943) (i32* %ret))
  (assign %sta639 (alloca i32))
  (assign %var6945 (load (i32* %ret)))
  (store (i32 %var6945) (i32* %sta639))
  (assign %var6954 (load (i32* %sta639)))
  (store (i32 %var6954) (i32* %ret))
  (assign %sta640 (alloca i32))
  (assign %var6948 (load (i32* %ret)))
  (store (i32 %var6948) (i32* %sta640))
  (store (i32 0) (i32* %ret))
  (assign %sta641 (alloca i32))
  (assign %var6949 (load (i32* %ret)))
  (store (i32 %var6949) (i32* %sta641))
  (assign %var6950 (load (i32* %sta640)))
  (assign %var6951 (load (i32* %sta641)))
  (assign %var6952 (icmp eq (i32 %var6950 %var6951)))
  (assign %var6953 (select (i1 %var6952) (i32 111) (i32 47)))
  (store (i32 %var6953) (i32* %ret))
  (assign %var6946 (load (i32* %ret)))
  (assign %var6947 (icmp eq (i32 %var6946 47)))
  (br (i1 %var6947) Label_981 Label_980)
  (label Label_980)
  (store (i32 8975) (i32* %ret))
  (assign %var6955 (load (i32* %ret)))
  (assign %var6956 (lshr (i32 %var6955 6)))
  (assign %var6957 (lshr (i32 %var6956 2)))
  (call i32 @putchar ((i32 %var6957)))
  (store (i32 10255) (i32* %ret))
  (assign %var6958 (load (i32* %ret)))
  (assign %var6959 (lshr (i32 %var6958 6)))
  (assign %var6960 (lshr (i32 %var6959 2)))
  (call i32 @putchar ((i32 %var6960)))
  (store (i32 10511) (i32* %ret))
  (assign %var6961 (load (i32* %ret)))
  (assign %var6962 (lshr (i32 %var6961 6)))
  (assign %var6963 (lshr (i32 %var6962 2)))
  (call i32 @putchar ((i32 %var6963)))
  (br Label_982)
  (label Label_981)
  (assign %var6972 (load (i32* %sta638)))
  (store (i32 %var6972) (i32* %ret))
  (assign %sta642 (alloca i32))
  (assign %var6966 (load (i32* %ret)))
  (store (i32 %var6966) (i32* %sta642))
  (store (i32 0) (i32* %ret))
  (assign %sta643 (alloca i32))
  (assign %var6967 (load (i32* %ret)))
  (store (i32 %var6967) (i32* %sta643))
  (assign %var6968 (load (i32* %sta642)))
  (assign %var6969 (load (i32* %sta643)))
  (assign %var6970 (icmp eq (i32 %var6968 %var6969)))
  (assign %var6971 (select (i1 %var6970) (i32 111) (i32 47)))
  (store (i32 %var6971) (i32* %ret))
  (assign %var6964 (load (i32* %ret)))
  (assign %var6965 (icmp eq (i32 %var6964 47)))
  (br (i1 %var6965) Label_984 Label_983)
  (label Label_983)
  (store (i32 8975) (i32* %ret))
  (assign %var6973 (load (i32* %ret)))
  (assign %var6974 (lshr (i32 %var6973 6)))
  (assign %var6975 (lshr (i32 %var6974 2)))
  (call i32 @putchar ((i32 %var6975)))
  (store (i32 10255) (i32* %ret))
  (assign %var6976 (load (i32* %ret)))
  (assign %var6977 (lshr (i32 %var6976 6)))
  (assign %var6978 (lshr (i32 %var6977 2)))
  (call i32 @putchar ((i32 %var6978)))
  (assign %var6987 (load (i32* %sta637)))
  (store (i32 %var6987) (i32* %ret))
  (assign %var6980 (load (i32* %ret)))
  (assign %var6988 (load (i32* %sta638)))
  (store (i32 %var6988) (i32* %ret))
  (assign %var6981 (load (i32* %ret)))
  (assign %var6983 (add (i32 %var6980 4)))
  (assign %var6984 (add (i32 %var6983 %var6981)))
  (assign %var6985 (inttoptr (i32 %var6984) i32*))
  (assign %var6982 (load (i32* %var6985)))
  (store (i32 %var6982) (i32* %ret))
  (assign %var6979 (load (i32* %ret)))
  (call i32 @display_obj ((i32 %var6979)))
  (br Label_985)
  (label Label_984)
  (assign %var6997 (load (i32* %sta638)))
  (store (i32 %var6997) (i32* %ret))
  (assign %sta644 (alloca i32))
  (assign %var6991 (load (i32* %ret)))
  (store (i32 %var6991) (i32* %sta644))
  (assign %var7003 (load (i32* %sta639)))
  (store (i32 %var7003) (i32* %ret))
  (assign %sta646 (alloca i32))
  (assign %var6998 (load (i32* %ret)))
  (store (i32 %var6998) (i32* %sta646))
  (store (i32 4) (i32* %ret))
  (assign %sta647 (alloca i32))
  (assign %var6999 (load (i32* %ret)))
  (store (i32 %var6999) (i32* %sta647))
  (assign %var7000 (load (i32* %sta646)))
  (assign %var7001 (load (i32* %sta647)))
  (assign %var7002 (sub (i32 %var7000 %var7001)))
  (store (i32 %var7002) (i32* %ret))
  (assign %sta645 (alloca i32))
  (assign %var6992 (load (i32* %ret)))
  (store (i32 %var6992) (i32* %sta645))
  (assign %var6993 (load (i32* %sta644)))
  (assign %var6994 (load (i32* %sta645)))
  (assign %var6995 (icmp sle (i32 %var6993 %var6994)))
  (assign %var6996 (select (i1 %var6995) (i32 111) (i32 47)))
  (store (i32 %var6996) (i32* %ret))
  (assign %var6989 (load (i32* %ret)))
  (assign %var6990 (icmp eq (i32 %var6989 47)))
  (br (i1 %var6990) Label_987 Label_986)
  (label Label_986)
  (assign %var7012 (load (i32* %sta637)))
  (store (i32 %var7012) (i32* %ret))
  (assign %var7005 (load (i32* %ret)))
  (assign %var7013 (load (i32* %sta638)))
  (store (i32 %var7013) (i32* %ret))
  (assign %var7006 (load (i32* %ret)))
  (assign %var7008 (add (i32 %var7005 4)))
  (assign %var7009 (add (i32 %var7008 %var7006)))
  (assign %var7010 (inttoptr (i32 %var7009) i32*))
  (assign %var7007 (load (i32* %var7010)))
  (store (i32 %var7007) (i32* %ret))
  (assign %var7004 (load (i32* %ret)))
  (call i32 @display_obj ((i32 %var7004)))
  (br Label_988)
  (label Label_987)
  (store (i32 63) (i32* %ret))
  (br Label_988)
  (label Label_988)
  (br Label_985)
  (label Label_985)
  (assign %var7022 (load (i32* %sta638)))
  (store (i32 %var7022) (i32* %ret))
  (assign %sta648 (alloca i32))
  (assign %var7016 (load (i32* %ret)))
  (store (i32 %var7016) (i32* %sta648))
  (assign %var7028 (load (i32* %sta639)))
  (store (i32 %var7028) (i32* %ret))
  (assign %sta650 (alloca i32))
  (assign %var7023 (load (i32* %ret)))
  (store (i32 %var7023) (i32* %sta650))
  (store (i32 4) (i32* %ret))
  (assign %sta651 (alloca i32))
  (assign %var7024 (load (i32* %ret)))
  (store (i32 %var7024) (i32* %sta651))
  (assign %var7025 (load (i32* %sta650)))
  (assign %var7026 (load (i32* %sta651)))
  (assign %var7027 (sub (i32 %var7025 %var7026)))
  (store (i32 %var7027) (i32* %ret))
  (assign %sta649 (alloca i32))
  (assign %var7017 (load (i32* %ret)))
  (store (i32 %var7017) (i32* %sta649))
  (assign %var7018 (load (i32* %sta648)))
  (assign %var7019 (load (i32* %sta649)))
  (assign %var7020 (icmp eq (i32 %var7018 %var7019)))
  (assign %var7021 (select (i1 %var7020) (i32 111) (i32 47)))
  (store (i32 %var7021) (i32* %ret))
  (assign %var7014 (load (i32* %ret)))
  (assign %var7015 (icmp eq (i32 %var7014 47)))
  (br (i1 %var7015) Label_990 Label_989)
  (label Label_989)
  (store (i32 10511) (i32* %ret))
  (assign %var7029 (load (i32* %ret)))
  (assign %var7030 (lshr (i32 %var7029 6)))
  (assign %var7031 (lshr (i32 %var7030 2)))
  (call i32 @putchar ((i32 %var7031)))
  (br Label_991)
  (label Label_990)
  (store (i32 8207) (i32* %ret))
  (assign %var7032 (load (i32* %ret)))
  (assign %var7033 (lshr (i32 %var7032 6)))
  (assign %var7034 (lshr (i32 %var7033 2)))
  (call i32 @putchar ((i32 %var7034)))
  (assign %var7039 (load (i32* %sta637)))
  (store (i32 %var7039) (i32* %ret))
  (assign %var7035 (load (i32* %ret)))
  (assign %var7045 (load (i32* %sta638)))
  (store (i32 %var7045) (i32* %ret))
  (assign %sta652 (alloca i32))
  (assign %var7040 (load (i32* %ret)))
  (store (i32 %var7040) (i32* %sta652))
  (store (i32 4) (i32* %ret))
  (assign %sta653 (alloca i32))
  (assign %var7041 (load (i32* %ret)))
  (store (i32 %var7041) (i32* %sta653))
  (assign %var7042 (load (i32* %sta652)))
  (assign %var7043 (load (i32* %sta653)))
  (assign %var7044 (add (i32 %var7042 %var7043)))
  (store (i32 %var7044) (i32* %ret))
  (assign %var7036 (load (i32* %ret)))
  (call i32 @display_vector ((i32 %var7035) (i32 %var7036)))
  (br Label_991)
  (label Label_991)
  (br Label_982)
  (label Label_982)
  (assign %retval (load (i32* %ret)))
  (ret (i32 %retval)))

続く。