
(DEFPROP GNC
 (LAMBDA NIL
  ((LAMBDA (CH) (COND ((EQ CH CTRLDSYM) (ERR CTRLDSYM)) (T CH)))
   (READCH)))
EXPR)

(DEFPROP INITLEAN
 (LAMBDA NIL
  (PROG	NIL
	(SETQ TOKEN NIL)
	(SETQ TOKCHS NIL)
	(SETQ TOKTYP NIL)
	(SETQ CHAR SPACE)
	(PUTPROP TOKBEARER NIL (QUOTE TOKVAL))
	(PUTPROP TOKLBEARER NIL (QUOTE TOKLVAL))
	(CLRBFI)))
EXPR)

(DEFPROP GNT
 (LAMBDA NIL
  (PROG	(X)
	(SETQ CFLAG NIL)
   TOP	(SETQ PTOKEN TOKEN)
	(SETQ PTOKCHS TOKCHS)
	(SETQ PTOKTYP TOKTYP)
	(SETQ PCHAR CHAR)
	(COND ((EQ CHAR CMNTCHR)
	       (PROG NIL L (COND ((NOT (EQ (GNC) CMNTCHR)) (GO L))))
	       (SETQ CHAR (GNC))
	       (GO TOP))
	      ((EQ (SETQ X (LEANPROP CHAR)) 1)
	       (SETQ CFLAG T)
	       (SETQ CHAR (GNC))
	       (GO TOP))
	      ((EQ X 2) (SETQ TOKCHS (LIST CHAR))
			(SETQ TOKTYP 1)
			(COND ((NUMBERP CHAR) (NUMB)) (T (IDENT))))
	      ((EQ CHAR TOKQTSYM)
	       (SETQ TOKCHS NIL)
	       (SETQ TOKTYP 1)
	       (COND ((EQ (SETQ CHAR (GNC)) TOKQTSYM) (TCNL))
		     (T (TCN))))
	      (T (SETQ TOKCHS (LIST CHAR))
		 (SETQ CHAR (GNC))
		 (SETQ TOKTYP 2)
		 (SETQ TOKEN (CAR TOKCHS))))
	(COND
	 ((AND (EQ TOKEN SCOLON) (EQ CHAR CR))
	  (SETQ CHAR (PROG2 (GNC) (GNC)))))
	(COND
	 ((OR (NUMBERP TOKEN)
	      (NOT (MEMQ CHAR (GET TOKEN (QUOTE DOUBLE)))))
	  (RETURN TOKEN)))
	(SETQ TOKTYP 2)
	(SETQ TOKCHS (APPEND TOKCHS (LIST CHAR)))
	(SETQ TOKEN (PACK TOKCHS))
	(SETQ CHAR (GNC))
	(RETURN TOKEN)))
EXPR)

(DEFPROP NUMB
 (LAMBDA NIL
  (COND	((NUMBERP (SETQ CHAR (GNC)))
	 (PROG2 (SETQ TOKCHS (CONS CHAR TOKCHS)) (NUMB)))
	(T (SETQ TOKEN (READLIST (REVERSE TOKCHS))))))
EXPR)

(DEFPROP IDENT
 (LAMBDA NIL
  (COND	((EQ (LEANPROP (SETQ CHAR (GNC))) 2)
	 (PROG2 (SETQ TOKCHS (CONS CHAR TOKCHS)) (IDENT)))
	(T (SETQ TOKEN (READLIST (REVERSE TOKCHS))))))
EXPR)

(DEFPROP TCN
 (LAMBDA NIL
  (PROG	NIL
   L	(COND ((EQ CHAR ESCAPESYM)
	       (SETQ CHAR (GNC))
	       (SETQ TOKCHS (APPEND (ESCAPERTN) TOKCHS)))
	      ((EQ CHAR TOKQTSYM)
	       (SETQ CHAR (GNC))
	       (SETQ TOKEN TOKBEARER)
	       (PUTPROP
		TOKBEARER
		(APPEND (GET TOKBEARER (QUOTE TOKVAL))
			(LIST (PACK (REVERSE TOKCHS))))
		(QUOTE TOKVAL))
	       (RETURN TOKEN))
	      (T (SETQ TOKCHS (CONS CHAR TOKCHS))))
	(SETQ CHAR (GNC))
	(GO L)))
EXPR)

(DEFPROP TCNL
 (LAMBDA NIL
  (PROG	(TOKL)
	(SETQ TOKL NIL)
   L1	(SETQ CHAR (GNC))
   L2	(COND
	 ((EQ CHAR ESCAPESYM)
	  (SETQ CHAR (GNC))
	  (SETQ TOKCHS (APPEND (ESCAPERTN) TOKCHS))
	  (GO L1))
	 ((EQ CHAR TOKQTSYM)
	  (COND
	   ((EQ (SETQ CHAR (GNC)) TOKQTSYM)
	    (COND
	     (TOKCHS (SETQ TOKL (CONS (PACK (REVERSE TOKCHS)) TOKL))))
	    (SETQ TOKEN TOKLBEARER)
	    (PUTPROP
	     TOKLBEARER
	     (APPEND (GET TOKLBEARER (QUOTE TOKLVAL))
		     (LIST (REVERSE TOKL)))
	     (QUOTE TOKLVAL))
	    (SETQ CHAR (GNC))
	    (RETURN TOKEN))
	   (T (SETQ TOKCHS (CONS TOKQTSYM TOKCHS)) (GO L2))))
	 ((EQ (LEANPROP CHAR) 1)
	  (PROG	NIL
	   L3	(COND ((EQ (LEANPROP (SETQ CHAR (GNC))) 1) (GO L3))))
	  (COND
	   (TOKCHS (SETQ TOKL (CONS (PACK (REVERSE TOKCHS)) TOKL))))
	  (SETQ TOKCHS NIL)
	  (GO L2))
	 (T (SETQ TOKCHS (CONS CHAR TOKCHS)) (GO L1)))))
EXPR)

(DEFPROP ESCAPERTN
 (LAMBDA NIL
  (COND	((EQ CHAR 0) (CHARSEQ SPACE 12))
	((NUMBERP CHAR) (CHARSEQ SPACE CHAR))
	((GET CHAR (QUOTE STRINGMACRO)))
	(T (LIST CHAR))))
EXPR)

(DEFPROP LEANPROP
 (LAMBDA (X) (COND ((NUMBERP X) 2) ((GET X (QUOTE LEANPROP))) (T 3)))
EXPR)

(DEFPROP VARTYPERTN
 (LAMBDA NIL
  (PROG	(N)
	(COND (CFLAG (RETURN MULSYM)))
	(SETQ N 1)
   LOOP	(COND ((OR (NUMBERP TOKEN) (EQ TOKTYP 1) (EQ TOKEN MULSYM)))
	      (T (RETURN (PACK (CHARSEQ MULSYM N)))))
	(GNT)
	(COND
	 ((AND (EQ PTOKEN MULSYM) (NOT CFLAG))
	  (SETQ N (ADD1 N))
	  (GO LOOP)))
	(RETURN (PACK (APPEND (CHARSEQ MULSYM N) (EXPLODE PTOKEN))))))
EXPR)
