[bpt/guile.git] / srfi / srfi-14.scm

;;;; srfi-14.scm --- SRFI-14 procedures for Guile
;;;;
;;;; 	Copyright (C) 2001 Free Software Foundation, Inc.
;;;; 
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation; either version 2, or
;;;; (at your option) any later version.
;;;; 
;;;; This program 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
;;;; General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA

(define-module (srfi srfi-14))

(export 
;;; General procedures
 char-set?
 char-set=
 char-set<=
 char-set-hash

;;; Iterating over character sets
 char-set-cursor
 char-set-ref
 char-set-cursor-next
 end-of-char-set?
 char-set-fold
 char-set-unfold char-set-unfold!
 char-set-for-each
 char-set-map

;;; Creating character sets
 char-set-copy
 char-set
 list->char-set list->char-set!
 string->char-set string-char-set!
 char-set-filter char-set-filter!
 ucs-range->char-set ucs-range->char-set!
 ->char-set

;;; Querying character sets
 char-set-size
 char-set-count
 char-set->list
 char-set->string
 char-set-contains?
 char-set-every
 char-set-any

;;; Character set algebra
 char-set-adjoin char-set-adjoin!
 char-set-delete char-set-delete!
 char-set-complement
 char-set-union
 char-set-intersection
 char-set-difference
 char-set-xor
 char-set-diff+intersection
 char-set-complement!
 char-set-union!
 char-set-intersection!
 char-set-difference!
 char-set-xor!
 char-set-diff+intersection!

;;; Standard character sets
 char-set:lower-case
 char-set:upper-case
 char-set:title-case
 char-set:letter
 char-set:digit
 char-set:letter+digit
 char-set:graphic
 char-set:printing
 char-set:whitespace
 char-set:iso-control
 char-set:punctuation
 char-set:symbol
 char-set:hex-digit
 char-set:blank
 char-set:ascii
 char-set:empty
 char-set:full
 )

