(SETQ FNS @(METEOR METRIX
                  METRIX2
                  COMITRULE
                  TRANSFER
                  DISPATCH
                  GTPAIR
                  FSTATM
                  SHELVE
                  SETDIS
                  GETDCT
                  INDIRECT
                  COMITR
                  COMITRIN
                  GTNAME
                  COPYTP
                  EXPAND
                  COMPRESS
                  MTREAD
                  ALL
                  NEXT
                  GTSHLF
                  SBMERGE
                  COMITMATCH
                  CMATCH
                  NAMER
                  SUBMCH
                  DOLNN
                  ADDLAST
                  WRITES
                  DEFLIST))

(DEFPROP METEOR
(LAMBDA (RULES WORKSPACE) (METRIX RULES WORKSPACE NIL NIL NIL))
EXPR)

(DEFPROP METRIX
(LAMBDA (RULES WORKSPACE SHELF DISPCH TRACK)
 (METRIX2 RULES WORKSPACE))
EXPR)

(DEFPROP METRIX2
(LAMBDA (RULES WORKSPACE)
 (PROG (PC GT A)
       (SETQ PC RULES)
  START(COND
        ((NULL PC)
         (RETURN (PROG2 (PRINT @(OVER END OF PROGRAM)) WORKSPACE))))
       (SETQ GT (DISPATCH (COMITRULE (CAR PC))))
       (COND ((EQ GT @*) (GO NEXT))
             ((EQ GT @END) (RETURN WORKSPACE))
             ((EQUAL GT (CAAR PC)) (GO START)))
       (SETQ A (TRANSFER GT RULES))
       (COND
        ((EQ (CAR A) @NONAME)
         (RETURN
          (PROG2
           (PRINT (LIST (CADR A) @(UNDEFINED GO-TO IN) (CAR PC)))
           WORKSPACE))))
       (SETQ PC A)
       (GO START)
  NEXT (SETQ PC (CDR PC))
       (GO START)))
EXPR)

(DEFPROP COMITRULE
(LAMBDA (RULE)
 (PROG (A B C D E G M LEFT)
       (SETQ G RULE)
  TOP  (SETQ RULE (CDR RULE))
       (SETQ A (CAR RULE))
       (SETQ E @*)
       (COND ((NOT (ATOM A)) (GO START))
             ((EQ A @*) (GO STAR))
             ((EQ A @*M) (GO *M))
             ((EQ A @*T) (GO *T))
             ((EQ A @*U) (GO *U)))
       (DEFLIST (CDR RULE) A)
       (RETURN @*)
  STAR (SETQ RULE (CDR RULE))
       (SETQ E (FSTATM RULE))
  START(COND ((AND (NULL TRACK) (NULL M)) (GO TRACK)))
       (PRINT @WORKSPACE)
       (PRINT WORKSPACE)
       (PRINT @RULE)
       (PRINT G)
  TRACK(SETQ LEFT (COMITMATCH (CAR RULE) WORKSPACE))
       (COND ((NULL LEFT) (RETURN E)))
  LOOP (SETQ RULE (CDR RULE))
       (SETQ A (CAR RULE))
       (COND ((NULL RULE) (RETURN E))
             ((EQ A @$) (GO DOLL))
             ((ZEROP A) (GO ON))
             ((ATOM A) (GO SW))
             ((EQ (CAR A) @\) (GO SHELVE)))
  ON   (SETQ WORKSPACE (COMITR LEFT A))
       (COND (M (PROG2 (PRINT @WORKSPACE) (PRINT WORKSPACE))))
       (GO LOOP)
  DOLL (SETQ A (CAR WORKSPACE))
  SW   (COND ((EQ E @*) (RETURN A)))
       (RETURN @*)
  SHELVE
       (SHELVE LEFT A)
       (GO LOOP)
  *M   (SETQ M A)
       (GO TOP)
  *T   (SETQ TRACK A)
       (GO TOP)
  *U   (SETQ TRACK NIL)
       (GO TOP)))
EXPR)

