
(def equal
 (lambda ($a $b)
   (cond ((and  (dtpr $a)(dtpr $b))
         (and (equal (car $a) (car $b))
              (equal (cdr $a) (cdr $b))))
        (t (eq $a $b)))))
(def defevq (lambda (at fm)(putd at fm]

(def defprop
 (nlambda (x)
   (prog (a)
	[cond((null(caar x))(rplaca (car x)(list(car(cddr x))(cadr x)))(return nil]
	(setq a (car (car x)))
loop	(cond	[ (cdr a)
		   (setq a (cdr a))
		   (go loop])
	(rplacd a (cons (car (cdr (cdr x))) (cons (car (cdr x]

(def putprop
 [lambda (a val ind)
   (prog ()
	[cond((null(car a))(rplaca a(list ind val))(return val]
	(setq a (car a))
loop	(cond	[ (eq (car a) ind)
		   (rplaca (cdr a) val)
		   (go end]
		[ (cdr (cdr a))
		   (setq a (cdr (cdr a)))
		   (go loop])
	(rplacd (cdr a) (cons ind (cons val)))
end	(return val]
 ]

(def get (lambda (a ind)
   (prog ()
	(setq a (car a))
loop	(cond	[(eq a nil)(return nil]
		[ (eq (car a) ind)
		   (return (cadr a]
		[ (setq a (cddr a))
		   (go loop]]

(def memcar (lambda (a l)
   (prog ()
	(cond	[ (null l)
		   (go end])
loop	(cond	[ (eq a (caar l))
		   (return (cdar l]
		[ (setq l (cdr l))
		   (go loop])
end	]

(def memcdr (lambda (a l)
   (prog ()
	(cond	[ (null l)
		   (go end])
loop	(cond	[ (eq a (cdar l))
		   (return (caar l]
		[ (setq l (cdr l))
		   (go loop])
end	]

(def delete (lambda (a b)
	(cond	[ (null b)
		   nil]
		[ (eq a (car b))
		   (cdr b]
		[ (eq a (cadr b))
		   (rplacd b (cddr b))
		   b]
		[ t
		   (delete a (cdr b))
		   b]]

(def reverse (lambda (x)
   (prog (temp)
	(cond	[ (or (atom x)
		      (numbp x))
		   (return x]
		[ (null (cdr x))
		   (return (cons (car x]
		[ t
		   (setq temp (reverse (cdr x)))
		   (rplacd (last temp) (cons (car x)))
		   (return temp]]
(def pp (nlambda ($x$)
   (ppevq (car $x$]

(def ppevq (lambda ($x$)
   (prog ()
	(cond	[ (null
		  (cond	[ (atom $x$)
			   (setq $x$ (eval $x$]
			[ t
			   $x$]))
		   (go end])
loop	(terpri)
	($patom1 ' "(def ")
	(prin1 (car $x$))
	($prpr (getd (car $x$) ))
	($patom1 rpar)
	(terpri)
	(cond	[ (setq $x$ (cdr $x$))
		   (go loop])
end	]

(def $prpr (lambda (x)
	(cond	[ t
		   (linelength 78)
		   (terpri)
		   ($prdf x 1 0)
                   (terpri]]
(def $prdf (lambda (l n m)
   (prog ()
	($tocolumn n)
a	(cond	[ (or (atom l)
		      (lessp (add m (flatsize l (chrct)))
		             (chrct)))
		   (return (prin1 l]
		[ (and ($patom1 lpar)
		       (lessp 2 (length l))
		       (atom (car l)))
		   (prog (c f g h)
			(setq g
			 (cond	[ (member (car l) '(lambda nlambda))
				   -7]
				[ t
				   0]))
			(setq f (eq (prin1 (car l)) 'prog))
			($patom1 ' " ")
			(setq c ($dinc))
		   a	($prd1
			 (cdr l)
			 (add
			  c
			  (cond	[ (setq h (and f
				               (cadr l)
				               (atom (cadr l))))
				   -5]
				[ t
				   g])))
			(cond	[ (cdr (setq l (cdr l)))
				  (cond	[ (or (null h) (atom (cadr l)))
					   (terpri])
				   (go a]]
		[ (prog (c)
			(setq c ($dinc))
		  a	($prd1 l c)
			(cond	[ (setq l (cdr l))
				   (terpri)
				   (go a]])
b	($patom1 rpar]
(def $prd1 (lambda (l n)
   (prog ()
	($prdf
	 (car l)
	 n
	 (cond	[ (null (setq l (cdr l)))
		   (add m 1]
		[ (atom l)
		   (setq n)
		   (plus 4 m (pntlen l]
		[ t
		   m]))
	(cond	[ (null n)
		   ($patom1 ' " . ")
		   (return (prin1 l]]

(def flatsize (lambda (l $mlen)
   (prog ($len)
	(setq $len 0)
	($flt1 l)
	(return $len]

(def $flt1 (lambda (l)
	(cond	[ (or (atom l)
		      (numbp l))
		   ($addl (pntlen l]
		[ (and (cdr l)
		       (or (atom (cdr l))
		           (numbp (cdr l))))
		   ($flt1 (car l))
		   ($addl (pntlen (cdr l]
		[ t
		   ($addl (add (length l) 2))
		   (mapc (getd '$flt1 ) l]]
(def $addl (lambda (n)
	(cond	[ t
		   (setq $len (add $len n))
		  (cond	[ (greaterp $len $mlen)
			   (return 1000]]]

(def $dinc (lambda () (diff (linelength) (chrct]

(def $tocolumn (lambda (n)
   (prog ()
loop	(cond	[ (lessp ($dinc) n)
		   ($patom1 ' " ")
		   (go loop]]

(def prin1 (lambda (x)
	(cond	[ t
		   (print x poport)
		   x]]

(def terpri (lambda () (terpr poport]

(def chrct (lambda () (charcnt poport]

(def $patom1 (lambda (x) (patom x poport]

(def lib
 (lambda (file)
  (load (concat (quote /srce/usr/source/L/lisp/harvard/lib/) file)))
)
(def while
 (nlambda (x)
  (prog () loop (cond ((eval (car x)) (mapc 'eval (cdr x)) (go loop))]
