(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE " 1-MAR-73 12:40:36")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE GENPATVARS)
              T)
  (RPAQQ GENPATVARS
         ((FNS PICK RAND1 ORR PAT PATELT PATELT2 EXPRESSION VAR GENPAT 
               XLATE LISTOF NUMBER FNNAME TSTPARSE DIFFER)
          (VARS)
          (PROP MACRO ORR LISTOF)))
(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

          (* A pattern element can take several forms;
          those defined here cannot occur after a !, those 
          defined in PATELT2 can)


    (ORR (PATELT2)
         (QUOTE $)
         (CONS (QUOTE $$)
               (ORR (NUMBER)
                    (EXPRESSION)))
         (CONS (QUOTE ANY)
               (INTERSECTION [SETQ TEM
                               (SUBSET (LISTOF (PATELT)
                                               2)
                                       (FUNCTION (LAMBDA (X)
                                           (NOT (EQ (CAR X)
                                                    (QUOTE ANY]
                             TEM)

          (* ANY may precede a list of patterns, none the 
          same, and none of them ANY's)


               )
         (CONS (QUOTE ←)
               (CONS (VAR)
                     (PATELT))

          (* This is input as (... VAR ← PATELT ...) and 
          parses to (← VAR . PATELT))


               )
         (CONS (QUOTE ->)
               (CONS (EXPRESSION)
                     (PATELT))

          (* 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 (PATELT2)
                    (CONS (QUOTE ←)
                          (VAR)))

          (* A ! may occur only in the following input 
          contexts: -
          (... !=VAR ...) -
          (... !* ...) -
          (... !var← ...) meaning that VAR is set to tail here 
          -
          (... ! (PAT) ← ...) meaning replace this segment -
          (... var←!patelt ...))


               ])

(PATELT2
  [LAMBDA NIL

          (* These are all of the patterns that may be 
          preceded by a !)


    (ORR (COND
           ((NOT STARDONE)                      (* Only one star can 
                                                occur in a pattern)
             (SETQ STARDONE T)
             (QUOTE *))
           (T (QUOTE $1)))
         (QUOTE $1)
         (CONS (QUOTE DEFAULT)
               (VAR))
         (CONS (ORR (QUOTE ')
                    (QUOTE =)
                    (QUOTE ==))
               (EXPRESSION))
         (PROG1 (PAT)

          (* A PATELT can also be a list of patelts...
          This means that it is a sub-pattern)


                )
         (CONS (QUOTE ANY)
               (INTERSECTION [SETQ TEM
                               (SUBSET (LISTOF (PATELT2)
                                               2)
                                       (FUNCTION (LAMBDA (X)
                                           (NOT (EQ (CAR X)
                                                    (QUOTE ANY]
                             TEM)               (* ANY can precede a 
                                                list of at least two 
                                                PATELT's)
               ])

(EXPRESSION
  [LAMBDA (FLG)
    (ORR (COND
           (FLG NIL)
           (T (VAR)))
         (ORR (NUMBER)
              (VAR))
         (CONS (SETQ FLG (FNNAME))
               (COND
                 ((SUBRP FLG)
                   (LIST (EXPRESSION)))
                 ((GETD FLG)
                   (LISTOF (EXPRESSION)
                           (NARGS FLG)
                           (NARGS FLG)))
                 (T (LISTOF (EXPRESSION)
                            0 3])

(VAR
  [LAMBDA NIL
    (CAR (FNTH (QUOTE (TUGGLE TICKLE TAG TUMMY TISKET TASKET TRISKET 
                              TRASKET TOOKEY TACKEY))
               (RAND 1 10])

(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
    (CAR (FNTH (QUOTE (NUMBERP GETD EXPRP ATOM LITATOM STRINGP CAR CDR 
                               FIXP NNIL ZEROP INFILEP LISTP NLISTP 
                               MINUSP READP SMALLP))
               (RAND 1 17])

(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])
)
(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))

STOP