Scheme Compiler の勉強 (11) - fixnum, char

1.3 Unary Primitives の fixnum->char までテストが通るようになった。

• 一旦基盤ができてしまえば、テストを追加=>primitive を追加=>テストを実行、とループを回せる。結局テキスト通りでちゃんとうまくいく。

;; gauche 用に変更した箇所。

(define *is-prim* '())
(define *arg-count* '())
(define *emitter* '())

(define-syntax define-primitive 
  (syntax-rules () 
    [(_ (prim-name arg* ...) b b* ...) 
     (begin 
       (set! *is-prim* (acons 'prim-name #t *is-prim*))
       (set! *arg-count* (acons 'prim-name (length '(arg* ...)) *is-prim*))
       (set! *emitter* (acons 'prim-name 
			      (lambda (arg* ...) b b* ...) *emitter*)))]))

;; LLVM 用に変更した箇所

(define (emit-function-header)
  (emit "define i32 @scheme_entry() nounwind {")
  (emit "entry:")
  (emit "    %ret = alloca i32"))

(define (emit-function-footer)
  (emit "    %retval = load i32* %ret")
  (emit "    ret i32 %retval")
  (emit "}"))

(define (emit-expr expr)
  (cond
   [(immediate? expr) (emit-immediate expr)]
   [(primcall? expr) (emit-primcall expr)]
   [else (error) ]))

;; LLVM 用に変更した箇所
(define (emit-immediate expr)
  (emit "    store i32 ~s, i32* %ret" (immediate-rep expr)))

;; ユニークな変数名を作成する簡易手続き

(define unique-var
  (let ((count 0))
    (lambda ()
      (set! count (+ 1 count))
      (format #f "%var~a" count))))

;; define-primitive での定義; 多分無駄なことをやっている

(define-primitive ($fxadd1 expr)
  (let* ((%val (unique-var))
	 (%tmp (unique-var)))
    (emit-expr expr)
    (emit "    ~a = load i32* %ret" %val)
    (emit "    ~a = add i32 ~s, ~a" %tmp (immediate-rep 1) %val)
    (emit "    store i32 ~a, i32* %ret" %tmp)))