This page is part of the web mail archives of SRFI 110 from before July 7th, 2015. The new archives for SRFI 110 contain all messages, not just those from before July 7th, 2015.
Attached is an initial reference implementation of:
* curly-write-simple and neoteric-write-simple
* [curly,neoteric]-write-[shared,cyclic]
It then does:
(define neoteric-write neoteric-write-cyclic)
(define curly-write curly-write-cyclic)
Comments/improvements welcome! The "simple" implementations is separable from the shared/cyclic implementation, so that those who don't want shared and cyclic versions can omit them.
I used the Chibi Scheme implementation as a starting point. That builds on srfi-38, but it uses hash tables (more efficient) and can deal with both cyclic and shared structure versions. The Chibi code for this is released to the public domain, so no license issue.
Below is the starting test set and its output, to show that it's plausible. The test set is used by all; I can't (obviously) include cycles in the calls to the -simple variants.
--- David A. Wheeler
============= Basic tests =============================
(define basic-tests
'(
(+ 4 5)
(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))
============= Output (test results) =============================
curly-write-simple
{4 + 5}
'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-write-simple
{4 + 5}
'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
curly-write-shared
{4 + 5}
'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
(a b)
(begin #0=(a b) #0# end)
#0=(first . #0#)
(dosomething #0=(c1 c2) (b1 b2) #0#)
#0=(quote . #0#)
curly-write-cyclic
{4 + 5}
'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
(a b)
(begin (a b) (a b) end)
#0=(first . #0#)
(dosomething (c1 c2) (b1 b2) (c1 c2))
#0=(quote . #0#)
neoteric-write-shared
{4 + 5}
'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
a(b)
begin(#0=a(b) #0# end)
#0=(first . #0#)
dosomething(#0=c1(c2) b1(b2) #0#)
#0=(quote . #0#)
neoteric-write-cyclic
{4 + 5}
'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
a(b)
begin(a(b) a(b) end)
#0=(first . #0#)
dosomething(c1(c2) b1(b2) c1(c2))
#0=(quote . #0#)
Attachment:
write.scm
Description: Binary data