(DEFPROP TRANSFER
(LAMBDA (GT RL)
 (PROG NIL
  START(COND ((NULL RL) (RETURN (LIST @NONAME GT)))
             ((EQ GT (CAAR RL)) (RETURN RL)))
       (SETQ RL (CDR RL))
       (GO START)))
EXPR)

(DEFPROP DISPATCH
(LAMBDA (GT)
 (PROG (A)
       (COND ((EQ GT @*) (RETURN GT)))
       (SETQ A (GTPAIR GT DISPCH))
       (COND ((NULL A) (RETURN GT)))
       (RETURN (CAR A))))
EXPR)

(DEFPROP GTPAIR
(LAMBDA (NAME X)
 (PROG (A)
  START(COND ((NULL X) (RETURN NIL))
             ((EQUAL (CAR X) NAME) (RETURN (CDR X))))
       (SETQ X (CDDR X))
       (GO START)))
EXPR)

(DEFPROP FSTATM
(LAMBDA (RULE)
 (PROG (A)
  START(SETQ A (CAR RULE))
       (COND ((NULL RULE) (RETURN @*))
             ((ZEROP A) (GO ON))
             ((ATOM A) (RETURN A)))
  ON   (SETQ RULE (CDR RULE))
       (GO START)))
EXPR)

(DEFPROP SHELVE
(LAMBDA (PAIRS INST)
 (PROG (A B C D)
  START(SETQ INST (CDR INST))
       (COND ((NULL INST) (RETURN SHELF)))
       (SETQ A (CAR INST))
       (SETQ B (CAR A))
       (SETQ C (CADR A))
       (SETQ D (CDDR A))
       (COND ((EQ B @*P) (GO PR))
             ((EQ B @*D) (RETURN (SETDIS C (CAR D))))
             ((NEQ C @*) (GO GETD)))
       (SETQ C (INDIRECT (CAR D) PAIRS))
       (SETQ D (CDR D))
  GETD (SETQ D (COMITRIN PAIRS D))
       (SETQ A (GTSHLF C))
       (COND ((EQ B @*S) (GO ST1))
             ((EQ B @*Q) (GO QU1))
             ((EQ B @*X) (GO EX)))
       (PRINT (LIST @(SHELVING ERROR IN) (CAR INST)))
       (GO START)
  PR   (COND ((EQ C @\) (RETURN (PRINT SHELF))))
  PR1  (PRINT (LIST @SHELF C @CONTAINS (CAR (GTSHLF C))))
       (COND ((NULL D) (GO START)))
       (SETQ C (CAR D))
       (SETQ D (CDR D))
       (GO PR1)
  EX   (SETQ B (CAR A))
       (RPLACA A WORKSPACE)
       (SETQ WORKSPACE B)
       (GO START)
  QU1  (RPLACA A (COND ((CAR A) (NCONC (CAR A) D)) (D)))
       (GO START)
  ST1  (RPLACA A (APPEND D (CAR A)))
       (GO START)))
EXPR)

(DEFPROP SETDIS
(LAMBDA (X Y)
 (PROG (A)
       (SETQ A (GTPAIR X DISPCH))
       (COND ((NULL A) (SETQ DISPCH (CONS X (CONS Y DISPCH))))
             (T (RPLACA A Y)))
       (RETURN DISPCH)))
EXPR)

(DEFPROP GETDCT
(LAMBDA (X Y)
 (PROG (A)
       (COND ((NOT (ATOM X)) (RETURN (LIST X))))
       (SETQ A (GET X Y))
       (COND ((NULL A) (RETURN X)))
       (RETURN A)))
EXPR)

(DEFPROP INDIRECT
(LAMBDA (X PAIRS) (GTNAME X PAIRS))
EXPR)

