perm filename GENPAT[1,LMM]1 blob sn#031674 filedate 1973-03-25 generic text, type T, neo UTF8
  (PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "25-MAR-73 06:22:06")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE GENPATVARS)
              T)
  (RPAQQ GENPATVARS
         ((FNS PICK RAND1 ORR PAT PATELT EXPRESSION VAR GENPAT XLATE 
               LISTOF NUMBER FNNAME TSTPARSE DIFFER PATELT1 PATELT2 
               PATELT3 PRED PATELT4 TMPPATELT UNPARSE UNPARSELT PACKRAT 
               PACKRAT1)
          (VARS)
          (PROP MACRO ORR LISTOF)
          (ADVICE PATELT)))
(DEFINEQ

(PICK
  [LAMBDA (L)
    (CAR (NTH L (RAND1 (LENGTH L])

(RAND1
  [LAMBDA (N)
    (XLATE (RAND 0.0 1.0)
           N])

(ORR
  [NLAMBDA L
    (EVAL (PICK L])

(PAT
  [LAMBDA NIL                                   (* A pattern is a list 
                                                of at least one PATELT)
    (LISTOF (PATELT)
            1])

(PATELT
  [LAMBDA NIL
    (ORR (PATELT1)
         (PATELT2)
         (PATELT3)
         [CONS (QUOTE ←)
               (CONS (VAR)
                     (ORR (PATELT2)
                          (PATELT3]
         (CONS (QUOTE ->)
               (CONS (EXPRESSION)
                     (ORR (PATELT2)
                          (PATELT3)))

          (* This is input as (... PATELT ← EXPRESSION ..) and 
          parses this way -
          Depends, on input, on whether the first thing can 
          PARSE as a pattern or not)


               )
         (CONS (QUOTE !)
               (ORR (PATELT1)
                    (PATELT3)
                    (CONS (QUOTE ←)
                          (CONS (VAR)
                                (PATELT3)))
                    (CONS (QUOTE ->)
                          (CONS (EXPRESSION)
                                (PATELT3])

(EXPRESSION
  [LAMBDA (FLG)
    (ORR (COND
           (FLG NIL)
           (T (VAR)))
         (ORR (NUMBER)
              (VAR))
         (CONS (SETQ FLG (FNNAME))
               (COND
                 ((SUBRP FLG)
                   (LIST (EXPRESSION)))
                 ((GETD FLG)
                   (PROG ((X 1)
                          LST
                          (MAX (NARGS FLG)))
                     LP  [COND
                           ((IGREATERP X MAX)
                             (RETURN LST))
                           (T (SETQ LST (NCONC1 LST (EXPRESSION]
                         (SETQ X (ADD1 X))
                         (GO LP)))
                 (T (LISTOF (EXPRESSION)
                            0 3])

(VAR
  [LAMBDA NIL
    (PICK (QUOTE (TUGGLE TICKLE TAG TUMMY TISKET TASKET TRISKET TRASKET 
                         TOOKEY TACKEY EGG BASKET HEAD TAIL FOO BAZ 
                         FIDDLE TURKEY TEM TMP LST EXPR1 STRUC SILLY 
                         SALLY LARRY ME SRI WARREN BOB BILL FRED 
                         SHIRLEY TERESA CAROLYNN SUSAN BARBARA MADELYN 
                         MARY TED BILL BOB CAROL ALICE FRANK LES NANCY 
                         VICKI XEROX])

(GENPAT
  [LAMBDA (STARDONE)
    (PROG (VAL)
          (PRINTDEF (SETQ VAL (PAT)))
          (TERPRI)
          (RETURN VAL])

(XLATE
  [LAMBDA (N1 N2)
    (ADD1 (FTIMES N2 (EXPT (FDIFFERENCE N1 1.0)
                           2])

(LISTOF
  [NLAMBDA (EXPR MIN MAX)
    (PROG (VAL (MIN (OR (EVAL MIN)
                        0))
               (MAX (OR (EVAL MAX)
                        10)))
          (RPTQ (IPLUS MIN (RAND1 (IDIFFERENCE MAX MIN)))
                (SETQ VAL (CONS (EVAL EXPR)
                                VAL)))
          (RETURN VAL])

(NUMBER
  [LAMBDA NIL
    (RAND 2 10])

(FNNAME
  [LAMBDA NIL
    (PICK (QUOTE (NUMBERP GETD EXPRP ATOM LITATOM STRINGP FIXP NNIL 
                          ZEROP INFILEP LISTP NLISTP MINUSP SMALLP])

(TSTPARSE
  [LAMBDA NIL
    (SETQ PAT1 (GENPAT))
    (PRINT (SETQ PAT2 (UNPARSE PAT1)))
    [PRINT (SETQ PAT3 (PARSE (COPY PAT2]
    (COND
      ((NOT (SETQ DIFF (DIFFER PAT1 PAT3)))
        (QUOTE WIN!))
      (T (QUOTE LOSE!!])

(DIFFER
  [LAMBDA (L1 L2)
    (COND
      ((OR (NLISTP L1)
           (NLISTP L2))
        (AND (NOT (EQUAL L1 L2))
             (OR L2 L1)))
      (T (PROG [(CAR (DIFFER (CAR L1)
                             (CAR L2)))
                (CDR (DIFFER (CDR L1)
                             (CDR L2]
               (RETURN (OR (AND CAR CDR (CONS CAR CDR))
                           CAR CDR])

(PATELT1
  [LAMBDA NIL
    (COND
      (STARDONE (CONS (QUOTE DEFAULT)
                      (VAR)))
      (T (OR (CONS (QUOTE DEFAULT)
                   (VAR))
             (PROG1 (QUOTE *)
                    (SETQ STARDONE T])

(PATELT2
  [LAMBDA NIL
    (ORR (QUOTE $)
         (QUOTE $1)
         (CONS (QUOTE $$)
               (ORR (NUMBER)
                    (EXPRESSION])

(PATELT3
  [LAMBDA NIL
    (ORR (CONS (QUOTE :)
               (PRED))
         (PAT])

(PRED
  [LAMBDA NIL
    (ORR (LIST (CAR (FNTH (QUOTE (EQ EQUAL))
                          (RAND 1 2)))
               (QUOTE X)
               (ORR (KWOTE (EXPRESSION))
                    (EXPRESSION)))
         (FNNAME)
         (LIST (FNNAME)
               (QUOTE X])

(PATELT4
  [LAMBDA NIL
    (ORR (PATELT3)
         (CONS (QUOTE ←)
               (CONS (VAR)
                     (PATELT3)))
         (CONS (QUOTE ->)
               (CONS (EXPRESSION)
                     (PATELT3])

(TMPPATELT
  [LAMBDA NIL
    (ORR (PATELT1)
         (PATELT2)
         (PATELT3)
         [CONS (QUOTE ←)
               (CONS (VAR)
                     (ORR (QUOTE $1)
                          (PATELT3]
         (CONS (QUOTE ->)
               (CONS (EXPRESSION)
                     (ORR (QUOTE $1)
                          (PATELT3)))

          (* This is input as (... PATELT ← EXPRESSION ..) and 
          parses this way -
          Depends, on input, on whether the first thing can 
          PARSE as a pattern or not)


               ])

(UNPARSE
  [LAMBDA (PAT)                                 (* Unpatparse each 
                                                pattern element and 
                                                NCONC values together)
    (MAPCONC PAT (FUNCTION UNPATPARSELT])

(UNPARSELT
  [LAMBDA (PATELT)                              (* CREATE valid input 
                                                sytax)
    (PROG (TEM)
          (COND
            ((NLISTP PATELT)
              (SELECTQ PATELT
                       (($1 $ *)
                         (LIST PATELT))
                       (HELP (QUOTE "CAN'T UNPATPARSE")
                             PATELT)))
            (T
              (SELECTQ
                (CAR PATELT)
                (DEFAULT (LIST (CDR PATELT)))
                [$$ (COND
                      ((NUMBERP (CDR PAT))
                        (PACKRAT (QUOTE $)
                                 (CDR PATELT)))
                      ((NLISTP (CDR PATELT))
                        (PACKRAT (QUOTE $$)
                                 (CDR PATELT)))
                      (T (LIST (CAR PATELT)
                               (CDR PATELT]
                [:(COND
                    ((NLISTP (CDR PATELT))
                      (PACKRAT (QUOTE :)
                               (CDR PATELT)))
                    ((NOT (EQ (CADDR PATELT)
                              (QUOTE X)))
                      (LIST (QUOTE :)
                            (CDR PATELT)))
                    [(EQ (CADR PATELT)
                         (QUOTE EQ))
                      (COND
                        [(EQ (CAR (CADDDR PATELT))
                             (QUOTE QUOTE))
                          (PACKRAT (QUOTE ')
                                   (CADR (CADDDR PATELT]
                        (T (PACKRAT (QUOTE ==)
                                    (CADR (CADDDR PATELT]
                    [(EQ (CADR PATELT)
                         (QUOTE EQUAL))
                      (COND
                        [(EQ (CAR (CADDDR PATELT))
                             (QUOTE QUOTE))
                          (PACKRAT (QUOTE ')
                                   (CADR (CADDDR PATELT]
                        (T (PACKRAT (QUOTE =)
                                    (CADR (CADDDR PATELT]
                    ((NOT (CDDDR PATELT))
                      (PACKRAT (QUOTE :)
                               (CADR PATELT)))
                    (T (PACKRAT ':(CDR PATELT]
                [ANY (LIST (CONS (CAR PATELT)
                                 (UNPATPARSE (CDR PATELT]
                (←(NCONC [PACKRAT (CADR PATELT)
                                  (CAR PATELT)
                                  (CAR (SETQ TEM (UNPATPARSELT
                                           (CDDR PATELT]
                         (CDR TEM)))
                (-> (PACKRAT (UNPATPARSELT (CDDR PATELT))
                             (QUOTE ←)
                             (CADR PATELT)))
                (! (NCONC [PACKRAT (QUOTE !)
                                   (CAR (SETQ TEM (UNPATPARSELT
                                            (CDR PATELT]
                          (CDR TEM)))
                (LIST (UNPATPARSE PATELT])

(PACKRAT
  [LAMBDA N
    (PROG ((CNT N)
           VAL ATLST)
      LP  (COND
            ((ZEROP CNT)
              (RETURN (PACKRAT1 ATLST VAL)))
            ((NLISTP (ARG N CNT))
              (SETQ ATLST (CONS (ARG N CNT)
                                ATLST)))
            (T (SETQ VAL (CONS (ARG N CNT)
                               (PACKRAT1 ATLST VAL)))
               (SETQ ATLST)))
          (SETQ CNT (SUB1 CNT))
          (GO LP])

(PACKRAT1
  [LAMBDA (ATLST LST)
    (COND
      (ATLST (CONS (PACK ATLST)
                   LST))
      (T LST])
)
(DEFLIST(QUOTE(
  [ORR
    (L (PROG ((TEM 0))
             (CONS (QUOTE SELECTQ)
                   (CONS (LIST (QUOTE RAND1)
                               (LENGTH L))
                         (NCONC [MAPCAR L (FUNCTION
                                          (LAMBDA
                                            (X)
                                            (LIST (SETQ TEM
                                                        (ADD1 TEM))
                                                  X]
                                (QUOTE ((HELP]
  [LISTOF
    (L ([LAMBDA
          (EXPR MIN MAX)
          (LIST (QUOTE PROG)
                (QUOTE (VAL))
                (LIST (QUOTE RPTQ)
                      [COND [MIN (LIST (QUOTE IPLUS)
                                       MIN
                                       (LIST (QUOTE RAND1)
                                             (LIST (QUOTE IDIFFERENCE)
                                                   (OR MAX 10)
                                                   MIN]
                            (T (LIST (QUOTE RAND1)
                                     (OR MAX 10]
                      (LIST (QUOTE SETQ)
                            (QUOTE VAL)
                            (CONS (QUOTE CONS)
                                  (CONS EXPR (QUOTE (VAL]
        (CAR L)
        (CADR L)
        (CADDR L]
))(QUOTE MACRO))

(DEFLIST(QUOTE(
  [PATELT (NIL (BEFORE NIL (RETURN (TMPPATELT]
))(QUOTE READVICE))

STOP