From b6a7ebf1845ca0ba688f90f12c70b0636f00f7d6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 23 Aug 2008 22:35:29 -0500
Subject: [PATCH] Fix map-case

---
 basis/unicode/case/case-tests.factor |  4 ++++
 basis/unicode/case/case.factor       | 26 +++++++++++++++++---------
 2 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor
index 531fa2faab..6401ce201e 100755
--- a/basis/unicode/case/case-tests.factor
+++ b/basis/unicode/case/case-tests.factor
@@ -1,5 +1,9 @@
 USING: unicode.case tools.test namespaces ;
 
+\ >upper must-infer
+\ >lower must-infer
+\ >title must-infer
+
 [ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
 [ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
 [ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor
index c377bda462..f0f8b4821c 100755
--- a/basis/unicode/case/case.factor
+++ b/basis/unicode/case/case.factor
@@ -1,6 +1,6 @@
-USING: kernel unicode.data sequences sequences.next namespaces
+USING: unicode.data sequences sequences.next namespaces
 unicode.normalize math unicode.categories combinators
-assocs strings splitting ;
+assocs strings splitting kernel ;
 IN: unicode.case
 
 : at-default ( key assoc -- value/key ) over >r at r> or ;
@@ -70,15 +70,23 @@ SYMBOL: locale ! Just casing locale, or overall?
 : final-sigma ( string -- string )
     HEX: 3A3 over member? [ sigma-map ] when ;
 
+! : map-case ( string string-quot char-quot -- case )
+!     [
+!         rot [
+!             -rot [
+!                 rot dup special-casing at
+!                 [ -rot drop call % ]
+!                 [ -rot nip call , ] ?if
+!             ] 2keep
+!         ] each 2drop
+!     ] "" make ; inline
+
 : map-case ( string string-quot char-quot -- case )
     [
-        rot [
-            -rot [
-                rot dup special-casing at
-                [ -rot drop call % ]
-                [ -rot nip call , ] ?if
-            ] 2keep
-        ] each 2drop
+        [
+            [ dup special-casing at ] 2dip
+            [ [ % ] compose ] [ [ , ] compose ] bi* ?if
+        ] 2curry each
     ] "" make ; inline
 
 : >lower ( string -- lower )