
(DEFPROP PARSEOL
 (LAMBDA(PL)
  (PROG	(LANG1 LANG2 LANGLP ATOMRTN JUXTLEVEL JUXTRTN PARSEDEPTH)
	(SETQ LANG1 (QUOTE OL1))
	(SETQ LANG2 (QUOTE OL2))
	(SETQ LANGLP (QUOTE OLLP))
	(SETQ ATOMRTN (QUOTE (OLATOMR)))
	(SETQ JUXTLEVEL 80)
	(SETQ JUXTRTN (QUOTE (OLJUXT ARG1)))
	(SETQ PARSEDEPTH 0)
	(RETURN (POP PL))))
EXPR)

(DEFPROP OLINFIX
 (LAMBDA(X TYP)
  (PROG2 (PUTPROP X TYP (QUOTE OLINFIX))
	 ((LAMBDA(LANG1 LANG2 LANGLP)
	   (BINOP X
		  OLINPREC
		  (LIST	(COND ((EQ TYP (QUOTE PAIRED))
			       (QUOTE OLINFRTN))
			      (T (QUOTE OLCINFRTN)))
			(LIST (QUOTE QUOTE) X))))
	  (QUOTE OL1)
	  (QUOTE OL2)
	  (QUOTE OLLP))))
EXPR)

(DEFPROP OLINFRTN
 (LAMBDA(X)
  (LIST	(QUOTE mk=comb)
	(MKOLATOM X)
	(LIST (QUOTE mk=pair)
	      (TERMCHK ARG1 (CONS (QUOTE ARG1) X))
	      (TERMCHK (POP OLINPREC) (CONS (QUOTE ARG2) X)))))
EXPR)

(DEFPROP OLCINFRTN
 (LAMBDA(X)
  (LIST	(QUOTE mk=comb)
	(LIST (QUOTE mk=comb)
	      (MKOLATOM X)
	      (TERMCHK ARG1 (CONS (QUOTE ARG1) X)))
	(TERMCHK (POP OLINPREC) (CONS (QUOTE ARG2) X))))
EXPR)

(DEFPROP LPARRTN
 (LAMBDA NIL
  (COND	((EQ TOKEN RPAREN) (PROG2 (GNT) (QUOTE (mk=tok /(/)))))
	(T (CHECK RPAREN (POP 0) (QUOTE (BAD PAREN BALANCE))))))
EXPR)

(DEFPROP WFFRTN
 (LAMBDA(OPTR CONSTR A B)
  (PROG	(X)
	(SETQ X (CONS (QUOTE OF) (CONS OPTR (QUOTE (IS A TERM)))))
	(RETURN
	 (LIST CONSTR
	       (WFFCHK A (CONS (QUOTE ARG1) X))
	       (WFFCHK B (CONS (QUOTE ARG2) X))))))
EXPR)

(DEFPROP WFFCHK
 (LAMBDA(WFF MSG)
  (COND ((MEMQ (CAR WFF) TERMCONSTRS) (FAIL MSG)) (T WFF)))
EXPR)

(DEFPROP OLATOMR
 (LAMBDA NIL (MKOLATOM PTOKEN))
EXPR)

(DEFPROP MKOLATOM
 (LAMBDA(X)
  (COND	((OR (MEMQ X SPECTOKS) (NUMBERP X))
	 (FAIL (CONS X (QUOTE (CANNOT BE A TERM)))))
	(T (LIST (QUOTE mk=tok) X))))
EXPR)

(DEFPROP OLJUXT
 (LAMBDA(X)
  (LIST	(QUOTE mk=comb)
	(TERMCHK X (QUOTE (WFF TERMINATED BY JUNK)))
	(TERMCHK (POP 80) (QUOTE (TERM JUXTAPOSED WITH WFF)))))
EXPR)

(DEFPROP LAMQRTN
 (LAMBDA(CONSTR CHK N MSG)
  (PROG	(X)
	(SETQ X
	      (COND ((EQ TOKEN ANTICNRTOK) (GNT) (METACALL))
		    ((NOT (EQUAL TOKTYP 1))
		     (FAIL (CONS TOKEN (QUOTE (IN A PREFIX)))))
		    (T (GNT) (LIST (QUOTE mk=tok) PTOKEN))))
   L	(COND
	 ((NOT (EQ TOKEN COLON))
	  (RETURN
	   (LIST CONSTR
		 X
		 (COND ((EQ TOKEN PERIOD)
			(GNT)
			(APPLY CHK (LIST (POP N) MSG)))
		       (T (LAMQRTN CONSTR CHK N MSG)))))))
	(GNT)
	(SETQ X (LIST (QUOTE mk=typed) X (OLT)))
	(GO L)))
EXPR)

