(DEFPROP LCFM
	 (LCFM PARSEML
	       ISTYPEDEC
	       ISABSTYPEDEC
	       DECLNCHK
	       ULTABSTR
	       IDCHK
	       EQSETUP
	       PERSETUP
	       SECRTN
	       MLINFIX
	       MLINFRTN
	       MLCINFRTN
	       EXFIXRTN
	       MLATOMR
	       APPLRTN
	       LPARENRTN
	       TESTRTN
	       TRAPRTN
	       TRAPBINDRTN
	       LISTRTN
	       SEQRTN
	       LETRTN
	       BINDRTN
	       TYPBINDRTN
	       ABSTYPBINDRTN
	       CHKVARSTR
	       CHKVARSTRX
	       INRTN
	       WHERERTN
	       LAMBRTN
	       ITERRTN
	       ASSIGNRTN
	       DUPLRTN
	       CONDRTN
	       FAILWITHRTN
	       MLTYPRTN
	       MLT
	       MLT1
	       MLT2
	       MLT3
	       MLT4
	       MLT5
	       MLJUXT
	       CNRRTN)
	 VALUE)

(DEFPROP PARSEML
	 (LAMBDA(PL)
	  (PROG	(LANG1 LANG2 LANGLP ATOMRTN JUXTLEVEL JUXTRTN IBASE PARSEDEPTH)
		(SETQ LANG1 (QUOTE ML1))
		(SETQ LANG2 (QUOTE ML2))
		(SETQ LANGLP (QUOTE MLLP))
		(SETQ ATOMRTN (QUOTE (MLATOMR)))
		(SETQ JUXTLEVEL 1010)
		(SETQ JUXTRTN (QUOTE (MLJUXT ARG1)))
		(SETQ IBASE 12)
		(SETQ PARSEDEPTH 0)
		(RETURN (POP PL))))
	 EXPR)

(DEFPROP ISTYPEDEC
	 (LAMBDA (CLASS) (MEMQ CLASS (QUOTE (MK/-DEFTYPE MK/-DEFRECTYPE MK/-ABSTYPE MK/-ABSRECTYPE))))
	 EXPR)

(DEFPROP ISABSTYPEDEC (LAMBDA (CLASS) (MEMQ CLASS (QUOTE (MK/-ABSTYPE MK/-ABSRECTYPE)))) EXPR)

(DEFPROP DECLNCHK (LAMBDA (X MSG) (COND ((MEMQ (CAR X) DECLNCONSTRS) X) (T (FAIL MSG)))) EXPR)

(DEFPROP ULTABSTR
	 (LAMBDA(E)
	  (OR (EQ (CAR E) (QUOTE MK/-ABSTR)) (AND (EQ (CAR E) (QUOTE MK/-STRAINT)) (ULTABSTR (CADR E)))))
	 EXPR)

(DEFPROP IDCHK
	 (LAMBDA (ID MSG) (COND ((OR (NUMBERP ID) (MEMQ ID SPECSYMS) (MEMQ ID RSVDWDS)) (FAIL MSG)) (T ID)))
	 EXPR)

(DEFPROP EQSETUP (LAMBDA NIL (BINOP EQSYM 540 (QUOTE (APPLRTN 550 (QUOTE =))))) EXPR)

(DEFPROP PERSETUP (LAMBDA NIL (BINOP PERIOD 650 (QUOTE (APPLRTN 640 (QUOTE /.))))) EXPR)

(DEFPROP SECRTN
	 (LAMBDA(X)
	  (PROG	(L)
		(COND
		 ((NOT (EQ PARSEDEPTH 1)) (FAIL (QUOTE (SECTIONS CAN ONLY BE OPENED OR CLOSED AT TOP LEVEL)))))
	   LOOP	(COND ((EQ TOKEN TMLSYM) (RETURN (CONS X (COND ((NULL L) NIL) (T (LIST (PACK (REVERSE L))))))))
		      ((NOT (OR (EQ TOKEN PERIOD) (EQ TOKTYP 1))) (FAIL (QUOTE (BAD SECTION NAME)))))
		(SETQ L (CONS TOKEN L))
		(GNT)
		(GO LOOP)))
	 EXPR)

