(READMAC ";" (READMAC "?" F))

(DELIM ";" (DELIM "?" F))

(READMAC "\" (READMAC "!" F))

(READMAC "!"
(LAMBDA NIL
        (COND [<EQ (READCH) '\!> <LIST '*!! (READ)>]
              [T <BACKSP>
                 <LIST '*! (READ)>])))

(READMAC "&"
(LAMBDA NIL
        (COND [<EQ (READCH) '\&> <LIST '*&& (READ)>]
              [T <BACKSP>
                 <LIST '*& (READ)>])))

(READMAC "?"
(LAMBDA NIL
        (PROG <(Z-C (READCH))>
              <RETURN
               (COND [<EQ Z-C '\'> <LIST '*?Q (READ)>]
                     [<DELIM (STRING Z-C)>
                       <BACKSP>
                       '(*?)]
                     [<NOT (EQ Z-C '\?)>
                       <BACKSP>
                       <LIST '*? (READ)>]
                     [<DELIM (STRING (SETQ Z-C (READCH)))>
                       <BACKSP>
                       '(*??)]
                     [<EQ Z-C '/> <LIST '*??/ (READ)>]
                     [T <BACKSP>
                        <LIST '*?? (READ)>])>)))

(DEFSPEC ACCUM:
(LAMBDA (Z-NM . Z-V)
        (ZPROCN Z-NM 'ACCUM: CDDR Z-V)))

(DEFSPEC ADD
(LAMBDA (Z-DAT . Z-Z)
        (PROG <Z-L>
              <COND [<NOT (SETQ Z-L (ZPROC? Z-DAT))>
                      <RETURN (ZADD (ZINST Z-DAT)
                       (COND [Z-Z <EVAL (CAR Z-Z)>]
                             [T ZHIGH]))>]
                    [<NOT (ATOM (SETQ Z-Z (CAR Z-Z)))>
                      <SETQ Z-Z (EVAL Z-Z)>]>
              <COND [<NOT (GET Z-Z 'PDEF)> <ZERROR Z-Z " IS NOT A PROC">
                     ]
                    [<MEMBER Z-Z (CDR Z-L)> <RETURN Z-Z>]>
              <ZPLACD Z-L (CONS Z-Z (CDR Z-L))>
              <RETURN Z-Z>)))

(CSETQ ZADD
(LAMBDA (Z-DAT Z-Z)
        (PROG <Z-L>
              <ZREMOVE Z-DAT>
              <ZPLACD (SETQ Z-L (ZMEMBN Z-Z ZNET)) (CONS (SETQ Z-DAT (
               CONS Z-DAT Z-Z)) (CDR Z-L))>
              <MAPC (ZATOMS (CAR Z-DAT))
               (LAMBDA (Z-A)
                       (COND [<NOT (SETQ Z-L (GET Z-A 'ZNET))>
                               <PUT Z-A 'ZNET (SETQ Z-L (LIST (CONS NIL
                                0)))>])
                       (ZPLACD (CAR Z-L) (ADD1 (CDAR Z-L)))
                       (ZPLACD (SETQ Z-L (ZMEMBN Z-Z Z-L)) (CONS Z-DAT (
                        CDR Z-L))))>
              <RETURN (ZCAR Z-DAT)>)))

(DEFSPEC ZAND
(LAMBDA Z-L
        (ZANDOR Z-L ZHIGH T)))

(CSETQ ZANDOR
(LAMBDA (Z-L Z-MZ Z-AND)
        (PROG <(Z-TH ZLOW) Z-E Z-Z>
              <COND [<EQ (CAR Z-L) 'THRESH:>
                      <SETQ Z-TH (EVAL (CADR Z-L))>
                      <SETQ Z-L (CDDR Z-L)>]>
         LOOP <COND [<OR [EQ (SETQ Z-E (EVAL (CAR Z-L))) *FAIL]
                         [LESSP (SETQ Z-Z (ZVALZ Z-E)) Z-TH]>
                      <RETURN *FAIL>]
                    [Z-AND <COND [<LESSP Z-Z Z-MZ> <SETQ Z-MZ Z-Z>]>]
                    [<GREATERP Z-Z Z-MZ> <SETQ Z-MZ Z-Z>]>
              <COND [<SETQ Z-L (CDR Z-L)> <GO LOOP>]
                    [T <RETURN (ZCONS (ZVALV Z-E) Z-MZ)>]>)))

(DEFSPEC ASSERT
(LAMBDA (Z-DAT . Z-Z)
        (ZCALLEM ZSAVE APROCS (ZADD (ZINST Z-DAT)
         (COND [Z-Z <EVAL (CAR Z-Z)>]
               [T ZHIGH])))))

(CSETQ ZATOMS
(LAMBDA (Z-PAT)
        (CSETQ ZTEMPV NIL)
        (ZATOM1 Z-PAT)
        ZTEMPV))

(CSETQ ZATOM1
(LAMBDA (Z-PAT)
        (PROG <Z-C>
              <COND [<ATOM Z-PAT>
                      <COND [<AND [IFTYPE Z-PAT 7]
                                  [NOT (IFFLAG Z-PAT 'NOHASH)]
                                  [NOT (MEMBER Z-PAT ZTEMPV)]>
                              <CSETQ ZTEMPV (CONS Z-PAT ZTEMPV)>]>]
                    [<OR [NOT (IFTYPE (SETQ Z-C (CAR Z-PAT)) 7)]
                         [NOT (IFFLAG Z-C 'ZPATF)]> <MAPC Z-PAT ZATOM1>]
                    [<MEMBER Z-C '(*AND *CON)> <MAPC (CDR Z-PAT) ZATOM1>
                     ]
                    [<MEMBER Z-C '(*ANY *NOT *R)> <ZATOM1 (CADR Z-PAT)>]
               >)))

(DEFSPEC BACK
(LAMBDA Z-L
        (COND [<EQ (ZSETV Z-L) Z*NIL*> <CSETQ ZVALUE *FAIL>])
        (ERROR 15)))

(DEFSPEC BIND
(LAMBDA (Z-V Z-E)
        (ZBIND (CADR Z-V) (EVAL Z-E))))

(DEFSPEC BIND!
(LAMBDA (Z-V Z-E)
        (RPLACD (CDR (ZLOOK (CADR Z-V))) (SETQ Z-E (EVAL Z-E)))
        Z-E))

(CSETQ ZBIND
(LAMBDA (Z-A Z-V)
        (ZPLACD (CDR (ZLOOK Z-A)) Z-V)
        Z-V))

(DEFSPEC BOUND
(LAMBDA (Z-V)
        (COND [<ZLOOK? (CADR Z-V)> T]
              [T *FAIL])))

(CSETQ ZCALL
(LAMBDA (Z-NM Z-DAT)
        (PROG <ZSUCCEED?>
              <CSETQ ZRESETV NIL>
              <COND [<EQ (ZCALLP Z-NM Z-DAT) Z*NIL*> <RETURN *FAIL>]
                    [<EQ (*CAR ZVALUE) Z*NIL*>
                      <RETURN (CSETQ ZVALUE (ZCONS (ZINSTR (ZVALV Z-DAT)
                       ) (CDR ZVALUE)))>]
                    [T <RETURN ZVALUE>]>)))

(CSETQ ZCALLP
(LAMBDA (Z-NM Z-DAT)
        (COND [<NOT (SETQ Z-NM (GET Z-NM 'PDEF))>
                <ZERROR "ILLEGAL PROC CALL">])
        (CSETQ ZALIST1 ZALIST)
        (PROG <(ZALIST (ZGLOBE (CADR Z-NM)))>
              <COND [<NOT (ZMATCH (ZINSTP (CAR Z-NM)) (ZVALV Z-DAT))>
                      <RETURN (CSETQ ZVALUE Z*NIL*)>]>
              <CSETQ ZVALD Z-DAT>
              <RETURN (ZPROC (STACK (CDDR Z-NM)))>)))

(CSETQ ZCALLD
(LAMBDA (Z-E)
        (COND [ZDEMON <ZPLACD (CSETQ ZTEMPV (ASSOC 'ZACCUM (ALIST))) (
                       ZDEMON Z-E ZTHRSH (CDR ZTEMPV))>])))

(CSETQ ZCALLEM
(LAMBDA (Z-SAVE Z-L Z-DAT)
        (PROG <ZSUCCEED?>
              <CSETQ ZRESETV NIL>
         LOOP <COND [<NULL (SETQ Z-L (CDR Z-L))> <RETURN Z-DAT>]
                    [<EQ (ZCALLP (CAR Z-L) Z-DAT) *FAIL>
                      <ZRESTORE Z-SAVE>
                      <RETURN *FAIL>]
                    [T <GO LOOP>]>)))

(CSETQ ZCAR
(LAMBDA (Z-E)
        (COND [<ATOM Z-E> Z-E]
              [<EQUAL (CDR Z-E) ZHIGH> <CAR Z-E>]
              [T Z-E])))

(CSETQ ZCONS
(LAMBDA (Z-E Z-Z)
        (COND [<EQUAL Z-Z ZHIGH> Z-E]
              [T <CONS Z-E Z-Z>])))

(DEFSPEC DEDUCE
(LAMBDA (Z-PAT . Z-R)
        (CSETQ ZRESETV NIL)
        (ZDEDUCE (ZINSTPD Z-PAT) DPROCS (ZRANGER (ZRANGES Z-R)))))

(CSETQ ZDEDUCE
(LAMBDA (Z-PAT Z-L Z-R)
        (PROG <(ZSUCCEED? T) ZSAVED>
              <COND [ZRESETV <GO RETRY>]
                    [T <SETQ ZSAVED ZSAVE>]>
         LOOP <COND [<NULL (SETQ Z-L (CDR Z-L))>
                      <RETURN (CSETQ ZVALUE *FAIL)>]
                    [T <ZCALLP (CAR Z-L) Z-PAT>]>
          TRY <COND [<AND [NOT (EQ ZVALUE Z*NIL*)]
                          [NOT (EQ ZVALUE *FAIL)]
                          [ZRANGEP (ZVALZ ZVALUE) Z-R]>
                      <CSETQ ZDEDUCEV Z-L>
                      <COND [<EQ (*CAR ZVALUE) Z*NIL*>
                              <CSETQ ZVALUE (ZCONS (ZINSTR (ZVALV Z-PAT)
                               ) (CDR ZVALUE))>]>
                      <RETURN (CSETQ ZVALD ZVALUE)>]
                    [<NOT ZRESETV>
                      <ZRESTORE ZSAVED>
                      <GO LOOP>]>
        RETRY <(LAMBDA (ZALIST ZACCUM) (ZPROC T T T)) T T>
              <GO TRY>)))

(DEFSPEC DEMON:
(LAMBDA (Z-NM . Z-V)
        (ZPROCN Z-NM 'DEMON: CDDDR Z-V)))

(DEFSPEC DO?
(LAMBDA Z-L
        (PROG <(Z-SAVE ZSAVE) Z-V>
              <SETQ Z-V (EVAL (CONS 'DO Z-L))>
              <ZRESTORE Z-SAVE>
              <RETURN Z-V>)))

(DEFSPEC DO!
(LAMBDA Z-L
        (PROG <(Z-SAVE ZSAVE) Z-V>
              <SETQ Z-V (EVAL (CONS 'DO Z-L))>
              <CSETQ ZSAVE Z-SAVE>
              <RETURN Z-V>)))

(CSETQ DUMPNET
(LAMBDA (Z-F)
        (TERPRI Z-F)
        (PRINT ":LOAD")
        (MAPC (CDR ZNET)
         (LAMBDA (Z-A)
                 (PRINT (CONS 'ADD (CONS (CAR Z-A)
                  (COND [<EQUAL (SETQ Z-A (CDR Z-A)) ZHIGH> NIL]
                        [T <LIST Z-A>]))))))
        (PRINT ":END")
        (TERPRI)
        T))

(CSETQ ZERROR
(LAMBDA Z-L
        (TERPRI)
        (SPACE 1)
        (MAPC Z-L PRIN1)
        (TERPRI)
        (SPACE 1)
        (PRINT "HELP:")
        (CLEARBUFF)
        (COND [<NULL (SETQ Z-L (EVAL (READ)))> <ERROR 0 (BACKTR)>]
              [T Z-L])))

(CSETQ *ERASE ERASE)

(DEFSPEC ERASE
(LAMBDA (Z-DAT)
        (PROG <(Z-SAVE ZSAVE)>
              <COND [<EQ (SETQ Z-DAT (ZREMOVE (ZINST Z-DAT))) *FAIL>
                      <RETURN *FAIL>]>
              <RETURN (ZCALLEM Z-SAVE EPROCS Z-DAT)>)))

(DEFSPEC EXIT
(LAMBDA Z-L
        (ZSETV Z-L)
        (ERROR 13)))

(CSETQ FAIL
(LAMBDA Z-C
        (RESTORE (STACK Z-C))
        (CSETQ ZVALUE *FAIL)
        (ERROR 11)))

(DEFSPEC FETCH
(LAMBDA (Z-PAT . Z-R)
        (ZFETCH (SETQ Z-PAT (ZINSTP Z-PAT)) ZINSTPF (ZGETAS Z-PAT (SETQ
         Z-R (ZRANGES Z-R))) (ZRANGER Z-R))))

(CSETQ ZFETCH
(LAMBDA (Z-PAT Z-I Z-L Z-R)
        (PROG NIL
              <COND [<NULL Z-L> <RETURN *FAIL>]
                    [Z-I <GO LOOP>]
                    [<AND [SETQ Z-PAT (ASSOC Z-PAT Z-L)]
                          [ZRANGEP (CDR Z-PAT) Z-R]>
                      <CSETQ ZFETCHV NIL>
                      <RETURN (CSETQ ZVALD (ZCAR Z-PAT))>]
                    [T <RETURN *FAIL>]>
         LOOP <COND [<NOT (ZRANGEP (CDAR Z-L) Z-R)> <RETURN *FAIL>]
                    [<ZMATCH Z-PAT (CAAR Z-L)>
                      <CSETQ ZFETCHV (CDR Z-L)>
                      <RETURN (CSETQ ZVALD (ZCAR (CAR Z-L)))>]
                    [<SETQ Z-L (CDR Z-L)> <GO LOOP>]
                    [T <RETURN *FAIL>]>)))

(CSETQ FINALIZE
(LAMBDA Z-C
        (CSETQ ZSAVE
         (COND [Z-C <CAR Z-C>]
               [T ZSAVEP]))
        T))

(DEFSPEC FLUSH
(LAMBDA Z-F
        (COND [<OR [NULL Z-F]
                   [EQ (CAR Z-F) 'NET]>
                <RPLACD ZNET NIL>
                <OBLIST
                 (LAMBDA (Z-A)
                         (REMPROP Z-A 'ZNET))>])
        (COND [<OR [NULL Z-F]
                   [EQ (CAR Z-F) 'PROCS]>
                <RPLACD DPROCS NIL>
                <RPLACD EPROCS NIL>
                <RPLACD APROCS NIL>])
        (CSETQ ZSAVE NIL)
        T))

(DEFSPEC FOR
(LAMBDA (Z-A1 Z-A2 . Z-L)
        (CSETQ ZRESETV NIL)
        (PROG NIL
              <COND [<OR [EQ Z-A1 'FETCH:]
                         [EQ Z-A1 'F:]> <SETQ Z-A1 F>]
                    [<OR [EQ Z-A1 'DEDUCE:]
                         [EQ Z-A1 'D:]> <SETQ Z-A1 'D>]
                    [<OR [EQ Z-A1 'GOAL:]
                         [EQ Z-A1 'G:]> <SETQ Z-A1 T>]
                    [<OR [EQ Z-A1 'TRY:]
                         [EQ Z-A1 'T:]>
                      <SETQ Z-A1 (RPLACD '(Z*NIL*) (ZINST Z-A2))>
                      <SETQ Z-A2 (CAR Z-L)>
                      <SETQ Z-L (CDR Z-L)>]
                    [T <RETURN (ZFOR (ZINSTP Z-A1) (ZINST Z-A2) Z-L)>]>
              <RETURN (ZFORFD (ZINSTP Z-A2) Z-L Z-A1)>)))

(CSETQ ZFOR
(LAMBDA (ZPAT ZDATS ZLIST)
        (PROG <ZLIST1 ZSAVEF>
              <COND [ZRESETV <COND [<EQ (ZRESET '(ZPAT ZDATS ZLIST
                                      ZLIST1 ZSAVEF)) Z*NIL*> <GO NEXT>]
                                   [T <GO EVAL>]>]>
              <SETQ ZSAVEF ZSAVE>
              <SETQ ZLIST1 ZLIST>
              <CSETQ ZVALUE *FAIL>
         LOOP <COND [<NOT (ZMATCH ZPAT (ZVALV (CSETQ ZVALD (CAR ZDATS)))
                       )> <GO ITER>]>
           LP <CSETQ ZVALUE (CAR ZLIST)>
         EVAL <ATTEMPT [CSETQ ZVALUE (EVAL ZVALUE)]
                       [12 <GO SUCCEED?>]
                       [13 <GO EXIT>]
                       [14 <GO NXT>]
                       [15 <GO BACK>]>
              <COND [<EQ ZVALUE *FAIL> <GO BACK>]
                    [T <ZCALLD ZVALUE>]>
         NEXT <COND [<SETQ ZLIST (CDR ZLIST)> <GO LP>]
                    [T <CSETQ ZVALUE *FAIL>
                       <GO BACK>]>
     SUCCEED? <CSETQ ZRESETV (CONS 'ZFOR (CONS (ALIST) ZRESETV))>
              <ERROR 12>
         EXIT <COND [<EQ ZVALUE Z*NIL*> <CSETQ ZVALUE (CAR ZDATS)>]>
              <RETURN (ZCAR ZVALUE)>
          NXT <COND [<EQ ZVALUE Z*NIL*> <CSETQ ZVALUE (CAR ZDATS)>]>
              <GO ITER>
         BACK <ZRESTORE ZSAVEF>
         ITER <COND [<SETQ ZDATS (CDR ZDATS)>
                      <SETQ ZLIST ZLIST1>
                      <GO LOOP>]
                    [T <RETURN (ZCAR ZVALUE)>]>)))

(CSETQ ZFORFD
(LAMBDA (ZPAT ZLIST ZPROCS)
        (PROG <ZDATS ZLIST1 ZRNG ZRSETV ZVLD ZSAVEF ZSAVF1 Z-B (Z-I T)>
              <COND [ZRESETV <COND [<EQ (ZRESET '(ZPAT ZLIST ZPROCS
                                      ZDATS ZLIST1 ZRNG ZRSETV ZVLD
                                      ZSAVEF ZSAVF1)) Z*NIL*> <GO NEXT>]
                                   [T <GO EVAL>]>]
                    [<EQ (CAR ZLIST) 'ZVAL:>
                      <SETQ ZRNG (ZRANGES (CDR ZLIST))>
                      <SETQ ZLIST (CDDR ZLIST)>]
                    [T <SETQ ZRNG ZRANGE>]>
              <SETQ ZSAVEF ZSAVE>
              <COND [<EQ ZPROCS 'D>
                      <SETQ ZPROCS DPROCS>
                      <SETQ ZPAT (ZINSTD ZPAT)>]
                    [<EQ (*CAR ZPROCS) Z*NIL*> <SETQ ZPAT (ZINSTD ZPAT)>
                     ]
                    [T <SETQ Z-I ZINSTPF>
                       <SETQ ZDATS (ZGETAS ZPAT ZRNG)>]>
              <SETQ ZRNG (ZRANGER ZRNG)>
              <SETQ ZLIST1 ZLIST>
              <CSETQ ZVALUE *FAIL>
         LOOP <COND [ZDATS <COND [<EQ (ZFETCH ZPAT Z-I ZDATS ZRNG) *FAIL
                                    > <SETQ ZDATS NIL>]
                                 [T <SETQ ZDATS ZFETCHV>
                                    <GO CALLD>]>]>
              <COND [<EQ ZPROCS T>
                      <SETQ ZPROCS DPROCS>
                      <SETQ ZPAT (ZINSTD ZPAT)>]>
              <CSETQ ZRESETV ZRSETV>
              <COND [<OR [NULL ZPROCS]
                         [EQ (ZDEDUCE ZPAT ZPROCS ZRNG) *FAIL]>
                      <COND [Z-B <ZRESTORE ZSAVEF>]>
                      <RETURN (ZCAR ZVALUE)>]
                    [T <SETQ ZPROCS ZDEDUCEV>
                       <SETQ ZRSETV ZRESETV>
                       <SETQ ZSAVF1 ZSAVE>]>
        CALLD <ZCALLD (SETQ ZVLD ZVALD)>
              <SETQ Z-B F>
           LP <CSETQ ZVALUE (CAR ZLIST)>
         EVAL <ATTEMPT [CSETQ ZVALUE (EVAL ZVALUE)]
                       [12 <GO SUCCEED?>]
                       [13 <GO EXIT>]
                       [14 <GO NXT>]
                       [15 <GO BACK>]>
              <COND [<EQ ZVALUE *FAIL> <GO BACK>]
                    [T <ZCALLD ZVALUE>]>
         NEXT <COND [<SETQ ZLIST (CDR ZLIST)> <GO LP>]
                    [T <CSETQ ZVALUE *FAIL>
                       <GO BACK>]>
     SUCCEED? <CSETQ ZRESETV (CONS 'ZFORFD (CONS (ALIST) ZRESETV))>
              <ERROR 12>
         EXIT <COND [<EQ ZVALUE Z*NIL*> <CSETQ ZVALUE ZVLD>]>
              <RETURN (ZCAR ZVALUE)>
          NXT <COND [<EQ ZVALUE Z*NIL*> <CSETQ ZVALUE ZVLD>]>
              <GO ITER>
         BACK <COND [ZRSETV <ZRESTORE ZSAVF1>
                            <SETQ Z-B T>]
                    [T <ZRESTORE ZSAVEF>]>
         ITER <SETQ ZLIST ZLIST1>
              <GO LOOP>)))

(CSETQ ZGETAS
(LAMBDA (Z-P Z-R)
        (PROG <(Z-AL (ZATOMS Z-P)) (Z-L ZNET) (Z-N 10000) Z-N1>
         LOOP <COND [<NULL Z-AL> <GO OK>]
                    [<OR [NULL (SETQ Z-P (GET (CAR Z-AL) 'ZNET))]
                         [ZEROP (SETQ Z-N1 (CDAR Z-P))]> <RETURN NIL>]
                    [<LESSP Z-N1 Z-N>
                      <SETQ Z-N Z-N1>
                      <SETQ Z-L Z-P>]>
              <SETQ Z-AL (CDR Z-AL)>
              <GO LOOP>
           OK <SETQ Z-L (CDR Z-L)>
              <COND [<LESSP (SETQ Z-N (CAR Z-R)) (CADR Z-R)>
                      <SETQ Z-AL T>
                      <SETQ Z-L (REVERSE Z-L)>]>
         MOVE <COND [Z-AL <COND [<LESSP (CDAR Z-L) Z-N> <GO NEXT>]>]
                    [<GREATERP (CDAR Z-L) Z-N> <GO NEXT>]>
              <RETURN Z-L>
         NEXT <COND [<SETQ Z-L (CDR Z-L)> <GO MOVE>]
                    [T <RETURN NIL>]>)))

(DEFSPEC GLOBAL
(LAMBDA Z-L
        (CSETQ ZGLOBEV Z-L)
        T))

(CSETQ ZGLOBE
(LAMBDA (Z-L)
        (MAPCAR (APPEND ZGLOBEV Z-L)
         (LAMBDA (Z-A)
                 (ZLOOK (CADR Z-A))))))

(DEFSPEC GOAL
(LAMBDA (Z-PAT . Z-R)
        (COND [<NOT (EQ (ZFETCH (SETQ Z-PAT (ZINSTP Z-PAT)) ZINSTPF (
                 ZGETAS Z-PAT (SETQ Z-R (ZRANGES Z-R))) (SETQ Z-R (
                 ZRANGER Z-R))) *FAIL)> ZVALD]
              [T <CSETQ ZRESETV NIL>
                 <ZDEDUCE (ZINSTD Z-PAT) DPROCS Z-R>])))

(DEFSPEC GOTO 
(LAMBDA (Z-L)
        (PROG NIL
         LOOP <COND [<ATOM Z-L>
                      <CSETQ ZVALUE Z-L>
                      <ERROR 10>]
                    [T <SETQ Z-L (EVAL Z-L)>
                       <GO LOOP>]>)))

(DEFSPEC IFALL
(LAMBDA Z-L
        (PROG <Z-A Z-V>
         LOOP <COND [<OR [NULL Z-L]
                         [EQ (SETQ Z-A (CAR Z-L)) 'ELSE:]> <RETURN Z-V>]
                    [<EQ Z-A 'THEN:> <GO DOIT>]
                    [<AND [SETQ Z-V (EVAL Z-A)]
                          [NOT (EQ Z-V *FAIL)]>
                      <SETQ Z-L (CDR Z-L)>
                      <GO LOOP>]
                    [<NOT (SETQ Z-L (MEMBER 'ELSE: Z-L))> <RETURN *FAIL>
                     ]>
         DOIT <COND [<OR [NULL (SETQ Z-L (CDR Z-L))]
                         [EQ (SETQ Z-A (CAR Z-L)) 'ELSE:]> <RETURN Z-V>]
                    [T <SETQ Z-V (EVAL Z-A)>
                       <GO DOIT>]>)))

(DEFSPEC IF IFALL)

(DEFSPEC IFANY
(LAMBDA Z-L
        (PROG <Z-A Z-V>
         LOOP <COND [<NULL Z-L> <RETURN *FAIL>]
                    [<EQ (SETQ Z-A (CAR Z-L)) 'ELSE:> <GO DOIT>]
                    [<EQ Z-A 'THEN:>
                      <COND [<SETQ Z-L (MEMBER 'ELSE: Z-L)> <GO DOIT>]
                            [T <RETURN *FAIL>]>]
                    [<OR [NULL (SETQ Z-V (EVAL Z-A))]
                         [EQ Z-V *FAIL]>
                      <SETQ Z-L (CDR Z-L)>
                      <GO LOOP>]
                    [<NOT (SETQ Z-L (MEMBER 'THEN: Z-L))> <RETURN Z-V>]>
         DOIT <COND [<OR [NULL (SETQ Z-L (CDR Z-L))]
                         [EQ (SETQ Z-A (CAR Z-L)) 'ELSE:]> <RETURN Z-V>]
                    [T <SETQ Z-V (EVAL Z-A)>
                       <GO DOIT>]>)))

(CSETQ ZINST      ;FULL INSTANTIATION (NO PAT-FNS UNLESS QUOTED)
(LAMBDA (Z-DAT)
        (CSETQ ZINSTF F)
        (ZINST1 Z-DAT)))

(CSETQ ZINSTP     ;PATTERN INSTANTIATION (PAT-FNS OK)
(LAMBDA (Z-DAT)
        (CSETQ ZINSTF 'P)
        (CSETQ ZINSTPF F)
        (ZINST1 Z-DAT)))

(CSETQ ZINSTD     ;DEDUCE-PATTERN INSTANTIATION (ONLY ? OR ?X)
(LAMBDA (Z-DAT)
        (CSETQ ZINSTF 'D)
        (ZINST1 Z-DAT)))

(CSETQ ZINSTR     ;RE-INSTANTIATE DEDUCE-PATTERN AFTER DEDUCTION
(LAMBDA (Z-DAT)
        (CSETQ ZINSTF 'R)
        (ZINST1 Z-DAT)))

(CSETQ ZINSTPD
(LAMBDA (Z-DAT)
        (SETQ Z-DAT (ZINSTP Z-DAT))
        (COND [ZINSTPF <ZINSTD Z-DAT>]
              [T Z-DAT])))

(CSETQ ZINST1
(LAMBDA (Z-DAT)
        (PROG <Z-C Z-F>
         LOOP <COND [<EQ ZINSTF 'P>
                      <COND [<ZINSTP? Z-DAT> <RETURN Z-DAT>]>]
                    [<ZINST? Z-DAT> <RETURN Z-DAT>]>
              <COND [<ATOM (SETQ Z-C (CAR Z-DAT))>
                      <COND [<OR [NOT (IFTYPE Z-C 7)]
                                 [NOT (IFFLAG Z-C 'ZPATF)]> <GO CONS>]
                            [<EQ Z-C 'QUOTE> <RETURN (CADR Z-DAT)>]
                            [<SETQ Z-F (GET Z-C 'ZPATEI)>
                              <SETQ Z-DAT (Z-F (CADR Z-DAT))>
                              <GO LOOP>]
                            [<EQ ZINSTF 'R>
                              <RETURN (ZLOOK! (CADR Z-DAT))>]
                            [<AND [EQ ZINSTF 'D]
                                  [EQ Z-C '*?]>
                              <COND [<NULL (CDR Z-DAT)>
                                      <SETQ Z-DAT (LIST '*? (GENSYM))>]>
                              <ZLOOK (CADR Z-DAT)>
                              <RETURN Z-DAT>]
                            [T <ZERROR "CAN'T INSTANTIATE " Z-DAT>]>]
                    [<AND [IFTYPE (SETQ Z-F (CAR Z-C)) 7]
                          [SETQ Z-F (GET Z-F 'ZPATES)]>
                      <SETQ Z-DAT (APPEND (Z-F (CADR Z-C)) (CDR Z-DAT))>
                      <GO LOOP>]
                    [T <SETQ Z-C (ZINST1 Z-C)>]>
         CONS <RETURN (CONS Z-C (ZINST1 (CDR Z-DAT)))>)))

(CSETQ ZINST?
(LAMBDA (Z-DAT)
        (CSETQ ZINST?F T)
        (ATTEMPT [ZINST?1 (ZVALV Z-DAT)]
                 [2 NIL])))

(CSETQ ZINSTP?
(LAMBDA (Z-DAT)
        (CSETQ ZINST?F F)
        (ATTEMPT [ZINST?1 (ZVALV Z-DAT)]
                 [2 NIL])))

(CSETQ ZINST?1
(LAMBDA (Z-DAT)
        (PROG <Z-C>
              <RETURN
               (COND [<ATOM Z-DAT> T]
                     [<AND [IFTYPE (SETQ Z-C (CAR Z-DAT)) 7]
                           [IFFLAG Z-C 'ZPATF]>
                       <COND [<OR ZINST?F
                                  [EQ Z-C 'QUOTE]
                                  [GET Z-C 'ZPATEI]
                                  [GET Z-C 'ZPATES]> <ERROR 2>]
                             [T <CSETQ ZINSTPF T>]>]
                     [T <MAPC Z-DAT ZINST?1>
                        T])>)))

(CSETQ ZLOOK
(LAMBDA (Z-A)
        (COND [<ASSOC Z-A ZALIST>]
              [T <SETQ ZALIST (CONS (SETQ Z-A (CONS Z-A (CONS NIL Z*NIL*
                  ))) ZALIST)>
                 Z-A])))

(CSETQ ZLOOK!
(LAMBDA (Z-A)
        (COND [<ZLOOK? Z-A> ZLOOKV]
              [T <ZERROR "UNBOUND !" Z-A>])))

(CSETQ ZLOOK?
(LAMBDA (Z-A)
        (NOT (EQ (CSETQ ZLOOKV (CDDR (ZLOOK Z-A))) Z*NIL*))))

(DEFSPEC MATCH
(LAMBDA (Z-PAT Z-DAT)
        (COND [<ZMATCH (ZINSTP Z-PAT) (ZVALV (SETQ Z-DAT (ZINST Z-DAT)))
                 > Z-DAT]
              [T *FAIL])))

(CSETQ ZMATCH
(LAMBDA (Z-PAT Z-DAT)
        (PROG <(Z-SAVE ZSAVE)>
              <ATTEMPT [DO <ZMATCH1 Z-PAT Z-DAT>
                           <RETURN T>]
                       [1 <ZRESTORE Z-SAVE>
                          <RETURN F>]>)))

(CSETQ ZMATCH1
(LAMBDA (Z-PAT Z-DAT)
        (PROG <Z-C Z-C1 Z-F>
              <COND [<AND [NOT (ATOM Z-PAT)]
                          [EQ (SETQ Z-C (CAR Z-PAT)) '*?Q]>
                      <RETURN (ZBIND (CADR Z-PAT) Z-DAT)>]
                    [<AND [NOT (ATOM Z-DAT)]
                          [EQ (CAR Z-DAT) '*?]>
                      <SETQ Z-DAT (CDR (ASSOC (CADR Z-DAT) ZALIST1))>
                      <COND [<ZINST? Z-PAT>
                              <RETURN (ZPLACD Z-DAT Z-PAT)>]
                            [<AND [EQ (CAR Z-PAT) '*?]
                                  [CDR Z-PAT]>
                              <ZPLACD (ZLOOK (CADR Z-PAT)) Z-DAT>
                              <RETURN (ZPLACD Z-DAT Z*NIL*)>]
                            [T <ERROR 1>]>]
                    [<ATOM Z-PAT> <GO ATOM>]
                    [<NOT (ATOM Z-C)> <GO GO>]
                    [<OR [NOT (IFTYPE Z-C 7)]
                         [NOT (IFFLAG Z-C 'ZPATF)]> <GO MCAR>]
                    [<NOT (SETQ Z-F (GET Z-C 'ZPATMI))>
                      <ZERROR "ILLEGAL PATTERN: " Z-PAT>]
                    [<ZINST? Z-DAT> <RETURN (Z-F (CDR Z-PAT) Z-DAT)>]
                    [T <ERROR 1>]>
         LOOP <COND [<ATOM Z-PAT> <GO ATOM>]
                    [<ATOM (SETQ Z-C (CAR Z-PAT))> <GO MCAR>]>
           GO <COND [<AND [IFTYPE (SETQ Z-C1 (CAR Z-C)) 7]
                          [IFFLAG Z-C1 'ZPATF]>
                      <COND [<AND Z-DAT
                                  [ATOM Z-DAT]> <ERROR 1>]
                            [<SETQ Z-F (GET Z-C1 'ZPATMS)>
                              <RETURN (Z-F (CDR Z-C) (CDR Z-PAT) Z-DAT)>
                             ]>]>
         MCAR <COND [<ATOM Z-DAT> <ERROR 1>]>
              <ZMATCH1 Z-C (CAR Z-DAT)>
              <SETQ Z-DAT (CDR Z-DAT)>
              <SETQ Z-PAT (CDR Z-PAT)>
              <GO LOOP>
         ATOM <COND [<EQUAL Z-PAT Z-DAT> <RETURN T>]
                    [T <ERROR 1>]>)))

(CSETQ ZMEMB
(LAMBDA (Z-A Z-L)
        (PROG <Z-N>
         LOOP <COND [<NULL (SETQ Z-N (CDR Z-L))> <RETURN NIL>]
                    [<EQ Z-A (CAR Z-N)> <RETURN Z-L>]
                    [T <SETQ Z-L Z-N>
                       <GO LOOP>]>)))

(CSETQ ZMEMBC
(LAMBDA (Z-A Z-L)
        (PROG <Z-N>
         LOOP <COND [<NULL (SETQ Z-N (CDR Z-L))> <RETURN NIL>]
                    [<EQUAL Z-A (CAAR Z-N)> <RETURN Z-L>]
                    [T <SETQ Z-L Z-N>
                       <GO LOOP>]>)))

(CSETQ ZMEMBN
(LAMBDA (Z-A Z-L)
        (PROG <Z-N>
         LOOP <COND [<NULL (SETQ Z-N (CDR Z-L))> <RETURN Z-L>]
                    [<GREATERP (CDAR Z-N) Z-A>
                      <SETQ Z-L Z-N>
                      <GO LOOP>]
                    [T <RETURN Z-L>]>)))

(DEFSPEC NEXT
(LAMBDA Z-L
        (ZSETV Z-L)
        (ERROR 14)))

(DEFSPEC NOHASH
(LAMBDA Z-L
        (MAPC Z-L
         (LAMBDA (Z-A)
                 (FLAG Z-A 'NOHASH)))
        T))

(CSETQ ZNOT
(LAMBDA (Z-E)
        (ZCONS (ZVALV Z-E) (DIFFERENCE ZHIGH (ZVALZ Z-E)))))

(DEFSPEC ZOR
(LAMBDA Z-L
        (ZANDOR Z-L ZLOW F)))

(CSETQ ZPLACD
(LAMBDA (Z-L Z-E)
        (COND [<NOT (EQ Z-E (CDR Z-L))>
                <CSETQ ZSAVE (CONS (CONS Z-L (CDR Z-L)) ZSAVE)>
                <RPLACD Z-L Z-E>])))

(DEFSPEC POP
(LAMBDA (Z-V)
        (PROG <Z-A>
              <COND [<ATOM (SETQ Z-A (EVAL Z-V))>
                      <ZERROR "CAN'T POP " Z-A>]
                    [T <ZSET Z-V (CDR Z-A)>
                       <RETURN (CAR Z-A)>]>)))

(DEFSPEC PROC
(LAMBDA Z-L
        (PROG <(Z-L1 Z-L) Z-P Z-V Z-NM Z-GL (Z-DE *DEMON) (Z-TH ZLOW) (
               Z-AC ZHIGH)>
         LOOP <SETQ Z-P (CAR Z-L)>
              <SETQ Z-V (CADR Z-L)>
              <COND [<EQ Z-P 'NAME:> <SETQ Z-NM Z-V>]
                    [<EQ Z-P 'GLOBAL:> <SETQ Z-GL Z-V>]
                    [<EQ Z-P 'DEMON:> <SETQ Z-DE (EVAL Z-V)>]
                    [<EQ Z-P 'THRESH:> <SETQ Z-TH (EVAL Z-V)>]
                    [<EQ Z-P 'ACCUM:> <SETQ Z-AC (EVAL Z-V)>]
                    [Z-NM <GO OK>]
                    [T <SETQ Z-NM (COMPRESS (EXPLODE (GENSYM '*PROC)))>
                       <GO OK>]>
              <SETQ Z-L (CDDR Z-L)>
              <GO LOOP>
           OK <PUT Z-NM 'PROC Z-L1>
              <PUT Z-NM 'PDEF (LIST Z-P Z-GL Z-DE Z-TH Z-AC (CDR Z-L))>
              <EVAL (LIST 'DEFSPEC Z-NM (LIST 'LAMBDA '(Z-DAT) (LIST '
               ZCALL (LIST 'QUOTE Z-NM) '(ZINSTPD Z-DAT))))>
              <RETURN Z-NM>)))

(CSETQ *DEMON
(LAMBDA (Z-E Z-TH Z-AC)
        (COND [<EQ Z-E *FAIL> <FAIL>]
              [<EQ Z-E *DONE> Z-AC]
              [<LESSP (SETQ Z-E (ZVALZ Z-E)) Z-TH> <FAIL>]
              [<LESSP Z-E Z-AC> Z-E]
              [T Z-AC])))

(CSETQ ZPROCN
(LAMBDA (Z-NM Z-L Z-C Z-V)
        (PROG <Z-D Z-D1>
              <COND [<NOT (ATOM Z-NM)> <SETQ Z-NM (EVAL Z-NM)>]>
              <COND [<NOT (SETQ Z-D (GET Z-NM 'PDEF))>
                      <ZERROR Z-NM " IS NOT A PROC">]>
              <SETQ Z-C (CAR (SETQ Z-D (Z-C Z-D)))>
              <COND [<NULL Z-V> <RETURN Z-C>]
                    [T <RPLACA Z-D (EVAL (SETQ Z-V (CAR Z-V)))>]>
              <COND [<SETQ Z-D1 (MEMBER Z-L (SETQ Z-D (GET Z-NM 'PROC)))
                       > <RPLACA (CDR Z-D1) Z-V>]
                    [T <PUT Z-NM 'PROC (CONS Z-L (CONS Z-V Z-D))>]>
              <RETURN Z-C>)))

(CSETQ ZPROC
(LAMBDA (ZDEMON ZTHRSH ZACCUM ZLIST)
        (PROG <ZLIST1 ZSAVEP>
              <COND [ZRESETV <COND [<EQ (ZRESET '(ZSAVED ZALIST ZDEMON
                                      ZTHRSH ZACCUM ZLIST ZLIST1 ZSAVEP)
                                      ) Z*NIL*> <GO NEXT>]
                                   [T <GO EVAL>]>]>
              <SETQ ZSAVEP ZSAVE>
              <SETQ ZLIST1 ZLIST>
         LOOP <COND [<ATOM (CSETQ ZVALUE (CAR ZLIST))> <GO NEXT>]>
         EVAL <ATTEMPT [ZCALLD (EVAL ZVALUE)]
                       [10 <GO GOTO>]
                       [11 <GO SUCCEED>]
                       [12 <GO SUCCEED?>]
                       [13 <ZERROR "ILLEGAL EXIT">]
                       [14 <ZERROR "ILLEGAL NEXT">]
                       [15 <ZERROR "ILLEGAL BACK">]>
         NEXT <COND [<SETQ ZLIST (CDR ZLIST)> <GO LOOP>]
                    [T <CSETQ ZVALUE Z*NIL*>]>
      SUCCEED <CSETQ ZRESETV NIL>
              <GO DONE>
         GOTO <COND [<SETQ ZLIST (MEMBER ZVALUE ZLIST1)> <GO NEXT>]
                    [T <ZERROR "GOTO " ZVALUE " ILLEGAL">]>
     SUCCEED? <CSETQ ZRESETV (CONS (ALIST) ZRESETV)>
         DONE <ZCALLD *DONE>
              <COND [<EQ ZVALUE Z*NIL*>
                      <CSETQ ZVALUE (CONS Z*NIL* ZACCUM)>]>
              <RETURN ZVALUE>)))

(CSETQ ZPROC?
(LAMBDA (Z-A)
        (COND [<OR [EQ Z-A 'DEDUCE:]
                   [EQ Z-A 'D:]> DPROCS]
              [<OR [EQ Z-A 'ASSERT:]
                   [EQ Z-A 'A:]> APROCS]
              [<OR [EQ Z-A 'ERASE:]
                   [EQ Z-A 'E:]> EPROCS])))

(DEFSPEC PUSH
(LAMBDA (Z-V Z-E)
        (ZSET Z-V (CONS (EVAL Z-E) (EVAL Z-V)))))

(CSETQ ZRANGEP
(LAMBDA (Z-Z Z-R)
        (COND [<GREATERP Z-Z (CAR Z-R)> F]
              [<LESSP Z-Z (CADR Z-R)> F]
              [T])))

(CSETQ ZRANGER
(LAMBDA (Z-R)
        (COND [<LESSP (CAR Z-R) (CADR Z-R)> <REVERSE Z-R>]
              [T Z-R])))

(CSETQ ZRANGES
(LAMBDA (Z-R)
        (COND [<NULL Z-R> ZRANGE]
              [<NOT (ATOM (SETQ Z-R (ZINST (CAR Z-R))))> Z-R]
              [T <LIST ZHIGH Z-R>])))

(DEFSPEC REMOVE
(LAMBDA (Z-DAT . Z-P)
        (PROG <Z-L>
              <COND [<NOT (SETQ Z-L (ZPROC? Z-DAT))>
                      <RETURN (ZREMOVE (ZINST Z-DAT))>]
                    [<NOT (ATOM (SETQ Z-P (CAR Z-P)))>
                      <SETQ Z-P (EVAL Z-P)>]>
              <COND [<SETQ Z-L (ZMEMB Z-P Z-L)>
                      <ZPLACD Z-L (CDDR Z-L)>
                      <RETURN Z-P>]
                    [T <RETURN *FAIL>]>)))

(CSETQ ZREMOVE
(LAMBDA (Z-DAT)
        (PROG <Z-L>
              <COND [<SETQ Z-L (ZMEMBC Z-DAT ZNET)>
                      <SETQ Z-DAT (CADR Z-L)>
                      <ZPLACD Z-L (CDDR Z-L)>]
                    [T <RETURN *FAIL>]>
              <MAPC (ZATOMS (CAR Z-DAT))
               (LAMBDA (Z-A)
                       (SETQ Z-L (GET Z-A 'ZNET))
                       (ZPLACD (CAR Z-L) (SUB1 (CDAR Z-L)))
                       (ZPLACD (SETQ Z-L (ZMEMB Z-DAT Z-L)) (CDDR Z-L)))
               >
              <RETURN (ZCAR Z-DAT)>)))

(CSETQ ZRESET
(LAMBDA (Z-L)
        (CSETQ ZVALUE (CAR ZRESETV))
        (MAPC Z-L
         (LAMBDA (Z-A)
                 (SET Z-A (CDR (ASSOC Z-A ZVALUE)))))
        (COND [<NULL (CSETQ ZRESETV (CDR ZRESETV))> Z*NIL*]
              [T <CSETQ ZVALUE (CONS (CAR ZRESETV) '(T T T))>
                 <CSETQ ZRESETV (CDR ZRESETV)>])))

(CSETQ RESTORE
(LAMBDA Z-L
        (ZRESTORE
         (COND [Z-L <CAR Z-L>]
               [T ZSAVEP]))))

(CSETQ ZRESTORE
(LAMBDA (Z-L)
        (PROG NIL
         LOOP <COND [<EQ Z-L ZSAVE> <RETURN T>]
                    [<NULL ZSAVE> <ZERROR "BACKTRACK ERROR">]>
              <RPLACD (CAAR ZSAVE) (CDAR ZSAVE)>
              <CSETQ ZSAVE (CDR ZSAVE)>
              <GO LOOP>)))

(CSETQ SAVE
(LAMBDA NIL
        ZSAVE))

(CSETQ ZSET
(LAMBDA (Z-V Z-E)
        (COND [<ATOM Z-V> <SET Z-V Z-E>]
              [T <ZBIND (CADR Z-V) Z-E>])))

(CSETQ ZSETV
(LAMBDA (Z-L)
        (COND [<NULL Z-L> <CSETQ ZVALUE Z*NIL*>]
              [<DO <CSETQ ZVALUE (ZINST (CAR Z-L))>
                   <CDR Z-L>>
                <CSETQ ZVALUE (ZCONS ZVALUE (EVAL (CADR Z-L)))>])))

(DEFSPEC STATE
(LAMBDA Z-F
        (COND [<OR [NULL Z-F]
                   [EQ (CAR Z-F) 'NET]>
                <PRINT "NET:">
                <MAPC (CDR ZNET) PRINT>])
        (COND [<OR [NULL Z-F]
                   [EQ (CAR Z-F) 'PROCS]>
                <PRIN1 "DPROCS: ">
                <PRINT (CDR DPROCS)>
                <PRIN1 "APROCS: ">
                <PRINT (CDR APROCS)>
                <PRIN1 "EPROCS: ">
                <PRINT (CDR EPROCS)>])
        T))

(DEFSPEC SUCCEED
(LAMBDA Z-L
        (ZSETV Z-L)
        (ERROR 11)))

(DEFSPEC SUCCEED!
(LAMBDA Z-L
        (ZSETV Z-L)
        (CSETQ ZSAVE ZSAVEP)
        (ERROR 11)))

(DEFSPEC SUCCEED?
(LAMBDA Z-L
        (ZSETV Z-L)
        (COND [ZSUCCEED?
                <CSETQ ZRESETV NIL>
                <ERROR 12>]
              [T <ERROR 11>])))

(DEFSPEC THRESH:
(LAMBDA (Z-NM . Z-V)
        (ZPROCN Z-NM 'THRESH: CDDDDR Z-V)))

(DEFSPEC TRY
(LAMBDA (Z-L Z-PAT . Z-R)
        (CSETQ ZRESETV NIL)
        (ZDEDUCE (ZINSTPD Z-PAT) (RPLACD '(NIL) (ZINST Z-L)) (ZRANGER (
         ZRANGES Z-R)))))

(CSETQ VAL
(LAMBDA Z-E
        (ZVALV
         (COND [Z-E <CAR Z-E>]
               [T ZVALD]))))

(CSETQ ZVAL
(LAMBDA Z-E
        (ZVALZ
         (COND [Z-E <CAR Z-E>]
               [T ZVALD]))))

(CSETQ ZVALV
(LAMBDA (Z-E)     
        (COND [<ATOM Z-E> Z-E]
              [<NUMBERP (CDR Z-E)> <CAR Z-E>]
              [T Z-E])))

(CSETQ ZVALZ
(LAMBDA (Z-E)
        (COND [<EQ Z-E *FAIL> ZLOW]
              [<ATOM Z-E> ZHIGH]
              [<NUMBERP (SETQ Z-E (CDR Z-E))> Z-E]
              [T ZHIGH])))

(DEFSPEC *!
(LAMBDA (Z-A)
        (COND [<NOT (ATOM Z-A)> <ZINST Z-A>]
              [T <ZLOOK! Z-A>])))

(CSETQ *&
(LAMBDA (Z-A)
        Z-A))

(PUT '*! 'ZPATEI
(LAMBDA (Z-A)
        (COND [<NOT (ATOM Z-A)> Z-A]
              [<ZLOOK? Z-A> ZLOOKV]
              [T <LIST '*? Z-A>])))

(PUT '*& 'ZPATEI
(LAMBDA (Z-A)
        (EVAL Z-A)))

(PUT '*!! 'ZPATES
(LAMBDA (Z-A)
        (COND [<NOT (ATOM Z-A)> Z-A]
              [<NOT (ZLOOK? Z-A)> <LIST (LIST '*?? Z-A)>]
              [<ATOM ZLOOKV> NIL]
              [T ZLOOKV])))

(PUT '*&& 'ZPATES
(LAMBDA (Z-A)
        (COND [<ATOM (SETQ Z-A (EVAL Z-A))> NIL]
              [T Z-A])))

(PUT '*? 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (COND [Z-ARGS <ZBIND (CAR Z-ARGS) Z-DAT>])))

(PUT '*AND 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (PROG NIL
         LOOP <COND [Z-ARGS <ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT>
                            <SETQ Z-ARGS (CDR Z-ARGS)>
                            <GO LOOP>]>)))

(PUT '*ANY 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (COND [<MEMBER Z-DAT (ZINST (CADR Z-ARGS))> 
                <ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT>]
              [T <ERROR 1>])))

(PUT '*CON 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (CSETQ ZTEMPV (ZINST (CADR Z-ARGS)))
        (ATTEMPT [DO <Z*CON Z-DAT>
                     <ERROR 1>]
                 [2 <ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT>])))

(CSETQ Z*CON
(LAMBDA (Z-DAT)
        (COND [<EQUAL ZTEMPV Z-DAT> <ERROR 2>]
              [<NOT (ATOM Z-DAT)> <MAPC Z-DAT Z*CON>])))

(PUT '*NOT 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (COND [<ZMATCH (ZINSTP (CADR Z-ARGS)) Z-DAT> <ERROR 1>]
              [T <ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT>])))

(PUT '*OR 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (PROG NIL
         LOOP <COND [<NULL Z-ARGS> <ERROR 1>]
                    [<NOT (ZMATCH (ZINSTP (CAR Z-ARGS)) Z-DAT)>
                      <SETQ Z-ARGS (CDR Z-ARGS)>
                      <GO LOOP>]>)))

(PUT '*R 'ZPATMI
(LAMBDA (Z-ARGS Z-DAT)
        (ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT)
        (COND [<AND [CDR Z-ARGS]
                    [OR [NULL (SETQ Z-ARGS (EVAL (CADR Z-ARGS)))]
                        [EQ Z-ARGS *FAIL]]> <ERROR 1>])))

(PUT '*LEN 'ZPATMS
(LAMBDA (Z-ARGS Z-PAT Z-DAT)
        (PROG <(Z-N (EVAL (CADR Z-ARGS))) Z-L>
              <COND [<ZEROP Z-N> <GO DONE>]>
         LOOP <COND [<OR [NULL Z-DAT]
                         [NOT (ZINST? (CAR Z-DAT))]> <ERROR 1>]>
              <SETQ Z-L (NCONC Z-L (LIST (CAR Z-DAT)))>
              <SETQ Z-DAT (CDR Z-DAT)>
              <COND [<NOT (ZEROP (SETQ Z-N (SUB1 Z-N)))> <GO LOOP>]>
              <ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-L>
         DONE <ZMATCH1 Z-PAT Z-DAT>)))

(PUT '*OPT 'ZPATMS
(LAMBDA (Z-ARGS Z-PAT Z-DAT)
        (COND [<AND Z-DAT
                    [ZINST? (CAR Z-DAT)]
                    [ZMATCH (ZINSTP (CAR Z-ARGS)) (CAR Z-DAT)]>
                <SETQ Z-DAT (CDR Z-DAT)>])
        (ZMATCH1 Z-PAT Z-DAT)))

(PUT '*REP 'ZPATMS
(LAMBDA (Z-ARGS Z-PAT Z-DAT)
        (PROG <(Z-P (ZINSTP (CAR Z-ARGS))) Z-N>
              <COND [<CDR Z-ARGS>
                      <SETQ Z-N (EVAL (CADR Z-ARGS))>
                      <GO LOOP>]>
           LP <COND [<AND Z-DAT
                          [ZINST? (CAR Z-DAT)]
                          [ZMATCH Z-P (CAR Z-DAT)]>
                      <SETQ Z-DAT (CDR Z-DAT)>
                      <GO LP>]
                    [T <GO DONE>]>
         LOOP <COND [<ZEROP Z-N> <GO DONE>]
                    [<OR [NULL Z-DAT]
                         [NOT (ZINST? (CAR Z-DAT))]> <ERROR 1>]>
              <ZMATCH1 Z-P (CAR Z-DAT)>
              <SETQ Z-DAT (CDR Z-DAT)>
              <SETQ Z-N (SUB1 Z-N)>
              <GO LOOP>
         DONE <ZMATCH1 Z-PAT Z-DAT>)))

(PUT '*?? 'ZPATMS
(LAMBDA (Z-ARGS Z-PAT Z-DAT)
        (Z*?? Z-ARGS Z-PAT Z-DAT F)))

(PUT '*??/ 'ZPATMS
(LAMBDA (Z-ARGS Z-PAT Z-DAT)
        (Z*?? Z-ARGS Z-PAT Z-DAT T)))

(CSETQ Z*??
(LAMBDA (Z-ARGS Z-PAT Z-DAT Z-/)
        (PROG <Z-N Z-L>
              <COND [Z-ARGS <SETQ Z-N (CAR Z-ARGS)>]>
              <COND [<NULL Z-PAT>
                      <COND [<NOT (ZINST? Z-DAT)> <ERROR 1>]
                            [Z-/ <RETURN (ZBIND Z-N (LENGTH Z-DAT))>]
                            [Z-N <RETURN (ZBIND Z-N Z-DAT)>]
                            [T <RETURN T>]>]>
              <COND [Z-/ <SETQ Z-L 0>]>
         LOOP <COND [Z-N <ZBIND Z-N Z-L>]>
              <COND [<ZMATCH Z-PAT Z-DAT> <RETURN T>]
                    [<OR [NULL Z-DAT]
                         [NOT (ZINST? (CAR Z-DAT))]> <ERROR 1>]
                    [Z-/ <SETQ Z-L (ADD1 Z-L)>]
                    [Z-N <SETQ Z-L (NCONC Z-L (LIST (CAR Z-DAT)))>]>
              <SETQ Z-DAT (CDR Z-DAT)>
              <GO LOOP>)))

(FLAG '*! 'ZPATF)
(FLAG '*!! 'ZPATF)
(FLAG '*& 'ZPATF)
(FLAG '*&& 'ZPATF)
(FLAG '*? 'ZPATF)
(FLAG '*?Q 'ZPATF)
(FLAG '*?? 'ZPATF)
(FLAG '*??/ 'ZPATF)
(FLAG '*AND 'ZPATF)
(FLAG '*ANY 'ZPATF)
(FLAG '*CON 'ZPATF)
(FLAG '*LEN 'ZPATF)
(FLAG '*NOT 'ZPATF)
(FLAG '*OPT 'ZPATF)
(FLAG '*OR 'ZPATF)
(FLAG '*R 'ZPATF)
(FLAG '*REP 'ZPATF)
(FLAG 'QUOTE 'ZPATF)

(CSETQ ZHIGH 1)
(CSETQ ZLOW 0)
(CSETQ ZRANGE '(1 0))
(CSETQ *FAIL '*FAIL)
(CSETQ Z*NIL* 'Z*NIL*)
(CSETQ *DONE '*DONE)
(CSETQ ZNET '(NIL))
(CSETQ DPROCS '(NIL))
(CSETQ APROCS '(NIL))
(CSETQ EPROCS '(NIL))
(CSETQ ZSAVE 'NIL)
(CSETQ ZGLOBEV 'NIL)

(CSETQ $TRACEP
(LAMBDA (Z-AL . Z-L)
        (SETQ Z-AL (LIST 'MEMBER '($ 1) (LIST 'QUOTE (DB-LIST Z-AL))))
        (COND [Z-L <RPLACA Z-L (LIST 'AND Z-AL (CAR Z-L))>
                   <COND [<AND [CDR Z-L]
                               [CDDR Z-L]>
                           <RPLACA (CDDR Z-L) (LIST 'AND Z-AL (CADDR Z-L
                            ))>]>]
              [T <SETQ Z-L (LIST Z-AL)>])
        ($TRACE 'ZCALLP (STACK Z-L))))

(CSETQ $BREAKP
(LAMBDA (Z-AL . Z-L)    
        (SETQ Z-AL (LIST 'MEMBER '($ 1) (LIST 'QUOTE (DB-LIST Z-AL))))
        (COND [Z-L <RPLACA Z-L (LIST 'AND Z-AL (CAR Z-L))>
                   <COND [<CDR Z-L>
                           <RPLACA (CDR Z-L) (LIST 'AND Z-AL (CADR Z-L))
                            >]>]
              [T <SETQ Z-L (LIST Z-AL)>])
        ($BREAK 'ZCALLP (STACK Z-L))))

(CSETQ LOADEDIT
(LAMBDA NIL
        (LOAD '(L . EDIT))
        (DEFSPEC ZEDIT EDIT)
        (DEFSPEC EDIT ZEDIT1)
        "EDITOR LOADED"))

(DEFSPEC ZEDIT1
(LAMBDA (V-F)
        (PROG <V-D>
              <COND [<NOT (SETQ V-D (GET V-F 'PROC))>
                      <RETURN (EVAL (LIST 'ZEDIT V-F))>]
                    [<NOT (MEMBER 'NAME: V-D)>
                      <SETQ V-D (CONS 'NAME: (CONS V-F V-D))>]>
              <RETURN (EVAL (EDIT1 (CONS 'PROC V-D)))>)))

(CSETQ LOADPRETTYP
(LAMBDA NIL
        (LOAD '(L . PRETTYP))
        (CSETQ ZP-SCAN PP-SCAN)
        (CSETQ PP-SCAN ZP-SCAN1)
        "PRETTYPRINTER LOADED"))

(CSETQ ZP-SCAN1
(LAMBDA (PP-A)
        (PROG <PP-D>
              <COND [<OR [NOT (ATOM PP-A)]
                         [NOT (SETQ PP-D (GET PP-A 'PROC))]>
                      <RETURN (ZP-SCAN PP-A)>]>
              <SETQ PP-D (CONS 'PROC PP-D)>
              <COND [<MEMBER PP-A DPROCS>
                      <SETQ PP-D (LIST 'ADD 'DEDUCE: PP-D)>]
                    [<MEMBER PP-A APROCS>
                      <SETQ PP-D (LIST 'ADD 'ASSERT: PP-D)>]
                    [<MEMBER PP-A EPROCS>
                      <SETQ PP-D (LIST 'ADD 'ERASE: PP-D)>]>
              <PP-PPP PP-D 0 "(" ")">
              <TERPRI (STACK PP-FILE)>)))

(CSETQ PP-FOR
(LAMBDA (PP-SEXP PP-FLG)
        (COND [PP-FLG <PP-PPP (CAR PP-SEXP) PP-INDENT "[" "]">
                      <CDR PP-SEXP>]
              [T <SETQ PP-FLG (LIST (CAR PP-SEXP) (CADR PP-SEXP))>
                 <SETQ PP-SEXP (CDDR PP-SEXP)>
                 <COND [<OR [EQ (CAR PP-FLG) 'TRY:]
                            [EQ (CAR PP-FLG) 'T:]>
                         <NCONC PP-FLG (LIST (CAR PP-SEXP))>
                         <SETQ PP-SEXP (CDR PP-SEXP)>]>
                 <COND [<EQ (CAR PP-SEXP) 'ZVAL:>
                         <NCONC PP-FLG (LIST 'ZVAL: (CADR PP-SEXP))>
                         <SETQ PP-SEXP (CDDR PP-SEXP)>]>
                 <PP-PLIST PP-FLG PP-INDENT "[" "]" F>
                 PP-SEXP])))

(CSETQ PP-PROC
(LAMBDA (PP-SEXP PP-FLG)
        (PROG <PP-L>
              <COND [PP-FLG <RETURN (PP-PROG PP-SEXP T)>]>
         LOOP <COND [<MEMBER (CAR PP-SEXP) '(NAME: GLOBAL: DEMON: ACCUM:
                       THRESH:)>
                      <SETQ PP-L (NCONC PP-L (LIST (CAR PP-SEXP) (CADR
                       PP-SEXP)))>
                      <SETQ PP-SEXP (CDDR PP-SEXP)>
                      <GO LOOP>]>
              <PP-PLIST (NCONC PP-L (LIST (CAR PP-SEXP))) PP-INDENT "<"
               ">" F>
              <RETURN (CDR PP-SEXP)>)))

(PUT 'FOR 'PP-PP '(T T PP-FOR))
(PUT 'PROC 'PP-PP '(T T PP-PROC))
(PUT 'IFALL 'PP-PP '(T T PP-PROG))
(PUT 'IFANY 'PP-PP '(T T PP-PROG))
(PUT 'IF 'PP-PP '("<" ">" F))
(PUT 'DO! 'PP-PP '("<" ">" T))
(PUT 'DO? 'PP-PP '("<" ">" T))
(PUT 'ZAND 'PP-PP '("[" "]" T))
(PUT 'ZOR 'PP-PP '("[" "]" T))
(PUT '*! 'PP-MAC "!")
(PUT '*!! 'PP-MAC "!!")
(PUT '*& 'PP-MAC "&")
(PUT '*&& 'PP-MAC "&&")
(PUT '*? 'PP-MAC "?")
(PUT '*?Q 'PP-MAC "?'")
(PUT '*?? 'PP-MAC "??")
(PUT '*??/ 'PP-MAC "??/")

(CSETQ FUZZYDUMP '(";" "\" "!" "&" "?" ACCUM: ADD ZADD ZAND ZANDOR
         ASSERT ZATOMS ZATOM1 BACK BIND BIND! ZBIND BOUND ZCALL ZCALLP
         ZCALLD ZCALLEM ZCAR ZCONS DEDUCE ZDEDUCE DEMON: DO? DO! DUMPNET
         ZERROR *ERASE ERASE EXIT FAIL FETCH ZFETCH FINALIZE FLUSH FOR
         ZFOR ZFORFD ZGETAS GLOBAL ZGLOBE GOAL GOTO IFALL IFANY ZINST
         ZINSTP ZINSTD ZINSTR ZINSTPD ZINST1 ZINST? ZINSTP? ZINST?1
         ZLOOK ZLOOK! ZLOOK? MATCH ZMATCH ZMATCH1 ZMEMB ZMEMBC ZMEMBN
         NEXT NOHASH ZNOT ZOR ZPLACD POP PROC *DEMON ZPROCN ZPROC ZPROC?
         PUSH ZRANGEP ZRANGER ZRANGES REMOVE ZREMOVE ZRESET RESTORE
         ZRESTORE SAVE ZSET ZSETV STATE SUCCEED SUCCEED! SUCCEED?
         THRESH: TRY VAL ZVAL ZVALV ZVALZ *! *& (ZPATEI *! *&) (ZPATES
         *!! *&&) (ZPATMI *? *AND *ANY *CON) Z*CON (ZPATMI *NOT *OR *R)
         (ZPATMS *LEN *OPT *REP *?? *??/) Z*?? (ZPATF *! *!! *& *&& *?
         *?Q *?? *??/ *AND *ANY *CON *LEN *NOT *OPT *OR *R *REP QUOTE)
         ZHIGH ZLOW ZRANGE *FAIL Z*NIL* *DONE ZNET DPROCS APROCS EPROCS
         ZSAVE ZGLOBEV $TRACEP $BREAKP LOADEDIT ZEDIT1 LOADPRETTYP
         ZP-SCAN1 PP-FOR PP-PROC (PP-PP FOR PROC IFALL IFANY IF DO! DO?
         ZAND ZOR) (PP-MAC *! *!! *& *&& *? *?Q *?? *??/) FUZZYDUMP))
(SETQ ZALIST NIL)
(SETQ ZDEMON NIL)
(SETQ ZSAVEP NIL)

"FUZZY LOADED"