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

.