(DEFPROP MLINFIX
	 (LAMBDA(X TYP)
	  (PROG2 (PUTPROP X TYP (QUOTE MLINFIX))
		 (BINOP	X
			450
			(LIST (COND ((EQ TYP (QUOTE PAIRED)) (QUOTE MLINFRTN)) (T (QUOTE MLCINFRTN)))
			      (LIST (QUOTE QUOTE) X)))))
	 EXPR)

(DEFPROP MLINFRTN
	 (LAMBDA (X) (LIST (QUOTE MK/-APPN) (LIST (QUOTE MK/-VAR) X) (LIST (QUOTE MK/-DUPL) ARG1 (POP 460))))
	 EXPR)

(DEFPROP MLCINFRTN
	 (LAMBDA (X) (LIST (QUOTE MK/-APPN) (LIST (QUOTE MK/-APPN) (LIST (QUOTE MK/-VAR) X) ARG1) (POP 460)))
	 EXPR)

(DEFPROP EXFIXRTN
	 (LAMBDA NIL
	  (PROG2 (GNT)
		 (LIST (QUOTE MK/-VAR)
		       (COND ((EQ PTOKEN TOKBEARER) (GET TOKBEARER (QUOTE TOKVAL))) (T PTOKEN)))))
	 EXPR)

(DEFPROP MLATOMR
	 (LAMBDA NIL
	  (COND	((MEMQ PTOKEN SPECSYMS) (FAIL (CONS PTOKEN (QUOTE (CANNOT BE A VAR)))))
		((NUMBERP PTOKEN) (LIST (QUOTE MK/-INTCONST) PTOKEN))
		((EQ PTOKEN TOKBEARER)
		 (LIST (QUOTE MK/-TOKCONST)
		       ((LAMBDA (X) (PROG2 (PUTPROP TOKBEARER (CDR X) (QUOTE TOKVAL)) (CAR X)))
			(GET TOKBEARER (QUOTE TOKVAL)))))
		((EQ PTOKEN TOKLBEARER)
		 (CONS (QUOTE MK/-LIST)
		       (MAPCAR (FUNCTION (LAMBDA (X) (LIST (QUOTE MK/-TOKCONST) X)))
			       ((LAMBDA (X) (PROG2 (PUTPROP TOKLBEARER (CDR X) (QUOTE TOKLVAL)) (CAR X)))
				(GET TOKLBEARER (QUOTE TOKLVAL))))))
		(T (LIST (QUOTE MK/-VAR) PTOKEN))))
	 EXPR)

(DEFPROP APPLRTN
	 (LAMBDA (PL RN) (PROG (X) (SETQ X ARG1) (POP PL) (RETURN (LIST (QUOTE MK/-BINOP) RN X ARG1))))
	 EXPR)

(DEFPROP LPARENRTN
	 (LAMBDA NIL
	  (COND	((EQ TOKEN RPAREN) (PROG2 (GNT) (QUOTE (MK/-EMPTY))))
		(T (CHECK RPAREN (POP 20) (QUOTE (BAD PAREN BALANCE))))))
	 EXPR)

