FEAT/CHANGE: added support for case-sensitivity of map! keys

implements: Oldes/Rebol-issues#2294

With this commit maps should be compatible with Red language, where creation is case sensitive, selection is by default case insensitive unless `/case` refinement is used.

Author: Oldes

src/core/t-map.c

@@ -162,7 +162,7 @@
 	} else {
 		while (NZ(n = hashes[hash])) {
 			val = BLK_SKIP(series, (n-1) * wide);
-			if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
+			if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, cased)) return hash;
 			hash += skip;
 			if (hash >= len) hash -= len;
 		}
@@ -199,15 +199,15 @@
 
 	val = BLK_HEAD(series);
 	for (n = 0; n < series->tail; n += 2, val += 2) {
-		key = Find_Key(series, series->series, val, 2, 0, 0);
+		key = Find_Key(series, series->series, val, 2, TRUE, 0);
 		hashes[key] = n/2+1;
 	}
 }
 
 
 /***********************************************************************
 **
-*/	static REBCNT Find_Entry(REBSER *series, REBVAL *key, REBVAL *val)
+*/	static REBCNT Find_Entry(REBSER *series, REBVAL *key, REBVAL *val, REBOOL cased)
 /*
 **		Try to find the entry in the map. If not found
 **		and val is SET, create the entry and store the key and
@@ -231,7 +231,7 @@
 		Rehash_Hash(series);
 	}
 
-	hash = Find_Key(series, hser, key, 2, 0, 0);
+	hash = Find_Key(series, hser, key, 2, cased, 0);
 	hashes = (REBCNT*)hser->data;
 	n = hashes[hash];
 
@@ -313,7 +313,7 @@
 		!IS_INTEGER(pvs->select) && !IS_CHAR(pvs->select))
 		return PE_BAD_SELECT;
 
-	n = Find_Entry(VAL_SERIES(data), pvs->select, val);
+	n = Find_Entry(VAL_SERIES(data), pvs->select, val, FALSE);
 
 	if (!n) return PE_NONE;
 
@@ -333,7 +333,7 @@
 
 	val = VAL_BLK_DATA(arg);
 	for (n = 0; n < len && NOT_END(val) && NOT_END(val+1); val += 2, n += 2) {
-		Find_Entry(ser, val, val+1);
+		Find_Entry(ser, val, val+1, TRUE);
 	}
 }
 
@@ -488,7 +488,7 @@
 
 	case A_PICK:		// same as SELECT for MAP! datatype
 	case A_SELECT:
-		n = Find_Entry(series, arg, 0);
+		n = Find_Entry(series, arg, 0, Find_Refines(ds, AM_SELECT_CASE) ? AM_FIND_CASE : 0);
 		if (!n) return R_NONE;
 		*D_RET = *VAL_BLK_SKIP(val, ((n-1)*2)+1);
 		break;
@@ -505,11 +505,11 @@
 		break;
 
 	case A_PUT:
-		Find_Entry(series, arg, D_ARG(3));
+		Find_Entry(series, arg, D_ARG(3), Find_Refines(ds, AM_PUT_CASE) ? AM_FIND_CASE : 0);
 		return R_ARG3;
 
 	case A_POKE:  // CHECK all pokes!!! to be sure they check args now !!!
-		Find_Entry(series, arg, D_ARG(3));
+		Find_Entry(series, arg, D_ARG(3), FALSE);
 		*D_RET = *D_ARG(3);
 		break;
 

src/tests/units/map-test.r3

@@ -28,6 +28,39 @@ Rebol [
 		--assert 2 = m/b
 		--assert empty? #()
 
+	--test-- "case sensitivity"
+		m: #(
+			 <a> 1   <A> 2   <ab> 3   <Ab> 4
+			 %a  5   %A  6   %ab  7   %Ab  8
+			 "a" 9   "A" 10  "ab" 11  "Ab" 12
+			  a  13   A  14   ab  15   Ab  16
+			 @a  17  @A  18   @ab 19  @Ab  20
+			#"a" 21 #"A" 22 #{61} 23 #{41} 24
+		)
+		--assert 24 = length? m
+		--assert 1  = select m <A>
+		--assert 5  = select m %A
+		--assert 9  = select m "A"
+		--assert 13 = select m 'A
+		--assert 17 = select m @A
+		--assert 21 = select m #"A"
+		--assert 24 = select m #{41} ; always case sensitive
+		--assert 24 = length? m
+		--assert 2  = select/case m <A>
+		--assert 6  = select/case m %A
+		--assert 10 = select/case m "A"
+		--assert 14 = select/case m 'A
+		--assert 18 = select/case m @A
+		--assert 22 = select/case m #"A"
+		--assert 24 = select/case m #{41}
+		--assert 1  = m/(<A>)
+		--assert 5  = m/(%A)
+		--assert 9  = m/("A")
+		--assert 13 = m/('A)
+		--assert 17 = m/(@A)
+		--assert 21 = m/(#"A")
+
+
 ===end-group===
 
 ===start-group=== "map issues"

src/tools/make-headers.r

@@ -331,6 +331,7 @@ acts: load %../boot/actions.r
 foreach word [
 	copy
 	find
+	put
 	select
 	insert
 	trim