(def match-json-string ()
    (match-char #\"
      (liststr:accum a
        (while (~match-char #\")
          (atend-err "missing close quote")
          (a (or (match-json-backslash)
                 (readc (stdin))))))))

Getting the parse position out of the function really broke the logjam. The old version was doing two things at once -- keeping track of the parse position and matching characters -- and that made it really hard to pull out bits of functionality into their own functions to make the main function shorter and clearer. Now it's much easier to tell what the function is doing! :)

Here's the rest of the code:

  (def hexdigit (c)
    (and (isa c 'char)
         (or (<= #\a c #\f) (<= #\A c #\F) (<= #\0 c #\9))))

  (def json-unicode-digits ()
    (let u (n-of 4 (readc (stdin)))
      (unless (all hexdigit u) (err "need 4 hexadecimal digits after \\u"))
      (coerce (int (coerce u 'string) 16) 'char)))

  ; json-backslash-char is the same

  (mac match-char (c . body)
    `(when (is (peekc (stdin)) ,c)
       (readc (stdin))
       ,@body))

  (def atend-err (msg)
    (unless (peekc (stdin))
      (err msg)))

  (def match-json-unicode-escape ()
    (match-char #\u (json-unicode-digits)))

  (def match-json-backslash ()
    (match-char #\\
      (atend-err "missing char after backslash")
      (or (match-json-unicode-escape)
          (json-backslash-char (readc (stdin))))))

  (def liststr (l)
    (coerce l 'string))

Only one comment: peekc and readc default to stdin, so you can leave out all of the (stdin) calls, unless you're leaving them for readability.

  arc> (readc)
  Error: "procedure readc: expects 1 argument, given 0"

According to arcfn.com and the code that it references, it looks like it's supposed to default to stdin, but it's written in such a way to require at least one argument. If you pass nil, it reads from stdin because of the default.

The current code is:

  (xdef readc (lambda (str)
               (let ((p (if (ar-false? str)
                            (current-input-port)
                            str)))
                 (let ((c (read-char p)))
                   (if (eof-object? c) 'nil c)))))

So the new code would be:

    (xdef readc (lambda ((str (current-input-port))
               (let ((c (read-char p)))
                   (if (eof-object? c) 'nil c))))

    (xdef readc (lambda ((str (current-input-port))
               (let ((p (if (ar-false? str)
                            (current-input-port)
                            str)))
                 (let ((c (read-char p)))
                   (if (eof-object? c) 'nil c)))))

  (xdef 'readc (lambda str
                 (let ((c (read-char
                           (if (pair? str)
                               (car str)
                               (current-input-port)))))
                   (if (eof-object? c) 'nil c))))

  (let original readc
    (= readc (fn ((o str (stdin)))
               (original str))))

  arc> (fromstring "abc" (readc))
  #\a

  (mac redef (name args . body)
    `(let original ,name
       (= ,name (fn ,args ,@body))))

  (redef readc ((o str (stdin)))
    (original str))

  (mac redef (name parms . body)
    " Redefine a function.  The old function definition may be used within
      `body' as the name `old'. "
    `(do (tostring
          (let old (varif ,name nilfn)
            (= ,name (fn ,parms ,@body))))
         ,name))

  arc> (def foo () 3)
  #<procedure: foo>
  arc> (= foo 4)
  4
  arc>

As part of the design process of finding the shortest Arc implementation, pg is careful not to include functions that he isn't actually using for news. This leads to some surprises (car, cdr, cadr, cddr, but no cdar?) but also removes cruft that builds up implementing things that people might need some day but turn out not to.

It turns out not to be a problem, since Arc is so concise it's really easy to extend, and so people quickly implement the things they need that pg happens not to be using for news.

Side note: compare the "profiles" of this version, and the earlier versions -- this one has a much more "functional" profile.

I'm a bit confused what you mean about atend:err. Do you basically mean that there would be function composition between a macro, and a call to, for example, (err "missing char after backslash")? Something like

  (mac atend (alert)
    `(unless (peekc (stdin))
       ,alert))

Yes, a composition, though not a function composition. Because the Arc compiler rewrites (a:b ...) as (a (b ...)) when a:b appears in the first position in an expression, it works for macros also.

Thus

  (atend:err "missing close quote")

  (atend (err "missing close quote"))

  (unless (peekc (stdin))
    (err "missing close quote"))

  (atend:err "missing char after backslash")

I copied out the code, commented it (spending about 80% of the time between www.arcfn.com and arc.arc), and then made two main changes. One is that I rewrote 'json-unicode-digits to only pass over the 4 chars once, rather than three times -- I did this by dissecting 'firstn, and putting the error checking forms inside there.

The other major change is the macro. I noticed that three functions used a similar pattern (the last one was a slight stretch, but after all, a 'let is a lambda deep inside).

My code:

  (def hexdigit (c)
    (or (<= #\a c #\f) (<= #\A c #\F) digit.c))

  (def json-backslash-char (c)
    (case c
      #\" #\"
      #\\ #\\
      #\/ #\/
      #\b #\backspace
      #\f #\page
      #\n #\newline
      #\r #\return
      #\t #\tab
      (err "invalid JSON backslash char" c) ) )

  ;; (The above two are verbatim from CatDancer's code
  ;;  Now comes some modified stuff)

  (def json-unicode-digits (j)
    (let u ((afn (n xs)
              (if (is n 0) nil
                    (or (no xs) (no:hexdigit (car xs)))
                  (err "need 4 hexadecimal digits after \u")
                    (cons (car xs) (self (-- n) (cdr xs)))))
            4 j)
      (coerce (int (coerce u 'string) 16) 'char) ) )

  (mac def-jsniffer (name c next (o arg 'cdr.j))
    `(def ,name (j)
       (if (is car.j ,c)
           (,next ,arg))))

  ;; ... because it sniffs ahead at the next char.
  
  (def-jsniffer match-json-unicode-escape #\u
    [list (nthcdr 4 _)
          (json-unicode-digits _)])

  (def-jsniffer match-json-backslash #\\
    [do (if no._ (err "missing char after backslash"))
        (or match-json-unicode-escape._
            (list cdr._ (json-backslash-char car._)) ) ] )

  (def-jsniffer match-json-string #\"
    (fn ((j a))
      (list j (coerce rev.a 'string)))
    ((afn (j a)
       (if no.j (err "missing close quote"))
       (if (is car.j #\") (list cdr.j a)
           (iflet (j c)
                 (match-json-backslash j)
               (self j (cons c a))
             (self (cdr j) (cons (car j) a)) ) ) )
     cdr.j nil))

  (mac def-jsniffer (name c next (o arg 'cdr.j))
    `(def ,name (j)

1. Put all the functions inside a surrounding lexical scope, and keep the state in some lexical variables that all the functions can access.

2. Write some macros so that you're still passing the state through all your functions, but the variables don't appear in your code.

  (def run-parser (j ...)
     (withs
        (next-char (fn () car.j))
        (bump-j (fn () (= j cdr.j))
        (parse-string (fn ()
                         if (is (next-char) #\")
                              (do (bump-j)
                                  ...

Other than that, I'm not good enough yet at writing parsers in arc to help you much. Your original was already pretty short, though there were a few spots that you could have used the . operator more (car, cdr, etc.)