Scheme - C言語による Scheme の interpreter (kscheme) - (文字型と文字を操作したりする手続きを実装)

開発環境

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ではなく、関数を呼び出すとか))を少しずつ書き進めてめていくことに。

文字型(扱う文字の範囲は、とりあえず Unicode ではなく、ASCII文字のみ)とそれに付随する手続きを実装。

参考書籍等

kscheme

コード(BBEdit, Emacs)

char.c


#include "char.h"

data_s char_new(char *in) {
  return (data_s){.type = CHAR, .data.ch = *in};
}

data_s char_copy(data_s in) {
  return in;
}

void char_print(FILE *stream, data_s in) {
  fprintf(stream, "#\\%c", in.data.ch);
}

void char_display(FILE *stream, data_s in) {
  fprintf(stream, "%c", in.data.ch);
}

bool char_is_eq(data_s in1, data_s in2) {
  return in1.data.ch == in2.data.ch;
}

bool char_is_eqv(data_s in1, data_s in2) {
  return char_is_eq(in1, in2);
}

bool char_is_equal(data_s in1, data_s in2) {
  return char_is_eq(in1, in2);
}

#include "list_operations.h"
#include "boolean.h"
data_s prim_is_char(data_s in){
  return car(in).type == CHAR ? true_data : false_data;
}

data_s prim_char_equal(data_s in) {
  return car(in).data.ch == cadr(in).data.ch ? true_data : false_data;
}

data_s prim_char_lt(data_s in) {
  return car(in).data.ch < cadr(in).data.ch ? true_data : false_data;
}

data_s prim_char_gt(data_s in) {
  return car(in).data.ch > cadr(in).data.ch ? true_data : false_data;
}

data_s prim_char_le(data_s in) {
  return car(in).data.ch <= cadr(in).data.ch ? true_data : false_data;
}

data_s prim_char_ge(data_s in) {
  return car(in).data.ch >= cadr(in).data.ch ? true_data : false_data;
}

/* 大文字小文字を同一視 */
#include <ctype.h>
data_s prim_char_ci_equal(data_s in) {
  return toupper(car(in).data.ch) == toupper(cadr(in).data.ch) ? true_data : false_data;
}

data_s prim_char_ci_lt(data_s in) {
  return toupper(car(in).data.ch) < toupper(cadr(in).data.ch) ? true_data : false_data;
}

data_s prim_char_ci_gt(data_s in) {
  return toupper(car(in).data.ch) > toupper(cadr(in).data.ch) ? true_data : false_data;
}

data_s prim_char_ci_le(data_s in) {
  return toupper(car(in).data.ch) <= toupper(cadr(in).data.ch) ? true_data : false_data;
}

data_s prim_char_ci_ge(data_s in) {
  return toupper(car(in).data.ch) >= toupper(cadr(in).data.ch) ? true_data : false_data;
}

data_s prim_is_alphabetic(data_s in) {
  return isalpha(car(in).data.ch) ? true_data : false_data;
}
data_s prim_is_numeric(data_s in) {
  return isdigit(car(in).data.ch) ? true_data : false_data;
}
data_s prim_is_whitespace(data_s in) {
  return isspace(car(in).data.ch) ? true_data : false_data;
}

data_s prim_is_upper_case(data_s in) {
  return isupper(car(in).data.ch) ? true_data : false_data;
}
data_s prim_is_lower_case(data_s in) {
  return islower(car(in).data.ch) ? true_data : false_data;
}

data_s prim_digit_value(data_s in) {
  char ch = car(in).data.ch;
  if (isdigit(ch)) {
    char s[2] = {ch, '\0'};
    return data_s_new(Z, s);
  }
  return false_data;
}

data_s prim_char2integer(data_s in) {
  char s[2] = {car(in).data.ch, '\0'};
  return data_s_new(Z, s);
}

data_s prim_integer2char(data_s in) {
  unsigned long int n = mpz_get_ui(car(in).data.z);
  return (data_s){.type = CHAR, .data.ch = n};
}

data_s prim_upcase(data_s in) {
  return (data_s){.type=CHAR, .data.ch = toupper(car(in).data.ch)};
}

data_s prim_downcase(data_s in) {
  return (data_s){.type=CHAR, .data.ch = tolower(car(in).data.ch)};
}

data_s prim_foldcase(data_s in) {
  data_s out = {.type = CHAR};
  char ch = car(in).data.ch;
  out.data.ch =  isupper(ch) ? tolower(ch) : toupper(ch);
  return out;
}

samp;le.scm


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

  (define c1 #\a)
  (define c2 #\b)
  (define c3 #\a)
  (define c4 #\A)  

  (for-each (lambda (x)
              (print x))
            (list (char? c1)
                  (char=? c1 c2)
                  (char=? c1 c3)
                  (char=? c1 c4)
                  (char>? c1 c2)
                  (char>? c1 c3)
                  (char>? c1 c4)
                  (char<? c1 c2)
                  (char<? c1 c3)
                  (char<? c1 c4)
                  (char<=? c1 c2)
                  (char<=? c1 c3)
                  (char<=? c1 c4)
                  (char>=? c1 c2)
                  (char>=? c1 c3)
                  (char>=? c1 c4)
                  (char-ci=? c1 c2)
                  (char-ci=? c1 c3)
                  (char-ci=? c1 c4)                  
                  (char-ci<? c1 c2)
                  (char-ci<? c1 c3)
                  (char-ci<? c1 c4)
                  (char-ci>? c1 c2)
                  (char-ci>? c1 c3)
                  (char-ci>? c1 c4)
                  (char-ci<? c1 c2)
                  (char-ci<? c1 c3)
                  (char-ci<? c1 c4)
                  (char-ci>=? c1 c2)
                  (char-ci>=? c1 c3)
                  (char-ci>=? c1 c4)
                  (char-ci<=? c1 c2)
                  (char-ci<=? c1 c3)
                  (char-ci<=? c1 c4)
                  (char-alphabetic? c1)
                  (char-alphabetic? #\5)
                  (char-numeric? c1)
                  (char-numeric? #\5)
                  (char-upper-case? c1)
                  (char-upper-case? c4)
                  (char-lower-case? c1)
                  (char-lower-case? c4)
                  (digit-value c1)
                  (digit-value #\5)
                  (char->integer #\5)
                  (integer->char 83)    ; S式の'S'
                  (char-upcase c1)
                  (char-upcase c4)
                  (char-downcase c1)
                  (char-downcase c4)
                  (char-foldcase c1)
                  (char-foldcase c4)))
  (quote done))

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

$ kscheme sample.scm
#t
#f
#t
#f
#f
#f
#t
#t
#f
#f
#t
#t
#f
#f
#t
#t
#f
#t
#t
#t
#f
#f
#f
#f
#f
#t
#f
#f
#f
#t
#t
#t
#t
#t
#t
#f
#f
#t
#f
#t
#t
#f
#f
5
5
S
A
A
a
a
A
a
done
$

Kamimura's blog

2015年7月9日木曜日

Scheme - C言語による Scheme の interpreter (kscheme) - (文字型と文字を操作したりする手続きを実装)

0 コメント:

コメントを投稿