string-to-list.scm

#>
#include <stdio.h>
#include <stdlib.h>
#include <locale.h>
#include <wchar.h>

C_word
C_string_to_list(const char *str)
{
	int i;
	size_t len, wcs_len, tmp_len;
	wchar_t *wcs, *tmp_wcs;
	mbstate_t mbs;
	C_word x, last, current, first;

	memset(&mbs, 0, sizeof(mbstate_t));

	tmp_len = BUFSIZ;
	wcs = NULL;
	len = 0;
	for ( ; ; ) {
		size_t conv_len;

		tmp_wcs = malloc(sizeof(wchar_t) * tmp_len);
		conv_len = mbsrtowcs(tmp_wcs, &str, tmp_len, &mbs);

		if (conv_len == -1) {
			free(tmp_wcs);
			return C_SCHEME_FALSE;
		} else if (conv_len == 0) {
			free(tmp_wcs);
			break;
		} else if (conv_len == tmp_len) {
			wchar_t *newp;

			if (wcs == NULL && ((newp = malloc(sizeof(wchar_t) * conv_len)) == NULL)) {
				return C_SCHEME_FALSE;
			} else if ((newp = realloc(wcs, sizeof(wchar_t) * (len + conv_len))) == NULL) {
				free(wcs);
				return C_SCHEME_FALSE;
			}
			wcs = newp;
			memcpy(&wcs[len], tmp_wcs, sizeof(wchar_t) * conv_len);
			len += conv_len;
			tmp_len *= 2;
		} else {
			wchar_t *newp;

			if (wcs == NULL && ((newp = malloc(sizeof(wchar_t) * conv_len)) == NULL)) {
				return C_SCHEME_FALSE;
			} else if ((newp = realloc(wcs, sizeof(wchar_t) * (len + conv_len))) == NULL) {
				free(wcs);
				return C_SCHEME_FALSE;
			}
			wcs = newp;
			memcpy(&wcs[len], tmp_wcs, sizeof(wchar_t) * conv_len);
			len += conv_len;
			break;
		}
		free(tmp_wcs);
	}


	first = C_SCHEME_END_OF_LIST;
	last = C_SCHEME_UNDEFINED;
	for(i = len - 1; 0 <= i; i--) {
		char s[MB_CUR_MAX];
		C_word *ptr;

		wcs_len = wcrtomb(s, wcs[i], &mbs);
		if (wcs_len == -1) {
			free(wcs);
			return C_SCHEME_FALSE;
		}
		ptr = C_malloc(C_SIZEOF_STRING(wcs_len));
		x = C_string(&ptr, wcs_len, s);

		current = C_pair(C_heaptop, x, C_SCHEME_END_OF_LIST);

		if(C_in_stackp(x))
			C_mutate(&C_u_i_car(current), x);

		if(last != C_SCHEME_UNDEFINED)
			C_set_block_item(last, 1, current);
		else first = current;

		last = current;
	}
	free(wcs);

	return first;
}

<#

(define setlocale
  (foreign-lambda c-string "setlocale" int c-string*))

(define string-to-list
  (foreign-lambda scheme-object "C_string_to_list" c-string*))

;; (setlocale (foreign-value "LC_ALL" int)
;; (print (reverse (string-to-list "あいうabcかきく")))
;; => (あ い う a b c か き く)