Artifact 912833a5f9f6cbe9d169b55659de1c66c340c6171ef9faee2645f502b8df080b:

• File psl-1983/tests/mini-putd-getd.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: 1310) [annotate] [blame] [check-ins using] [more...]

% MINI-PUTD-GETD.RED Small COPYD, GETD, PUTD

on syslisp;

Procedure Getd(fn);
 Begin scalar type;
    if Not IDP fn then return
       <<Prin2 "*** Can only GETD off ID's: ";
         Print fn;
         NIL>>;
    if FunBoundP fn then return NIL;
    if null(type:=Get(fn,'Ftype)) then type:='Expr;
    if FCodeP fn then return ( type . GetFcodePointer fn);
    If FLambdaLinkP fn then return (type .Get(fn,'!*LambdaLink));
    Prin2 "*** GETD should find a LAMBDA or CODE";
    print fn;
    return NIL;
 End;

Procedure PutD(fn,type,body);
 Begin
    if Not IDP fn then return
       <<Prin2 "*** Can only define ID's as functions: ";
         Print fn;
         NIL>>;
    if FCodeP fn then 
       <<Prin2 "*** Redefining a COMPILED function: ";
         Print fn>>
     else if not FunBoundP fn then
       <<prin2 " Redefining function ";
         print fn>>;
    Remprop(fn,'!*LambdaLink);
    Remprop(fn,'Ftype);
    MakeFUnBound fn;
    If LambdaP body then
      << Put(fn,'!*LambdaLink,body);
         MakeFlambdaLink fn>>
     else if CodeP body then
          MakeFcode(fn,body)
     else return  <<Prin2 "*** Body must be a LAMBDA or CODE";
                    prin1 fn; prin2 " "; print body; NIL>>;
    If not(type eq 'expr) then Put(fn,'Ftype,type);
    return fn;
 End;

off syslisp;

End;