(DEFPROP COMITR
(LAMBDA (LEFT ORDER)
 (PROG (A B C)
       (SETQ A (GTNAME 0 LEFT))
       (COND ((ZEROP A) (SETQ A NIL))
             ((NULL A) (GO ON))
             ((ATOM A) (SETQ A (LIST A))))
  ON   (SETQ B (GTNAME @WSEND LEFT))
       (COND ((ZEROP ORDER) (SETQ C NIL))
             (T (SETQ C (COMITRIN LEFT ORDER))))
       (RETURN (APPEND A C B))))
EXPR)

(DEFPROP COMITRIN
(LAMBDA (LEFT ORDER)
 (PROG (A B)
  START(COND ((NULL ORDER) (RETURN A)))
       (SETQ B (GTNAME (CAR ORDER) LEFT))
       (COND ((NULL B) (GO ON)) ((ATOM B) (SETQ B (LIST B))))
       (SETQ A (COND (A (NCONC A B)) (B)))
  ON   (SETQ ORDER (CDR ORDER))
       (GO START)))
EXPR)

(DEFPROP GTNAME
(LAMBDA (NAME PRS)
 (PROG (A B C)
       ((ATOM NAME) (GO START))
       (SETQ C (CAR NAME))
       (COND
        ((EQ C @FN)
         (RETURN
          (COPYTP
           (APPLY (CADR NAME) (COMITRIN PRS (CDDR NAME)) NIL))))
        ((EQ C @*K) (RETURN (LIST (COMITRIN PRS (CDR NAME)))))
        ((EQ C @*C) (RETURN (COMPRESS (COMITRIN PRS (CDR NAME)))))
        ((EQ C @*) (RETURN (COPYTP (EVAL (CADR NAME)))))
        ((EQ C @*W) (RETURN (WRITES (COMITRIN PRS (CDR NAME)))))
        ((EQ C @*E) (RETURN (EXPAND (GTNAME (CADR NAME) PRS))))
        ((EQ C @*\) (RETURN (LIST (SBMERGE (CDR NAME)))))
        ((EQ C @*N) (RETURN (NEXT (CDR NAME))))
        ((EQ C @*R) (RETURN (MTREAD)))
        ((EQ (CADR NAME) @\)
         (RETURN
          (LIST
           (SBMERGE (LIST @MERGE C (CONS @G99999 (CDR NAME)))))))
        ((EQ C @*F) (RETURN (CAAR (GTNAME (CADR NAME) PRS))))
        ((EQ C @*A) (RETURN (ALL (CDR NAME))))
        ((EQ C QUOTE) (RETURN (CADR NAME))))
  START(COND ((NULL PRS) (RETURN NAME)))
       (SETQ A (CAR PRS))
       (COND ((EQUAL NAME (CAR A)) (RETURN (COPYTP (CDR A)))))
       (SETQ PRS (CDR PRS))
       (GO START)))
EXPR)

(DEFPROP COPYTP
(LAMBDA (X) (COND ((ATOM X) X) ((APPEND X NIL))))
EXPR)

(DEFPROP EXPAND
(LAMBDA (X) (COND ((ATOM X) (EXPLODE X)) ((CAR X))))
EXPR)

(DEFPROP COMPRESS
(LAMBDA (X) (READLIST X))
EXPR)

(DEFPROP MTREAD
(LAMBDA NIL
 (PROG (A B)
       (CLRBFI)
       (SETQ A (NCONS))
  A    (SETQ B (READCH))
       ((EQ (CHRVAL B) 15) (RETURN (VCONC A)))
       (TCONC A B)
       (GO A)))
EXPR)

(DEFPROP ALL
(LAMBDA (X)
 (PROG (A B)
       (COND ((EQ (CAR X) @*) (SETQ X (INDIRECT (CADR X) PRS)))
             (T (SETQ X (CAR X))))
       (SETQ A (GTSHLF X))
       (SETQ B (CAR A))
       (RPLACA A NIL)
       (RETURN B)))
EXPR)

