SML Circularity error when writing in Continuation-Passing Style

Question

I'm trying to implement iteration using continuations

fun stringChars string =
    let val len = size string
    fun nextChar index kEndOfString kReadChar =
        if len = index
        then kEndOfString ()
        else kReadChar(index, String.sub(string, index), nextChar (index + 1))
    in nextChar 0
    end

but I get the following error:

Error: right-hand-side of clause does not agree with function result type [circularity]
  expression:  (unit -> 'Z) -> (int * char * 'Y -> 'Z) -> 'Z
  result type:  'Y
  in declaration:
    nextChar =
      (fn arg =>
            (fn arg =>
                  (fn arg =>
                        (case (arg,arg,arg)
                        of (<pat>,<pat>,<pat>) =>
                             if <exp> then <exp> else <exp>))))
val it = () : unit

The idea of stringChars is to return a function that takes 2 continuations: one for end of string and one for processing a character, so that I can call it like:

fun collect stream =
    let fun iter stream results =
            stream (fn () => rev results)
                   (fn (index, char, stream) => iter stream (char::results))
    in iter stream []
    end

which would collect all of the characters into a list. For example: calling collect (stringChars "Hello") would return [#"H", #"e", ...].

collect unfortunately also doesn't typecheck:

Error: case object and rules do not agree [circularity]
  rule domain: ((unit -> 'Z list) -> ('Y * 'Z * 'X -> 'W) -> 'V) * 'Z list
  object: 'X * 'U
  in expression:
    (case (arg,arg)
    of (stream,results) =>
         (stream (fn () => rev results))
           (fn (index,char,stream) => (iter stream) (char :: results)))
val it = () : unit

Is there a way I can make these typecheck?

I tried to manually include types but I ended up with a circularity problem (the type of nextChar needs the type of kReadChar which needs the type of nextChar.)

[EDIT]: Here is an example of this in Common Lisp:

(defun string-chars (string)
  (let ((length (length string)))
    (labels ((next-char (index k-end-of-string k-read-char)
               (if (= index length)
                   (funcall k-end-of-string)
                   (funcall k-read-char 
                            index 
                            (aref string index) 
                            (lambda (k-end-of-string k-read-char)
                              (next-char (1+ index) k-end-of-string k-read-char))))))
      (lambda (k-end-of-string k-read-char)
        (next-char 0 k-end-of-string k-read-char)))))

(defun collect (stream)
  (labels ((iter (stream result)
             (funcall stream
                      (lambda () (reverse result))
                      (lambda (index char stream)
                        (declare (ignore index))
                        (iter stream (cons char result))))))
    (iter stream '())))

(collect (string-chars "Hello"))
;; '(#\H #\e #\l #\l #\o)

My question is, is it possible to make this type check?

Answer 1

You have identified a circularity problem with the types which is the first step. The problem is that a type cannot contain itself. For example we cannot define

type t = int * t

However, there is a way to effectively achieve this in SML.

Use a datatype with a single constructor:

datatype t = T of int * t

I would recommend thinking about how to use this for up to an hour before looking at a solution below.

datatype 'a cont = Cont of (unit -> 'a) * (int * char * 'a stream -> 'a)
withtype 'a stream = 'a cont -> 'a

fun stringChars (string : string) : 'a stream =
    let val len = size string
    fun nextChar (index : int) (Cont (kEndOfString, kReadChar)) =
        if len = index
        then kEndOfString ()
        else kReadChar(index, String.sub(string, index), nextChar (index + 1))
    in nextChar 0
    end
fun collect stream =
    let fun iter stream results =
            stream (Cont (fn () => rev results,
                          fn (index, char, stream) => iter stream (char::results)))
    in iter stream []
    end
;
collect (stringChars "Hello")
;