(FILECREATED "11-MAR-73  2:55:46")
  (LISPXPRINT (QUOTE ANALPATVARS)
              T)
  (RPAQQ ANALPATVARS ((FNS MAKEDEFAULT ANALPATELT ANALPAT MAXANAL MAX 
                           ANAL!PAT TSTANAL)
          (VARS)))
(DEFINEQ

(MAKEDEFAULT
  [LAMBDA (PATELT)
    (COND
      ((EQ (CAR PATELT)
           (QUOTE DEFAULT))
        (SELECTQ VARDEFAULT
                 ((←
                     SETQ SET)
                   (FRPLACA (FRPLACD PATELT (CONS (CDR PATELT)
                                                  (QUOTE $1)))
                            (QUOTE ←)))
                 ((QUOTE ')
                   (FRPLACA PATELT (QUOTE ')))
                 ((= EQUAL)
                   (FRPLACA PATELT (QUOTE =)))
                 (HELP "FUNNY VARDEFAULT")))
      (T (SELECTQ VARDEFAULT
                  [(←
                      SETQ SET)
                    (CONS (QUOTE ←)
                          (CONS PATELT (QUOTE $1]
                  ((QUOTE ')
                    (CONS (QUOTE ')
                          PATELT))
                  ((= EQUAL)
                    (CONS (QUOTE =)
                          PATELT))
                  (HELP "FUNNY VARDEFAULT"])

(ANALPATELT
  [LAMBDA (PATELT SEGEXPR)

          (* Analyze PATELT , returning either -
          "ELT" if PATELT matches a single element -
          "SEG" if PATELT matches a segment of fixed but not 
          given size -
          A number if PATELT matches a segment of fixed, given 
          size -
          Or "ARB" if PATELT matches a segment of not 
          precomputable size)



          (* Unless SEGEXPR is on, in which case, the size of 
          the expr is returned instead of seg)



          (* Also, if the PATELT is a "SET", sets special 
          variable "SETS" -
          If it contains a match (i.e., other than $i's or $'s 
          or sets involving those) it sets the special 
          variable "MATCH")


    (COND
      ((NLISTP PATELT)
        (SELECTQ PATELT
                 [($1 &)
                   (COND
                     (SEGEXPR 1)
                     (T (QUOTE ELT]
                 [("*" *)
                   (SETQ SETS T)
                   (COND
                     (SEGEXPR 1)
                     (T (QUOTE ELT]
                 (($ --)
                   (QUOTE ARB))
                 (HELP "FUNNY PAT IN ANALPATELT" PATELT)))
      (T (SELECTQ (CAR PATELT)
                  (! (ANAL!PAT (CDR PATELT)
                               SEGEXPR))
                  ($$                           (* Either $$ NUMBER or 
                                                $$ EXPRESSION)
                      (OR (NUMBERP (CDR PATELT))
                          (AND SEGEXPR (CDR PATELT))
                          (QUOTE SEG)))
                  (DEFAULT (ANALPATELT (MAKEDEFAULT PATELT)
                                       SEGEXPR))
                  [(= == ')
                    (SETQ MATCH T)              (* = FOO matches an 
                                                element)
                    (COND
                      (SEGEXPR 1)
                      (T (QUOTE ELT]
                  [ANY                          (* It's the MAX of them 
                                                all)
                       (ANALPAT (CDR PATELT)
                                (AND SEGEXPR (QUOTE SEGEXPR]
                  (←                            (* It's a set, with the 
                                                same PROP as what's 
                                                being set)
                    (SETQ SETS T)
                    (ANALPATELT (CDDR PATELT)
                                SEGEXPR))
                  (->                           (* Ditto)
                      (SETQ SETS T)
                      (ANALPATELT (CDDR PATELT)
                                  SEGEXPR))
                  ((!←
                      !->)
                    (SETQ SETS T)
                    0)
                  (PROGN                        (* Got a PATELT which is
                                                a list of pats)
                         (ANALPAT PATELT)
                         (COND
                           (SEGEXPR 1)
                           (T (QUOTE ELT])

(ANALPAT
  [LAMBDA (PAT FLG FN TAIL)

          (* Calls either ANALPATELT or FN on the elements of 
          PAT (up to TAIL) and returns the MAXANAL of them -
          The value of FLG determinses whether MAXANAL returns 
          a sum or a maximum)


    (PROG (VAL)
      LP  (COND
            ((OR (EQ PAT TAIL)
                 (NOT PAT))
              (RETURN VAL)))
          (SETQ VAL (MAXANAL (APPLY* (OR FN (QUOTE ANALPATELT))
                                     (CAR PAT))
                             VAL FLG))
          (SETQ PAT (CDR PAT))
          (GO LP])

(MAXANAL
  [LAMBDA (VAL1 VAL2 FLG)
    (COND
      ((NOT VAL1)
        VAL2)
      ((NOT VAL2)
        VAL1)
      ((OR (EQ VAL2 (QUOTE ARB))
           (EQ VAL1 (QUOTE ARB)))
        (QUOTE ARB))
      ((OR (EQ VAL1 (QUOTE SEG))
           (EQ VAL2 (QUOTE SEG)))
        (QUOTE SEG))
      ((EQ FLG (QUOTE SEGEXPR))
        (MAKEPLUS VAL1 VAL2))
      (FLG (IPLUS (OR (NUMBERP VAL1)
                      1)
                  (OR (NUMBERP VAL2)
                      1)))
      [(EQ VAL1 (QUOTE ELT))
        (COND
          ((OR (EQ VAL2 1)
               (EQ VAL2 (QUOTE ELT)))
            VAL2)
          (T (QUOTE SEG]
      [(EQ VAL2 (QUOTE ELT))
        (COND
          ((EQ VAL1 1)
            VAL1)
          (T (QUOTE SEG]
      (T 'SEG])

(MAX
  [LAMBDA (X Y)
    (COND
      ((IGREATERP X Y)
        X)
      (T Y])

(ANAL!PAT
  [LAMBDA (PAT SEGEXPR)
    (COND
      ((NLISTP PAT)
        (SELECTQ PAT
                 (("*" *)                       (* !* is like result←$)
                   (SETQ SETS T)
                   (QUOTE ARB))
                 (($1 &)                        (* !$1 is the same as $)
                   (QUOTE ARB))
                 (HELP "FUNNY NLISTP PAT AFTER ! IN" PATELT)))
      (T (SELECTQ (CAR PAT)
                  ('                            (* !'exp matches exactly
                                                length exp things)
                    (LENGTH (CDR PAT)))
                  [(= ==)                       (* = exp matches 
                                                precomputable NUMBER of 
                                                things)
                    (SETQ MATCH T)
                    (COND
                      [SEGEXPR (LIST (QUOTE LENGTH)
                                     (CDR (CAR PAT]
                      (T (QUOTE SEG]
                  ((←
                      ->)
                    (SETQ SETS T)
                    (ANAL!PAT (CDR PAT)))
                  (DEFAULT                      (* MAKEDEFAULT actually 
                                                smashes it, so go ahead 
                                                & try it again)
                           (MAKEDEFAULT PAT)
                           (ANAL!PAT PAT SEGEXPR))
                  (ANY 

          (* ! (any ...) matches the MAX of ANAL!PAT of the 
          elts of the any)


                       (ANALPAT (CDR PAT)
                                (AND SEGEXPR (QUOTE SEGEXPR))
                                (FUNCTION ANAL!PAT)))
                  (PROGN 

          (* Otherwise, there is a ! 
          (PAT) so it's the MAX, except if there are all fixed 
          segs, add'em up)


                         (ANALPAT PAT (COND
                                    (SEGEXPR (QUOTE SEGEXPR))
                                    (T T))
                                  NIL NIL])

(TSTANAL
  [LAMBDA (PAT)
    (PROG (SETS MATCH VA)
          (LIST (ANALPAT PAT)
                SETS MATCH])
)
STOP