%%HP: T(3)A(D)F(.);
by David Lowenstein
DIR
  MN
    \<< \->NUM DUP SIGN SWAP ABS DUP IP 10 OVER DUP
      \<< XPON
      \>> IFT - FIX SWAP FP \->Q STD + *
    \>>
  OQF
    \<< \->NUM DUP SIGN SWAP SQ 5 FIX \->Q DUP TYPE
      \<< OBJ\-> DROP2 PF FS SWAP PF FS
      \>>
      \<< { 1 1 } SWAP PF FS
      \>> IFTE 1 1 \-> B A D E
      \<< 1 A SIZE 1 -
        FOR c A c 1 + GET A c GET 2 / DUP FP
          \<< IP OVER SWAP ^ 'D' STO* 'E' STO*
          \>>
          \<< ^ 'D' STO*
          \>> IFTE 2
        STEP 1 B SIZE 1 -
        FOR c B c 1 + GET B c GET 2 / DUP FP
          \<< IP OVER SWAP ^ 'D' SWAP STO/ 'E' SWAP STO/
          \>>
          \<< ^ 'D' SWAP STO/
          \>> IFTE 2
        STEP D \->Q E \->Q STD DUP TYPE
        \<< \v/ *
        \>>
        \<< "'\v/" SWAP \->STR + OBJ\-> DUP EVAL FP NOT
          \<< EVAL
          \>> IFT *
        \>> IFTE *
      \>>
    \>>
  QF
    \<< \->NUM DUP SIGN SWAP SQ 5 FIX \->Q DUP TYPE
      \<< OBJ\-> DROP2 PF FS SWAP PF FS
      \>>
      \<< { 1 1 } SWAP PF FS
      \>> IFTE 1 1 \-> B A D E
      \<< 1 A SIZE 1 -
        FOR c A c 1 + GET A c GET 2 / DUP FP
          \<< IP OVER SWAP ^ 'D' STO* 'E' STO*
          \>>
          \<< ^ 'D' STO*
          \>> IFTE 2
        STEP 1 B SIZE 1 -
        FOR c B c 1 + GET B c GET 2 / DUP FP
          \<< IP OVER SWAP ^ 'D' SWAP STO/ DUP 'E' STO* 'D' SWAP STO/
          \>>
          \<< ^ 'D' SWAP STO/
          \>> IFTE 2
        STEP D \->Q E \->Q STD DUP TYPE
        \<< \v/ *
        \>>
        \<< "'\v/" SWAP \->STR + OBJ\-> DUP EVAL FP NOT
          \<< EVAL
          \>> IFT *
        \>> IFTE *
      \>>
    \>>
  FS
    \<< 0 \-> l c
      \<< { } l 1 GET 1 l SIZE
        FOR p l p GET SAME
          \<< 'c' INCR DROP
          \>>
          \<< c + l p 1 - GET + 1 'c' STO
          \>> IFTE l p GET
        NEXT c SWAP 1 \->LIST + +
      \>>
    \>>
  PF
    \<< { } OVER SIGN -1 ==
      \<< -1 +
      \>> IFT SWAP ABS 1 \->LIST
      DO DUP DUP DUP SIZE SWAP OVER GET DUP 2 / IP 2 \-> n h c
        \<<
          WHILE c h \<= n c / FP AND
          REPEAT 'c' INCR DROP
          END n 1 c h \<=
          \<< DROP c SWAP OVER / 2
          \>> IFT \->LIST
        \>> REPL
      UNTIL SWAP OVER ==
      END +
    \>>
END