(DEFPROP TICTAC
      (COMMENCE
       EXT
       NEWGAME
       TER
       IMVAL
       SUCCESSORS
       REVERT
       UPDATE
       SORT
       SORTA
       SORTB
       SORTC
       WIN
       ANSWER
       DOUBLETH
       TWOLIS
       THREAT 
       ORLIS
       DELETE)
FNS)

(DEFPROP COMMENCE
 (LAMBDA NIL
  (PROG	NIL
	(ARRAY LINES T 12)
	(ARRAY XCOUNT FIXNUM 11)
	(ARRAY OCOUNT FIXNUM 11)
	(STORE (LINES 1) (QUOTE (1 4 7)))
	(STORE (LINES 2) (QUOTE (1 5)))
	(STORE (LINES 3) (QUOTE (1 6 10)))
	(STORE (LINES 4) (QUOTE (2 4)))
	(STORE (LINES 5) (QUOTE (2 5 7 10)))
	(STORE (LINES 6) (QUOTE (2 6)))
	(STORE (LINES 7) (QUOTE (3 4 10)))
	(STORE (LINES 10) (QUOTE (3 5)))
	(STORE (LINES 11) (QUOTE (3 6 7)))))
EXPR)

(DEFPROP EXT
 (LAMBDA (P) (CAR P))
EXPR)

(DEFPROP NEWGAME
 (LAMBDA NIL
  (PROG	(N)
	(SETQ N 0)
   L	(SETQ N (ADD1 N))
	(STORE (XCOUNT N) 0)
	(STORE (OCOUNT N) 0)
	(COND ((LESSP N 10) (GO L)))
	(SETQ P1 NIL)
	(SETQ XS NIL)
	(SETQ OS NIL)
	(SETQ BS (QUOTE (1 2 3 4 5 6 7 10 11)))
	(SETQ W NIL)
	(SETQ LEVEL 0)
	(SETQ COUNT 0)
	(RETURN (QUOTE (NEW GAME)))))
EXPR)

(DEFPROP TER
 (LAMBDA(P ALPHA BETA)
  (AND (NOT (NULL P))
       (OR (EQUAL LEVEL 11)
	   (LESSP (DIFFERENCE 11 LEVEL) ALPHA)
	   (GREATERP (PLUS -11 LEVEL) BETA)
	   (PROG (N)
		 (SETQ N 0)
	    L2	 (SETQ N (ADD1 N))
		 (COND
		  ((EQUAL 3 (COND (W (XCOUNT N)) (T (OCOUNT N))))
		   (RETURN T)))
		 (COND ((LESSP N 10) (GO L2)))
		 (RETURN NIL)))))
EXPR)

(DEFPROP IMVAL
 (LAMBDA(P)
  (COND	(W
	 (PROG (N)
	       (SETQ N 0)
	  L3   (SETQ N (ADD1 N))
	       (COND ((EQUAL 3 (XCOUNT N)) (RETURN (DIFFERENCE 12 LEVEL))))
	       (COND ((LESSP N 10) (GO L3)) (T (RETURN 0)))))
	(T
	 (PROG (N)
	       (SETQ N 0)
	  L4   (SETQ N (ADD1 N))
	       (COND ((EQUAL 3 (OCOUNT N)) (RETURN (PLUS -12 LEVEL))))
	       (COND ((LESSP N 10) (GO L4)) (T (RETURN 0)))))))
EXPR)

(DEFPROP SUCCESSORS
 (LAMBDA (P) (SORT (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P))) BS)))
EXPR)

(DEFPROP REVERT
 (LAMBDA NIL
  (PROG	(A)
	(SETQ LEVEL (SUB1 LEVEL))
	(SETQ BS (CONS (CAR (COND (W XS) (T OS))) BS))
	(COND (W (SETQ XS (CDR XS))) (T (SETQ OS (CDR OS))))
	(SETQ A (LINES (CAR P1)))
   L5	(COND ((NULL A) (GO L6)))
	(COND (W (STORE (XCOUNT (CAR A)) (SUB1 (XCOUNT (CAR A)))))
	      (T (STORE (OCOUNT (CAR A)) (SUB1 (OCOUNT (CAR A))))))
	(SETQ A (CDR A))
	(GO L5)
   L6	(SETQ W (NOT W))
	(SETQ P1 (CDR P1))
	(RETURN NIL)))
EXPR)

