Scheme - C言語による Scheme の interpreter (kscheme) - (数値を操作する(丸める)、ceiling、floor、truncate、round 手続きを実装)

開発環境

• OS X Yosemite - Apple, Ubuntu (OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• C (プログラミング言語)
• Clang/LLVM (コンパイラ, Xcode - Apple)

Schemeの処理系(解釈系、評価器、レジスタ計算機を翻訳した命令列中心のより、もう少しC言語の特性を使った書き方をしたもの(label, gotoではなく、関数を呼び出すとか))を少しずつ書き進めてめていくことに。

SICPで必要になった、round 手続き、その他数値を丸める手続き(cdiling, floor, truncate)を実装。(gmpを利用。)

参考書籍等

• 計算機プログラムの構造と解釈[第2版]
• Structure and Interpretation of Computer Programs (原書)
• R7RSHomePage – Scheme Working Groups
• Head First C ―頭とからだで覚えるCの基本
• 21st Century C: C Tips from the New School
• プログラミング言語C 第2版 ANSI規格準拠
• プログラミング言語Cアンサー・ブック 第2版
• C実践プログラミング 第3版

kscheme

コード(BBEdit, Emacs)

number_r.c

#include "number_r.h"
#include <gmp.h>

data_s number_r_new(char *in) {
  data_s out = {.type = R};
  mpf_init_set_str(out.data.r, in, 10);
  return out;
}

data_s number_r_copy(data_s in) {
  data_s out = {.type = R};
  mpf_init_set(out.data.r, in.data.r);
  return out;
}

void number_r_free(data_s in) { mpf_clear(in.data.r); }

void number_r_print(FILE *stream, data_s in) {
  mpf_out_str(stream, 10, 0, in.data.r);
}

bool number_r_eq(data_s in1, data_s in2) {
  return mpf_cmp(in1.data.r, in2.data.r) == 0;
}

data_s number_r_ceiling(data_s in) {
  data_s out = {.type=R};
  mpf_init(out.data.r);
  mpf_ceil(out.data.r, in.data.r);
  return out;
}

data_s number_r_floor(data_s in) {
  data_s out = {.type=R};
  mpf_init(out.data.r);
  mpf_floor(out.data.r, in.data.r);
  return out;
}

data_s number_r_truncate(data_s in) {
  data_s out = {.type=R};
  mpf_init(out.data.r);
  mpf_trunc(out.data.r, in.data.r);
  return out;
}

data_s number_r_round(data_s in) {
  data_s out = {.type=R};
  mpf_init(out.data.r);
  mpf_t op;
  mpf_init(op);
  mpf_ceil(op, in.data.r);
  mpf_t op1;
  mpf_init(op1);
  mpf_sub(op1, op, in.data.r);
  int n = mpf_cmp_d(op1, 0.5); 
  if (n == 0) {
    mpz_t op2;
    mpz_init(op2);
    mpz_set_f(op2, op);
    if (mpz_cdiv_ui(op2, 2) == 0) {
      mpf_set(out.data.r, op);
    } else {
      mpf_floor(out.data.r, in.data.r);
    }
    mpz_clear(op2);
  } else if (n > 0) {    
    mpf_floor(out.data.r, in.data.r);
  } else if (n < 0) {
    mpf_ceil(out.data.r, in.data.r);
  }
  mpf_clears(op, op1, NULL);
  return out;
}

number_r.c

(begin  
  (define for-each
    (lambda (proc items)
      (if (not (null? items))
          (begin (proc (car items))
                 (for-each proc (cdr items))))))  

  (define nums (quote (1.4 1.5 1.6 2.4 2.5 2.6
                           -1.4 -1.5 -1.6 -2.4 -2.5 -2.6)))

  (for-each (lambda (n)
              (display n)
              (display ": ")
              (display (ceiling n))
              (display " ")
              (display (floor n))
              (display " ")
              (display (truncate n))
              (display " ")
              (display (round n))
              (newline))
            nums)
  (quote done))

入出力結果(Terminal(kscm), REPL(Read, Eval, Print, Loop))

$ kscheme sample.scm
0.14e1: 0.2e1 0.1e1 0.1e1 0.1e1
0.15e1: 0.2e1 0.1e1 0.1e1 0.2e1
0.16e1: 0.2e1 0.1e1 0.1e1 0.2e1
0.24e1: 0.3e1 0.2e1 0.2e1 0.2e1
0.25e1: 0.3e1 0.2e1 0.2e1 0.2e1
0.26e1: 0.3e1 0.2e1 0.2e1 0.3e1
-0.14e1: -0.1e1 -0.2e1 -0.1e1 -0.1e1
-0.15e1: -0.1e1 -0.2e1 -0.1e1 -0.2e1
-0.16e1: -0.1e1 -0.2e1 -0.1e1 -0.2e1
-0.24e1: -0.2e1 -0.3e1 -0.2e1 -0.2e1
-0.25e1: -0.2e1 -0.3e1 -0.2e1 -0.2e1
-0.26e1: -0.2e1 -0.3e1 -0.2e1 -0.3e1
done
$