(cond-expand-provide (current-module) '(srfi-14))

(dynamic-call "scm_init_srfi_14" (dynamic-link "libguile-srfi-srfi-13-14"))

(define (->char-set x)
  (cond
   ((string? x)   (string->char-set x))
   ((char? x)     (char-set x))
   ((char-set? x) x)
   (else (error "invalid argument to `->char-set'"))))

(define char-set:full (ucs-range->char-set 0 256))

(define char-set:lower-case (char-set-filter char-lower-case? char-set:full))

(define char-set:upper-case (char-set-filter char-upper-case? char-set:full))

(define char-set:title-case (char-set))

(define char-set:letter (char-set-union char-set:lower-case
					char-set:upper-case))

(define char-set:digit (string->char-set "0123456789"))

(define char-set:letter+digit
  (char-set-union char-set:letter char-set:digit))

(define char-set:punctuation (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}"))

(define char-set:symbol (string->char-set "$+<=>^`|~"))

(define char-set:whitespace (char-set #\space #\newline #\tab #\cr #\vt #\np))

(define char-set:blank (char-set #\space #\tab))

(define char-set:graphic
  (char-set-union char-set:letter+digit char-set:punctuation char-set:symbol))

(define char-set:printing
  (char-set-union char-set:graphic char-set:whitespace))

(define char-set:iso-control
  (char-set-adjoin
   (char-set-filter (lambda (ch) (< (char->integer ch) 31)) char-set:full)
   (integer->char 127)))

(define char-set:hex-digit (string->char-set "0123456789abcdefABCDEF"))

(define char-set:ascii
  (char-set-filter (lambda (ch) (< (char->integer ch) 128)) char-set:full))

(define char-set:empty (char-set))
Commit	Line	Data
ca003b26 MG	1	;;;; srfi-14.scm --- SRFI-14 procedures for Guile
	2	;;;;
	3	;;;; Copyright (C) 2001 Free Software Foundation, Inc.
	4	;;;;
	5	;;;; This program is free software; you can redistribute it and/or
	6	;;;; modify it under the terms of the GNU General Public License as
	7	;;;; published by the Free Software Foundation; either version 2, or
	8	;;;; (at your option) any later version.
	9	;;;;
	10	;;;; This program is distributed in the hope that it will be useful,
	11	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	13	;;;; General Public License for more details.
	14	;;;;
	15	;;;; You should have received a copy of the GNU General Public License
	16	;;;; along with this software; see the file COPYING. If not, write to
	17	;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	18	;;;; Boston, MA 02111-1307 USA
	19
	20	(define-module (srfi srfi-14))
	21
	22	(export
	23	;;; General procedures
	24	char-set?
	25	char-set=
	26	char-set<=
	27	char-set-hash
	28
	29	;;; Iterating over character sets
	30	char-set-cursor
	31	char-set-ref
	32	char-set-cursor-next
	33	end-of-char-set?
	34	char-set-fold
	35	char-set-unfold char-set-unfold!
	36	char-set-for-each
	37	char-set-map
	38
	39	;;; Creating character sets
	40	char-set-copy
	41	char-set
	42	list->char-set list->char-set!
	43	string->char-set string-char-set!
	44	char-set-filter char-set-filter!
	45	ucs-range->char-set ucs-range->char-set!
	46	->char-set
	47
	48	;;; Querying character sets
	49	char-set-size
	50	char-set-count
	51	char-set->list
	52	char-set->string
	53	char-set-contains?
	54	char-set-every
	55	char-set-any
	56
	57	;;; Character set algebra
	58	char-set-adjoin char-set-adjoin!
	59	char-set-delete char-set-delete!
	60	char-set-complement
	61	char-set-union
	62	char-set-intersection
	63	char-set-difference
	64	char-set-xor
65	char-set-diff+intersection
66	char-set-complement!
67	char-set-union!
68	char-set-intersection!
69	char-set-difference!
70	char-set-xor!
71	char-set-diff+intersection!
72
73	;;; Standard character sets
74	char-set:lower-case
75	char-set:upper-case
76	char-set:title-case
77	char-set:letter
78	char-set:digit
79	char-set:letter+digit
80	char-set:graphic
81	char-set:printing
82	char-set:whitespace
83	char-set:iso-control
84	char-set:punctuation
85	char-set:symbol
86	char-set:hex-digit
87	char-set:blank
88	char-set:ascii
89	char-set:empty
90	char-set:full
91	)
92
1b2f40b9 MG	93	(cond-expand-provide (current-module) '(srfi-14))
1b2f40b9 MG	94
94451729	95	(dynamic-call "scm_init_srfi_14" (dynamic-link "libguile-srfi-srfi-13-14"))
ca003b26 MG	96
	97	(define (->char-set x)
	98	(cond
	99	((string? x) (string->char-set x))
	100	((char? x) (char-set x))
	101	((char-set? x) x)
	102	(else (error "invalid argument to `->char-set'"))))
	103
	104	(define char-set:full (ucs-range->char-set 0 256))
	105
	106	(define char-set:lower-case (char-set-filter char-lower-case? char-set:full))
	107
	108	(define char-set:upper-case (char-set-filter char-upper-case? char-set:full))
	109
	110	(define char-set:title-case (char-set))
	111
	112	(define char-set:letter (char-set-union char-set:lower-case
	113	char-set:upper-case))
	114
	115	(define char-set:digit (string->char-set "0123456789"))
	116
	117	(define char-set:letter+digit
	118	(char-set-union char-set:letter char-set:digit))
	119
	120	(define char-set:punctuation (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}"))
	121
	122	(define char-set:symbol (string->char-set "$+<=>^`\|~"))
	123
	124	(define char-set:whitespace (char-set #\space #\newline #\tab #\cr #\vt #\np))
	125
	126	(define char-set:blank (char-set #\space #\tab))
	127
	128	(define char-set:graphic
	129	(char-set-union char-set:letter+digit char-set:punctuation char-set:symbol))
	130
	131	(define char-set:printing
	132	(char-set-union char-set:graphic char-set:whitespace))
	133
	134	(define char-set:iso-control
	135	(char-set-adjoin
	136	(char-set-filter (lambda (ch) (< (char->integer ch) 31)) char-set:full)
	137	(integer->char 127)))
	138
	139	(define char-set:hex-digit (string->char-set "0123456789abcdefABCDEF"))
	140
	141	(define char-set:ascii
	142	(char-set-filter (lambda (ch) (< (char->integer ch) 128)) char-set:full))
	143
	144	(define char-set:empty (char-set))