(if (string=? "" value)
'()
(map string->cp (splitter value)))))
- (lambda (char-expr) `(list ,char-expr))
- (lambda (svs-expr) `(map integer->char ,svs-expr))))
+ (lambda (char-expr) `(string ,char-expr))
+ (lambda (svs-expr) `(string* (map integer->char ,svs-expr)))))
\f
(define value-manager:byte
(value-manager "0"
(error:illegal-number string))))
(define (parse-atom port db prefix)
- (let ((port* (open-output-string))
+ (let ((builder (string-builder))
(atom-delimiters (db-atom-delimiters db)))
(define (%peek)
(define %emit
(if (db-fold-case? db)
(lambda (char)
- (for-each (lambda (char*)
- (write-char char* port*))
- (char-foldcase-full char)))
+ (builder (char-foldcase-full char)))
(lambda (char)
- (write-char char port*))))
+ (builder char))))
(let loop ()
(let ((char (%peek)))
(if (or (eof-object? char)
(char-in-set? char atom-delimiters))
- (get-output-string port*)
+ (builder)
(begin
(%discard)
(%emit char)
(declare (usual-integrations))
\f
(define (ucd-cf-value char)
- (hash-table-ref char-map:case-folding char (lambda () (list char))))
+ (hash-table-ref char-map:case-folding char (lambda () (string char))))
(define-deferred char-map:case-folding
(let ((table (make-non-pointer-hash-table)))
(for-each
(lambda (p)
- (hash-table-set! table (integer->char (car p)) (map integer->char (cdr p))))
+ (hash-table-set! table (integer->char (car p)) (string* (map integer->char (cdr p)))))
'((65 97) (66 98) (67 99) (68 100) (69 101) (70 102) (71 103) (72 104) (73 105) (74 106) (75 107) (76 108) (77 109) (78 110) (79 111) (80 112) (81 113) (82 114) (83 115) (84 116) (85 117) (86 118) (87 119) (88 120) (89 121) (90 122) (181 956) (192 224) (193 225) (194 226) (195 227) (196 228) (197 229) (198 230) (199 231) (200 232) (201 233) (202 234) (203 235) (204 236) (205 237) (206 238) (207 239) (208 240) (209 241) (210 242) (211 243) (212 244) (213 245) (214 246) (216 248) (217 249) (218 250) (219 251) (220 252) (221 253) (222 254) (223 115 115) (256 257)
(258 259) (260 261) (262 263) (264 265) (266 267) (268 269) (270 271) (272 273) (274 275) (276 277) (278 279) (280 281) (282 283) (284 285) (286 287) (288 289) (290 291) (292 293) (294 295) (296 297) (298 299) (300 301) (302 303) (304 105 775) (306 307) (308 309) (310 311) (313 314) (315 316) (317 318) (319 320) (321 322) (323 324) (325 326) (327 328) (329 700 110) (330 331) (332 333) (334 335) (336 337) (338 339) (340 341) (342 343) (344 345) (346 347) (348 349) (350 351) (352 353) (354 355) (356 357) (358 359) (360 361) (362 363) (364 365) (366 367) (368 369) (370 371) (372 373) (374 375)
(376 255) (377 378) (379 380) (381 382) (383 115) (385 595) (386 387) (388 389) (390 596) (391 392) (393 598) (394 599) (395 396) (398 477) (399 601) (400 603) (401 402) (403 608) (404 611) (406 617) (407 616) (408 409) (412 623) (413 626) (415 629) (416 417) (418 419) (420 421) (422 640) (423 424) (425 643) (428 429) (430 648) (431 432) (433 650) (434 651) (435 436) (437 438) (439 658) (440 441) (444 445) (452 454) (453 454) (455 457) (456 457) (458 460) (459 460) (461 462) (463 464) (465 466) (467 468) (469 470) (471 472) (473 474) (475 476) (478 479) (480 481) (482 483) (484 485)
(declare (usual-integrations))
\f
(define (ucd-dm-value char)
- (hash-table-ref char-map:decomposition-mapping char (lambda () (list char))))
+ (hash-table-ref char-map:decomposition-mapping char (lambda () (string char))))
(define-deferred char-map:decomposition-mapping
(let ((table (make-non-pointer-hash-table)))
(for-each
(lambda (p)
- (hash-table-set! table (integer->char (car p)) (map integer->char (cdr p))))
+ (hash-table-set! table (integer->char (car p)) (string* (map integer->char (cdr p)))))
'((160 32) (168 32 776) (170 97) (175 32 772) (178 50) (179 51) (180 32 769) (181 956) (184 32 807) (185 49) (186 111) (188 49 8260 52) (189 49 8260 50) (190 51 8260 52) (192 65 768) (193 65 769) (194 65 770) (195 65 771) (196 65 776) (197 65 778) (199 67 807) (200 69 768) (201 69 769) (202 69 770) (203 69 776) (204 73 768)
(205 73 769) (206 73 770) (207 73 776) (209 78 771) (210 79 768) (211 79 769) (212 79 770) (213 79 771) (214 79 776) (217 85 768) (218 85 769) (219 85 770) (220 85 776) (221 89 769) (224 97 768) (225 97 769) (226 97 770) (227 97 771) (228 97 776) (229 97 778) (231 99 807) (232 101 768) (233 101 769) (234 101 770) (235 101 776) (236 105 768)
(237 105 769) (238 105 770) (239 105 776) (241 110 771) (242 111 768) (243 111 769) (244 111 770) (245 111 771) (246 111 776) (249 117 768) (250 117 769) (251 117 770) (252 117 776) (253 121 769) (255 121 776) (256 65 772) (257 97 772) (258 65 774) (259 97 774) (260 65 808) (261 97 808) (262 67 769) (263 99 769) (264 67 770) (265 99 770) (266 67 775)
(declare (usual-integrations))
\f
(define (ucd-lc-value char)
- (hash-table-ref char-map:lower-case char (lambda () (list char))))
+ (hash-table-ref char-map:lower-case char (lambda () (string char))))
(define-deferred char-map:lower-case
(let ((table (make-non-pointer-hash-table)))
(for-each
(lambda (p)
- (hash-table-set! table (integer->char (car p)) (map integer->char (cdr p))))
+ (hash-table-set! table (integer->char (car p)) (string* (map integer->char (cdr p)))))
'((65 97) (66 98) (67 99) (68 100) (69 101) (70 102) (71 103) (72 104) (73 105) (74 106) (75 107) (76 108) (77 109) (78 110) (79 111) (80 112) (81 113) (82 114) (83 115) (84 116) (85 117) (86 118) (87 119) (88 120) (89 121) (90 122) (192 224) (193 225) (194 226) (195 227) (196 228) (197 229) (198 230) (199 231) (200 232) (201 233) (202 234) (203 235) (204 236) (205 237) (206 238) (207 239) (208 240) (209 241) (210 242) (211 243) (212 244) (213 245) (214 246) (216 248) (217 249) (218 250) (219 251) (220 252) (221 253) (222 254) (256 257) (258 259) (260 261) (262 263) (264 265) (266 267) (268 269) (270 271) (272 273) (274 275)
(276 277) (278 279) (280 281) (282 283) (284 285) (286 287) (288 289) (290 291) (292 293) (294 295) (296 297) (298 299) (300 301) (302 303) (304 105 775) (306 307) (308 309) (310 311) (313 314) (315 316) (317 318) (319 320) (321 322) (323 324) (325 326) (327 328) (330 331) (332 333) (334 335) (336 337) (338 339) (340 341) (342 343) (344 345) (346 347) (348 349) (350 351) (352 353) (354 355) (356 357) (358 359) (360 361) (362 363) (364 365) (366 367) (368 369) (370 371) (372 373) (374 375) (376 255) (377 378) (379 380) (381 382) (385 595) (386 387) (388 389) (390 596) (391 392) (393 598) (394 599) (395 396) (398 477) (399 601) (400 603) (401 402) (403 608)
(404 611) (406 617) (407 616) (408 409) (412 623) (413 626) (415 629) (416 417) (418 419) (420 421) (422 640) (423 424) (425 643) (428 429) (430 648) (431 432) (433 650) (434 651) (435 436) (437 438) (439 658) (440 441) (444 445) (452 454) (453 454) (455 457) (456 457) (458 460) (459 460) (461 462) (463 464) (465 466) (467 468) (469 470) (471 472) (473 474) (475 476) (478 479) (480 481) (482 483) (484 485) (486 487) (488 489) (490 491) (492 493) (494 495) (497 499) (498 499) (500 501) (502 405) (503 447) (504 505) (506 507) (508 509) (510 511) (512 513) (514 515) (516 517) (518 519) (520 521) (522 523) (524 525) (526 527) (528 529) (530 531) (532 533)
(declare (usual-integrations))
\f
(define (ucd-tc-value char)
- (hash-table-ref char-map:title-case char (lambda () (list char))))
+ (hash-table-ref char-map:title-case char (lambda () (string char))))
(define-deferred char-map:title-case
(let ((table (make-non-pointer-hash-table)))
(for-each
(lambda (p)
- (hash-table-set! table (integer->char (car p)) (map integer->char (cdr p))))
+ (hash-table-set! table (integer->char (car p)) (string* (map integer->char (cdr p)))))
'((97 65) (98 66) (99 67) (100 68) (101 69) (102 70) (103 71) (104 72) (105 73) (106 74) (107 75) (108 76) (109 77) (110 78) (111 79) (112 80) (113 81) (114 82) (115 83) (116 84) (117 85) (118 86) (119 87) (120 88) (121 89) (122 90) (181 924) (223 83 115) (224 192) (225 193) (226 194) (227 195) (228 196) (229 197) (230 198) (231 199) (232 200) (233 201) (234 202) (235 203) (236 204) (237 205) (238 206) (239 207) (240 208) (241 209) (242 210) (243 211) (244 212) (245 213) (246 214) (248 216) (249 217) (250 218) (251 219) (252 220) (253 221) (254 222) (255 376) (257 256)
(259 258) (261 260) (263 262) (265 264) (267 266) (269 268) (271 270) (273 272) (275 274) (277 276) (279 278) (281 280) (283 282) (285 284) (287 286) (289 288) (291 290) (293 292) (295 294) (297 296) (299 298) (301 300) (303 302) (305 73) (307 306) (309 308) (311 310) (314 313) (316 315) (318 317) (320 319) (322 321) (324 323) (326 325) (328 327) (329 700 78) (331 330) (333 332) (335 334) (337 336) (339 338) (341 340) (343 342) (345 344) (347 346) (349 348) (351 350) (353 352) (355 354) (357 356) (359 358) (361 360) (363 362) (365 364) (367 366) (369 368) (371 370) (373 372) (375 374) (378 377)
(380 379) (382 381) (383 83) (384 579) (387 386) (389 388) (392 391) (396 395) (402 401) (405 502) (409 408) (410 573) (414 544) (417 416) (419 418) (421 420) (424 423) (429 428) (432 431) (436 435) (438 437) (441 440) (445 444) (447 503) (452 453) (454 453) (455 456) (457 456) (458 459) (460 459) (462 461) (464 463) (466 465) (468 467) (470 469) (472 471) (474 473) (476 475) (477 398) (479 478) (481 480) (483 482) (485 484) (487 486) (489 488) (491 490) (493 492) (495 494) (496 74 780) (497 498) (499 498) (501 500) (505 504) (507 506) (509 508) (511 510) (513 512) (515 514) (517 516) (519 518)
(declare (usual-integrations))
\f
(define (ucd-uc-value char)
- (hash-table-ref char-map:upper-case char (lambda () (list char))))
+ (hash-table-ref char-map:upper-case char (lambda () (string char))))
(define-deferred char-map:upper-case
(let ((table (make-non-pointer-hash-table)))
(for-each
(lambda (p)
- (hash-table-set! table (integer->char (car p)) (map integer->char (cdr p))))
+ (hash-table-set! table (integer->char (car p)) (string* (map integer->char (cdr p)))))
'((97 65) (98 66) (99 67) (100 68) (101 69) (102 70) (103 71) (104 72) (105 73) (106 74) (107 75) (108 76) (109 77) (110 78) (111 79) (112 80) (113 81) (114 82) (115 83) (116 84) (117 85) (118 86) (119 87) (120 88) (121 89) (122 90) (181 924) (223 83 83) (224 192) (225 193) (226 194) (227 195) (228 196) (229 197) (230 198) (231 199) (232 200) (233 201) (234 202) (235 203) (236 204) (237 205) (238 206) (239 207) (240 208) (241 209) (242 210) (243 211) (244 212) (245 213) (246 214) (248 216) (249 217) (250 218) (251 219) (252 220) (253 221) (254 222) (255 376)
(257 256) (259 258) (261 260) (263 262) (265 264) (267 266) (269 268) (271 270) (273 272) (275 274) (277 276) (279 278) (281 280) (283 282) (285 284) (287 286) (289 288) (291 290) (293 292) (295 294) (297 296) (299 298) (301 300) (303 302) (305 73) (307 306) (309 308) (311 310) (314 313) (316 315) (318 317) (320 319) (322 321) (324 323) (326 325) (328 327) (329 700 78) (331 330) (333 332) (335 334) (337 336) (339 338) (341 340) (343 342) (345 344) (347 346) (349 348) (351 350) (353 352) (355 354) (357 356) (359 358) (361 360) (363 362) (365 364) (367 366) (369 368) (371 370) (373 372)
(375 374) (378 377) (380 379) (382 381) (383 83) (384 579) (387 386) (389 388) (392 391) (396 395) (402 401) (405 502) (409 408) (410 573) (414 544) (417 416) (419 418) (421 420) (424 423) (429 428) (432 431) (436 435) (438 437) (441 440) (445 444) (447 503) (453 452) (454 452) (456 455) (457 455) (459 458) (460 458) (462 461) (464 463) (466 465) (468 467) (470 469) (472 471) (474 473) (476 475) (477 398) (479 478) (481 480) (483 482) (485 484) (487 486) (489 488) (491 490) (493 492) (495 494) (496 74 780) (498 497) (499 497) (501 500) (505 504) (507 506) (509 508) (511 510) (513 512)
(end (string-length string)))
(do ((index 0 (fix:+ index 1)))
((not (fix:< index end)))
- (for-each builder (transform (string-ref string index))))
+ (builder (transform (string-ref string index))))
(builder)))
(define (string-titlecase string)
(let ((char (string-ref string index)))
(if (char-cased? char)
(begin
- (for-each builder (char-titlecase-full char))
+ (builder (char-titlecase-full char))
(do ((index (fix:+ index 1) (fix:+ index 1)))
((not (fix:< index end)))
- (for-each builder
- (char-downcase-full (string-ref string index)))))
+ (builder (char-downcase-full (string-ref string index)))))
(begin
(builder char)
(loop (fix:+ index 1))))))))
(builder (string-builder)))
(do ((i 0 (fix:+ i 1)))
((not (fix:< i end)))
- (for-each builder (ucd-dm-value (string-ref string i))))
+ (builder (ucd-dm-value (string-ref string i))))
(builder)))
(define (canonical-ordering! string)
projects / mit-scheme.git / commitdiff