(DEFPROP TESTRTN
	 (LAMBDA NIL
	  (PROG	(X1 X2 XL XT)
	   LOOP	(SETQ X1 (POP 330))
		(SETQ XT TOKEN)
		(COND ((NOT (MEMQ XT (QUOTE (then loop)))) (FAIL (QUOTE (MISSING then OR loop AFTER test))))
		      (T (GNT)))
		(SETQ X2 (POP 320))
		(SETQ XL
		      (CONS (CONS (COND ((EQ XT (QUOTE then)) (QUOTE ONCE)) (T (QUOTE ITER))) (CONS X1 X2)) XL))
		(COND ((MEMQ TOKEN (QUOTE (test if))) (GNT) (GO LOOP)))
		(SETQ XT TOKEN)
		(COND ((MEMQ XT (QUOTE (else loop)))
		       (GNT)
		       (RETURN
			(LIST (QUOTE MK/-TEST)
			      (REVERSE XL)
			      (CONS (COND ((EQ XT (QUOTE else)) (QUOTE ONCE)) (T (QUOTE ITER))) (POP 320)))))
		      (T (RETURN (LIST (QUOTE MK/-TEST) (REVERSE XL)))))))
	 EXPR)

(DEFPROP TRAPRTN
	 (LAMBDA(TRAP)
	  (PROG	(X X1 X2 XL)
		(SETQ X ARG1)
	   LOOP	(SETQ X1 (POP 1020))
		(COND ((MEMQ TOKEN TPSYMS) (FAIL (QUOTE (MISSING TRAP BODY)))))
		(SETQ X2 (POP 270))
		(SETQ XL (CONS (CONS TRAP (CONS X1 X2)) XL))
		(COND
		 ((MEMQ TOKEN TPSYMS)
		  (SETQ TRAP (COND ((MEMQ TOKEN (LIST TP1SYM TP3SYM TP5SYM)) (QUOTE ONCE)) (T (QUOTE ITER))))))
		(COND ((MEMQ TOKEN (LIST TP3SYM TP4SYM)) (GNT) (GO LOOP)))
		(COND
		 ((MEMQ TOKEN (LIST TP1SYM TP2SYM))
		  (GNT)
		  (RETURN (LIST (QUOTE MK/-TRAP) X (REVERSE XL) (CONS TRAP (POP 240))))))
		(COND
		 ((MEMQ TOKEN (LIST TP5SYM TP6SYM))
		  (GNT)
		  (RETURN
		   (LIST (QUOTE MK/-TRAP) X (REVERSE XL) (CONS (CONS TRAP TOKEN) (PROG2 (GNT) (POP 270)))))))
		(RETURN (LIST (QUOTE MK/-TRAP) X (REVERSE XL)))))
	 EXPR)

(DEFPROP TRAPBINDRTN
	 (LAMBDA(TRAP)
	  (LIST	(QUOTE MK/-TRAP)
		ARG1
		NIL
		(CONS (CONS TRAP (IDCHK TOKEN (CONS TOKEN (QUOTE (CANT BE BOUND))))) (PROG2 (GNT) (POP 270)))))
	 EXPR)

(DEFPROP LISTRTN
	 (LAMBDA NIL
	  (PROG	(L)
	   LOOP	(COND ((EQ TOKEN RBRKT) (GNT) (RETURN (CONS (QUOTE MK/-LIST) (REVERSE L)))))
		(SETQ L (CONS (POP 170) L))
		(COND ((EQ TOKEN RBRKT) (GO LOOP))
		      (T (CHECK SCOLON ARG1 (QUOTE (FUNNY LIST SEPARATOR))) (GO LOOP)))))
	 EXPR)

(DEFPROP SEQRTN
	 (LAMBDA NIL
	  (PROG	(XL)
		(SETQ XL (LIST ARG1))
	   LOOP	(SETQ XL (CONS (POP 160) XL))
		(COND ((EQ TOKEN SCOLON) (GNT) (GO LOOP)))
		(RETURN (LIST (QUOTE MK/-SEQ) (REVERSE (CDR XL)) (CAR XL)))))
	 EXPR)

(DEFPROP LETRTN
	 (LAMBDA(CLASS)
	  (PROG	NIL
		(SETQ ARG1 (BINDRTN CLASS))
		(COND ((EQ TOKEN (QUOTE in)) (GNT) (RETURN (INRTN)))
		      ((LESSP 1 PARSEDEPTH) (FAIL (QUOTE (NON TOP LEVEL DECLN MUST HAVE in CLAUSE))))
		      (T (RETURN ARG1)))))
	 EXPR)

