perm filename XFORMS[1,LMM] blob sn#030255 filedate 1973-03-08 generic text, type T, neo UTF8
  (FILECREATED " 8-MAR-73 14:44:41")
(DEFINEQ

(@1
  (LAMBDA (X M)
    (COND
      ((OR (NULL X)
           (NUMBERP X)
           (STRINGP X)
           (EQ X T))
        X)
      ((SETQ M (@2 X M))
        M)
      (T (LIST (QUOTE QUOTE)
               X)))))

(@2
  (LAMBDA (X N)
    (COND
      ((ATOM X)
        NIL)
      ((EQ (CAR X)
           (QUOTE ≠))
        (COND
          ((ATOM (CDR X))
            (CDR X))
          ((NULL (CDDR X))
            (LIST (QUOTE LIST)
                  (CADR X)))
          (T ((LAMBDA (D E)
                 (COND
                   ((EQ (CAR D)
                        (QUOTE LIST))
                     (CONS (QUOTE LIST)
                           (CONS E (CDR D))))
                   (T (LIST (QUOTE CONS)
                            E D))))
               (@1 (CDDR X))
               (CADR X)))))
      ((NULL (CDR X))
        (COND
          ((SETQ N (@2 (CAR X)
                       N))
            (LIST (QUOTE LIST)
                  N))
          (T NIL)))
      (T (PROG (M)
               (SETQ M (@2 (CAR X)
                           N))
               (SETQ N (@2 (CDR X)
                           N))
               (COND
                 ((AND (NULL M)
                       (NULL N))
                   (RETURN NIL)))
               (COND
                 ((AND (NULL M)
                       (SETQ M (CAR X))
                       (NOT (NUMBERP M))
                       (NOT (EQ M T))
                       (NOT (STRINGP M)))
                   (SETQ M (LIST (QUOTE QUOTE)
                                 M))))
               (RETURN (COND
                         ((EQ (CAR N)
                              (QUOTE LIST))
                           (CONS (CAR N)
                                 (CONS M (CDR N))))
                         (T (LIST (QUOTE CONS)
                                  M
                                  (COND
                                    ((AND (NULL N)
                                          (SETQ N (CDR X))
                                          (NOT (NUMBERP N))
                                          (NOT (EQ N T)))
                                      (LIST (QUOTE QUOTE)
                                            N))
                                    (T N)))))))))))
)
  (LISPXPRINT (QUOTE XFORMSFNS)
              T)
  (RPAQQ XFORMSFNS (@1 @2))
  (LISPXPRINT (QUOTE XFORMSVARS)
              T)
  (RPAQQ XFORMSVARS ((VARS (#RPARS))
          (TRANSAVE)))
  (RPAQ #RPARS)
  (RPAQQ DUMPFILE 360TO1.6)
  (RPAQQ USERNOTES ((APPLY/EVAL (* TRANSOR will translate the arguments 
                                   of the APPLY or EVAL expression, but 
                                   the user must make sure that the 
                                   run-time evaluation of the arguments 
                                   returns a BBN-compatible expression.)
                                )
          (ARRAYS (* Array function. No transformations for these 
                     functions have been composed yet.))
          (COMMON (* %% COMMON VARIABLES ARE NOT USED IN LISP 1.6; ALL 
                     VARIABLES ARE EITHER SPECIAL OR REGULAR
                     (I THINK)
                     %. THE CSET- HERE HAS BEEN CHANGED TO A REGULAR 
                     SET-))
          (DEBUG: (* %% THIS DIDN'T DO ANYTHING IN LISP 1.5!!!!))
          (DEFPROP-MACRO (* * macro properties go here eventually.))
          (EXPLODE: (* %% LISP 1.5 EXPLODE CREATES ALL CHARACTERS
                       (I.E., (EXPLODE (QUOTE A123))
                              WILL RESULT IN A LIST OF 4 CHARACTERS)
                       %. LISP 1.6 MAKES THE 1, 2 AND 3 INTO NUMBERS))
          (FDEFPROP (* Funny DEFINE: too few args. Translation of it 
                       abandoned.))
          (FEATURE (* %% THIS FEATURE IS NOT AVAILABLE IN LISP 1.6 AND 
                      MUST BE RECODED))
          (FILES (* %% IO FUNCTIONS DIFFER ON THE 360 AND THE PDP-10. 
                    ONLY A WEAK ATTEMPT HAS BEEN MADE TO TRANSLATE THE 
                    CODE. THE USER NEEDS TO EXAMINE THE CODE CAREFULLY 
                    AND MAKE SURE THAT IT IS DOING WHAT IS EXPECTED))
          (GENSYM1: (* %% GENSYM DOESN'T TAKE AN ARG HERE))
          (INTERN (* No direct match for INTERN exists on BBN Lisp.))
          (IOFNS (* Random grubby IO functions, documented in chapter 
                    14 of SAILON 28.2, which I am too lazy to fix up.))
          (LABEL (* The LABEL device is not implemented in BBN lisp.))
          (LAZY (* I did not really expect this fn to appear and will
                   (may)
                   write TRANSFORMATIONS for it if it does.))
          (LOGP: (* %% NO LOGICAL NUMBERS IN LISP 1.6))
          (MACHINE-CODE (* Expression dependent on machine-code. User 
                           must recode.))
          (MKATOM (* %% CREATING ATOMS IS HANDLED DIFFERENTLY - COLLECT 
                     A LIST AND THEN CALL READLIST ON IT, RATHER THAN 
                     USING RLIT, RNUMB AND MKATOM - THIS EXPRESSION 
                     HASN'T BEEN CHANGED, BUT I COULD WORK UP A 
                     TRANSFORMATION IN TERMS OF SOME SPECIAL VARIABLE 
                     DO DO IT IF REQUIRED))
          (SPEC (* %% THE FUNCTION SPECIAL MUST BE DEFINED FOR THE 
                   PROGRAM TO WORK))
          (UDF (* This function is not defined directly in BBN Lisp))))
  (RPAQQ NLISTPCOMS ((IF (EQ (##)
                             (QUOTE @))
                         (UP (I 2 (@1 (## 2)))
                             (1))
                         NIL)))
  (RPAQQ LAMBDACOMS
         ((IF (NULL (EQ (CAAAR L)
                        (QUOTE LAMBDA)))
              ((REMARK BLAMBDA1))
              ((IF (NEQ (LENGTH (## (NTH 2)))
                        (LENGTH (## 1 2)))
                   ((REMARK BLAMBDA2))
                   NIL)
               MARK
               (ORR (1 (NTH 3)
                       DOTHESE)
                    ((REMARK BLAMBDA3)))
               ←←
               (NTH 2)
               DOTHESE))))
  (RPAQQ TRANSFORMATIONS
         (APPEND1 APPLY ASA ATTRIB BPSCHKPT BPSLEFT BPSMOVE BPSRESTR 
                  BPSUSED BPSWIPE BPSZ BREAKP CHKPOINT CLOSE COMMON 
                  COMPILE COND COUNT CSET CSETQ DEBUG DEFINE DEFLIST 
                  DIGP EJECT EVAL EVCON EVENP EVLIS EXCISE EXITERR 
                  EXPLODE EXPT FIXP FLAG FLAGP FLOAT FLOATP FUNCTION 
                  GENSYM1 INLL LAP360 LEFTSHIFT LETP LITP LOGAND LOGOR 
                  LOGP LOGXOR MAPCAR MAX MIN MKATOM OPEN OPTIMIZE 
                  ORDERP OTLL OVOFF PAIR PAIRMAP PLANT PLANT1 PLANTDC 
                  PLANTSQ PRBUFFER PRINLAP PROG QUOTE RDS READCH RECIP 
                  RECLAIM RELINK REMFLAG REMOB RESTORE RLIT RNUMB SET 
                  SPEAK SPECIAL SUBLIS TRACE TTAB UNCOMMON UNTRACE 
                  VERBOS WRS XTAB))
(DEFLIST(QUOTE(
  (APPEND1 ((1 NCONC)
            3
            (MBD LIST)))
  (APPLY ((REMARK APPLY/EVAL)))
  (ASA ((REMARK FEATURE)
        (MBD QUOTE)))
  (ATTRIB ((REMARK LAZY)))
  (BPSCHKPT ((REMARK FEATURE)
             (MBD QUOTE)))
  (BPSLEFT ((REMARK FEATURE)
            (MBD QUOTE)))
  (BPSMOVE ((REMARK FEATURE)
            (MBD QUOTE)))
  (BPSRESTR ((REMARK FEATURE)
             (MBD QUOTE)))
  (BPSUSED ((REMARK FEATURE)
            (MBD QUOTE)))
  (BPSWIPE ((REMARK FEATURE)
            (MBD QUOTE)))
  (BPSZ ((REMARK FEATURE)
         (MBD QUOTE)))
  (BREAKP ((REMARK LAZY)))
  (CHKPOINT ((REMARK FILES)
             (MBD QUOTE)))
  (CLOSE ((REMARK FILES)
          (MBD QUOTE)))
  (COMMON ((1 SPECIAL)
           (REMARK SPEC)))
  (COMPILE ((REMARK FEATURE)
            (MBD QUOTE)))
  (COND (1 (LPQ NX DOTHESE)))
  (COUNT ((REMARK LAZY)))
  (CSET ((1 SET)
         (REMARK COMMON)))
  (CSETQ ((REMARK COMMON)
          (1 SETQ)))
  (DEBUG ((REMARK DEBUG:)
          (MBD QUOTE)))
  (DEFINE ((IF (EQ (## 2 1)
                   (QUOTE QUOTE))
               ((XTR 2 2)
                1
                (LPQ (-1 DE)
                     (IF (EQ (## 3 1)
                             (QUOTE LAMBDA)))
                     (BO 3)
                     (3)
                     4 DOTHIS 0 NX)
                0
                (IF (## 2)
                    ((-1 PROG NIL))
                    ((BO 1))))
               ((REMARK APPLY/EVAL)))))
  (DEFLIST ((REMARK LAZY)))
  (DIGP ((REMARK LAZY)))
  (EJECT ((REMARK IOFNS)
          (MBD QUOTE)))
  (EVAL ((REMARK APPLY/EVAL)))
  (EVCON ((REMARK LAZY)
          (REMARK LAZY)))
  (EVENP ((1 REMAINDER)
          (N 2)
          2 DOTHIS 0 (MBD ZEROP)))
  (EVLIS ((REMARK LAZY)))
  (EXCISE ((REMARK FEATURE)
           (MBD QUOTE)))
  (EXITERR ((REMARK FEATURE)
            (MBD QUOTE)))
  (EXPLODE ((REMARK EXPLODE:)))
  (EXPT ((REMARK FEATURE)))
  (FIXP ((REMARK FEATURE)))
  (FLAG ((REMARK LAZY)))
  (FLAGP ((REMARK LAZY)))
  (FLOAT ((1 PLUS)
          (N 0.0)))
  (FLOATP ((REMARK LAZY)))
  (FUNCTION ((IF (AND (LISTP (## 2))
                      (CADDR (CALLS (## 2)
                                    NIL T)))
                 ((REMARK FUNCTION))
                 NIL)))
  (GENSYM1 ((REMARK GENSYM1:)
            (1 GENSYM)
            (2)))
  (INLL ((REMARK FILES)
         (MBD QUOTE)))
  (LAP360 ((REMARK MACHINE-CODE)))
  (LEFTSHIFT ((1 LSH)))
  (LETP ((REMARK LAZY)))
  (LITP ((REMARK LAZY)))
  (LOGAND ((1 BOOLE 1)
           (NTH 3)
           DOTHESE))
  (LOGOR ((1 BOOLE 7)
          (NTH 3)
          DOTHESE))
  (LOGP ((REMARK LOGP:)
         (1 NUMBERP)))
  (LOGXOR ((1 BOOLE 11)
           (NTH 3)
           DOTHESE))
  (MAPCAR ((SW 2 3)))
  (MAX ((IF (## 4)
            ((EMBED (3 THRU)
                    IN MAX))
            NIL)))
  (MIN ((IF (## 4)
            ((EMBED (3 THRU)
                    IN MIN))
            NIL)))
  (MKATOM ((REMARK MKATOM)))
  (OPEN ((REMARK FILES)))
  (OPTIMIZE ((MBD QUOTE)))
  (ORDERP ((REMARK LAZY)))
  (OTLL ((REMARK FEATURE)
         (MBD QUOTE)))
  (OVOFF ((REMARK FEATURE)
          (MBD QUOTE)))
  (PAIR ((REMARK LAZY)))
  (PAIRMAP ((REMARK LAZY)))
  (PLANT ((REMARK LAZY)))
  (PLANT1 ((REMARK LAZY)))
  (PLANTDC ((REMARK LAZY)))
  (PLANTSQ ((REMARK LAZY)))
  (PRBUFFER ((REMARK IOFNS)
             (MBD QUOTE)))
  (PRINLAP ((REMARK FEATURE)
            (MBD QUOTE)))
  (PROG (3 (LPQ DOTHIS NX)))
  (QUOTE (NLAM))
  (RDS ((REMARK FILES)
        (1 INC)
        (N NIL)))
  (READCH ((IF (## 2)
               ((REMARK FEATURE))
               NIL)
           (2)))
  (RECIP ((1 QUOTIENT 0.999999)))
  (RECLAIM ((1 GC)))
  (RELINK ((REMARK LAZY)))
  (REMFLAG ((REMARK LAZY)))
  (REMOB ((REMARK LAZY)))
  (RESTORE ((REMARK FILES)
            (MBD QUOTE)))
  (RLIT ((REMARK MKATOM)))
  (RNUMB ((REMARK MKATOM)))
  (SET ((REMARK WARNING)))
  (SPEAK ((REMARK LAZY)))
  (SPECIAL ((REMARK SPEC)))
  (SUBLIS ((REMARK LAZY)))
  (TRACE ((REMARK FEATURE)
          (MBD QUOTE)))
  (TTAB ((REMARK LAZY)
         (MBD QUOTE)))
  (UNCOMMON ((REMARK COMMON)
             (1 UNSPECIAL)))
  (UNTRACE ((REMARK FEATURE)
            (1 UNSPECIAL)))
  (VERBOS ((REMARK FEATURE)
           (MBD QUOTE)))
  (WRS ((1 OUTC)
        (N NIL)
        (REMARK FILES)))
  (XTAB ((REMARK LAZY)
         (MBD QUOTE)))
))(QUOTE XFORM))

  (COND ((EQ (EVALV (QUOTE MERGE))
             T)
         (RPAQ TRANSFORMATIONS (UNION TRANSFORMATIONS
                                      (LISTP (GETP (QUOTE 
                                                    TRANSFORMATIONS)
                                                   (QUOTE VALUE)))))
         (MAPC (GETP (QUOTE USERNOTES)
                     (QUOTE VALUE))
               (FUNCTION (LAMBDA (NOTE)
                                 (OR (ASSOC (CAR NOTE)
                                            USERNOTES)
                                     (SETQ USERNOTES (CONS NOTE 
                                                          USERNOTES)))))
               ))
        (T (MAPC (GETP (QUOTE TRANSFORMATIONS)
                       (QUOTE VALUE))
                 (FUNCTION (LAMBDA (X)
                                   (AND (NOT (MEMB X TRANSFORMATONS))
                                        (/REMPROP X (QUOTE XFORM))))))))
STOP