
(DEFPROP GENLINK
 (LAMBDA NIL (CONS (QUOTE link) (SETQ LINKCOUNT (ADD1 LINKCOUNT))))
EXPR)

(DEFPROP TYCONSTP
 (LAMBDA (TY) (GET TY (QUOTE CANON)))
EXPR)

(DEFPROP CONSTP
 (LAMBDA (TOK) (GET TOK (QUOTE const)))
EXPR)

(DEFPROP TRIPLE
 (LAMBDA (X Y Z) (CONS X (CONS Y Z)))
EXPR)

(DEFPROP STRIP
 (LAMBDA(TAG X)
  (COND	((EQ (CAR X) TAG) (CDR X))
	((ERR
	  (READLIST (APPEND (EXPLODE (QUOTE dest)) (EXPLODE TAG)))))))
EXPR)

(DEFPROP REVASSOC
 (LAMBDA(X L)
  (PROG	NIL
	(COND ((NULL L) (RETURN NIL)))
   A	(COND ((EQ X (CDAR L)) (RETURN (CAR L)))
	      ((SETQ L (CDR L)) (GO A)))))
EXPR)

(DEFPROP REVASSOC1
 (LAMBDA (X L) ((LAMBDA (PR) (COND (PR (CAR PR)))) (REVASSOC X L)))
EXPR)

(DEFPROP ASSOC1
 (LAMBDA (X L) ((LAMBDA (PR) (COND (PR (CDR PR)))) (ASSOC X L)))
EXPR)

(DEFPROP ITLIST
 (LAMBDA(FN XL X)
  (PROG	NIL
	(SETQ XL (REVERSE XL))
   L	(COND ((NULL XL) (RETURN X))
	      (T (SETQ X (FN (CAR XL) X))
		 (SETQ XL (CDR XL))
		 (GO L)))))
EXPR)

(DEFPROP XGENSYM
 (LAMBDA(X)
  ((LAMBDA(XCOUNT BASE IBASE)
    (MAKNAM
     (APPEND (EXPLODE X)
	     (EXPLODE (SET XCOUNT (ADD1 (EVAL XCOUNT)))))))
   (READLIST (CONS X (QUOTE (C O U N T))))
   12
   12))
EXPR)

(DEFPROP ADDPROP
 (LAMBDA (I V P) (CAR (PUTPROP I (CONS V (GET I P)) P)))
EXPR)

(DEFPROP SELECTQ
 (LAMBDA(%%%L)
  (PROG	(%%%X1 %%%X2 %%%X3 %%%X4)
	(SETQ %%%X1 (EVAL (CAR %%%L)))
	(SETQ %%%X2 (CDR %%%L))
   L	(COND ((NULL (CDR %%%X2)) (RETURN (EVAL (CAR %%%X2))))
	      ((OR (EQ %%%X1
		       (SETQ %%%X4 (CAR (SETQ %%%X3 (CAR %%%X2)))))
		   (AND (NOT (ATOM %%%X4)) (MEMQ %%%X1 %%%X4)))
	       (RETURN
		(EVAL (LIST (QUOTE COND) (CONS T (CDR %%%X3))))))
	      (T (SETQ %%%X2 (CDR %%%X2)) (GO L)))))
FEXPR)

(DEFPROP SELECTQ
 (NIL . N)
VALUE)

(DEFPROP CHARSEQ
 (LAMBDA(CH N)
  (PROG	(L)
   LOOP	(COND ((EQ N 0) (RETURN L)))
	(SETQ L (CONS CH L))
	(SETQ N (SUB1 N))
	(GO LOOP)))
EXPR)

(DEFPROP PACK
 (LAMBDA(L)
  (READLIST
   (ITLIST
    (FUNCTION
     (LAMBDA(Y YL)
      (APPEND
       (COND ((NUMBERP Y) (SLASHIFY (EXPLODE Y))) (T (EXPLODE Y)))
       YL)))
    L
    NIL)))
EXPR)
