

(DEFPROP MKTIDY
 (LAMBDA(TY)
  ((LAMBDA (%L %STAR) (MKTIDYUP (MAKETY TY))) NIL (QUOTE *)))
EXPR)

(DEFPROP MKTIDYUP
 (LAMBDA(TY)
  (COND	((ASSOC1 TY %L))
	((ATOM TY)
	 (SETQ %L (CONS (CONS TY %STAR) %L))
	 (SETQ %STAR (READLIST (CONS (QUOTE *) (EXPLODE %STAR))))
	 (CDAR %L))
	((SHARECONS (QUOTE MLTYPE) (CAR TY) (MKTIDYUPL (CDR TY))))))
EXPR)

(DEFPROP MKTIDYUPL
 (LAMBDA(TYL)
  (COND
   (TYL
    (SHARECONS (QUOTE MLTYPE)
	       (MKTIDYUP (CAR TYL))
	       (MKTIDYUPL (CDR TYL))))))
EXPR)

(DEFPROP DML
 (LAMBDA(L)
  ((LAMBDA(FN ARGS BODY MTY)
    (PROG NIL
	  (PUTPROP FN (LENGTH ARGS) (QUOTE NUMARGS))
	  (PUTPROP FN (LIST (QUOTE LAMBDA) ARGS BODY) (QUOTE EXPR))
	  (PUTPROP FN (MKTIDY MTY) (QUOTE MLTYPE))
	  (RETURN FN)))
   (CAR L)
   (CADR L)
   (CADDR L)
   (CADDDR L)))
FEXPR)

(DEFPROP DML'
 (LAMBDA(L)
  ((LAMBDA(FN N LISPFN MTY)
    (PROG NIL
	  (PUTPROP FN (CONS LISPFN N) (QUOTE NUMARGS))
	  (PUTPROP FN (MKTIDY MTY) (QUOTE MLTYPE))
	  (RETURN FN)))
   (CAR L)
   (CADR L)
   (CADDR L)
   (CADDDR L)))
FEXPR)

(DEFPROP DMLC
 (LAMBDA(L)
  ((LAMBDA(ID EXP MTY)
    (PROG NIL
	  (PUTPROP ID (EVAL EXP) (QUOTE MLVAL))
	  (PUTPROP ID (MKTIDY MTY) (QUOTE MLTYPE))
	  (RETURN ID)))
   (CAR L)
   (CADR L)
   (CADDR L)))
FEXPR)

(DEFPROP DIV
 (LAMBDA (X Y) (COND ((ZEROP Y) (ERR (QUOTE div))) (T (*QUO X Y))))
EXPR)

(DEFPROP do
 (LAMBDA (X) NIL)
EXPR)

(DEFPROP hd
 (LAMBDA (X) (HDTL X (QUOTE hd)))
EXPR)

(DEFPROP tl
 (LAMBDA (X) (HDTL X (QUOTE tl)))
EXPR)

(DEFPROP HDTL
 (LAMBDA(X hdtl)
  (COND	((NULL X) (ERR hdtl))
	((ATOM X) (ERROR (CONS X (QUOTE (IS NOT A LIST)))))
	((SELECTQ hdtl
		  (hd (CAR X))
		  (tl (CDR X))
		  (ERROR (QUOTE HDTL))))))
EXPR)

(DEFPROP isl
 (LAMBDA (X) (NOT (isr X)))
EXPR)

(DEFPROP isr
 (LAMBDA(X)
  (COND	((AND (NOT (ATOM X)) (MEMQ (CAR X) (QUOTE (T NIL)))) (CAR X))
	((ERROR (CONS X (QUOTE (BAD MLSUMTYPE)))))))
EXPR)

(DEFPROP outl
 (LAMBDA (X) (COND ((isr X) (ERR (QUOTE outl))) ((CDR X))))
EXPR)

(DEFPROP outr
 (LAMBDA (X) (COND ((isr X) (CDR X)) ((ERR (QUOTE outr)))))
EXPR)

(DEFPROP inl
 (LAMBDA (X) (CONS NIL X))
EXPR)

(DEFPROP inr
 (LAMBDA (X) (CONS T X))
EXPR)

(DEFPROP explode
 (LAMBDA(X)
  (COND ((EQ X EMPTYTOK) NIL) (T (UNSLASHIFY (EXPLODE X)))))
EXPR)

(DEFPROP implode
 (LAMBDA(L)
  (COND	((NULL L) EMPTYTOK)
	((MAPAND (FUNCTION (LAMBDA (X) (EQ (LENGTH (explode X)) 1)))
		 L)
	 (READLIST (SLASHIFY L)))
	((ERR (QUOTE implode)))))
EXPR)

(DEFPROP mlinfix
 (LAMBDA (X) (MLINFIX X (QUOTE PAIRED)))
EXPR)

(DEFPROP mlcinfix
 (LAMBDA (X) (MLINFIX X (QUOTE CURRIED)))
EXPR)

(DEFPROP mlin
 (LAMBDA(%TOK PRFLAG)
  (ProtectIO
   (FUNCTION
    (LAMBDA(%F)
     (PROG (B %DUMP)
	   (SETQ B
		 (ERRSET
		  (PROG2 (OPENERR (QUOTE DSK:) (FILEOF %TOK))
			 (TMLLOOP))))
	   (AND %DUMP (end (CDAR (LAST %DUMP))))
	   (AND	(EQ B (QUOTE / DURING/ mlin/ ))
		(PRINX (QUOTE `) %TOK (QUOTE `) CR LF))
	   (OR (EQ B (QUOTE $EOF$)) (ERR (QUOTE mlin))))))
   (LIST (QUOTE mlin))))
EXPR)

(DEFPROP FILEOF
 (LAMBDA(TOK)
  (PROG	(X Y)
	(SETQ Y (explode TOK))
   L	(COND ((NULL Y) (RETURN TOK))
	      ((EQ (CAR Y) (QUOTE /.))
	       (RETURN
		(CONS (implode (REVERSE X)) (implode (CDR Y)))))
	      ((SETQ X (CONS (CAR Y) X)) (SETQ Y (CDR Y)) (GO L)))))
EXPR)
