(PROCLAIM '(OPTIMIZE SPEED)) (DEFPACKAGE "BOOTTRAN") (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (PROGN (COND ((|%hasFeature| :COMMON-LISP) (USE-PACKAGE "COMMON-LISP" . #1=(#2="BOOTTRAN"))) (T (USE-PACKAGE "LISP" . #1#))) (USE-PACKAGE "AxiomCore" #2#))) (IN-PACKAGE "BOOTTRAN") (PROVIDE "utility") (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| |lastNode| |append| |append!| |copyList| |substitute| |substitute!| |setDifference| |setUnion| |setIntersection| |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ| |objectAssoc| |remove| |removeSymbol| |atomic?| |finishLine|))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|)) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute!|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|)) (|%List| |%Thing|)) |append|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|)) (|%List| |%Thing|)) |append!|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%List| |%Thing|)) |copyList|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%Maybe| (|%Node| |%Thing|))) |lastNode|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Symbol|) (|%List| |%Thing|)) |removeSymbol|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Thing|) (|%List| |%Thing|)) |remove|)) (DECLAIM (FTYPE (FUNCTION (|%Thing| (|%List| |%Thing|)) (|%Maybe| (|%Pair| |%Thing| |%Thing|))) |objectAssoc|)) (DECLAIM (FTYPE (FUNCTION (|%Symbol| (|%List| |%Thing|)) (|%Maybe| (|%Pair| |%Symbol| |%Thing|))) |symbolAssoc|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|)) (|%List| |%Thing|)) |setDifference|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|)) (|%List| |%Thing|)) |setUnion|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|)) (|%List| |%Thing|)) |setIntersection|)) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |atomic?|)) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Void|) |finishLine|)) (DECLAIM (FTYPE (FUNCTION (|%String| |%Short|) (|%Maybe| |%Short|)) |firstBlankPosition|)) (|%defaultReadAndLoadSettings|) (DEFUN |atomic?| (|x|) (OR (NOT (CONSP |x|)) (EQ (CAR |x|) 'QUOTE))) (DEFUN |objectMember?| (|x| |l|) (LOOP (COND ((NULL |l|) (RETURN NIL)) ((CONSP |l|) (COND ((EQ |x| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|))))) (T (RETURN (EQ |x| |l|)))))) (DEFUN |symbolMember?| (|s| |l|) (LOOP (COND ((NULL |l|) (RETURN NIL)) ((CONSP |l|) (COND ((EQ |s| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|))))) (T (RETURN (EQ |s| |l|)))))) (DEFUN |stringMember?| (|s| |l|) (LOOP (COND ((NULL |l|) (RETURN NIL)) ((CONSP |l|) (COND ((STRING= |s| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|))))) (T (RETURN (STRING= |s| |l|)))))) (DEFUN |charMember?| (|c| |l|) (LOOP (COND ((NULL |l|) (RETURN NIL)) ((CONSP |l|) (COND ((CHAR= |c| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|))))) (T (RETURN (CHAR= |c| |l|)))))) (DEFUN |scalarMember?| (|s| |l|) (LOOP (COND ((NULL |l|) (RETURN NIL)) ((CONSP |l|) (COND ((EQL |s| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|))))) (T (RETURN (EQL |s| |l|)))))) (DEFUN |listMember?| (|x| |l|) (LOOP (COND ((NULL |l|) (RETURN NIL)) ((CONSP |l|) (COND ((EQUAL |x| (CAR |l|)) (RETURN T)) (T (SETQ |l| (CDR |l|))))) (T (RETURN (EQUAL |x| |l|)))))) (DEFUN |reverse| (|l|) (PROG (|r|) (RETURN (PROGN (SETQ |r| NIL) (LOOP (COND ((CONSP |l|) (SETQ |r| (CONS (CAR |l|) |r|)) (SETQ |l| (CDR |l|))) (T (RETURN |r|)))))))) (DEFUN |reverse!| (|l|) (PROG (|l2| |l1|) (RETURN (PROGN (SETQ |l1| NIL) (LOOP (COND ((CONSP |l|) (SETQ |l2| (CDR |l|)) (RPLACD |l| |l1|) (SETQ |l1| |l|) (SETQ |l| |l2|)) (T (RETURN |l1|)))))))) (DEFUN |lastNode| (|l|) (PROG (|l'|) (RETURN (PROGN (LOOP (COND ((NOT (AND (CONSP |l|) (PROGN (SETQ |l'| (CDR |l|)) T) (CONSP |l'|))) (RETURN NIL)) (T (SETQ |l| |l'|)))) |l|)))) (DEFUN |copyList| (|l|) (PROG (|l'| |t|) (RETURN (COND ((NOT (CONSP |l|)) |l|) (T (SETQ |l'| (SETQ |t| (LIST (CAR |l|)))) (LOOP (PROGN (SETQ |l| (CDR |l|)) (COND ((CONSP |l|) (RPLACD |t| (LIST (CAR |l|))) (SETQ |t| (CDR |t|))) (T (RPLACD |t| |l|) (RETURN |l'|)))))))))) (DEFUN |append!| (|x| |y|) (COND ((NULL |x|) |y|) ((NULL |y|) |x|) (T (RPLACD (|lastNode| |x|) |y|) |x|))) (DEFUN |append| (|x| |y|) (|append!| (|copyList| |x|) |y|)) (DEFUN |symbolAssoc| (|s| |l|) (PROG (|x|) (RETURN (LOOP (COND ((NOT (AND (CONSP |l|) (PROGN (SETQ |x| (CAR |l|)) (SETQ |l| (CDR |l|)) T))) (RETURN NIL)) ((AND (CONSP |x|) (EQ |s| (CAR |x|))) (RETURN |x|))))))) (DEFUN |objectAssoc| (|x| |l|) (PROG (|p|) (RETURN (LOOP (COND ((NOT (AND (CONSP |l|) (PROGN (SETQ |p| (CAR |l|)) (SETQ |l| (CDR |l|)) T))) (RETURN NIL)) ((AND (CONSP |p|) (EQ (CAR |p|) |x|)) (RETURN |p|))))))) (DEFUN |substitute!| (|y| |x| |s|) (COND ((NULL |s|) NIL) ((EQ |x| |s|) |y|) (T (COND ((CONSP |s|) (RPLACA |s| (|substitute!| |y| |x| (CAR |s|))) (RPLACD |s| (|substitute!| |y| |x| (CDR |s|))))) |s|))) (DEFUN |substitute| (|y| |x| |s|) (PROG (|t| |h|) (RETURN (COND ((NULL |s|) NIL) ((EQ |x| |s|) |y|) ((CONSP |s|) (SETQ |h| (|substitute| |y| |x| (CAR |s|))) (SETQ |t| (|substitute| |y| |x| (CDR |s|))) (COND ((AND (EQ |h| (CAR |s|)) (EQ |t| (CDR |s|))) |s|) (T (CONS |h| |t|)))) (T |s|))))) (DEFUN |applySubst| (|sl| |t|) (PROG (|p| |tl| |hd|) (RETURN (COND ((CONSP |t|) (SETQ |hd| (|applySubst| |sl| (CAR |t|))) (SETQ |tl| (|applySubst| |sl| (CDR |t|))) (COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|) (T (CONS |hd| |tl|)))) ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|)) (T |t|))))) (DEFUN |applySubst!| (|sl| |t|) (PROG (|p| |tl| |hd|) (RETURN (COND ((CONSP |t|) (SETQ |hd| (|applySubst!| |sl| (CAR |t|))) (SETQ |tl| (|applySubst!| |sl| (CDR |t|))) (RPLACA |t| |hd|) (RPLACD |t| |tl|)) ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|)) (T |t|))))) (DEFUN |applySubstNQ| (|sl| |t|) (PROG (|p| |tl| |hd|) (RETURN (COND ((AND (CONSP |t|) (PROGN (SETQ |hd| (CAR |t|)) (SETQ |tl| (CDR |t|)) T)) (COND ((EQ |hd| 'QUOTE) |t|) (T (SETQ |hd| (|applySubstNQ| |sl| |hd|)) (SETQ |tl| (|applySubstNQ| |sl| |tl|)) (COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|) (T (CONS |hd| |tl|)))))) ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|)) (T |t|))))) (DEFUN |setDifference| (|x| |y|) (PROG (|a| |l| |p|) (RETURN (COND ((NULL |x|) NIL) ((NULL |y|) |x|) (T (SETQ |l| (SETQ |p| (LIST NIL))) (LET ((|bfVar#1| |x|)) (LOOP (COND ((NOT (CONSP |bfVar#1|)) (RETURN NIL)) (T (AND (CONSP |bfVar#1|) (PROGN (SETQ |a| (CAR |bfVar#1|)) T) (NOT (|objectMember?| |a| |y|)) (PROGN (RPLACD |p| (LIST |a|)) (SETQ |p| (CDR |p|)))))) (SETQ |bfVar#1| (CDR |bfVar#1|)))) (CDR |l|)))))) (DEFUN |setUnion| (|x| |y|) (PROG (|z|) (RETURN (PROGN (SETQ |z| NIL) (LET ((|bfVar#1| |x|) (|a| NIL)) (LOOP (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |a| (CAR |bfVar#1|)) NIL)) (RETURN NIL)) (T (AND (NOT (|objectMember?| |a| |z|)) (SETQ |z| (CONS |a| |z|))))) (SETQ |bfVar#1| (CDR |bfVar#1|)))) (LET ((|bfVar#2| |y|) (|a| NIL)) (LOOP (COND ((OR (NOT (CONSP |bfVar#2|)) (PROGN (SETQ |a| (CAR |bfVar#2|)) NIL)) (RETURN NIL)) (T (AND (NOT (|objectMember?| |a| |z|)) (SETQ |z| (CONS |a| |z|))))) (SETQ |bfVar#2| (CDR |bfVar#2|)))) (|reverse!| |z|))))) (DEFUN |setIntersection| (|x| |y|) (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |x|) (|a| NIL)) (LOOP (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |a| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) (T (AND (|objectMember?| |a| |y|) (COND ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS |a| NIL)) (SETQ |bfVar#3| |bfVar#2|)) (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))))) (SETQ |bfVar#1| (CDR |bfVar#1|))))) (DEFUN |removeSymbol| (|l| |x|) (PROG (|y| |LETTMP#1| |l'| |before|) (RETURN (PROGN (SETQ |before| NIL) (SETQ |l'| |l|) (LOOP (COND ((NOT (CONSP |l'|)) (RETURN |l|)) (T (SETQ |LETTMP#1| |l'|) (SETQ |y| (CAR |LETTMP#1|)) (SETQ |l'| (CDR |LETTMP#1|)) (COND ((EQ |x| |y|) (RETURN (|append!| (|reverse!| |before|) |l'|))) (T (SETQ |before| (CONS |y| |before|))))))))))) (DEFUN |removeScalar| (|l| |x|) (PROG (|y| |LETTMP#1| |l'| |before|) (RETURN (PROGN (SETQ |before| NIL) (SETQ |l'| |l|) (LOOP (COND ((NOT (CONSP |l'|)) (RETURN |l|)) (T (SETQ |LETTMP#1| |l'|) (SETQ |y| (CAR |LETTMP#1|)) (SETQ |l'| (CDR |LETTMP#1|)) (COND ((EQL |x| |y|) (RETURN (|append!| (|reverse!| |before|) |l'|))) (T (SETQ |before| (CONS |y| |before|))))))))))) (DEFUN |removeValue| (|l| |x|) (PROG (|y| |LETTMP#1| |l'| |before|) (RETURN (PROGN (SETQ |before| NIL) (SETQ |l'| |l|) (LOOP (COND ((NOT (CONSP |l'|)) (RETURN |l|)) (T (SETQ |LETTMP#1| |l'|) (SETQ |y| (CAR |LETTMP#1|)) (SETQ |l'| (CDR |LETTMP#1|)) (COND ((EQUAL |x| |y|) (RETURN (|append!| (|reverse!| |before|) |l'|))) (T (SETQ |before| (CONS |y| |before|))))))))))) (DEFUN |remove| (|l| |x|) (COND ((SYMBOLP |x|) (|removeSymbol| |l| |x|)) ((OR (CHARACTERP |x|) (INTEGERP |x|)) (|removeScalar| |l| |x|)) (T (|removeValue| |l| |x|)))) (DEFUN |charPosition| (|c| |s| |k|) (PROG (|n|) (RETURN (PROGN (SETQ |n| (LENGTH |s|)) (LOOP (COND ((NOT (< |k| |n|)) (RETURN NIL)) ((CHAR= (SCHAR |s| |k|) |c|) (RETURN |k|)) (T (SETQ |k| (+ |k| 1))))))))) (DEFUN |firstNonblankPosition| (|s| |k|) (LET ((|bfVar#2| NIL) (|bfVar#1| (- (LENGTH |s|) 1)) (|i| |k|)) (LOOP (COND ((> |i| |bfVar#1|) (RETURN |bfVar#2|)) (T (AND (NOT (CHAR= (SCHAR |s| |i|) (|char| '| |))) (PROGN (SETQ |bfVar#2| |i|) (COND (|bfVar#2| (RETURN |bfVar#2|))))))) (SETQ |i| (+ |i| 1))))) (DEFUN |firstBlankPosition| (|s| |k|) (LET ((|bfVar#2| NIL) (|bfVar#1| (- (LENGTH |s|) 1)) (|i| |k|)) (LOOP (COND ((> |i| |bfVar#1|) (RETURN |bfVar#2|)) (T (AND (CHAR= (SCHAR |s| |i|) (|char| '| |)) (PROGN (SETQ |bfVar#2| |i|) (COND (|bfVar#2| (RETURN |bfVar#2|))))))) (SETQ |i| (+ |i| 1))))) (DEFUN |finishLine| (|out|) (PROGN (TERPRI |out|) (FORCE-OUTPUT |out|)))