perm filename ANALPA[1,LMM]1 blob sn#031668 filedate 1973-03-25 generic text, type T, neo UTF8
  (PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "25-MAR-73 06:20:16")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE ANALPATVARS)
              T)
  (RPAQQ ANALPATVARS
         ((FNS MAKEDEFAULT ANALPATELT ANALPAT MAXANAL MAX ANAL!PAT 
               TSTANAL $? SKIP$ SKIP$ANY SKIP$I ELT? MEMBPAT? ARB? 
               NOMATCHARB?)
          (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 (QUOTE "FUNNY VARDEFAULT"]
      (T (SELECTQ VARDEFAULT
                  [(←
                      SETQ SET)
                    (CONS (QUOTE ←)
                          (CONS PATELT (QUOTE $1]
                  ((QUOTE ')
                    (CONS (QUOTE ')
                          PATELT))
                  ((= EQUAL)
                    (CONS (QUOTE =)
                          PATELT))
                  (HELP (QUOTE "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 (QUOTE "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)