File psl-1983/3-1/kernel/carcdr.red artifact 93d290a6f3 part of check-in trunk

%
% CARCDR.RED - Composites of CAR and CDR, up to 4 levels
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        17 August 1981
% Copyright (c) 1981 University of Utah
%

%  <PSL.INTERP>CARCDR.RED.3,  4-Jul-82 13:29:21, Edit by BENSON
%  CAR and CDR of NIL are legal == NIL

CompileTime for each X in '(		% remove all compiler optimizations
CAAAAR     CAAAR     CAAR		% for CAR and CDR composites
CAAADR     CAADR     CADR	
CAADAR     CADAR     CDAR
CAADDR     CADDR     CDDR
CADAAR     CDAAR
CADADR     CDADR
CADDAR     CDDAR
CADDDR     CDDDR
CDAAAR
CDAADR
CDADAR
CDADDR
CDDAAR
CDDADR
CDDDAR
CDDDDR
) do Put(X, 'SaveCMACRO, RemProp(X, 'CMACRO));

lisp procedure CAAAAR U;		%.
    if null U then NIL
    else if PairP U then CAAAR CAR U else NonPairError(U, 'CAAAAR);

lisp procedure CAAADR U;		%.
    if null U then NIL
    else if PairP U then CAAAR CDR U else NonPairError(U, 'CAAADR);

lisp procedure CAADAR U;		%.
    if null U then NIL
    else if PairP U then CAADR CAR U else NonPairError(U, 'CAADAR);

lisp procedure CAADDR U;		%.
    if null U then NIL
    else if PairP U then CAADR CDR U else NonPairError(U, 'CAADDR);

lisp procedure CADAAR U;		%.
    if null U then NIL
    else if PairP U then CADAR CAR U else NonPairError(U, 'CADAAR);

lisp procedure CADADR U;		%.
    if null U then NIL
    else if PairP U then CADAR CDR U else NonPairError(U, 'CADADR);

lisp procedure CADDAR U;		%.
    if null U then NIL
    else if PairP U then CADDR CAR U else NonPairError(U, 'CADDAR);

lisp procedure CADDDR U;		%.
    if null U then NIL
    else if PairP U then CADDR CDR U else NonPairError(U, 'CADDDR);

lisp procedure CDAAAR U;		%.
    if null U then NIL
    else if PairP U then CDAAR CAR U else NonPairError(U, 'CDAAAR);

lisp procedure CDAADR U;		%.
    if null U then NIL
    else if PairP U then CDAAR CDR U else NonPairError(U, 'CDAADR);

lisp procedure CDADAR U;		%.
    if null U then NIL
    else if PairP U then CDADR CAR U else NonPairError(U, 'CDADAR);

lisp procedure CDADDR U;		%.
    if null U then NIL
    else if PairP U then CDADR CDR U else NonPairError(U, 'CDADDR);

lisp procedure CDDAAR U;		%.
    if null U then NIL
    else if PairP U then CDDAR CAR U else NonPairError(U, 'CDDAAR);

lisp procedure CDDADR U;		%.
    if null U then NIL
    else if PairP U then CDDAR CDR U else NonPairError(U, 'CDDADR);

lisp procedure CDDDAR U;		%.
    if null U then NIL
    else if PairP U then CDDDR CAR U else NonPairError(U, 'CDDDAR);

lisp procedure CDDDDR U;		%.
    if null U then NIL
    else if PairP U then CDDDR CDR U else NonPairError(U, 'CDDDDR);


lisp procedure CAAAR U;			%.
    if null U then NIL
    else if PairP U then CAAR CAR U else NonPairError(U, 'CAAAR);

lisp procedure CAADR U;			%.
    if null U then NIL
    else if PairP U then CAAR CDR U else NonPairError(U, 'CAADR);

lisp procedure CADAR U;			%.
    if null U then NIL
    else if PairP U then CADR CAR U else NonPairError(U, 'CADAR);

lisp procedure CADDR U;			%.
    if null U then NIL
    else if PairP U then CADR CDR U else NonPairError(U, 'CADDR);

lisp procedure CDAAR U;			%.
    if null U then NIL
    else if PairP U then CDAR CAR U else NonPairError(U, 'CDAAR);

lisp procedure CDADR U;			%.
    if null U then NIL
    else if PairP U then CDAR CDR U else NonPairError(U, 'CDADR);

lisp procedure CDDAR U;			%.
    if null U then NIL
    else if PairP U then CDDR CAR U else NonPairError(U, 'CDDAR);

lisp procedure CDDDR U;			%.
    if null U then NIL
    else if PairP U then CDDR CDR U else NonPairError(U, 'CDDDR);


lisp procedure SafeCAR U;
    if null U then NIL
    else if PairP U then CAR U else NonPairError(U, 'CAR);

lisp procedure SafeCDR U;
    if null U then NIL
    else if PairP U then CDR U else NonPairError(U, 'CDR);


lisp procedure CAAR U;			%.
    if null U then NIL
    else if PairP U then SafeCAR CAR U else NonPairError(U, 'CAAR);

lisp procedure CADR U;			%.
    if null U then NIL
    else if PairP U then SafeCAR CDR U else NonPairError(U, 'CADR);

lisp procedure CDAR U;			%.
    if null U then NIL
    else if PairP U then SafeCDR CAR U else NonPairError(U, 'CDAR);

lisp procedure CDDR U;			%.
    if null U then NIL
    else if PairP U then SafeCDR CDR U else NonPairError(U, 'CDDR);

CompileTime for each X in '(		% restore compiler optimizations
CAAAAR     CAAAR     CAAR		% for CAR and CDR composites
CAAADR     CAADR     CADR	
CAADAR     CADAR     CDAR
CAADDR     CADDR     CDDR
CADAAR     CDAAR
CADADR     CDADR
CADDAR     CDDAR
CADDDR     CDDDR
CDAAAR
CDAADR
CDADAR
CDADDR
CDDAAR
CDDADR
CDDDAR
CDDDDR
) do Put(X, 'CMACRO, RemProp(X, 'SaveCMACRO));

END;