perm filename CYCDRE.LSP[3,LMM] blob sn#037474 filedate 1973-04-21 generic text, type T, neo UTF8

(DEFPROP CYCDREFNS
 (CYCDREFNS ASSOC2 UNION SORT INSERT SQRT AE)
VALUE)

(DEFPROP ASSOC2
 (LAMBDA (X Y) (FOR NEW Z IN Y WHEN (EQUAL X (CAR Z)) DO (RETURN Z)))
EXPR)

(DEFPROP UNION
 (LAMBDA (X Y) (FOR NEW Z IN X WHEN (NOT (MEMBER Z FOR-VALUE)) XLIST FIRST Y Z))
EXPR)

(DEFPROP SORT
 (LAMBDA (X FN) (PROG (RET) (FOR NEW Z IN X DO (SETQ RET (INSERT Z RET FN))) (RETURN RET)))
EXPR)

(DEFPROP INSERT
 (LAMBDA(ELT LST FN)
  (COND ((NULL LST) (LIST ELT)) ((FN ELT (CAR LST)) (CONS ELT LST)) (T (RPLACD LST (INSERT ELT (CDR LST) FN)))))
EXPR)

(DEFPROP SQRT
 (LAMBDA(X)
  (PROG	(TRY NEWTRY)
	(SETQ TRY 2.0)
   RETRY
	(COND ((AE TRY (SETQ NEWTRY (*TIMES 0.5 (*PLUS (*QUO X TRY) TRY)))) (RETURN NEWTRY)))
	(SETQ TRY NEWTRY)
	(GO RETRY)))
EXPR)

(DEFPROP AE
 (LAMBDA (X Y) (LESSP (ABS (DIFFERENCE X Y)) 1.0E-2))
EXPR)