From 08c026c8628326946fd1b957a1ec482145ad54c4 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 1 Sep 2015 12:14:35 +0000 Subject: [PATCH] added some sample scheme scripts --- lib/cmn/Makefile.am | 1 + lib/cmn/Makefile.in | 4 +- lib/cmn/utf16.c | 147 ++++++++++++++++++++++++++++++++++++++++++++ lib/test-001.scm | 56 +++++++++++++++++ lib/test-002.scm | 10 +++ lib/test-003.scm | 2 + 6 files changed, 219 insertions(+), 1 deletion(-) create mode 100644 lib/cmn/utf16.c create mode 100644 lib/test-001.scm create mode 100644 lib/test-002.scm create mode 100644 lib/test-003.scm diff --git a/lib/cmn/Makefile.am b/lib/cmn/Makefile.am index 3d8a659..0386288 100644 --- a/lib/cmn/Makefile.am +++ b/lib/cmn/Makefile.am @@ -125,6 +125,7 @@ noinst_HEADERS = \ libh2cmn_la_SOURCES = \ str.c \ + utf16.c \ utf8.c diff --git a/lib/cmn/Makefile.in b/lib/cmn/Makefile.in index 7f64d26..4be96ed 100644 --- a/lib/cmn/Makefile.in +++ b/lib/cmn/Makefile.in @@ -100,7 +100,7 @@ am__installdirs = "$(DESTDIR)$(libdir)" LTLIBRARIES = $(lib_LTLIBRARIES) am__DEPENDENCIES_1 = libh2cmn_la_DEPENDENCIES = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) -am_libh2cmn_la_OBJECTS = str.lo utf8.lo +am_libh2cmn_la_OBJECTS = str.lo utf16.lo utf8.lo libh2cmn_la_OBJECTS = $(am_libh2cmn_la_OBJECTS) AM_V_lt = $(am__v_lt_@AM_V@) am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) @@ -445,6 +445,7 @@ noinst_HEADERS = \ libh2cmn_la_SOURCES = \ str.c \ + utf16.c \ utf8.c @@ -533,6 +534,7 @@ distclean-compile: -rm -f *.tab.c @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/str.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utf16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utf8.Plo@am__quote@ .c.o: diff --git a/lib/cmn/utf16.c b/lib/cmn/utf16.c new file mode 100644 index 0000000..b622213 --- /dev/null +++ b/lib/cmn/utf16.c @@ -0,0 +1,147 @@ +/* + * $Id$ + * + Copyright 2006-2014 Chung, Hyung-Hwan. + This file is part of H2. + + H2 is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation, either version 3 of + the License, or (at your option) any later version. + + H2 is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with H2. If not, see . + */ + +#include

