Artifact 8cc674cb7bd28418e93e26accf17176e87089e62d943ffc32759321aa85c7bb9:

• File psl-1983/kernel/char.red — 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: 1313) [annotate] [blame] [check-ins using] [more...]

%
% CHAR.RED - Character constant macro
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        10 August 1981
% Copyright (c) 1981 University of Utah
%

macro procedure Char U;			%. Character constant macro
    DoChar cadr U;

lisp procedure DoChar U;
begin scalar ChDef, CharFn;
    return if IDP U then
	if (ChDef := get(U, 'CharConst)) then ChDef
	else if (ChDef := ID2Int U) < 128 then ChDef
	else CharError U
    else if PairP U then
    <<  CharFn := car U;
	U := cadr U;
	if CharFn eq 'QUOTE then DoChar U
	else if CharFn eq 'LOWER then LOr(DoChar U, 2#100000)
	else if CharFn memq '(CNTRL CONTROL) then LAnd(DoChar U, 2#11111)
	else if CharFn eq 'META then LOr(DoChar U, 2#10000000)
	else CharError U >>
    else if FixP U and U >= 0 and U <= 9 then U + char !0
    else CharError U;
end;

lisp expr procedure CharError U;
<<  ErrorPrintF("*** Unknown character constant: %r", U);
    0 >>;

DefList('((NULL 0)
	  (BELL 7)
	  (BACKSPACE 8)
	  (TAB 8#11)
	  (LF 8#12)
	  (RETURN 8#12)		% RETURN is LF because it's end-of-line
	  (EOL 8#12)
	  (FF 8#14)
	  (CR 8#15)
	  (ESC 27)
	  (ESCAPE 27)
	  (BLANK 32)
	  (SPACE 32)
	  (RUB 8#177)
	  (RUBOUT 8#177)
	  (DEL 8#177)
	  (DELETE 8#177)), 'CharConst);

END;