(DEFPROP UPDATE
 (LAMBDA(M)
  (PROG	(A)
	(SETQ LEVEL (ADD1 LEVEL))
	(COND (W (SETQ OS (CONS M OS))) (T (SETQ XS (CONS M XS))))
	(SETQ BS (DELETE M BS))
	(SETQ P1 (CONS M P1))
	(SETQ COUNT (ADD1 COUNT))
	(SETQ A (LINES M))
   L7	(COND ((NULL A) (GO L8)))
	(COND (W (STORE (OCOUNT (CAR A)) (ADD1 (OCOUNT (CAR A)))))
	      (T (STORE (XCOUNT (CAR A)) (ADD1 (XCOUNT (CAR A))))))
	(SETQ A (CDR A))
	(GO L7)
   L8	(SETQ W (NOT W))
	(RETURN NIL)))
EXPR)

(DEFPROP SORT
 (LAMBDA (U) (SORTA U NIL NIL))
EXPR)

(DEFPROP SORTA
 (LAMBDA(U TH ORD)
  (COND	((NULL U) (APPEND TH ORD))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	((DOUBLETH (CAR U)) (SORTC (CDR U) (CAR U)))
	((THREAT (CAR U)) (SORTA (CDR U) (CONS (CAR U) TH) ORD))
	(T (SORTA (CDR U) TH (CONS (CAR U) ORD)))))
EXPR)

(DEFPROP SORTB
 (LAMBDA (U M) (COND ((NULL U) (LIST M)) ((WIN (CAR U)) (LIST (CAR U))) (T (SORTB (CDR U) M))))
EXPR)

(DEFPROP SORTC
 (LAMBDA(U M)
  (COND	((NULL U) (LIST M))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	(T (SORTC (CDR U) M))))
EXPR)

(DEFPROP WIN
 (LAMBDA(P)
  (COND	(W (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (OCOUNT X)))) (LINES (CAR P))))
	(T (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (XCOUNT X)))) (LINES (CAR P))))))
EXPR)

(DEFPROP ANSWER
 (LAMBDA(P)
  (COND	(W (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (XCOUNT X)))) (LINES (CAR P))))
	(T (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (OCOUNT X)))) (LINES (CAR P))))))
EXPR)

(DEFPROP DOUBLETH
 (LAMBDA(P)
  (TWOLIS (FUNCTION
           (LAMBDA(X)
            (AND (EQUAL 1 (COND (W (OCOUNT X)) (T (XCOUNT X))))
	         (ORLIS (FUNCTION (LAMBDA (W) (MEMBER X (LINES W)))) (DELETE (CAR P) BS)))))
          (LINES (CAR P))))
EXPR)


(DEFPROP THREAT
 (LAMBDA(P)
  (ORLIS (FUNCTION
          (LAMBDA(X)
           (AND (EQUAL 1 (COND (W (OCOUNT X)) (T (XCOUNT X))))
	        (ORLIS (FUNCTION (LAMBDA (W) (MEMBER X (LINES W)))) (DELETE (CAR P) BS)))))
         (LINES (CAR P))))
EXPR)

(DEFUN TWOLIS (PRED U) (AND (NOT (NULL U))
        (OR (AND (PRED (CAR U)) (ORLIS PRED (CDR U)))
	    (TWOLIS PRED (CDR U)))))

(DEFPROP ORLIS
 (LAMBDA(PRED U) (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
EXPR)

(DEFPROP DELETE
 (LAMBDA(X U) (COND ((NULL U) NIL) 
	            ((EQUAL X (CAR U)) (CDR U))
	            (T (CONS (CAR U) (DELETE X (CDR U))))))
EXPR)

(DEFPROP LISTSUBT
 (LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
EXPR)

(DEFPROP LISTSUBTA
 (LAMBDA(U N Z)
  (COND	((EQUAL N 0) Z)
	(T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
EXPR)