(DEFPROP NEXT
(LAMBDA (X)
 (PROG (A B C)
       (COND ((EQ (CAR X) @*) (SETQ X (INDIRECT (CADR X) PRS)))
             (T (SETQ X (CAR X))))
       (SETQ A (GTSHLF X))
       (SETQ C (CAR A))
       (COND ((NULL C) (RETURN NIL)))
       (SETQ B (CAR C))
       (RPLACA A (CDR C))
       (RETURN (LIST B))))
EXPR)

(DEFPROP GTSHLF
(LAMBDA (X)
 (PROG (A)
       (SETQ A (GTPAIR X SHELF))
       (COND ((NULL A) (GO A)))
       (RETURN A)
  A    (SETQ A (CONS NIL SHELF))
       (SETQ SHELF (CONS X A))
       (RETURN A)))
EXPR)

(DEFPROP SBMERGE
(LAMBDA (X)
 (PROG (A B C D E G)
       (SETQ A (CAR X))
       (SETQ B (CADR X))
       (COND ((EQ (AND (CONSP B) (CADR B)) @\) (GO BX)))
       (SETQ B (GTNAME B PRS))
       (COND ((NOT (ATOM B)) (SETQ B (CAR B))))
  BX   (SETQ C (CADDR X))
       (COND ((EQ (CADR C) @\) (GO CX)))
       (SETQ C (GTNAME C PRS))
       (COND ((NOT (ATOM X)) (SETQ C (CAR C))))
  CX   (COND ((OR (ATOM C) (NOT (EQ (CADR C) @\))) (SETQ C NIL))
             (T (SETQ C (CDDR C))))
       (COND ((OR (ATOM B) (NOT (EQ (CADR B) @\))) (GO B)))
       (SETQ D (LIST (CAR B) @\))
       (SETQ B (CDDR B))
       (GO D)
  B    (SETQ D (LIST B @\))
       (SETQ B NIL)
  D    (SELECTQ A
                (AND (GO AND))
                (MERGE (GO AND))
                (OR (GO OR))
                (SUBST (GO SUBST))
                NIL)
  ERROR(PRINT @(SUBSCRIPT ERROR))
       (PRINT X)
       (RETURN (GTNAME (CADR X) PRS))
  AND  (COND ((NULL B) (GO RETURN))
             ((MEMBER (CAR B) C) (SETQ G (CONS (CAR B) G))))
       (SETQ B (CDR B))
       (GO AND)
  OR   (SETQ G C)
  OR1  (COND ((NULL B) (GO RETURN))
             ((NOT (MEMBER (CAR B) G)) (SETQ G (CONS (CAR B) G))))
       (SETQ B (CDR B))
       (GO OR1)
  SUBST(SETQ G C)
  RETURN
       (COND ((AND (EQ A @MERGE) (NULL G)) (SSETQ G C)))
       (COND ((NULL G) (RETURN (CAR D))))
       (RETURN (NCONC D G))))
EXPR)

(DEFPROP COMITMATCH
(LAMBDA (RULE WORKSPACE)
 (PROG (A B)
       (SETQ A (CMATCH (NAMER RULE) WORKSPACE NIL))
       (COND ((NULL A) (RETURN NIL)) ((EQ A @$IMP) (RETURN NIL)))
       (SETQ B (CONS @WSEND (CDR A)))
       (RETURN (ADDLAST (CAR A) B))))
EXPR)