+ +#define LEAD_SURROGATE_MIN 0xD800lu +#define LEAD_SURROGATE_MAX 0xDBFFlu +#define TRAIL_SURROGATE_MIN 0xDC00lu +#define TRAIL_SURROGATE_MAX 0xDFFFlu + +#define IS_SURROGATE(x) ((x) >= LEAD_SURROGATE_MIN && (x) <= TRAIL_SURROGATE_MAX) +#define IS_LEAD_SURROGATE(x) ((x) >= LEAD_SURROGATE_MIN && (x) <= LEAD_SURROGATE_MAX) +#define IS_TRAIL_SURROGATE(x) ((x) >= TRAIL_SURROGATE_MIN && (x) <= TRAIL_SURROGATE_MAX) + +h2_size_t h2_uctoutf16 (h2_wxchar_t uc, h2_wchar_t* utf16, h2_size_t size) +{ +#if (H2_SIZEOF_WXCHAR_T > H2_SIZEOF_WCHAR_T) + + /*if (IS_SURROGATE(uc)) return 0;*/ /* illegal character */ + + if (uc <= 0xFFFFlu) + { + if (utf16 && size >= 1) *utf16 = uc; + return 1; + } + if (uc >= 0x10000lu && uc <= 0x10FFFlu) + { + if (utf16 && size >= 2) + { + h2_uint32_t tmp; + tmp = uc - 0x10000lu; + utf16[0] = LEAD_SURROGATE_MIN | (tmp >> 10); + utf16[1] = TRAIL_SURROGATE_MIN | (tmp & 0x3FFlu); + } + + return 2; + } + else + { + return 0; /* illegal character */ + } + +#elif (H2_SIZEOF_WXCHAR_T == H2_SIZEOF_WCHAR_T) + + /*if (IS_SURROGATE(uc)) return 0;*/ /* illegal character */ + + /* ucs2 is assumed in this case */ + if (utf16 && size >= 1) *utf16 = uc; + + /* small buffer is also indicated by this return value + * greater than 'size'. */ + return 1; + +#else +# error Unsupported size of h2_wxchar_t +#endif +} + +h2_size_t h2_utf16touc ( + const h2_wchar_t* utf16, h2_size_t size, h2_wxchar_t* uc) +{ + H2_ASSERT (utf16 != H2_NULL); + H2_ASSERT (size > 0); + +#if (H2_SIZEOF_WXCHAR_T > H2_SIZEOF_WCHAR_T) + + if (IS_LEAD_SURROGATE(utf16[0])) + { + if (size >= 2) + { + if (IS_TRAIL_SURROGATE(utf16[1])) + { + if (uc) + { + h2_uint32_t tmp = 0x10000lu; + tmp += (utf16[0] & 0x3FFlu) << 10; + tmp += (utf16[1] & 0x3FFlu); + *uc = tmp; + } + + /* this return value can indicate both + * the correct length (size >= 2) + * and + * the incomplete seqeunce error (size < 2). + */ + return 2; + } + else + { + return 0; /* invalid sequence */ + } + } + else return 2; /* this should indicate the incomplete sequence */ + } + else if (IS_TRAIL_SURROGATE(utf16[0])) + { + return 0; /* invalid sequence */ + } + else + { + if (uc) *uc = utf16[0]; + return 1; + } + +#elif (H2_SIZEOF_WXCHAR_T == H2_SIZEOF_WCHAR_T) + + /*if (IS_SURROGATE(utf16[0])) return 0;*/ /* illegal character */ + + /* ucs2 is assumed in this case */ + if (uc) *uc = utf16[0]; + + /* small buffer is also indicated by this return value + * greater than 'size'. */ + return 1; + +#else +# error Unsupported size of h2_wxchar_t +#endif +} + +h2_size_t h2_utf16len (const h2_wchar_t* utf16, h2_size_t size) +{ + return h2_utf16touc (utf16, size, H2_NULL); +} + +h2_size_t h2_utf16lenmax (void) +{ + return H2_UTF16LEN_MAX; +} + diff --git a/lib/test-001.scm b/lib/test-001.scm new file mode 100644 index 0000000..2c8a63e --- /dev/null +++ b/lib/test-001.scm @@ -0,0 +1,56 @@ +; what the +;(+ x (+ c z) (+ y (+ a b))) +;(+ x y z) +;hello-world +;() +;(x . y) +;(x . (y)) +;(x . ((a b c))) +;(x y . ()) +;(x . y z) +;(x . ) +;(() x y z) +;(() . (x y z)) +;(() . (x (y a b c d e . j) z)) +;(() . (x (y a b "hello world" d "so good" . j) z)) + +;'10 +;'(+ x (+ c z) '(+ y (+ a b))) +;(x 'y z) + +;(x . 'y) + + +(+ -10 +20 30) + +( + (lambda (x y) (+ x y)) + 100 200 +) + + +;'(10 20 30) + +'(+ x (+ c z) '(+ y (+ a b))) + +;(define makeOperator +; (lambda (operator) +; (lambda (num1 num2) +; (operator num1 num2)))) +;example useage - equivalent to (* 3 4): +;((makeOperator *) 3 4) + +;(define (makeOperator operator) +; (lambda (num1 num2) +; (operator num1 num2))) + +;(define (makeOperator operator) +; (define (foo num1 num2) +; (operator num1 num2)) +; foo) + +;(define ((foo x) y) (+ x y)) +;(foo 5) +;; => procedure +;((foo 5) 3) +;; => 8 diff --git a/lib/test-002.scm b/lib/test-002.scm new file mode 100644 index 0000000..d432a9e --- /dev/null +++ b/lib/test-002.scm @@ -0,0 +1,10 @@ +;(+ 10000000000000000000000000000000000000000 8 1 2) +;(> 10000000000000000000000000000000000000000 8 2 1) + +;(quotient 10000000000000000000000000000000000000000 2) +;(quotient 110000000000000000000000000000000000000000 10000000000000000000000000000000000000000) +;(remainder 110000000000000000000000000000000000000000 12) +;(- 1) +;(- 1 2) + +(* -102039919912349081209381209810928301928190281203980124098901238091283120983 94589734589734985734985734985734987987321893129381208312 19902838409823409328409238240398) diff --git a/lib/test-003.scm b/lib/test-003.scm new file mode 100644 index 0000000..b552102 --- /dev/null +++ b/lib/test-003.scm @@ -0,0 +1,2 @@ +(setf plus lambda (x y) (+ x y)) +(plus-plus a b)