The fix: (= bodops*
(with (exclude '(aif)
include '(after 1 annotate 1 atlet 2 atwith 1 atwiths 1 case 1
caselet 2 def 2 defhook 2 deftem 1 fn 1 mac 2))
(fill-table (table
[each (op parms) sig
(unless (mem op exclude)
(when (is (reclist atom&idfn parms) 'body)
(= (_ op) (count (fn (x) t)
(check parms acons)))))])
include)))
(See below for another approach, too.)Explanation: In pprint.arc, ppr decides how to indent certain expressions based on whether they're operators that have some body of code. For example, def should be indented like (def f (x)
body)
instead of (def f
(x)
body)
But the body-operators are determined by the hard-coded table (= bodops* (fill-table (table)
'(let 2 with 1 while 1 def 2 fn 1 rfn 2 afn 1
when 1 unless 1 after 1 whilet 2 for 3 each 2 whenlet 2 awhen 1
whitepage 0 tag 1 form 1 aform 1 aformh 1 w/link 1 textarea 3
)))
This only has 22 operators and clearly misses a lot of them -- it doesn't even have mac!But the definitions of body-operators are fairly reliable in Arc's source: they usually name their rest parameter "body". So, my fix: - looks through sig for operators that take a rest parameter named "body" - excludes false positives (I only noticed aif, but it's easily extensible) - includes false negatives (e.g., def isn't in sig and atlet's rest parameter is named "args") Thus, it makes the table less hard-coded, more future-proof, etc. Caveat: this definition means that we'll only find as many body-operators as are in sig at the time pprint.arc is loaded. Note that libs.arc loads pprint.arc second: (map load '("strings.arc"
"pprint.arc"
"code.arc"
"html.arc"
"srv.arc"
"app.arc"
"prompt.arc"))
So, if we put this definition at the top of pprint.arc, we'll miss the body-operators of code.arc, html.arc, srv.arc, app.arc, and prompt.arc.Possible solution: make a bodop function instead. (with (exclude '(aif)
include (fill-table (table)
'(after 1 annotate 1 atlet 2 atwith 1 atwiths 1 case 1
caselet 2 def 2 defhook 2 deftem 1 fn 1 mac 2)))
(defmemo bodop (op)
(unless (mem op exclude)
(or (include op)
(let parms (sig op)
(and (is (reclist atom&idfn parms) 'body)
(count (fn (x) t)
(check parms acons)))))))
(each op (+ (keys sig) (keys include) exclude)
(bodop op)))
On the plus side, the result is determined at runtime, so we don't need to worry about when bodop is defined in relation to body-operators. And though memoization makes it resistant to redefinitions (I'm not sure if that's good or bad), ppr could treat some user-defined operators as body-operators (this might actually be desirable).My compromise for the time being is to put the original fix at the end of libs.arc instead of at the top of pprint.arc -- i.e., after all the libraries have been loaded. When this is done, we have BEFORE: Use (quit) to quit, (tl) to return here after an interrupt.
arc> (len bodops*)
22
arc> (sort < (keys bodops*))
(afn aform aformh after awhen def each fn for form let rfn tag textarea
unless w/link when whenlet while whilet whitepage with)
arc> (ppr '(mac rfn (name parms . body)
`(let ,name nil
(assign ,name (fn ,parms ,@body)))))
(mac rfn
(name parms . body)
(quasiquote (let (unquote name) nil
(assign (unquote name)
(fn (unquote parms)
(unquote-splicing body))))))t
AFTER: Use (quit) to quit, (tl) to return here after an interrupt.
arc> (len bodops*)
100
arc> (sort < (keys bodops*))
(accum afn aform aformh after annotate arform arformh atlet atomic atwith
atwiths awhen case caselet catch cdata center def defbg defcache defhook
defmemo defop defop-raw defopl defopr defopr-raw defset deftem down each fn
fontcolor for forlen form fromstring let linkf loop mac noisy-each on onlink
onrlink point prbold repeat rfn rlinkf spanclass spanrow sptab summing tab
taform tag tag-if tarform td tdcolor tdr textarea thread tostring tr trtd
uform ulink underline unless until urform w/appendfile w/bars w/infile
w/instring w/link w/link-if w/outfile w/outstring w/rlink w/socket w/stdin
w/stdout w/table w/uniq when when-umatch when-umatch/r whenlet while whiler
whilet whitepage widtable with withs zerotable)
arc> (ppr '(mac rfn (name parms . body)
`(let ,name nil
(assign ,name (fn ,parms ,@body)))))
(mac rfn (name parms . body)
(quasiquote (let (unquote name) nil
(assign (unquote name)
(fn (unquote parms)
(unquote-splicing body))))))t
| 