(DEFPROP CMATCH
(LAMBDA (RULE WORKSPACE MPAIRS)
 (PROG (RNAME A B C D E G H)
       (SETQ RNAME (CAR RULE))
       (SETQ RULE (CDR RULE))
       (SETQ B (CAR RULE))
       (COND ((NULL RULE) (RETURN (CONS MPAIRS WORKSPACE)))
             ((EQ B @$0) (GO $0))
             ((EQ B @$) (GO PDOLL)))
       (SETQ H (AND (CONSP B) (CAR B)))
       (COND ((EQ H @*P) (GO PRINT))
             ((EQ H @FN) (GO FN))
             ((NULL WORKSPACE) (RETURN @$IMP)))
       (SETQ G 0)
       (COND ((EQ B @$1) (SETQ G 1))
             ((EQ B @$2) (SETQ G 2))
             ((EQ B @$3) (SETQ G 3)))
       (COND ((NOT (ZEROP G)) (GO NDOLL2)))
       (GO TEST)
  $0   (COND
        ((AND (NOT (NULL WORKSPACE)) (NULL (CDR RULE))) (SETQ B NIL))
        (T (SETQ B (CONS NIL WORKSPACE))))
       (GO WATB)
  TEST (COND ((EQ H @$) (GO NDOLL))
             ((EQ H @*) (GO EVAL))
             ((EQ H QUOTE) (GO ATB1))
             (T (GO ATB)))
  FN   (SETQ B (CDR B))
       (SETQ E (CONS WORKSPACE (COMITRIN MPAIRS (CDR B))))
       (SETQ B (COPYTP (APPLY (CAR B) E NIL)))
  WATB (COND
        ((NULL B) (RETURN NIL))
        ((EQ B @$IMP) (RETURN B))
        (T
         (RETURN
          (CMATCH (CONS (CDR RNAME) (CDR RULE))
                  (CDR B)
                  (ADDLAST MPAIRS (CONS (CAR RNAME) (CAR B)))))))
  PDOLL(SETQ D (CDR RNAME))
       (SETQ RULE (CDR RULE))
       (COND
        ((NULL RULE)
         (RETURN
          (LIST (ADDLAST MPAIRS (CONS (CAR RNAME) WORKSPACE))))))
  DLOOP(SETQ B (CMATCH (CONS D RULE) WORKSPACE MPAIRS))
       (COND
        ((NULL WORKSPACE) (RETURN NIL))
        ((EQ B @$IMP) (RETURN B))
        (B
         (RETURN
          (CONS (ADDLAST (CAR B) (CONS (CAR RNAME) C)) (CDR B)))))
       (SETQ C (ADDLAST C (CAR WORKSPACE)))
       (SETQ WORKSPACE (CDR WORKSPACE))
       (GO DLOOP)
  SUBMCH
       (SETQ B (SUBMCH B WORKSPACE))
       (GO WATB)
  PRINT(PRINT (CDR B))
       (PRINT WORKSPACE)
  $IMP (RETURN @$IMP)
  EVAL (SETQ B (EVAL (CADR B)))
       (GO ATB2)
  ATB1 (SETQ B (CADR B))
       (GO ATB2)
  ATB  (COND ((ATOM B) (SETQ B (GTNAME B MPAIRS))))
  ATB2 (SETQ H (CAR WORKSPACE))
       (COND ((ATOM B) (GO B))
             ((EQ (CADR B) @\) (GO SUBMCH))
             ((EQUAL B H) (SETQ B (CONS (LIST B) (CDR WORKSPACE))))
             (T (SETQ B NIL)))
       (GO WATB)
  B    (COND
        ((EQUAL B H) (SETQ B WORKSPACE))
        ((AND (EQUAL B (AND (CONSP H) (CAR H))) (EQ (CADR H) @\))
         (SETQ B (CONS (LIST H) (CDR WORKSPACE))))
        (T (SETQ B NIL)))
       (GO WATB)
  NDOLL(SETQ G (CADR B))
  NDOLL2
       (SETQ B (DOLNN G WORKSPACE))
       (GO WATB)))
EXPR)

(DEFPROP NAMER
(LAMBDA (X)
 (PROG (A B C D E)
       (SETQ A (CAR X))
       (SETQ D 1)
       (SETQ B X)
       (COND ((OR (EQ A @$) (EQ A @$0)) (GO START)))
       (SETQ B (CONS @$ X))
       (SETQ E (LIST 0))
  START(COND ((NULL X) (RETURN (CONS E B))))
       (SETQ E (ADDLAST E D))
       (SETQ X (CDR X))
       (SETQ D (ADD1 D))
       (GO START)))
EXPR)