(DEFPROP LAMRTN
 (LAMBDA NIL
  (LAMQRTN (QUOTE mk=abs)
	   (FUNCTION TERMCHK)
	   40
	   (QUOTE (LAMBDA BODY MUST BE A TERM))))
EXPR)

(DEFPROP QUANTRTN
 (LAMBDA NIL
  (LAMQRTN (QUOTE mk=quant)
	   (FUNCTION WFFCHK)
	   5
	   (QUOTE (CAN ONLY QUANTIFY FORM))))
EXPR)

(DEFPROP TERMRTN
 (LAMBDA(OPTR CONSTR A B)
  (PROG	(X)
	(SETQ X
	      (LIST (QUOTE OF) OPTR (QUOTE IS) (QUOTE A) (QUOTE WFF)))
	(RETURN
	 (LIST CONSTR
	       (TERMCHK A (CONS (QUOTE ARG1) X))
	       (TERMCHK B (CONS (QUOTE ARG2) X))))))
EXPR)

(DEFPROP TERMCHK
 (LAMBDA(TM MSG)
  (COND ((MEMQ (CAR TM) WFFCONSTRS) (FAIL MSG)) (T TM)))
EXPR)

(DEFPROP CONDLRTN
 (LAMBDA(P)
  (PROG	(X Y)
	(SETQ P
	      (TERMCHK P (QUOTE (CONDITION OF CONDITIONAL NOT TERM))))
	(SETQ X
	      (TERMCHK (CHECK ELSETOK
			      (POP 50)
			      (QUOTE
			       (NEED 2 ND BRANCH TO CONDITIONAL)))
		       (QUOTE (1 ST BRANCH OF CONDITIONAL NOT TERM))))
	(SETQ Y
	      (TERMCHK (POP 50)
		       (QUOTE (2 ND BRANCH OF CONDITIONAL NOT TERM))))
	(RETURN (LIST (QUOTE mk=cond) P X Y))))
EXPR)

(DEFPROP METACALL
 (LAMBDA NIL
  (LIST	(QUOTE mk=antiquot)
	(PROG2 (GNT)
	       (COND ((EQ PTOKEN LPAREN)
		      (CHECK RPAREN
			     (PARSEML METAPREC)
			     (QUOTE (BAD ANTIQUOTATION))))
		     ((EQ PTOKTYP 1) (MLATOMR))
		     ((FAIL (QUOTE (JUNK IN ANTIQUOTATION))))))))
EXPR)

(DEFPROP OLTYPRTN
 (LAMBDA NIL
  (LIST	(QUOTE mk=typed)
	(TERMCHK ARG1 (QUOTE (ONLY A TERM CAN HAVE A TYPE)))
	(OLT)))
EXPR)

(DEFPROP OLT
 (LAMBDA NIL (OLT1 (OLT2 (OLT3 (OLT4)))))
EXPR)

(DEFPROP OLT1
 (LAMBDA(X)
  (COND	((EQ TOKEN ARROWTOK)
	 (PROG2 (GNT) (LIST (QUOTE mk=funtype) X (OLT))))
	(T X)))
EXPR)

(DEFPROP OLT2
 (LAMBDA(X)
  (COND	((EQ TOKEN SUMTOK)
	 (PROG2	(GNT)
		(LIST (QUOTE mk=sumtype) X (OLT2 (OLT3 (OLT4))))))
	(T X)))
EXPR)

(DEFPROP OLT3
 (LAMBDA(X)
  (COND	((EQ TOKEN PRODTOK)
	 (PROG2 (GNT) (LIST (QUOTE mk=prodtype) X (OLT3 (OLT4)))))
	(T X)))
EXPR)

(DEFPROP OLT4
 (LAMBDA NIL
  (PROG2 (GNT)
	 (COND ((EQ PTOKEN LPAREN)
		(CHECK RPAREN (OLT) (QUOTE (BAD TYPE EXPRESSION))))
	       ((EQ PTOKEN ANTICNRTOK) (METACALL))
	       ((EQ PTOKEN NULLTYPTOK) (QUOTE (mk=nulltype)))
	       ((EQ PTOKEN MULSYM)
		(LIST (QUOTE mk=vartype) (VARTYPERTN)))
	       ((NOT (EQ PTOKTYP 1))
		(FAIL (QUOTE (JUNK IN A TYPE EXPRESSION))))
	       (T (LIST (QUOTE mk=consttype) PTOKEN)))))
EXPR)
