Saturday, August 9, 2008

Real life nastiness

Here's an example I stole from the support code for PLT Scheme. This function seems to check whether we've hit a symbol delimiter or comment.
int wxMediaStreamIn::IsDelim(char c)
{
  if (scheme_isspace((unsigned char)c))
    return 1;
  else if (c == '#') {
    long pos;
    char next[1];
    pos = f->Tell();
    f->Read(next, 1);
    if (next[0] == '|') {
      f->Seek(pos - 1);
      return 1;
    } else {
      f->Seek(pos);
      return 0;
    }
  } else if (c == ';') {
    long pos;
    pos = f->Tell();
    f->Seek(pos - 1);
    return 1;
  } else
    return 0;
}
This function might be skipping a token in the input stream. I'm not really sure.
void wxMediaStreamIn::SkipOne(int recur)
{
  char buf[1];

  if (recur) {
    buf[0] = '#';
  } else {
    SkipWhitespace(buf);
  }

  if (!bad) {
    if (buf[0] == '#') {
      /* Byte string */
      if (f->Read(buf, 1) == 1) {
 if (buf[0] != '"') {
   bad = 1;
   BAD_PRINTF(("bad 12\n"));
 } else {
   while (1) {
     if (f->Read(buf, 1) != 1) {
       bad = 1;
       BAD_PRINTF(("bad 13\n"));
       break;
     }
     if (buf[0] == '"') {
       break;
     } else if (buf[0] == '\\') {
       if (f->Read(buf, 1) != 1) {
  bad = 1;
  BAD_PRINTF(("bad 14\n"));
  break;
       }
     }
   }
 }
      } else {
 bad = 1;
 BAD_PRINTF(("bad 15\n"));
      }
    } else if (buf[0] == '(') {
      /* List of byte strings */
      while (!bad) {
 do {
   if (f->Read(buf, 1) != 1) {
     bad = 1;
     BAD_PRINTF(("bad 16\n"));
     break;
   }
 } while (!IsDelim(buf[0]));
 if (buf[0] == ')')
   break;
 else if (buf[0] == '#') {
   SkipOne(TRUE);
 } else {
   bad = 1;
   break;
 }
      }
    } else {
      /* Number */
      do {
 if (f->Read(buf, 1) != 1) {
   bad = 1;
   BAD_PRINTF(("bad 16\n"));
   break;
 }
      } while (!IsDelim(buf[0]));
    }

    if (!bad && !recur)
      IncItemCount();
  }
}
Now suppose we wanted to change this code by in-lining the calls to IsDelim. This is not a trivial task. In fact, the calls to BAD_PRINTF seem to indicate that the author of the code had no easy time getting to this point. The duplication of code blocks shows that some in-lining has already been done.

Now consider this code. It is part of a compiler. It establishes an escape continuation upon entry to a block, and if possible, optimizes the code if it can determine either that the continuation is not used or that the call to the continuation is at the same dynamic depth as the continuation.
  (define (bind-escape-continuation variable-name binder-type)
    (lambda (block receiver)
      ;; Grab a continuation to return to if necessary.
      (let* ((block (block/make block '()))
             (cont-var (binding/variable (variable/make&bind! block variable-name #f #f)))
             (result (receiver block)))
        (cond ((and (non-local-exit? result)
                    (eq? (non-local-exit/variable result) cont-var)
                    (not (variable/referenced? cont-var (non-local-exit/body result))))
               (evil-message "Optimize:  Coalesce catch/throw" cont-var)
               (non-local-exit/body result))
              ((not (variable/referenced? cont-var result))
               (evil-message "Optimize:  Remove binding for non-local-exit" cont-var)
               result)
              (else (make binder-type
                      :block    block
                      :variable cont-var
                      :body     result))))))
And this function compiles a for statement. An escape continuation is necessary to handle calls to break and continuue.
  (defmethod (compile-expression (target <void-target>) block (statement <c-for>))
    (cons-expression
     block
     (compile-expression (make <effect-target> :parent target) block (for/initialize statement))
     ((bind-escape-continuation 'break <compiled-bind-break>)
      block
      (lambda (break-block)
        (let* ((for-block (block/make break-block '()))
               (for-var   (binding/variable (variable/make&bind! block 'for #f #f))))
          (make-iteration
           (variable/name for-var)
           (make-sequence
            (list (make-conditional
                   (compile-expression (make <predicate-target> :parent target)
                                       for-block (for/predicate statement))
                   ((bind-escape-continuation 'continue <compiled-bind-continue>)
                    for-block
                    (lambda (continue-block)
                      (let ((continue-binding (block/lookup-name continue-block 'continue #f)))
                        ;; stow the step part.
                        (setf! (binding/value continue-binding)
                               (compile-expression (make <statement-target> :parent target)
                                                   break-block (for/step statement)))
                        (cons-expression continue-block
                                         (compile-expression (make <statement-target> :parent target)
                                                             continue-block (for/body statement))
                                         (make <non-local-exit>
                                           :block continue-block
                                           :variable (binding/variable continue-binding)
                                           :body (binding/value continue-binding))))))
                   (make <non-local-exit>
                     :block for-block
                     :variable (binding/variable
                                (block/lookup-name break-block 'break #f))
                     :body #f))
                  (make <compiled-combination>
                    :operator (make <compiled-reference> :variable for-var)
                    :operands '()))
            )))))))
Inlining the call to bind-escape-continuation is trivial. (Try it.) This isn't due to the problem domain unless character at a time parsing is that much more difficult than flow-control in a compiler.

One reason I chose Lisp or Scheme for experimental code is because I can move things around so much easier than in other languages. When I tinker with code I often decide to pull a chunk out, combine it with another, change my mind, put it back, change something to a function, move a binding, etc. Lisp simply does not get in my way as much as other languages.