(DEFPROP SUBMCH
(LAMBDA (X Y)
 (PROG (A B C)
       (SETQ A (CAR X))
       (SETQ B (CAR Y))
       (COND
        ((NOT
          (OR (EQ A @$1)
              (EQUAL A (AND (CONSP B) (CAR B)))
              (EQUAL A @($ 1))))
         (RETURN NIL)))
       (COND ((EQ (CADR B) @\) (GO ON)) (T (RETURN NIL)))
  ON   (SETQ A (CDR X))
       (COND ((EQ (CAR A) @\) (GO A)))
       (PRINT (LIST @(SUBSCRIPT ERROR SUBMCH) X))
       (RETURN NIL)
  A    (SETQ A (CDR A))
       (SETQ C (CDDR B))
  START(COND ((NULL A) (RETURN (CONS (LIST B) (CDR Y))))
             ((MEMBER (CAR A) C) (SETQ A (CDR A)))
             (T (RETURN NIL)))
       (GO START)))
EXPR)

(DEFPROP DOLNN
(LAMBDA (NUM WSPACE)
 (PROG (A B)
       (SETQ B (CAR WSPACE))
       (COND ((NUMBERP NUM) (GO NUM))
             ((EQ NUM @NUMBER) (GO NUMBER))
             ((EQ NUM ATOM) (GO ATOM))
             ((EQ NUM LIST) (GO LIST)))
       (COND ((OR (EQUAL NUM B) (EQUAL NUM (CAR B))) (GO RNIL)))
  $1   (COND ((ATOM B) (GO B)))
  LST  (RETURN (CONS (LIST B) (CDR WSPACE)))
  NUMBER
       (COND ((NOT (NUMBERP B)) (GO RNIL)))
  B    (RETURN WSPACE)
  ATOM (COND ((ATOM B) (GO B)))
  RNIL (RETURN NIL)
  LIST (COND ((ATOM B) (GO RNIL)) (T (GO LST)))
  NUM  (COND ((ONEP NUM) (GO $1)))
  START(COND ((ZEROP NUM) (RETURN (CONS A WSPACE)))
             ((NULL WSPACE) (RETURN @$IMP)))
       (SETQ A (ADDLAST A (CAR WSPACE)))
       (SETQ WSPACE (CDR WSPACE))
       (SETQ NUM (SUB1 NUM))
       (GO START)))
EXPR)

(DEFPROP ADDLAST
(LAMBDA (X Y) (APPEND X (LIST Y)))
EXPR)

(DEFPROP WRITES
(LAMBDA (X)
 (PROG (A)
  START(SETQ A (CAR X))
       (COND ((NULL X) (RETURN NIL))
             ((EQ A @$EOR$) (GO ON))
             ((ATOM A) (PRIN1 A))
             (T (PRIN1 @***)))
       (SETQ X (CDR X))
       (GO START)
  ON   (TERPRI)
       (RETURN NIL)))
EXPR)

(DEFPROP DEFLIST
(LAMBDA (%A %B)
 (MAPCAR @(LAMBDA (X) (PUTPROP (CAR X) (CADR X) B) (RETURN (CAR X)))
         A))
EXPR)


(SETQ TESTS @(WS123 TEST1
                   TEST2
                   TEST3
                   WS4
                   TEST4
                   WS5
                   TEST5
                   WS6
                   TEST6
                   WS7
                   TEST7
                   WS8
                   TEST8))

(SETQ WS123 @(A ROSE IS A ROSE IS A ROSE))

