Re: Attribute String...

[Dave Love <d.love@xxxxxxxx>]

>>>>> "Norman" == Norman Walsh <norm@xxxxxxxxxxxxx> writes:

 Norman> I thought two lists would be easier to maintain (and
 Norman> customize for other alphabets) than an explicitly constructed
 Norman> character-by-character mapping.  I could be wrong...

Probably not.  (You could also search strings rather than lists, but
the constant-time string-ref vs. list-ref probably won't gain much.)
The association lists should be roughly sorted by character frequency,
obviously.

A canonical solution for the lookup would probably use association lists:

(define alist-u-l			; association list indexed on u.c.
  (map cons uppercase-list lowercase-list))

(define alist-l-u
  (map cons lowercase-list uppercase-list))

;(define (tr alist)
;  (lambda (c)
;    (cond ((assoc c alist) => cdr)	; not Jade :-(
;	  (else c))))

(define (tr alist)			; general translation using alist
  (lambda (c)
    (let ((x (assoc c alist)))
      (if x (cdr x) c))))

(define char-downcase (tr alist-u-l))
(define char-upcase (tr alist-l-u))

(define (string-map f s)		; useful abstraction
    (list->string (map f (string->list s))))

(define (string-upcase s)
  (string-map char-upcase s))

Jade doesn't have `assoc' and I don't know if a definition has been
posted:

(define (assoc obj alist)
  (cond ((null? alist) #f)
	((equal? obj (car (car alist)))
	 (car alist))
	(else (assoc obj (cdr alist)))))

You might win a little speed by unfolding some of the definitions if
you really care.

Since `assoc' isn't primitive you might do better generating
double-length lists and using `member' for the search, like:

(define l-u				; '(#\a (#\A) #\b (#\B) ...)
  (apply append (map list lowercase-list (map list uppercase-list))))

(define (char-upcase c)
  (let ((x (member c l-u)))
    (if x
	(list-ref x 1)
	c)))

Or make assoc primitive [do I not like C++ :-(].

--- style/InterpreterMessages.msg     1997/10/06 18:16:20     1.1
+++ style/InterpreterMessages.msg     1997/10/06 18:19:44     1.2
@@ -107,3 +107,4 @@
 I1+stackTraceEllipsis++called from here...(%1 calls omitted)
 E0+processNodeLoop++node processing loop detected
 E0+spliceNotList++unquote-splicing expression does not evaluate to a list
+E3+notAnAlist++%2 argument for primitive %1 of wrong type: %3 not an association list
--- style/primitive.cxx       1997/10/06 18:16:20     1.1
+++ style/primitive.cxx       1997/10/06 18:19:44     1.2
@@ -4294,6 +4294,25 @@
     return interp.makeFalse();
 }

+DEFPRIMITIVE(Assoc, argc, argv, context, interp, loc)
+{
+  ELObj *p = argv[1];
+  while (!p->isNil()) {
+    PairObj *tem = p->asPair();
+    if (!tem)
+      return argError(interp, loc,
+                     InterpreterMessages::notAnAlist, 1, argv[1]);
+    PairObj *tem2 = (tem->car())->asPair();
+    if (!tem2)
+      return argError(interp, loc,
+                     InterpreterMessages::notAnAlist, 1, argv[1]);
+    if (*argv[0] == *tem2->car())
+      return tem2;
+    p = tem->cdr();
+  }
+  return interp.makeFalse();
+}
+
 void Interpreter::installPrimitives()
 {
 #define PRIMITIVE(name, string, nRequired, nOptional, rest) \
--- style/primitive.h 1997/10/06 18:16:20     1.1
+++ style/primitive.h 1997/10/06 18:19:44     1.2
@@ -169,6 +169,7 @@
 PRIMITIVE(NodeListReverse, "node-list-reverse", 1, 0, 0)
 PRIMITIVE(NodeListLength, "node-list-length", 1, 0, 0)
 PRIMITIVE(SgmlParse, "sgml-parse", 1, 0, 1)
+PRIMITIVE(Assoc, "assoc", 2, 0, 0)
 // External procedures
 XPRIMITIVE(ReadEntity, "read-entity", 1, 0, 0)
 XPRIMITIVE(Debug, "debug", 1, 0, 0)

HTH.

 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist