; earlier defined ssyntaxes have *lower*
; precedence: thus foo.bar:x means
; (foo (compose bar x))
(def-ss
; capital L means left associative:
; so foo.bar.z means ((foo bar) z)
#\. (L r)
; also means that foo!bar!z now works
; properly with nested tables/objects
#\! (L 'r)
; means split by #\: and
; replace the ... with the list
#\: (compose ...)
; since there's no L, this is
; a prefix
#\~ (no R))
Implementation of def-ss (mac def-ss rest
(let paired (pair rest)
`(= ssyntaxes*
',paired
ssyntax-chars*
',(map car paired))))
Implementation of 'ssyntax: (def ssyntax (s)
(and (isa s 'sym)
(some [some _ ssyntax-chars*]
(coerce (string s) 'cons))))
Implementation of 'ssexpand: (let (has-dot3 dot3 expansion-fun
do-expansion expand) nil
(= has
(fn (s exp)
(if
(acons exp)
(or (has-dot3:car exp)
(has-dot3:cdr exp))
(is exp s)
t)))
(= dot3
(fn (ls exp)
(if (acons ls)
(if (caris ls '...)
(+ ls (dot3:cdr exp))
(cons (dot3:car exp)
(dot3:cdr exp)))
ls)))
(= expansion-fun
(fn (post exp)
(fn (l r)
(with (l (post l)
r (post r))
((afn (e)
(if
(acons e)
(cons (self:car e)
(self:cdr e))
(in e 'L 'l)
l
(in e 'R 'r)
r
e))
exp)))))
(= do-expansion
(fn (char ls exp post)
(if
(has '... exp)
(dot3 (map post ls) exp)
(has 'L exp)
(reduce (expansion-fun post exp)
ls)
(has 'l exp)
(rreduce (expansion-fun post exp)
ls)
; no L or l: prefix only
(if (empty:ls 0)
((compose post (expansion-fun post exp))
nil (apply + (intersperse (string char)
ls)))
(post (apply + (intersperse (string char)
ls))))))
(= expand
(fn (s expansions)
(if expansions
(withs (((char expansion) . rest) expansions
ls (ssplit s [is _ char]))
(if (> (len ls) 1)
(do-expansion char ls expansion
[expand _ rest])
(expand s rest)))
(coerce s 'sym))))
(def ssexpand (s)
(if (isa s 'sym)
(expand (string s) ssyntaxes*)
s)))
All code untested ^^(yeah, someone really has to tell me to start working in the office instead of programming Arc) | 