(DEFPROP BINDRTN
	 (LAMBDA(CLASS)
	  (PROG	(DL X Y)
		(COND ((ISABSTYPEDEC CLASS) (RETURN (ABSTYPBINDRTN CLASS)))
		      ((ISTYPEDEC CLASS) (RETURN (TYPBINDRTN CLASS))))
	   L1	(BINOP EQSYM 30 (QUOTE (FAIL (QUOTE (= INSIDE DEFINIEND)))))
		(SETQ X (CHECK EQSYM (POP 50) (QUOTE (LOST = IN DECLN))))
		(EQSETUP)
		(SETQ Y (POP 120))
	   L2	(COND ((EQ (CAR X) (QUOTE MK/-STRAINT))
		       (SETQ Y (LIST (QUOTE MK/-STRAINT) Y (CADDR X)))
		       (SETQ X (CADR X))
		       (GO L2))
		      ((EQ (CAR X) (QUOTE MK/-APPN)) (GO L4))
		      ((EQ (CAR X) (QUOTE MK/-VAR)) (GO OK))
		      ((EQ CLASS (QUOTE MK/-LETREC)) (FAIL (QUOTE (ILLEGAL FORM OF LETREC))))
		      (T NIL))
		(CHKVARSTR X
			   (QUOTE (MULTIPLE BINDING OCCURENCE OF VAR IN DECLN))
			   (QUOTE (ILLEGAL FORM OF DECLARATION)))
		(GO OK)
	   L4	(SETQ Y
		      (LIST (QUOTE MK/-ABSTR)
			    (CHKVARSTR (CADDR X)
				       (QUOTE (MULTIPLY OCCURRING FN PARAM))
				       (QUOTE (BAD FN PARAM STRUCTURE)))
			    Y))
		(SETQ X (CADR X))
	   L5	(COND ((EQ (CAR X) (QUOTE MK/-STRAINT))
		       (SETQ Y (LIST (QUOTE MK/-STRAINT) Y (CADDR X)))
		       (SETQ X (CADR X))
		       (GO L5))
		      ((EQ (CAR X) (QUOTE MK/-APPN)) (GO L4))
		      ((EQ (CAR X) (QUOTE MK/-VAR)) (GO OK))
		      (T (FAIL (QUOTE (BAD DEFINIEND OF FUNCTION)))))
	   OK	(COND
		 ((AND (EQ CLASS (QUOTE MK/-LETREC)) (NOT (ULTABSTR Y)))
		  (FAIL (QUOTE (LETREC OF NON/-FUNCTION)))))
		(SETQ DL (CONS (CONS X Y) DL))
		(COND ((EQ TOKEN (QUOTE and)) (PROG2 (GNT) (GO L1))))
		(SETQ X (CAAR DL))
		(SETQ Y (CDAR DL))
	   L9	(SETQ DL (CDR DL))
		(COND
		 ((NULL DL)
		  (RETURN (LIST CLASS (CHKVARSTR X (QUOTE (MULTIPLY OCCURRING VAR IN DECLARATION)) NIL) Y))))
		(SETQ X (LIST (QUOTE MK/-DUPL) (CAAR DL) X))
		(SETQ Y (LIST (QUOTE MK/-DUPL) (CDAR DL) Y))
		(GO L9)))
	 EXPR)

