
(DEFPROP POP
 (LAMBDA(CPL)
  (PROG	(X)
	(SETQ PARSEDEPTH (ADD1 PARSEDEPTH))
	(GNT)
	(SETQ ARG1
	      (COND ((NOT
		      (OR (NUMBERP PTOKEN)
			  (NULL (SETQ X (GET PTOKEN LANG1)))))
		     (EVAL X))
		    (T (EVAL ATOMRTN))))
   L	(SETQ X (COND ((NUMBERP TOKEN) NIL) (T (GET TOKEN LANGLP))))
	(COND ((AND (NULL X) (NOT (LESSP CPL JUXTLEVEL)))
	       (SETQ PARSEDEPTH (SUB1 PARSEDEPTH))
	       (RETURN ARG1))
	      ((NULL X) (PROG2 (SETQ ARG1 (EVAL JUXTRTN)) (GO L)))
	      ((NOT (LESSP CPL X))
	       (SETQ PARSEDEPTH (SUB1 PARSEDEPTH))
	       (RETURN ARG1))
	      (T NIL))
	(COND
	 ((MEMQ (CAR ARG1) DECLNCONSTRS)
	  (FAIL (QUOTE (NON TOP LEVEL DECLN MUST HAVE in CLAUSE)))))
	(SETQ X (GET TOKEN LANG2))
	(COND
	 ((NULL X)
	  (FAIL
	   (CONS TOKEN (QUOTE (IS UNDEFINED OPTR (SYSTEM ERROR)))))))
	(GNT)
	(SETQ ARG1 (EVAL X))
	(GO L)))
EXPR)

(DEFPROP UNOP
 (LAMBDA (OP CODE) (PUTPROP OP CODE LANG1))
EXPR)

(DEFPROP BNOP
 (LAMBDA (OP CODE) (PUTPROP OP CODE LANG2))
EXPR)

(DEFPROP BINOP
 (LAMBDA(OP LP CODE)
  (PROG2 (PUTPROP OP CODE LANG2) (PUTPROP OP LP LANGLP)))
EXPR)

(DEFPROP CHECK
 (LAMBDA(TOK RSLT MSG)
  (COND ((EQ TOK TOKEN) (PROG2 (GNT) RSLT)) (T (FAIL MSG))))
EXPR)

(DEFPROP FAIL
 (LAMBDA(MSG)
  (PROG	NIL
	(PRINT MSG)
	(PRINT (QUOTE SKIPPING:))
	(PRINC PTOKEN)
	(PRINC SPACE)
	(PRINC TOKEN)
	(PRINC SPACE)
   L	(COND
	 ((EQ TOKEN TMLSYM)
	  (INITLEAN)
	  (EQSETUP)
	  (PERSETUP)
	  (ERR (QUOTE ***))))
	(PRINC (GNT))
	(PRINC SPACE)
	(GO L)))
EXPR)

