I've refined version curly-write and neoteric-write (which are really "simple" versions right now).

Key question: Does this output (below) look *reasonable*?  I think it does.  Below (in-line) I've shown my sample input tests, curly-infix, and neoteric results.  In both cases, it guesses that lists whose first element is a punctuation-only symbol (or "and or "or" or "xor), and have 3..6 arguments, are infix, e.g., {a + b ...}.  For neoteric-expressions, most lists that begin with a symbol but won't be curly-infix are put in the form f(...).

The key refinement is that they don't get stuck trying to figure out "what to do" in the presence of cycles.  They'll still loop when they try to actually *write* a cycle, of course, but at least if it's getting displayed it's obvious what the problem is :-).  Before, it could get stuck without displaying anything.  This refinement is also necessary to create shared and cycle-detecting versions.  Actual code attached.

--- David A. Wheeler

=== TEST CASES ===

(define basic-tests
  '(
    (quote x)
    (a b c d e f g h i j k l m n o p q r s t u v w x y z)
    (a b c d e f g h i j k l m n o p q r s t u v w x y z . 2)
    (a 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
    (a 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17)
    (+ a b)
    (+ a b c)
    (+ a b c . improper)
    (+ 1 2 3 4 5)
    (+ 1 2 3 4 5 6)
    (+ 1 2 3 4 5 6 7)
    (sin (- theta))
    (fact (- n 1))
    (calculate (pi))
    (between current min max)
    (my-write . rest)
    (sin x)
    (- x)
    (-)
    (function +)
    (map + '(2 4 6))
    (current-time)
    (1 2 3)
    (4 5 . 6)
    5
    boring-symbol
    (+ (sqrt x) (sqrt y))
    `(1 2 ,@(+ a b))
    (syntax (a b c))
    #(v1 v2 (+ 2 3) (sin x))
    (define (is-infix-operator? x)
      (cond ((not (symbol? x)) #f)
            ((memq x special-infix-operators) #t)
            (#t
             (contains-only-punctuation?
               (string->list (symbol->string x))))))
    fin))

=== CURLY-INFIX (from curly-write) ===

'x
(a b c d e f g h i j k l m n o p q r s t u v w x y z)
(a b c d e f g h i j k l m n o p q r s t u v w x y z . 2)
(a 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
(a 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17)
{a + b}
{a + b + c}
(+ a b c . improper)
{1 + 2 + 3 + 4 + 5}
{1 + 2 + 3 + 4 + 5 + 6}
(+ 1 2 3 4 5 6 7)
(sin (- theta))
(fact {n - 1})
(calculate (pi))
(between current min max)
(my-write . rest)
(sin x)
(- x)
(-)
(function +)
(map + '(2 4 6))
(current-time)
(1 2 3)
(4 5 . 6)
5
boring-symbol
{sqrt(x) + sqrt(y)}
`(1 2 ,@{a + b})
#'(a b c)
#( v1 v2 {2 + 3} (sin x) )
(define (is-infix-operator? x) (cond ((not (symbol? x)) #f) ((memq x special-infix-operators) #t) (#t (contains-only-punctuation? (string->list (symbol->string x))))))
fin

=== NEOTERIC-EXPRESSIONS (from neoteric-write) ===

'x
(a b c d e f g h i j k l m n o p q r s t u v w x y z)
(a b c d e f g h i j k l m n o p q r s t u v w x y z . 2)
a(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
(a 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17)
{a + b}
{a + b + c}
+(a b c . improper)
{1 + 2 + 3 + 4 + 5}
{1 + 2 + 3 + 4 + 5 + 6}
+(1 2 3 4 5 6 7)
sin{- theta}
fact{n - 1}
calculate(pi())
between(current min max)
my-write(. rest)
sin(x)
-(x)
-()
function(+)
map(+ '(2 4 6))
current-time()
(1 2 3)
(4 5 . 6)
5
boring-symbol
{sqrt(x) + sqrt(y)}
`(1 2 ,@{a + b})
#'a(b c)
#( v1 v2 {2 + 3} sin(x) )
define(is-infix-operator?(x) cond((not(symbol?(x)) #f) (memq(x special-infix-operators) #t) (#t contains-only-punctuation?(string->list(symbol->string(x))))))
fin