Artifact b5488c07e0dd19486b2dc4135de820f4bba00b1c4cc16b006947ca45acd4505b:

• File psl-1983/3-1/util/string-input.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: 2901) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/string-input.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: 2901) [annotate] [blame] [check-ins using]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Input from strings
%%% Cris Perdue
%%% 12/1/82
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(compiletime (load if fast-int))

(fluid '(channel-string channel-string-pos))

%%% Takes two arguments: a string and a function.
%%% The function must take 1 argument.  With-input-from-string
%%% will call the function and pass it a channel number.  If the
%%% function takes input from the channel (which is the point of
%%% all this), it will receive successive characters from the
%%% string as its input.
%%%
%%% This is not currently unwind-protected.

(defun with-input-from-string (str fn)
  (let ((specialreadfunction* 'string-readchar)
	(specialwritefunction* 'readonlychannel)
	(specialclosefunction* 'null)
	(channel-string str) (channel-string-pos 0))
    (let ((chan (open "" 'special))
	  value)
	(setq value (apply fn (list chan)))
	(close chan)
	value)))

%%% This is similar to with-input-from-string, but the string
%%% passed in is effectively padded on the right with a single
%%% blank.  No storage allocation is performed to give this
%%% effect.

(defun with-input-from-terminated-string (str fn)
  (let ((specialreadfunction* 'string-readchar-terminated)
	(specialwritefunction* 'readonlychannel)
	(specialclosefunction* 'null)
	(channel-string str)
	(channel-string-pos 0))
    (let ((chan (open "" 'special))
	  value)
      (setq value (apply fn (list chan)))
      (close chan)
      value)))

%%% Reads from the string.  The string is effectively padded with
%%% a blank at the end so if the expression in the string is for
%%% example a single token, it need not be followed by a terminator.

(defun string-read (str)
  (with-input-from-terminated-string str 'channelread))

%%% Reads a single token from the string using channelreadtoken.
%%% The string need contain no terminator character; a blank is
%%% provided if necessary by string-readtoken.

(defun string-readtoken (str)
  (with-input-from-terminated-string str 'channelreadtoken))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Internal routines.

(defun string-readchar (chan)
  (if (> channel-string-pos (size channel-string)) then
      $eof$
      else
      (prog1
       (indx channel-string channel-string-pos)
       (setq channel-string-pos (+ channel-string-pos 1)))))

%%% Includes hack that tacks on a blank for termination of READ
%%% and friends.

(defun string-readchar-terminated (chan)
  (if (<= channel-string-pos (size channel-string)) then
      (prog1
       (indx channel-string channel-string-pos)
       (setq channel-string-pos (+ channel-string-pos 1)))
      elseif (= channel-string-pos (+ 1 (size channel-string))) then
      (prog1
       32			% Blank
       (setq channel-string-pos (+ channel-string-pos 1)))
      else
      $eof$))