(DEFPROP TYPBINDRTN
	 (LAMBDA(CLASS)
	  (PROG	(DL)
	   LOOP	(COND ((NOT (EQ TOKTYP 1)) (FAIL (CONS TOKEN (QUOTE (NOT ALLOWED AS A TYPE)))))
		      ((MEMQ TOKEN BASTYPES) (FAIL (CONS TOKEN (QUOTE (MUSN'T BE REDEFINED)))))
		      ((NOT (NULL (ASSOC TOKEN DL))) (FAIL (CONS TOKEN (QUOTE (DEFINED MORE THAN ONCE)))))
		      ((NOT (EQ (GNT) EQSYM)) (FAIL (QUOTE (MISSING = IN TYPE DECLARATION)))))
		(SETQ DL (CONS (CONS PTOKEN (PROG2 (GNT) (MLT))) DL))
		(COND ((EQ TOKEN (QUOTE and)) (GNT) (GO LOOP)))
		(RETURN (LIST CLASS DL))))
	 EXPR)

(DEFPROP ABSTYPBINDRTN
	 (LAMBDA(CLASS)
	  (PROG	(TYARGS DL)
	   LOOP	(SETQ TYARGS NIL)
		(COND ((EQ TOKEN MULSYM) (GNT) (SETQ TYARGS (LIST (VARTYPERTN))))
		      ((EQ TOKEN LPAREN) (COND ((EQ (GNT) RPAREN) (GNT)) (T (GO L2)))))
	   L1	(COND ((NOT (EQ TOKTYP 1)) (FAIL (QUOTE (BAD TYPE CONSTRUCTOR))))
		      ((NOT (EQ (GNT) EQSYM)) (FAIL (QUOTE (BAD TYPE CONSTRUCTOR)))))
		(SETQ DL (CONS (CONS PTOKEN (CONS TYARGS (PROG2 (GNT) (MLT)))) DL))
		(COND ((EQ TOKEN (QUOTE and)) (GNT) (GO LOOP))
		      ((EQ TOKEN (QUOTE with)) (GNT))
		      (T (FAIL (QUOTE (MISSING with)))))
		(RETURN (LIST CLASS DL (BINDRTN (QUOTE MK/-LET))))
	   L2	(COND ((NOT (EQ TOKEN MULSYM)) (FAIL (QUOTE (TYPE CONSTRUCTOR'S ARGS NOT VARIABLES)))))
		(GNT)
		(SETQ TYARGS (APPEND TYARGS (LIST (VARTYPERTN))))
		(COND ((EQ TOKEN COMMA) (GNT) (GO L2))
		      ((EQ TOKEN RPAREN) (GNT) (GO L1))
		      (T (FAIL (QUOTE (BAD ARGS TO TYPE CONSTRUCTOR)))))))
	 EXPR)

(DEFPROP CHKVARSTR (LAMBDA (X MSG1 MSG2) (PROG2 (CHKVARSTRX X NIL MSG1 MSG2) X)) EXPR)

(DEFPROP CHKVARSTRX
	 (LAMBDA(X IDLST MSG1 MSG2)
	  (COND	((EQ (CAR X) (QUOTE MK/-STRAINT)) (CHKVARSTRX (CADR X) IDLST MSG1 MSG2))
		((EQ (CAR X) (QUOTE MK/-VAR))
		 (COND ((MEMQ (CADR X) IDLST) (FAIL MSG1)) (T (CONS (CADR X) IDLST))))
		((EQ (CAR X) (QUOTE MK/-DUPL))
		 (CHKVARSTRX (CADDR X) (CHKVARSTRX (CADR X) IDLST MSG1 MSG2) MSG1 MSG2))
		((EQ (CAR X) (QUOTE MK/-EMPTY)) IDLST)
		((EQ (CAR X) (QUOTE MK/-LIST))
		 (ITLIST (FUNCTION (LAMBDA (X IDLST) (CHKVARSTRX X IDLST MSG1 MSG2))) (CDR X) IDLST))
		((AND (EQ (CAR X) (QUOTE MK/-BINOP)) (EQ (CADR X) (QUOTE /.)))
		 (CHKVARSTRX (CADDDR X) (CHKVARSTRX (CADDR X) IDLST MSG1 MSG2) MSG1 MSG2))
		(T (FAIL MSG2))))
	 EXPR)

(DEFPROP INRTN
	 (LAMBDA NIL
	  (LIST	(COND ((ISABSTYPEDEC (CAR ARG1)) (QUOTE MK/-INA))
		      ((ISTYPEDEC (CAR ARG1)) (QUOTE MK/-IND))
		      (T (QUOTE MK/-IN)))
		(DECLNCHK ARG1 (QUOTE (in MUST FOLLOW DECLN)))
		(POP 100)))
	 EXPR)

(DEFPROP WHERERTN
	 (LAMBDA(CLASS)
	  (PROG	(E)
		(SETQ E ARG1)
		(RETURN
		 (LIST (COND ((ISTYPEDEC CLASS) (QUOTE MK/-IND)) (T (QUOTE MK/-IN)))
		       (DECLNCHK (BINDRTN CLASS) (QUOTE (BAD DECLN IN where)))
		       E))))
	 EXPR)

(DEFPROP LAMBRTN
	 (LAMBDA NIL
	  (PROG	(ITER)
		(BINOP PERIOD 220 (QUOTE (APPLRTN 210 (QUOTE /.))))
		(SETQ ITER (POP 230))
		(PERSETUP)
		(RETURN (ITERRTN (CHECK PERIOD ITER (QUOTE (LOST PERIOD IN ABSTRN))) (POP 130)))))
	 EXPR)

(DEFPROP ITERRTN
	 (LAMBDA(A B)
	  (COND	((EQ (CAR A) (QUOTE MK/-APPN))
		 (ITERRTN (CADR A)
			  (LIST	(QUOTE MK/-ABSTR)
				(CHKVARSTR (CADDR A)
					   (QUOTE (MULTIPLE LAMBDA BINDING FOR VAR))
					   (QUOTE (BAD VAR STRUCTURE IN ITERATED ABSTRN)))
				B)))
		(T
		 (LIST (QUOTE MK/-ABSTR)
		       (CHKVARSTR A
				  (QUOTE (MULTIPLE LAMBDA BINDING FOR VAR))
				  (QUOTE (BAD VAR STRUCTURE IN ABSTRN)))
		       B))))
	 EXPR)

(DEFPROP ASSIGNRTN
	 (LAMBDA NIL
	  (LIST	(QUOTE MK/-ASSIGN)
		(CHKVARSTR ARG1 (QUOTE (VAR DUPLICATED ON LEFT OF ASSGT)) (QUOTE (BAD LEFT HAND SIDE OF ASSGT)))
		(POP 350)))
	 EXPR)

(DEFPROP DUPLRTN (LAMBDA NIL (LIST (QUOTE MK/-DUPL) ARG1 (POP 370))) EXPR)

(DEFPROP CONDRTN
	 (LAMBDA NIL
	  (PROG	(X1 X2 XL)
	   LOOP	(SETQ X1 ARG1)
		(SETQ X2 (POP 420))
		(SETQ XL (CONS (CONS (QUOTE ONCE) (CONS X1 X2)) XL))
		(COND ((NOT (EQ TOKEN ELSESYM)) (FAIL (LIST (QUOTE MISSING) ELSESYM))) (T (GNT)))
		(POP 430)
		(COND ((EQ TOKEN CONDLSYM) (GNT) (GO LOOP)))
		(RETURN (LIST (QUOTE MK/-TEST) (REVERSE XL) (CONS (QUOTE ONCE) ARG1)))))
	 EXPR)

(DEFPROP FAILWITHRTN (LAMBDA NIL (LIST (QUOTE MK/-FAILWITH) (POP 340))) EXPR)

(DEFPROP MLTYPRTN (LAMBDA NIL (LIST (QUOTE MK/-STRAINT) ARG1 (MLT))) EXPR)

(DEFPROP MLT (LAMBDA NIL (MLT1 (MLT2 (MLT3 (MLT4))))) EXPR)

(DEFPROP MLT1
	 (LAMBDA (X) (COND ((EQ TOKEN ARROWSYM) (PROG2 (GNT) (LIST (QUOTE MK/-FUNTYP) X (MLT)))) (T X)))
	 EXPR)

(DEFPROP MLT2
	 (LAMBDA(X)
	  (COND ((EQ TOKEN SUMSYM) (PROG2 (GNT) (LIST (QUOTE MK/-SUMTYP) X (MLT2 (MLT3 (MLT4)))))) (T X)))
	 EXPR)

(DEFPROP MLT3
	 (LAMBDA (X) (COND ((EQ TOKEN PRODSYM) (PROG2 (GNT) (LIST (QUOTE MK/-PRODTYP) X (MLT3 (MLT4))))) (T X)))
	 EXPR)

(DEFPROP MLT4
	 (LAMBDA NIL
	  (PROG	(X)
		(GNT)
		(COND ((EQ PTOKEN LPAREN) (SETQ X (COND ((EQ TOKEN RPAREN) (GNT) NIL) (T (MLT5)))) (GO L)))
		(SETQ X
		      (LIST
		       (COND ((EQ PTOKEN NULLSYM) (QUOTE (MK/-NULLTYP)))
			     ((EQ PTOKEN MULSYM) (LIST (QUOTE MK/-VARTYP) (VARTYPERTN)))
			     ((NOT (EQ PTOKTYP 1)) (FAIL (CONS PTOKEN (QUOTE (ISN'T ALLOWED IN A TYPE)))))
			     ((EQ PTOKEN (QUOTE int)) (QUOTE (MK/-INTTYP)))
			     ((EQ PTOKEN (QUOTE bool)) (QUOTE (MK/-BOOLTYP)))
			     ((EQ PTOKEN (QUOTE term)) (QUOTE (MK/-TERMTYP)))
			     ((EQ PTOKEN (QUOTE form)) (QUOTE (MK/-FORMTYP)))
			     ((EQ PTOKEN (QUOTE thm)) (QUOTE (MK/-THMTYP)))
			     ((EQ PTOKEN (QUOTE type)) (QUOTE (MK/-TYPETYP)))
			     ((MEMQ PTOKEN (QUOTE (token tok))) (QUOTE (MK/-TOKTYP)))
			     (T (LIST (QUOTE MK/-CONSTTYP) PTOKEN)))))
	   L	(COND ((OR (NOT (EQ TOKTYP 1)) (MEMQ TOKEN RSVDWDS))
		       (RETURN
			(COND ((NOT (EQ (LENGTH X) 1)) (FAIL (QUOTE (MISSING TYPE CONSTRUCTOR))))
			      (T (RETURN (CAR X))))))
		      (T (GNT)))
		(SETQ X
		      (COND ((EQ PTOKEN (QUOTE list)) (LIST (CONS (QUOTE MK/-LISTYP) X)))
			    (T (LIST (CONS (QUOTE MK/-CONSTTYP) (CONS PTOKEN X))))))
		(GO L)))
	 EXPR)

(DEFPROP MLT5
	 (LAMBDA NIL
	  (PROG	(X)
		(SETQ X (LIST (MLT)))
	   LOOP	(COND ((EQ TOKEN RPAREN) (GNT) (RETURN X))
		      ((EQ TOKEN COMMA) (GNT) (SETQ X (APPEND X (LIST (MLT)))) (GO LOOP))
		      (T (FAIL (QUOTE (MISSING SEPARATOR OR TERMINATOR IN TYPE)))))))
	 EXPR)

(DEFPROP MLJUXT (LAMBDA (X) (LIST (QUOTE MK/-APPN) X (POP 1020))) EXPR)

(DEFPROP CNRRTN
	 (LAMBDA NIL
	  (CHECK ENDCNRSYM
		 (COND ((EQ TOKEN (QUOTE :)) (GNT) (LIST (QUOTE MK/-TYQUOT) (OLT)))
		       (T (LIST (QUOTE MK/-QUOT) (PARSEOL 0))))
		 (QUOTE (CANNOT FIND END OF QUOTATION))))
	 EXPR)