(SETQ TEST1 @((* (ROSE) (FLOWER) * (SIMPLE REPLACEMENT))
             (* ((*P THE WORKSPACE IS)) * (DEBUG PRINTOUT))
             (* (IS A ROSE) 0 * (DELETION))
             (* (A FLOWER IS) (3 1 2) * (REARRANGEMENT))
             (* ((*P WS2)) *)
             (* (FLOWER) (1 OF RED) * (INSERTION))
             (* (A FLOWER) (THE 2) * (REPLACEMENT IN CONTEXT))
             (* ((*P WS3)) *)
             (* (FLOWER) * (NO OPERATION))
             (* (RED) (1 1) * (DUPLICATION))
             (* ((*P WS4)) *)
             (* (OF ($ 1)) (1) * (SINGLE UNKNOWN CONSTITUENT))
             (* (($ 1)) (QUESTION 1) * (FIRST CONSTITUENT))
             (* ((*P WS5)) *)
             (* (($ 2) FLOWER ($ 3))
                (3 2 1)
                *
                (N CONSECUTIVE CONSTITUENTS))
             (* ((*P WS6)) *)
             (* (FLOWER $ ROSE) (1 3) * (UNKNOW NUM OF CONSTITUENTS))
             (* ((*P WS7)) *)
             (* ($) (START C A B D) * (REPLACING ENTIRE WORKSPACE))
             (* (START ($ 1) $ D) (1 3 2 4) *)
             (* ((*P WS8)) *)
             (* ($) END)))

(SETQ TEST2 @((CHANGE (A ROSE) (THE FLOWER) CHANGE (FLOW OF CONTROL))
             (RULE1 (FLOWER) RULE3)
             (RULE2 * ((*P WSP)) END)
             (RULE3 (ROSE) CHANGE)
             (* * (ROSE) (FLOWER) RULE2)
             (* * ((*P WSEND)) END)))

(SETQ TEST3 @((CHANGE ($ ROSE)
                     (FLOWER)
                     (\ (*Q SHELF1 1 PRETTY))
                     CHANGE)
             (* ($) ((*A SHELF1) 1) (\ (*D PNTRET RULE3)) *)
             (PRNTWS * ((*P THE WORKSPACE IS)) PNTRET)
             (RULE2 ($) END)
             (RULE3 (($ 1) ($ 1))
                    0
                    (\ (*S ODD 1) (*Q EVEN 2) (*D PNTRET RULE3))
                    PRNTWS)
             (*
              ($)
              ((*A ODD) (*N EVEN))
              (\ (*Q ODD (*N EVEN) ONLY)
                 (*P ODD EVEN)
                 (*D PNTRET RULE2))
              PRNTWS)))

(SETQ WS4 @((1) H1 H2 H3 H4 C1 C2 C3 C4 D1 D2 D3 D4 S1 S2 S3 S4))

(SETQ TEST4 @((DEAL
              ($1 $1)
              ((FN (LAMBDA (X) (NCONS (NCONS (ADD1 (CAR X))))) 1))
              (\ (*S * 1 2))
              *)
             (* * ($2) PRINT)
             (* ((5)) (@((1))) DEAL)
             (* ($) DEAL)
             (PRINT ($) (\ (*P \)) END)))

(SETQ WS5 @(THE BOY AND GIRL))

(SETQ TEST5 @((* DICT
                (BOY ((BOY \ NOUN HE)))
                (GIRL ((GIRL \ NOUN SHE))))
             (LOOKUP ($1)
                     0
                     (\ (*Q SENT (FN GETDCT 1 DICT)) (*P SENT))
                     LOOKUP)
             (* ($) ((*A SENT)) END)))

(SETQ WS6 @(THE (BOY \ NOUN SING SMALL) AT HOME))

(SETQ TEST6 @((*
              ((BOY \ NOUN SING))
              ((*\ AND 1 (DOG \ NOUN MALE))
               (*\ OR 1 (BOY \ SMALL MALE))
               (*\ SUBST 1 (MAN \ MALE)))
              END)))

(SETQ WS7 @(WHO IT IS AT MY DOOR IS THERE NOW))

(SETQ TEST7 @((* (($ 1) IS ($ 2) $ THERE) ((*K 1 2 3 4)) END)))

(SETQ WS8 @(IS (ANYBODY AT HOME) NOW))

(SETQ TEST8 @((* (IS ($ 1)) (1 (*E 2)) END)))

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.