Artifact 763cf966b3818e1284b61b9736268c6e6e53c4752be199c2cabd3def135fbe31:

• File psl-1983/3-1/util/stringx.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2323) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/stringx.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2323) [annotate] [blame] [check-ins using]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% STRINGX - Useful String Functions
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        9 September 1982
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(CompileTime (load fast-int fast-strings common))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Private Macros:

(CompileTime (progn

(put 'make-string 'cmacro % temporary bug fix
  '(lambda (sz init)
	   (mkstring (- sz 1) init)))

)) % End of CompileTime

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(de string-rest (s i)
  (substring s i (string-length s)))

(de string-pad-right (s desired-length)

  % Pad the specified string with spaces on the right side to the specified
  % length.  Returns a new string.

  (let ((len (string-length s)))
    (if (< len desired-length)
      (string-concat s (make-string (- desired-length len) #\space))
      s)))

(de string-pad-left (s desired-length)

  % Pad the specified string with spaces on the left side to the specified
  % length.  Returns a new string.

  (let ((len (string-length s)))
    (if (< len desired-length)
      (string-concat (make-string (- desired-length len) #\space) s)
      s)))

(de string-largest-common-prefix (s1 s2)

  % Return the string that is the largest common prefix of S1 and S2.

  (for (from i 0 (min (string-upper-bound s1) (string-upper-bound s2)) 1)
       (while (= (string-fetch s1 i) (string-fetch s2 i)))
       (returns (substring s1 0 i))
       ))

(de strings-largest-common-prefix (l)

  % Return the string that is the largest common prefix of the elements
  % of L, which must be a list of strings.

  (cond ((null l) "")
	((null (cdr l)) (car l))
	(t
	 (let* ((prefix (car l))
		(limit (string-length prefix))
		)
	   % Prefix[0..LIMIT-1] is the string that is a prefix of all
	   % strings so far examined.

	   (for (in s (cdr l))
		(with i)
		(do (let ((n (string-length s)))
		      (if (< n limit) (setf limit n))
		      )
		    (setf i 0)
		    (while (< i limit)
		      (if (~= (string-fetch prefix i) (string-fetch s i))
		        (setf limit i)
		        (setf i (+ i 1))
		        ))
		    ))
	   (substring prefix 0 limit)
	   ))))