source: project/chicken/trunk/srfi-13.import.scm @ 14801

Last change on this file since 14801 was 14801, checked in by felix winkelmann, 11 years ago

string-hash[-ci] redundancy slightly improved

File size: 3.8 KB
Line 
1;;;; srfi-13.import.scm - import library for "srfi-13" module
2;
3; Copyright (c) 2008-2009, The Chicken Team
4; All rights reserved.
5;
6; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
7; conditions are met:
8;
9;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
10;     disclaimer.
11;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
12;     disclaimer in the documentation and/or other materials provided with the distribution.
13;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
14;     products derived from this software without specific prior written permission.
15;
16; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
17; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
18; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
19; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
21; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
22; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
23; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
24; POSSIBILITY OF SUCH DAMAGE.
25
26
27(##sys#register-primitive-module
28 'srfi-13
29 '(check-substring-spec
30   kmp-step
31   make-kmp-restart-vector
32   string->list
33   string-any
34   string-append/shared
35   string-ci<
36   string-ci<=
37   string-ci<>
38   string-ci=
39   string-ci>
40   string-ci>=
41   string-compare
42   string-compare-ci
43   string-concatenate
44   string-concatenate-reverse
45   string-concatenate-reverse/shared
46   string-concatenate/shared
47   string-contains
48   string-contains-ci
49   string-copy
50   string-copy!
51   string-count
52   string-delete
53   string-downcase
54   string-downcase!
55   string-drop
56   string-drop-right
57   string-every
58   string-fill!
59   string-filter
60   string-fold
61   string-fold-right
62   string-for-each
63   string-for-each-index
64   string-index
65   string-index-right
66   string-join
67   string-kmp-partial-search
68   string-map
69   string-map!
70   string-null?
71   string-pad
72   string-pad-right
73   string-parse-final-start+end
74   string-parse-start+end
75   string-prefix-ci?
76   string-prefix-length
77   string-prefix-length-ci
78   string-prefix?
79   string-replace
80   string-reverse
81   string-reverse!
82   string-skip
83   string-skip-right
84   string-suffix-ci?
85   string-suffix-length
86   string-suffix-length-ci
87   string-suffix?
88   string-tabulate
89   string-take
90   string-take-right
91   string-titlecase
92   string-titlecase!
93   string-tokenize
94   string-trim
95   string-trim-both
96   string-trim-right
97   string-unfold
98   string-unfold-right
99   string-upcase
100   string-upcase!
101   string-xcopy!
102   string<
103   string<=
104   string<>
105   string=
106   string>
107   string>=
108   substring-spec-ok?
109   substring/shared
110   xsubstring)
111 `((let-string-start+end 
112    ()
113    ,(##sys#er-transformer
114      (lambda (form r c)
115        (##sys#check-syntax 'let-string-start+end form '(_ _ _ _ _ . _))
116        (let ((s-e-r (cadr form))
117              (proc (caddr form))
118              (s-exp (cadddr form))
119              (args-exp (car (cddddr form)))
120              (body (cdr (cddddr form)))
121              (%receive (r 'receive))
122              (%string-parse-start+end (r 'string-parse-start+end))
123              (%string-parse-final-start+end (r 'string-parse-final-start+end)))
124          (if (pair? (cddr s-e-r))
125              `(,%receive (,(caddr s-e-r) ,(car s-e-r) ,(cadr s-e-r))
126                          (,%string-parse-start+end ,proc ,s-exp ,args-exp)
127                          ,@body)
128              `(,%receive ,s-e-r
129                          (,%string-parse-final-start+end ,proc ,s-exp ,args-exp)
130                          ,@body) ) ))))))
Note: See TracBrowser for help on using the repository browser.