SteveGilham

let putc (c: char) (k: continuation) =
    let write () = System.Console.Write(c);
                   execute k
    K write
let getc (g: char -> continuation) =
    let read () = execute (g <| System.Console.ReadKey(true).KeyChar)
    K read;;

SteveGilham

let (<|) f x = (f x);;

SteveGilham

let rec echo k = 
    let echoChar c = if c = '\r'
                     then putc '\n' k
                     else putc c (echo k)
    getc echoChar;;

SteveGilham

// Define a result type of a lexeme list or error message:
type lexerResult<'lexeme> = 
    Success of 'lexeme list
  | Failure of string;;

SteveGilham

// Define a type with a character source, a 'lexeme sink and an error string sink:
type lexerSystem<'lexeme> = { 
  input: unit -> char option;
  output: 'lexeme -> unit;
  error: string -> unit;
  result: unit -> lexerResult<'lexeme> };;

SteveGilham

// Read the output result and continue with (g result)
let lexComplete s g = 
    let complete () =
        g (s.result ())
    K complete;;

SteveGilham

// Set the output to the failure state and continue with k
let lexFail s e k =
    let storeError () =
        s.error e
        execute k
    K storeError;;

SteveGilham

// s is our lexerSystem
let lexGetChar s g =
       K (fun () -> execute (g (s.input())));;

SteveGilham

let lexPutLexeme s lexeme (k: continuation) =
    let storeLexeme () =
        s.output lexeme;
        execute k
    K storeLexeme;;

SteveGilham

// (^^) associates on the right, which means that we can chain instances without requiring nested brackets
let ( ^^ ) (test, g1) (g2: 'x -> continuation) x =
      (if test x then g1 else g2) x;;