anchor.diff:      (com.informatimago.common-lisp.cesarum.ecma048:generate-all-functions-in-ecma048)))
   
   
  -(deftype string-designator ()
  -  "The type of string designators."
  -  '(or string symbol character))
  -
  -(defun designated-string (object)
  -  "
  -RETURN:   The string designated by the string designator OBJECT.
  -NOTE:     If OBJECT is not a string designator, then signal a TYPE-ERROR.
  -SEE ALSO: PRINC-TO-STRING, PRIN1-TO-STRING.
  -"
  -  (check-type object string-designator)
  -  (typecase object
  -    (string object)
  -    (symbol (symbol-name object))
  -    (character (string object))))
  +
  +(defun symbol-of-name-of-length=1 (object)
  +  "PREDICATE of symbols of name of length = 1"
  +  (and (symbolp object)
  +       (= 1 (length (symbol-name object)))))
  +
  +(defun symbol-of-name-of-length=n (n)
  +  "RETURN: A symbol naming a predicate for a symbol of name of length = N."
  +  (flet ((predicate (object)
  +           (and (symbolp object)
  +                (= n (length (symbol-name object))))))
  +    (let ((name (gensym)))
  +      (setf (symbol-function name) (function predicate))
  +      name)))
  +
  +(deftype string-designator (&optional length)
  +  "
  +STRING-DESIGNATOR       is the type of string designators.
  +\(STRING-DESIGNATOR n)  is the type of string designators of strings of length n.
  +
  +NOTE:    characters are all designators of strings of length 1,
  +         therefore (STRING-DESIGNATOR n) with n/=1 doesn't designate a
  +         CHARACTER.
  +"
  +  (case length
  +    ;; sbcl binds * to length for 'string-designator ; is this conforming?
  +    ((nil *)   '(or character string symbol))
  +    ((1)       '(or character (string 1) (satisfies symbol-of-name-of-length=1)))
  +    (otherwise `(or (string ,length) (satisfies ,(symbol-of-name-of-length=n length))))))
  +
  +
  +(defun test/string-designator ()
  +  (assert (typep "toto" 'string-designator))
  +  (assert (typep 'toto  'string-designator))
  +  (assert (typep #\t    'string-designator))
  +  (assert (not (typep 42 'string-designator)))
  +  (assert (not (typep #(#\a #\b) 'string-designator)))
  +  (assert (not (typep '(#\a #\b) 'string-designator)))
  +  (assert (typep "t"    '(string-designator 1)))
  +  (assert (typep 't     '(string-designator 1)))
  +  (assert (typep #\t    '(string-designator 1)))
  +  (assert (typep "toto" '(string-designator 4)))
  +  (assert (typep 'toto  '(string-designator 4)))
  +  (assert (not (typep "toto" '(string-designator 2))))
  +  (assert (not (typep 'toto  '(string-designator 2))))
  +  (assert (not (typep #\t    '(string-designator 2))))
  +  (assert (not (typep 42 '(string-designator 1))))
  +  (assert (not (typep #(#\a #\b) '(string-designator 2))))
  +  (assert (not (typep '(#\a #\b) '(string-designator 2))))
  +  :success)
  +
  +
  +(deftype character-designator ()
  +  "
  +CHARACTER-DESIGNATOR is the type of character or designators of
  +                     strings of length 1.
  +"
  +  ;; note: (subtypep 'character '(string-designator 1)), but it's
  +  ;; expected to be more efficient this way:
  +  
  +  '(or character (string-designator 1)))
  +
  +
  +
  +(defun test/character-designator ()
  +  (assert (typep "t"    'character-designator))
  +  (assert (typep 't     'character-designator))
  +  (assert (typep #\t    'character-designator))
  +  (assert (not (typep "toto" 'character-designator)))
  +  (assert (not (typep 'toto  'character-designator)))
  +  (assert (not (typep 42     'character-designator)))
  +  (assert (not (typep #(#\a) 'character-designator)))
  +  (assert (not (typep '(#\a) 'character-designator)))
  +  :success)
  +
  +
  +
  +(defun concatenate-strings (list-of-string-designators)
  +  "
  +LIST-OF-STRING-DESIGNATORS:
  +                 EACH element may be either a string-designator,
  +                 or a list containing a string-designator, and a start and end position
  +                 denoting a substring.
  +
  +RETURN:          A string containing the concatenation of the strings
  +                 of the LIST-OF-STRINGS.
  +"
  +  (flet ((slength (string)
  +           (if (stringp string)
  +               (length string)
  +               (- (or (third string) (length (first string)))
  +                  (second string)))))
  +    (loop
  +      :with strings = (mapcar (lambda (item)
  +                                (if (consp item)
  +                                    (list (string (first item))
  +                                          (second item)
  +                                          (third item))
  +                                    (string item)))
  +                              list-of-string-designators)
  +      :with result = (make-string (reduce (function +) strings :key (function slength)))
  +      :for pos = 0
  +      :then (+ pos (slength string))
  +      :for string :in strings
  +      :do (if (stringp string)
  +              (replace result string :start1 pos)
  +              (replace result (first string) :start1 pos
  +                       :start2 (second string) :end2 (third string)))
  +      :finally (return result))))
   
   
   (defun test/concatenate-strings ()
  
positive.code:         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
          "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY")
    (:export
     "STRING-DESIGNATOR" "DESIGNATED-STRING"
     "LOCALIZE" "DEFTRANSLATION" "STRING-JUSTIFY-LEFT" "STRING-PAD"
     "PREFIXP" "SUFFIXP"
     "SPLIT-NAME-VALUE" "STRING-REPLACE" "UNSPLIT-STRING" "SPLIT-STRING"
  
negative.code: 
  
  (defun test ()
    (test/string-designator)
    (test/character-designator)
    (test/concatenate-strings)
    (test/implode-explode))
  
  (test)
  
  
  ;;;; THE END ;;;;
  